From b1f39b09879822a8b8bdfac5c7bd67fb93554bac Mon Sep 17 00:00:00 2001 From: markito3 Date: Tue, 21 Aug 2018 13:14:40 -0400 Subject: [PATCH] Modified recon launch tag recon-2017_01-ver03 using same procedure as with split of sim-recon. --- src/SBMS/SConstruct.plugin | 14 +- src/SBMS/sbms.py | 4 +- src/SBMS/sbms_setenv.py | 20 +- src/SConstruct | 4 +- src/libraries/AMPTOOLS_AMPS/BreitWigner.cc | 107 - src/libraries/AMPTOOLS_AMPS/BreitWigner.h | 59 - .../AMPTOOLS_AMPS/BreitWigner3body.cc | 68 - .../AMPTOOLS_AMPS/BreitWigner3body.h | 56 - .../AMPTOOLS_AMPS/GPUBreitWigner_kernel.cu | 94 - .../AMPTOOLS_AMPS/GPUThreePiAngles_kernel.cu | 144 - .../AMPTOOLS_AMPS/GPUTwoPSAngles_kernel.cu | 64 - .../AMPTOOLS_AMPS/GPUUniform_kernel.cu | 21 - .../AMPTOOLS_AMPS/GPUb1piAngAmp_kernel.cu | 686 - .../AMPTOOLS_AMPS/GPUpolCoef_kernel.cu | 30 - src/libraries/AMPTOOLS_AMPS/Pi0Regge.cc | 111 - src/libraries/AMPTOOLS_AMPS/Pi0Regge.h | 42 - src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.cc | 378 - src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.h | 88 - src/libraries/AMPTOOLS_AMPS/Pi0SAID.cc | 321 - src/libraries/AMPTOOLS_AMPS/Pi0SAID.h | 42 - src/libraries/AMPTOOLS_AMPS/SConscript | 18 - src/libraries/AMPTOOLS_AMPS/ThreePiAngles.cc | 169 - src/libraries/AMPTOOLS_AMPS/ThreePiAngles.h | 64 - .../AMPTOOLS_AMPS/ThreePiAnglesSchilling.cc | 165 - .../AMPTOOLS_AMPS/ThreePiAnglesSchilling.h | 71 - src/libraries/AMPTOOLS_AMPS/TwoPSAngles.cc | 81 - src/libraries/AMPTOOLS_AMPS/TwoPSAngles.h | 62 - src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.cc | 85 - src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.h | 62 - src/libraries/AMPTOOLS_AMPS/TwoPiAngles.cc | 95 - src/libraries/AMPTOOLS_AMPS/TwoPiAngles.h | 61 - .../AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc | 246 - .../AMPTOOLS_AMPS/TwoPiAnglesRadiative.h | 71 - .../AMPTOOLS_AMPS/TwoPiAngles_amp.cc | 133 - src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.h | 55 - .../AMPTOOLS_AMPS/TwoPiAngles_primakoff.cc | 123 - .../AMPTOOLS_AMPS/TwoPiAngles_primakoff.h | 44 - .../AMPTOOLS_AMPS/TwoPiWt_primakoff.cc | 276 - .../AMPTOOLS_AMPS/TwoPiWt_primakoff.h | 51 - src/libraries/AMPTOOLS_AMPS/Uniform.cc | 17 - src/libraries/AMPTOOLS_AMPS/Uniform.h | 49 - src/libraries/AMPTOOLS_AMPS/b1piAngAmp.cc | 549 - src/libraries/AMPTOOLS_AMPS/b1piAngAmp.h | 85 - src/libraries/AMPTOOLS_AMPS/barrierFactor.cc | 66 - src/libraries/AMPTOOLS_AMPS/barrierFactor.cuh | 69 - src/libraries/AMPTOOLS_AMPS/barrierFactor.h | 16 - .../AMPTOOLS_AMPS/breakupMomentum.cc | 22 - .../AMPTOOLS_AMPS/breakupMomentum.cuh | 23 - src/libraries/AMPTOOLS_AMPS/breakupMomentum.h | 10 - src/libraries/AMPTOOLS_AMPS/clebschGordan.cc | 193 - src/libraries/AMPTOOLS_AMPS/clebschGordan.h | 9 - .../AMPTOOLS_AMPS/fit_2pi_primakoff.cfg | 88 - .../AMPTOOLS_AMPS/gen_2pi_primakoff.cfg | 78 - src/libraries/AMPTOOLS_AMPS/polCoef.cc | 30 - src/libraries/AMPTOOLS_AMPS/polCoef.h | 54 - src/libraries/AMPTOOLS_AMPS/wignerD.cc | 119 - src/libraries/AMPTOOLS_AMPS/wignerD.h | 14 - .../AMPTOOLS_DATAIO/ASCIIDataWriter.cc | 80 - .../AMPTOOLS_DATAIO/ASCIIDataWriter.h | 39 - .../AMPTOOLS_DATAIO/HDDMDataWriter.cc | 117 - .../AMPTOOLS_DATAIO/HDDMDataWriter.h | 40 - .../OmegaRadiativePlotGenerator.cc | 81 - .../OmegaRadiativePlotGenerator.h | 31 - .../AMPTOOLS_DATAIO/ROOTDataReader.cc | 109 - .../AMPTOOLS_DATAIO/ROOTDataReader.h | 65 - .../ROOTDataReaderBootstrap.cc | 130 - .../AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h | 72 - .../AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.cc | 181 - .../AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h | 66 - .../AMPTOOLS_DATAIO/ROOTDataWriter.cc | 74 - .../AMPTOOLS_DATAIO/ROOTDataWriter.h | 60 - src/libraries/AMPTOOLS_DATAIO/SConscript | 17 - .../AMPTOOLS_DATAIO/ThreePiPlotGenerator.cc | 68 - .../AMPTOOLS_DATAIO/ThreePiPlotGenerator.h | 31 - .../ThreePiPlotGeneratorSchilling.cc | 90 - .../ThreePiPlotGeneratorSchilling.h | 30 - .../AMPTOOLS_DATAIO/TwoPiPlotGenerator.cc | 79 - .../AMPTOOLS_DATAIO/TwoPiPlotGenerator.h | 30 - .../AMPTOOLS_DATAIO/TwoZPiPlotGenerator.cc | 92 - .../AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h | 30 - .../AMPTOOLS_MCGEN/BreitWignerGenerator.cc | 65 - .../AMPTOOLS_MCGEN/BreitWignerGenerator.h | 35 - .../AMPTOOLS_MCGEN/CobremsGeneration.cc | 1178 - .../AMPTOOLS_MCGEN/CobremsGeneration.hh | 309 - .../AMPTOOLS_MCGEN/DalitzDecayFactory.cc | 99 - .../AMPTOOLS_MCGEN/DalitzDecayFactory.h | 32 - .../AMPTOOLS_MCGEN/DecayChannelGenerator.cc | 103 - .../AMPTOOLS_MCGEN/DecayChannelGenerator.h | 32 - .../AMPTOOLS_MCGEN/GammaPToNPartP.cc | 120 - src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.h | 43 - src/libraries/AMPTOOLS_MCGEN/GammaPToXP.cc | 89 - src/libraries/AMPTOOLS_MCGEN/GammaPToXP.h | 42 - src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.cc | 96 - src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.h | 44 - src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.cc | 96 - src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.h | 48 - src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.cc | 101 - src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.h | 45 - .../AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.cc | 124 - .../AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h | 51 - .../AMPTOOLS_MCGEN/ProductionMechanism.cc | 197 - .../AMPTOOLS_MCGEN/ProductionMechanism.h | 62 - .../AMPTOOLS_MCGEN/ResonanceDecayFactory.cc | 73 - .../AMPTOOLS_MCGEN/ResonanceDecayFactory.h | 35 - src/libraries/AMPTOOLS_MCGEN/SConscript | 21 - .../AMPTOOLS_MCGEN/TwoBodyDecayFactory.cc | 61 - .../AMPTOOLS_MCGEN/TwoBodyDecayFactory.h | 30 - src/libraries/DANA/DApplication.cc | 4 +- src/libraries/SConscript | 1 - .../Analysis/B3pi_eff_missgamma/bakSConstruct | 12 +- .../Analysis/B3pi_eff_misspim/bakSConstruct | 12 +- .../Analysis/B3pi_eff_misspip/bakSConstruct | 12 +- .../Analysis/B3pi_eff_missprot/bakSConstruct | 12 +- src/plugins/Analysis/Z2pi_trees/SConstruct | 12 +- .../Z2pi_trees/scripts/Load_DSelector.C | 2 +- src/plugins/Analysis/bcal_shower/SConstruct | 12 +- .../fcal_charged/CalcGainFactors/SConstruct | 12 +- .../fcal_charged/MakeEigensystem/SConstruct | 12 +- src/plugins/Analysis/p2pi_trees/SConstruct | 12 +- .../Calibration/BCAL_ADC_4ns/SConstruct | 14 +- .../Calibration/CDC_TimeToDistance/README.md | 6 +- .../Calibration/FCALpulsepeak/SConstruct | 14 +- src/plugins/SConscript | 2 +- src/plugins/Simulation/SConscript | 11 - .../JEventProcessor_extract_ptype_hddm.cc | 199 - .../JEventProcessor_extract_ptype_hddm.h | 41 - .../Simulation/extract_ptype_hddm/Makefile | 5 - .../Simulation/extract_ptype_hddm/README | 47 - .../hdparsim/DFactoryGeneratorHDParSim.h | 45 - .../hdparsim/DPhoton_factory_HDParSim.cc | 108 - .../hdparsim/DPhoton_factory_HDParSim.h | 35 - .../DTrackTimeBased_factory_HDParSim.cc | 151 - .../DTrackTimeBased_factory_HDParSim.h | 35 - .../hdparsim/DTrackingResolution.cc | 156 - .../Simulation/hdparsim/DTrackingResolution.h | 44 - .../hdparsim/DTrackingResolutionGEANT.cc | 215 - .../hdparsim/DTrackingResolutionGEANT.h | 49 - .../DTrackingResolutionGEANTphoton.cc | 155 - .../hdparsim/DTrackingResolutionGEANTphoton.h | 36 - src/plugins/Simulation/hdparsim/Makefile | 8 - src/plugins/Simulation/hdparsim/getwebfile.c | 151 - src/plugins/Simulation/hdparsim/getwebfile.h | 16 - .../recon2mc/JEventProcessor_recon2mc.cc | 262 - .../recon2mc/JEventProcessor_recon2mc.h | 38 - src/plugins/Simulation/recon2mc/README | 52 - src/plugins/Simulation/recon2mc/SConscript | 14 - .../danaevio/JEventProcessor_danaevio.cc | 2 +- .../AmplitudeAnalysis/Examples/Makefile | 7 - .../Examples/threepi_all/Makefile | 5 - .../Examples/threepi_all/README | 179 - .../Examples/threepi_all/fit_3pi.cfg | 131 - .../Examples/threepi_all/threepi_plotter.cc | 99 - .../Examples/threepi_binned/Makefile | 4 - .../Examples/threepi_binned/README | 221 - .../Examples/threepi_binned/divideData.pl | 89 - .../Examples/threepi_binned/drawWaves.C | 147 - .../Examples/threepi_binned/driveFit.pl | 35 - .../Examples/threepi_binned/plot_3pi.cc | 138 - .../threepi_binned/threepi_pol_TEMPLATE.cfg | 117 - .../threepi_binned/threepi_unpol_TEMPLATE.cfg | 151 - src/programs/AmplitudeAnalysis/Makefile | 3 - src/programs/AmplitudeAnalysis/SConscript | 9 - src/programs/AmplitudeAnalysis/fit/Makefile | 5 - src/programs/AmplitudeAnalysis/fit/SConscript | 21 - src/programs/AmplitudeAnalysis/fit/fit.cc | 130 - .../omega_radiative_plotter/SConscript | 22 - .../omega_radiative_plotter.cc | 257 - .../AmplitudeAnalysis/project_moments/3j.cc | 273 - .../AmplitudeAnalysis/project_moments/3j.h | 39 - .../project_moments/SConscript | 23 - .../project_moments/project_moments.cc | 191 - .../AmplitudeAnalysis/project_moments/wave.cc | 17 - .../AmplitudeAnalysis/project_moments/wave.h | 81 - .../AmplitudeAnalysis/split_mass/Makefile | 5 - .../AmplitudeAnalysis/split_mass/SConscript | 21 - .../split_mass/split_mass.cc | 142 - .../AmplitudeAnalysis/split_t/SConscript | 21 - .../AmplitudeAnalysis/split_t/split_t.cc | 139 - .../threepi_plotter_schilling/SConscript | 22 - .../threepi_plotter_schilling.cc | 259 - .../AmplitudeAnalysis/toy_detector/Makefile | 5 - .../toy_detector/toy_detector.cc | 61 - .../twopi_plotter/SConscript | 21 - .../twopi_plotter/twopi_plotter.cc | 247 - .../twopi_plotter_amp/RootScripts/twopi_amp.C | 568 - .../twopi_plotter_amp/SConscript | 21 - .../twopi_plotter_amp/twopi_plotter_amp.cc | 255 - .../twopi_plotter_mom/SConscript | 21 - .../twopi_plotter_mom/twopi_plotter_mom.cc | 243 - .../twopi_plotter_primakoff/SConscript | 21 - .../twopi_plotter_primakoff.cc | 279 - src/programs/SConscript | 2 +- .../Simulation/BGRate_calc/BGRate_calc.cc | 274 - .../Simulation/BGRate_calc/SConscript | 23 - src/programs/Simulation/HDGeant/GetDOCA.cc | 104 - .../Simulation/HDGeant/HDGeant_tutorial.txt | 163 - src/programs/Simulation/HDGeant/Makefile | 32 - src/programs/Simulation/HDGeant/Makefile.bms | 40 - src/programs/Simulation/HDGeant/README.txt | 117 - src/programs/Simulation/HDGeant/SConscript | 38 - .../Simulation/HDGeant/backgrounds.inc | 23 - src/programs/Simulation/HDGeant/beamgen.F | 277 - src/programs/Simulation/HDGeant/bintree.c | 56 - src/programs/Simulation/HDGeant/bintree.h | 9 - src/programs/Simulation/HDGeant/calibDB.cc | 459 - src/programs/Simulation/HDGeant/calibDB.h | 26 - src/programs/Simulation/HDGeant/cobrems.F | 688 - src/programs/Simulation/HDGeant/cobrems.inc | 16 - src/programs/Simulation/HDGeant/control.in | 441 - .../Simulation/HDGeant/controlparams.h | 22 - .../Simulation/HDGeant/controlparams.inc | 16 - .../Simulation/HDGeant/copytocplusplus.cc | 42 - src/programs/Simulation/HDGeant/dbug.kumac | 52 - .../Simulation/HDGeant/dl_routines.cc | 244 - .../Simulation/HDGeant/dsolenoid.table | 10378 --- src/programs/Simulation/HDGeant/fint.F | 90 - src/programs/Simulation/HDGeant/flukaaf.dat | 4011 - src/programs/Simulation/HDGeant/gdrawp.F | 233 - src/programs/Simulation/HDGeant/geant3.h | 51 - .../Simulation/HDGeant/gelhad/Makefile | 7 - .../Simulation/HDGeant/gelhad/Makefile.orig | 68 - .../Simulation/HDGeant/gelhad/SConscript | 14 - .../Simulation/HDGeant/gelhad/begran.F | 32 - .../Simulation/HDGeant/gelhad/bimsel.F | 427 - .../Simulation/HDGeant/gelhad/caspim.F | 470 - .../Simulation/HDGeant/gelhad/caspip.F | 368 - .../Simulation/HDGeant/gelhad/gamate.F | 25 - .../Simulation/HDGeant/gelhad/gelboost.F | 78 - .../Simulation/HDGeant/gelhad/gelh_last.F | 34 - .../Simulation/HDGeant/gelhad/gelh_outp.F | 110 - .../Simulation/HDGeant/gelhad/gelh_vrfy.F | 41 - .../Simulation/HDGeant/gelhad/gelhad.db | 31 - .../Simulation/HDGeant/gelhad/gelhadused.inc | 15 - .../Simulation/HDGeant/gelhad/geltwobod.F | 70 - .../HDGeant/gelhad/ghcdes/blank.inc | 4 - .../HDGeant/gelhad/ghcdes/blankp.inc | 4 - .../HDGeant/gelhad/ghcdes/consts.inc | 9 - .../HDGeant/gelhad/ghcdes/coscom.inc | 3 - .../HDGeant/gelhad/ghcdes/csdat.inc | 1046 - .../HDGeant/gelhad/ghcdes/csdim.inc | 7 - .../HDGeant/gelhad/ghcdes/curpar.inc | 7 - .../HDGeant/gelhad/ghcdes/defcom.inc | 11 - .../HDGeant/gelhad/ghcdes/errcom.inc | 3 - .../HDGeant/gelhad/ghcdes/event.inc | 4 - .../HDGeant/gelhad/ghcdes/genio.inc | 4 - .../HDGeant/gelhad/ghcdes/kginit.inc | 4 - .../HDGeant/gelhad/ghcdes/limits.inc | 5 - .../HDGeant/gelhad/ghcdes/masses.inc | 31 - .../Simulation/HDGeant/gelhad/ghcdes/mat.inc | 8 - .../HDGeant/gelhad/ghcdes/mxgkgh.inc | 2 - .../HDGeant/gelhad/ghcdes/nucio.inc | 7 - .../HDGeant/gelhad/ghcdes/nuciod.inc | 3 - .../HDGeant/gelhad/ghcdes/pcodat.inc | 20 - .../HDGeant/gelhad/ghcdes/pcodim.inc | 7 - .../HDGeant/gelhad/ghcdes/prntfl.inc | 4 - .../HDGeant/gelhad/ghcdes/result.inc | 8 - .../HDGeant/gelhad/ghcdes/uanal.inc | 16 - .../Simulation/HDGeant/gelhad/gheishp.F | 770 - .../Simulation/HDGeant/gelhad/ghstopp.F | 119 - .../Simulation/HDGeant/gelhad/gmmate.F | 14 - .../Simulation/HDGeant/gelhad/gnbase/Flags.h | 22 - .../HDGeant/gelhad/gnbase/gelhad_db.inc | 11 - .../Simulation/HDGeant/gelhad/gpgheip.F | 60 - .../Simulation/HDGeant/gelhad/gphad.F | 574 - .../Simulation/HDGeant/gelhad/gpsig.F | 51 - .../Simulation/HDGeant/gelhad/grmate.F | 41 - .../Simulation/HDGeant/gelhad/gtgama.F | 485 - .../Simulation/HDGeant/gelhad/labframe.F | 31 - .../Simulation/HDGeant/gelhad/recoilframe.F | 45 - .../Simulation/HDGeant/gelhad/sigmag.F | 98 - .../Simulation/HDGeant/gelhad/sigmagamma.F | 49 - src/programs/Simulation/HDGeant/ggclos.F | 918 - src/programs/Simulation/HDGeant/gid_map.cc | 37 - src/programs/Simulation/HDGeant/gid_map.h | 3 - src/programs/Simulation/HDGeant/gltrac.F | 259 - src/programs/Simulation/HDGeant/goptimize.F | 27 - src/programs/Simulation/HDGeant/gpairg.F | 310 - src/programs/Simulation/HDGeant/gpp/gpp.C | 523 - src/programs/Simulation/HDGeant/gpp/mcfast.f | 3513 - src/programs/Simulation/HDGeant/gpp/mcgeom.f | 983 - .../Simulation/HDGeant/gsrotm.F_obsolete | 231 - src/programs/Simulation/HDGeant/gsstak.F | 140 - src/programs/Simulation/HDGeant/gthion.F | 564 - src/programs/Simulation/HDGeant/gtnext.F | 1001 - src/programs/Simulation/HDGeant/guhadr.F | 133 - src/programs/Simulation/HDGeant/gukine.F | 340 - src/programs/Simulation/HDGeant/guout.F | 97 - src/programs/Simulation/HDGeant/guphad.F | 133 - src/programs/Simulation/HDGeant/gustep.F | 951 - .../Simulation/HDGeant/gustep.F_review2008 | 585 - src/programs/Simulation/HDGeant/guxcs.F | 26 - src/programs/Simulation/HDGeant/gvdcar.F | 420 - src/programs/Simulation/HDGeant/gxcs.F | 123 - src/programs/Simulation/HDGeant/gxint.F | 72 - src/programs/Simulation/HDGeant/gxphys.F | 193 - src/programs/Simulation/HDGeant/hddmInput.c | 577 - src/programs/Simulation/HDGeant/hddmOutput.c | 182 - src/programs/Simulation/HDGeant/hddmOutput.h | 15 - src/programs/Simulation/HDGeant/hdgeant++.cc | 112 - src/programs/Simulation/HDGeant/hdgeant.cc | 150 - src/programs/Simulation/HDGeant/hdgeant_f.F | 35 - .../Simulation/HDGeant/hdtrackparams.inc | 4 - src/programs/Simulation/HDGeant/hitBCal.cc | 717 - src/programs/Simulation/HDGeant/hitCCal.c | 261 - src/programs/Simulation/HDGeant/hitCDC.c | 705 - src/programs/Simulation/HDGeant/hitCerenkov.c | 242 - src/programs/Simulation/HDGeant/hitDIRC.c | 150 - src/programs/Simulation/HDGeant/hitFCal.c | 467 - src/programs/Simulation/HDGeant/hitFDC.c | 1183 - src/programs/Simulation/HDGeant/hitFTOF.c | 572 - src/programs/Simulation/HDGeant/hitGCal.c | 257 - src/programs/Simulation/HDGeant/hitPS.c | 280 - src/programs/Simulation/HDGeant/hitPSC.c | 278 - src/programs/Simulation/HDGeant/hitStart.c | 501 - src/programs/Simulation/HDGeant/hitTPOL.c | 276 - src/programs/Simulation/HDGeant/hitTag.c | 458 - src/programs/Simulation/HDGeant/hitUPV.c | 322 - .../Simulation/HDGeant/hitutil/Makefile | 7 - .../Simulation/HDGeant/hitutil/Makefile.orig | 60 - .../Simulation/HDGeant/hitutil/SConscript | 12 - .../Simulation/HDGeant/hitutil/getcell.F | 6 - .../Simulation/HDGeant/hitutil/getcolumn.F | 6 - .../Simulation/HDGeant/hitutil/getlayer.F | 6 - .../Simulation/HDGeant/hitutil/getmodule.F | 6 - .../Simulation/HDGeant/hitutil/getplane.F | 6 - .../Simulation/HDGeant/hitutil/getring.F | 6 - .../Simulation/HDGeant/hitutil/getrow.F | 6 - .../Simulation/HDGeant/hitutil/getsector.F | 6 - .../Simulation/HDGeant/hitutil/hitutil.F | 53 - src/programs/Simulation/HDGeant/memcheck.c | 156 - src/programs/Simulation/HDGeant/memcheck.h | 3 - src/programs/Simulation/HDGeant/mhdgeant | 299 - src/programs/Simulation/HDGeant/ray.kumac | 50 - src/programs/Simulation/HDGeant/savehits.F | 338 - .../Simulation/HDGeant/savenewvertex.c | 116 - src/programs/Simulation/HDGeant/seteventid.F | 8 - src/programs/Simulation/HDGeant/settofg.F | 92 - src/programs/Simulation/HDGeant/solenoid.map | 10291 --- .../Simulation/HDGeant/storeTrajectory.c | 166 - src/programs/Simulation/HDGeant/timel.c | 195 - src/programs/Simulation/HDGeant/trapfpe.c | 22 - src/programs/Simulation/HDGeant/uginit.F | 476 - src/programs/Simulation/HDGeant/uglast.F | 81 - .../Simulation/HDGeant/utilities/SConscript | 17 - .../Simulation/HDGeant/utilities/bcal2nt.cpp | 146 - .../Simulation/HDGeant/utilities/bcal2nt_c.c | 145 - .../Simulation/HDGeant/utilities/cdccount.cpp | 45 - .../Simulation/HDGeant/utilities/cdccount_c.c | 71 - .../Simulation/HDGeant/utilities/cdcdump.cpp | 60 - .../Simulation/HDGeant/utilities/cdcdump_c.c | 65 - .../Simulation/HDGeant/utilities/hddmcp.cpp | 66 - .../Simulation/HDGeant/utilities/hddmcp_c.c | 53 - src/programs/Simulation/HDGeant/vunit.F | 40 - src/programs/Simulation/HDGeant/wc.f | 100 - src/programs/Simulation/HDGeant/wc.kumac | 581 - src/programs/Simulation/Makefile | 11 - src/programs/Simulation/SConscript | 11 - src/programs/Simulation/bggen/Makefile | 3 - src/programs/Simulation/bggen/README | 170 - src/programs/Simulation/bggen/SConscript | 6 - src/programs/Simulation/bggen/code/Makefile | 29 - src/programs/Simulation/bggen/code/SConscript | 32 - .../Simulation/bggen/code/bg_CFglue.F | 23 - .../Simulation/bggen/code/bg_ctrl.inc | 50 - src/programs/Simulation/bggen/code/bg_end.F | 39 - src/programs/Simulation/bggen/code/bg_eve.F | 146 - .../Simulation/bggen/code/bg_evec.inc | 23 - src/programs/Simulation/bggen/code/bg_hddm.c | 158 - src/programs/Simulation/bggen/code/bg_ini.F | 246 - .../Simulation/bggen/code/bg_ntup_ini.F | 42 - .../Simulation/bggen/code/bg_partc.inc | 14 - .../Simulation/bggen/code/bg_proc.inc | 10 - src/programs/Simulation/bggen/code/bggen.cc | 11 - src/programs/Simulation/bggen/code/bggen_F.F | 94 - src/programs/Simulation/bggen/code/cobrems.F | 674 - .../Simulation/bggen/code/cobrems.inc | 16 - .../Simulation/bggen/code/cohbeam_ini.F | 80 - src/programs/Simulation/bggen/code/gbrwign.F | 38 - src/programs/Simulation/bggen/code/gdecan.F | 227 - src/programs/Simulation/bggen/code/gloren.F | 34 - .../Simulation/bggen/code/gpxcosthr.F | 301 - src/programs/Simulation/bggen/code/gpxsecp.F | 144 - src/programs/Simulation/bggen/code/gpxsect.F | 64 - src/programs/Simulation/bggen/code/grndm.F | 14 - .../Simulation/bggen/code/hbook_ini.F | 18 - .../Simulation/bggen/code/include/amf2com.inc | 2 - .../Simulation/bggen/code/include/bseocom.inc | 4 - .../Simulation/bggen/code/include/cmpcom.inc | 5 - .../Simulation/bggen/code/include/concom.inc | 8 - .../bggen/code/include/deltacom.inc | 2 - .../Simulation/bggen/code/include/density.inc | 14 - .../Simulation/bggen/code/include/double.inc | 1 - .../Simulation/bggen/code/include/gamcom.inc | 8 - .../Simulation/bggen/code/include/intcom.inc | 2 - .../Simulation/bggen/code/include/kincom.inc | 15 - .../Simulation/bggen/code/include/leptou.inc | 9 - .../bggen/code/include/mcRadCor.inc | 46 - .../Simulation/bggen/code/include/mc_set.inc | 52 - .../Simulation/bggen/code/include/mconsp.inc | 17 - .../Simulation/bggen/code/include/phiout.inc | 7 - .../Simulation/bggen/code/include/polcom.inc | 2 - .../Simulation/bggen/code/include/ppicom.inc | 3 - .../Simulation/bggen/code/include/py6int1.inc | 8 - .../Simulation/bggen/code/include/py6pars.inc | 8 - .../Simulation/bggen/code/include/py6strf.inc | 7 - .../Simulation/bggen/code/include/pypars.inc | 4 - .../Simulation/bggen/code/include/radgen.inc | 26 - .../bggen/code/include/radgenkeys.inc | 4 - .../Simulation/bggen/code/include/sxycom.inc | 4 - .../Simulation/bggen/code/include/tailcom.inc | 9 - .../bggen/code/include/xytabcom.inc | 39 - .../Simulation/bggen/code/lowen_eve.F | 291 - .../Simulation/bggen/code/lowen_ini.F | 142 - src/programs/Simulation/bggen/code/omdeca2.F | 133 - src/programs/Simulation/bggen/code/omdeca3.F | 181 - src/programs/Simulation/bggen/code/omrots.F | 85 - src/programs/Simulation/bggen/code/omrotv.F | 41 - src/programs/Simulation/bggen/code/orndpoly.F | 97 - src/programs/Simulation/bggen/code/parp_ini.F | 15 - src/programs/Simulation/bggen/code/pyr.F | 11 - src/programs/Simulation/bggen/code/pyth_eve.F | 58 - src/programs/Simulation/bggen/code/pyth_ini.F | 89 - src/programs/Simulation/bggen/code/pythia_h.F | 62285 ---------------- src/programs/Simulation/bggen/code/rnd_ini.F | 14 - src/programs/Simulation/bggen/code/rndm.F | 11 - src/programs/Simulation/bggen/code/saidcore.F | 2063 - src/programs/Simulation/bggen/code/saide.F | 43 - .../Simulation/bggen/code/saidxseca.F | 62 - src/programs/Simulation/bggen/code/simpsf.F | 46 - src/programs/Simulation/bggen/fix_warnings.py | 153 - src/programs/Simulation/bggen/paw/Makefile | 20 - src/programs/Simulation/bggen/paw/bgg_pri.f | 35 - src/programs/Simulation/bggen/paw/bgg_read.f | 64 - src/programs/Simulation/bggen/paw/bggen.dat | 1 - src/programs/Simulation/bggen/paw/bggen.his | 1 - src/programs/Simulation/bggen/paw/bggen.nt | 1 - src/programs/Simulation/bggen/paw/efm.f | 36 - src/programs/Simulation/bggen/paw/efmass.f | 41 - src/programs/Simulation/bggen/paw/ev_stat.f | 54 - .../Simulation/bggen/paw/example_1.kumac | 48 - src/programs/Simulation/bggen/paw/gloren.f | 34 - src/programs/Simulation/bggen/paw/last.kumac | 182 - src/programs/Simulation/bggen/paw/p_kin.f | 105 - .../Simulation/bggen/paw/p_kin_auto.f | 93 - src/programs/Simulation/bggen/paw/part_kin.f | 67 - src/programs/Simulation/bggen/paw/pi_plot.f | 204 - .../bggen/paw/plot_pi0_photons.kumac | 145 - src/programs/Simulation/bggen/run/fort.15 | 1 - .../Simulation/bggen/run/particle.dat | 21 - .../Simulation/bggen/run/pythia-geant.map | 41 - src/programs/Simulation/bggen/run/pythia.dat | 52 - src/programs/Simulation/bggen/run/run.ffr | 25 - src/programs/Simulation/bggen_jpsi/Makefile | 3 - src/programs/Simulation/bggen_jpsi/README | 170 - src/programs/Simulation/bggen_jpsi/SConscript | 8 - .../Simulation/bggen_jpsi/code/Makefile | 29 - .../Simulation/bggen_jpsi/code/SConscript | 32 - .../Simulation/bggen_jpsi/code/bg_CFglue.F | 23 - .../Simulation/bggen_jpsi/code/bg_ctrl.inc | 51 - .../Simulation/bggen_jpsi/code/bg_end.F | 39 - .../Simulation/bggen_jpsi/code/bg_eve.F | 154 - .../Simulation/bggen_jpsi/code/bg_evec.inc | 23 - .../Simulation/bggen_jpsi/code/bg_hddm.c | 158 - .../Simulation/bggen_jpsi/code/bg_ini.F | 299 - .../Simulation/bggen_jpsi/code/bg_ntup_ini.F | 42 - .../Simulation/bggen_jpsi/code/bg_partc.inc | 16 - .../Simulation/bggen_jpsi/code/bg_proc.inc | 10 - .../Simulation/bggen_jpsi/code/bg_reac.inc | 15 - .../Simulation/bggen_jpsi/code/bggen.cc | 11 - .../Simulation/bggen_jpsi/code/bggen_F.F | 94 - .../Simulation/bggen_jpsi/code/cobrems.F | 621 - .../Simulation/bggen_jpsi/code/cobrems.inc | 15 - .../Simulation/bggen_jpsi/code/cohbeam_ini.F | 84 - .../Simulation/bggen_jpsi/code/gbrwign.F | 38 - .../Simulation/bggen_jpsi/code/gdecan.F | 227 - .../Simulation/bggen_jpsi/code/getxsec.F | 23 - .../Simulation/bggen_jpsi/code/gloren.F | 34 - .../Simulation/bggen_jpsi/code/gpxcosthr.F | 301 - .../Simulation/bggen_jpsi/code/gpxsecp.F | 144 - .../Simulation/bggen_jpsi/code/gpxsect.F | 64 - .../Simulation/bggen_jpsi/code/grndm.F | 14 - .../Simulation/bggen_jpsi/code/hbook_ini.F | 20 - .../bggen_jpsi/code/include/amf2com.inc | 2 - .../bggen_jpsi/code/include/bseocom.inc | 4 - .../bggen_jpsi/code/include/cmpcom.inc | 5 - .../bggen_jpsi/code/include/concom.inc | 8 - .../bggen_jpsi/code/include/deltacom.inc | 2 - .../bggen_jpsi/code/include/density.inc | 14 - .../bggen_jpsi/code/include/double.inc | 1 - .../bggen_jpsi/code/include/gamcom.inc | 8 - .../bggen_jpsi/code/include/intcom.inc | 2 - .../bggen_jpsi/code/include/kincom.inc | 15 - .../bggen_jpsi/code/include/leptou.inc | 9 - .../bggen_jpsi/code/include/mcRadCor.inc | 46 - .../bggen_jpsi/code/include/mc_set.inc | 52 - .../bggen_jpsi/code/include/mconsp.inc | 17 - .../bggen_jpsi/code/include/phiout.inc | 7 - .../bggen_jpsi/code/include/polcom.inc | 2 - .../bggen_jpsi/code/include/ppicom.inc | 3 - .../bggen_jpsi/code/include/py6int1.inc | 8 - .../bggen_jpsi/code/include/py6pars.inc | 8 - .../bggen_jpsi/code/include/py6strf.inc | 7 - .../bggen_jpsi/code/include/pypars.inc | 4 - .../bggen_jpsi/code/include/radgen.inc | 26 - .../bggen_jpsi/code/include/radgenkeys.inc | 4 - .../bggen_jpsi/code/include/sxycom.inc | 4 - .../bggen_jpsi/code/include/tailcom.inc | 9 - .../bggen_jpsi/code/include/xytabcom.inc | 39 - .../Simulation/bggen_jpsi/code/lowen_eve.F | 291 - .../Simulation/bggen_jpsi/code/lowen_ini.F | 142 - .../Simulation/bggen_jpsi/code/omdeca2.F | 133 - .../Simulation/bggen_jpsi/code/omdeca3.F | 181 - .../Simulation/bggen_jpsi/code/omrots.F | 85 - .../Simulation/bggen_jpsi/code/omrotv.F | 41 - .../Simulation/bggen_jpsi/code/orndpoly.F | 97 - .../Simulation/bggen_jpsi/code/parp_ini.F | 14 - src/programs/Simulation/bggen_jpsi/code/pyr.F | 11 - .../Simulation/bggen_jpsi/code/pyth_eve.F | 58 - .../Simulation/bggen_jpsi/code/pyth_ini.F | 89 - .../Simulation/bggen_jpsi/code/pythia_h.F | 62285 ---------------- .../Simulation/bggen_jpsi/code/reac_eve.F | 221 - .../Simulation/bggen_jpsi/code/rnd_ini.F | 14 - .../Simulation/bggen_jpsi/code/rndm.F | 11 - .../Simulation/bggen_jpsi/code/saidcore.F | 2062 - .../Simulation/bggen_jpsi/code/saide.F | 43 - .../Simulation/bggen_jpsi/code/saidxseca.F | 62 - .../Simulation/bggen_jpsi/code/simpsf.F | 46 - .../Simulation/bggen_jpsi/fix_warnings.py | 153 - .../Simulation/bggen_jpsi/paw/Makefile | 20 - .../Simulation/bggen_jpsi/paw/bgg_pri.f | 35 - .../Simulation/bggen_jpsi/paw/bgg_read.f | 64 - src/programs/Simulation/bggen_jpsi/paw/efm.f | 36 - .../Simulation/bggen_jpsi/paw/ev_stat.f | 54 - .../Simulation/bggen_jpsi/paw/example_1.kumac | 48 - .../Simulation/bggen_jpsi/paw/gloren.f | 34 - .../Simulation/bggen_jpsi/paw/last.kumac | 182 - .../Simulation/bggen_jpsi/paw/p_kin.f | 105 - .../Simulation/bggen_jpsi/paw/p_kin_auto.f | 93 - .../Simulation/bggen_jpsi/paw/part_kin.f | 67 - .../Simulation/bggen_jpsi/paw/pi_plot.f | 204 - .../bggen_jpsi/paw/plot_pi0_photons.kumac | 141 - .../Simulation/bggen_jpsi/run/fort.15 | 25 - .../Simulation/bggen_jpsi/run/particle.dat | 21 - .../bggen_jpsi/run/pythia-geant.map | 41 - .../Simulation/bggen_jpsi/run/pythia.dat | 52 - .../Simulation/bggen_jpsi/run/run.ffr | 25 - .../Simulation/bggen_jpsi/run/run_jpsi.ffr | 78 - .../bggen_jpsi/xsec_table/SConscript | 25 - .../bggen_jpsi/xsec_table/xsec_jpsi.F | 100 - .../bggen_jpsi/xsec_table/xsec_jpsi.o | Bin 4008 -> 0 bytes .../bggen_jpsi/xsec_table/xsec_pri.cc | 11 - .../bggen_jpsi/xsec_table/xsec_pri.o | Bin 1352 -> 0 bytes .../bggen_jpsi/xsec_table/xsec_pri_F.F | 55 - .../bggen_jpsi/xsec_table/xsec_pri_F.o | Bin 5024 -> 0 bytes .../bggen_jpsi/xsec_table/xsec_table | Bin 15886 -> 0 bytes src/programs/Simulation/filtergen/Makefile | 6 - src/programs/Simulation/filtergen/filter.cc | 77 - .../Simulation/filtergen/filtergen.cc | 176 - src/programs/Simulation/genEtaRegge/README | 30 - .../Simulation/genEtaRegge/SConscript | 14 - src/programs/Simulation/genEtaRegge/eta548.in | 15 - src/programs/Simulation/genEtaRegge/eta958.in | 12 - .../Simulation/genEtaRegge/genEtaRegge.cc | 663 - src/programs/Simulation/gen_2k/SConscript | 22 - .../Simulation/gen_2k/fit_2k-template.cfg | 82 - src/programs/Simulation/gen_2k/gen_2k.cc | 310 - src/programs/Simulation/gen_2k/gen_2k.cfg | 53 - .../Simulation/gen_2k/gen_2k_flat.cfg | 52 - .../Simulation/gen_2mu/CobremsGenerator.cc | 1153 - .../Simulation/gen_2mu/CobremsGenerator.hh | 292 - .../gen_2mu/GlueXPrimaryGeneratorAction.cc | 1011 - .../gen_2mu/GlueXPrimaryGeneratorAction.hh | 196 - src/programs/Simulation/gen_2mu/SConscript | 17 - .../Simulation/gen_2mu/expint_spline.cc | 36 - src/programs/Simulation/gen_2mu/gen_2mu.cc | 816 - src/programs/Simulation/gen_2pi/SConscript | 22 - src/programs/Simulation/gen_2pi/gen_2pi.cc | 310 - src/programs/Simulation/gen_2pi/gen_2pi.cfg | 53 - src/programs/Simulation/gen_2pi_amp/README | 24 - .../Simulation/gen_2pi_amp/SConscript | 22 - .../Simulation/gen_2pi_amp/fit_2pi_amp.cfg | 212 - .../Simulation/gen_2pi_amp/gen_2pi_amp.cc | 329 - .../Simulation/gen_2pi_amp/gen_2pi_amp.cfg | 208 - .../Simulation/gen_2pi_amp/gen_2pi_mom.cfg | 99 - .../Simulation/gen_2pi_primakoff/SConscript | 22 - .../gen_2pi_primakoff/gen_2pi_primakoff.cc | 339 - .../gen_2pi_primakoff/gen_2pi_primakoff.cfg | 73 - src/programs/Simulation/gen_3pi/Makefile | 6 - src/programs/Simulation/gen_3pi/SConscript | 21 - src/programs/Simulation/gen_3pi/gen_3pi.cc | 284 - src/programs/Simulation/gen_3pi/gen_3pi.cfg | 125 - .../Simulation/gen_3pi/gen_3pi_ypol.cfg | 33 - src/programs/Simulation/gen_5pi/Makefile | 7 - .../Simulation/gen_5pi/b1piAmpCheck.cc | 111 - .../Simulation/gen_5pi/b1piAmpCheck.h | 83 - src/programs/Simulation/gen_5pi/gen_5pi.cc | 407 - src/programs/Simulation/gen_amp/SConscript | 22 - src/programs/Simulation/gen_amp/gen_2k.cfg | 55 - .../Simulation/gen_amp/gen_2pi_amp.cfg | 208 - .../Simulation/gen_amp/gen_2pi_mom.cfg | 99 - src/programs/Simulation/gen_amp/gen_3pi.cfg | 125 - src/programs/Simulation/gen_amp/gen_amp.cc | 397 - src/programs/Simulation/gen_amp/gen_b1.cfg | 89 - .../Simulation/gen_amp/gen_b1_pigamma.cfg | 89 - .../Simulation/gen_amp/gen_etapi0_2body.cfg | 57 - .../Simulation/gen_amp/gen_omega_3pi.cfg | 57 - .../Simulation/gen_amp/gen_omega_3pi_flat.cfg | 54 - .../gen_amp/gen_omega_radiative_flat.cfg | 55 - src/programs/Simulation/gen_ee/SConscript | 6 - src/programs/Simulation/gen_ee/code/HddmOut.h | 154 - .../Simulation/gen_ee/code/SConscript | 13 - .../Simulation/gen_ee/code/devilTreePT.h | 59 - src/programs/Simulation/gen_ee/code/gen_ee.cc | 522 - .../Simulation/gen_ee/code/qDevilLib.cc | 1614 - .../Simulation/gen_ee/code/qDevilLib.h | 214 - .../Simulation/gen_ee_hb/HallBTCS/GPDs.cc | 289 - .../Simulation/gen_ee_hb/HallBTCS/GPDs.hh | 64 - .../Simulation/gen_ee_hb/HallBTCS/GenTCS.cc | 267 - .../Simulation/gen_ee_hb/HallBTCS/HddmOut.h | 155 - .../Simulation/gen_ee_hb/HallBTCS/SConscript | 13 - .../Simulation/gen_ee_hb/HallBTCS/TTCS_crs.cc | 303 - .../Simulation/gen_ee_hb/HallBTCS/TTCS_crs.hh | 54 - .../gen_ee_hb/HallBTCS/TTCS_kine.cc | 171 - .../gen_ee_hb/HallBTCS/TTCS_kine.hh | 75 - .../gen_ee_hb/HallBTCS/kin_funcs.cc | 34 - .../Simulation/gen_ee_hb/HallBTCS/kin_funcs.h | 10 - src/programs/Simulation/gen_ee_hb/SConscript | 6 - .../gen_ee_hb/run/CFFs_DD_Feb2012.dat | 2755 - .../Simulation/gen_omega_3pi/SConscript | 22 - .../Simulation/gen_omega_3pi/gen_omega_3pi.cc | 318 - .../gen_omega_3pi/gen_omega_3pi.cfg | 52 - .../gen_omega_3pi/gen_omega_3pi_flat.cfg | 51 - .../Simulation/gen_omega_radiative/SConscript | 22 - .../gen_omega_radiative/gen_omega_3pi.cfg | 52 - .../gen_omega_radiative.cc | 311 - .../gen_omega_radiative_flat.cfg | 51 - src/programs/Simulation/gen_pi0/SConscript | 22 - src/programs/Simulation/gen_pi0/gen_pi0.cc | 235 - src/programs/Simulation/gen_pi0/saidPWA.cfg | 50 - src/programs/Simulation/gen_pi0/vmRegge.cfg | 51 - src/programs/Simulation/geneta/Makefile | 24 - src/programs/Simulation/geneta/README | 15 - src/programs/Simulation/geneta/bg_hddm.cc | 237 - src/programs/Simulation/geneta/bg_hddm.h | 54 - src/programs/Simulation/geneta/c_cern.c | 9 - src/programs/Simulation/geneta/c_cern.h | 46 - src/programs/Simulation/geneta/cr_prt.F | 105 - src/programs/Simulation/geneta/eta_p_gen.dat | 67 - src/programs/Simulation/geneta/eta_prot_kin.F | 169 - src/programs/Simulation/geneta/eta_proton.F | 1045 - src/programs/Simulation/geneta/geneta.cc | 168 - src/programs/Simulation/geneta/kin_eta.F | 151 - src/programs/Simulation/genp_pi0/Makefile | 7 - src/programs/Simulation/genp_pi0/bg_hddm.cc | 132 - src/programs/Simulation/genp_pi0/bg_hddm.h | 23 - src/programs/Simulation/genp_pi0/cern.h | 268 - src/programs/Simulation/genp_pi0/genp_pi0.cc | 1368 - src/programs/Simulation/genp_pi0/kinematics.c | 185 - src/programs/Simulation/genp_pi0/kinematics.h | 62 - src/programs/Simulation/genphoton/Makefile | 5 - src/programs/Simulation/genphoton/SConscript | 12 - .../Simulation/genphoton/genphoton.cc | 220 - src/programs/Simulation/genpi/Makefile | 5 - src/programs/Simulation/genpi/SConscript | 35 - src/programs/Simulation/genpi/complex.h | 26 - src/programs/Simulation/genpi/genmu+mu-.cc | 227 - src/programs/Simulation/genpi/genpi+pi-.cc | 298 - src/programs/Simulation/genpi/genpi.cc | 214 - src/programs/Simulation/genpi/genpi0.cc | 280 - src/programs/Simulation/genpi/nr.h | 527 - src/programs/Simulation/genpi/nrutil.c | 293 - src/programs/Simulation/genpi/nrutil.h | 91 - src/programs/Simulation/genpi/rtnewt.c | 23 - src/programs/Simulation/genpi/rtsafe.c | 53 - src/programs/Simulation/genpi/zbrent.c | 72 - .../genr8/InputFiles/KstarKstar.input | 91 - .../Simulation/genr8/InputFiles/b1_pi.input | 130 - .../Simulation/genr8/InputFiles/eta1_p.input | 105 - .../Simulation/genr8/InputFiles/n_3pi.input | 104 - .../genr8/InputFiles/n_eta_pi+pi-pi+.input | 107 - .../genr8/InputFiles/n_omega_pi+.input | 109 - .../genr8/InputFiles/n_omega_pi0_pi+.input | 112 - .../genr8/InputFiles/omegadelta2.input | 107 - .../genr8/InputFiles/pKstarKstar.input | 47 - .../genr8/InputFiles/p_K-pi+pi-K+.input | 104 - .../genr8/InputFiles/p_eta_pi0pi0.input | 110 - .../genr8/InputFiles/p_pi+pi-pi0.input | 105 - .../genr8/InputFiles/pk+k-pi+pi-.input | 43 - .../Simulation/genr8/InputFiles/rho.input | 85 - .../Simulation/genr8/InputFiles/rhop.input | 43 - src/programs/Simulation/genr8/Makefile | 6 - src/programs/Simulation/genr8/Makefile.orig | 33 - src/programs/Simulation/genr8/SConscript | 13 - src/programs/Simulation/genr8/genkin.c | 339 - src/programs/Simulation/genr8/genkin.h | 93 - src/programs/Simulation/genr8/genr8.c | 1316 - src/programs/Simulation/genr8_2_hddm/Makefile | 7 - .../Simulation/genr8_2_hddm/SConscript | 13 - .../Simulation/genr8_2_hddm/genr8_2_hddm.cc | 385 - src/programs/Simulation/gxtwist/Makefile | 19 - src/programs/Simulation/gxtwist/Makefile.bms | 12 - src/programs/Simulation/gxtwist/README.txt | 86 - src/programs/Simulation/gxtwist/beamgen.F | 227 - src/programs/Simulation/gxtwist/bfld.f | 11 - src/programs/Simulation/gxtwist/bfld.sl | Bin 493779 -> 0 bytes src/programs/Simulation/gxtwist/bintree.c | 56 - src/programs/Simulation/gxtwist/bintree.h | 9 - src/programs/Simulation/gxtwist/cobrems.F | 674 - src/programs/Simulation/gxtwist/cobrems.inc | 16 - src/programs/Simulation/gxtwist/control.in | 209 - src/programs/Simulation/gxtwist/dbug.kumac | 52 - src/programs/Simulation/gxtwist/geant3.h | 29 - src/programs/Simulation/gxtwist/getwebfile.c | 124 - src/programs/Simulation/gxtwist/gltrac.F | 241 - src/programs/Simulation/gxtwist/goptimize.F | 27 - src/programs/Simulation/gxtwist/gpairg.F | 328 - src/programs/Simulation/gxtwist/gsstak.F | 138 - src/programs/Simulation/gxtwist/guhadr.F | 136 - src/programs/Simulation/gxtwist/gukine.F | 168 - src/programs/Simulation/gxtwist/guout.F | 40 - src/programs/Simulation/gxtwist/guphad.F | 136 - src/programs/Simulation/gxtwist/gustep.F | 252 - src/programs/Simulation/gxtwist/guxcs.F | 29 - src/programs/Simulation/gxtwist/gxcs.F | 126 - src/programs/Simulation/gxtwist/gxint.F | 75 - src/programs/Simulation/gxtwist/gxphys.F | 196 - src/programs/Simulation/gxtwist/gxtwist++.cc | 11 - src/programs/Simulation/gxtwist/gxtwist.cc | 14 - src/programs/Simulation/gxtwist/gxtwist_f.F | 29 - src/programs/Simulation/gxtwist/halo.F | 69 - src/programs/Simulation/gxtwist/halo.inc | 4 - src/programs/Simulation/gxtwist/hddmInput.c | 271 - src/programs/Simulation/gxtwist/hddmOutput.c | 98 - src/programs/Simulation/gxtwist/hddmOutput.h | 10 - src/programs/Simulation/gxtwist/hddm_s.c | 1157 - src/programs/Simulation/gxtwist/hddm_s.h | 234 - .../Simulation/gxtwist/hdds/ElectronDump.xml | 343 - .../Simulation/gxtwist/hdds/FocalPlane.xml | 886 - .../Simulation/gxtwist/hdds/HDDS-1_1.xsd | 2673 - src/programs/Simulation/gxtwist/hdds/Makefile | 23 - .../Simulation/gxtwist/hdds/Materials.xml | 839 - .../Simulation/gxtwist/hdds/Regions.xml | 73 - .../Simulation/gxtwist/hdds/Spectrometer.xml | 238 - .../Simulation/gxtwist/hdds/TaggerArea.xml | 277 - .../Simulation/gxtwist/hdtrackparams.inc | 4 - src/programs/Simulation/gxtwist/memcheck.c | 156 - src/programs/Simulation/gxtwist/memcheck.h | 3 - src/programs/Simulation/gxtwist/nt.inc | 27 - src/programs/Simulation/gxtwist/ray.kumac | 50 - src/programs/Simulation/gxtwist/seer.kumac | 94 - .../Simulation/gxtwist/taggerCoords.txt | 52 - .../Simulation/gxtwist/taggerCoords2.txt | 57 - .../Simulation/gxtwist/taggerCoords2.xls | Bin 48640 -> 0 bytes .../Simulation/gxtwist/tagger_building.ppt | Bin 282110 -> 0 bytes src/programs/Simulation/gxtwist/trapfpe.c | 22 - src/programs/Simulation/gxtwist/uginit.F | 200 - src/programs/Simulation/gxtwist/uglast.F | 33 - src/programs/Simulation/gxtwist/wc.f | 89 - src/programs/Simulation/gxtwist/wc.kumac | 575 - .../Simulation/mcsmear/BCALSmearer.cc | 896 - src/programs/Simulation/mcsmear/BCALSmearer.h | 322 - .../Simulation/mcsmear/CCALSmearer.cc | 72 - src/programs/Simulation/mcsmear/CCALSmearer.h | 48 - src/programs/Simulation/mcsmear/CDCSmearer.cc | 191 - src/programs/Simulation/mcsmear/CDCSmearer.h | 52 - src/programs/Simulation/mcsmear/DRandom2.h | 150 - .../Simulation/mcsmear/FCALSmearer.cc | 161 - src/programs/Simulation/mcsmear/FCALSmearer.h | 55 - src/programs/Simulation/mcsmear/FDCSmearer.cc | 143 - src/programs/Simulation/mcsmear/FDCSmearer.h | 72 - .../Simulation/mcsmear/FDIRCSmearer.cc | 9 - .../Simulation/mcsmear/FDIRCSmearer.h | 29 - .../Simulation/mcsmear/FMWPCSmearer.cc | 45 - .../Simulation/mcsmear/FMWPCSmearer.h | 40 - .../JFactoryGenerator_ThreadCancelHandler.h | 41 - src/programs/Simulation/mcsmear/Makefile | 7 - .../Simulation/mcsmear/MyProcessor.cc | 400 - src/programs/Simulation/mcsmear/MyProcessor.h | 53 - src/programs/Simulation/mcsmear/PSCSmearer.cc | 46 - src/programs/Simulation/mcsmear/PSCSmearer.h | 39 - src/programs/Simulation/mcsmear/PSSmearer.cc | 44 - src/programs/Simulation/mcsmear/PSSmearer.h | 38 - src/programs/Simulation/mcsmear/SCSmearer.cc | 153 - src/programs/Simulation/mcsmear/SCSmearer.h | 84 - src/programs/Simulation/mcsmear/SConscript | 14 - src/programs/Simulation/mcsmear/Smearer.h | 28 - .../Simulation/mcsmear/TAGHSmearer.cc | 48 - src/programs/Simulation/mcsmear/TAGHSmearer.h | 40 - .../Simulation/mcsmear/TAGMSmearer.cc | 43 - src/programs/Simulation/mcsmear/TAGMSmearer.h | 39 - src/programs/Simulation/mcsmear/TOFSmearer.cc | 101 - src/programs/Simulation/mcsmear/TOFSmearer.h | 59 - .../Simulation/mcsmear/TPOLSmearer.cc | 46 - src/programs/Simulation/mcsmear/TPOLSmearer.h | 39 - .../Simulation/mcsmear/hddm_s_merger.cc | 2234 - .../Simulation/mcsmear/hddm_s_merger.h | 233 - src/programs/Simulation/mcsmear/mcsmear.cc | 245 - .../Simulation/mcsmear/mcsmear_config.cc | 260 - .../Simulation/mcsmear/mcsmear_config.h | 66 - src/programs/Simulation/mcsmear/smear.cc | 188 - src/programs/Simulation/mcsmear/smear.h | 55 - src/programs/Simulation/nullgen/SConscript | 13 - src/programs/Simulation/nullgen/nullgen.cc | 86 - .../Simulation/stdhep_translators/README | 26 - .../Simulation/stdhep_translators/SConscript | 15 - .../stdhep_translators/ascii2stdhep.c | 553 - .../stdhep_translators/stdhep2ascii.c | 479 - .../stdhep_translators/stdhep2hddm.c | 364 - .../Utilities/analysis/MakeReactionPlugin.pl | 14 +- src/programs/Utilities/hddm/hddm-py.cpp | 6 +- src/programs/Utilities/hddm/mk_xml.pl | 6 +- src/programs/Utilities/hddm2root/hddm2root.cc | 6 +- .../mkfactory_plugin/mkfactory_plugin | 2 +- src/programs/Utilities/mkplugin/mkplugin | 10 +- 814 files changed, 120 insertions(+), 262313 deletions(-) delete mode 100644 src/libraries/AMPTOOLS_AMPS/BreitWigner.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/BreitWigner.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/BreitWigner3body.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/BreitWigner3body.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUBreitWigner_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUThreePiAngles_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUTwoPSAngles_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUUniform_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUb1piAngAmp_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/GPUpolCoef_kernel.cu delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0Regge.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0Regge.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0SAID.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/Pi0SAID.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/SConscript delete mode 100644 src/libraries/AMPTOOLS_AMPS/ThreePiAngles.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/ThreePiAngles.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPSAngles.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPSAngles.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/Uniform.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/Uniform.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/b1piAngAmp.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/b1piAngAmp.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/barrierFactor.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/barrierFactor.cuh delete mode 100644 src/libraries/AMPTOOLS_AMPS/barrierFactor.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/breakupMomentum.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/breakupMomentum.cuh delete mode 100644 src/libraries/AMPTOOLS_AMPS/breakupMomentum.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/clebschGordan.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/clebschGordan.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/fit_2pi_primakoff.cfg delete mode 100644 src/libraries/AMPTOOLS_AMPS/gen_2pi_primakoff.cfg delete mode 100644 src/libraries/AMPTOOLS_AMPS/polCoef.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/polCoef.h delete mode 100644 src/libraries/AMPTOOLS_AMPS/wignerD.cc delete mode 100644 src/libraries/AMPTOOLS_AMPS/wignerD.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/SConscript delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.h delete mode 100644 src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.hh delete mode 100644 src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXP.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXP.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.h delete mode 100644 src/libraries/AMPTOOLS_MCGEN/SConscript delete mode 100644 src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.cc delete mode 100644 src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.h delete mode 100644 src/plugins/Simulation/SConscript delete mode 100644 src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.cc delete mode 100644 src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.h delete mode 100644 src/plugins/Simulation/extract_ptype_hddm/Makefile delete mode 100644 src/plugins/Simulation/extract_ptype_hddm/README delete mode 100644 src/plugins/Simulation/hdparsim/DFactoryGeneratorHDParSim.h delete mode 100644 src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.cc delete mode 100644 src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.h delete mode 100644 src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.cc delete mode 100644 src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.h delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolution.cc delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolution.h delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.cc delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.h delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.cc delete mode 100644 src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.h delete mode 100644 src/plugins/Simulation/hdparsim/Makefile delete mode 100644 src/plugins/Simulation/hdparsim/getwebfile.c delete mode 100644 src/plugins/Simulation/hdparsim/getwebfile.h delete mode 100644 src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.cc delete mode 100644 src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.h delete mode 100644 src/plugins/Simulation/recon2mc/README delete mode 100644 src/plugins/Simulation/recon2mc/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/Examples/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_all/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_all/README delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_all/fit_3pi.cfg delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_all/threepi_plotter.cc delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/README delete mode 100755 src/programs/AmplitudeAnalysis/Examples/threepi_binned/divideData.pl delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/drawWaves.C delete mode 100755 src/programs/AmplitudeAnalysis/Examples/threepi_binned/driveFit.pl delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/plot_3pi.cc delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_pol_TEMPLATE.cfg delete mode 100644 src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_unpol_TEMPLATE.cfg delete mode 100644 src/programs/AmplitudeAnalysis/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/fit/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/fit/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/fit/fit.cc delete mode 100644 src/programs/AmplitudeAnalysis/omega_radiative_plotter/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/omega_radiative_plotter/omega_radiative_plotter.cc delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/3j.cc delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/3j.h delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/project_moments.cc delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/wave.cc delete mode 100644 src/programs/AmplitudeAnalysis/project_moments/wave.h delete mode 100644 src/programs/AmplitudeAnalysis/split_mass/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/split_mass/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/split_mass/split_mass.cc delete mode 100644 src/programs/AmplitudeAnalysis/split_t/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/split_t/split_t.cc delete mode 100644 src/programs/AmplitudeAnalysis/threepi_plotter_schilling/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/threepi_plotter_schilling/threepi_plotter_schilling.cc delete mode 100644 src/programs/AmplitudeAnalysis/toy_detector/Makefile delete mode 100644 src/programs/AmplitudeAnalysis/toy_detector/toy_detector.cc delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter/twopi_plotter.cc delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_amp/RootScripts/twopi_amp.C delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_amp/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_amp/twopi_plotter_amp.cc delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_mom/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_mom/twopi_plotter_mom.cc delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/SConscript delete mode 100644 src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/twopi_plotter_primakoff.cc delete mode 100644 src/programs/Simulation/BGRate_calc/BGRate_calc.cc delete mode 100644 src/programs/Simulation/BGRate_calc/SConscript delete mode 100644 src/programs/Simulation/HDGeant/GetDOCA.cc delete mode 100644 src/programs/Simulation/HDGeant/HDGeant_tutorial.txt delete mode 100644 src/programs/Simulation/HDGeant/Makefile delete mode 100644 src/programs/Simulation/HDGeant/Makefile.bms delete mode 100644 src/programs/Simulation/HDGeant/README.txt delete mode 100644 src/programs/Simulation/HDGeant/SConscript delete mode 100644 src/programs/Simulation/HDGeant/backgrounds.inc delete mode 100644 src/programs/Simulation/HDGeant/beamgen.F delete mode 100644 src/programs/Simulation/HDGeant/bintree.c delete mode 100644 src/programs/Simulation/HDGeant/bintree.h delete mode 100644 src/programs/Simulation/HDGeant/calibDB.cc delete mode 100644 src/programs/Simulation/HDGeant/calibDB.h delete mode 100644 src/programs/Simulation/HDGeant/cobrems.F delete mode 100644 src/programs/Simulation/HDGeant/cobrems.inc delete mode 100644 src/programs/Simulation/HDGeant/control.in delete mode 100644 src/programs/Simulation/HDGeant/controlparams.h delete mode 100644 src/programs/Simulation/HDGeant/controlparams.inc delete mode 100644 src/programs/Simulation/HDGeant/copytocplusplus.cc delete mode 100644 src/programs/Simulation/HDGeant/dbug.kumac delete mode 100644 src/programs/Simulation/HDGeant/dl_routines.cc delete mode 100644 src/programs/Simulation/HDGeant/dsolenoid.table delete mode 100644 src/programs/Simulation/HDGeant/fint.F delete mode 100644 src/programs/Simulation/HDGeant/flukaaf.dat delete mode 100644 src/programs/Simulation/HDGeant/gdrawp.F delete mode 100644 src/programs/Simulation/HDGeant/geant3.h delete mode 100644 src/programs/Simulation/HDGeant/gelhad/Makefile delete mode 100644 src/programs/Simulation/HDGeant/gelhad/Makefile.orig delete mode 100644 src/programs/Simulation/HDGeant/gelhad/SConscript delete mode 100644 src/programs/Simulation/HDGeant/gelhad/begran.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/bimsel.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/caspim.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/caspip.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gamate.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelboost.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelh_last.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelh_outp.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelh_vrfy.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelhad.db delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gelhadused.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/geltwobod.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/blank.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/blankp.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/consts.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/coscom.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/csdat.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/csdim.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/curpar.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/defcom.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/errcom.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/event.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/genio.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/kginit.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/limits.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/masses.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/mat.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/mxgkgh.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/nucio.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/nuciod.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodat.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodim.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/prntfl.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/result.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghcdes/uanal.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gheishp.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/ghstopp.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gmmate.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gnbase/Flags.h delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gnbase/gelhad_db.inc delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gpgheip.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gphad.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gpsig.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/grmate.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/gtgama.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/labframe.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/recoilframe.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/sigmag.F delete mode 100644 src/programs/Simulation/HDGeant/gelhad/sigmagamma.F delete mode 100644 src/programs/Simulation/HDGeant/ggclos.F delete mode 100644 src/programs/Simulation/HDGeant/gid_map.cc delete mode 100644 src/programs/Simulation/HDGeant/gid_map.h delete mode 100644 src/programs/Simulation/HDGeant/gltrac.F delete mode 100644 src/programs/Simulation/HDGeant/goptimize.F delete mode 100644 src/programs/Simulation/HDGeant/gpairg.F delete mode 100644 src/programs/Simulation/HDGeant/gpp/gpp.C delete mode 100644 src/programs/Simulation/HDGeant/gpp/mcfast.f delete mode 100644 src/programs/Simulation/HDGeant/gpp/mcgeom.f delete mode 100644 src/programs/Simulation/HDGeant/gsrotm.F_obsolete delete mode 100644 src/programs/Simulation/HDGeant/gsstak.F delete mode 100644 src/programs/Simulation/HDGeant/gthion.F delete mode 100644 src/programs/Simulation/HDGeant/gtnext.F delete mode 100644 src/programs/Simulation/HDGeant/guhadr.F delete mode 100644 src/programs/Simulation/HDGeant/gukine.F delete mode 100644 src/programs/Simulation/HDGeant/guout.F delete mode 100644 src/programs/Simulation/HDGeant/guphad.F delete mode 100644 src/programs/Simulation/HDGeant/gustep.F delete mode 100644 src/programs/Simulation/HDGeant/gustep.F_review2008 delete mode 100644 src/programs/Simulation/HDGeant/guxcs.F delete mode 100644 src/programs/Simulation/HDGeant/gvdcar.F delete mode 100644 src/programs/Simulation/HDGeant/gxcs.F delete mode 100644 src/programs/Simulation/HDGeant/gxint.F delete mode 100644 src/programs/Simulation/HDGeant/gxphys.F delete mode 100644 src/programs/Simulation/HDGeant/hddmInput.c delete mode 100644 src/programs/Simulation/HDGeant/hddmOutput.c delete mode 100644 src/programs/Simulation/HDGeant/hddmOutput.h delete mode 100644 src/programs/Simulation/HDGeant/hdgeant++.cc delete mode 100644 src/programs/Simulation/HDGeant/hdgeant.cc delete mode 100644 src/programs/Simulation/HDGeant/hdgeant_f.F delete mode 100644 src/programs/Simulation/HDGeant/hdtrackparams.inc delete mode 100644 src/programs/Simulation/HDGeant/hitBCal.cc delete mode 100644 src/programs/Simulation/HDGeant/hitCCal.c delete mode 100644 src/programs/Simulation/HDGeant/hitCDC.c delete mode 100644 src/programs/Simulation/HDGeant/hitCerenkov.c delete mode 100644 src/programs/Simulation/HDGeant/hitDIRC.c delete mode 100644 src/programs/Simulation/HDGeant/hitFCal.c delete mode 100644 src/programs/Simulation/HDGeant/hitFDC.c delete mode 100644 src/programs/Simulation/HDGeant/hitFTOF.c delete mode 100644 src/programs/Simulation/HDGeant/hitGCal.c delete mode 100644 src/programs/Simulation/HDGeant/hitPS.c delete mode 100644 src/programs/Simulation/HDGeant/hitPSC.c delete mode 100644 src/programs/Simulation/HDGeant/hitStart.c delete mode 100644 src/programs/Simulation/HDGeant/hitTPOL.c delete mode 100644 src/programs/Simulation/HDGeant/hitTag.c delete mode 100644 src/programs/Simulation/HDGeant/hitUPV.c delete mode 100644 src/programs/Simulation/HDGeant/hitutil/Makefile delete mode 100644 src/programs/Simulation/HDGeant/hitutil/Makefile.orig delete mode 100644 src/programs/Simulation/HDGeant/hitutil/SConscript delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getcell.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getcolumn.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getlayer.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getmodule.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getplane.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getring.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getrow.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/getsector.F delete mode 100644 src/programs/Simulation/HDGeant/hitutil/hitutil.F delete mode 100644 src/programs/Simulation/HDGeant/memcheck.c delete mode 100644 src/programs/Simulation/HDGeant/memcheck.h delete mode 100755 src/programs/Simulation/HDGeant/mhdgeant delete mode 100644 src/programs/Simulation/HDGeant/ray.kumac delete mode 100644 src/programs/Simulation/HDGeant/savehits.F delete mode 100644 src/programs/Simulation/HDGeant/savenewvertex.c delete mode 100644 src/programs/Simulation/HDGeant/seteventid.F delete mode 100644 src/programs/Simulation/HDGeant/settofg.F delete mode 100644 src/programs/Simulation/HDGeant/solenoid.map delete mode 100644 src/programs/Simulation/HDGeant/storeTrajectory.c delete mode 100644 src/programs/Simulation/HDGeant/timel.c delete mode 100644 src/programs/Simulation/HDGeant/trapfpe.c delete mode 100644 src/programs/Simulation/HDGeant/uginit.F delete mode 100644 src/programs/Simulation/HDGeant/uglast.F delete mode 100644 src/programs/Simulation/HDGeant/utilities/SConscript delete mode 100644 src/programs/Simulation/HDGeant/utilities/bcal2nt.cpp delete mode 100644 src/programs/Simulation/HDGeant/utilities/bcal2nt_c.c delete mode 100644 src/programs/Simulation/HDGeant/utilities/cdccount.cpp delete mode 100644 src/programs/Simulation/HDGeant/utilities/cdccount_c.c delete mode 100644 src/programs/Simulation/HDGeant/utilities/cdcdump.cpp delete mode 100644 src/programs/Simulation/HDGeant/utilities/cdcdump_c.c delete mode 100644 src/programs/Simulation/HDGeant/utilities/hddmcp.cpp delete mode 100644 src/programs/Simulation/HDGeant/utilities/hddmcp_c.c delete mode 100644 src/programs/Simulation/HDGeant/vunit.F delete mode 100644 src/programs/Simulation/HDGeant/wc.f delete mode 100644 src/programs/Simulation/HDGeant/wc.kumac delete mode 100644 src/programs/Simulation/Makefile delete mode 100644 src/programs/Simulation/SConscript delete mode 100644 src/programs/Simulation/bggen/Makefile delete mode 100644 src/programs/Simulation/bggen/README delete mode 100644 src/programs/Simulation/bggen/SConscript delete mode 100644 src/programs/Simulation/bggen/code/Makefile delete mode 100644 src/programs/Simulation/bggen/code/SConscript delete mode 100644 src/programs/Simulation/bggen/code/bg_CFglue.F delete mode 100644 src/programs/Simulation/bggen/code/bg_ctrl.inc delete mode 100644 src/programs/Simulation/bggen/code/bg_end.F delete mode 100644 src/programs/Simulation/bggen/code/bg_eve.F delete mode 100644 src/programs/Simulation/bggen/code/bg_evec.inc delete mode 100644 src/programs/Simulation/bggen/code/bg_hddm.c delete mode 100644 src/programs/Simulation/bggen/code/bg_ini.F delete mode 100644 src/programs/Simulation/bggen/code/bg_ntup_ini.F delete mode 100644 src/programs/Simulation/bggen/code/bg_partc.inc delete mode 100644 src/programs/Simulation/bggen/code/bg_proc.inc delete mode 100644 src/programs/Simulation/bggen/code/bggen.cc delete mode 100644 src/programs/Simulation/bggen/code/bggen_F.F delete mode 100644 src/programs/Simulation/bggen/code/cobrems.F delete mode 100644 src/programs/Simulation/bggen/code/cobrems.inc delete mode 100644 src/programs/Simulation/bggen/code/cohbeam_ini.F delete mode 100644 src/programs/Simulation/bggen/code/gbrwign.F delete mode 100644 src/programs/Simulation/bggen/code/gdecan.F delete mode 100644 src/programs/Simulation/bggen/code/gloren.F delete mode 100644 src/programs/Simulation/bggen/code/gpxcosthr.F delete mode 100644 src/programs/Simulation/bggen/code/gpxsecp.F delete mode 100644 src/programs/Simulation/bggen/code/gpxsect.F delete mode 100644 src/programs/Simulation/bggen/code/grndm.F delete mode 100644 src/programs/Simulation/bggen/code/hbook_ini.F delete mode 100644 src/programs/Simulation/bggen/code/include/amf2com.inc delete mode 100644 src/programs/Simulation/bggen/code/include/bseocom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/cmpcom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/concom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/deltacom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/density.inc delete mode 100644 src/programs/Simulation/bggen/code/include/double.inc delete mode 100644 src/programs/Simulation/bggen/code/include/gamcom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/intcom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/kincom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/leptou.inc delete mode 100644 src/programs/Simulation/bggen/code/include/mcRadCor.inc delete mode 100644 src/programs/Simulation/bggen/code/include/mc_set.inc delete mode 100644 src/programs/Simulation/bggen/code/include/mconsp.inc delete mode 100644 src/programs/Simulation/bggen/code/include/phiout.inc delete mode 100644 src/programs/Simulation/bggen/code/include/polcom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/ppicom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/py6int1.inc delete mode 100644 src/programs/Simulation/bggen/code/include/py6pars.inc delete mode 100644 src/programs/Simulation/bggen/code/include/py6strf.inc delete mode 100644 src/programs/Simulation/bggen/code/include/pypars.inc delete mode 100644 src/programs/Simulation/bggen/code/include/radgen.inc delete mode 100644 src/programs/Simulation/bggen/code/include/radgenkeys.inc delete mode 100644 src/programs/Simulation/bggen/code/include/sxycom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/tailcom.inc delete mode 100644 src/programs/Simulation/bggen/code/include/xytabcom.inc delete mode 100644 src/programs/Simulation/bggen/code/lowen_eve.F delete mode 100644 src/programs/Simulation/bggen/code/lowen_ini.F delete mode 100644 src/programs/Simulation/bggen/code/omdeca2.F delete mode 100644 src/programs/Simulation/bggen/code/omdeca3.F delete mode 100644 src/programs/Simulation/bggen/code/omrots.F delete mode 100644 src/programs/Simulation/bggen/code/omrotv.F delete mode 100644 src/programs/Simulation/bggen/code/orndpoly.F delete mode 100644 src/programs/Simulation/bggen/code/parp_ini.F delete mode 100644 src/programs/Simulation/bggen/code/pyr.F delete mode 100644 src/programs/Simulation/bggen/code/pyth_eve.F delete mode 100644 src/programs/Simulation/bggen/code/pyth_ini.F delete mode 100644 src/programs/Simulation/bggen/code/pythia_h.F delete mode 100644 src/programs/Simulation/bggen/code/rnd_ini.F delete mode 100644 src/programs/Simulation/bggen/code/rndm.F delete mode 100644 src/programs/Simulation/bggen/code/saidcore.F delete mode 100644 src/programs/Simulation/bggen/code/saide.F delete mode 100644 src/programs/Simulation/bggen/code/saidxseca.F delete mode 100644 src/programs/Simulation/bggen/code/simpsf.F delete mode 100755 src/programs/Simulation/bggen/fix_warnings.py delete mode 100644 src/programs/Simulation/bggen/paw/Makefile delete mode 100644 src/programs/Simulation/bggen/paw/bgg_pri.f delete mode 100644 src/programs/Simulation/bggen/paw/bgg_read.f delete mode 120000 src/programs/Simulation/bggen/paw/bggen.dat delete mode 120000 src/programs/Simulation/bggen/paw/bggen.his delete mode 120000 src/programs/Simulation/bggen/paw/bggen.nt delete mode 100644 src/programs/Simulation/bggen/paw/efm.f delete mode 100644 src/programs/Simulation/bggen/paw/efmass.f delete mode 100644 src/programs/Simulation/bggen/paw/ev_stat.f delete mode 100644 src/programs/Simulation/bggen/paw/example_1.kumac delete mode 100644 src/programs/Simulation/bggen/paw/gloren.f delete mode 100644 src/programs/Simulation/bggen/paw/last.kumac delete mode 100644 src/programs/Simulation/bggen/paw/p_kin.f delete mode 100644 src/programs/Simulation/bggen/paw/p_kin_auto.f delete mode 100644 src/programs/Simulation/bggen/paw/part_kin.f delete mode 100644 src/programs/Simulation/bggen/paw/pi_plot.f delete mode 100644 src/programs/Simulation/bggen/paw/plot_pi0_photons.kumac delete mode 120000 src/programs/Simulation/bggen/run/fort.15 delete mode 100644 src/programs/Simulation/bggen/run/particle.dat delete mode 100644 src/programs/Simulation/bggen/run/pythia-geant.map delete mode 100644 src/programs/Simulation/bggen/run/pythia.dat delete mode 100644 src/programs/Simulation/bggen/run/run.ffr delete mode 100644 src/programs/Simulation/bggen_jpsi/Makefile delete mode 100644 src/programs/Simulation/bggen_jpsi/README delete mode 100644 src/programs/Simulation/bggen_jpsi/SConscript delete mode 100644 src/programs/Simulation/bggen_jpsi/code/Makefile delete mode 100644 src/programs/Simulation/bggen_jpsi/code/SConscript delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_CFglue.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_ctrl.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_end.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_eve.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_evec.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_hddm.c delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_ntup_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_partc.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_proc.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bg_reac.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bggen.cc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/bggen_F.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/cobrems.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/cobrems.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/cohbeam_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gbrwign.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gdecan.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/getxsec.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gloren.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gpxcosthr.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gpxsecp.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/gpxsect.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/grndm.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/hbook_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/amf2com.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/bseocom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/cmpcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/concom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/deltacom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/density.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/double.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/gamcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/intcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/kincom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/leptou.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/mcRadCor.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/mc_set.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/mconsp.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/phiout.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/polcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/ppicom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/py6int1.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/py6pars.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/py6strf.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/pypars.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/radgen.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/radgenkeys.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/sxycom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/tailcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/include/xytabcom.inc delete mode 100644 src/programs/Simulation/bggen_jpsi/code/lowen_eve.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/lowen_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/omdeca2.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/omdeca3.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/omrots.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/omrotv.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/orndpoly.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/parp_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/pyr.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/pyth_eve.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/pyth_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/pythia_h.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/reac_eve.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/rnd_ini.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/rndm.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/saidcore.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/saide.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/saidxseca.F delete mode 100644 src/programs/Simulation/bggen_jpsi/code/simpsf.F delete mode 100755 src/programs/Simulation/bggen_jpsi/fix_warnings.py delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/Makefile delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/bgg_pri.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/bgg_read.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/efm.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/ev_stat.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/example_1.kumac delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/gloren.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/last.kumac delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/p_kin.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/p_kin_auto.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/part_kin.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/pi_plot.f delete mode 100644 src/programs/Simulation/bggen_jpsi/paw/plot_pi0_photons.kumac delete mode 100644 src/programs/Simulation/bggen_jpsi/run/fort.15 delete mode 100644 src/programs/Simulation/bggen_jpsi/run/particle.dat delete mode 100644 src/programs/Simulation/bggen_jpsi/run/pythia-geant.map delete mode 100644 src/programs/Simulation/bggen_jpsi/run/pythia.dat delete mode 100644 src/programs/Simulation/bggen_jpsi/run/run.ffr delete mode 100644 src/programs/Simulation/bggen_jpsi/run/run_jpsi.ffr delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/SConscript delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.F delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.o delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_pri.cc delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_pri.o delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_pri_F.F delete mode 100644 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_pri_F.o delete mode 100755 src/programs/Simulation/bggen_jpsi/xsec_table/xsec_table delete mode 100644 src/programs/Simulation/filtergen/Makefile delete mode 100644 src/programs/Simulation/filtergen/filter.cc delete mode 100644 src/programs/Simulation/filtergen/filtergen.cc delete mode 100644 src/programs/Simulation/genEtaRegge/README delete mode 100644 src/programs/Simulation/genEtaRegge/SConscript delete mode 100644 src/programs/Simulation/genEtaRegge/eta548.in delete mode 100644 src/programs/Simulation/genEtaRegge/eta958.in delete mode 100644 src/programs/Simulation/genEtaRegge/genEtaRegge.cc delete mode 100644 src/programs/Simulation/gen_2k/SConscript delete mode 100644 src/programs/Simulation/gen_2k/fit_2k-template.cfg delete mode 100644 src/programs/Simulation/gen_2k/gen_2k.cc delete mode 100644 src/programs/Simulation/gen_2k/gen_2k.cfg delete mode 100644 src/programs/Simulation/gen_2k/gen_2k_flat.cfg delete mode 100644 src/programs/Simulation/gen_2mu/CobremsGenerator.cc delete mode 100644 src/programs/Simulation/gen_2mu/CobremsGenerator.hh delete mode 100644 src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.cc delete mode 100644 src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.hh delete mode 100644 src/programs/Simulation/gen_2mu/SConscript delete mode 100644 src/programs/Simulation/gen_2mu/expint_spline.cc delete mode 100644 src/programs/Simulation/gen_2mu/gen_2mu.cc delete mode 100644 src/programs/Simulation/gen_2pi/SConscript delete mode 100644 src/programs/Simulation/gen_2pi/gen_2pi.cc delete mode 100644 src/programs/Simulation/gen_2pi/gen_2pi.cfg delete mode 100644 src/programs/Simulation/gen_2pi_amp/README delete mode 100644 src/programs/Simulation/gen_2pi_amp/SConscript delete mode 100644 src/programs/Simulation/gen_2pi_amp/fit_2pi_amp.cfg delete mode 100644 src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cc delete mode 100644 src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cfg delete mode 100644 src/programs/Simulation/gen_2pi_amp/gen_2pi_mom.cfg delete mode 100644 src/programs/Simulation/gen_2pi_primakoff/SConscript delete mode 100644 src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cc delete mode 100644 src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cfg delete mode 100644 src/programs/Simulation/gen_3pi/Makefile delete mode 100644 src/programs/Simulation/gen_3pi/SConscript delete mode 100644 src/programs/Simulation/gen_3pi/gen_3pi.cc delete mode 100644 src/programs/Simulation/gen_3pi/gen_3pi.cfg delete mode 100644 src/programs/Simulation/gen_3pi/gen_3pi_ypol.cfg delete mode 100644 src/programs/Simulation/gen_5pi/Makefile delete mode 100644 src/programs/Simulation/gen_5pi/b1piAmpCheck.cc delete mode 100644 src/programs/Simulation/gen_5pi/b1piAmpCheck.h delete mode 100644 src/programs/Simulation/gen_5pi/gen_5pi.cc delete mode 100644 src/programs/Simulation/gen_amp/SConscript delete mode 100644 src/programs/Simulation/gen_amp/gen_2k.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_2pi_amp.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_2pi_mom.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_3pi.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_amp.cc delete mode 100644 src/programs/Simulation/gen_amp/gen_b1.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_b1_pigamma.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_etapi0_2body.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_omega_3pi.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_omega_3pi_flat.cfg delete mode 100644 src/programs/Simulation/gen_amp/gen_omega_radiative_flat.cfg delete mode 100644 src/programs/Simulation/gen_ee/SConscript delete mode 100644 src/programs/Simulation/gen_ee/code/HddmOut.h delete mode 100644 src/programs/Simulation/gen_ee/code/SConscript delete mode 100644 src/programs/Simulation/gen_ee/code/devilTreePT.h delete mode 100644 src/programs/Simulation/gen_ee/code/gen_ee.cc delete mode 100644 src/programs/Simulation/gen_ee/code/qDevilLib.cc delete mode 100644 src/programs/Simulation/gen_ee/code/qDevilLib.h delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/GPDs.cc delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/GPDs.hh delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/GenTCS.cc delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/HddmOut.h delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/SConscript delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.cc delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.hh delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.cc delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.hh delete mode 100644 src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.cc delete mode 100755 src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.h delete mode 100644 src/programs/Simulation/gen_ee_hb/SConscript delete mode 100644 src/programs/Simulation/gen_ee_hb/run/CFFs_DD_Feb2012.dat delete mode 100644 src/programs/Simulation/gen_omega_3pi/SConscript delete mode 100644 src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cc delete mode 100644 src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cfg delete mode 100644 src/programs/Simulation/gen_omega_3pi/gen_omega_3pi_flat.cfg delete mode 100644 src/programs/Simulation/gen_omega_radiative/SConscript delete mode 100644 src/programs/Simulation/gen_omega_radiative/gen_omega_3pi.cfg delete mode 100644 src/programs/Simulation/gen_omega_radiative/gen_omega_radiative.cc delete mode 100644 src/programs/Simulation/gen_omega_radiative/gen_omega_radiative_flat.cfg delete mode 100644 src/programs/Simulation/gen_pi0/SConscript delete mode 100644 src/programs/Simulation/gen_pi0/gen_pi0.cc delete mode 100644 src/programs/Simulation/gen_pi0/saidPWA.cfg delete mode 100644 src/programs/Simulation/gen_pi0/vmRegge.cfg delete mode 100644 src/programs/Simulation/geneta/Makefile delete mode 100644 src/programs/Simulation/geneta/README delete mode 100644 src/programs/Simulation/geneta/bg_hddm.cc delete mode 100644 src/programs/Simulation/geneta/bg_hddm.h delete mode 100644 src/programs/Simulation/geneta/c_cern.c delete mode 100644 src/programs/Simulation/geneta/c_cern.h delete mode 100644 src/programs/Simulation/geneta/cr_prt.F delete mode 100644 src/programs/Simulation/geneta/eta_p_gen.dat delete mode 100644 src/programs/Simulation/geneta/eta_prot_kin.F delete mode 100644 src/programs/Simulation/geneta/eta_proton.F delete mode 100644 src/programs/Simulation/geneta/geneta.cc delete mode 100644 src/programs/Simulation/geneta/kin_eta.F delete mode 100644 src/programs/Simulation/genp_pi0/Makefile delete mode 100644 src/programs/Simulation/genp_pi0/bg_hddm.cc delete mode 100644 src/programs/Simulation/genp_pi0/bg_hddm.h delete mode 100755 src/programs/Simulation/genp_pi0/cern.h delete mode 100644 src/programs/Simulation/genp_pi0/genp_pi0.cc delete mode 100644 src/programs/Simulation/genp_pi0/kinematics.c delete mode 100644 src/programs/Simulation/genp_pi0/kinematics.h delete mode 100644 src/programs/Simulation/genphoton/Makefile delete mode 100644 src/programs/Simulation/genphoton/SConscript delete mode 100644 src/programs/Simulation/genphoton/genphoton.cc delete mode 100644 src/programs/Simulation/genpi/Makefile delete mode 100644 src/programs/Simulation/genpi/SConscript delete mode 100644 src/programs/Simulation/genpi/complex.h delete mode 100644 src/programs/Simulation/genpi/genmu+mu-.cc delete mode 100644 src/programs/Simulation/genpi/genpi+pi-.cc delete mode 100644 src/programs/Simulation/genpi/genpi.cc delete mode 100644 src/programs/Simulation/genpi/genpi0.cc delete mode 100644 src/programs/Simulation/genpi/nr.h delete mode 100644 src/programs/Simulation/genpi/nrutil.c delete mode 100644 src/programs/Simulation/genpi/nrutil.h delete mode 100644 src/programs/Simulation/genpi/rtnewt.c delete mode 100644 src/programs/Simulation/genpi/rtsafe.c delete mode 100644 src/programs/Simulation/genpi/zbrent.c delete mode 100644 src/programs/Simulation/genr8/InputFiles/KstarKstar.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/b1_pi.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/eta1_p.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/n_3pi.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/n_eta_pi+pi-pi+.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/n_omega_pi+.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/n_omega_pi0_pi+.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/omegadelta2.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/pKstarKstar.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/p_K-pi+pi-K+.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/p_eta_pi0pi0.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/p_pi+pi-pi0.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/pk+k-pi+pi-.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/rho.input delete mode 100644 src/programs/Simulation/genr8/InputFiles/rhop.input delete mode 100644 src/programs/Simulation/genr8/Makefile delete mode 100644 src/programs/Simulation/genr8/Makefile.orig delete mode 100644 src/programs/Simulation/genr8/SConscript delete mode 100644 src/programs/Simulation/genr8/genkin.c delete mode 100644 src/programs/Simulation/genr8/genkin.h delete mode 100644 src/programs/Simulation/genr8/genr8.c delete mode 100644 src/programs/Simulation/genr8_2_hddm/Makefile delete mode 100644 src/programs/Simulation/genr8_2_hddm/SConscript delete mode 100644 src/programs/Simulation/genr8_2_hddm/genr8_2_hddm.cc delete mode 100644 src/programs/Simulation/gxtwist/Makefile delete mode 100644 src/programs/Simulation/gxtwist/Makefile.bms delete mode 100644 src/programs/Simulation/gxtwist/README.txt delete mode 100644 src/programs/Simulation/gxtwist/beamgen.F delete mode 100644 src/programs/Simulation/gxtwist/bfld.f delete mode 100755 src/programs/Simulation/gxtwist/bfld.sl delete mode 100644 src/programs/Simulation/gxtwist/bintree.c delete mode 100644 src/programs/Simulation/gxtwist/bintree.h delete mode 100644 src/programs/Simulation/gxtwist/cobrems.F delete mode 100644 src/programs/Simulation/gxtwist/cobrems.inc delete mode 100644 src/programs/Simulation/gxtwist/control.in delete mode 100644 src/programs/Simulation/gxtwist/dbug.kumac delete mode 100644 src/programs/Simulation/gxtwist/geant3.h delete mode 100644 src/programs/Simulation/gxtwist/getwebfile.c delete mode 100644 src/programs/Simulation/gxtwist/gltrac.F delete mode 100644 src/programs/Simulation/gxtwist/goptimize.F delete mode 100644 src/programs/Simulation/gxtwist/gpairg.F delete mode 100644 src/programs/Simulation/gxtwist/gsstak.F delete mode 100644 src/programs/Simulation/gxtwist/guhadr.F delete mode 100644 src/programs/Simulation/gxtwist/gukine.F delete mode 100644 src/programs/Simulation/gxtwist/guout.F delete mode 100644 src/programs/Simulation/gxtwist/guphad.F delete mode 100644 src/programs/Simulation/gxtwist/gustep.F delete mode 100644 src/programs/Simulation/gxtwist/guxcs.F delete mode 100644 src/programs/Simulation/gxtwist/gxcs.F delete mode 100644 src/programs/Simulation/gxtwist/gxint.F delete mode 100644 src/programs/Simulation/gxtwist/gxphys.F delete mode 100644 src/programs/Simulation/gxtwist/gxtwist++.cc delete mode 100644 src/programs/Simulation/gxtwist/gxtwist.cc delete mode 100644 src/programs/Simulation/gxtwist/gxtwist_f.F delete mode 100644 src/programs/Simulation/gxtwist/halo.F delete mode 100644 src/programs/Simulation/gxtwist/halo.inc delete mode 100644 src/programs/Simulation/gxtwist/hddmInput.c delete mode 100644 src/programs/Simulation/gxtwist/hddmOutput.c delete mode 100644 src/programs/Simulation/gxtwist/hddmOutput.h delete mode 100644 src/programs/Simulation/gxtwist/hddm_s.c delete mode 100644 src/programs/Simulation/gxtwist/hddm_s.h delete mode 100644 src/programs/Simulation/gxtwist/hdds/ElectronDump.xml delete mode 100644 src/programs/Simulation/gxtwist/hdds/FocalPlane.xml delete mode 100644 src/programs/Simulation/gxtwist/hdds/HDDS-1_1.xsd delete mode 100644 src/programs/Simulation/gxtwist/hdds/Makefile delete mode 100644 src/programs/Simulation/gxtwist/hdds/Materials.xml delete mode 100644 src/programs/Simulation/gxtwist/hdds/Regions.xml delete mode 100644 src/programs/Simulation/gxtwist/hdds/Spectrometer.xml delete mode 100644 src/programs/Simulation/gxtwist/hdds/TaggerArea.xml delete mode 100644 src/programs/Simulation/gxtwist/hdtrackparams.inc delete mode 100644 src/programs/Simulation/gxtwist/memcheck.c delete mode 100644 src/programs/Simulation/gxtwist/memcheck.h delete mode 100644 src/programs/Simulation/gxtwist/nt.inc delete mode 100644 src/programs/Simulation/gxtwist/ray.kumac delete mode 100644 src/programs/Simulation/gxtwist/seer.kumac delete mode 100644 src/programs/Simulation/gxtwist/taggerCoords.txt delete mode 100644 src/programs/Simulation/gxtwist/taggerCoords2.txt delete mode 100644 src/programs/Simulation/gxtwist/taggerCoords2.xls delete mode 100644 src/programs/Simulation/gxtwist/tagger_building.ppt delete mode 100644 src/programs/Simulation/gxtwist/trapfpe.c delete mode 100644 src/programs/Simulation/gxtwist/uginit.F delete mode 100644 src/programs/Simulation/gxtwist/uglast.F delete mode 100644 src/programs/Simulation/gxtwist/wc.f delete mode 100644 src/programs/Simulation/gxtwist/wc.kumac delete mode 100644 src/programs/Simulation/mcsmear/BCALSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/BCALSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/CCALSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/CCALSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/CDCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/CDCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/DRandom2.h delete mode 100644 src/programs/Simulation/mcsmear/FCALSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/FCALSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/FDCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/FDCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/FDIRCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/FDIRCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/FMWPCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/FMWPCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/JFactoryGenerator_ThreadCancelHandler.h delete mode 100644 src/programs/Simulation/mcsmear/Makefile delete mode 100644 src/programs/Simulation/mcsmear/MyProcessor.cc delete mode 100644 src/programs/Simulation/mcsmear/MyProcessor.h delete mode 100644 src/programs/Simulation/mcsmear/PSCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/PSCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/PSSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/PSSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/SCSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/SCSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/SConscript delete mode 100644 src/programs/Simulation/mcsmear/Smearer.h delete mode 100644 src/programs/Simulation/mcsmear/TAGHSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/TAGHSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/TAGMSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/TAGMSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/TOFSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/TOFSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/TPOLSmearer.cc delete mode 100644 src/programs/Simulation/mcsmear/TPOLSmearer.h delete mode 100644 src/programs/Simulation/mcsmear/hddm_s_merger.cc delete mode 100644 src/programs/Simulation/mcsmear/hddm_s_merger.h delete mode 100644 src/programs/Simulation/mcsmear/mcsmear.cc delete mode 100644 src/programs/Simulation/mcsmear/mcsmear_config.cc delete mode 100644 src/programs/Simulation/mcsmear/mcsmear_config.h delete mode 100644 src/programs/Simulation/mcsmear/smear.cc delete mode 100644 src/programs/Simulation/mcsmear/smear.h delete mode 100644 src/programs/Simulation/nullgen/SConscript delete mode 100644 src/programs/Simulation/nullgen/nullgen.cc delete mode 100644 src/programs/Simulation/stdhep_translators/README delete mode 100644 src/programs/Simulation/stdhep_translators/SConscript delete mode 100644 src/programs/Simulation/stdhep_translators/ascii2stdhep.c delete mode 100644 src/programs/Simulation/stdhep_translators/stdhep2ascii.c delete mode 100644 src/programs/Simulation/stdhep_translators/stdhep2hddm.c diff --git a/src/SBMS/SConstruct.plugin b/src/SBMS/SConstruct.plugin index bdb81fe3e6..ee01bfab6d 100644 --- a/src/SBMS/SConstruct.plugin +++ b/src/SBMS/SConstruct.plugin @@ -5,7 +5,7 @@ # This SConstruct file can be copied into a directory containing # the source for a plugin and used to compile it. It will use and # install into the directory specified by the HALLD_MY environment -# variable if defined. Otherwise, it will install in the HALLD_HOME +# variable if defined. Otherwise, it will install in the HALLD_RECON_HOME # directory. # # This file should not need modification. It will be copied in by @@ -29,13 +29,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Add SBMS directory to PYTHONPATH @@ -61,7 +61,7 @@ lib = "%s/lib" % (installdir) plugins = "%s/plugins" % (installdir) env = Environment( ENV = os.environ, # Bring in full environment, including PATH CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -99,7 +99,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/SBMS/sbms.py b/src/SBMS/sbms.py index cbf38402d7..ffeffd96ee 100644 --- a/src/SBMS/sbms.py +++ b/src/SBMS/sbms.py @@ -1038,7 +1038,7 @@ def AddAmpTools(env): print 'is not set. Expect to see an error message below....' print '' else: - env.AppendUnique(CUDAFLAGS=['-I%s -I%s/src/libraries' % (AMPTOOLS, os.getenv('HALLD_HOME',os.getcwd()))]) + env.AppendUnique(CUDAFLAGS=['-I%s -I%s/src/libraries' % (AMPTOOLS, os.getenv('HALLD_RECON_HOME',os.getcwd()))]) AddCUDA(env) AMPTOOLS_CPPPATH = "%s" % (AMPTOOLS) AMPTOOLS_LIBPATH = "%s/lib" % (AMPTOOLS) @@ -1070,7 +1070,7 @@ def AddAmpPlotter(env): ################################## def AddCobrems(env): pyincludes = subprocess.Popen(["python-config", "--includes" ], stdout=subprocess.PIPE).communicate()[0] - cobrems_home = os.getenv('HALLD_HOME', 'sim-recon') + cobrems_home = os.getenv('HALLD_RECON_HOME', 'halld_recon') env.AppendUnique(CPPPATH = ["%s/src/libraries/AMPTOOLS_MCGEN" % (cobrems_home)]) env.AppendUnique(LIBPATH = ["%s/%s/lib" % (cobrems_home, env['OSNAME'])]) env.AppendUnique(LIBS = 'AMPTOOLS_MCGEN') diff --git a/src/SBMS/sbms_setenv.py b/src/SBMS/sbms_setenv.py index d62a04a2c1..9f1a8dbe52 100644 --- a/src/SBMS/sbms_setenv.py +++ b/src/SBMS/sbms_setenv.py @@ -97,13 +97,13 @@ def mk_setenv_csh(env): # HALLD str += '# HALLD\n' - str += 'setenv HALLD_HOME %s\n' % halld_home + str += 'setenv HALLD_RECON_HOME %s\n' % halld_home str += 'setenv BMS_OSNAME %s\n' % env['OSNAME'] - str += 'setenv PATH ${HALLD_HOME}/${BMS_OSNAME}/bin:${PATH}\n' - str += 'setenv JANA_PLUGIN_PATH ${HALLD_HOME}/${BMS_OSNAME}/plugins:${JANA_PLUGIN_PATH}\n' + str += 'setenv PATH ${HALLD_RECON_HOME}/${BMS_OSNAME}/bin:${PATH}\n' + str += 'setenv JANA_PLUGIN_PATH ${HALLD_RECON_HOME}/${BMS_OSNAME}/plugins:${JANA_PLUGIN_PATH}\n' # python support - str += 'setenv %s ${HALLD_HOME}/${BMS_OSNAME}/lib:${%s}\n' %(LDLPV, LDLPV) - str += 'setenv PYTHONPATH ${HALLD_HOME}/${BMS_OSNAME}/lib/python:${PYTHONPATH}\n' + str += 'setenv %s ${HALLD_RECON_HOME}/${BMS_OSNAME}/lib:${%s}\n' %(LDLPV, LDLPV) + str += 'setenv PYTHONPATH ${HALLD_RECON_HOME}/${BMS_OSNAME}/lib/python:${PYTHONPATH}\n' str += '\n' # CCDB @@ -271,13 +271,13 @@ def mk_setenv_bash(env): # HALLD str += '# HALLD\n' - str += 'export HALLD_HOME=%s\n' % halld_home + str += 'export HALLD_RECON_HOME=%s\n' % halld_home str += 'export BMS_OSNAME=%s\n' % env['OSNAME'] - str += 'export PATH=${HALLD_HOME}/${BMS_OSNAME}/bin:${PATH}\n' - str += 'export JANA_PLUGIN_PATH=${HALLD_HOME}/${BMS_OSNAME}/plugins:${JANA_PLUGIN_PATH}\n' + str += 'export PATH=${HALLD_RECON_HOME}/${BMS_OSNAME}/bin:${PATH}\n' + str += 'export JANA_PLUGIN_PATH=${HALLD_RECON_HOME}/${BMS_OSNAME}/plugins:${JANA_PLUGIN_PATH}\n' # python support - str += 'export %s=${HALLD_HOME}/${BMS_OSNAME}/lib:${%s}\n' %(LDLPV, LDLPV) - str += 'export PYTHONPATH=${HALLD_HOME}/${BMS_OSNAME}/lib/python:${PYTHONPATH}\n' + str += 'export %s=${HALLD_RECON_HOME}/${BMS_OSNAME}/lib:${%s}\n' %(LDLPV, LDLPV) + str += 'export PYTHONPATH=${HALLD_RECON_HOME}/${BMS_OSNAME}/lib/python:${PYTHONPATH}\n' str += '\n' # CCDB diff --git a/src/SConstruct b/src/SConstruct index aa4fb14137..66e58a48c4 100644 --- a/src/SConstruct +++ b/src/SConstruct @@ -21,8 +21,8 @@ BUILDSWIG = ARGUMENTS.get('BUILDSWIG', 0) # Get platform-specific name osname = os.getenv('BMS_OSNAME', 'build') -# Make sure HALLD_HOME is set (needed for python module builds) -if not os.getenv('HALLD_HOME'): os.environ['HALLD_HOME'] = Dir('#/..').abspath +# Make sure HALLD_RECON_HOME is set (needed for python module builds) +if not os.getenv('HALLD_RECON_HOME'): os.environ['HALLD_RECON_HOME'] = Dir('#/..').abspath # Get architecture name arch = ROOT_CFLAGS = subprocess.Popen(["uname"], stdout=subprocess.PIPE).communicate()[0].strip() diff --git a/src/libraries/AMPTOOLS_AMPS/BreitWigner.cc b/src/libraries/AMPTOOLS_AMPS/BreitWigner.cc deleted file mode 100644 index 3dfc84ef1a..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/BreitWigner.cc +++ /dev/null @@ -1,107 +0,0 @@ - - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" - -#include "barrierFactor.h" -#include "breakupMomentum.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -BreitWigner::BreitWigner( const vector< string >& args ) : -UserAmplitude< BreitWigner >( args ) -{ - - assert( args.size() == 5 ); - - m_mass0 = AmpParameter( args[0] ); - m_width0 = AmpParameter( args[1] ); - m_orbitL = atoi( args[2].c_str() ); - m_daughters = pair< string, string >( args[3], args[4] ); - - // need to register any free parameters so the framework knows about them - registerParameter( m_mass0 ); - registerParameter( m_width0 ); - - // make sure the input variables look reasonable - assert( ( m_orbitL >= 0 ) && ( m_orbitL <= 4 ) ); -} - -complex< GDouble > -BreitWigner::calcAmplitude( GDouble** pKin ) const -{ - TLorentzVector P1, P2, Ptot, Ptemp; - - for( unsigned int i = 0; i < m_daughters.first.size(); ++i ){ - - string num; num += m_daughters.first[i]; - int index = atoi(num.c_str()); - Ptemp.SetPxPyPzE( pKin[index][1], pKin[index][2], - pKin[index][3], pKin[index][0] ); - P1 += Ptemp; - Ptot += Ptemp; - } - - for( unsigned int i = 0; i < m_daughters.second.size(); ++i ){ - - string num; num += m_daughters.second[i]; - int index = atoi(num.c_str()); - Ptemp.SetPxPyPzE( pKin[index][1], pKin[index][2], - pKin[index][3], pKin[index][0] ); - P2 += Ptemp; - Ptot += Ptemp; - } - - GDouble mass = Ptot.M(); - GDouble mass1 = P1.M(); - GDouble mass2 = P2.M(); - - // assert positive breakup momenta - GDouble q0 = fabs( breakupMomentum(m_mass0, mass1, mass2) ); - GDouble q = fabs( breakupMomentum(mass, mass1, mass2) ); - - GDouble F0 = barrierFactor(q0, m_orbitL); - GDouble F = barrierFactor(q, m_orbitL); - - GDouble width = m_width0*(m_mass0/mass)*(q/q0)*((F*F)/(F0*F0)); - //GDouble width = m_width0; - - // this first factor just gets normalization right for BW's that have - // no additional s-dependence from orbital L - complex bwtop( sqrt( m_mass0 * m_width0 / 3.1416 ), 0.0 ); - - complex bwbottom( ( m_mass0*m_mass0 - mass*mass ) , - -1.0 * ( m_mass0 * width ) ); - - return( F * bwtop / bwbottom ); -} - -void -BreitWigner::updatePar( const AmpParameter& par ){ - - // could do expensive calculations here on parameter updates - -} - -#ifdef GPU_ACCELERATION -void -BreitWigner::launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const { - - // use integers to endcode the string of daughters -- one index in each - // decimal place - - int daught1 = atoi( m_daughters.first.c_str() ); - int daught2 = atoi( m_daughters.second.c_str() ); - - GPUBreitWigner_exec( dimGrid, dimBlock, GPU_AMP_ARGS, - m_mass0, m_width0, m_orbitL, daught1, daught2 ); - -} -#endif //GPU_ACCELERATION - diff --git a/src/libraries/AMPTOOLS_AMPS/BreitWigner.h b/src/libraries/AMPTOOLS_AMPS/BreitWigner.h deleted file mode 100644 index 9312ac4348..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/BreitWigner.h +++ /dev/null @@ -1,59 +0,0 @@ -#if !defined(BREITWIGNER) -#define BREITWIGNER - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - -#ifdef GPU_ACCELERATION -void GPUBreitWigner_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - GDouble mass0, GDouble width0, int orbitL, - int daught1, int daught2 ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class BreitWigner : public UserAmplitude< BreitWigner > -{ - -public: - - BreitWigner() : UserAmplitude< BreitWigner >() {} - BreitWigner( const vector< string >& args ); - - ~BreitWigner(){} - - string name() const { return "BreitWigner"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - - void updatePar( const AmpParameter& par ); - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter m_mass0; - AmpParameter m_width0; - int m_orbitL; - - pair< string, string > m_daughters; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.cc b/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.cc deleted file mode 100644 index e2c7cb072c..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.cc +++ /dev/null @@ -1,68 +0,0 @@ - - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" - -#include "barrierFactor.h" -#include "breakupMomentum.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/BreitWigner3body.h" - -BreitWigner3body::BreitWigner3body( const vector< string >& args ) : -UserAmplitude< BreitWigner3body >( args ) -{ - - assert( args.size() == 3 ); - - m_mass0 = AmpParameter( args[0] ); - m_width0 = AmpParameter( args[1] ); - m_daughters = args[2]; - - // need to register any free parameters so the framework knows about them - registerParameter( m_mass0 ); - registerParameter( m_width0 ); - -} - -complex< GDouble > -BreitWigner3body::calcAmplitude( GDouble** pKin ) const -{ - TLorentzVector Ptot, Ptemp; - - for( unsigned int i = 0; i < m_daughters.size(); ++i ){ - - string num; num += m_daughters[i]; - int index = atoi(num.c_str()); - Ptemp.SetPxPyPzE( pKin[index][1], pKin[index][2], - pKin[index][3], pKin[index][0] ); - Ptot += Ptemp; - } - - GDouble mass = Ptot.M(); - - GDouble width = m_width0; - //GDouble width = m_width0; - - // this first factor just gets normalization right for BW's that have - // no additional s-dependence from orbital L - complex bwtop( sqrt( m_mass0 * m_width0 / 3.1416 ), 0.0 ); - - complex bwbottom( ( m_mass0*m_mass0 - mass*mass ) , - -1.0 * ( m_mass0 * width ) ); - - return( bwtop / bwbottom ); -} - -void -BreitWigner3body::updatePar( const AmpParameter& par ){ - - // could do expensive calculations here on parameter updates - -} - diff --git a/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.h b/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.h deleted file mode 100644 index 235f7cac62..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/BreitWigner3body.h +++ /dev/null @@ -1,56 +0,0 @@ -#if !defined(BREITWIGNER3BODY) -#define BREITWIGNER3BODY - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - -#ifdef GPU_ACCELERATION -void GPUBreitWigner3body_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - GDouble mass0, GDouble width0, int orbitL, - int daught1, int daught2 ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class BreitWigner3body : public UserAmplitude< BreitWigner3body > -{ - -public: - - BreitWigner3body() : UserAmplitude< BreitWigner3body >() {} - BreitWigner3body( const vector< string >& args ); - - ~BreitWigner3body(){} - - string name() const { return "BreitWigner3body"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - - void updatePar( const AmpParameter& par ); - -#ifdef GPU_ACCELERATION - - bool isGPUEnabled() const { return false; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter m_mass0; - AmpParameter m_width0; - - string m_daughters; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/GPUBreitWigner_kernel.cu b/src/libraries/AMPTOOLS_AMPS/GPUBreitWigner_kernel.cu deleted file mode 100644 index 2601f1dde7..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/GPUBreitWigner_kernel.cu +++ /dev/null @@ -1,94 +0,0 @@ - -#include - -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - -#include "AMPTOOLS_AMPS/breakupMomentum.cuh" -#include "AMPTOOLS_AMPS/barrierFactor.cuh" - -__global__ void -GPUBreitWigner_kernel( GPU_AMP_PROTO, GDouble mass0, GDouble width0, - GDouble orbitL, int daught1, int daught2 ){ - - int iEvent = GPU_THIS_EVENT; - - // decode the list of daughter indices in each integer - // be careful to handle the zero index correctly - - GDouble p1[4] = { 0, 0, 0, 0 }; - if( daught1 == 0 ){ - - GDouble tmp[4] = GPU_P4(0); - for( int i = 0; i < 4; ++i ) p1[i] += tmp[i]; - } - else if( daught1 > 0 ){ - - while( daught1 > 0 ){ - - int ind = daught1 % 10; - GDouble tmp[4] = GPU_P4(ind); - for( int i = 0; i < 4; ++i ) p1[i] += tmp[i]; - daught1 /= 10; - } - } - - - GDouble p2[4] = { 0, 0, 0, 0 }; - if( daught2 == 0 ){ - - GDouble tmp[4] = GPU_P4(0); - for( int i = 0; i < 4; ++i ) p2[i] += tmp[i]; - } - else if( daught2 > 0 ){ - - while( daught2 > 0 ){ - - int ind = daught2 % 10; - GDouble tmp[4] = GPU_P4(ind); - for( int i = 0; i < 4; ++i ) p2[i] += tmp[i]; - daught2 /= 10; - } - } - - - GDouble mass = SQ( p1[0] + p2[0] ); - GDouble mass1 = SQ( p1[0] ); - GDouble mass2 = SQ( p2[0] ); - - for( int i = 1; i <= 3; ++i ){ - - mass -= SQ( p1[i] + p2[i] ); - mass1 -= SQ( p1[i] ); - mass2 -= SQ( p2[i] ); - } - - mass = G_SQRT( mass ); - mass1 = G_SQRT( mass1 ); - mass2 = G_SQRT( mass2 ); - - GDouble q = fabs( breakupMomentum( mass, mass1, mass2 ) ); - GDouble q0 = fabs( breakupMomentum( mass0, mass1, mass2 ) ); - - GDouble F = barrierFactor( q, orbitL ); - GDouble F0 = barrierFactor( q0, orbitL ); - - GDouble width = width0*(mass0/mass)*(q/q0)*((F*F)/(F0*F0)); -// GDouble width = width0; - - WCUComplex bwTop = { G_SQRT( mass0 * width0 / 3.1416 ), 0 }; - WCUComplex bwBot = { SQ( mass0 ) - SQ( mass ), -1.0 * mass0 * width }; - - pcDevAmp[iEvent] = ( F * bwTop / bwBot ); -} - - -void -GPUBreitWigner_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - GDouble mass, GDouble width, int orbitL, - int daught1, int daught2 ) -{ - - GPUBreitWigner_kernel<<< dimGrid, dimBlock >>> - ( GPU_AMP_ARGS, mass, width, orbitL, daught1, daught2 ); -} diff --git a/src/libraries/AMPTOOLS_AMPS/GPUThreePiAngles_kernel.cu b/src/libraries/AMPTOOLS_AMPS/GPUThreePiAngles_kernel.cu deleted file mode 100644 index fe92971dbc..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/GPUThreePiAngles_kernel.cu +++ /dev/null @@ -1,144 +0,0 @@ -/* - * GPUThreePiAngles_kernel.cu - * GlueXTools - * - * Created by Matthew Shepherd on 6/16/10. - * Copyright 2010 Home. All rights reserved. - * - */ - - -#include - -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - -#include "AMPTOOLS_AMPS/breakupMomentum.cuh" - -#include "GPUUtils/lorentzBoost.cuh" -#include "GPUUtils/threeVector.cuh" -#include "GPUUtils/wignerD.cuh" -#include "GPUUtils/clebsch.cuh" - -__global__ void -GPUThreePiAngles_kernel( GPU_AMP_PROTO, int polBeam, GDouble polFrac, int jX, - int parX, int iX, int lX, int jI, int iI, int iZ0, - int iZ1, int iZ2 ){ - - int iEvent = GPU_THIS_EVENT; - - GDouble beam[4] = GPU_P4(0); - GDouble recoil[4] = GPU_P4(1); - GDouble p1[4] = GPU_P4(2); - GDouble p2[4] = GPU_P4(3); - GDouble p3[4] = GPU_P4(4); - - GDouble alpha = phi( &(recoil[1]) ); - - GDouble res[4]; - GDouble iso[4]; - - for( int i = 0; i < 4; ++i ){ - - iso[i] = p1[i] + p2[i]; - res[i] = iso[i] + p3[i]; - } - - GDouble resMass = G_SQRT(res[0]*res[0]-res[1]*res[1]-res[2]*res[2]-res[3]*res[3]); - GDouble isoMass = G_SQRT(iso[0]*iso[0]-iso[1]*iso[1]-iso[2]*iso[2]-iso[3]*iso[3]); - GDouble p1Mass = G_SQRT(p1[0]*p1[0]-p1[1]*p1[1]-p1[2]*p1[2]-p1[3]*p1[3]); - GDouble p2Mass = G_SQRT(p2[0]*p2[0]-p2[1]*p2[1]-p2[2]*p2[2]-p2[3]*p2[3]); - GDouble p3Mass = G_SQRT(p3[0]*p3[0]-p3[1]*p3[1]-p3[2]*p3[2]-p3[3]*p3[3]); - - GDouble k = breakupMomentum( resMass, isoMass, p3Mass ); - GDouble q = breakupMomentum( isoMass, p1Mass, p2Mass ); - - boostToRest( beam , res ); - boostToRest( recoil , res ); - boostToRest( p3 , res ); - - // now beam, recoil, iso, and p1 are at rest in the resonance frame - - // create the z axis in this frame - GDouble zRes[3] = { -recoil[1], -recoil[2], -recoil[3] }; - makeUnit( zRes ); - - // create the y axis from the cross product of the beam with z - GDouble yRes[3] = { beam[1], beam[2], beam[3] }; - cross( yRes, zRes ); - makeUnit( yRes ); - - // defines x and replaces it with the cross product - // of y and z - GDouble xRes[3] = { yRes[0], yRes[1], yRes[2] }; - cross( xRes, zRes ); - - // rewrite the isobar direction in this coordinate system - GDouble angRes[3] = { dot( &(p3[1]), xRes ), - dot( &(p3[1]), yRes ), - dot( &(p3[1]), zRes ) }; - - // and record the angles - GDouble cosThRes = cosTheta( angRes ); - GDouble phiAngRes = phi( angRes ); - - boostToRest( p1 , iso ); - - GDouble angIso[3] = { dot( &(p1[1]), xRes ), - dot( &(p1[1]), yRes ), - dot( &(p1[1]), zRes ) }; - - GDouble cosThIso = cosTheta( angIso ); - GDouble phiAngIso = phi( angIso ); - - WCUComplex i = { 0, 1 }; - WCUComplex one = { 1, 0 }; - WCUComplex ans = { 0, 0 }; - - // a prefactor the matrix elements that couple negative helicity - // photons to the final state - WCUComplex negResHelProd = ( polBeam == 0 ? - ( one * G_COS( 2 * alpha ) + i * G_SIN( 2 * alpha ) ) : - ( one * G_COS( 2 * alpha ) + i * G_SIN( 2 * alpha ) ) * -1 ); - negResHelProd *= ( jX % 2 == 0 ? -parX : parX ); - - // in general we also need a sum over resonance helicities here - // however, we assume a production mechanism that only produces - // resonance helicities +-1 - - for( int mL = -lX; mL <= lX; ++mL ){ - - WCUComplex term = { 0, 0 }; - - for( int mI = -jI; mI <= jI; ++mI ){ - - // CAREFUL!! ordering of arguments for GPU routine clebsch - // is different from CPU routine clebschGordan - - term += Y( jI, mI, cosThIso, phiAngIso ) * - ( negResHelProd * clebsch( jI, mI, lX, mL, jX, -1 ) + - clebsch( jI, mI, lX, mL, jX, 1 ) ); - } - - term *= Y( lX, mL, cosThRes, phiAngRes ); - ans += term; - } - - ans *= ( polBeam == 0 ? ( 1 + polFrac ) / 4 : ( 1 - polFrac ) / 4 ); - - pcDevAmp[iEvent] = ans * - clebsch( 1, iZ0, 1, iZ1, iI, iZ0 + iZ1 ) * - clebsch( iI, iZ0 + iZ1, 1, iZ2, iX, iZ0 + iZ1 + iZ2 ) * - ::pow( k, lX ) * ::pow( q, jI ); -// G_POW( k, lX ) * G_POW( q, jI ); -} - -void -GPUThreePiAngles_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int polBeam, GDouble polFrac, int jX, int parX, int iX, - int lX, int jI, int iI, int iZ0, int iZ1, int iZ2 ) -{ - GPUThreePiAngles_kernel<<< dimGrid, dimBlock >>> - ( GPU_AMP_ARGS, polBeam, polFrac, jX, parX, iX, lX, jI, iI, iZ0, iZ1, iZ2 ); -} - diff --git a/src/libraries/AMPTOOLS_AMPS/GPUTwoPSAngles_kernel.cu b/src/libraries/AMPTOOLS_AMPS/GPUTwoPSAngles_kernel.cu deleted file mode 100644 index 89c2a45249..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/GPUTwoPSAngles_kernel.cu +++ /dev/null @@ -1,64 +0,0 @@ - -#include - -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - -#include "GPUUtils/lorentzBoost.cuh" -#include "GPUUtils/threeVector.cuh" -#include "GPUUtils/wignerD.cuh" - -__global__ void -GPUTwoPSAngles_kernel( GPU_AMP_PROTO, int j, int m, GDouble bigTheta, - GDouble refFact ){ - - int iEvent = GPU_THIS_EVENT; - - GDouble beam[4] = GPU_P4(0); - GDouble recoil[4] = GPU_P4(1); - GDouble p1[4] = GPU_P4(2); - GDouble p2[4] = GPU_P4(3); - - GDouble res[4]; - - for( int i = 0; i < 4; ++i ) res[i] = p1[i] + p2[i]; - - boostToRest( beam , res ); - boostToRest( recoil , res ); - boostToRest( p1 , res ); - - GDouble z[3] = { beam[1], beam[2], beam[3] }; - makeUnit( z ); - - GDouble y[3] = { recoil[1], recoil[2], recoil[3] }; - cross( y, z ); - makeUnit( y ); - - // defines x and replaces it with the cross product - // of y and z - GDouble x[3] = { y[0], y[1], y[2] }; - cross( x, z ); - - GDouble ang[3] = { dot( &(p1[1]), x ), - dot( &(p1[1]), y ), - dot( &(p1[1]), z ) }; - - GDouble cosTh = cosTheta( ang ); - GDouble phiAng = phi( ang ); - - GDouble coef = sqrt( ( 2. * j + 1 ) / ( 4 * 3.1416 ) ); - - pcDevAmp[iEvent] = - ( coef * bigTheta * - ( wignerD( j, m, 0, cosTh, phiAng ) - - refFact * wignerD( j, -m, 0, cosTh, phiAng ) ) ); - -} - -void -GPUTwoPSAngles_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ) -{ - GPUTwoPSAngles_kernel<<< dimGrid, dimBlock >>> - ( GPU_AMP_ARGS, j, m, bigTheta, refFact ); -} diff --git a/src/libraries/AMPTOOLS_AMPS/GPUUniform_kernel.cu b/src/libraries/AMPTOOLS_AMPS/GPUUniform_kernel.cu deleted file mode 100644 index 2fbfa3a133..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/GPUUniform_kernel.cu +++ /dev/null @@ -1,21 +0,0 @@ - -#include - -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - - -__global__ void -GPUUniform_kernel(GPU_AMP_PROTO) -{ - - WCUComplex ans = { 1, 0}; - pcDevAmp[GPU_THIS_EVENT] = ans; - -} - -void -GPUUniform_exec(dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO) -{ - GPUUniform_kernel<<< dimGrid, dimBlock >>>(GPU_AMP_ARGS); -} diff --git a/src/libraries/AMPTOOLS_AMPS/GPUb1piAngAmp_kernel.cu b/src/libraries/AMPTOOLS_AMPS/GPUb1piAngAmp_kernel.cu deleted file mode 100644 index 0b934e1212..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/GPUb1piAngAmp_kernel.cu +++ /dev/null @@ -1,686 +0,0 @@ -/* - * GPUb1piAngAmp_kernel.cu - * - */ - -#include -#include "cuda.h" - -// Original headers were scattered around file system -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - -#include "GPUUtils/lorentzBoost.cuh" -#include "GPUUtils/threeVector.cuh" -#include "GPUUtils/wignerD.cuh" -#include "GPUUtils/clebsch.cuh" - -#include "AMPTOOLS_AMPS/breakupMomentum.cuh" -#include "AMPTOOLS_AMPS/barrierFactor.cuh" - - -// Test headers -#if 0 -#include "GPUCustomTypes.h" -#include "CUDA-Complex.cuh" - -#include "lorentzBoost.cuh" -#include "threeVector.cuh" -#include "wignerD.cuh" -#include "clebsch.cuh" - -#include "breakupMomentum.cuh" -#include "barrierFactor.cuh" -#endif - - - -#define ADD4(a,b) { a[0]+b[0], a[1]+b[1], a[2]+b[2], a[3]+b[3] } - -#define MASS(v) (G_SQRT(v[0]*v[0]-v[1]*v[1]-v[2]*v[2]-v[3]*v[3])) - -#define Nterm(J) (G_SQRT((2*J+1)/(4*M_PI))) - - -// Macro to ease definition of loops -#define LOOP(INDEX,START,END,INC) for (int INDEX=START;INDEX<=END;INDEX+=INC) - - -static __device__ void //note: 4-vector input presumed -rotateZ( GDouble* v, GDouble phi ){ - GDouble sinphi = G_SIN(phi); - GDouble cosphi = G_COS(phi); - GDouble tx; - tx = v[1] * cosphi - v[2] * sinphi; - v[2] = v[2] * cosphi + v[1] * sinphi; - v[1] = tx; -} - -static __device__ void //note: 4-vector input presumed -rotateY ( GDouble* v, GDouble theta) { - double sinphi = G_SIN(theta); - double cosphi = G_COS(theta); - double tz; - tz = v[3] * cosphi - v[1] * sinphi; - v[1] = v[1] * cosphi + v[3] * sinphi; - v[3] = tz; -} - -static __device__ GDouble //note: 3-vector input presumed -theta( GDouble* pv ){ - GDouble r= G_SQRT(pv[0]*pv[0] + pv[1]*pv[1]); - return G_ATAN2( r , pv[2] ); -} - - -static __device__ void -MoveToRF(GDouble *parent, GDouble *daughter) -{ - GDouble *par3vec=parent+1; - rotateZ( daughter , -phi(par3vec) ); - rotateY( daughter , -theta(par3vec) ); - - GDouble beta[]={0,0, -G_SQRT(dot(par3vec,par3vec))/parent[0]}; - //** (x) Might this be bootToRest??? - // beta is defined to boost to parent's rest frame - // I just adapted GPUUtil boost fcn with vector beta input - boost( daughter , beta ); - -} - - - -static __device__ WCUComplex -BreitWigner_loc(GDouble m0, GDouble Gamma0, int L, - GDouble *P1, GDouble *P2) -{ - - GDouble Ptot[4] = ADD4(P1, P2); - GDouble m = MASS(Ptot); - GDouble mass1 = MASS(P1); - GDouble mass2 = MASS(P2); - - - // assert positive breakup momenta - GDouble q0 = fabs( breakupMomentum(m0, mass1, mass2) ); - GDouble q = fabs( breakupMomentum(m, mass1, mass2) ); - - //printf("BW: (%5.3f, %5.3f, %d) m=%6.4f m1=%6.4f m2=%6.4f q=%6.4f q0=%6.4f\n", - // m0,Gamma0,L,m,mass1,mass2,q,q0); - - GDouble F0 = L==0 ? 1.0 : barrierFactor(q0, L); - GDouble F = L==0 ? 1.0 : barrierFactor(q, L); - - GDouble width_coef=Gamma0*(m0/m); - //GDouble qq0=q/q0; - //GDouble width_qdep = (L==0 ? qq0 : (L==1 ? qq0*qq0*qq0 : pow(qq0,2*L+1)))*((F*F)/(F0*F0)); - GDouble width_qdep = q/q0 * (F*F)/(F0*F0); - //GDouble num_qdep = (L==0 ? q : (L==1 ? q*q*q : pow(q,2*L+1)))*(F*F); - GDouble num_qdep = q*(F*F); - - GDouble width = width_coef * width_qdep; - - //complex bwtop(m0 * width, 0.0 ); - WCUComplex bwtop = { G_SQRT(m0*width_coef) * num_qdep, 0 }; - - WCUComplex bwbottom = { m0*m0 - m*m , -1.0 * ( m0 * width ) }; - - return ( bwtop / bwbottom ); - -} - - -// JR 2012-07-29 -// Set all Amplitudes to 0 on the Device. This is needed now because we only -// calculate amplitudes for those momenta sets with non-zero amplitudes. If -// this function were not performed, amplitudes which are supposed to be zero will -// be undefined. -__global__ void Setzero_kernel(WCUComplex *pcDevAmp, int iNEvents) { - int iEvent = GPU_THIS_EVENT; - if (iEvent>=iNEvents) return; - pcDevAmp[iEvent].m_dRe = 0.0; - pcDevAmp[iEvent].m_dIm = 0.0; -} - - -// JR 2012-07-29 -// Perform beginning of b1pi calculation, just enough to determine those -// amplitude which will be set to zero. Amplitudes are set to (1,0) if -// they are not zero. These amplitudes will need set to their correct -// values on the call to GPUb1piAngAmp_kernel(). -__global__ void Pretest_kernel( GPU_AMP_PROTO , int polBeam, GDouble polFrac, - int J_X, int Par_X, int L_X, int I_X, int epsilon_R, int Iz_b1, int Iz_pi, - GDouble u_rho_1, GDouble u_rho_3, GDouble u_omega_1, GDouble u_omega_3, - GDouble u_b1_0, GDouble u_b1_2, - GDouble G0_omega, GDouble G0_b1, bool orthocheck) -{ - // Calculate event for this thread. - int iEvent = GPU_THIS_EVENT; - WCUComplex CZero = { 0, 0 }; - WCUComplex COne = { 1, 0 }; - - int pol=(polBeam==1 ? +1 : -1); // y and x-pol. respectively - - //** (x) This statement can be evaluated at top of function? - if (J_X==0 && Par_X*pol*epsilon_R==-1) { - pcDevAmp[iEvent] = CZero; - return; - } - - GDouble m0_omega = 0.783; - GDouble m0_b1 = 1.223; - bool isZero; - - - // Copy four-vectors for this thread from global memory. - GDouble b1s_pi [4] = GPU_P4(3); - GDouble omegas_pi[4] = GPU_P4(4); - GDouble rhos_pim [4] = GPU_P4(5); - GDouble rhos_pip [4] = GPU_P4(6); - - // Make four-vector sums - GDouble rho [4] = ADD4(rhos_pip, rhos_pim ); - GDouble omega [4] = ADD4(rho, omegas_pi); - GDouble b1 [4] = ADD4(omega, b1s_pi); - - // Store mass of b1; for other vectors we can calculate mass on the fly. - GDouble b1mass = MASS(b1); - - // Is this term zero? - isZero = MASS(rho)+0.135 > m0_omega+3*G0_omega; - isZero |= fabs(MASS(omega)-m0_omega) > 3*G0_omega; - isZero |= fabs(b1mass-m0_b1) > 3*G0_b1; - isZero |= b1mass < (m0_omega - 3*G0_omega); - if (isZero) pcDevAmp[iEvent] = CZero; - else pcDevAmp[iEvent] = COne; -} - - - - - - -// JR 2012-07-29 -// Calculate amplitudes only for those momenta sets with known non-zero -// amplitudes. -__global__ void -GPUb1piAngAmp_kernel( - int cnt, - // GPU_AMP_PROTO , - GDouble* pfDevData, WCUComplex* pcDevAmp, int* piDevPerm, int iNParticles, int iNEvents, - int polBeam, GDouble polFrac, - int J_X, int Par_X, int L_X, int I_X, int epsilon_R, int Iz_b1, int Iz_pi, - GDouble u_rho_1, GDouble u_rho_3, GDouble u_omega_1, GDouble u_omega_3, - GDouble u_b1_0, GDouble u_b1_2, - GDouble G0_omega, GDouble G0_b1, bool orthocheck) -{ - - // Calculate event for this thread. - // int iEvent = GPU_THIS_EVENT; - - // JR 2012-07-29 - // NOTE: This vesrsion of this function is called with different settings - // for threadIdx, blockIdx and blockDim than for the original version. - // The next line relects that change. - int iEvent = threadIdx.x + blockIdx.x * blockDim.x; - - // Skip this event index if it overruns number of events. - if (iEvent>=iNEvents) return; - - WCUComplex CZero = { 0, 0 }; - WCUComplex i = { 0, 1 }; - WCUComplex COne = { 1, 0 }; - - int pol=(polBeam==1 ? +1 : -1); // y and x-pol. respectively - - if (J_X==0 && Par_X*pol*epsilon_R==-1) { - pcDevAmp[iEvent] = CZero; - return; - } - - int m_X; - GDouble u_rho, u_omega, u_b1; - GDouble InvSqrt2 = 1.0/G_SQRT(2.0); - GDouble m0_rho = 0.775; - GDouble G0_rho = 0.149; - GDouble m0_omega = 0.783; - GDouble m0_b1 = 1.223; - bool useCutoff = true; - bool isZero; - - // Copy four-vectors for this thread from global memory. - // 2012-05-19 JR rhos_pip0,omega0,rho0 added for use - // in BreitWigner_loc() below. - GDouble beam [4] = GPU_P4(0); - GDouble recoil [4] = GPU_P4(1); - GDouble Xs_pi [4] = GPU_P4(2); - GDouble b1s_pi [4] = GPU_P4(3); - GDouble omegas_pi[4] = GPU_P4(4); - GDouble rhos_pim [4] = GPU_P4(5); - GDouble rhos_pip [4] = GPU_P4(6); - GDouble rhos_pip0[4] = GPU_P4(6); - - // Make four-vector sums - GDouble rho [4] = ADD4(rhos_pip, rhos_pim ); - GDouble rho0 [4] = ADD4(rhos_pip, rhos_pim ); - GDouble omega [4] = ADD4(rho, omegas_pi); - GDouble omega0[4] = ADD4(rho, omegas_pi); - GDouble b1 [4] = ADD4(omega, b1s_pi); - - - // Store mass of b1; for other vectors we can calculate mass on the fly. - GDouble b1mass = MASS(b1); - - // Is this term zero? - if (useCutoff) { - isZero = MASS(rho)+0.135 > m0_omega+3*G0_omega; - isZero |= fabs(MASS(omega)-m0_omega) > 3*G0_omega; - isZero |= fabs(b1mass-m0_b1) > 3*G0_b1; - isZero |= b1mass < (m0_omega - 3*G0_omega); - // Zero amplitude - if (isZero) { - pcDevAmp[iEvent] = CZero; - return; - } - } - - // Continue to Calculate amplitude - GDouble X[4] = ADD4(b1, Xs_pi); - - GDouble q = breakupMomentum( MASS(X), b1mass, MASS(Xs_pi) ); - - GDouble alpha = phi( &(recoil[1]) ); - - // NOTE: Values of beam and recoil are changed below. - boostToRest (beam, X); - boostToRest (recoil, X); - - // Define new coordinate system with - // - beam parallel to z direction - // - recoil in the x,z plain (i.e., y is normal to recoil and beam) - // - y is normal to beam and recoil. - GDouble zGJ[3] = { beam[1], beam[2], beam[3] }; - makeUnit( zGJ ); - - //** (x) Be care of cross order, need to check this - // 2012-05-19 JR - Invert yGJ to make cross come out right. - // GDouble yGJ[3] = { recoil[1], recoil[2], recoil[3] }; - GDouble yGJ[3] = { -recoil[1], -recoil[2], -recoil[3] }; - cross( yGJ, zGJ ); - makeUnit( yGJ ); - - GDouble xGJ[3] = { yGJ[0], yGJ[1], yGJ[2] }; - cross( xGJ, zGJ ); - - //particles to rest frames of their parents - boostToRest (b1, X); - boostToRest (omega, X); - boostToRest (rho, X); - boostToRest (rhos_pip, X); - - // Note that in this form of the cascade of boosts, we are not - // saving the 4-vecs in their intermediate RF, but going sequentially - // straight to their immediate parent's RF. - // Make sure to verify that the intermediares were not in fact needed - // and that we didn't break anything with this simplification. - MoveToRF(b1,omega); - MoveToRF(b1,rho); MoveToRF(omega,rho); - MoveToRF(b1,rhos_pip); MoveToRF(omega,rhos_pip); MoveToRF(rho,rhos_pip); - - GDouble *b1_3vec=b1+1; - GDouble ang_b1[]={dot(b1_3vec, xGJ), - dot(b1_3vec, yGJ), - dot(b1_3vec, zGJ)}; - GDouble b1_XRF_cosTheta = cosTheta(ang_b1); - GDouble b1_XRF_phi = phi(ang_b1); - - GDouble rho_omegaRF_cosTheta = cosTheta(rho+1); - GDouble rho_omegaRF_phi = phi(rho+1); - GDouble rhos_pip_rhoRF_cosTheta = cosTheta(rhos_pip+1); - GDouble rhos_pip_rhoRF_phi = phi(rhos_pip+1); - GDouble omega_b1RF_cosTheta = cosTheta(omega+1); - GDouble omega_b1RF_phi = phi(omega+1); - -/* - List_l_R: 0 1 - List_J_rho: 1 - List_l_rho: -1 1 - List_L_omega: 1 - List_l_omega: -1 0 1 - List_L_b1: 0 2 - List_l_b1: -1 0 1 -*/ - - // SUMMATION GUIDE: - // notation meant to resemble TeX symbols in derivation - // exception: pol = \epsilon_\gamma - // l -> lambda, indicating helicity - // u_[particle](q.n.) -> amplitude strength coefficient - - int l_R_lim = J_X + 1; - - //shortcut: CB(L_X, J_b1, 0, l_b1 ; J_X, l_b1) vanishes when - // = CB(1, 1, 0, 0 ; 1, 0), so omit l_b1=0 when J_X=L_X=1 - int l_b1_inc = L_X==1 && J_X==1 ? 2 : 1; - - // restrict omega decay to just p wave - int L_omega_lim = 1; // set to 3 to allow F wave - int L_Rsign_lim; - - GDouble cosAlpha=G_COS(alpha), sinAlpha=G_SIN(alpha); - WCUComplex expFact = {cosAlpha, sinAlpha}; - WCUComplex expFact_conj = {cosAlpha, -sinAlpha}; - - WCUComplex ThelSum = { 0 , 0 }; - - // Setup dependent loop limits - LOOP(l_gamma, -1, 1, 2) { - - - LOOP(l_R, 0, l_R_lim, 1) { - if(l_R==0 && epsilon_R==-1) continue; - // LOOP(l_R, (1-epsilon_R)/2, l_R_lim, 1) // if this still causes some GPU core - // misalignment, try setting lower bound back to zero and tacking on - // * !(l_R==0 && epsilon_R==-1) - // to the long list of factors multiplying Thelsum below -IS - - - //summing positive and negative helicity terms of R's reflectivity state - L_Rsign_lim = l_R > 0 ? -1 : +1; - // Switch order of loop, because LOOP can only handle increasing increments - // LOOP(l_Rsign, 1, L_Rsign_lim, -2) - LOOP(l_Rsign, L_Rsign_lim, 1, 2) { - - m_X = l_gamma - l_Rsign * l_R; - if (m_X==0) { - //testing for cancelation in |J 0>+pol*P*epsilon_R*(-1)^J|J 0> - if(Par_X*pol*epsilon_R == (J_X % 2 ==0 ? -1:+1)) continue; - } else { - //enforcing that the selected projection <= vector magnitude - if( abs(m_X)>J_X) continue; - } - - - WCUComplex l_b1DepTerm = {0,0}; - LOOP(l_b1, -1,1,l_b1_inc) { - - - WCUComplex L_b1DepTerm = {0,0}; - - LOOP(L_b1,0,2,2) { - - - WCUComplex l_omegaDepTerm = {0,0}; - // 2012-05-19 JR Fix l_omega loop - // LOOP(l_omega,-1,0,1) - LOOP(l_omega,-1,1,1) { - - WCUComplex L_omegaDepTerm = {0,0}; - LOOP(L_omega, 1, L_omega_lim, 2) { - - WCUComplex J_rhoDepTerm = {0,0}; - LOOP(J_rho, 1, L_omega_lim, 2) { - - //enforces triang. ineq. betw. J_omega=1, J_rho and L_omega - // in effect, L_omega and J_rho take identical values - if( abs(J_rho-L_omega) > 1) continue; - - - WCUComplex l_rhoDepTerm = {0,0}; - LOOP(l_rho,-1,1,1) { - //shortcut CB(1,1,0,0;1,0)=0 - if(L_omega==1 && J_rho==1 && l_rho==0) continue; - - l_rhoDepTerm += - Conjugate(wignerD(1, l_omega, l_rho, - rho_omegaRF_cosTheta, rho_omegaRF_phi)) - * clebsch(L_omega, 0, J_rho, l_rho, 1, l_rho) - * Y(J_rho, l_rho, rhos_pip_rhoRF_cosTheta, rhos_pip_rhoRF_phi); - } - - u_rho = J_rho==1 ? u_rho_1 : (J_rho==3 ? u_rho_3 : 0); - J_rhoDepTerm += u_rho * l_rhoDepTerm * - BreitWigner_loc(m0_rho,G0_rho, J_rho,rhos_pip0,rhos_pim); - } - - J_rhoDepTerm *= BreitWigner_loc(m0_omega, G0_omega, L_omega, omegas_pi,rho0); - - u_omega = L_omega==1 ? u_omega_1 : (L_omega==3 ? u_omega_3 : 0); - L_omegaDepTerm += u_omega * J_rhoDepTerm * Nterm(L_omega); - } - - l_omegaDepTerm += L_omegaDepTerm * - clebsch(L_b1, 0, 1, l_omega, 1, l_omega) * - Conjugate(wignerD(1, l_b1, l_omega, - omega_b1RF_cosTheta, omega_b1RF_phi)); - } - - l_omegaDepTerm *= BreitWigner_loc(m0_b1, G0_b1, L_b1, b1s_pi, omega0); - - u_b1 = L_b1==0 ? u_b1_0 : (L_b1==2 ? u_b1_2 : 0); - L_b1DepTerm += u_b1 * l_omegaDepTerm * Nterm(L_b1); - } - //-- (_) understand why assignment here produces: - // KERNEL LAUNCH ERROR [b1piAngAmp]: the launch timed out and was terminated - // assigning/incrementing integers causes no problems - - l_b1DepTerm += L_b1DepTerm * - Conjugate(wignerD(J_X, m_X, l_b1, b1_XRF_cosTheta, b1_XRF_phi)) * - clebsch(L_X, 0, 1, l_b1, J_X, l_b1); - } - - ThelSum += l_b1DepTerm - //to account for |eps_g> ~ (|1,-1>exp(-ia)-pol|1,+1>exp(ia)) - * (l_gamma==1 ? (-pol)*expFact : expFact_conj) - //Assemble reflectivity eigenvector with epsilon_X=pol*epslion_R - * (GDouble) (m_X<0 ? Par_X*pol*epsilon_R*((J_X-m_X) % 2 == 0 ? +1:-1) : 1) - * (GDouble) (m_X == 0 ? 1.0 : InvSqrt2 ) - // to apply th(l_R) reflectivity state prefactor: - // m=0: 1/2 m>0: 1/sqrt(2) m<0: 0 (last just skipped in this sum) - * (GDouble) (l_R > 0 ? InvSqrt2 : 1.0 ) - //apply coefficients to the reflectivity basis terms: - * (GDouble) (l_Rsign==1 ? 1 : epsilon_R) - ; //v(*epsilon_R) * - - } - } - } - - ThelSum *= Nterm(L_X) * - // barrier factor -// (GDouble)(L_X==0 ? 1.0 : (L_X==1 ? q : G_POW(q,L_X))) * - (GDouble)(L_X==0 ? 1.0 : (L_X==1 ? q : ::pow(q,L_X))) * - // to apply polarization fraction weights: - (GDouble)G_SQRT((1.0-pol*polFrac)*0.5) * //(1+g) for x-pol, (1-g) for y-pol - (pol==1 ? i : COne)*InvSqrt2 * //to account for |eps_g> ~ sqrt(-eps/2) - clebsch(1, Iz_b1, 1, Iz_pi, I_X, Iz_b1 + Iz_pi); - pcDevAmp[iEvent] = ThelSum; - - -} - - - - - -#ifdef DEBUG -// This is for debugging -// It reads the amplitdues and momemta vectors from the CUDA device and prints them. -void -printCudaArrays(GDouble* pfDevData, WCUComplex* pcDevAmp, int* piDevPerm, int iNParticles, int iNEvents, int cnt) { - - // Read amplitudes from GPU to CPU - GDouble *amp = (GDouble *) malloc (iNEvents * 2 * sizeof(GDouble)); - cudaMemcpy (amp, pcDevAmp, iNEvents * 2 * sizeof(GDouble), cudaMemcpyDeviceToHost); - - // Copy 4momenta from GPU to CPU - make part() big enough to hold the entire set of momenta - GDouble *part = (GDouble *) malloc (iNEvents * 4 * iNParticles * sizeof(GDouble)); - cudaMemcpy (part, pfDevData, iNEvents * 4 * iNParticles * sizeof(GDouble), cudaMemcpyDeviceToHost); - - // Print arrays - int ievent, ipart, idim; - int ndim = 4; - for (ievent=0; ievent>> - ( - // GPU_AMP_ARGS, - pfDevData, pcDevAmp, piDevPerm, iNParticles, iNEvents, - polBeam, polFrac, - J_X, Par_X, L_X, I_X, epsilon_R, Iz_b1, Iz_pi, - u_rho_1, u_rho_3, u_omega_1, u_omega_3, u_b1_0, u_b1_2, - G0_omega, G0_b1, orthocheck ); -// printf("test: after call to Pretest_kernel()\n"); - - - // Copy pcDevAmp from device to host */ - GDouble *hostAmp = (GDouble *) malloc(2*iNEvents*sizeof(GDouble)); - cudaMemcpy (hostAmp, pcDevAmp, 2*iNEvents*sizeof(GDouble), cudaMemcpyDeviceToHost); - - // Initialize all on-device amplitudes to zero - Setzero_kernel<<< dimGrid, dimBlock >>>(pcDevAmp,iNEvents); -// printf("test: after call to Setzero_kernel()\n"); - - - // Count number of nonZero amplitudes - for (i=0;i>> - ( - cnt, - // GPU_AMP_ARGS, - // pfDevData, pcDevAmp, piDevPerm, iNParticles, nonZero, - part_dev, pcDevAmp, piDevPerm, iNParticles, nonZero, - polBeam, polFrac, - J_X, Par_X, L_X, I_X, epsilon_R, Iz_b1, Iz_pi, - u_rho_1, u_rho_3, u_omega_1, u_omega_3, u_b1_0, u_b1_2, - G0_omega, G0_b1, orthocheck ); -// printf("test: after call to GUPb1piAngAmp_kernel()\n"); - - // Read amplitudes from GPU to CPU - GDouble *amp = (GDouble *) malloc (iNEvents * 2 * sizeof(GDouble)); - cudaMemcpy (amp, pcDevAmp, iNEvents * 2 * sizeof(GDouble), cudaMemcpyDeviceToHost); - -// printf("test: after copy Amp to Host\n"); - - - // Re-arrange location of amplitudes on GPU to match original distribution of vectors - // Progress through the index array backward. - k = iNEvents; - for (i=nonZero-1;i>=0;i--) { - // Zero those elements between this element and last. - for (j=nonZeroIndices[i]+1;j - -#include "GPUManager/GPUCustomTypes.h" -#include "GPUManager/CUDA-Complex.cuh" - - - - - -__global__ void -GPUpolCoef_kernel(GPU_AMP_PROTO , int polBeam, GDouble polFrac) -{ - int pol=(polBeam==1 ? +1 : -1); // y and x-pol. respectively - - //(1+g) for x-pol, (1-g) for y-pol - WCUComplex ans = { sqrt((1.0-pol*polFrac)*0.5), 0 }; - - pcDevAmp[GPU_THIS_EVENT] = ans; - -} - -void -GPUpolCoef_exec(dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int polBeam, GDouble polFrac) -{ - GPUpolCoef_kernel<<< dimGrid, dimBlock >>> - ( GPU_AMP_ARGS, polBeam, polFrac ); - -} diff --git a/src/libraries/AMPTOOLS_AMPS/Pi0Regge.cc b/src/libraries/AMPTOOLS_AMPS/Pi0Regge.cc deleted file mode 100644 index 71eb7fe651..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Pi0Regge.cc +++ /dev/null @@ -1,111 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/Pi0Regge.h" - -#include - -Pi0Regge::Pi0Regge( const vector< string >& args ) : -UserAmplitude< Pi0Regge >( args ) -{ - assert( args.size() == 1 ); - // Polarization plane angle (PARA = 0 and PERP = PI/2) - PolPlane = atof( args[0].c_str() ); - - // Initialize coherent brem table - // Do this over the full range since we will be using this as a lookup - float Emax = 12.0; - float Epeak = 9.0; - float Elow = 0.135; - float Ehigh = 12.0; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - totalFlux_vs_E = new TH1D("totalFlux_vs_E", "Total Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFlux_vs_E = new TH1D("polFlux_vs_E", "Polarized Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFrac_vs_E = new TH1D("polFrac_vs_E", "Polarization Fraction vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill totalFlux - for(int i=1;i<=totalFlux_vs_E->GetNbinsX(); i++){ - double x = totalFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - doPolFlux=1; - cobrems.setPolarizedFlag(doPolFlux); - // Fill totalFlux - for(int i=1;i<=polFlux_vs_E->GetNbinsX(); i++){ - double x = polFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - polFrac_vs_E->Divide(polFlux_vs_E, totalFlux_vs_E); -} - - -complex< GDouble > -Pi0Regge::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector target ( 0., 0., 0., 0.938); - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - - TLorentzVector cm = recoil + p1; - TLorentzRotation cmBoost( -cm.BoostVector() ); - - TLorentzVector beam_cm = cmBoost * beam; - TLorentzVector target_cm = cmBoost * target; - TLorentzVector recoil_cm = cmBoost * recoil; - - // phi dependence needed for polarized distribution - TLorentzVector p1_cm = cmBoost * p1; - GDouble phi = p1_cm.Phi() + PolPlane*TMath::Pi()/180.; - GDouble cos2Phi = cos(2.*phi); - - // polarization from cobrem.F - int bin = polFrac_vs_E->GetXaxis()->FindBin(beam.E()); - GDouble Pgamma; - if (bin == 0 || bin > polFrac_vs_E->GetXaxis()->GetNbins()){ - Pgamma = 0.; - } - else Pgamma = polFrac_vs_E->GetBinContent(bin); - - // factors needed to calculate amplitude in c++ code - GDouble Ecom = cm.M(); - GDouble theta = p1_cm.Theta(); - - // amplitude coded in c++ (include calculation of beam asymmetry) - GDouble BeamSigma = 0.; - GDouble W = Pi0PhotCS_S(Ecom, theta, BeamSigma); - W *= (1 - Pgamma * BeamSigma * cos2Phi); - - return complex< GDouble > ( sqrt( fabs(W) ) ); -} - diff --git a/src/libraries/AMPTOOLS_AMPS/Pi0Regge.h b/src/libraries/AMPTOOLS_AMPS/Pi0Regge.h deleted file mode 100644 index 525a6545e1..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Pi0Regge.h +++ /dev/null @@ -1,42 +0,0 @@ -#if !defined(PI0REGGE) -#define PI0REGGE - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include "TH1D.h" -#include -#include -#include - -#include "Pi0ReggeModel.h" - -using std::complex; -using namespace std; - -class Kinematics; - -class Pi0Regge : public UserAmplitude< Pi0Regge > -{ - -public: - - Pi0Regge() : UserAmplitude< Pi0Regge >() { }; - Pi0Regge( const vector< string >& args ); - - string name() const { return "Pi0Regge"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -private: - - GDouble PolPlane; - - TH1D *totalFlux_vs_E; - TH1D *polFlux_vs_E; - TH1D *polFrac_vs_E; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.cc b/src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.cc deleted file mode 100644 index b928705610..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Pi0ReggeModel.cc +++ /dev/null @@ -1,378 +0,0 @@ -/* - ============================================================================ - Name : Pi0ReggeModel.cc - Author : Vincent Mathieu (Adapted for C++ and GlueX sim-recon by Justin Stevens) - Version : v1.0 June 2015 - Copyright : MyLab - Publication : arXiv:1505.02321 - Description : Photoproduction of a pseudoscalar : gamma + N --> 0- + N' - Applied to gamma + p --> pi0 + p - To change the model, change 'CGLN_Ai' - ============================================================================ -*/ - -#include "Pi0ReggeModel.h" - -// ********************************************************************************* -double Pi0PhotCS_S(double E, double theta, double &BeamSigma){ -/* - * compute the differential cross section from s-channel helicities - * in micro barns/Gev^2 - */ - - double MP = 0.938272046; - double MPI = 0.1349766; - double mass[5] = {0.0, 0.0, MP, MPI, MP}; - double pa[4], pb[4], pc[4], pd[4]; - int hel[4] = {2,1,0,1}; // hel = {1,+,0,+} (x2) - complex res[4] ; - double sig; - kin2to2(E, theta, mass, pa, pb, pc, pd); - - res[0] = Pi0PhotAmpS(pa, pb, pc, hel); // hel = {1,+,0,+} (x2) - - hel[1] = -1; // hel = {1,-,0,+} (x2) - res[1] = Pi0PhotAmpS(pa, pb, pc, hel); - - hel[3] = -1; // hel = {1,-,0,-} (x2) - res[2] = Pi0PhotAmpS(pa, pb, pc, hel); - - hel[1] = +1; // hel = {1,+,0,-} (x2) - res[3] = Pi0PhotAmpS(pa, pb, pc, hel); - - sig = pow(abs(res[0]),2) + pow(abs(res[1]),2) + pow(abs(res[2]),2) + pow(abs(res[3]),2); - sig = sig/32 * 389.3; - //sig = sig/32/M_PI/(E*E-MP*MP)/(E*E-MP*MP) * 389.3; - - // Sigma beam asymmetry from equation B3b from paper - BeamSigma = real(res[0]*conj(res[2]) - res[1]*conj(res[3])); - BeamSigma = BeamSigma/16 * 389.3; - BeamSigma = BeamSigma/sig; - - return sig; -} - -// ********************************************************************************* -complex Pi0PhotAmpS(double pa[],double pb[],double pc[], int hel[]){ - /* Regge amplitudes for gamma + p --> pi0 + p - * See arXiv:1505.02321 for the formulas - * Amplitudes in the S-CHANNEL ! - * Helicities are defined in the c.o.m. of (gamma,p) - * Inputs: - * pa, pb, pc : four vectors in the c.o.m. frame. - * hel={mua, mub, muc, mud} : 2 x helicities of a,b,c,d - * Outputs: - * ampl : the amplitude ; complex number - */ - complex amp = 0.0; - complex Ai[5] = {0}, Fi[5] = {0}; - //pbc set but not used: double pab[4], pbc[4], pca[4], pd[4]; - double pab[4], pca[4], pd[4]; - struct Kin var; - double mass[5]={0}; - - // Only valid for Q^2 = 0 --> photon helicity should be +1 or -1 - if ( abs(hel[0]) != 2 ) return 0.0; - - int i; - for(i=0;i<4;i++){ // compute the Mandelstam invariant - pab[i] = pa[i] + pb[i]; // from four-vectors - // pbc set but not used: pbc[i] = pb[i] - pc[i]; // - pca[i] = pc[i] - pa[i]; // - pd[i] = pa[i] + pb[i] - pc[i]; // - } - - double EPS = 0.0; - complex I(0,1); - var.s = snorm( pab ) + I*EPS; - var.t = snorm( pca ) - I*EPS; - // photon should be real - mass[1] = 0.0; - mass[2] = sqrt( snorm( pb ) ); - mass[3] = sqrt( snorm( pc ) ); - mass[4] = sqrt( snorm( pd ) ); - - kinematics(var.s, var.t, mass, &var); // fill the structure var with all kin. quantities - CGLN_Ai(var.s,var.t,Ai); // call the model : CHANGE HERE FOR ANOTHER MODEL - - CGLNA2F(var, Ai, Fi); // Convert CGLN Ai to CGLN Fi - - // Test nucleon helicities hel[1] and hel[3] - if ( hel[1] == 1 && hel[3] == 1 ) { - // hel = {1,+,0,+} - amp = sqrt(2) * var.sinsh * (Fi[2] + Fi[1] ) - + 1/sqrt(2) * var.sins * var.cossh * (Fi[3] + Fi[4]); - } - else if ( hel[1] == -1 && hel[3] == -1 ){ - // hel = {1,-,0,-} - amp = -1/sqrt(2) * var.sins * var.cossh * (Fi[3] + Fi[4]); - } - else if ( hel[1] == -1 && hel[3] == 1 ){ - // hel = {1,-,0,+} - amp = sqrt(2) * var.cossh * (Fi[2] - Fi[1] ) - + 1/sqrt(2) * var.sins * var.sinsh * (Fi[3] - Fi[4]); - } - else if ( hel[1] == 1 && hel[3] == -1 ){ - // hel = {1,+,0,-} - amp = 1/sqrt(2) * var.sins * var.sinsh * (Fi[3] - Fi[4]); - } - else return 0.0 ; - - // if negative photon helicity, nucleon flip amplitude changes sign - if (hel[0] == -2 && hel[1] != hel[3] ) amp = -1.*amp; - - // there is a factor 8*PI*W between Hi and helicity amplitudes - return amp * 8. * M_PI * sqrt(var.s); -} - -// ********************************************************************************* -void CGLN_Ai(complex s, complex t, complex CGLNA[]){ - /* - * Model for gamma p --> pi0 p from arXiv:1505.02321 - * Vincent Mathieu June 2015 - */ - - // Model parameters - double alpV[3] = { 0.442457, 1.099910, 0.0}; // vector trajectory - double alpC[3] = { 0.461811, 0.166543, 0.0}; // vector cut trajectory - double alpA[3] = {-0.193332, 1.021300, 0.0}; // axial-vector trajectory - double g1 = 3.8873, g4 = -10.1403, g1c = -1.76187, g4c = -3.58089, g2 = -8.887; // residues - - complex Rv, Rc, Ra; - complex avec, acut, aaxi; - // trajectories: - avec = alpV[0] + t*alpV[1] + t*t*alpV[2]; - acut = alpC[0] + t*alpC[1] + t*t*alpC[2]; - aaxi = alpA[0] + t*alpA[1] + t*t*alpA[2]; - - // Regge factors: - complex I(0,1); - Rv = cgamma( 1.0 - avec, 0)/2. * ( 1.-exp(-1.*I*M_PI*avec) ) * pow(s,avec-1.); - Rc = cgamma( 1.0 - acut, 0)/2. * ( 1.-exp(-1.*I*M_PI*acut) ) * pow(s,acut-1.); - Ra = cgamma( 1.0 - aaxi, 0)/2. * ( 1.-exp(-1.*I*M_PI*aaxi) ) * pow(s,aaxi-1.); - Rc = Rc / log(s); - // IF ONLY VECTOR POLE - //Rc = 0; Ra = 0; - - // Scalar amplitudes: - CGLNA[1] = t* ( g1*Rv + g1c*Rc); - CGLNA[2] = g2 * Ra - ( g1*Rv + g1c*Rc); - CGLNA[3] = 0; - CGLNA[4] = g4*Rv + g4c*Rc; - - return ; - -} - -// ********************************************************************************* -void CGLNA2F(struct Kin var, complex Ai[], complex Fi[]){ - /* - * Compute CGLN Fi(s,t) from CGLN Ai(s,t) - */ - complex w; - complex E2p, E2m, E4p, E4m; - - w = sqrt(var.s); - E2p = var.E2s + var.m2 ; - E2m = var.E2s - var.m2 ; - E4p = var.E4s + var.m4 ; - E4m = var.E4s - var.m4 ; - - Fi[1] = (w - var.m2) * Ai[1] + (var.m3*var.m3 - var.t)/2. * (Ai[3] - Ai[4]); - Fi[1] = Fi[1] + ( w - var.m2 ) * ( w - var.m4 ) * Ai[4]; - Fi[1] = Fi[1] * sqrt( E2p * E4p ) / ( 8. * M_PI * w); - - Fi[2] = -1.*(w + var.m2) * Ai[1] + (var.m3*var.m3 - var.t)/2. * (Ai[3] - Ai[4]); - Fi[2] = Fi[2] + ( w + var.m2 ) * ( w + var.m4 ) * Ai[4]; - Fi[2] = Fi[2] * sqrt( E2m * E4m ) / ( 8. * M_PI * w); - - Fi[3] = (w + var.m2) * ( (w - var.m2)*Ai[2] + Ai[3] - Ai[4] ); - Fi[3] = Fi[3] * sqrt( E2m * E4p) * var.qs / ( 8. * M_PI * w); - - Fi[4] = (w - var.m2) * ( -1.*(w + var.m2)*Ai[2] + Ai[3] - Ai[4] ); - Fi[4] = Fi[4] * sqrt( E2p * E4m) * var.qs / ( 8. * M_PI * w); - - return; -} - -// ********************************************************************************* -void kin2to2(double Ecm, double theta, double mass[], double pa[],double pb[],double pc[], double pd[]){ -/* - * Kinematics of the 2-to-2 reaction, a + b --> c + d - * Inputs: - * Ecm center of mass energy - * cos cosine of the scattering angle in the center of mass - * mass = {ma,mb,mc,md} vector with the masses of external particles - * Outputs: - * pa, pb, pc, pd are the momenta of the particles - */ - double Ea, Eb, Ec, Ed; // Energies of the particles - double pi, pf; // initial and final breakup momenta - double ma, mb, mc, md; // masses of the particles - - ma = mass[1]; mb = mass[2]; mc = mass[3]; md = mass[4]; - - // Check that inputs are valid - if( ( ma<0 ) || ( mb<0 ) || ( mc<0 ) || ( md<0 ) ) { - printf("\n*** Wrong masses in kin2to2 ! *** \n\n"); - return ; - } - if( ( Ecm < ma + mb ) || ( Ecm < mc + md ) ) { - printf("\n*** Wrong total energy in kin2to2 ! *** \n\n"); - return ; - } - - Ea = ( Ecm*Ecm + ma*ma - mb*mb )/2./Ecm; - Eb = ( Ecm*Ecm - ma*ma + mb*mb )/2./Ecm; - Ec = ( Ecm*Ecm + mc*mc - md*md )/2./Ecm; - Ed = ( Ecm*Ecm - mc*mc + md*md )/2./Ecm; - - pi = sqrt(Ea*Ea - ma*ma); - pa[0] = Ea; pa[1] = 0; pa[2] = 0; pa[3] = +pi; - pb[0] = Eb; pb[1] = 0; pb[2] = 0; pb[3] = -pi; - - pf = sqrt(Ec*Ec - mc*mc); - pc[0] = Ec; pc[1] = +pf*sin(theta); pc[2] = 0; pc[3] = +pf*cos(theta); - pd[0] = Ed; pd[1] = -pf*sin(theta); pd[2] = 0; pd[3] = -pf*cos(theta); - - return; -} - -// ********************************************************************************* -void kinematics(complex s, complex t, double mass[], struct Kin *var) -{ - double m12, m22, m32, m42; // masses squared - complex t0, t1, u ; - - var->s = s; - var->t = t; - - var->m1 = mass[1]; - var->m2 = mass[2]; - var->m3 = mass[3]; - var->m4 = mass[4]; - - m12 = mass[1] * mass[1] ; - m22 = mass[2] * mass[2] ; - m32 = mass[3] * mass[3] ; - m42 = mass[4] * mass[4] ; - - var->ks = sqrt( lambda(s, m12, m22) / 4. / s ); - var->qs = sqrt( lambda(s, m32, m42) / 4. / s ); - var->kt = sqrt( lambda(t, m12, m32) / 4. / t ); - var->pt = sqrt( lambda(t, m22, m42) / 4. / t ); - - // nuclei energies in s- and t-channel frames - var->E2s = ( s + m22 - m12 ) / 2. / sqrt(s); - var->E4s = ( s + m42 - m32 ) / 2. / sqrt(s); - var->E2t = ( t + m22 - m42 ) / 2. / sqrt(t); - var->E4t = ( t + m42 - m22 ) / 2. / sqrt(t); - - t1 = pow(m12 - m32 - m22 + m42,2)/(4.*s) - (var->ks - var->qs) * (var->ks - var->qs); - t0 = t1 - 4. * var->ks *var->qs ; - u = -1.*s - t + m12 + m22 + m32 + m42 ; // Mandelstam s variable - var->phi = s * (t - t1) * (t0 - t) ; // Kibble function - - var->coss = 1. + (t - t1)/(2. * var->qs * var->ks) ; - var->cost = (t*(s-u) + (m12-m32) * (m22-m42) )/(sqrt(lambda(var->t,m12,m32) * lambda(var->t,m22,m42) ) ) ; - var->sins = sqrt( var->phi / s ) / ( 2. * var->qs * var->ks) ; - var->sint = sqrt( var->phi / t ) / ( 2. * var->kt * var->pt) ; - var->cossh = sqrt( (1. + var->coss ) / 2. ); - var->sinsh = sqrt( (1. - var->coss ) / 2. ); - var->costh = sqrt( (1. + var->cost ) / 2. ); - var->sinth = sqrt( (1. - var->cost ) / 2. ); - - return ; -} - -// ********************************************************************************* -complex lambda(complex a, double b, double c){ -// triangle function - return a*a + b*b + c*c - 2.*(a*b + b*c + c*a); -} - -// ********************************************************************************* -double snorm(double p[]){ -// Norm squared of a quadri-vector ; p[0] is the energy ; p[1-3] are x,y,z components - return p[0]*p[0] - ( p[1]*p[1] + p[2]*p[2] + p[3]*p[3] ); -} - -// ********************************************************************************* -complex cgamma(complex z,int OPT) -{ - complex I(0,1); - complex g, infini= 1e308+ 0.*I; // z0,z1 - double x0,q1,q2,x,y,th,th1,th2,g0,gr,gi,gr1,gi1; - double na,t,x1,y1,sr,si; - int j,k; - x1=9e9; - na=9e9; - - static double a[] = { - 8.333333333333333e-02, - -2.777777777777778e-03, - 7.936507936507937e-04, - -5.952380952380952e-04, - 8.417508417508418e-04, - -1.917526917526918e-03, - 6.410256410256410e-03, - -2.955065359477124e-02, - 1.796443723688307e-01, - -1.39243221690590}; - - x = real(z); - y = imag(z); - if (x > 171) return infini; - if ((y == 0.0) && (x == (int)x) && (x <= 0.0)) - return infini; - else if (x < 0.0) { - x1 = x; - y1 = y; - x = -x; - y = -y; - } - x0 = x; - if (x <= 7.0) { - na = (int)(7.0-x); - x0 = x+na; - } - q1 = sqrt(x0*x0+y*y); - th = atan(y/x0); - gr = (x0-0.5)*log(q1)-th*y-x0+0.5*log(2.0*M_PI); - gi = th*(x0-0.5)+y*log(q1)-y; - for (k=0;k<10;k++){ - t = pow(q1,-1.0-2.0*k); - gr += (a[k]*t*cos((2.0*k+1.0)*th)); - gi -= (a[k]*t*sin((2.0*k+1.0)*th)); - } - if (x <= 7.0) { - gr1 = 0.0; - gi1 = 0.0; - for (j=0;j 0- + N' - Applied to gamma + p --> pi0 + p - To change the model, change 'CGLN_Ai' - ============================================================================ -*/ - -#include -#include -#include -#include - -using std::complex; -using namespace std; - -// Structure with all the kinematical quantities -struct Kin -{ - double m1; // Mass particle 1 - double m2; // Mass particle 2 - double m3; // Mass particle 3 - double m4; // Mass particle 4 - complex s; // Mandelstam s variable - complex t; // Mandelstam t variable - complex phi; // phi = stu + ... - complex ks; // photon momentum in s-channel frame - complex qs; // pion momentum in s-channel frame - complex kt; // photon momentum in t-channel frame - complex pt; // nucleon momentum in t-channel frame - complex E2s; // initial nucleon energy in s-channel frame - complex E4s; // final nucleon energy in s-channel frame - complex E2t; // initial nucleon energy in t-channel frame - complex E4t; // final nucleon energy in t-channel frame - complex coss; // cos \theta_s - complex sins; // sin \theta_s - complex cossh; // cos \theta_s/2 - complex sinsh; // sin \theta_s/2 - complex cost; // cos \theta_t - complex sint; // sin \theta_t - complex costh; // cos \theta_t/2 - complex sinth; // sin \theta_t/2 -}; - -/* - ============================================================================ - Description of the subroutines: - Pi0PhotCS_S - differential cross section from s-channel amplitudes - Pi0PhotAmpS - s-channel helicity amplitudes with inputs = four vectors and helicities - CGLN_Ai - CGLN Scalar amplitudes Ai - the model has to be specified there - CGLNA2F - transformation between CGLN Fi (ouputs) and Ai (inputs) - kin2to2 - four vectors of a + b --> c + d for given Ecm and theta_s - kinematics - compute all kinematical quantities (s- and t-channel) - and store then in a struct Kin - - functions: - --------- - Cos2T - return Mandelstam t from cos(theta_s) - cgamma - return gamma(z) or log( gamma(z) ) - lambda - return a*a + b*b + c*c - 2*(a*b + b*c + c*a) - snorm - return - ============================================================================ - */ - -void kin2to2(double Ecm, double theta, double mass[], double pa[],double pb[],double pc[], double pd[]); -complex lambda(complex a, double b, double c); -double snorm(double p[]); -complex cgamma(complex z,int OPT); -complex Pi0PhotAmpS(double pa[],double pb[],double pc[], int hel[]); -void CGLN_Ai(complex s, complex t, complex CGLNA[]); -double Pi0PhotCS_S(double E,double theta, double &BeamSigma); -void CGLNA2F(struct Kin var, complex Ai[], complex Fi[]); -void kinematics(complex s, complex t, double mass[], struct Kin *var); diff --git a/src/libraries/AMPTOOLS_AMPS/Pi0SAID.cc b/src/libraries/AMPTOOLS_AMPS/Pi0SAID.cc deleted file mode 100644 index e37f86ba4f..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Pi0SAID.cc +++ /dev/null @@ -1,321 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/Pi0SAID.h" - -Pi0SAID::Pi0SAID( const vector< string >& args ) : -UserAmplitude< Pi0SAID >( args ) -{ - assert( args.size() == 1 ); - Pgamma = atof( args[0].c_str() ); - - FillDataTables(); - - hCosTheta_Ebeam = new TH2F("hCosTheta_Ebeam","; E_{#gamma}; cos#theta; d#sigma/dcos#theta", 31, 1.475, 3.025, 41, -1.025, 1.025); - hSigma_Ebeam = new TH2F("hSigma_Ebeam","; E_{#gamma}; cos#theta; #Sigma", 31, 1.475, 3.025, 41, -1.025, 1.025); - - for(int i=0; iGetXaxis()->GetNbins(); i++){ - for(int j=0; jGetYaxis()->GetNbins(); j++){ - hCosTheta_Ebeam->SetBinContent(i+1,j+1,DSG[i][j]); - hSigma_Ebeam->SetBinContent(i+1,j+1,Sigma[i][j]); - } - } -} - - -complex< GDouble > -Pi0SAID::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector target ( 0., 0., 0., 0.938); - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - - TLorentzVector cm = recoil + p1; - TLorentzRotation cmBoost( -cm.BoostVector() ); - - TLorentzVector target_cm = cmBoost * target; - TLorentzVector recoil_cm = cmBoost * recoil; - - TLorentzVector p1_cm = cmBoost * p1; - GDouble phi = p1_cm.Phi(); - GDouble cosTheta = p1_cm.CosTheta(); - GDouble cos2Phi = cos(2.*phi); - GDouble Eg = beam.E(); - - int bin = hCosTheta_Ebeam->FindBin(Eg, cosTheta); - GDouble DSG = hCosTheta_Ebeam->GetBinContent(bin); - GDouble Sigma = hSigma_Ebeam->GetBinContent(bin); - - // weighted cross section from Igor Strakovsky (GWU/SAID collaboration) - GDouble W = DSG * (1 - Pgamma * Sigma * cos2Phi); - - return complex< GDouble > ( sqrt(W) ); -} - -// select proper index for given Eg and CosTheta -void Pi0SAID::FillDataTables() { - - // Fill DSG data tables - double DSG1500[41] = {1.1446, 1.232, 1.2297, 1.1623, 1.0535, 0.9252, 0.7962, 0.6814, 0.5913, 0.5325, 0.5073, 0.5145, 0.5499, 0.607, 0.6777, 0.7533, 0.8248, 0.8838, 0.9233, 0.9378, 0.9238, 0.8806, 0.8098, 0.7158, 0.6057, 0.489, 0.3773, 0.284, 0.2233, 0.2094, 0.2551, 0.3705, 0.5609, 0.824, 1.1475, 1.5043, 1.8486, 2.11, 2.1861, 1.9348, 1.1637}; - for(int i=0; i<41; i++) { - DSG[0][i] = DSG1500[i]; - } - double DSG1550[41] = {0.8826, 0.9824, 1.0043, 0.9649, 0.8834, 0.7797, 0.6718, 0.575, 0.5008, 0.4563, 0.4443, 0.4639, 0.5108, 0.578, 0.6569, 0.7382, 0.8125, 0.8712, 0.9072, 0.9155, 0.8934, 0.841, 0.7611, 0.6592, 0.5434, 0.424, 0.3129, 0.223, 0.1677, 0.1595, 0.2093, 0.3246, 0.5084, 0.7566, 1.0563, 1.3821, 1.693, 1.9278, 1.9995, 1.7886, 1.135}; - for(int i=0; i<41; i++) { - DSG[1][i] = DSG1550[i]; - } - double DSG1600[41] = {0.6698, 0.7561, 0.7867, 0.7681, 0.7124, 0.6346, 0.5503, 0.4737, 0.4157, 0.384, 0.3818, 0.4086, 0.4605, 0.5309, 0.6114, 0.6927, 0.7656, 0.8218, 0.8546, 0.8593, 0.8339, 0.779, 0.6982, 0.5974, 0.4849, 0.3709, 0.267, 0.185, 0.137, 0.1336, 0.1836, 0.2925, 0.4616, 0.6858, 0.9527, 1.2396, 1.5111, 1.7155, 1.7803, 1.6063, 1.0607}; - for(int i=0; i<41; i++) { - DSG[2][i] = DSG1600[i]; - } - double DSG1650[41] = {0.5092, 0.5674, 0.5954, 0.5905, 0.5569, 0.5038, 0.443, 0.3865, 0.3444, 0.3239, 0.3289, 0.3593, 0.4119, 0.4808, 0.5583, 0.6357, 0.7044, 0.7565, 0.7859, 0.7884, 0.7623, 0.7088, 0.6315, 0.5365, 0.4318, 0.3272, 0.2334, 0.1611, 0.1209, 0.1218, 0.1708, 0.272, 0.4254, 0.626, 0.862, 1.1138, 1.3508, 1.5289, 1.5865, 1.4385, 0.9697}; - for(int i=0; i<41; i++) { - DSG[3][i] = DSG1650[i]; - } - double DSG1700[41] = {0.3961, 0.4234, 0.4431, 0.4459, 0.4291, 0.3964, 0.3555, 0.3158, 0.2863, 0.2738, 0.2823, 0.3125, 0.3621, 0.4261, 0.4977, 0.569, 0.6322, 0.6801, 0.7068, 0.7088, 0.6847, 0.6355, 0.5649, 0.4787, 0.3844, 0.291, 0.2083, 0.1457, 0.1125, 0.1164, 0.1631, 0.2557, 0.3938, 0.5726, 0.782, 1.0047, 1.2144, 1.3723, 1.4238, 1.2916, 0.8687}; - for(int i=0; i<41; i++) { - DSG[4][i] = DSG1700[i]; - } - double DSG1750[41] = {0.3116, 0.3125, 0.322, 0.3281, 0.3237, 0.3076, 0.2836, 0.2586, 0.24, 0.2339, 0.2447, 0.2735, 0.3188, 0.3768, 0.4415, 0.5061, 0.5633, 0.6068, 0.6313, 0.6333, 0.6119, 0.5679, 0.5049, 0.4281, 0.3447, 0.2626, 0.1905, 0.1371, 0.1102, 0.1164, 0.1607, 0.2455, 0.3705, 0.5315, 0.7198, 0.9204, 1.1102, 1.2541, 1.301, 1.1766, 0.7744}; - for(int i=0; i<41; i++) { - DSG[5][i] = DSG1750[i]; - } - double DSG1800[41] = {0.248, 0.2322, 0.2323, 0.2388, 0.2422, 0.2379, 0.2265, 0.2124, 0.2015, 0.1994, 0.2103, 0.236, 0.276, 0.327, 0.3842, 0.4417, 0.4931, 0.5325, 0.5552, 0.5582, 0.5403, 0.5025, 0.4478, 0.3812, 0.3089, 0.2381, 0.1766, 0.1318, 0.1105, 0.1186, 0.1602, 0.2377, 0.3507, 0.4962, 0.667, 0.8501, 1.025, 1.1591, 1.2026, 1.0809, 0.6828}; - for(int i=0; i<41; i++) { - DSG[6][i] = DSG1800[i]; - } - double DSG1850[41] = {0.1988, 0.175, 0.1665, 0.1706, 0.1778, 0.1814, 0.1795, 0.174, 0.1693, 0.1705, 0.1815, 0.2044, 0.2392, 0.2837, 0.3339, 0.3846, 0.4302, 0.4656, 0.4864, 0.4899, 0.475, 0.4427, 0.3957, 0.3384, 0.2763, 0.216, 0.164, 0.127, 0.1109, 0.1207, 0.1599, 0.2309, 0.3337, 0.4662, 0.6226, 0.7921, 0.9561, 1.0835, 1.125, 1.0028, 0.5985}; - for(int i=0; i<41; i++) { - DSG[7][i] = DSG1850[i]; - } - double DSG1900[41] = {0.1587, 0.1368, 0.122, 0.1218, 0.1293, 0.1369, 0.1408, 0.1411, 0.1409, 0.1442, 0.1547, 0.1749, 0.2052, 0.2439, 0.2878, 0.3325, 0.3731, 0.405, 0.4243, 0.4285, 0.4168, 0.3898, 0.3502, 0.3018, 0.2496, 0.1991, 0.1562, 0.1265, 0.1149, 0.1258, 0.1623, 0.2266, 0.3193, 0.4393, 0.5824, 0.7397, 0.8948, 1.018, 1.0597, 0.9392, 0.5293}; - for(int i=0; i<41; i++) { - DSG[8][i] = DSG1900[i]; - } - double DSG1950[41] = {0.129, 0.115, 0.0948, 0.0883, 0.093, 0.1013, 0.1082, 0.1122, 0.115, 0.1198, 0.1301, 0.148, 0.1744, 0.2081, 0.2465, 0.2858, 0.3218, 0.3502, 0.3678, 0.3723, 0.363, 0.3407, 0.3077, 0.2674, 0.2243, 0.1832, 0.149, 0.1265, 0.1196, 0.132, 0.1663, 0.2246, 0.308, 0.4162, 0.5467, 0.6926, 0.8393, 0.9589, 1.0013, 0.8828, 0.4674}; - for(int i=0; i<41; i++) { - DSG[9][i] = DSG1950[i]; - } - double DSG2000[41] = {0.1053, 0.1038, 0.0793, 0.0661, 0.0665, 0.0738, 0.0821, 0.0886, 0.0939, 0.1003, 0.1105, 0.1269, 0.1503, 0.1798, 0.2134, 0.2477, 0.2791, 0.304, 0.3193, 0.3234, 0.3156, 0.2969, 0.2694, 0.2363, 0.2014, 0.1689, 0.143, 0.1274, 0.1253, 0.1395, 0.1721, 0.225, 0.2996, 0.3968, 0.5155, 0.6509, 0.7903, 0.9075, 0.9528, 0.8392, 0.4233}; - for(int i=0; i<41; i++) { - DSG[10][i] = DSG2000[i]; - } - double DSG2050[41] = {0.089, 0.102, 0.0744, 0.0543, 0.0491, 0.0536, 0.0613, 0.0685, 0.0747, 0.0815, 0.0913, 0.1061, 0.1267, 0.1528, 0.1823, 0.2126, 0.2402, 0.2621, 0.2757, 0.2796, 0.2733, 0.2579, 0.2354, 0.2087, 0.1812, 0.1565, 0.1379, 0.1283, 0.1299, 0.1448, 0.1747, 0.2212, 0.2861, 0.3714, 0.4775, 0.6017, 0.7341, 0.8504, 0.9018, 0.7997, 0.394}; - for(int i=0; i<41; i++) { - DSG[11][i] = DSG2050[i]; - } - double DSG2100[41] = {0.0806, 0.1071, 0.0765, 0.0493, 0.0381, 0.039, 0.0452, 0.0523, 0.0589, 0.0659, 0.0752, 0.0887, 0.1072, 0.1303, 0.1564, 0.1829, 0.207, 0.226, 0.2377, 0.2408, 0.2354, 0.2225, 0.2042, 0.1832, 0.1625, 0.145, 0.1333, 0.1294, 0.1348, 0.1506, 0.1779, 0.2183, 0.2737, 0.347, 0.4403, 0.5531, 0.6779, 0.7928, 0.8508, 0.7622, 0.3721}; - for(int i=0; i<41; i++) { - DSG[12][i] = DSG2100[i]; - } - double DSG2150[41] = {0.0746, 0.1131, 0.0803, 0.0476, 0.0315, 0.0293, 0.0341, 0.0409, 0.0476, 0.0547, 0.0637, 0.0761, 0.0928, 0.1134, 0.1364, 0.1597, 0.1807, 0.1969, 0.2066, 0.2089, 0.204, 0.1931, 0.1785, 0.1625, 0.1479, 0.1371, 0.1321, 0.1338, 0.1431, 0.1601, 0.1853, 0.2199, 0.2663, 0.3279, 0.4085, 0.5098, 0.6272, 0.7416, 0.8083, 0.7383, 0.3738}; - for(int i=0; i<41; i++) { - DSG[13][i] = DSG2150[i]; - } - double DSG2200[41] = {0.0746, 0.1218, 0.0868, 0.0493, 0.029, 0.024, 0.0271, 0.033, 0.0392, 0.0457, 0.0538, 0.065, 0.0798, 0.0981, 0.1186, 0.1391, 0.1573, 0.1711, 0.1791, 0.1805, 0.176, 0.1668, 0.1552, 0.1436, 0.1344, 0.1296, 0.1303, 0.1371, 0.1497, 0.1675, 0.1904, 0.2193, 0.2565, 0.3064, 0.3743, 0.464, 0.5739, 0.6883, 0.7653, 0.7179, 0.3873}; - for(int i=0; i<41; i++) { - DSG[14][i] = DSG2200[i]; - } - double DSG2250[41] = {0.0766, 0.1275, 0.0909, 0.0509, 0.0287, 0.0223, 0.0245, 0.0295, 0.0346, 0.0398, 0.0462, 0.0553, 0.0678, 0.0836, 0.1014, 0.1192, 0.135, 0.1467, 0.1531, 0.1539, 0.1496, 0.1419, 0.1329, 0.125, 0.1204, 0.1206, 0.1264, 0.1373, 0.1524, 0.1705, 0.1906, 0.2135, 0.2416, 0.2801, 0.3355, 0.4143, 0.5176, 0.6334, 0.7234, 0.7036, 0.4158}; - for(int i=0; i<41; i++) { - DSG[15][i] = DSG2250[i]; - } - double DSG2300[41] = {0.0817, 0.1317, 0.0932, 0.052, 0.0293, 0.0227, 0.0247, 0.0292, 0.0335, 0.0374, 0.0422, 0.0494, 0.0598, 0.0732, 0.0885, 0.1039, 0.1172, 0.1268, 0.1316, 0.1314, 0.1271, 0.1204, 0.1136, 0.109, 0.1087, 0.1138, 0.1244, 0.1397, 0.1579, 0.1769, 0.1953, 0.2132, 0.2333, 0.2611, 0.3048, 0.3727, 0.4693, 0.5863, 0.6897, 0.6993, 0.4599}; - for(int i=0; i<41; i++) { - DSG[16][i] = DSG2300[i]; - } - double DSG2350[41] = {0.0891, 0.1359, 0.0954, 0.0536, 0.0307, 0.0239, 0.0255, 0.0291, 0.0322, 0.0347, 0.038, 0.0437, 0.0525, 0.0644, 0.0782, 0.0921, 0.1041, 0.1125, 0.1164, 0.1158, 0.1118, 0.1062, 0.1014, 0.0997, 0.103, 0.1122, 0.1271, 0.146, 0.1665, 0.1858, 0.2019, 0.2145, 0.2262, 0.2432, 0.2749, 0.332, 0.4219, 0.5406, 0.6588, 0.7014, 0.5179}; - for(int i=0; i<41; i++) { - DSG[17][i] = DSG2350[i]; - } - double DSG2400[41] = {0.0988, 0.1348, 0.0926, 0.0529, 0.033, 0.0285, 0.0309, 0.034, 0.0354, 0.0354, 0.0359, 0.0386, 0.0445, 0.0538, 0.0652, 0.077, 0.0873, 0.0944, 0.0974, 0.0964, 0.0926, 0.0879, 0.0848, 0.0856, 0.092, 0.1046, 0.1228, 0.1445, 0.1667, 0.1861, 0.1999, 0.2078, 0.2122, 0.2201, 0.2421, 0.2909, 0.3772, 0.5006, 0.6368, 0.7156, 0.5913}; - for(int i=0; i<41; i++) { - DSG[18][i] = DSG2400[i]; - } - double DSG2450[41] = {0.1121, 0.1344, 0.0891, 0.051, 0.034, 0.0317, 0.0351, 0.038, 0.0382, 0.0366, 0.035, 0.0357, 0.0397, 0.0471, 0.0569, 0.0672, 0.0761, 0.082, 0.0842, 0.0828, 0.0792, 0.0754, 0.0739, 0.0771, 0.0865, 0.1027, 0.1244, 0.1493, 0.1736, 0.1934, 0.2056, 0.2092, 0.2071, 0.2065, 0.2194, 0.2606, 0.3435, 0.4721, 0.6266, 0.7425, 0.6795}; - for(int i=0; i<41; i++) { - DSG[19][i] = DSG2450[i]; - } - double DSG2500[41] = {0.1299, 0.1344, 0.0855, 0.0495, 0.0357, 0.036, 0.0405, 0.0432, 0.0423, 0.0389, 0.0354, 0.0341, 0.0364, 0.0423, 0.0507, 0.0598, 0.0676, 0.0726, 0.0741, 0.0724, 0.069, 0.0659, 0.0659, 0.0712, 0.0833, 0.1026, 0.1276, 0.1552, 0.1814, 0.2016, 0.2124, 0.2125, 0.2047, 0.197, 0.2025, 0.2381, 0.3201, 0.4562, 0.6314, 0.7864, 0.7865}; - for(int i=0; i<41; i++) { - DSG[20][i] = DSG2500[i]; - } - double DSG2550[41] = {0.1558, 0.1379, 0.0843, 0.0506, 0.0405, 0.0436, 0.0493, 0.0516, 0.0493, 0.0439, 0.0382, 0.0348, 0.035, 0.0391, 0.0459, 0.0535, 0.0601, 0.064, 0.0646, 0.0624, 0.0588, 0.0563, 0.0574, 0.0646, 0.0791, 0.1011, 0.1289, 0.1589, 0.1867, 0.2072, 0.2166, 0.2137, 0.2014, 0.1882, 0.1886, 0.2214, 0.3055, 0.4521, 0.6501, 0.8446, 0.9052}; - for(int i=0; i<41; i++) { - DSG[21][i] = DSG2550[i]; - } - double DSG2600[41] = {0.1961, 0.147, 0.0844, 0.051, 0.044, 0.05, 0.0574, 0.0601, 0.0573, 0.0507, 0.0435, 0.0384, 0.0369, 0.0392, 0.0442, 0.0501, 0.0548, 0.0571, 0.0564, 0.0533, 0.0495, 0.0476, 0.0502, 0.0596, 0.0772, 0.1027, 0.1341, 0.1675, 0.1977, 0.2195, 0.2285, 0.2234, 0.2074, 0.1898, 0.1862, 0.2171, 0.3042, 0.4613, 0.6809, 0.9116, 1.0261}; - for(int i=0; i<41; i++) { - DSG[22][i] = DSG2600[i]; - } - double DSG2650[41] = {0.2485, 0.1641, 0.0908, 0.0567, 0.052, 0.0602, 0.0688, 0.0716, 0.068, 0.0603, 0.0518, 0.0453, 0.0425, 0.0434, 0.0469, 0.0512, 0.0542, 0.0548, 0.0526, 0.0484, 0.044, 0.0421, 0.0455, 0.0565, 0.0763, 0.1045, 0.1386, 0.1743, 0.2063, 0.2287, 0.2372, 0.2304, 0.212, 0.1919, 0.1871, 0.2199, 0.314, 0.4859, 0.7302, 0.9978, 1.1623}; - for(int i=0; i<41; i++) { - DSG[23][i] = DSG2650[i]; - } - double DSG2700[41] = {0.3105, 0.1906, 0.1067, 0.072, 0.0696, 0.0798, 0.0893, 0.092, 0.0874, 0.0783, 0.0681, 0.0598, 0.055, 0.0537, 0.0549, 0.0566, 0.0571, 0.0553, 0.0509, 0.0452, 0.04, 0.0384, 0.043, 0.0563, 0.0791, 0.1107, 0.1484, 0.1873, 0.2216, 0.2452, 0.2535, 0.2454, 0.2251, 0.2033, 0.1986, 0.235, 0.3383, 0.5273, 0.7985, 1.1038, 1.3163}; - for(int i=0; i<41; i++) { - DSG[24][i] = DSG2700[i]; - } - double DSG2750[41] = {0.3987, 0.2256, 0.1306, 0.1012, 0.1083, 0.1267, 0.1412, 0.1458, 0.1405, 0.1288, 0.1148, 0.1022, 0.0928, 0.087, 0.0837, 0.0814, 0.0783, 0.0735, 0.0669, 0.0596, 0.0538, 0.0523, 0.0578, 0.0725, 0.0971, 0.1304, 0.1694, 0.209, 0.2431, 0.2655, 0.2719, 0.2617, 0.2397, 0.218, 0.2162, 0.2601, 0.3764, 0.5845, 0.8804, 1.2131, 1.4501}; - for(int i=0; i<41; i++) { - DSG[25][i] = DSG2750[i]; - } - double DSG2800[41] = {0.4971, 0.2786, 0.2201, 0.2542, 0.3245, 0.3944, 0.445, 0.4707, 0.4742, 0.4618, 0.4409, 0.4177, 0.3963, 0.3786, 0.3647, 0.3533, 0.3432, 0.333, 0.3224, 0.312, 0.3033, 0.2983, 0.2991, 0.3072, 0.3228, 0.3445, 0.3692, 0.392, 0.4076, 0.4107, 0.3985, 0.3717, 0.3373, 0.309, 0.3078, 0.3597, 0.4906, 0.7162, 1.0258, 1.3567, 1.5585}; - for(int i=0; i<41; i++) { - DSG[26][i] = DSG2800[i]; - } - double DSG2850[41] = {0.6103, 0.4674, 0.6002, 0.8518, 1.1235, 1.3611, 1.5411, 1.6602, 1.7263, 1.7524, 1.7519, 1.7366, 1.7149, 1.6919, 1.67, 1.6491, 1.6282, 1.6058, 1.5808, 1.5525, 1.5214, 1.4881, 1.4537, 1.419, 1.3836, 1.3465, 1.3051, 1.2559, 1.1956, 1.1214, 1.0334, 0.9358, 0.8383, 0.7572, 0.7148, 0.7363, 0.8437, 1.0443, 1.3131, 1.5653, 1.6177}; - for(int i=0; i<41; i++) { - DSG[27][i] = DSG2850[i]; - } - double DSG2900[41] = {0.7611, 1.0472, 1.7367, 2.5471, 3.3222, 3.9858, 4.511, 4.9005, 5.1722, 5.3504, 5.4591, 5.5194, 5.5471, 5.5531, 5.5435, 5.5205, 5.4839, 5.4323, 5.3634, 5.2757, 5.1678, 5.0394, 4.8903, 4.7209, 4.5315, 4.3218, 4.0917, 3.8408, 3.5696, 3.2804, 2.9783, 2.6728, 2.3787, 2.1159, 1.908, 1.7785, 1.7425, 1.7942, 1.8861, 1.9, 1.6055}; - for(int i=0; i<41; i++) { - DSG[28][i] = DSG2900[i]; - } - double DSG2950[41] = {0.9953, 2.4498, 4.4073, 6.4227, 8.2697, 9.8487, 11.1342, 12.1415, 12.9063, 13.4711, 13.8772, 14.1602, 14.3482, 14.461, 14.5109, 14.5046, 14.4439, 14.3279, 14.1544, 13.9207, 13.6248, 13.2653, 12.8422, 12.3565, 11.8105, 11.2072, 10.5509, 9.8472, 9.1037, 8.3307, 7.5419, 6.7553, 5.9934, 5.2816, 4.6462, 4.1084, 3.6744, 3.3205, 2.97, 2.4608, 1.5004}; - for(int i=0; i<41; i++) { - DSG[29][i] = DSG2950[i]; - } - double DSG3000[41] = {1.3858, 5.3273, 9.7794, 14.0987, 17.9804, 21.3061, 24.0612, 26.2853, 28.0432, 29.4068, 30.4438, 31.2127, 31.7599, 32.1196, 32.3147, 32.3588, 32.2584, 32.0153, 31.6284, 31.0955, 30.4153, 29.5871, 28.6129, 27.4967, 26.2456, 24.8689, 23.3794, 21.7926, 20.1278, 18.408, 16.6603, 14.9158, 13.2087, 11.5739, 10.0427, 8.6351, 7.3482, 6.1377, 4.8924, 3.3979, 1.288}; - for(int i=0; i<41; i++) { - DSG[30][i] = DSG3000[i]; - } - - // Fill Sigma data tables - double Sigma1500[41] = {0, 0.2962, 0.4677, 0.568, 0.6196, 0.6322, 0.6091, 0.5519, 0.4665, 0.369, 0.2858, 0.2404, 0.2388, 0.2696, 0.3162, 0.3661, 0.4121, 0.4513, 0.4827, 0.506, 0.5213, 0.528, 0.5252, 0.5111, 0.4822, 0.4339, 0.3615, 0.2701, 0.2069, 0.2765, 0.4849, 0.6812, 0.7982, 0.8556, 0.8787, 0.8807, 0.8655, 0.8297, 0.7575, 0.5934, 0}; - for(int i=0; i<41; i++) { - Sigma[0][i] = Sigma1500[i]; - } - double Sigma1550[41] = {0, 0.3222, 0.5052, 0.6103, 0.6636, 0.6758, 0.6504, 0.5887, 0.4975, 0.3965, 0.3162, 0.2805, 0.2897, 0.3271, 0.3752, 0.4224, 0.4635, 0.4967, 0.5216, 0.5383, 0.5464, 0.5454, 0.5334, 0.5072, 0.4609, 0.3851, 0.2664, 0.101, -0.0409, 0.0435, 0.3537, 0.6198, 0.7674, 0.8391, 0.8699, 0.8762, 0.863, 0.8268, 0.7512, 0.58, 0}; - for(int i=0; i<41; i++) { - Sigma[1][i] = Sigma1550[i]; - } - double Sigma1600[41] = {0, 0.3308, 0.524, 0.6356, 0.6922, 0.7054, 0.6788, 0.6141, 0.5189, 0.4157, 0.3384, 0.3098, 0.3257, 0.3665, 0.4143, 0.459, 0.4965, 0.5257, 0.5464, 0.5587, 0.5623, 0.5562, 0.5379, 0.5032, 0.4439, 0.3466, 0.1899, -0.0392, -0.2497, -0.1488, 0.2401, 0.5566, 0.7296, 0.8158, 0.8558, 0.8681, 0.8585, 0.8236, 0.7467, 0.5707, 0}; - for(int i=0; i<41; i++) { - Sigma[2][i] = Sigma1600[i]; - } - double Sigma1650[41] = {0, 0.3191, 0.5244, 0.6478, 0.7122, 0.73, 0.706, 0.6425, 0.5481, 0.4468, 0.3734, 0.3485, 0.3655, 0.4046, 0.4488, 0.4894, 0.5228, 0.5481, 0.5652, 0.5742, 0.5744, 0.5646, 0.5418, 0.5008, 0.4321, 0.3189, 0.1352, -0.1354, -0.3795, -0.2609, 0.1608, 0.4997, 0.6895, 0.7885, 0.8381, 0.8576, 0.8532, 0.8216, 0.7457, 0.5682, 0}; - for(int i=0; i<41; i++) { - Sigma[3][i] = Sigma1650[i]; - } - double Sigma1700[41] = {0, 0.2853, 0.5049, 0.6466, 0.7239, 0.7494, 0.7297, 0.6686, 0.5754, 0.4747, 0.401, 0.3747, 0.3892, 0.4251, 0.4663, 0.5042, 0.5352, 0.5586, 0.5741, 0.5816, 0.5805, 0.5693, 0.5447, 0.501, 0.4281, 0.308, 0.1137, -0.1672, -0.4071, -0.2827, 0.1249, 0.4595, 0.6557, 0.7636, 0.8215, 0.848, 0.8494, 0.8226, 0.7504, 0.5747, 0}; - for(int i=0; i<41; i++) { - Sigma[4][i] = Sigma1700[i]; - } - double Sigma1750[41] = {0, 0.2288, 0.464, 0.634, 0.7326, 0.7714, 0.76, 0.7045, 0.6154, 0.5164, 0.4406, 0.4086, 0.4159, 0.4451, 0.4809, 0.5149, 0.5433, 0.5647, 0.579, 0.5856, 0.5839, 0.5721, 0.5468, 0.5022, 0.4276, 0.3054, 0.1108, -0.1599, -0.3744, -0.2578, 0.1072, 0.4223, 0.6196, 0.7351, 0.8016, 0.8361, 0.8447, 0.8244, 0.7583, 0.5879, 0}; - for(int i=0; i<41; i++) { - Sigma[5][i] = Sigma1750[i]; - } - double Sigma1800[41] = {0, 0.1564, 0.402, 0.6087, 0.7364, 0.7926, 0.7909, 0.7412, 0.6548, 0.5546, 0.4726, 0.4312, 0.4293, 0.4516, 0.4831, 0.5146, 0.5417, 0.5627, 0.5771, 0.5842, 0.5833, 0.5724, 0.5483, 0.505, 0.4325, 0.3142, 0.13, -0.1142, -0.2935, -0.1945, 0.1128, 0.3967, 0.5884, 0.7085, 0.7823, 0.8245, 0.8407, 0.8279, 0.7698, 0.6076, 0}; - for(int i=0; i<41; i++) { - Sigma[6][i] = Sigma1800[i]; - } - double Sigma1850[41] = {0, 0.0722, 0.3107, 0.5614, 0.7298, 0.8096, 0.82, 0.7765, 0.693, 0.5915, 0.5029, 0.4512, 0.439, 0.4534, 0.4798, 0.5085, 0.5344, 0.5553, 0.5701, 0.5782, 0.5786, 0.5693, 0.5473, 0.5067, 0.438, 0.3268, 0.1578, -0.0551, -0.1996, -0.1163, 0.1377, 0.3874, 0.5687, 0.6897, 0.7687, 0.8174, 0.8404, 0.8349, 0.7852, 0.6328, 0}; - for(int i=0; i<41; i++) { - Sigma[7][i] = Sigma1850[i]; - } - double Sigma1900[41] = {0, 0.0013, 0.2, 0.4875, 0.7074, 0.8196, 0.8463, 0.811, 0.7311, 0.6283, 0.5327, 0.4701, 0.4468, 0.4528, 0.4738, 0.4996, 0.5242, 0.5448, 0.5602, 0.5694, 0.5712, 0.5639, 0.5444, 0.5072, 0.4439, 0.3426, 0.194, 0.0175, -0.0952, -0.0338, 0.1643, 0.3771, 0.5458, 0.6673, 0.7518, 0.8074, 0.8376, 0.8395, 0.7981, 0.6559, 0}; - for(int i=0; i<41; i++) { - Sigma[8][i] = Sigma1900[i]; - } - double Sigma1950[41] = {0, -0.032, 0.0858, 0.3762, 0.6575, 0.8182, 0.8708, 0.8487, 0.775, 0.6719, 0.5693, 0.4949, 0.4592, 0.4549, 0.4687, 0.4898, 0.5117, 0.531, 0.5459, 0.5552, 0.5577, 0.5516, 0.5339, 0.4997, 0.4417, 0.351, 0.2242, 0.0843, 0.0032, 0.0514, 0.2039, 0.3805, 0.5333, 0.6521, 0.74, 0.8015, 0.838, 0.8465, 0.8128, 0.6805, 0}; - for(int i=0; i<41; i++) { - Sigma[9][i] = Sigma1950[i]; - } - double Sigma2000[41] = {0, -0.014, 0.0006, 0.2278, 0.5633, 0.7936, 0.8867, 0.8853, 0.8224, 0.723, 0.6164, 0.5315, 0.4821, 0.4649, 0.4684, 0.482, 0.4987, 0.5145, 0.5271, 0.5351, 0.5371, 0.5311, 0.5144, 0.4826, 0.4299, 0.351, 0.2477, 0.1444, 0.0929, 0.1341, 0.2508, 0.3939, 0.5287, 0.6419, 0.7313, 0.7969, 0.8385, 0.8521, 0.824, 0.6995, 0}; - for(int i=0; i<41; i++) { - Sigma[10][i] = Sigma2000[i]; - } - double Sigma2050[41] = {0, 0.058, -0.0079, 0.0822, 0.4068, 0.7166, 0.8703, 0.902, 0.8562, 0.7632, 0.6538, 0.5595, 0.4981, 0.4697, 0.4641, 0.4709, 0.4828, 0.4953, 0.5059, 0.5129, 0.5149, 0.5103, 0.4966, 0.4706, 0.4286, 0.3682, 0.2945, 0.2269, 0.1979, 0.2291, 0.3126, 0.4227, 0.5365, 0.6408, 0.7287, 0.7963, 0.8408, 0.857, 0.8316, 0.7109, 0}; - for(int i=0; i<41; i++) { - Sigma[11][i] = Sigma2050[i]; - } - double Sigma2100[41] = {0, 0.1492, 0.0424, -0.021, 0.1944, 0.575, 0.8221, 0.9095, 0.8937, 0.8144, 0.706, 0.6029, 0.5282, 0.4857, 0.4679, 0.4648, 0.4691, 0.4758, 0.4822, 0.4864, 0.4872, 0.4831, 0.4727, 0.4542, 0.4259, 0.3885, 0.3473, 0.3151, 0.3074, 0.3334, 0.391, 0.4707, 0.5614, 0.6527, 0.7355, 0.8024, 0.8473, 0.8641, 0.839, 0.7193, 0}; - for(int i=0; i<41; i++) { - Sigma[12][i] = Sigma2100[i]; - } - double Sigma2150[41] = {0, 0.2302, 0.1051, -0.08, -0.0511, 0.3494, 0.7222, 0.8951, 0.9271, 0.8724, 0.7705, 0.6604, 0.5706, 0.5109, 0.4771, 0.4605, 0.4537, 0.4515, 0.4507, 0.4493, 0.4462, 0.4406, 0.432, 0.4205, 0.4068, 0.3932, 0.3831, 0.381, 0.3908, 0.4149, 0.4548, 0.5109, 0.581, 0.6594, 0.7366, 0.8021, 0.8468, 0.8625, 0.835, 0.7115, 0}; - for(int i=0; i<41; i++) { - Sigma[13][i] = Sigma2150[i]; - } - double Sigma2200[41] = {0, 0.2923, 0.165, -0.0943, -0.2762, 0.0297, 0.5296, 0.8259, 0.9348, 0.9234, 0.8384, 0.725, 0.6206, 0.5426, 0.4912, 0.4593, 0.4396, 0.4265, 0.4166, 0.4078, 0.3995, 0.3919, 0.3864, 0.3854, 0.3916, 0.4063, 0.428, 0.4525, 0.4765, 0.5003, 0.5278, 0.5647, 0.6152, 0.6783, 0.7463, 0.8068, 0.8479, 0.8591, 0.8255, 0.6944, 0}; - for(int i=0; i<41; i++) { - Sigma[14][i] = Sigma2200[i]; - } - double Sigma2250[41] = {0, 0.3451, 0.2267, -0.0627, -0.3781, -0.2161, 0.3172, 0.7061, 0.8957, 0.9436, 0.8914, 0.7844, 0.6692, 0.5743, 0.5061, 0.4596, 0.4276, 0.4042, 0.3857, 0.3704, 0.3584, 0.3518, 0.3547, 0.3717, 0.4058, 0.4537, 0.5055, 0.5503, 0.5825, 0.6036, 0.6197, 0.6389, 0.6689, 0.713, 0.7664, 0.8163, 0.8482, 0.8502, 0.8065, 0.6642, 0}; - for(int i=0; i<41; i++) { - Sigma[15][i] = Sigma2250[i]; - } - double Sigma2300[41] = {0, 0.3788, 0.2664, -0.0475, -0.4479, -0.3886, 0.1311, 0.5703, 0.8273, 0.941, 0.9381, 0.8525, 0.7339, 0.6227, 0.535, 0.47, 0.4215, 0.3834, 0.3518, 0.3253, 0.3053, 0.2965, 0.3068, 0.3439, 0.4089, 0.4901, 0.5685, 0.6293, 0.6685, 0.6896, 0.7001, 0.708, 0.722, 0.7478, 0.7841, 0.8199, 0.8396, 0.83, 0.7747, 0.6212, 0}; - for(int i=0; i<41; i++) { - Sigma[16][i] = Sigma2300[i]; - } - double Sigma2350[41] = {0, 0.4005, 0.2956, -0.0316, -0.4798, -0.5037, -0.0326, 0.4273, 0.7388, 0.9161, 0.9657, 0.9055, 0.7859, 0.6601, 0.5547, 0.4729, 0.409, 0.3566, 0.3115, 0.2729, 0.2439, 0.2326, 0.2516, 0.3106, 0.4059, 0.5153, 0.6128, 0.6839, 0.7276, 0.7499, 0.7581, 0.7595, 0.7616, 0.7711, 0.7897, 0.8094, 0.8155, 0.7939, 0.7276, 0.5661, 0}; - for(int i=0; i<41; i++) { - Sigma[17][i] = Sigma2350[i]; - } - double Sigma2400[41] = {0, 0.4131, 0.3148, -0.0273, -0.4587, -0.4585, -0.0757, 0.3108, 0.6128, 0.8347, 0.9603, 0.9662, 0.8736, 0.7428, 0.6199, 0.5193, 0.4383, 0.3707, 0.3119, 0.2613, 0.2244, 0.2138, 0.2473, 0.3353, 0.4632, 0.5954, 0.7017, 0.7725, 0.8125, 0.8302, 0.8328, 0.826, 0.8144, 0.8031, 0.7957, 0.7899, 0.7757, 0.74, 0.6649, 0.5016, 0}; - for(int i=0; i<41; i++) { - Sigma[18][i] = Sigma2400[i]; - } - double Sigma2450[41] = {0, 0.4161, 0.3259, -0.0376, -0.4716, -0.4536, -0.1151, 0.2251, 0.5096, 0.7478, 0.9229, 0.9894, 0.9338, 0.8084, 0.6738, 0.5568, 0.459, 0.3748, 0.2994, 0.233, 0.1836, 0.1702, 0.2174, 0.3335, 0.4895, 0.6374, 0.7477, 0.8173, 0.8551, 0.8708, 0.8711, 0.8596, 0.8376, 0.8067, 0.7713, 0.7379, 0.7059, 0.6629, 0.5875, 0.4321, 0}; - for(int i=0; i<41; i++) { - Sigma[19][i] = Sigma2450[i]; - } - double Sigma2500[41] = {0, 0.405, 0.3223, -0.0598, -0.4685, -0.4195, -0.1241, 0.1662, 0.4208, 0.6554, 0.8606, 0.9834, 0.9761, 0.868, 0.7285, 0.598, 0.4844, 0.3833, 0.2898, 0.2045, 0.1387, 0.1189, 0.1774, 0.3184, 0.4962, 0.6533, 0.764, 0.8314, 0.867, 0.8808, 0.8782, 0.8607, 0.8264, 0.7724, 0.704, 0.6417, 0.5992, 0.5613, 0.4976, 0.3612, 0}; - for(int i=0; i<41; i++) { - Sigma[20][i] = Sigma2500[i]; - } - double Sigma2550[41] = {0, 0.3773, 0.2958, -0.1039, -0.4679, -0.4043, -0.164, 0.0704, 0.2842, 0.4978, 0.7172, 0.903, 0.9825, 0.9367, 0.8217, 0.6925, 0.5699, 0.455, 0.3443, 0.239, 0.1538, 0.1232, 0.1881, 0.3455, 0.5312, 0.6835, 0.7845, 0.8428, 0.8714, 0.879, 0.8694, 0.841, 0.7874, 0.7007, 0.5889, 0.4968, 0.4574, 0.4418, 0.4034, 0.2953, 0}; - for(int i=0; i<41; i++) { - Sigma[21][i] = Sigma2550[i]; - } - double Sigma2600[41] = {0, 0.3287, 0.2515, -0.1551, -0.4704, -0.3792, -0.1636, 0.0367, 0.2189, 0.4054, 0.6096, 0.8096, 0.9403, 0.9542, 0.8771, 0.7612, 0.6361, 0.5087, 0.3779, 0.2457, 0.1319, 0.0861, 0.1625, 0.3426, 0.5369, 0.6836, 0.7753, 0.8257, 0.8479, 0.8495, 0.8322, 0.792, 0.7182, 0.5986, 0.4461, 0.3334, 0.3115, 0.3293, 0.3217, 0.2428, 0}; - for(int i=0; i<41; i++) { - Sigma[22][i] = Sigma2600[i]; - } - double Sigma2650[41] = {0, 0.2733, 0.1961, -0.1856, -0.4389, -0.3507, -0.1723, -0.0068, 0.1463, 0.3075, 0.4925, 0.6922, 0.8566, 0.9303, 0.9094, 0.8291, 0.7199, 0.5937, 0.4511, 0.2934, 0.1421, 0.0612, 0.1251, 0.308, 0.5013, 0.6423, 0.7284, 0.7744, 0.7922, 0.7877, 0.7606, 0.7038, 0.6025, 0.442, 0.2486, 0.1327, 0.1516, 0.2171, 0.2463, 0.1979, 0}; - for(int i=0; i<41; i++) { - Sigma[23][i] = Sigma2650[i]; - } - double Sigma2700[41] = {0, 0.217, 0.1229, -0.2213, -0.4185, -0.3549, -0.2209, -0.0918, 0.0305, 0.1619, 0.3182, 0.4999, 0.6785, 0.8074, 0.8606, 0.8456, 0.7817, 0.6811, 0.5451, 0.3731, 0.1858, 0.0628, 0.1032, 0.2738, 0.4525, 0.5806, 0.6579, 0.6976, 0.7093, 0.6966, 0.6567, 0.5794, 0.4468, 0.2454, 0.0215, -0.079, -0.0065, 0.1113, 0.1784, 0.1596, 0}; - for(int i=0; i<41; i++) { - Sigma[24][i] = Sigma2700[i]; - } - double Sigma2750[41] = {0, 0.1167, -0.0416, -0.3348, -0.4215, -0.3444, -0.2416, -0.1502, -0.0675, 0.019, 0.1218, 0.2475, 0.3886, 0.5228, 0.6247, 0.6799, 0.6864, 0.6466, 0.5608, 0.4289, 0.2661, 0.1291, 0.0972, 0.1773, 0.2983, 0.4031, 0.4744, 0.513, 0.5219, 0.5011, 0.4452, 0.3414, 0.1719, -0.0644, -0.2831, -0.3132, -0.1529, 0.0271, 0.1317, 0.137, 0}; - for(int i=0; i<41; i++) { - Sigma[25][i] = Sigma2750[i]; - } - double Sigma2800[41] = {0, -0.1056, -0.3422, -0.3973, -0.3228, -0.2394, -0.1744, -0.1251, -0.0845, -0.0457, -0.0031, 0.0462, 0.102, 0.1601, 0.2138, 0.2557, 0.2801, 0.2838, 0.2656, 0.2272, 0.1734, 0.1126, 0.056, 0.0141, -0.0082, -0.0138, -0.0116, -0.0133, -0.03, -0.0731, -0.1543, -0.2858, -0.4716, -0.6766, -0.7798, -0.6473, -0.35, -0.0768, 0.0852, 0.1233, 0}; - for(int i=0; i<41; i++) { - Sigma[26][i] = Sigma2800[i]; - } - double Sigma2850[41] = {0, -0.2665, -0.3163, -0.2395, -0.1663, -0.114, -0.0773, -0.0502, -0.028, -0.0072, 0.0143, 0.0374, 0.062, 0.0867, 0.1094, 0.1278, 0.1396, 0.1432, 0.1375, 0.1224, 0.0984, 0.0664, 0.028, -0.0151, -0.0614, -0.1101, -0.1617, -0.2183, -0.2834, -0.3618, -0.4587, -0.5765, -0.708, -0.8227, -0.854, -0.7311, -0.4685, -0.1803, 0.029, 0.1106, 0}; - for(int i=0; i<41; i++) { - Sigma[27][i] = Sigma2850[i]; - } - double Sigma2900[41] = {0, -0.2283, -0.1779, -0.1122, -0.0665, -0.036, -0.0151, 0.0004, 0.0132, 0.0249, 0.0368, 0.0491, 0.0616, 0.0738, 0.0846, 0.093, 0.0978, 0.0982, 0.0933, 0.0828, 0.0664, 0.0441, 0.016, -0.0178, -0.0569, -0.1015, -0.1516, -0.2078, -0.271, -0.3419, -0.4207, -0.5057, -0.5901, -0.658, -0.681, -0.6242, -0.4713, -0.2535, -0.0418, 0.085, 0}; - for(int i=0; i<41; i++) { - Sigma[28][i] = Sigma2900[i]; - } - double Sigma2950[41] = {0, -0.1343, -0.0797, -0.0366, -0.0089, 0.0091, 0.0212, 0.0299, 0.0371, 0.0435, 0.05, 0.0565, 0.063, 0.0691, 0.0741, 0.0775, 0.0786, 0.0767, 0.0714, 0.0621, 0.0486, 0.0307, 0.0082, -0.0189, -0.0509, -0.0877, -0.1294, -0.1762, -0.2282, -0.285, -0.3459, -0.4087, -0.4687, -0.5172, -0.5401, -0.5188, -0.4374, -0.295, -0.1179, 0.0355, 0}; - for(int i=0; i<41; i++) { - Sigma[29][i] = Sigma2950[i]; - } - double Sigma3000[41] = {0, -0.0604, -0.0189, 0.0088, 0.0257, 0.0362, 0.0428, 0.0473, 0.0507, 0.0537, 0.0567, 0.0597, 0.0626, 0.0651, 0.0668, 0.0673, 0.0661, 0.0628, 0.0569, 0.0481, 0.0361, 0.0206, 0.0015, -0.0214, -0.0483, -0.0792, -0.1142, -0.1533, -0.1962, -0.2428, -0.2919, -0.3418, -0.3894, -0.4293, -0.4532, -0.4503, -0.4086, -0.3202, -0.1884, -0.0374, 0}; - for(int i=0; i<41; i++) { - Sigma[30][i] = Sigma3000[i]; - } - - - return; -} diff --git a/src/libraries/AMPTOOLS_AMPS/Pi0SAID.h b/src/libraries/AMPTOOLS_AMPS/Pi0SAID.h deleted file mode 100644 index db837fa57d..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Pi0SAID.h +++ /dev/null @@ -1,42 +0,0 @@ -#if !defined(PI0SAID) -#define PI0SAID - -#include "TH2.h" - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -using std::complex; -using namespace std; - -class Kinematics; - -class Pi0SAID : public UserAmplitude< Pi0SAID > -{ - -public: - - Pi0SAID() : UserAmplitude< Pi0SAID >() { }; - Pi0SAID( const vector< string >& args ); - - string name() const { return "Pi0SAID"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -private: - - void FillDataTables(); - double DSG[31][41]; - double Sigma[31][41]; - - TH2F *hCosTheta_Ebeam, *hSigma_Ebeam; - GDouble Pgamma; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/SConscript b/src/libraries/AMPTOOLS_AMPS/SConscript deleted file mode 100644 index ec72a8abe6..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/SConscript +++ /dev/null @@ -1,18 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada': - - env = env.Clone() - - sbms.AddAmpTools(env) - sbms.AddCobrems(env) - sbms.AddROOT(env) - sbms.library(env) - - diff --git a/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.cc b/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.cc deleted file mode 100644 index d781fe6032..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.cc +++ /dev/null @@ -1,169 +0,0 @@ - -#include - -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/AmpParameter.h" -#include "AMPTOOLS_AMPS/ThreePiAngles.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" -#include "AMPTOOLS_AMPS/breakupMomentum.h" - -ThreePiAngles::ThreePiAngles( const vector< string >& args ) : -UserAmplitude< ThreePiAngles >( args ) -{ - - assert( args.size() == 11 ); - - m_polBeam = atoi( args[0].c_str() ); // beam polarization component (X=0, Y=1) - m_polFrac = AmpParameter( args[1] ); // fraction of polarization 0=0% 1=100% - m_jX = atoi( args[2].c_str() ); // total J of produced resonance - m_parX = atoi( args[3].c_str() ); // parity of produced resonance - m_iX = atoi( args[4].c_str() ); // total isospin of resonance - m_lX = atoi( args[5].c_str() ); // l between bachelor and isobar - m_jI = atoi( args[6].c_str() ); // total J of isobar - m_iI = atoi( args[7].c_str() ); // total isospin of isobar - m_iZ0 = atoi( args[8].c_str() ); // z component of isospin of final state particle 0 - m_iZ1 = atoi( args[9].c_str() ); // z component of isospin of final state particle 1 - m_iZ2 = atoi( args[10].c_str() );// z component of isospin of final state particle 2 - - assert( ( m_polBeam == 0 ) || ( m_polBeam == 1 ) ); - assert( ( m_polFrac >= 0 ) && ( m_polFrac <= 1 ) ); - assert( m_jX >= 0 ); - assert( abs( (double)m_parX ) == 1 ); - assert( abs( (double)m_iX ) <= 1 ); - assert( m_lX <= m_jX ); - assert( m_jI >= 0 ); - assert( abs( (double)m_iI ) <= 1 ); - assert( abs( (double)m_iZ0 ) <= 1 ); - assert( abs( (double)m_iZ1 ) <= 1 ); - assert( abs( (double)m_iZ2 ) <= 1 ); - - registerParameter( m_polFrac ); - - // the first two elements are the beam and recoil - m_iZ.push_back( 0 ); - m_iZ.push_back( 0 ); - m_iZ.push_back( m_iZ0 ); - m_iZ.push_back( m_iZ1 ); - m_iZ.push_back( m_iZ2 ); - -} - -complex< GDouble > -ThreePiAngles::calcAmplitude( GDouble** pKin ) const -{ - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - TLorentzVector p3 ( pKin[4][1], pKin[4][2], pKin[4][3], pKin[4][0] ); - - TLorentzVector isobar = p1 + p2; - TLorentzVector resonance = isobar + p3; - - // orientation of production plane in lab - GDouble alpha = recoil.Vect().Phi(); - - TLorentzRotation resRestBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resRestBoost * beam; - TLorentzVector recoil_res = resRestBoost * recoil; - TLorentzVector p3_res = resRestBoost * p3; - - TVector3 zRes = -recoil_res.Vect().Unit(); - TVector3 yRes = beam_res.Vect().Cross(zRes).Unit(); - TVector3 xRes = yRes.Cross(zRes); - - TVector3 anglesRes( (p3_res.Vect()).Dot(xRes), - (p3_res.Vect()).Dot(yRes), - (p3_res.Vect()).Dot(zRes) ); - - GDouble cosThetaRes = anglesRes.CosTheta(); - GDouble phiRes = anglesRes.Phi(); - - TLorentzRotation isoRestBoost( -isobar.BoostVector() ); - TLorentzVector p1_iso = isoRestBoost * p1; - - TVector3 anglesIso( (p1_iso.Vect()).Dot(xRes), - (p1_iso.Vect()).Dot(yRes), - (p1_iso.Vect()).Dot(zRes) ); - - GDouble cosThetaIso = anglesIso.CosTheta(); - GDouble phiIso = anglesIso.Phi(); - - GDouble k = breakupMomentum( resonance.M(), isobar.M(), p3.M() ); - GDouble q = breakupMomentum( isobar.M(), p1.M(), p2.M() ); - - const vector< int >& perm = getCurrentPermutation(); - - // get the z components of isospin (charges) for the pions - int iZ0 = m_iZ[perm[2]]; - int iZ1 = m_iZ[perm[3]]; - int iZ2 = m_iZ[perm[4]]; - - complex< GDouble > i( 0, 1 ); - complex< GDouble > ans( 0, 0 ); - - // a prefactor the matrix elements that couple negative helicity - // photons to the final state - complex< GDouble > negResHelProd = ( m_polBeam == 0 ? - cos( 2 * alpha ) + i * sin( 2 * alpha ) : - -cos( 2 * alpha ) - i * sin( 2 * alpha ) ); - negResHelProd *= ( m_jX % 2 == 0 ? -m_parX : m_parX ); - - // in general we also need a sum over resonance helicities here - // however, we assume a production mechanism that only produces - // resonance helicities +-1 - - for( int mL = -m_lX; mL <= m_lX; ++mL ){ - - complex< GDouble > term( 0, 0 ); - - for( int mI = -m_jI; mI <= m_jI; ++mI ){ - - term += Y( m_jI, mI, cosThetaIso, phiIso ) * - ( negResHelProd * clebschGordan( m_jI, m_lX, mI, mL, m_jX, -1 ) + - clebschGordan( m_jI, m_lX, mI, mL, m_jX, 1 ) ); - } - - term *= Y( m_lX, mL, cosThetaRes, phiRes ); - ans += term; - } - - ans *= ( m_polBeam == 0 ? ( 1 + m_polFrac ) / 4 : ( 1 - m_polFrac ) / 4 ); - - ans *= clebschGordan( 1, 1, iZ0, iZ1, m_iI, iZ0 + iZ1 ) * - clebschGordan( m_iI, 1, iZ0 + iZ1, iZ2, m_iX, iZ0 + iZ1 + iZ2 ) * - pow( k, m_lX ) * pow( q, m_jI ); - - return ans; -} - -#ifdef GPU_ACCELERATION - -void -ThreePiAngles::launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const { - - const vector< int >& perm = getCurrentPermutation(); - - // get the z components of isospin (charges) for the pions - int iZ0 = m_iZ[perm[2]]; - int iZ1 = m_iZ[perm[3]]; - int iZ2 = m_iZ[perm[4]]; - - GPUThreePiAngles_exec( dimGrid, dimBlock, GPU_AMP_ARGS, - m_polBeam, m_polFrac, m_jX, m_parX, m_iX, m_lX, - m_jI, m_iI, iZ0, iZ1, iZ2 ); - - -} - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.h b/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.h deleted file mode 100644 index 5eb9d9f3af..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/ThreePiAngles.h +++ /dev/null @@ -1,64 +0,0 @@ -#if !defined(THREEPIANGLES) -#define THREEPIANGLES - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "IUAmpTools/UserAmplitude.h" - -#include -#include -#include - -using std::complex; -using namespace std; - -#ifdef GPU_ACCELERATION -void -GPUThreePiAngles_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int polX, GDouble polFrac, int jX, int parX, int iX, - int lX, int jI, int iI, int iZ0, int iZ1, int iZ2 ); -#endif - -class Kinematics; - -class ThreePiAngles : public UserAmplitude< ThreePiAngles > -{ - -public: - - ThreePiAngles() : UserAmplitude< ThreePiAngles >() { } - ThreePiAngles( const vector< string >& args ); - ThreePiAngles( int polX, const AmpParameter& polFrac, int jX, int parX, - int iX, int lX, int jI, int iI, int iZ0, int iZ1, int iZ2 ); - - string name() const { return "ThreePiAngles"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - int m_polBeam; - AmpParameter m_polFrac; - int m_jX; - int m_parX; - int m_iX; - int m_lX; - int m_jI; - int m_iI; - int m_iZ0; - int m_iZ1; - int m_iZ2; - - vector< int > m_iZ; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.cc b/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.cc deleted file mode 100644 index b8fe5744a7..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.cc +++ /dev/null @@ -1,165 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/ThreePiAnglesSchilling.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -#include - -ThreePiAnglesSchilling::ThreePiAnglesSchilling( const vector< string >& args ) : - UserAmplitude< ThreePiAnglesSchilling >( args ) -{ - assert( args.size() == 11 ); - - rho000 = AmpParameter( args[0] ); - rho100 = AmpParameter( args[1] ); - rho1m10 = AmpParameter( args[2] ); - - rho111 = AmpParameter( args[3] ); - rho001 = AmpParameter( args[4] ); - rho101 = AmpParameter( args[5] ); - rho1m11 = AmpParameter( args[6] ); - - rho102 = AmpParameter( args[7] ); - rho1m12 = AmpParameter( args[8] ); - - polAngle = AmpParameter( args[9] ); - - polFraction = atof(args[10].c_str()); - - // need to register any free parameters so the framework knows about them - registerParameter( rho000 ); - registerParameter( rho100 ); - registerParameter( rho1m10 ); - - registerParameter( rho111 ); - registerParameter( rho001 ); - registerParameter( rho101 ); - registerParameter( rho1m11 ); - - registerParameter( rho102 ); - registerParameter( rho1m12 ); - - registerParameter( polAngle ); - - // Initialize coherent brem table - // Do this over the full range since we will be using this as a lookup - float Emax = 12.0; - float Epeak = 9.0; - float Elow = 0.139*2; - float Ehigh = 12.0; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - totalFlux_vs_E = new TH1D("totalFlux_vs_E", "Total Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFlux_vs_E = new TH1D("polFlux_vs_E", "Polarized Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFrac_vs_E = new TH1D("polFrac_vs_E", "Polarization Fraction vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill totalFlux - for(int i=1;i<=totalFlux_vs_E->GetNbinsX(); i++){ - double x = totalFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - doPolFlux=1; - cobrems.setPolarizedFlag(doPolFlux); - // Fill totalFlux - for(int i=1;i<=polFlux_vs_E->GetNbinsX(); i++){ - double x = polFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - polFrac_vs_E->Divide(polFlux_vs_E, totalFlux_vs_E); -} - - -complex< GDouble > -ThreePiAnglesSchilling::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - TLorentzVector p3 ( pKin[4][1], pKin[4][2], pKin[4][3], pKin[4][0] ); - TLorentzVector target (0.0, 0.0, 0.0, 0.938272); - - TLorentzVector resonance = p1 + p2 + p3; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - TLorentzVector p2_res = resonanceBoost * p2; - TLorentzVector p3_res = resonanceBoost * p3; - - // Three pi decay, use normal to decay plane - TVector3 norm = (p2_res.Vect().Cross(p1_res.Vect())).Unit(); - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( norm.Dot(x), - norm.Dot(y), - norm.Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - GDouble cosSqTheta = cosTheta*cosTheta; - GDouble sin2Theta = sin(2.*angles.Theta()); - GDouble sinSqTheta = 1. - cosSqTheta; - - GDouble phi = angles.Phi(); - - TVector3 eps(cos(polAngle), sin(polAngle), 0.0); // beam polarization vector - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - // vector meson production from K. Schilling et. al. - GDouble Pgamma; - if(polFraction >= 0.) Pgamma = polFraction; - else{ - int bin = polFrac_vs_E->GetXaxis()->FindBin(pKin[0][0]); - if (bin == 0 || bin > polFrac_vs_E->GetXaxis()->GetNbins()){ - Pgamma = 0.; - } - else Pgamma = polFrac_vs_E->GetBinContent(bin); - } - - GDouble W = 0.5*(1. - rho000) + 0.5*(3.*rho000 - 1.)*cosTheta*cosTheta - sqrt(2.)*rho100*sin2Theta*cos(phi) - rho1m10*sinSqTheta*cos(2.*phi); - - W -= Pgamma*cos(2.*Phi) * (rho111*sinSqTheta + rho001*cosTheta*cosTheta - sqrt(2.)*rho101*sin2Theta*cos(phi) - rho1m11*sinSqTheta*cos(2.*phi)); - - W -= Pgamma*sin(2.*Phi) * (sqrt(2.)*rho102*sin2Theta*sin(phi) + rho1m12*sinSqTheta*sin(2.*phi)); - - W *= 3./(4.*PI); - - return complex< GDouble > ( sqrt(fabs(W)) ); -} - diff --git a/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.h b/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.h deleted file mode 100644 index 0a4c859590..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/ThreePiAnglesSchilling.h +++ /dev/null @@ -1,71 +0,0 @@ -#if !defined(THREEPIANGLESSCHILLING) -#define THREEPIANGLESSCHILLING - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include "TH1D.h" -#include "TFile.h" -#include -#include -#include - -#ifdef GPU_ACCELERATION -void -GPUThreePiAnglesSchilling_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class ThreePiAnglesSchilling : public UserAmplitude< ThreePiAnglesSchilling > -{ - -public: - - ThreePiAnglesSchilling() : UserAmplitude< ThreePiAnglesSchilling >() { }; - ThreePiAnglesSchilling( const vector< string >& args ); - - string name() const { return "ThreePiAnglesSchilling"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter rho000; - AmpParameter rho100; - AmpParameter rho1m10; - - AmpParameter rho111; - AmpParameter rho001; - AmpParameter rho101; - AmpParameter rho1m11; - - AmpParameter rho102; - AmpParameter rho1m12; - - AmpParameter polAngle; - - double polFraction; - - TH1D *totalFlux_vs_E; - TH1D *polFlux_vs_E; - TH1D *polFrac_vs_E; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.cc b/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.cc deleted file mode 100644 index 601109b1da..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.cc +++ /dev/null @@ -1,81 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPSAngles.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -TwoPSAngles::TwoPSAngles( const vector< string >& args ) : -UserAmplitude< TwoPSAngles >( args ) -{ - assert( args.size() == 3 ); - - m_j = atoi( args[0].c_str() ); - m_m = atoi( args[1].c_str() ); - m_e = atoi( args[2].c_str() ); - - // make sure values are reasonable - assert( abs( m_e ) == 1 ); - assert( m_m <= m_j ); - - if( m_m == 0 ) m_bigTheta = 0.5; - if( m_m > 0 ) m_bigTheta = sqrt( 0.5 ); - if( m_m < 0 ) m_bigTheta = 0; - - // the "reflectivity factor" is e*(-1)^(m) - m_reflectivityFactor = ( m_m % 2 == 0 ? m_e : -m_e ); -} - - -complex< GDouble > -TwoPSAngles::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - - TLorentzVector resonance = p1 + p2; - - TLorentzRotation resRestBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resRestBoost * beam; - TLorentzVector recoil_res = resRestBoost * recoil; - TLorentzVector p1_res = resRestBoost * p1; - - TVector3 z = beam_res.Vect().Unit(); - TVector3 y = recoil_res.Vect().Cross(z).Unit(); - TVector3 x = y.Cross(z); - - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - GDouble phi = angles.Phi(); - - GDouble coef = sqrt( ( 2. * m_j + 1 ) / ( 4 * 3.1416 ) ); - - return complex< GDouble >( coef * m_bigTheta * - ( wignerD( m_j, m_m, 0, cosTheta, phi ) - - static_cast< GDouble>( m_reflectivityFactor ) * - wignerD( m_j, -m_m, 0, cosTheta, phi ) ) ); -} - -#ifdef GPU_ACCELERATION -void -TwoPSAngles::launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const { - - GPUTwoPSAngles_exec( dimGrid, dimBlock, GPU_AMP_ARGS, - m_j, m_m, m_bigTheta, - static_cast< GDouble >( m_reflectivityFactor ) ); -} -#endif //GPU_ACCELERATION diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.h b/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.h deleted file mode 100644 index 8672cfe3b9..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPSAngles.h +++ /dev/null @@ -1,62 +0,0 @@ -#if !defined(TWOPSANGLES) -#define TWOPSANGLES - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -#ifdef GPU_ACCELERATION -void -GPUTwoPSAngles_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -// A class for describing the angular portion of the decay in the -// reflectivity basis of R -> 1 2 -// particles 1 and 2 are pseudoscalars -// -// j,m are the total and z projection of the spin of R -// e is reflectivity -// p is parity of R - -class Kinematics; - -class TwoPSAngles : public UserAmplitude< TwoPSAngles > -{ - -public: - - TwoPSAngles() : UserAmplitude< TwoPSAngles >() { }; - TwoPSAngles( const vector< string >& args ); - - string name() const { return "TwoPSAngles"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - int m_j; - int m_m; - int m_e; - - GDouble m_bigTheta; - int m_reflectivityFactor; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.cc b/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.cc deleted file mode 100644 index a7b347e94c..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.cc +++ /dev/null @@ -1,85 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPSHelicity.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -TwoPSHelicity::TwoPSHelicity( const vector< string >& args ) : -UserAmplitude< TwoPSHelicity >( args ) -{ - assert( args.size() == 3 ); - - m_j = atoi( args[0].c_str() ); - m_m = atoi( args[1].c_str() ); - m_e = atoi( args[2].c_str() ); - - // make sure values are reasonable - assert( abs( m_e ) == 1 ); - assert( m_m <= m_j ); - - if( m_m == 0 ) m_bigTheta = 0.5; - if( m_m > 0 ) m_bigTheta = sqrt( 0.5 ); - if( m_m < 0 ) m_bigTheta = 0; - - // the "reflectivity factor" is e*(-1)^(m) - m_reflectivityFactor = ( m_m % 2 == 0 ? m_e : -m_e ); -} - - -complex< GDouble > -TwoPSHelicity::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - - TLorentzVector resonance = p1 + p2; - - TLorentzRotation resRestBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resRestBoost * beam; - TLorentzVector recoil_res = resRestBoost * recoil; - TLorentzVector p1_res = resRestBoost * p1; - - // helicity frame: z-axis is propagation of resonance X => opposite recoil proton in X rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - - // y axis perpendicular to production plane - TVector3 y = beam_res.Vect().Cross(z).Unit(); - - TVector3 x = y.Cross(z); - - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - GDouble phi = angles.Phi(); - - GDouble coef = sqrt( ( 2. * m_j + 1 ) / ( 4 * 3.1416 ) ); - - return complex< GDouble >( coef * m_bigTheta * - ( wignerD( m_j, m_m, 0, cosTheta, phi ) - - static_cast< GDouble>( m_reflectivityFactor ) * - wignerD( m_j, -m_m, 0, cosTheta, phi ) ) ); -} - -#ifdef GPU_ACCELERATION -void -TwoPSHelicity::launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const { - - GPUTwoPSHelicity_exec( dimGrid, dimBlock, GPU_AMP_ARGS, - m_j, m_m, m_bigTheta, - static_cast< GDouble >( m_reflectivityFactor ) ); -} -#endif //GPU_ACCELERATION diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.h b/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.h deleted file mode 100644 index 09d85f8aa4..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPSHelicity.h +++ /dev/null @@ -1,62 +0,0 @@ -#if !defined(TWOPSHELICITY) -#define TWOPSHELICITY - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -#ifdef GPU_ACCELERATION -void -GPUTwoPSHelicity_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -// A class for describing the angular portion of the decay in the -// reflectivity basis of R -> 1 2 -// particles 1 and 2 are pseudoscalars -// -// j,m are the total and z projection of the spin of R -// e is reflectivity -// p is parity of R - -class Kinematics; - -class TwoPSHelicity : public UserAmplitude< TwoPSHelicity > -{ - -public: - - TwoPSHelicity() : UserAmplitude< TwoPSHelicity >() { }; - TwoPSHelicity( const vector< string >& args ); - - string name() const { return "TwoPSHelicity"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - int m_j; - int m_m; - int m_e; - - GDouble m_bigTheta; - int m_reflectivityFactor; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.cc b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.cc deleted file mode 100644 index adadebb98f..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.cc +++ /dev/null @@ -1,95 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -TwoPiAngles::TwoPiAngles( const vector< string >& args ) : -UserAmplitude< TwoPiAngles >( args ) -{ - assert( args.size() == 9 ); - - rho000 = AmpParameter( args[0] ); - rho100 = AmpParameter( args[1] ); - rho1m10 = AmpParameter( args[2] ); - - rho111 = AmpParameter( args[3] ); - rho001 = AmpParameter( args[4] ); - rho101 = AmpParameter( args[5] ); - rho1m11 = AmpParameter( args[6] ); - - rho102 = AmpParameter( args[7] ); - rho1m12 = AmpParameter( args[8] ); - - // need to register any free parameters so the framework knows about them - registerParameter( rho000 ); - registerParameter( rho100 ); - registerParameter( rho1m10 ); - - registerParameter( rho111 ); - registerParameter( rho001 ); - registerParameter( rho101 ); - registerParameter( rho1m11 ); - - registerParameter( rho102 ); - registerParameter( rho1m12 ); -} - - -complex< GDouble > -TwoPiAngles::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - - TLorentzVector resonance = p1 + p2; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - GDouble sinSqTheta = sin(angles.Theta())*sin(angles.Theta()); - GDouble sin2Theta = sin(2.*angles.Theta()); - - GDouble phi = angles.Phi(); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - // vector meson production from K. Schilling et. al. - GDouble Pgamma = 0.4; - - GDouble W = 0.5*(1. - rho000) + 0.5*(3.*rho000 - 1.)*cosTheta*cosTheta - sqrt(2.)*rho100*sin2Theta*cos(phi) - rho1m10*sinSqTheta*cos(2.*phi); - - W -= Pgamma*cos(2.*Phi) * (rho111*sinSqTheta + rho001*cosTheta*cosTheta - sqrt(2.)*rho101*sin2Theta*cos(phi) - rho1m11*sinSqTheta*cos(2.*phi)); - - W -= Pgamma*sin(2.*Phi) * (sqrt(2.)*rho102*sin2Theta*sin(phi) + rho1m12*sinSqTheta*sin(2.*phi)); - - W *= 3./(4.*PI); - - return complex< GDouble > ( sqrt(fabs(W)) ); -} - diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.h b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.h deleted file mode 100644 index c640834eec..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles.h +++ /dev/null @@ -1,61 +0,0 @@ -#if !defined(TWOPIANGLES) -#define TWOPIANGLES - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -#ifdef GPU_ACCELERATION -void -GPUTwoPiAngles_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class TwoPiAngles : public UserAmplitude< TwoPiAngles > -{ - -public: - - TwoPiAngles() : UserAmplitude< TwoPiAngles >() { }; - TwoPiAngles( const vector< string >& args ); - - string name() const { return "TwoPiAngles"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter rho000; - AmpParameter rho100; - AmpParameter rho1m10; - - AmpParameter rho111; - AmpParameter rho001; - AmpParameter rho101; - AmpParameter rho1m11; - - AmpParameter rho102; - AmpParameter rho1m12; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc b/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc deleted file mode 100644 index 292af304a5..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc +++ /dev/null @@ -1,246 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPiAnglesRadiative.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -#include "AMPTOOLS_MCGEN/CobremsGeneration.hh" - -TwoPiAnglesRadiative::TwoPiAnglesRadiative( const vector< string >& args ) : - UserAmplitude< TwoPiAnglesRadiative >( args ) -{ - assert( args.size() == 11 ); - - rho000 = AmpParameter( args[0] ); - rho100 = AmpParameter( args[1] ); - rho1m10 = AmpParameter( args[2] ); - - rho111 = AmpParameter( args[3] ); - rho001 = AmpParameter( args[4] ); - rho101 = AmpParameter( args[5] ); - rho1m11 = AmpParameter( args[6] ); - - rho102 = AmpParameter( args[7] ); - rho1m12 = AmpParameter( args[8] ); - - polAngle = AmpParameter( args[9] ); - - polFraction = atof(args[10].c_str()); - - // need to register any free parameters so the framework knows about them - registerParameter( rho000 ); - registerParameter( rho100 ); - registerParameter( rho1m10 ); - - registerParameter( rho111 ); - registerParameter( rho001 ); - registerParameter( rho101 ); - registerParameter( rho1m11 ); - - registerParameter( rho102 ); - registerParameter( rho1m12 ); - - registerParameter( polAngle ); - - // Initialize coherent brem table - // Do this over the full range since we will be using this as a lookup - float Emax = 12.0; - float Epeak = 9.0; - float Elow = 0.139*2; - float Ehigh = 12.0; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=20.e-6; // radiator thickness in m - float collDiam=0.0034; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - totalFlux_vs_E = new TH1D("totalFlux_vs_E", "Total Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFlux_vs_E = new TH1D("polFlux_vs_E", "Polarized Flux vs. E_{#gamma}", 1000, Elow, Ehigh); - polFrac_vs_E = new TH1D("polFrac_vs_E", "Polarization Fraction vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill totalFlux - for(int i=1;i<=totalFlux_vs_E->GetNbinsX(); i++){ - double x = totalFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - doPolFlux=1; - cobrems.setPolarizedFlag(doPolFlux); - // Fill totalFlux - for(int i=1;i<=polFlux_vs_E->GetNbinsX(); i++){ - double x = polFlux_vs_E->GetBinCenter(i)/Emax; - double y = 0; - //if(EpeakSetBinContent(i, y); - } - - polFrac_vs_E->Divide(polFlux_vs_E, totalFlux_vs_E); -} - - -complex< GDouble > -TwoPiAnglesRadiative::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - TLorentzVector target (0.0, 0.0, 0.0, 0.938272); - - TLorentzVector locOmegaP4 = p1 + p2; - //Polarization plane: - //Beam is in the lab z-direction - //(FYI) Circularly polarized photon beam: Polarization rotates through the plane perpendicular to the direction of the photon: The XY Plane - //The polarization vector is perpendicular to the direction of the photon - //Linearly polarized photon beam: Polarization is confined to a plane along the direction of the photon - //Plane defined by z-direction & some angle phi. Thus, polarization vector defined by phi. - - //Production CM frame: The center-of-mass frame of the production step. Here: g, p -> omega, p - //In general, the beam energy is measured more accurately than the combination of all of the final-state particles - //So define the production CM frame using the initial state - TLorentzVector locInitialStateP4_KinFit = beam + target; - TVector3 locBoostVector_ProdCM = -1.0*(locInitialStateP4_KinFit.BoostVector()); //negative due to coordinate system convention - - //boost beam & target proton to production CM frame - TLorentzVector locBeamP4_ProdCM(beam); - locBeamP4_ProdCM.Boost(locBoostVector_ProdCM); - TLorentzVector locProtonP4_ProdCM(recoil); - locProtonP4_ProdCM.Boost(locBoostVector_ProdCM); - - //Production plane: - //The production plane is the plane containing the produced particles. Here: Defined by the proton and the omega - //However, when you boost to the production CM frame, the production plane is no longer well defined: the particles are back-to-back - //So, by convention, define the production plane in the production CM frame by the beam and the vector meson. - - //Production CM frame axes: "HELICITY SYSTEM" - //The z-axis is defined as the direction of the meson (omega): z = Omega - //The y-axis is defined by the vector cross product: y = Beam X Omega - //The x-axis is defined by the vector cross product: x = y cross z - //However, the proton momentum is in general better known than the omega momentum, so use it instead (they are back-to-back) - //z = -1 * Proton - //y = -1 * (Beam X Proton) - //x = y cross z - //Thus the production plane in the production frame is the XZ plane, and the normal vector is the Y-axis - - //Define production CM frame helicity axes - TVector3 locHelicityZAxis_ProdCM = -1.0*locProtonP4_ProdCM.Vect().Unit(); - TVector3 locHelicityYAxis_ProdCM = -1.0*locBeamP4_ProdCM.Vect().Cross(locProtonP4_ProdCM.Vect()).Unit(); - TVector3 locHelicityXAxis_ProdCM = locHelicityYAxis_ProdCM.Cross(locHelicityZAxis_ProdCM).Unit(); - - //Since the beam is in PARA configuration (Run 3185), the polarization vector is along the lab x-axis - //Since the boost is in the z-direction, this vector is the same in the production CM frame - TVector3 locPolUnit(cos(polAngle), sin(polAngle), 0.0); - - //In the production CM frame, locPHI is the angle between the polarization vector and the production plane - double locCosPHI = locPolUnit.Dot(locHelicityYAxis_ProdCM.Cross(locBeamP4_ProdCM.Vect().Unit())); - double locPHI = acos(locCosPHI); //reports phi between 0 and pi: sign ambiguity - //Resolve the sign ambiguity - double locSinPHI = locPolUnit.Dot(locHelicityYAxis_ProdCM); - if(locSinPHI < 0.0) locPHI *= -1.0; - - //Now, we need the theta, phi angles between the omega decay plane and the production plane - //The omega decay plane is defined by decay products in the omega CM frame - //2 particles (vectors) define a plane. - //However, to conserve momentum, the third particle cannot be out of that plane (so must also be in it) - //So, use the pi+ and the pi- to define the plane (pi0 measurement has less resolution) - //By the way, for rho decays, the theta & phi angles are those of the pi+ in the rho CM frame, with respect to the helicity axes - - //boost pi+/- to omega CM frame - TVector3 locBoostVector_OmegaCM = -1.0*(locOmegaP4.BoostVector()); //negative due to coordinate system convention - TLorentzVector locBeamP4_OmegaCM(beam); - locBeamP4_OmegaCM.Boost(locBoostVector_OmegaCM); - TLorentzVector locProtonP4_OmegaCM(recoil); - locProtonP4_OmegaCM.Boost(locBoostVector_OmegaCM); - TLorentzVector locPi0P4_OmegaCM(p1); - locPi0P4_OmegaCM.Boost(locBoostVector_OmegaCM); - TLorentzVector locGammaP4_OmegaCM(p2); - locGammaP4_OmegaCM.Boost(locBoostVector_OmegaCM); - - //Define omega CM frame helicity axes - //These are defined the same way as before, but with the boost, the direction of the x & y axes has changed - TVector3 locHelicityZAxis_OmegaCM = -1.0*locProtonP4_OmegaCM.Vect().Unit(); - TVector3 locHelicityYAxis_OmegaCM = -1.0*locBeamP4_OmegaCM.Vect().Cross(locProtonP4_OmegaCM.Vect()).Unit(); - TVector3 locHelicityXAxis_OmegaCM = locHelicityYAxis_OmegaCM.Cross(locHelicityZAxis_OmegaCM).Unit(); - - // Need the direction of the bachekor photon - TVector3 locOmegaNormal = locGammaP4_OmegaCM.Vect(); - - //Compute the theta angle to the omega decay plane - double locCosTheta = locOmegaNormal.Dot(locHelicityZAxis_OmegaCM)/locOmegaNormal.Mag(); - double locTheta = acos(locCosTheta); - - //Compute the phi angle to the omega decay plane - TVector3 locZCrossOmegaNormal = locHelicityZAxis_OmegaCM.Cross(locOmegaNormal); - double locZCrossOmegaNormalMag = locZCrossOmegaNormal.Mag(); - double locCosPhi = locHelicityYAxis_OmegaCM.Dot(locZCrossOmegaNormal)/locZCrossOmegaNormalMag; - double locPhi = acos(locCosPhi); //reports phi between 0 and pi: sign ambiguity - //Resolve the sign ambiguity - double locSinPhi = -1.0*locHelicityXAxis_OmegaCM.Dot(locZCrossOmegaNormal)/locZCrossOmegaNormalMag; - if(locSinPhi < 0.0) - locPhi *= -1.0; - - GDouble cosTheta = locCosTheta; - GDouble sinSqTheta = sin(locTheta)*sin(locTheta); - GDouble sin2Theta = sin(2.*locTheta); - - GDouble phi = locPhi; - GDouble Phi = locPHI; - - //GDouble psi = phi - Phi; - //if(psi < -1*PI) psi += 2*PI; - //if(psi > PI) psi -= 2*PI; - - // vector meson production from K. Schilling et. al. - - GDouble Pgamma; - if(polFraction >= 0.) Pgamma = polFraction; - else{ - int bin = polFrac_vs_E->GetXaxis()->FindBin(pKin[0][0]); - if (bin == 0 || bin > polFrac_vs_E->GetXaxis()->GetNbins()){ - Pgamma = 0.; - } - else Pgamma = polFrac_vs_E->GetBinContent(bin); - } -/* - GDouble W = 1.0 - 0.5*(1. - rho000)*sinSqTheta - rho000*cosTheta*cosTheta + sqrt(2.)*rho100*sin2Theta*cos(phi) + rho1m10*sinSqTheta*cos(2.*phi); - - W -= Pgamma*cos(2.*Phi) * (2.*rho111 + (rho001-rho111)*sinSqTheta + sqrt(2.)*rho101*sin2Theta*cos(phi) + rho1m11*sinSqTheta*cos(2.*phi)); - - W += Pgamma*sin(2.*Phi) * (sqrt(2.)*rho102*sin2Theta*sin(phi) + rho1m12*sinSqTheta*sin(2.*phi)); - - */ - - double rho110 = 0.5*(1.-rho000); - - GDouble W = 1.0 - sinSqTheta * rho110 - cosTheta*cosTheta*rho000 + sinSqTheta*cos(2.*phi)*rho1m10 + sqrt(2.)*rho100*sin2Theta*cos(phi); - - W -= Pgamma*cos(2.*Phi) * (2.*rho111 + sinSqTheta*(rho001-rho111) + sinSqTheta*cos(2.*phi)*rho1m11 + sqrt(2.)*rho101*sin2Theta*cos(phi)); - - W += Pgamma*sin(2.*Phi) * (rho1m12*sinSqTheta*sin(2.*phi) + sqrt(2.)*rho102*sin2Theta*sin(phi)); - - W *= 3./(8.*PI); - - return complex< GDouble > ( sqrt(fabs(W)) ); -} - diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.h b/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.h deleted file mode 100644 index 7af49e6457..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAnglesRadiative.h +++ /dev/null @@ -1,71 +0,0 @@ -#if !defined(TWOPIANGLESRADIATIVE) -#define TWOPIANGLESRADIATIVE - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include "TH1D.h" -#include "TFile.h" -#include -#include -#include - -#ifdef GPU_ACCELERATION -void -GPUTwoPiAnglesRadiative_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int j, int m, GDouble bigTheta, GDouble refFact ); - -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class TwoPiAnglesRadiative : public UserAmplitude< TwoPiAnglesRadiative > -{ - -public: - - TwoPiAnglesRadiative() : UserAmplitude< TwoPiAnglesRadiative >() { }; - TwoPiAnglesRadiative( const vector< string >& args ); - - string name() const { return "TwoPiAnglesRadiative"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter rho000; - AmpParameter rho100; - AmpParameter rho1m10; - - AmpParameter rho111; - AmpParameter rho001; - AmpParameter rho101; - AmpParameter rho1m11; - - AmpParameter rho102; - AmpParameter rho1m12; - - AmpParameter polAngle; - - double polFraction; - - TH1D *totalFlux_vs_E; - TH1D *polFlux_vs_E; - TH1D *polFrac_vs_E; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.cc b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.cc deleted file mode 100644 index f8d1acf6c9..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.cc +++ /dev/null @@ -1,133 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_amp.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -TwoPiAngles_amp::TwoPiAngles_amp( const vector< string >& args ) : -UserAmplitude< TwoPiAngles_amp >( args ) -{ - assert( args.size() == 5 ); - - phipol = atof(args[0].c_str() )*3.14159/180.; // azimuthal angle of the photon polarization vector in the lab. - polFrac = AmpParameter( args[1] ); // fraction of polarization (0-1) - m_rho = atoi( args[2].c_str() ); // Jz component of rho - PhaseFactor = AmpParameter( args[3] ); // prefix factor to amplitudes in computation ( 0=1/1=exp(2iPhi)/2=-exp(2iPhi) ) - flat = atoi( args[4].c_str() ); // flat=1 uniform angles, flat=0 use YLMs - - assert( ( phipol >= 0.) && (phipol <= 2*3.14159)); - assert( ( polFrac >= 0 ) && ( polFrac <= 1 ) ); - assert( ( m_rho == 1 ) || ( m_rho == 0 ) || ( m_rho == -1 )); - assert( ( PhaseFactor == 0 ) || ( PhaseFactor == 1 ) || ( PhaseFactor == 2 ) || ( PhaseFactor == 3 ) - || ( PhaseFactor == 4 ) || ( PhaseFactor == 5 ) || ( PhaseFactor == 6 ) || ( PhaseFactor == 7 )); - assert( (flat == 0) || (flat == 1) ); - - // need to register any free parameters so the framework knows about them - registerParameter( polFrac ); -} - - -complex< GDouble > -TwoPiAngles_amp::calcAmplitude( GDouble** pKin ) const { - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector recoil ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p1 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector p2 ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - - TLorentzVector resonance = p1 + p2; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - // GDouble sinSqTheta = sin(angles.Theta())*sin(angles.Theta()); - // GDouble sin2Theta = sin(2.*angles.Theta()); - GDouble phi = angles.Phi(); - - // TVector3 zlab(0.,0.,1.0); // z axis in lab - TVector3 eps(cos(phipol), sin(phipol), 0.0); // beam polarization vector in lab - // TVector3 eps_perp = zlab.Cross(eps); // perpendicular to plane defined by eps - // GDouble Phi_test = asin((eps_perp.Cross(y)).Mag()); // compute angle between planes. - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - Phi = Phi > 0? Phi : Phi + 3.14159; - - // cout << "Phi_test=" << Phi_test << " Phi=" << Phi << " Sum=" << Phi_test+Phi << " Diff=" << Phi_test-Phi << " PhaseFactor=" << PhaseFactor << endl; - - complex< GDouble > i( 0, 1 ); - complex< GDouble > prefactor( 0, 0 ); - complex< GDouble > Amp( 0, 0 ); - Int_t Mrho=0; - - switch (PhaseFactor) { - case 0: - prefactor = 0.5*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)); - Mrho = m_rho; - break; - case 1: - prefactor = 0.5*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)); - Mrho = m_rho; - break; - case 2: - prefactor = 0.5*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)); - Mrho = m_rho; - break; - case 3: - prefactor = -0.5*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)); - Mrho = m_rho; - break; - case 4: - prefactor = 0.5*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)); - prefactor *= pow(-1,m_rho); - Mrho = -m_rho; - break; - case 5: - prefactor = 0.5*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)); - prefactor *= pow(-1,m_rho); - Mrho = -m_rho; - break; - case 6: - prefactor = 0.5*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)); - prefactor *= pow(-1,m_rho); - Mrho = -m_rho; - break; - case 7: - prefactor = -0.5*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)); - prefactor *= pow(-1,m_rho); - Mrho = -m_rho; - break; - } - - if (flat == 1) { - Amp = 1; - } - else { - Amp = prefactor * Y( 1, Mrho, cosTheta, phi); - } - - // cout << " m_rho=" << m_rho << " cosTheta=" << cosTheta << " phi=" << phi << " prefactor=" << prefactor << " Amp=" << Amp << endl; - - return Amp; -} - diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.h b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.h deleted file mode 100644 index 282831bbd7..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_amp.h +++ /dev/null @@ -1,55 +0,0 @@ -#if !defined(TWOPIANGLES_AMP) -#define TWOPIANGLES_AMP - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -#ifdef GPU_ACCELERATION -#void -#GPUTwoPiAngles_amp_exec( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, -# int j, int m, GDouble bigTheta, GDouble refFact ); -# -#endif // GPU_ACCELERATION - -using std::complex; -using namespace std; - -class Kinematics; - -class TwoPiAngles_amp : public UserAmplitude< TwoPiAngles_amp > -{ - -public: - - TwoPiAngles_amp() : UserAmplitude< TwoPiAngles_amp >() { }; - TwoPiAngles_amp( const vector< string >& args ); - - string name() const { return "TwoPiAngles_amp"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION -# -# void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; -# -# bool isGPUEnabled() const { return true; } -# -#endif // GPU_ACCELERATION - -private: - - Double_t phipol; - Int_t m_rho; - Int_t PhaseFactor; - AmpParameter polFrac; - Int_t flat; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.cc b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.cc deleted file mode 100644 index 7bd9f331e4..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.cc +++ /dev/null @@ -1,123 +0,0 @@ - -#include -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_primakoff.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" - -TwoPiAngles_primakoff::TwoPiAngles_primakoff( const vector< string >& args ) : -UserAmplitude< TwoPiAngles_primakoff >( args ) -{ - assert( args.size() == 5 ); - - phipol = atof(args[0].c_str() )*3.14159/180.; // azimuthal angle of the photon polarization vector in the lab. Convert to radians. - polFrac = AmpParameter( args[1] ); // fraction of polarization (0-1) - m_rho = atoi( args[2].c_str() ); // Jz component of rho - PhaseFactor = AmpParameter( args[3] ); // prefix factor to amplitudes in computation - flat = atoi( args[4].c_str() ); // flat=1 uniform angles, flat=0 use YLMs - - assert( ( phipol >= 0.) && (phipol <= 2*3.14159)); - assert( ( polFrac >= 0 ) && ( polFrac <= 1 ) ); - assert( ( m_rho == 1 ) || ( m_rho == 0 ) || ( m_rho == -1 )); - assert( ( PhaseFactor == 0 ) || ( PhaseFactor == 1 ) || ( PhaseFactor == 2 ) || ( PhaseFactor == 3 )); - assert( (flat == 0) || (flat == 1) ); - - // need to register any free parameters so the framework knows about them - registerParameter( polFrac ); -} - - -complex< GDouble > -TwoPiAngles_primakoff::calcAmplitude( GDouble** pKin ) const { - - complex< GDouble > i( 0, 1 ); - complex< GDouble > factor( 0, 0 ); - complex< GDouble > Amp( 0, 0 ); - Int_t Mrho=0; - - if (flat == 1) { // no computations needed - Amp = 1; - return Amp; - } - - - // for Primakoff, all calculations are in the lab frame. Keep recoil but remember that it cannot be measured by detector. - - TLorentzVector beam ( pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0] ); - TLorentzVector p1 ( pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0] ); - TLorentzVector p2 ( pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0] ); - TLorentzVector recoil ( pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0] ); - TLorentzVector resonance = p1 + p2; - - TVector3 eps(cos(phipol), sin(phipol), 0.0); // beam polarization vector in lab - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // choose helicity frame: z-axis opposite recoil target in rho rest frame. Note that for Primakoff recoil is defined as missing P4 - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble CosTheta = angles.CosTheta(); - GDouble phi = angles.Phi(); - // GDouble sinSqTheta = sin(angles.Theta())*sin(angles.Theta()); - // GDouble sin2Theta = sin(2.*angles.Theta()); - - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = Phi - phi; // define angle difference - if(psi < -1*PI) psi += 2*PI; - if (psi > PI) psi -= 2*PI; - - /*cout << " recoil_res Angles="; recoil_res.Vect().Print(); - cout << " p1_res Angles="; p1_res.Vect().Print(); - cout << "Phi_pip= " << Phi_pip << endl; - cout << "Phi= " << Phi << endl; - cout << "Phi_prod= " << Phi_prod << endl; - cout << "phi= " << phi << endl; - cout << " psi=" << psi << endl;*/ - - - switch (PhaseFactor) { - case 0: - Mrho = m_rho; - Amp = sqrt(1-polFrac)*(-sin(Phi)* Y( 0, Mrho, CosTheta, phi) ); - break; - case 1: - Mrho = m_rho; - Amp = sqrt(1+polFrac)*(cos(Phi)* Y( 0, Mrho, CosTheta, phi) ); - break; - case 2: - Mrho = m_rho; - factor = exp(-i*Phi)* Y( 1, Mrho, CosTheta, phi); - Amp = sqrt(1-polFrac)* imag(factor); - break; - case 3: - Mrho = m_rho; - factor = exp(-i*Phi)* Y( 1, Mrho, CosTheta, phi); - Amp = sqrt(1+polFrac)* real(factor); - break; - } - - - // cout << " m_rho=" << m_rho << " CosTheta=" << CosTheta << " phi=" << phi << " prefactor=" << prefactor << " Amp=" << Amp << endl; - - return Amp; -} - diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.h b/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.h deleted file mode 100644 index e41f712b3c..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiAngles_primakoff.h +++ /dev/null @@ -1,44 +0,0 @@ -#if !defined(TWOPIANGLES_PRIMAKOFF) -#define TWOPIANGLES_PRIMAKOFF - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include - -using std::complex; -using namespace std; - -class Kinematics; - -class TwoPiAngles_primakoff : public UserAmplitude< TwoPiAngles_primakoff > -{ - -public: - - TwoPiAngles_primakoff() : UserAmplitude< TwoPiAngles_primakoff >() { }; - TwoPiAngles_primakoff( const vector< string >& args ); - - string name() const { return "TwoPiAngles_primakoff"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - bool isGPUEnabled() const { return false; } -#endif // GPU_ACCELERATION - -private: - - Double_t phipol; - Int_t m_rho; - Int_t PhaseFactor; - AmpParameter polFrac; - Int_t flat; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.cc b/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.cc deleted file mode 100644 index 0939cea135..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.cc +++ /dev/null @@ -1,276 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" - -#include "barrierFactor.h" -#include "breakupMomentum.h" - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/TwoPiWt_primakoff.h" - -// Class modeled after BreitWigner amplitude function provided for examples with AmpTools. -// Dependence of swave 2pi cross section on W (mass of 2pi system) -// Elton 4/17/2017 - - -Double_t sigma_ggpipi_func (Double_t *x, Double_t *par){ - - // Parameterization from Rory for cross section for gamma gamma -> pi+ pi- - // Returns cross section in units of nb/sr - - // constants - // Double_t const PI = 3.14159; - Double_t MPI =0.139570; - Double_t W0 = 0.3; - - Double_t expon = par[0]; - // Double_t par2 = par[1]; - Double_t Wpipi = x[0] ; - Double_t f; - - if (Wpipi < 2*MPI) { - f = 0; - } - else if (Wpipi < W0) { - f = 300./(0.6*4.*PI)*(Wpipi-2.*MPI)/(W0-2.*MPI); // linear rise, isotropic, CB data only 60% coverage - } - else { - f = 300./(0.6*4.*PI)*pow(W0/Wpipi,expon); // power fall off, isotropic - } - - return f; -} - - -Double_t ff_func (Double_t *x, Double_t *par){ - - // return the nuclear form factor accourding to 2 parameter Fermi distribution - // See Journall of Research of the National Bureau of Standards - B Mathenatics and Mathematical Physics - // Vol. 70B, No. 1, Jan-Mar 1966. "The Form Factor of the Fermi Model Spatial Distribution," by Maximon and Schrack - // - // Function is a function of q, the three-momentum transfer to the nucleus. - // Input argument is t - // Note that q is the 3-vector momentum, but for low -t, q ~ sqrt(-t). - - // constants - // Double_t alpha = 1/137.; - Double_t pi = 3.14159; - Double_t hbarc = 0.19733; // GeV*fm - Double_t q = sqrt(x[0])/hbarc; // take q to be in fm^-1. Input variable is positive (-t) - - Double_t R0 = par[0]; // half-density radius - Double_t a0 = par[1]; // skin or diffuseness parameter - - Double_t rho0; - Double_t sum=0; - Int_t jmax=4; - for (Int_t j=1;j 0? sqrt((t0 -t)/(p1cm*p3cm)) : 0; - - Double_t conv = 1./(gammastar*(1 + betastar/betapipicm)); - - if (-t > -t0) { - f = (coef/2)* Eg*Eg*Eg*Eg * (t0-t)* betapipi*betapipi * (FF*FF/(t*t))*conv*conv*conv*conv/(p1cm*p3cm*p1cm*p3cm); - } - else { - f = 0; - } - - // cout << " t=" << t << " betastar=" << betastar << " gammastar=" << gammastar << " betapipicm=" << betapipicm << " t0=" << t0 << " thepipicm=" << thepipicm << " thepipi=" << thepipi << " f=" << f << endl; - // cout << " t=" << t << " FF=" << FF << " f=" << f << endl; - return f; -} - - -TwoPiWt_primakoff::TwoPiWt_primakoff( const vector< string >& args ) : -UserAmplitude< TwoPiWt_primakoff >( args ) -{ - - assert( args.size() == 4 ); - m_par1 = AmpParameter( args[0] ); - m_par2 = AmpParameter( args[1] ); - m_daughters = pair< string, string >( args[2], args[3] ); - - // need to register any free parameters so the framework knows about them - registerParameter( m_par1 ); - registerParameter( m_par2 ); - - // make sure the input variables look reasonable - // assert( ( m_orbitL >= 0 ) && ( m_orbitL <= 4 ) ); -} - -complex< GDouble > -TwoPiWt_primakoff::calcAmplitude( GDouble** pKin ) const -{ - TLorentzVector P1, P2, Ptot, Ptemp, Precoil; - - for( unsigned int i = 0; i < m_daughters.first.size(); ++i ){ - - string num; num += m_daughters.first[i]; - int index = atoi(num.c_str()); - Ptemp.SetPxPyPzE( pKin[index][1], pKin[index][2], - pKin[index][3], pKin[index][0] ); // pi+ is index 1 - P1 += Ptemp; - Ptot += Ptemp; - - /* cout << " 1i=" << i << " num=" << num << " index=" << index << " P1.M=" << P1.M() << endl; - P1.Print(); - Ptot.Print();*/ - } - - for( unsigned int i = 0; i < m_daughters.second.size(); ++i ){ - - string num; num += m_daughters.second[i]; - int index = atoi(num.c_str()); - Ptemp.SetPxPyPzE( pKin[index][1], pKin[index][2], - pKin[index][3], pKin[index][0] ); // pi- is index 2 - P2 += Ptemp; - Ptot += Ptemp; - - /* cout << " 2i=" << i << " num=" << num << " index=" << index << " P2.M=" << P2.M() << endl; - P2.Print(); - Ptot.Print();*/ - } - - GDouble Wpipi = Ptot.M(); - // GDouble mass1 = P1.M(); - // GDouble mass2 = P2.M(); - - // get momentum transfer - Precoil.SetPxPyPzE (pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0]); // Recoil is particle 3 - GDouble Et = Precoil.E(); - GDouble Mt = Precoil.M(); - GDouble t = -2*Precoil.M()*(Et - Mt); - - // cout << "Precoil.M()=" << Precoil.M() << " T=" << Precoil.E() - Precoil.M() << " t=" << t << endl; Precoil.Print();cout << endl << endl; - - // call sigma (gamma gamma -> pi pi) cross section - - - Int_t const npar = 4; - Double_t xin[1]; - xin[0] = Wpipi; // W, 2pi mass - Double_t Eg = pKin[0][0]; // incident photon energy - Double_t parin[npar]; - parin[0] = 1.29; // parameter 1: exponent - parin[1] = 0.; // parameter 2: par2 (spare) - // Double_t Wmin=0.2 ; - // Double_t Wmax=0.8; - - GDouble sig_ggpipi = sigma_ggpipi_func(xin,parin); - - parin[0] = Wpipi; - parin[1] = Eg; - // Double_t R0 = 6.62; // Pb half-density radius, fm - // Double_t a0 = 0.546; // Pb difuseness parameter, fm - // Double_t R0 = 5.358; // Sn half-density radius, fm - // Double_t a0 = 0.550; // Sn difuseness parameter, fm - parin[2] = 6.62; - parin[3] = 0.546; - xin[0] = -t; // input positive value of t - - GDouble sigmat = sigmat_func (xin,parin); - - // cout << "calcAmplitude: 2pi mass=" << Wpipi << " Eg=" << Eg << " t=" << t << " sig_ggpipi=" << sig_ggpipi << " sigmat=" << sigmat << endl; - - complex Csig( sqrt(sigmat*sig_ggpipi/Wpipi/exp(6.0*t)), 0.0 ); // Return complex double, sqrt (cross section). Divide out generated exponential. - - return( Csig ); -} - -void -TwoPiWt_primakoff::updatePar( const AmpParameter& par ){ - - // could do expensive calculations here on parameter updates - -} - - diff --git a/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.h b/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.h deleted file mode 100644 index 33e7f24127..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/TwoPiWt_primakoff.h +++ /dev/null @@ -1,51 +0,0 @@ -#if !defined(TWOPIWT_PRIMAKOFF) -#define TWOPIWT_PRIMAKOFF - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - -using std::complex; -using namespace std; - -class Kinematics; - -class TwoPiWt_primakoff : public UserAmplitude< TwoPiWt_primakoff > -{ - -public: - - TwoPiWt_primakoff() : UserAmplitude< TwoPiWt_primakoff >() {} - TwoPiWt_primakoff( const vector< string >& args ); - - ~TwoPiWt_primakoff(){} - - string name() const { return "TwoPiWt_primakoff"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - - void updatePar( const AmpParameter& par ); - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - -private: - - AmpParameter m_par1; // for the moment assume W cross section has 2 parameters - AmpParameter m_par2; - - pair< string, string > m_daughters; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/Uniform.cc b/src/libraries/AMPTOOLS_AMPS/Uniform.cc deleted file mode 100644 index 804f3c5fca..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Uniform.cc +++ /dev/null @@ -1,17 +0,0 @@ - - -#include -#include -#include -#include -#include - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_AMPS/Uniform.h" - -complex< GDouble > -Uniform::calcAmplitude( GDouble** pKin ) const -{ - complex a(1,0); - return a; -} diff --git a/src/libraries/AMPTOOLS_AMPS/Uniform.h b/src/libraries/AMPTOOLS_AMPS/Uniform.h deleted file mode 100644 index 15336f308c..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/Uniform.h +++ /dev/null @@ -1,49 +0,0 @@ -#if !defined(UNIFORM) -#define UNIFORM - -#include "IUAmpTools/UserAmplitude.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - - -using std::complex; -using namespace std; - -class Kinematics; - -#ifdef GPU_ACCELERATION -void GPUUniform_exec(dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO); - -#endif - - -class Uniform : public UserAmplitude< Uniform > -{ -public: - - Uniform() : UserAmplitude< Uniform >() { } - - Uniform( const vector< string >& args ) : UserAmplitude< Uniform >( args ) {} - - ~Uniform(){} - - string name() const { return "Uniform"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - -#ifdef GPU_ACCELERATION - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const{ - GPUUniform_exec(dimGrid, dimBlock, GPU_AMP_ARGS); - }; - - bool isGPUEnabled() const { return true; } -#endif - - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.cc b/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.cc deleted file mode 100644 index 3be317aa4c..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.cc +++ /dev/null @@ -1,549 +0,0 @@ -#include -#include -#include - -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "IUAmpTools/AmpParameter.h" -#include "b1piAngAmp.h" -#include "AMPTOOLS_AMPS/barrierFactor.h" -#include "AMPTOOLS_AMPS/clebschGordan.h" -#include "AMPTOOLS_AMPS/wignerD.h" -#include "AMPTOOLS_AMPS/breakupMomentum.h" - -b1piAngAmp::b1piAngAmp( const vector< string >& args ): - UserAmplitude< b1piAngAmp >( args ), - m_fastCalc( false ) -{ - - const unsigned int base_arg_num=8; - - bool tweakBW_omega = args.size() == base_arg_num+1; - bool tweakBW_omega_b1 = args.size() == base_arg_num+2; - //accept either base number of arguments, extended set (14) - // for orthogonality check diagnostics - // or base number plus omega width or base number plus omega and b1 widths - assert(args.size() == base_arg_num || args.size() == 14 || - tweakBW_omega || tweakBW_omega_b1); - - mpolBeam = atoi( args[0].c_str() ); // beam polarization component (X=0, Y=1) - mpolFrac = AmpParameter( args[1] ); // fraction of polarization 0=0% 1=100%. - mJ_X = atoi( args[1].c_str() ); // total J of produced resonance - // parity of produced resonance - mPar_X = ( atoi( args[2].c_str() ) == 1 ? 1 : -1 ); // for convenience let Par_X=0 --> -1 - int L_X = atoi( args[3].c_str() ); // L between bachelor (pi) and isobar (b1) - mL_X = ( L_X >= 0 ? L_X : ( mJ_X == 0 ? 1 : 0) ); - mI_X = atoi( args[4].c_str() ); // isospin of the resonance - mepsilon_R= ( atoi( args[5].c_str() ) == 1 ? 1 : -1 ); - - int Iz_b1 = atoi( args[6].c_str() ); - int Iz_pi = atoi( args[7].c_str() ); - - bool m_ORTHOCHECK = (args.size() == base_arg_num || tweakBW_omega || tweakBW_omega_b1); - - // Note, the following have no effect since L_\omega & J_\rho - // have been restricted to value 1 - m_u_rho_1 = m_ORTHOCHECK ? sqrt(.9) : atoi( args[8].c_str()); - m_u_rho_3 = m_ORTHOCHECK ? sqrt(.1) : atoi( args[9].c_str()); - m_u_omega_1= m_ORTHOCHECK ? sqrt(.9) : atoi( args[10].c_str()); - m_u_omega_3= m_ORTHOCHECK ? sqrt(.1) : atoi( args[11].c_str()); - - mG0_omega = 0.0085; - mG0_b1 = 0.143; - - if(tweakBW_omega && args[8][0]=='F') m_fastCalc=true; - else{ - if(tweakBW_omega || tweakBW_omega_b1) mG0_omega = atof( args[8].c_str()); - if(tweakBW_omega_b1) mG0_b1 = atof( args[9].c_str()); - } - - const GDouble b1DSratio2 = 0.277*0.277; //from PDG: D/S amp ratio=0.277+/-0.027 - m_u_b1_0 = m_ORTHOCHECK ? sqrt(1/(1 + b1DSratio2)) - : atoi( args[12].c_str()); - m_u_b1_2 = m_ORTHOCHECK ? sqrt(b1DSratio2/(1 + b1DSratio2)) - : atoi( args[13].c_str()); - - - assert( ( mpolBeam == 0 ) || ( mpolBeam == 1 ) ); - if(!(( mpolFrac >= 0 ) && ( mpolFrac <= 1 ))){ - cout << "ERROR: polFrac set to " << mpolFrac << endl << "Should be 0.0-1.0" << endl; - assert(false); - } - - assert( mJ_X >= 0 && mJ_X <=2 ); -// assert( abs( (double)mPar_X ) <= 1 ); - assert( abs( (double)mI_X ) <= 1 ); - //assert( mL_X <= mJ_X ); - assert( (mL_X+1 >= mJ_X && abs(mL_X-1) <= mJ_X) || mL_X==-1 ); - assert( abs(mepsilon_R)<=1 ); - assert( abs(Iz_b1) <= 1 ); - assert( abs(Iz_pi) <= 1 ); - - registerParameter( mpolFrac ); - - m_disableBW_omega = mG0_omega <= 0; - m_disableBW_b1 = mG0_b1 <= 0; - - // create nominal Iz list: 0,0,-1,+1,0,-1,+1 - // (proton isospin irrelevant at the moment) - mIz.assign(7, 0); - mIz[2]=Iz_pi; - mIz[3]=Iz_b1; - mIz[5]=-1; - mIz[6]=+1; -} - -void PrintHEPvector(TLorentzVector &v){ - printf("(%6.3f, %6.3f, %6.3f; %6.3f m=%6.3f)\n",v.X(),v.Y(),v.Z(),v.T(),v.M()); -} -void PrintArrVector(GDouble *v){ - printf("arr(%6.3f, %6.3f, %6.3f; %6.3f m=%6.3f)\n",v[1],v[2],v[3],v[0], - v[0]*v[0]-v[1]*v[1]-v[2]*v[2]-v[3]*v[3]); -} - - - -inline GDouble b1piAngAmp::N(int J) const -{ return sqrt((2*J+1)/(4*M_PI)); } - -TLorentzVector& MoveToRF(TLorentzVector &parent, - TLorentzVector &daughter) -{ - daughter.RotateZ(-parent.Phi()); - daughter.RotateY(-parent.Theta()); - daughter.Boost(0,0,-parent.Rho()/parent.E()); - return daughter; -} - - -inline complex b1piAngAmp:: -BreitWigner(GDouble m0, GDouble Gamma0, int L, - TLorentzVector &P1, TLorentzVector &P2) const -{ - - TLorentzVector Ptot=P1+P2; - GDouble m = Ptot.M(); - GDouble mass1 = P1.M(); - GDouble mass2 = P2.M(); - - - // assert positive breakup momenta - GDouble q0 = fabs( breakupMomentum(m0, mass1, mass2) ); - GDouble q = fabs( breakupMomentum(m, mass1, mass2) ); - - //printf("BW: (%5.3f, %5.3f, %d) m=%6.4f m1=%6.4f m2=%6.4f q=%6.4f q0=%6.4f\n", - // m0,Gamma0,L,m,mass1,mass2,q,q0); - - GDouble F0 = L==0 ? 1.0 : barrierFactor(q0, L); - GDouble F = L==0 ? 1.0 : barrierFactor(q, L); - - GDouble width_coef=Gamma0*(m0/m); - //GDouble qq0=q/q0; - //GDouble width_qdep = (L==0 ? qq0 : (L==1 ? qq0*qq0*qq0 : pow(qq0,2*L+1)))*((F*F)/(F0*F0)); - GDouble width_qdep = q/q0 * (F*F)/(F0*F0); - //GDouble num_qdep = (L==0 ? q : (L==1 ? q*q*q : pow(q,2*L+1)))*(F*F); - GDouble num_qdep = q*(F*F); - - GDouble width = width_coef * width_qdep; - - //complex bwtop(m0 * width, 0.0 ); - complex bwtop(sqrt(m0*width_coef) * num_qdep, 0.0 ); - - complex bwbottom( ( m0*m0 - m*m ) , - -1.0 * ( m0 * width ) ); - - return( bwtop / bwbottom ); - -} - - -inline GDouble b1piAngAmp::CB(int j1, int j2, int m1, int m2, int J, int M) const -{ - if( j1*j2 == 0 ) return 1.0; - - if(J == 1){ - if(j1==1 && j2==1){ - if(M == -1){ - if(m1==0 && m2==-1) - return 1/sqrt(2.0); - else if(m1==-1 && m2==0) - return -1/sqrt(2.0); - else - return 0.0; - }else if(M == 1){ - if(m1==0 && m2==1) - return -1.0/sqrt(2.0); - else if(m1==1 && m2==0) - return 1.0/sqrt(2.0); - else - return 0.0; - }else if(M == 0){ - return m1/sqrt(2.0); - } - }else if( j1==2 && j2==1 ){ - if(M == -1 || M == 1){ - if(m1==0) return 1.0/sqrt(10.0); - } else if(M==0 && m1==0) - return -sqrt(2.0/5.0); - }else if( j1==2 && j2==3 ){ - if( M == -1 || M == 1 ) { - if (m1==0) return sqrt(6.0/35.0); - }else if (M==0 && m1==0) - return 3.0/sqrt(35.0); - }else if( j1==3 && j2==3 ){ - if( M == -1 || M == 1 ) { - if (m1==0) return -m2*0.5*sqrt(6.0/7.0); - }else if (M==0 && m1==0) - return 0.0; - } - } - - //printf("Resorting to clebschGordan(%3d,%3d,%3d,%3d,%3d,%3d)\n", - //j1, j2, m1, m2, J, M); - return clebschGordan(j1, j2, m1, m2, J, M); -} - - - -GDouble b1piAngAmp::u_rho(int J_rho) const -{ - return J_rho==1 ? m_u_rho_1 : (J_rho==3 ? m_u_rho_3 : 0); -} -GDouble b1piAngAmp::u_omega(int L_omega) const -{ - return L_omega==1 ? m_u_omega_1 : (L_omega==3 ? m_u_omega_3 : 0); -} -GDouble b1piAngAmp::u_b1(int L_b1) const -{ - return L_b1==0 ? m_u_b1_0 : (L_b1==2 ? m_u_b1_2 : 0); -} -/*GDouble b1piAngAmp::v(int epsilon_R) const -{ -assert( abs(epsilon_R)==1 ); -return epsilon_R==-1 ? m_v_m : (epsilon_R==+1 ? m_v_p); -}*/ - - - -complex< GDouble > -b1piAngAmp::calcAmplitude( GDouble** pKin ) const -{ - int m_X,IMLnum=0; - bool useCutoff=true; - complex i(0, 1), COne(1, 0),CZero(0,0); - - const vector< int >& perm = getCurrentPermutation(); - int Iz_b1 = mIz[perm[2]]; - int Iz_pi = mIz[perm[3]]; - - if(abs(Iz_b1+Iz_pi) > mI_X) return CZero; - - TLorentzVector beam (pKin[0][1], pKin[0][2], pKin[0][3], pKin[0][0]); - TLorentzVector recoil(pKin[1][1], pKin[1][2], pKin[1][3], pKin[1][0]); - GDouble InvSqrt2=1/sqrt(2.0); - GDouble m0_rho=0.775,G0_rho=0.149; - GDouble m0_omega=0.783, m0_b1=1.223; - - - //Exprected particle list: - // pi- b1(pi+ omega(pi0 "rho"(pi- pi+))) - // 2 3 4 5 6 - - - TLorentzVector rhos_pip(pKin[6][1], pKin[6][2], pKin[6][3], pKin[6][0]); - TLorentzVector rhos_pim(pKin[5][1], pKin[5][2], pKin[5][3], pKin[5][0]); - TLorentzVector rho = rhos_pip + rhos_pim; - - if( useCutoff && rho.M()+0.135 > m0_omega+3*mG0_omega){ - //cout << "s"; - return CZero; - } - - TLorentzVector omegas_pi(pKin[4][1], pKin[4][2], pKin[4][3], pKin[4][0]); - TLorentzVector omega = rho + omegas_pi; - - if(useCutoff && fabs(omega.M()-m0_omega) > 3*mG0_omega){ - //cout << "s"; - return CZero; - } - - TLorentzVector b1s_pi(pKin[3][1], pKin[3][2], pKin[3][3], pKin[3][0]); - TLorentzVector b1 = omega + b1s_pi; - - if( useCutoff && (fabs(b1.M()-m0_b1) > 3*mG0_b1 || - b1.M() < (m0_omega - 3*mG0_omega)) ){ - //cout << "s"; - return CZero; - } - - //printf("DEBUG: proceeding with b1pi amp calc. mG0_omega=%f, disbale BWomega=%d\n",mG0_omega,m_disableBW_omega); - - TLorentzVector Xs_pi(pKin[2][1], pKin[2][2], pKin[2][3], pKin[2][0]); - TLorentzVector X = b1 + Xs_pi; - - GDouble q = breakupMomentum( X.M(), b1.M(), Xs_pi.M() ); - - - // orientation of production plane in lab - GDouble alpha = recoil.Vect().Phi(); - - //Resonance RF, Godfried-Jackson frame - TLorentzRotation XRFboost( -X.BoostVector() ); - - TLorentzVector beam_XRF = XRFboost * beam; - TLorentzVector recoil_XRF = XRFboost * recoil; - - //Define coordinate system - TVector3 zGJ = beam_XRF.Vect().Unit(); - TVector3 yGJ = zGJ.Cross(recoil_XRF.Vect()).Unit(); - TVector3 xGJ = yGJ.Cross(zGJ); - - - TLorentzVector b1_XRF = XRFboost * b1; - TLorentzVector omega_XRF = XRFboost * omega; - TLorentzVector rho_XRF = XRFboost * rho; - TLorentzVector rhos_pip_XRF= XRFboost * rhos_pip; - - TLorentzVector omega_b1RF(MoveToRF(b1_XRF, omega_XRF)); - TLorentzVector rho_omegaRF(MoveToRF(omega_b1RF, - MoveToRF(b1_XRF, rho_XRF))); - TLorentzVector rhos_pip_rhoRF(MoveToRF(rho_omegaRF, - MoveToRF(omega_b1RF, - MoveToRF(b1_XRF,rhos_pip_XRF)))); - - TVector3 ang_b1( (b1_XRF.Vect()).Dot(xGJ), - (b1_XRF.Vect()).Dot(yGJ), - (b1_XRF.Vect()).Dot(zGJ) ); - - //printf("%f %f %f %f \n", - // omega.M(), (rho+omegas_pi).M(), - // rho.M(), (rhos_pip+rhos_pim).M()); - - - // SUMMATION GUIDE: - // notation meant to resemble TeX symbols in derivation - // exception: pol = \epsilon_\gamma - // l -> lambda, indicating helicity - // u_[particle](q.n.) -> amplitude strength coefficient - - int pol=(mpolBeam==1 ? +1 : -1); // y and x-pol. respectively - const int* epsilon_R=&mepsilon_R; - GDouble rho_omegaRF_cosTheta=rho_omegaRF.CosTheta(); - GDouble rho_omegaRF_phi =rho_omegaRF.Phi(); - GDouble rhos_pip_rhoRF_cosTheta=rhos_pip_rhoRF.CosTheta(); - GDouble rhos_pip_rhoRF_phi =rhos_pip_rhoRF.Phi(); - - - - // Prepare sets of quantum numbers over which to sum ---------- - - // Full L_omega=1, J_rho=1 and L_omega=3, J_rho=3 - /*int aList_J_rho[]={1,3}; - vector List_J_rho(aList_J_rho, aList_J_rho+2); - int aList_L_omega[]={1,3}; - vector List_L_omega(aList_L_omega, aList_L_omega+2); - */ - - //Restricted L_omega=1, J_rho=1 combination only - int aList_J_rho[]={1}; - vector List_J_rho(aList_J_rho, aList_J_rho+1); - int aList_L_omega[]={1}; - vector List_L_omega(aList_L_omega, aList_L_omega+1); - - int aList_l_rho[]={-1,1}; //'0' term vanishes for L_omega=J_rho=1 - // because CB(1,1,0,0;1,0)=0 ...change if introducing omega F-wave - vector List_l_rho(aList_l_rho, aList_l_rho+2); - - int aList_l_omega[]={-1,0,1}; - vector List_l_omega(aList_l_omega, aList_l_omega+3); - - int aList_L_b1[]={0,2}; - vector List_L_b1(aList_L_b1,aList_L_b1+2); - - //shortcut: CB(L_X, J_b1, 0, l_b1 ; J_X, l_b1) vanishes when - // = CB(1, 1, 0, 0 ; 1, 0), so omit l_b1=0 when J_X=L_X=1 - int aList_l_b1[3]={-1}; - if(mL_X==1 && mJ_X==1) aList_l_b1[1]=1; - else{ - aList_l_b1[1]=0; - aList_l_b1[2]=1; } - vector List_l_b1(aList_l_b1,aList_l_b1+ - (mL_X==1 && mJ_X==1 ? 2 : 3)); - // -------------------- - - vector List_l_R; - for(int n=0; n <= mJ_X+1 ; n++) { - List_l_R.push_back(n); - //printf("List_l_R.push_back(%d)\n",n); - } - - //int aList_epsilon_R[]={-1,1}; - //vector List_epsilon_R(aList_epsilon_R,aList_epsilon_R+2); - - // End of q.n. set prep ---------------------------------------- - - - complex ThelSum(0,0); - - if(mJ_X==0) if(mPar_X*pol*(*epsilon_R) == -1 ) return CZero; - - complex expFact(cos(alpha), sin(alpha)); - complex expFact_conj(conj(expFact)); - //summing positive and negative helicity terms - for(int l_gamma=-1; l_gamma <= +1 ; l_gamma+=2){ - - //for(vector::iterator epsilon_R=List_epsilon_R.begin(); - //epsilon_R != List_epsilon_R.end() ; epsilon_R++){ - - for(vector::iterator l_R=List_l_R.begin(); - l_R != List_l_R.end() ; l_R++){ - if(*l_R==0 && *epsilon_R==-1) continue; - - //summing positive and negative helicity terms of R's reflectivity state - for(int l_Rsign = +1; l_Rsign >= (*l_R>0 ? -1:+1) ; l_Rsign-=2){ - m_X=l_gamma - l_Rsign * (*l_R); - if(m_X==0){ - //testing for cancelation in |J 0>+pol*P*epsilon_R*(-1)^J|J 0> - if(mPar_X*pol*(*epsilon_R) == (mJ_X % 2 ==0 ? -1:+1)) continue; - }else - //enforcing that the selected projection <= vector magnitude - if( abs(m_X)>mJ_X) continue; - - - complex l_b1DepTerm(0,0); - for(vector::iterator l_b1=List_l_b1.begin(); - l_b1 != List_l_b1.end() ; l_b1++){ - - complex L_b1DepTerm(0,0); - for(vector::iterator L_b1=List_L_b1.begin(); - L_b1 != List_L_b1.end() ; L_b1++){ - - complex l_omegaDepTerm(0,0); - for(vector::iterator l_omega=List_l_omega.begin(); - l_omega != List_l_omega.end() ; l_omega++){ - - complex L_omegaDepTerm(0,0); - //only odd L_omega allowed to given off J_rho to honor P_omega=-1 - for(vector::iterator L_omega=List_L_omega.begin(); - L_omega != List_L_omega.end() ; L_omega++){ - - complex J_rhoDepTerm(0,0); - for(vector::iterator J_rho=List_J_rho.begin(); - J_rho != List_J_rho.end() ; J_rho++){ - - //enforces triang. ineq. betw. J_omega=1, J_rho and L_omega - if( abs(*J_rho-*L_omega) > 1) continue; - - complex l_rhoDepTerm(0,0); - for(vector::iterator l_rho = List_l_rho.begin(); - l_rho != List_l_rho.end() ; l_rho++){ - //shortcut CB(1,1,0,0;1,0)=0 - if(*L_omega==1 && *J_rho==1 && *l_rho==0) continue; - l_rhoDepTerm+= conj(wignerD(1, *l_omega, *l_rho, - rho_omegaRF_cosTheta, - rho_omegaRF_phi))* - CB(*L_omega, *J_rho, 0, *l_rho, 1, *l_rho) * - Y(*J_rho, *l_rho, rhos_pip_rhoRF_cosTheta, rhos_pip_rhoRF_phi); - - IMLnum++; - } - - J_rhoDepTerm += u_rho(*J_rho) * l_rhoDepTerm * - BreitWigner(m0_rho,G0_rho, *J_rho,rhos_pip,rhos_pim); - } - - if(!m_disableBW_omega) J_rhoDepTerm*= - BreitWigner(m0_omega,mG0_omega, *L_omega, omegas_pi,rho); - - L_omegaDepTerm += u_omega(*L_omega)*J_rhoDepTerm*N(*L_omega); - } - - l_omegaDepTerm += - L_omegaDepTerm * - conj(wignerD(1, *l_b1, *l_omega, omega_b1RF.CosTheta(), - omega_b1RF.Phi())) * - CB(*L_b1, 1, 0, *l_omega, 1, *l_omega); - } - - if(!m_disableBW_b1) l_omegaDepTerm*= - BreitWigner(m0_b1, mG0_b1, *L_b1, b1s_pi, omega); - - L_b1DepTerm += u_b1(*L_b1)*l_omegaDepTerm * N(*L_b1); - } - - l_b1DepTerm += - L_b1DepTerm * CB(mL_X, 1, 0, *l_b1, mJ_X, *l_b1)* - conj(wignerD(mJ_X, m_X, *l_b1, ang_b1.CosTheta(), ang_b1.Phi())); - - - } - - ThelSum += - //Assemble reflectivity eigenvector with epsilon_X=pol*epslion_R - l_b1DepTerm*(GDouble) - (m_X<0 ? mPar_X*pol*(*epsilon_R)*((mJ_X-m_X) % 2 == 0 ? +1:-1) : 1) * - (GDouble)(m_X == 0 ? 1.0 : InvSqrt2 ) * - //to account for |eps_g> ~ (|1,-1>exp(-ia)-pol|1,+1>exp(ia)) - (l_gamma==1 ? (GDouble)(-pol)*expFact : expFact_conj)* - // to apply th(l_R) reflectivity state prefactor: - // m=0: 1/2 m>0: 1/sqrt(2) m<0: 0 (last just skipped in this sum) - (GDouble)(*l_R > 0 ? InvSqrt2 : 1.0 ) * - //apply coefficients to the reflectivity basis terms: - (GDouble)(l_Rsign==1 ? 1 : *epsilon_R); //v(*epsilon_R) * - - } - } - //} - } - - - /*printf("DEBUG: perm2=%d -> Iz_b1=%d\tperm3=%d -> Iz_pi=%d\t==>\t%f\t%d %d %d %d %d\n", - perm[2],Iz_b1,perm[3],Iz_pi, CB(1, 1, Iz_b1, Iz_pi, mI_X, Iz_b1 + Iz_pi), - mIz[2],mIz[3],mIz[4],mIz[5],mIz[6]); - */ - - ThelSum *= N(mL_X) * (GDouble)(mL_X==0 ? 1.0 : (mL_X==1 ? q : pow(q,mL_X))) * - // to apply polarization fraction weights: - (GDouble)sqrt((1.0-pol*mpolFrac)*0.5) * //(1+g) for x-pol, (1-g) for y-pol - (pol==1 ? i : COne)*InvSqrt2 * //to account for |eps_g> ~ sqrt(-eps/2) - CB(1, 1, Iz_b1, Iz_pi, mI_X, Iz_b1 + Iz_pi); - - - if(m_ORTHOCHECK) { - double I=abs(ThelSum); - printf("ORTHOCHECK %3.1f %3.1f %3.1f %3.1f %3.1f %3.1f\t%17.10e ", - m_u_rho_1, m_u_rho_3, - m_u_omega_1, m_u_omega_3, m_u_b1_0, m_u_b1_2, I*I); - printf("%d %e %d %d %d %d %d\n",mpolBeam,(double)mpolFrac, - mJ_X,mPar_X,mL_X,mI_X,mepsilon_R); - - } - - return ThelSum; - -} - -#ifdef GPU_ACCELERATION - -void b1piAngAmp:: -launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const { - - const vector< int >& perm = getCurrentPermutation(); - int Iz_b1 = mIz[perm[2]]; - int Iz_pi = mIz[perm[3]]; - - GPUb1piAngAmp_exec(dimGrid, dimBlock, GPU_AMP_ARGS, mpolBeam, mpolFrac, - mJ_X, mPar_X, mL_X, mI_X, mepsilon_R, Iz_b1, Iz_pi, - m_u_rho_1, m_u_rho_3, m_u_omega_1, m_u_omega_3, - m_u_b1_0, m_u_b1_2, mG0_omega, mG0_b1, - /*m_ORTHOCHECK*/ false); - -} - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.h b/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.h deleted file mode 100644 index c330258407..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/b1piAngAmp.h +++ /dev/null @@ -1,85 +0,0 @@ -#if !defined(B1PIANGAMP) -#define B1PIANGAMP - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "IUAmpTools/UserAmplitude.h" - -#include -#include -#include - -#include "TLorentzVector.h" - -#include "GPUManager/GPUCustomTypes.h" - -using std::complex; -using namespace std; - - -#ifdef GPU_ACCELERATION -void -GPUb1piAngAmp_exec(dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int polBeam, GDouble polFrac, - int J_X, int Par_X, int L_X, int I_X, int epsilon_R, - int Iz_b1, int Iz_pi, - GDouble u_rho_1, GDouble u_rho_3, - GDouble u_omega_1, GDouble u_omega_3, - GDouble u_b1_0, GDouble u_b1_2, - GDouble G0_omega, GDouble G0_b1, bool orthocheck); -#endif - - - -class Kinematics; - -class b1piAngAmp : public UserAmplitude< b1piAngAmp > -{ - -public: - - b1piAngAmp() : UserAmplitude< b1piAngAmp >() { } - b1piAngAmp( const vector< string >& args ); - - string name() const { return "b1piAngAmp"; } - - complex< GDouble > calcAmplitude( GDouble** pKin ) const; - - GDouble u_rho(int J_rho) const; - GDouble u_omega(int L_omega) const; - GDouble u_b1(int L_b1) const; - - inline complex BreitWigner(GDouble m0, GDouble Gamma0, int L, - TLorentzVector &P1,TLorentzVector &P2) const; - inline GDouble CB(int j1, int j2, int m1, int m2, int J, int M) const; - - inline GDouble N(int J) const; - -private: - - int mpolBeam; - // GDouble mpolFrac; - AmpParameter mpolFrac; - int mJ_X, mPar_X, mL_X, mI_X, mepsilon_R; - - GDouble m_u_rho_1, m_u_rho_3; - GDouble m_u_omega_1, m_u_omega_3; - GDouble m_u_b1_0, m_u_b1_2, mG0_omega, mG0_b1; -// GDouble m_v_p, m_v_m; - bool m_ORTHOCHECK, m_fastCalc; - bool m_disableBW_omega, m_disableBW_b1; - - vector< int > mIz; - -#ifdef GPU_ACCELERATION - - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const; - - bool isGPUEnabled() const { return true; } - -#endif // GPU_ACCELERATION - - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/barrierFactor.cc b/src/libraries/AMPTOOLS_AMPS/barrierFactor.cc deleted file mode 100644 index f6ef3ce24d..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/barrierFactor.cc +++ /dev/null @@ -1,66 +0,0 @@ -#include -#include "AMPTOOLS_AMPS/breakupMomentum.h" -#include "AMPTOOLS_AMPS/barrierFactor.h" - - -// mass0 = mass of parent -// spin = angular momentum of the decay -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -double barrierFactor( double mass0, int spin, double mass1, double mass2 ){ - - double q; - - q = breakupMomentum(mass0, mass1, mass2); - - return barrierFactor( q, spin ); - -} - - -// q = breakup momentum -// spin = angular momentum of the decay - -double barrierFactor ( double q, int spin ){ - - double barrier; - double z; - - z = ( (q*q) / (0.1973*0.1973) ); - - switch (spin){ - - case 0: - barrier = 1.0; - break; - - case 1: - barrier = sqrt( (2.0*z) / - (z + 1.0) ); - break; - - case 2: - barrier = sqrt( (13.0*z*z) / - ((z-3.0)*(z-3.0) + 9.0*z) ); - break; - - case 3: - barrier = sqrt( (277.0*z*z*z) / - (z*(z-15.0)*(z-15.0) + - 9.0*(2.0*z-5.0)*(2.0*z-5.0)) ); - break; - - case 4: - barrier = sqrt( (12746.0*z*z*z*z) / - ((z*z-45.0*z+105.0)*(z*z-45.0*z+105.0) + - 25.0*z*(2.0*z-21.0)*(2.0*z-21.0)) ); - break; - - default: - barrier = 0.0; - } - - return barrier; - -} diff --git a/src/libraries/AMPTOOLS_AMPS/barrierFactor.cuh b/src/libraries/AMPTOOLS_AMPS/barrierFactor.cuh deleted file mode 100644 index 453f0630dd..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/barrierFactor.cuh +++ /dev/null @@ -1,69 +0,0 @@ -#ifndef CUDA_BARRIERFACTOR -#define CUDA_BARRIERFACTOR - -#include "GPUManager/GPUCustomTypes.h" -#include "AMPTOOLS_AMPS/breakupMomentum.cuh" - -// q = breakup momentum -// spin = angular momentum of the decay - -static __device__ GDouble -barrierFactor ( GDouble q, int spin ){ - - GDouble barrier; - GDouble z; - - z = ( (q*q) / (0.1973*0.1973) ); - - switch (spin){ - - case 0: - barrier = 1.0; - break; - - case 1: - barrier = G_SQRT( (2.0*z) / - (z + 1.0) ); - break; - - case 2: - barrier = G_SQRT( (13.0*z*z) / - ((z-3.0)*(z-3.0) + 9.0*z) ); - break; - - case 3: - barrier = G_SQRT( (277.0*z*z*z) / - (z*(z-15.0)*(z-15.0) + - 9.0*(2.0*z-5.0)*(2.0*z-5.0)) ); - break; - - case 4: - barrier = G_SQRT( (12746.0*z*z*z*z) / - ((z*z-45.0*z+105.0)*(z*z-45.0*z+105.0) + - 25.0*z*(2.0*z-21.0)*(2.0*z-21.0)) ); - break; - - default: - barrier = 0.0; - } - - return barrier; - -} - -// mass0 = mass of parent -// spin = angular momentum of the decay -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -static __device__ GDouble -barrierFactor( GDouble mass0, int spin, GDouble mass1, GDouble mass2 ){ - - GDouble q; - - q = breakupMomentum(mass0, mass1, mass2); - - return barrierFactor( q, spin ); -} - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/barrierFactor.h b/src/libraries/AMPTOOLS_AMPS/barrierFactor.h deleted file mode 100644 index 8e4941e405..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/barrierFactor.h +++ /dev/null @@ -1,16 +0,0 @@ -#if !defined(BARRIERFACTOR) -#define BARRIERFACTOR - -// mass0 = mass of parent -// spin = angular momentum of the decay -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -double barrierFactor( double mass0, int spin, double mass1, double mass2 ); - -// q = breakup momentum -// spin = angular momentum of the decay - -double barrierFactor( double q, int spin ); - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cc b/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cc deleted file mode 100644 index 8a472d5252..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cc +++ /dev/null @@ -1,22 +0,0 @@ -#include -#include "breakupMomentum.h" - -// mass0 = mass of parent -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -double breakupMomentum( double mass0, double mass1, double mass2 ){ - - double q; - - // fabs -- correct? consistent w/ previous E852 code - q = sqrt( fabs( mass0*mass0*mass0*mass0 + - mass1*mass1*mass1*mass1 + - mass2*mass2*mass2*mass2 - - 2.0*mass0*mass0*mass1*mass1 - - 2.0*mass0*mass0*mass2*mass2 - - 2.0*mass1*mass1*mass2*mass2 ) ) / (2.0 * mass0); - - return q; - -} diff --git a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cuh b/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cuh deleted file mode 100644 index 5f8b313beb..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.cuh +++ /dev/null @@ -1,23 +0,0 @@ -#ifndef CUDA_BREAKUPMOMENTUM -#define CUDA_BREAKUPMOMENTUM - -#include "GPUManager/GPUCustomTypes.h" - -// mass0 = mass of parent -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -static __device__ GDouble -breakupMomentum( GDouble mass0, GDouble mass1, GDouble mass2 ){ - - // fabs -- correct? consistent w/ previous E852 code - return G_SQRT( G_FABS( mass0*mass0*mass0*mass0 + - mass1*mass1*mass1*mass1 + - mass2*mass2*mass2*mass2 - - 2.0*mass0*mass0*mass1*mass1 - - 2.0*mass0*mass0*mass2*mass2 - - 2.0*mass1*mass1*mass2*mass2 ) ) / (2.0 * mass0); - -} - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.h b/src/libraries/AMPTOOLS_AMPS/breakupMomentum.h deleted file mode 100644 index 4e1294449e..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/breakupMomentum.h +++ /dev/null @@ -1,10 +0,0 @@ -#if !defined(BREAKUPMOMENTUM) -#define BREAKUPMOMENTUM - -// mass0 = mass of parent -// mass1 = mass of first daughter -// mass2 = mass of second daughter - -double breakupMomentum( double mass0, double mass1, double mass2 ); - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/clebschGordan.cc b/src/libraries/AMPTOOLS_AMPS/clebschGordan.cc deleted file mode 100644 index 4b81e9c154..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/clebschGordan.cc +++ /dev/null @@ -1,193 +0,0 @@ - -#include "AMPTOOLS_AMPS/clebschGordan.h" - -#include - -/* Name: s3j -** Evaluates 3j symbol -** -** Author: Riccardo Gusmeroli (web.address@libero.it) -** -** Notes: -** - defining S3J_TEST enables the compilation of a very small test suite. -** - the maximum allowed factorial is S3J_MAX_FACT (currently 25!). -** -** -** This program is free software; you can redistribute it and/or -** modify it under the terms of the GNU General Public License -** as published by the Free Software Foundation; either version 2 -** of the License, or (at your option) any later version. -** This program is distributed in the hope that it will be useful, -** but WITHOUT ANY WARRANTY; without even the implied warranty of -** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -** GNU General Public License for more details. -** You should have received a copy of the GNU General Public License -** along with this program; if not, write to the Free Software -** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ - - -#define S3J_0 1e-10 - -#define S3J_MAX_FACT 25 -#define S3J_TEST - -#define S3J_EQUAL(a,b) (fabs((a)-(b))(b)?(ris=(a)):(ris=(b)))>(c)?ris:(ris=(c))) -#define S3J_MIN(a,b,c,ris) (((a)<(b)?(ris=(a)):(ris=(b)))<(c)?ris:(ris=(c))) - - -double s3j(double j1, double j2, double j3, - double m1, double m2, double m3) { - - /* ( j1 j2 j3 ) - ( ) = delta(m1+m2+m3,0) * (-1)^(j1-j2-m3) * - ( m1 m2 m3 ) - - +- - | (j1+j2-j3)! (j1-j2+j3)! (-j1+j2+j3)! - * | -------------------------------------- ... - | - +- - -+ 1/2 - (j1-m1)! (j1+m1)! (j2-m2)! (j2+m2)! (j3-m3)! (j3+m3)! | - ... ------------------------------------------------------- | * - (j1+j2+j3+1)! | - -+ - - +--- - \ (-1)^k - * | --------------------------------------------------------------------- - / k! (j1+j2-j3-k)! (j1-m1-k)! (j2+m2-k)! (j3-j2+m1+k)! (j3-j1-m2+k)! - +--- - k - - Where factorials must have non-negative integral values: - - j1+j2-j3 >= 0 j1-j2+j3 >= 0 -j1+j2+j3 >= 0 j1+j2+j3+1 >= 0 - k >= 0 j1+j2-j3-k >= 0 j1-m1-k >= 0 j2+m2-k >= 0 - j3-j2+m1+k >= 0 j3-j1-m2+k >= 0 - - The 3j symbol is therefore non-null if - - j1+j2 >= j3 (1) - j1+j3 >= j2 (2) - j2+j3 >= j1 (3) - - and k values in the sum must be such that - - k <= j1+j2-j3 (4) k >= 0 (7) - k <= j1-m1 (5) k >= -j3+j2-m1 (8) - k <= j2+m2 (6) k >= -j3+j1+m2 (9) - - If no values of k satisfy the (4) to (9), the result is null because the sum is null, - otherwise one can find kmin < kmax such that - - kmin <= k <= kmax - - (4) to (6) => kmin=MAX(j1+j2-j3, j1-m1, j2+m2 ) - (7) to (9) => kmax=MIN(0, -j3+j2-m1, -j3+j1+m2 ) - - The condition kmin < kmax includes (1) to (3) because - - (4) and (7) => (1) - (5) and (8) => (2) - (6) and (9) => (3) - - Once the values of kmin and kmax are found, the only "selection rule" is kminkmax) return 0.0; - - ris=0.0; - if (kmin%2==0) mult=1.0; - else mult=-1.0; - for (k=kmin; k<=kmax; ++k) { - - ris+=mult/(f[k]*f[j1pj2mj3-k]*f[jmm1-k]*f[jpm2-k]*f[j3mj2pm1+k]*f[j3mj1mm2+k]); - - mult=-mult; - } - - /* (-1)^(j1-j2-m3)=(-1)^(j1-j2-m3+m1+m2+m3)=(-1)^(jpm1-jmm2) */ - if ((jpm1-jmm2)%2!=0) ris=-ris; - - ris*=sqrt(f[j1pj2mj3]*f[jpm1-jmm2+jpm3]*f[-jmm1+jpm2+jpm3]* - f[jpm1]*f[jpm2]*f[jpm3]*f[jmm1]*f[jmm2]*f[jmm3]/ - f[jpm1+jpm2+jpm3+1]); - - return ris; -} - - -double clebschGordan(int ij1, int ij2, int im1, int im2, int ij, int im) { - - int esp; - double cgris; -// double fcgris; - double j1,j2,m1,m2,j,m; - - j1 = (double) ij1; - j2 = (double) ij2; - m1 = (double) im1; - m2 = (double) im2; - j = (double) ij; - m = (double) im; - - esp=(int)(j1-j2+m); - if (!S3J_EQUAL(esp,j1-j2+m)) return 0; - - if (esp%2==0) cgris=1.0; - else cgris=-1.0; - - cgris*=sqrt(2*j+1)*s3j(j1,j2,j,m1,m2,-m); - - return cgris; -} - - diff --git a/src/libraries/AMPTOOLS_AMPS/clebschGordan.h b/src/libraries/AMPTOOLS_AMPS/clebschGordan.h deleted file mode 100644 index 2c195c89aa..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/clebschGordan.h +++ /dev/null @@ -1,9 +0,0 @@ -#if !defined(CLEBSCHGORDAN) -#define CLEBSCHGORDAN - -double clebschGordan(int j1, int j2, int m1, int m2, int j, int m); - -double s3j(double j1, double j2, double j3, - double m1, double m2, double m3); - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/fit_2pi_primakoff.cfg b/src/libraries/AMPTOOLS_AMPS/fit_2pi_primakoff.cfg deleted file mode 100644 index a4c2fb6d21..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/fit_2pi_primakoff.cfg +++ /dev/null @@ -1,88 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -fit twopi_primakoff - -reaction Primakoff gamma Pi+ Pi- p - -normintfile Primakoff twopi_primakoff_ni.txt - -# sum contains two terms for s-wave production of pi+pi- -sum Primakoff Aplus -sum Primakoff Aminus - -genmc Primakoff ROOTDataReader tree_gen_2pi_primakoff_flat.root -accmc Primakoff ROOTDataReader tree_gen_2pi_primakoff_flat.root -data Primakoff ROOTDataReader tree_gen_2pi_primakoff.root - -# amplitude Primakoff::swave TwoPiAngles_primakoff (phipol, pol fraction, m_rho, PhaseFactor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# pol fraction is the linear polarization of the beam -# m_rho Jz component of rho -# Phasefactor determines prefix factor to amplitudes in computation -# flat=1 generates distribution uniform in angles. flat=0 use YLMs -amplitude Primakoff::Aplus::g1Vm0 TwoPiAngles_primakoff phipol polFrac 0 0 flat -# amplitude Primakoff::Aplus::g1Vm0 BreitWigner rho 1 2 3 - -amplitude Primakoff::Aminus::g1Vm0 TwoPiAngles_primakoff phipol polFrac 0 1 flat -# amplitude Primakoff::Aminus::g1Vm0 BreitWigner rho 1 2 3 - -initialize Primakoff::Aplus::g1Vm0 cartesian 400.0 0.0 -initialize Primakoff::Aminus::g1Vm0 cartesian 400.0 0.0 - -constrain Primakoff::Aplus::g1Vm0 Primakoff::Aminus::g1Vm0 - - - - - diff --git a/src/libraries/AMPTOOLS_AMPS/gen_2pi_primakoff.cfg b/src/libraries/AMPTOOLS_AMPS/gen_2pi_primakoff.cfg deleted file mode 100644 index afd2c1a71f..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/gen_2pi_primakoff.cfg +++ /dev/null @@ -1,78 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit fit_Primakoff -reaction Primakoff gamma Pi+ Pi- p - -# sum is a single term from s-wave production of pi+pi- -sum Primakoff Aplus -sum Primakoff Aminus - - -# amplitude Primakoff::swave TwoPiAngles_primakoff (phipol, pol fraction, m_rho, PhaseFactor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# pol fraction is the linear polarization of the beam -# m_rho Jz component of rho -# Phasefactor determines prefix factor to amplitudes in computation -# flat=1 generates distribution uniform in angles. flat=0 use YLMs -amplitude Primakoff::Aplus::g1Vm0 TwoPiAngles_primakoff phipol polFrac 0 0 flat -amplitude Primakoff::Aplus::g1Vm0 BreitWigner rho 1 2 3 - -amplitude Primakoff::Aminus::g1Vm0 TwoPiAngles_primakoff phipol polFrac 0 1 flat -amplitude Primakoff::Aminus::g1Vm0 BreitWigner rho 1 2 3 - -initialize Primakoff::Aplus::g1Vm0 cartesian 500.0 0.0 real -initialize Primakoff::Aminus::g1Vm0 cartesian 500.0 0.0 - - - diff --git a/src/libraries/AMPTOOLS_AMPS/polCoef.cc b/src/libraries/AMPTOOLS_AMPS/polCoef.cc deleted file mode 100644 index 5abbc538e2..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/polCoef.cc +++ /dev/null @@ -1,30 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "AMPTOOLS_AMPS/polCoef.h" - -polCoef::polCoef( const vector< string >& args ) : - UserAmplitude< polCoef >( args ) -{ - - m_polBeam = atoi( args[0].c_str() ); - m_polFrac = AmpParameter( args[1] ); - - registerParameter( m_polFrac ); - - assert( ( m_polBeam == 0 ) || ( m_polBeam == 1 ) ); -} - - -complex< GDouble > -polCoef::calcAmplitude( GDouble** pKin ) const -{ - int pol=(m_polBeam==1 ? +1 : -1); // y and x-pol. respectively - - //(1+g) for x-pol, (1-g) for y-pol - return complex((GDouble)sqrt((1.0-pol*m_polFrac)*0.5), 0); -} diff --git a/src/libraries/AMPTOOLS_AMPS/polCoef.h b/src/libraries/AMPTOOLS_AMPS/polCoef.h deleted file mode 100644 index 3076d82df5..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/polCoef.h +++ /dev/null @@ -1,54 +0,0 @@ -#if !defined(POLCOEF) -#define POLCOEF - -#include "IUAmpTools/UserAmplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - - -using std::complex; -using namespace std; - -class Kinematics; - - -#ifdef GPU_ACCELERATION -void GPUpolCoef_exec(dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO, - int polBeam, GDouble polFrac); - -#endif - - -class polCoef : public UserAmplitude< polCoef > -{ - -public: - - polCoef() : UserAmplitude< polCoef >() { } - polCoef( const vector< string >& args ); - ~polCoef(){} - - string name() const { return "polCoef"; } - - complex< GDouble > calcAmplitude( GDouble** pKin=NULL) const; - -private: - int m_polBeam; - AmpParameter m_polFrac; - -#ifdef GPU_ACCELERATION - void launchGPUKernel( dim3 dimGrid, dim3 dimBlock, GPU_AMP_PROTO ) const{ - GPUpolCoef_exec(dimGrid, dimBlock, GPU_AMP_ARGS, m_polBeam, m_polFrac); - }; - - bool isGPUEnabled() const { return true; } -#endif - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_AMPS/wignerD.cc b/src/libraries/AMPTOOLS_AMPS/wignerD.cc deleted file mode 100644 index 43ea3ebdad..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/wignerD.cc +++ /dev/null @@ -1,119 +0,0 @@ - -#include "AMPTOOLS_AMPS/wignerD.h" -#include - -using namespace std; - -GDouble -wignerDSmall( GDouble aj, GDouble am, GDouble an, GDouble beta ){ - - // Calculates the beta-term - // d j mn (beta) - // in the matrix element of the finite rotation operator - // (Wigner's D-function), according to formula 4.3.1(3) in - // D.A. Varshalovich, A.N. Moskalev, and V.K. Khersonskii, - // Quantum Theory of Angular Momentum, World Scientific, - // Singapore 1988. - // CERNLIB DDJMNB function translated from Fortran to C++ by Rene Brun - - double f = 8.72664625997164788e-3; - - double fcl[51] = { 0 , 0 , - 6.93147180559945309e-1 ,1.79175946922805500e00, - 3.17805383034794562e00 ,4.78749174278204599e00, - 6.57925121201010100e00 ,8.52516136106541430e00, - 1.06046029027452502e01 ,1.28018274800814696e01, - 1.51044125730755153e01 ,1.75023078458738858e01, - 1.99872144956618861e01 ,2.25521638531234229e01, - 2.51912211827386815e01 ,2.78992713838408916e01, - 3.06718601060806728e01 ,3.35050734501368889e01, - 3.63954452080330536e01 ,3.93398841871994940e01, - 4.23356164607534850e01 ,4.53801388984769080e01, - 4.84711813518352239e01 ,5.16066755677643736e01, - 5.47847293981123192e01 ,5.80036052229805199e01, - 6.12617017610020020e01 ,6.45575386270063311e01, - 6.78897431371815350e01 ,7.12570389671680090e01, - 7.46582363488301644e01 ,7.80922235533153106e01, - 8.15579594561150372e01 ,8.50544670175815174e01, - 8.85808275421976788e01 ,9.21361756036870925e01, - 9.57196945421432025e01 ,9.93306124547874269e01, - 1.02968198614513813e02 ,1.06631760260643459e02, - 1.10320639714757395e02 ,1.14034211781461703e02, - 1.17771881399745072e02 ,1.21533081515438634e02, - 1.25317271149356895e02 ,1.29123933639127215e02, - 1.32952575035616310e02 ,1.36802722637326368e02, - 1.40673923648234259e02 ,1.44565743946344886e02, - 1.48477766951773032e02}; - - int jpm = int(aj+am); - int jpn = int(aj+an); - int jmm = int(aj-am); - - int jmn = int(aj-an); - int mpn = int(am+an); - - double r = 0; - if (beta == 0) - { - if (jpm == jpn) r = 1; - } - else if (beta == 180) - { - if (jpm == jmn) - { - r = 1; - if ( (jpm > 0 ? jpm : -jpm ) % 2 == 1 ) r = -1; - } - } - else if (beta == 360) - { - if (jpm == jpn) - { - r = 1; - if ( (jpm > 0 ? jpm : -jpm ) % 2 == 1 ) r = -1; - } - } - else - { - double b = f*beta; - double s = log(sin(b)); - double c = log(fabs(cos(b))); - double rt = 0.5*(fcl[jpm]+fcl[jmm]+fcl[jpn]+fcl[jmn]); - int k0 = ( 0 > mpn ? 0 : mpn ); //max( 0 , mpn ) - int kq = k0+jpm; - if (beta > 180) kq += mpn; - double q = 1; - if (kq%2 == 1) q = -1; - kq = k0+k0; - double cx = kq-mpn; - double sx = jpm+jpn-kq; - for( int k = k0 ; k <= ( jpm < jpn ? jpm : jpn ); k++ ) - { - r += q*exp(rt-fcl[k]-fcl[jpm-k]-fcl[jpn-k]-fcl[k-mpn]+ cx*c+sx*s); - cx += 2; - sx -= 2; - q = -q; - } - } - - return r; -} - - -complex< GDouble > wignerD( int l, int m, int n, - GDouble cosTheta, GDouble phi ){ - - double dtheta = acos( cosTheta ) * 180.0 / PI; - - GDouble dpart = wignerDSmall( l, m, n, dtheta ); - - return complex< GDouble >( cos( -1.0 * m * phi ) * dpart, - sin( -1.0 * m * phi ) * dpart ); - -} - -complex< GDouble > Y( int l, int m, GDouble cosTheta, GDouble phi ){ - - return ( (GDouble)sqrt( (2*l+1) / (4*PI) ) ) * - conj( wignerD( l, m, 0, cosTheta, phi ) ); -} diff --git a/src/libraries/AMPTOOLS_AMPS/wignerD.h b/src/libraries/AMPTOOLS_AMPS/wignerD.h deleted file mode 100644 index 883e27b089..0000000000 --- a/src/libraries/AMPTOOLS_AMPS/wignerD.h +++ /dev/null @@ -1,14 +0,0 @@ -#if !defined(WIGNERD) -#define WIGNERD - -#include - -#include "GPUManager/GPUCustomTypes.h" - -using std::complex; - -GDouble wignerDSmall( GDouble aj, GDouble am, GDouble an, GDouble beta ); -complex< GDouble > wignerD( int l, int m, int n, GDouble cosTheta, GDouble phi ); -complex< GDouble > Y( int l, int m, GDouble cosTheta, GDouble phi ); - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.cc b/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.cc deleted file mode 100644 index 64dca0f363..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.cc +++ /dev/null @@ -1,80 +0,0 @@ - -#include -#include - -#include "TLorentzVector.h" - -#include "ASCIIDataWriter.h" - - -ASCIIDataWriter::ASCIIDataWriter( const string& outFile ) -{ - - // Open output file - fid=fopen((char *)(outFile.c_str()),"w"); - - m_eventCounter = 0; -} - -ASCIIDataWriter::~ASCIIDataWriter() -{ - fclose(fid); -} - - -/** - * This function writes one event. It is presumed that the first - * two particles are the beam photon and the recoiling proton - * in that order. - * \param[in] kin - kinematics of the event - * \param[in] types - geant particles types corresponding to the particles specified in kin - */ - -void -ASCIIDataWriter::writeEvent( const Kinematics& kin, vector &types) -{ - vector< TLorentzVector > particleList = kin.particleList(); - - m_nPart = particleList.size() - 2; - - assert( particleList.size() <= Kinematics::kMaxParticles ); - - - // Start a new event - fprintf(fid,"9000 %d %d\n",m_eventCounter+1,m_nPart+1); - - - fprintf(fid,"1 %d %f\n",types[1],particleList[1].M()); - fprintf(fid," 1 %f %f %f %f\n", - particleList[1].Px(), particleList[1].Py(), - particleList[1].Pz(), particleList[1].E()); - - for( int i = 0; i < m_nPart; i++ ){ - - int charge=0; - switch (types[i+2]){ - case 8: //pi plus - charge=1; break; - case 9: //pi minus - charge=-1; break; - case 11: //K plus - charge=1; break; - case 12: //K minus - charge=-1; break; - default: - charge=0; - } - - - fprintf(fid,"%d %d %f\n",i+2,types[i+2],particleList[i+2].M()); - - fprintf(fid," %d %f %f %f %f\n",charge, - particleList[i+2].Px(),particleList[i+2].Py(), - particleList[i+2].Pz(),particleList[i+2].E()); - - } - - m_eventCounter++; -} - - diff --git a/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.h b/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.h deleted file mode 100644 index 1774c6919b..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ASCIIDataWriter.h +++ /dev/null @@ -1,39 +0,0 @@ -#if !defined(ASCIIDATAWRITER) -#define ASCIIDATAWRITER - -#include -#include "IUAmpTools/Kinematics.h" - -#include "particleType.h" - - -/** - * This class writes events passed in the Kinematics data type (see AmpTools) - * to disk in the genr8 ASCII format. This is a quick-and-dirty solution - * for preparing events generated by AmpTools-based event generators - * for simulation with HDGeant. This should be replaced at some - * point by an "HDDMDataWriter" - */ - -class ASCIIDataWriter -{ - -public: - - ASCIIDataWriter( const string& outFile ); - ~ASCIIDataWriter(); - - void writeEvent( const Kinematics& kin, vector &types); - - int eventCounter() const { return m_eventCounter; } - -private: - - FILE* fid; - int m_eventCounter; - - int m_nPart; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.cc b/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.cc deleted file mode 100644 index 3a3f66e44f..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.cc +++ /dev/null @@ -1,117 +0,0 @@ - -#include "TLorentzVector.h" -#include "TRandom3.h" - -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" -#include "HDDM/hddm_s.hpp" - -HDDMDataWriter::HDDMDataWriter(const string& outFile, int runNumber, int seed) -{ - m_OutputFile = new ofstream(outFile.c_str()); - m_OutputStream = new hddm_s::ostream(*m_OutputFile); - m_runNumber = runNumber; - - m_eventCounter = 0; - - // initialize root's pseudo-random generator - gRandom->SetSeed(seed); - -} - -HDDMDataWriter::~HDDMDataWriter() -{ - delete m_OutputStream; - delete m_OutputFile; -} - - -void HDDMDataWriter:: -writeEvent( const Kinematics& kin, const vector& ptype, bool centeredVertex) -{ - if (centeredVertex) - writeEvent(kin,ptype,0,0,65/*cm*/); - else - writeEvent(kin,ptype,0,0,50/*cm*/,80/*cm*/); -} - -void HDDMDataWriter:: -writeEvent( const Kinematics& kin, const vector& ptype, - float vx, float vy, float vz_min, float vz_max) -{ - if (vz_min > vz_max) { - float tmp=vz_min; - vz_min=vz_max; - vz_max=tmp; - } - writeEvent(kin, ptype,vx, vy, (vz_max - vz_min) * gRandom->Uniform() + vz_min); -} - - -void HDDMDataWriter:: -writeEvent( const Kinematics& kin, const vector& ptype, - float vx, float vy, float vz) -{ - vector< TLorentzVector > particleList = kin.particleList(); - int nParticles=kin.particleList().size(); - - // Start a new event in the HDDM record - hddm_s::HDDM record; - hddm_s::PhysicsEventList pes = record.addPhysicsEvents(); - pes().setRunNo(m_runNumber); - pes().setEventNo(m_eventCounter); - hddm_s::ReactionList rs = pes().addReactions(); - hddm_s::VertexList vs = rs().addVertices(); - hddm_s::OriginList os = vs().addOrigins(); - hddm_s::ProductList ps = vs().addProducts(nParticles-1); - hddm_s::RandomList ranl = rs().addRandoms(); - - ranl().setSeed1(gRandom->Integer(std::numeric_limits::max())); - ranl().setSeed2(gRandom->Integer(std::numeric_limits::max())); - ranl().setSeed3(gRandom->Integer(std::numeric_limits::max())); - ranl().setSeed4(gRandom->Integer(std::numeric_limits::max())); - - os().setT(0.0); - os().setVx(vx); - os().setVy(vy); - os().setVz(vz); - - hddm_s::BeamList bs = rs().addBeams(); - bs().setType((Particle_t)1); - hddm_s::MomentumList bmoms = bs().addMomenta(); - bmoms().setPx(kin.particle(0).Px()); - bmoms().setPy(kin.particle(0).Py()); - bmoms().setPz(kin.particle(0).Pz()); - bmoms().setE(kin.particle(0).E()); - hddm_s::PropertiesList bpros = bs().addPropertiesList(); - bpros().setCharge(0); - bpros().setMass(0.0); - - hddm_s::TargetList ts = rs().addTargets(); - ts().setType((Particle_t)14); - hddm_s::MomentumList tmoms = ts().addMomenta(); - tmoms().setPx(0); - tmoms().setPy(0); - tmoms().setPz(0); - tmoms().setE(0.938272); - hddm_s::PropertiesList tpros = ts().addPropertiesList(); - tpros().setCharge(+1); - tpros().setMass(0.938272); - - for(int i=1; i < nParticles; i++) - { - ps(i-1).setType((Particle_t)ptype[i]); - ps(i-1).setPdgtype(PDGtype((Particle_t)ptype[i])); - ps(i-1).setId(i); /* unique value for this particle within the event */ - ps(i-1).setParentid(0); /* All internally generated particles have no parent */ - ps(i-1).setMech(0); /* maybe this should be set to something? */ - hddm_s::MomentumList pmoms = ps(i-1).addMomenta(); - pmoms().setPx(kin.particle(i).Px()); - pmoms().setPy(kin.particle(i).Py()); - pmoms().setPz(kin.particle(i).Pz()); - pmoms().setE(kin.particle(i).E()); - } - - if (nParticles > 0) - *m_OutputStream << record; - m_eventCounter++; -} diff --git a/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.h b/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.h deleted file mode 100644 index 2e0e984ab8..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/HDDMDataWriter.h +++ /dev/null @@ -1,40 +0,0 @@ -#if !defined(HDDMDATAWRITER) -#define HDDMDATAWRITER - -#include -#include -#include -#include - -using namespace std; - -#include "IUAmpTools/Kinematics.h" -#include "HDDM/hddm_s.hpp" - -class HDDMDataWriter -{ - -public: - - HDDMDataWriter( const string& outFile, int runNumber=9000, int seed=0); - ~HDDMDataWriter(); - - void writeEvent( const Kinematics& kin, const vector& ptype, - bool centeredVertex=false); - void writeEvent( const Kinematics& kin, const vector& ptype, - float vx, float vy, float vz_min, float vz_max); - void writeEvent( const Kinematics& kin, const vector& ptype, - float vx, float vy, float vz); - - int eventCounter() const { return m_eventCounter; } - bool FileOpen() { return m_OutputStream; } - -private: - - std::ofstream *m_OutputFile; // output hddm file ofstream - hddm_s::ostream *m_OutputStream; // provides hddm layer on top of ofstream - int m_eventCounter, m_runNumber; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.cc b/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.cc deleted file mode 100644 index 9ea381a4f3..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.cc +++ /dev/null @@ -1,81 +0,0 @@ -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h" -#include "IUAmpTools/Histogram1D.h" -#include "IUAmpTools/Kinematics.h" - -OmegaRadiativePlotGenerator::OmegaRadiativePlotGenerator( const FitResults& results ) : -PlotGenerator( results ) -{ - // calls to bookHistogram go here - - bookHistogram( kOmegaMass, new Histogram1D( 200, 0.2, 0.8, "MOmega", "Invariant Mass of #pi^{0} #gamma") ); - bookHistogram( kCosThetaPi0, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of #pi^{0}") ); - bookHistogram( kCosThetaGamma, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of #Gamma") ); - bookHistogram( kPhiPi0, new Histogram1D( 50, -1*PI, PI, "PhiPiPlus", "#Phi_{#pi_{0}}" ) ); - bookHistogram( kPhiGamma, new Histogram1D( 50, -1*PI, PI, "PhiPiMinus", "#Phi_{#gamma}" ) ); - bookHistogram( kCosTheta, new Histogram1D( 50, -1., 1., "CosTheta", "cos#theta;cos#theta" ) ); - bookHistogram( kPhi, new Histogram1D( 50, -1*PI, PI, "Phi", "#Phi; #Phi[rad.]" ) ); - bookHistogram( kphi, new Histogram1D( 50, -1*PI, PI, "phi", "#phi; #phi[rad.]" ) ); - bookHistogram( kPsi, new Histogram1D( 50, -1*PI, PI, "psi", "#psi; #psi [rad.]" ) ); - bookHistogram( kt, new Histogram1D( 100, 0, 1.0 , "t", "-t" ) ); -} - -void -OmegaRadiativePlotGenerator::projectEvent( Kinematics* kin ){ - - TLorentzVector beam = kin->particle( 0 ); - TLorentzVector recoil = kin->particle( 1 ); - TLorentzVector p1 = kin->particle( 2 ); - TLorentzVector p2 = kin->particle( 3 ); - - TLorentzVector resonance = p1 + p2; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - TLorentzVector p2_res = resonanceBoost * p2; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - - //double polAngle = 0.0539258; // PARA Spring 2016 - double polAngle = 1.62927; // PERP Spring 2016 - //TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - TVector3 eps(cos(polAngle), sin(polAngle), 0.0); // beam polarization vector - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - // compute invariant t - GDouble t = - 2* recoil.M() * (recoil.E()-recoil.M()); - - // calls to fillHistogram go here - - fillHistogram( kOmegaMass, ( resonance ).M() ); - fillHistogram( kCosThetaPi0, p1_res.CosTheta()); - fillHistogram( kCosThetaGamma, p2_res.CosTheta() ); - fillHistogram( kPhiPi0, p1.Phi() ); - fillHistogram( kPhiGamma, p2.Phi() ); - fillHistogram( kCosTheta, cosTheta); - fillHistogram( kPhi, Phi ); - fillHistogram( kphi, phi ); - fillHistogram( kPsi, psi ); - fillHistogram( kt, -t ); // fill with -t to make positive -} diff --git a/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h b/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h deleted file mode 100644 index a6f8319e0b..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h +++ /dev/null @@ -1,31 +0,0 @@ -#if !(defined TWOPIPLOTGENERATOR) -#define TWOPIPLOTGENERATOR - -#include -#include - -#include "IUAmpTools/PlotGenerator.h" - -using namespace std; - -class FitResults; -class Kinematics; - -class OmegaRadiativePlotGenerator : public PlotGenerator -{ - -public: - - // create an index for different histograms - //enum { kOmegaMass = 0, kPi0CosTheta, kPi0Phi, kGammaCosTheta, kGammaPhi, kPhi, kphi, kPsi, kt, kNumHists}; - enum { kOmegaMass = 0, kCosThetaPi0, kCosThetaGamma, kPhiPi0, kPhiGamma, kCosTheta, kPhi, kphi, kPsi, kt, kNumHists}; - - OmegaRadiativePlotGenerator( const FitResults& results ); - -private: - - void projectEvent( Kinematics* kin ); - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.cc b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.cc deleted file mode 100644 index ce924c0304..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.cc +++ /dev/null @@ -1,109 +0,0 @@ - -#include -#include -#include - -#include "TLorentzVector.h" - -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "IUAmpTools/Kinematics.h" - -#include "TH1.h" -#include "TFile.h" -#include "TTree.h" - -using namespace std; - -ROOTDataReader::ROOTDataReader( const vector< string >& args ): - UserDataReader< ROOTDataReader >( args ), - m_eventCounter( 0 ), - m_useWeight( false ) -{ - assert( args.size() == 2 || args.size() == 1 ); - - TH1::AddDirectory( kFALSE ); - - //this way of opening files works with URLs of the form - // root://xrootdserver/path/to/myfile.root - m_inFile = TFile::Open( args[0].c_str() ); - - - // default to tree name of "kin" if none is provided - if( args.size() == 1 ){ - - m_inTree = dynamic_cast( m_inFile->Get( "kin" ) ); - } - else{ - - m_inTree = dynamic_cast( m_inFile->Get( args[1].c_str() ) ); - } - - m_inTree->SetBranchAddress( "NumFinalState", &m_nPart ); - m_inTree->SetBranchAddress( "E_FinalState", m_e ); - m_inTree->SetBranchAddress( "Px_FinalState", m_px ); - m_inTree->SetBranchAddress( "Py_FinalState", m_py ); - m_inTree->SetBranchAddress( "Pz_FinalState", m_pz ); - m_inTree->SetBranchAddress( "E_Beam", &m_eBeam ); - m_inTree->SetBranchAddress( "Px_Beam", &m_pxBeam ); - m_inTree->SetBranchAddress( "Py_Beam", &m_pyBeam ); - m_inTree->SetBranchAddress( "Pz_Beam", &m_pzBeam ); - - if(m_inTree->GetBranch("Weight") != NULL) { - - m_useWeight = true; - m_inTree->SetBranchAddress( "Weight", &m_weight ); - } - else{ - - m_useWeight = false; - } -} - -ROOTDataReader::~ROOTDataReader() -{ - if( m_inFile != NULL ) m_inFile->Close(); -} - -void -ROOTDataReader::resetSource() -{ - - cout << "Resetting source " << m_inTree->GetName() - << " in " << m_inFile->GetName() << endl; - - // this will cause the read to start back at event 0 - m_eventCounter = 0; -} - -Kinematics* -ROOTDataReader::getEvent() -{ - if( m_eventCounter < static_cast< unsigned int >( m_inTree->GetEntries() ) ){ - // if( m_eventCounter < 10 ){ - - m_inTree->GetEntry( m_eventCounter++ ); - assert( m_nPart < Kinematics::kMaxParticles ); - - vector< TLorentzVector > particleList; - - particleList. - push_back( TLorentzVector( m_pxBeam, m_pyBeam, m_pzBeam, m_eBeam ) ); - - for( int i = 0; i < m_nPart; ++i ){ - - particleList.push_back( TLorentzVector( m_px[i], m_py[i], m_pz[i], m_e[i] ) ); - } - - return new Kinematics( particleList, m_useWeight ? m_weight : 1.0 ); - } - else{ - - return NULL; - } -} - -unsigned int -ROOTDataReader::numEvents() const -{ - return static_cast< unsigned int >( m_inTree->GetEntries() ); -} diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.h b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.h deleted file mode 100644 index 361dc339fd..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReader.h +++ /dev/null @@ -1,65 +0,0 @@ -#if !defined(ROOTDATAREADER) -#define ROOTDATAREADER - -#include "IUAmpTools/Kinematics.h" -#include "IUAmpTools/UserDataReader.h" - -#include "TString.h" -#include "TFile.h" -#include "TTree.h" - -#include - -using namespace std; - -class ROOTDataReader : public UserDataReader< ROOTDataReader > -{ - -public: - - /** - * Default constructor for ROOTDataReader - */ - ROOTDataReader() : UserDataReader< ROOTDataReader >(), m_inFile( NULL ) { } - - ~ROOTDataReader(); - - /** - * Constructor for ROOTDataReader - * \param[in] args vector of string arguments - */ - ROOTDataReader( const vector< string >& args ); - - string name() const { return "ROOTDataReader"; } - - virtual Kinematics* getEvent(); - virtual void resetSource(); - - /** - * This function returns a true if the file was open - * with weight-reading enabled and had this tree branch, - * false, if these criteria are not met. - */ - virtual bool hasWeight(){ return m_useWeight; }; - virtual unsigned int numEvents() const; - -private: - - TFile* m_inFile; - TTree* m_inTree; - unsigned int m_eventCounter; - bool m_useWeight; - - int m_nPart; - float m_e[Kinematics::kMaxParticles]; - float m_px[Kinematics::kMaxParticles]; - float m_py[Kinematics::kMaxParticles]; - float m_pz[Kinematics::kMaxParticles]; - float m_eBeam; - float m_pxBeam; - float m_pyBeam; - float m_pzBeam; - float m_weight; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.cc b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.cc deleted file mode 100644 index fec4e433a3..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.cc +++ /dev/null @@ -1,130 +0,0 @@ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" - -#include "AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h" -#include "IUAmpTools/Kinematics.h" - -#include "TH1.h" -#include "TFile.h" -#include "TTree.h" - -using namespace std; - -ROOTDataReaderBootstrap::ROOTDataReaderBootstrap( const vector< string >& args ): -UserDataReader< ROOTDataReaderBootstrap >( args ), -m_eventCounter( 0 ), -m_useWeight( false ) -{ - - // arguments: - // 0: file name - // 1: random seed - // 2: tree name (optional; deafult: "kin") - - assert( args.size() == 3 || args.size() == 2 ); - - TH1::AddDirectory( kFALSE ); - - //this way of opening files works with URLs of the form - // root://xrootdserver/path/to/myfile.root - m_inFile = TFile::Open( args[0].c_str() ); - - int seed = stoi( args[1] ); - m_randGenerator = new TRandom2( seed ); - - cout << "******************** WARNING ***********************" << endl; - cout << "* You are using the boostrap data reader, which *" << endl; - cout << "* should only be used for evaluating errors. *" << endl; - cout << "* The results with different seeds will be random *" << endl; - cout << "* due to random oversampling of the input file. *" << endl; - cout << "****************************************************" << endl; - cout << endl; - cout << " Random Seed: " << seed << endl << endl; - - // default to tree name of "kin" if none is provided - if( args.size() == 2 ){ - - m_inTree = dynamic_cast( m_inFile->Get( "kin" ) ); - } - else{ - - m_inTree = dynamic_cast( m_inFile->Get( args[2].c_str() ) ); - } - - m_inTree->SetBranchAddress( "NumFinalState", &m_nPart ); - m_inTree->SetBranchAddress( "E_FinalState", m_e ); - m_inTree->SetBranchAddress( "Px_FinalState", m_px ); - m_inTree->SetBranchAddress( "Py_FinalState", m_py ); - m_inTree->SetBranchAddress( "Pz_FinalState", m_pz ); - m_inTree->SetBranchAddress( "E_Beam", &m_eBeam ); - m_inTree->SetBranchAddress( "Px_Beam", &m_pxBeam ); - m_inTree->SetBranchAddress( "Py_Beam", &m_pyBeam ); - m_inTree->SetBranchAddress( "Pz_Beam", &m_pzBeam ); - - if(m_inTree->GetBranch("Weight") != NULL) { - - m_useWeight = true; - m_inTree->SetBranchAddress( "Weight", &m_weight ); - } - else{ - - m_useWeight = false; - } -} - -ROOTDataReaderBootstrap::~ROOTDataReaderBootstrap() -{ - if( m_inFile != NULL ) m_inFile->Close(); - if( m_randGenerator ) delete m_randGenerator; -} - -void -ROOTDataReaderBootstrap::resetSource() -{ - - cout << "Resetting source " << m_inTree->GetName() - << " in " << m_inFile->GetName() << endl; - - // this will cause the read to start back at event 0 - m_eventCounter = 0; -} - -Kinematics* -ROOTDataReaderBootstrap::getEvent() -{ - if( m_eventCounter++ < numEvents() ){ - - int thisEntry = (int)floor( m_randGenerator->Rndm()*numEvents() ); - - m_inTree->GetEntry( thisEntry ); - assert( m_nPart < Kinematics::kMaxParticles ); - - vector< TLorentzVector > particleList; - - particleList. - push_back( TLorentzVector( m_pxBeam, m_pyBeam, m_pzBeam, m_eBeam ) ); - - for( int i = 0; i < m_nPart; ++i ){ - - particleList.push_back( TLorentzVector( m_px[i], m_py[i], m_pz[i], m_e[i] ) ); - } - - return new Kinematics( particleList, m_useWeight ? m_weight : 1.0 ); - } - else{ - - return NULL; - } -} - -unsigned int -ROOTDataReaderBootstrap::numEvents() const -{ - return static_cast< unsigned int >( m_inTree->GetEntries() ); -} diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h deleted file mode 100644 index f95288d2bb..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h +++ /dev/null @@ -1,72 +0,0 @@ -#if !defined(ROOTDATAREADERBOOTSTRAP) -#define ROOTDATAREADERBOOTSTRAP - -#include "IUAmpTools/Kinematics.h" -#include "IUAmpTools/UserDataReader.h" - -#include "TString.h" -#include "TRandom2.h" -#include "TFile.h" -#include "TTree.h" - -#include - -using namespace std; - -class ROOTDataReaderBootstrap : public UserDataReader< ROOTDataReaderBootstrap > -{ - -public: - - /** - * Default constructor for ROOTDataReaderBootstrap - */ - ROOTDataReaderBootstrap() : UserDataReader< ROOTDataReaderBootstrap >(), m_inFile( NULL ) { } - - ~ROOTDataReaderBootstrap(); - - /** - * Constructor for ROOTDataReaderBootstrap - * \param[in] args vector of string arguments - * arguments: - * 0: file name - * 1: random seeD - * 2: tree name (optional; deafult: "kin") - */ - ROOTDataReaderBootstrap( const vector< string >& args ); - - string name() const { return "ROOTDataReaderBootstrap"; } - - virtual Kinematics* getEvent(); - virtual void resetSource(); - - /** - * This function returns a true if the file was open - * with weight-reading enabled and had this tree branch, - * false, if these criteria are not met. - */ - virtual bool hasWeight(){ return m_useWeight; }; - virtual unsigned int numEvents() const; - -private: - - TFile* m_inFile; - TTree* m_inTree; - unsigned int m_eventCounter; - bool m_useWeight; - - TRandom2* m_randGenerator; - - int m_nPart; - float m_e[Kinematics::kMaxParticles]; - float m_px[Kinematics::kMaxParticles]; - float m_py[Kinematics::kMaxParticles]; - float m_pz[Kinematics::kMaxParticles]; - float m_eBeam; - float m_pxBeam; - float m_pyBeam; - float m_pzBeam; - float m_weight; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.cc b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.cc deleted file mode 100644 index 32bd357673..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.cc +++ /dev/null @@ -1,181 +0,0 @@ - -#include -#include -#include - -#include "TLorentzVector.h" - -#include "AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h" -#include "IUAmpTools/Kinematics.h" - -#include "TH1.h" -#include "TFile.h" -#include "TTree.h" - -using namespace std; - -ROOTDataReaderWithTCut::ROOTDataReaderWithTCut( const vector< string >& args ): - UserDataReader< ROOTDataReaderWithTCut >( args ), - m_eventCounter( 0 ), - m_useWeight( false ) -{ - assert( args.size() == 4 || args.size() == 3 || args.size() == 1 ); - - TH1::AddDirectory( kFALSE ); - - //this way of opening files works with URLs of the form - // root://xrootdserver/path/to/myfile.root - m_inFile = TFile::Open( args[0].c_str() ); - - // default to tree name of "kin" if none is provided - if( args.size() == 4 ){ - - m_inTree = dynamic_cast( m_inFile->Get( args[3].c_str() ) ); - } - else{ - - m_inTree = dynamic_cast( m_inFile->Get( "kin" ) ); - } - - m_numEvents = m_inTree->GetEntries(); - - m_inTree->SetBranchAddress( "NumFinalState", &m_nPart ); - m_inTree->SetBranchAddress( "E_FinalState", m_e ); - m_inTree->SetBranchAddress( "Px_FinalState", m_px ); - m_inTree->SetBranchAddress( "Py_FinalState", m_py ); - m_inTree->SetBranchAddress( "Pz_FinalState", m_pz ); - m_inTree->SetBranchAddress( "E_Beam", &m_eBeam ); - m_inTree->SetBranchAddress( "Px_Beam", &m_pxBeam ); - m_inTree->SetBranchAddress( "Py_Beam", &m_pyBeam ); - m_inTree->SetBranchAddress( "Pz_Beam", &m_pzBeam ); - - if(m_inTree->GetBranch("Weight") != NULL){ - - m_useWeight = true; - m_inTree->SetBranchAddress( "Weight", &m_weight ); - } - else{ - - m_useWeight=false; - } - - m_RangeSpecified = false; - if( args.size() == 4 || args.size() == 3){ - // Set t range - m_tMin = atof(args[1].c_str()); - m_tMax = atof(args[2].c_str()); - m_RangeSpecified = true; - - m_numEvents = 0; - cout << "*********************************************" << endl; - cout << "ROOT Data reader -t range specified [" << m_tMin << "," << m_tMax << ")" << endl; - cout << "Total events: " << m_inTree->GetEntries() << endl; - - while( m_eventCounter < static_cast< unsigned int >( m_inTree->GetEntries() ) ){ - - m_inTree->GetEntry( m_eventCounter++ ); - assert( m_nPart < Kinematics::kMaxParticles ); - - vector< TLorentzVector > particleList; - - particleList. - push_back( TLorentzVector( m_pxBeam, m_pyBeam, m_pzBeam, m_eBeam ) ); - - for( int i = 0; i < m_nPart; ++i ){ - - particleList.push_back( TLorentzVector( m_px[i], m_py[i], m_pz[i], m_e[i] ) ); - } - - // Calculate -t and check if it is in range - // Use the reconstructed proton - TLorentzVector target = TLorentzVector(0.0,0.0,0.0,0.938272); - double tMag = fabs((target-particleList[1]).M2()); - - if (m_tMin <= tMag && tMag < m_tMax){ - m_numEvents++; - } - } - cout << "Number of events kept = " << m_numEvents << endl; - cout << "*********************************************" << endl; - } -} - -ROOTDataReaderWithTCut::~ROOTDataReaderWithTCut() -{ - if( m_inFile != NULL ) m_inFile->Close(); -} - -void ROOTDataReaderWithTCut::resetSource() -{ - - cout << "Resetting source " << m_inTree->GetName() - << " in " << m_inFile->GetName() << endl; - - // this will cause the read to start back at event 0 - m_eventCounter = 0; -} - - Kinematics* -ROOTDataReaderWithTCut::getEvent() -{ - - - if (m_RangeSpecified == false){ - - if( m_eventCounter < static_cast< unsigned int >( m_inTree->GetEntries() ) ){ - // if( m_eventCounter < 10 ){ - m_inTree->GetEntry( m_eventCounter++ ); - assert( m_nPart < Kinematics::kMaxParticles ); - - vector< TLorentzVector > particleList; - - particleList. - push_back( TLorentzVector( m_pxBeam, m_pyBeam, m_pzBeam, m_eBeam ) ); - - for( int i = 0; i < m_nPart; ++i ){ - - particleList.push_back( TLorentzVector( m_px[i], m_py[i], m_pz[i], m_e[i] ) ); - } - - return new Kinematics( particleList, m_useWeight ? m_weight : 1.0 ); - } - else return NULL; - - } - else{ - - while( m_eventCounter < static_cast< unsigned int >( m_inTree->GetEntries() ) ){ - - m_inTree->GetEntry( m_eventCounter++ ); - assert( m_nPart < Kinematics::kMaxParticles ); - - vector< TLorentzVector > particleList; - - particleList. - push_back( TLorentzVector( m_pxBeam, m_pyBeam, m_pzBeam, m_eBeam ) ); - - for( int i = 0; i < m_nPart; ++i ){ - - particleList.push_back( TLorentzVector( m_px[i], m_py[i], m_pz[i], m_e[i] ) ); - } - - // Calculate -t and check if it is in range - // Use the reconstructed proton - TLorentzVector target = TLorentzVector(0.0,0.0,0.0,0.938272); - double tMag = fabs((target-particleList[1]).M2()); - - if (m_tMin <= tMag && tMag < m_tMax){ - return new Kinematics( particleList, m_useWeight ? m_weight : 1.0 ); - } - - } - return NULL; - } - - return NULL; - } - - unsigned int ROOTDataReaderWithTCut::numEvents() const - { - return m_numEvents; - } diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h b/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h deleted file mode 100644 index 5a4c58a4e8..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h +++ /dev/null @@ -1,66 +0,0 @@ -#if !defined(ROOTDATAREADERWITHTCUT) -#define ROOTDATAREADERWITHTCUT - -#include "IUAmpTools/Kinematics.h" -#include "IUAmpTools/UserDataReader.h" - -#include "TString.h" -#include "TFile.h" -#include "TTree.h" - -#include - -using namespace std; - -class ROOTDataReaderWithTCut : public UserDataReader< ROOTDataReaderWithTCut > -{ - -public: - - /** - * Default constructor for ROOTDataReaderWithTCut - */ - ROOTDataReaderWithTCut() : UserDataReader< ROOTDataReaderWithTCut >(), m_inFile( NULL ) { } - - ~ROOTDataReaderWithTCut(); - - /** - * Constructor for ROOTDataReaderWithTCut - * \param[in] args vector of string arguments - */ - ROOTDataReaderWithTCut( const vector< string >& args ); - - string name() const { return "ROOTDataReaderWithTCut"; } - - virtual Kinematics* getEvent(); - virtual void resetSource(); - - /** - * This function returns a true if the file was open - * with weight-reading enabled and had this tree branch, - * false, if these criteria are not met. - */ - virtual bool hasWeight(){ return m_useWeight; }; - virtual unsigned int numEvents() const; - -private: - - TFile* m_inFile; - TTree* m_inTree; - unsigned int m_eventCounter,m_numEvents; - bool m_useWeight, m_RangeSpecified; - double m_tMin,m_tMax; - - int m_nPart; - float m_e[Kinematics::kMaxParticles]; - float m_px[Kinematics::kMaxParticles]; - float m_py[Kinematics::kMaxParticles]; - float m_pz[Kinematics::kMaxParticles]; - float m_eBeam; - float m_pxBeam; - float m_pyBeam; - float m_pzBeam; - float m_weight; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.cc b/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.cc deleted file mode 100644 index dc5e54f70c..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.cc +++ /dev/null @@ -1,74 +0,0 @@ -#include -#include -#include - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" - -#include "TFile.h" -#include "TTree.h" -#include "TH1.h" - - -void ROOTDataWriter::IOinit( const string& outFile, - const string& outTreeName, - bool overwrite, bool writeWeight) -{ - - TH1::AddDirectory( kFALSE ); - string writeMode="recreate"; - if(!overwrite) writeMode="update"; - - m_outFile = new TFile( outFile.c_str(), writeMode.c_str() ); - m_outTree = new TTree( outTreeName.c_str(), "Kinematics" ); - - m_outTree->Branch( "NumFinalState", &m_nPart, "NumFinalState/I" ); - m_outTree->Branch( "E_FinalState", m_e, "E_FinalState[NumFinalState]/F" ); - m_outTree->Branch( "Px_FinalState", m_px, "Px_FinalState[NumFinalState]/F" ); - m_outTree->Branch( "Py_FinalState", m_py, "Py_FinalState[NumFinalState]/F" ); - m_outTree->Branch( "Pz_FinalState", m_pz, "Pz_FinalState[NumFinalState]/F" ); - m_outTree->Branch( "E_Beam", &m_eBeam, "E_Beam/F" ); - m_outTree->Branch( "Px_Beam", &m_pxBeam, "Px_Beam/F" ); - m_outTree->Branch( "Py_Beam", &m_pyBeam, "Py_Beam/F" ); - m_outTree->Branch( "Pz_Beam", &m_pzBeam, "Pz_Beam/F" ); - if(writeWeight) - m_outTree->Branch( "Weight", &m_weight, "Weight/F" ); - - m_eventCounter = 0; -} - -ROOTDataWriter::~ROOTDataWriter() -{ - m_outFile->cd(); - m_outTree->Write(); - m_outFile->Close(); -} - -void -ROOTDataWriter::writeEvent( const Kinematics& kin ) -{ - vector< TLorentzVector > particleList = kin.particleList(); - - m_nPart = particleList.size() - 1; - - assert( particleList.size() <= Kinematics::kMaxParticles ); - - m_eBeam = particleList[0].E(); - m_pxBeam = particleList[0].Px(); - m_pyBeam = particleList[0].Py(); - m_pzBeam = particleList[0].Pz(); - - for( int i = 0; i < m_nPart; ++i ){ - - m_e[i] = particleList[i+1].E(); - m_px[i] = particleList[i+1].Px(); - m_py[i] = particleList[i+1].Py(); - m_pz[i] = particleList[i+1].Pz(); - } - - m_weight = kin.weight(); //will not get saved if branch not added in IOinit() - - m_outTree->Fill(); - - m_eventCounter++; - -} diff --git a/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.h b/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.h deleted file mode 100644 index 4dc25e18ac..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ROOTDataWriter.h +++ /dev/null @@ -1,60 +0,0 @@ -#if !defined(ROOTDATAWRITER) -#define ROOTDATAWRITER - -#include "IUAmpTools/Kinematics.h" - -#include "TTree.h" -#include "TFile.h" - -class ROOTDataWriter -{ - -public: - - /** - * Constructor for ROOTDataWriter. - * - * \param[in] outFile name of output file - * \param[in] outTreeName (optional) name of tree name in which to store events. Default: "kin" - * \param[in] overwrite (optional) boolean parameter specifying whether to - * overwrite (default) or update the ROOT file. - * \param[in] writeWeight (optional) enables writing of the event weight in the ROOT file - */ - ROOTDataWriter( const string& outFile, - const string& outTreeName="kin", - bool overwrite=true, bool writeWeight=false ) - { - IOinit(outFile, outTreeName, overwrite, writeWeight); - }; - - ~ROOTDataWriter(); - - void writeEvent( const Kinematics& kin ); - - int eventCounter() const { return m_eventCounter; } - -private: - - - void IOinit( const string& outFile, - const string& outTreeName, - bool overwrite, bool writeWeight); - - TFile* m_outFile; - TTree* m_outTree; - int m_eventCounter; - float m_weight; - - int m_nPart; - float m_e[Kinematics::kMaxParticles]; - float m_px[Kinematics::kMaxParticles]; - float m_py[Kinematics::kMaxParticles]; - float m_pz[Kinematics::kMaxParticles]; - - float m_eBeam; - float m_pxBeam; - float m_pyBeam; - float m_pzBeam; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/SConscript b/src/libraries/AMPTOOLS_DATAIO/SConscript deleted file mode 100644 index e7f61afcca..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/SConscript +++ /dev/null @@ -1,17 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada': - - env = env.Clone() - - sbms.AddAmpTools(env) - sbms.AddROOT(env) - sbms.library(env) - - diff --git a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.cc b/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.cc deleted file mode 100644 index 68cd0be5a4..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.cc +++ /dev/null @@ -1,68 +0,0 @@ - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_DATAIO/ThreePiPlotGenerator.h" -#include "IUAmpTools/Histogram.h" -#include "IUAmpTools/Kinematics.h" - -ThreePiPlotGenerator::ThreePiPlotGenerator( const FitResults& results ) : -PlotGenerator( results ) -{ - // calls to bookHistogram go here - - bookHistogram( k3PiMass, new Histogram1D( 100, 0.7, 2, "3PiM", "Invariant Mass of #pi^{-} #pi^{+} #pi^{+}" ) ); - - bookHistogram( kPiMPiP1Mass, new Histogram1D( 100, 0.3, 1.8, "PiMPi1M", "Invariant Mass of #pi^{-} #pi^{+}_{1}" ) ); - bookHistogram( kPiMPiP2Mass, new Histogram1D( 100, 0.3, 1.8, "PiMPi2M", "Invariant Mass of #pi^{-} #pi^{+}_{2}" ) ); - bookHistogram( kPiP1PiP2Mass, new Histogram1D( 100, 0.3, 1.8, "PiP1PiP2M", "Invariant Mass of #pi^{+}_{1} #pi^{+}_{2}" ) ); - - bookHistogram( kAlpha, new Histogram1D( 100, -3.14, 3.14, "Alpha", "Laboratory Polar Angle of Production Plane" ) ); - bookHistogram( kCosThetaRes, new Histogram1D( 100, -1, 1, "CosThRes", "cos( #theta ) of Resonance Production" ) ); - bookHistogram( kPhiRes, new Histogram1D( 100, -3.14, 3.14, "phiRes", "#phi of Resonance Production" ) ); -} - -void -ThreePiPlotGenerator::projectEvent( Kinematics* kin ){ - - TLorentzVector beam = kin->particle( 0 ); - TLorentzVector recoil = kin->particle( 1 ); - TLorentzVector piP1 = kin->particle( 2 ); - TLorentzVector piM = kin->particle( 3 ); - TLorentzVector piP2 = kin->particle( 4 ); - - TLorentzVector resonance = piM + piP1 + piP2; - - // orientation of production plane in lab - GDouble alpha = recoil.Vect().Phi(); - - TLorentzRotation resRestBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resRestBoost * beam; - TLorentzVector recoil_res = resRestBoost * recoil; - TLorentzVector piP1_res = resRestBoost * piP1; - - TVector3 zRes = -recoil_res.Vect().Unit(); - TVector3 yRes = beam_res.Vect().Cross(zRes).Unit(); - TVector3 xRes = yRes.Cross(zRes); - - TVector3 anglesRes( (piP1_res.Vect()).Dot(xRes), - (piP1_res.Vect()).Dot(yRes), - (piP1_res.Vect()).Dot(zRes) ); - - GDouble cosThetaRes = anglesRes.CosTheta(); - GDouble phiRes = anglesRes.Phi(); - - - // calls to fillHistogram go here - - fillHistogram( k3PiMass, ( piM + piP1 + piP2 ).M() ); - - fillHistogram( kPiMPiP1Mass, ( piM + piP1 ).M() ); - fillHistogram( kPiMPiP2Mass, ( piM + piP2 ).M() ); - fillHistogram( kPiP1PiP2Mass, ( piP1+ piP2 ).M() ); - - fillHistogram( kAlpha, alpha ); - fillHistogram( kCosThetaRes, cosThetaRes ); - fillHistogram( kPhiRes, phiRes ); -} diff --git a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.h b/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.h deleted file mode 100644 index 36a38bda35..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGenerator.h +++ /dev/null @@ -1,31 +0,0 @@ -#if !(defined THREEPIPLOTGENERATOR) -#define THREEPIPLOTGENERATOR - -#include -#include - -#include "IUAmpTools/PlotGenerator.h" - -using namespace std; - -class FitResults; -class Kinematics; - -class ThreePiPlotGenerator : public PlotGenerator -{ - -public: - - // create an index for different histograms - enum { k3PiMass = 0, kPiMPiP1Mass, kPiMPiP2Mass, kPiP1PiP2Mass, - kAlpha, kCosThetaRes, kPhiRes, kNumHists }; - - ThreePiPlotGenerator( const FitResults& results ); - -private: - - void projectEvent( Kinematics* kin ); - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.cc b/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.cc deleted file mode 100644 index 4c806f0866..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.cc +++ /dev/null @@ -1,90 +0,0 @@ -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h" -#include "IUAmpTools/Histogram1D.h" -#include "IUAmpTools/Kinematics.h" - -ThreePiPlotGeneratorSchilling::ThreePiPlotGeneratorSchilling( const FitResults& results ) : -PlotGenerator( results ) -{ - // calls to bookHistogram go here - bookHistogram( k3PiMass, new Histogram1D( 75, 0.6, 0.9, "M3pi", "Invariant Mass of #pi^{+} #pi^{-} #pi^{0}") ); - bookHistogram( kCosThetaPiPlus, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of #pi^{+}") ); - bookHistogram( kCosThetaPiMinus, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of #pi^{-}") ); - bookHistogram( kCosThetaPi0, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of #pi^{0}") ); - bookHistogram( kPhiPiPlus, new Histogram1D( 50, -1*PI, PI, "PhiPiPlus", "#Phi_{#pi_{+}}" ) ); - bookHistogram( kPhiPiMinus, new Histogram1D( 50, -1*PI, PI, "PhiPiMinus", "#Phi_{#pi_{-}}" ) ); - bookHistogram( kPhiPi0, new Histogram1D( 50, -1*PI, PI, "PhiPi0", "#Phi_{#pi_{0}}" ) ); - bookHistogram( kCosTheta, new Histogram1D( 50, -1., 1., "CosTheta", "cos#theta;cos#theta" ) ); - bookHistogram( kPhi, new Histogram1D( 50, -1*PI, PI, "Phi", "#Phi; #Phi[rad.]" ) ); - bookHistogram( kphi, new Histogram1D( 50, -1*PI, PI, "phi", "#phi; #phi[rad.]" ) ); - bookHistogram( kPsi, new Histogram1D( 50, -1*PI, PI, "psi", "#psi; #psi [rad.]" ) ); - bookHistogram( kt, new Histogram1D( 100, 0, 1.0 , "t", "-t" ) ); -} - -void -ThreePiPlotGeneratorSchilling::projectEvent( Kinematics* kin ){ - - TLorentzVector beam = kin->particle( 0 ); - TLorentzVector recoil = kin->particle( 1 ); - TLorentzVector p1 = kin->particle( 2 ); - TLorentzVector p2 = kin->particle( 3 ); - TLorentzVector p3 = kin->particle( 4 ); - - TLorentzVector resonance = p1 + p2 + p3; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - TLorentzVector p2_res = resonanceBoost * p2; - TLorentzVector p3_res = resonanceBoost * p3; - - // Three pi decay, use normal to decay plane - TVector3 norm = (p1_res.Vect().Cross(p2_res.Vect())).Unit(); - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( norm.Dot(x), - norm.Dot(y), - norm.Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - - // Use the right polarization vector - double polAngle = 0.0539258; // PARA Spring 2016 - //double polAngle = 1.62927; // PERP Spring 2016 - //TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - TVector3 eps(cos(polAngle), sin(polAngle), 0.0); // beam polarization vector - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - // compute invariant t - GDouble t = - 2* recoil.M() * (recoil.E()-recoil.M()); - - // calls to fillHistogram go here - - fillHistogram( k3PiMass, ( resonance ).M() ); - fillHistogram( kCosThetaPiPlus, p1_res.CosTheta()); - fillHistogram( kCosThetaPiMinus, p2_res.CosTheta() ); - fillHistogram( kCosThetaPi0, p3_res.CosTheta() ); - fillHistogram( kPhiPiPlus, p1.Phi() ); - fillHistogram( kPhiPiMinus, p2.Phi() ); - fillHistogram( kPhiPi0, p3.Phi() ); - fillHistogram( kCosTheta, cosTheta); - fillHistogram( kPhi, Phi ); - fillHistogram( kphi, phi ); - fillHistogram( kPsi, psi ); - fillHistogram( kt, -t ); // fill with -t to make positive -} diff --git a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h b/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h deleted file mode 100644 index a9e67a45eb..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h +++ /dev/null @@ -1,30 +0,0 @@ -#if !(defined THREEPIPLOTGENERATORSCHILLING) -#define THREEPIPLOTGENERATORSCHILLING - -#include -#include - -#include "IUAmpTools/PlotGenerator.h" - -using namespace std; - -class FitResults; -class Kinematics; - -class ThreePiPlotGeneratorSchilling : public PlotGenerator -{ - -public: - - // create an index for different histograms - enum { k3PiMass = 0, kCosThetaPiMinus, kCosThetaPiPlus, kCosThetaPi0, kPhiPiPlus, kPhiPiMinus, kPhiPi0, kCosTheta, kPhi, kphi, kPsi, kt, kNumHists}; - - ThreePiPlotGeneratorSchilling( const FitResults& results ); - -private: - - void projectEvent( Kinematics* kin ); - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.cc b/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.cc deleted file mode 100644 index 3431e5d0dc..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.cc +++ /dev/null @@ -1,79 +0,0 @@ -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_DATAIO/TwoPiPlotGenerator.h" -#include "IUAmpTools/Histogram1D.h" -#include "IUAmpTools/Kinematics.h" - -TwoPiPlotGenerator::TwoPiPlotGenerator( const FitResults& results ) : -PlotGenerator( results ) -{ - // calls to bookHistogram go here - - // bookHistogram( k2PiMass, new Histogram1D( 200, 0., 2.0, "M2pi", "Invariant Mass of #pi^{+} #pi^{-}") ); - bookHistogram( k2PiMass, new Histogram1D( 86, 0.28, 2.0, "M2pi", "Invariant Mass of #pi^{+} #pi^{-}") ); - bookHistogram( kPiPCosTheta, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of Resonance Production") ); - - bookHistogram( kPhiPiPlus, new Histogram1D( 50, -1*PI, PI, "PhiPiPlus", "#Phi_{#pi_{+}}" ) ); - bookHistogram( kPhiPiMinus, new Histogram1D( 50, -1*PI, PI, "PhiPiMinus", "#Phi_{#pi_{-}}" ) ); - bookHistogram( kPhi, new Histogram1D( 50, -1*PI, PI, "Phi", "#Phi" ) ); - bookHistogram( kphi, new Histogram1D( 50, -1*PI, PI, "phi", "#phi" ) ); - bookHistogram( kPsi, new Histogram1D( 50, -1*PI, PI, "psi", "#psi" ) ); - // bookHistogram( kt, new Histogram1D( 100, 0, 5, "t", "-t" ) ); - bookHistogram( kt, new Histogram1D( 100, 0, 2.00, "t", "-t" ) ); -} - -void -TwoPiPlotGenerator::projectEvent( Kinematics* kin ){ - - TLorentzVector beam = kin->particle( 0 ); - TLorentzVector recoil = kin->particle( 1 ); - TLorentzVector p1 = kin->particle( 2 ); - TLorentzVector p2 = kin->particle( 3 ); - - TLorentzVector resonance = p1 + p2; - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble cosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - // compute invariant t - GDouble t = - 2* recoil.M() * (recoil.E()-recoil.M()); - - // calls to fillHistogram go here - - fillHistogram( k2PiMass, ( resonance ).M() ); - - fillHistogram( kPiPCosTheta, cosTheta ); - - fillHistogram( kPhiPiPlus, p1.Phi() ); - fillHistogram( kPhiPiMinus, p2.Phi() ); - fillHistogram( kPhi, Phi ); - fillHistogram( kphi, phi ); - - fillHistogram( kPsi, psi ); - fillHistogram( kt, -t ); // fill with -t to make positive -} diff --git a/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.h b/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.h deleted file mode 100644 index dedf5cad19..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/TwoPiPlotGenerator.h +++ /dev/null @@ -1,30 +0,0 @@ -#if !(defined TWOPIPLOTGENERATOR) -#define TWOPIPLOTGENERATOR - -#include -#include - -#include "IUAmpTools/PlotGenerator.h" - -using namespace std; - -class FitResults; -class Kinematics; - -class TwoPiPlotGenerator : public PlotGenerator -{ - -public: - - // create an index for different histograms - enum { k2PiMass = 0, kPiPCosTheta, kPhiPiPlus, kPhiPiMinus, kPhi, kphi, kPsi, kt, kNumHists}; - - TwoPiPlotGenerator( const FitResults& results ); - -private: - - void projectEvent( Kinematics* kin ); - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.cc b/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.cc deleted file mode 100644 index 2a8025e226..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.cc +++ /dev/null @@ -1,92 +0,0 @@ -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h" -#include "IUAmpTools/Histogram1D.h" -#include "IUAmpTools/Kinematics.h" - -TwoZPiPlotGenerator::TwoZPiPlotGenerator( const FitResults& results ) : -PlotGenerator( results ) -{ - // calls to bookHistogram go here - - // bookHistogram( k2PiMass, new Histogram1D( 200, 0., 2.0, "M2pi", "Invariant Mass of #pi^{+} #pi^{-}") ); - bookHistogram( k2PiMass, new Histogram1D( 200, 0.2, 0.8, "M2pi", "Invariant Mass of #pi^{+} #pi^{-}") ); - bookHistogram( kPiPCosTheta, new Histogram1D( 50, -1., 1., "cosTheta", "cos( #theta ) of Resonance Production") ); - - bookHistogram( kPhiPiPlus, new Histogram1D( 50, -1*PI, PI, "PhiPiPlus", "#Phi_{#pi_{+}}" ) ); - bookHistogram( kPhiPiMinus, new Histogram1D( 50, -1*PI, PI, "PhiPiMinus", "#Phi_{#pi_{-}}" ) ); - bookHistogram( kPhi, new Histogram1D( 50, -1*PI, PI, "Phi", "#Phi" ) ); - bookHistogram( kphi, new Histogram1D( 50, -1*PI, PI, "phi", "#phi" ) ); - bookHistogram( kPsi, new Histogram1D( 50, -1*PI, PI, "psi", "#psi" ) ); - // bookHistogram( kt, new Histogram1D( 100, 0, 5, "t", "-t" ) ); - bookHistogram( kt, new Histogram1D( 100, 0, 0.05, "t", "-t" ) ); -} - -void -TwoZPiPlotGenerator::projectEvent( Kinematics* kin ){ - - TLorentzVector beam = kin->particle( 0 ); - TLorentzVector recoil = kin->particle( 3 ); - TLorentzVector p1 = kin->particle( 1 ); - TLorentzVector p2 = kin->particle( 2 ); - TLorentzVector resonance = p1 + p2; - // double weight = kin->weight(); - - /*cout << endl << endl << "beam= "; beam.Print(); - cout << "p1= "; p1.Print(); - cout << "p2= "; p2.Print(); - cout << "recoil= ";recoil.Print(); - cout << "resonance= ";resonance.Print();*/ - // cout << "projectEvent weight=" << weight << endl; - - double phipol = 0; // should take this variable from the configuration file. - TVector3 eps(cos(phipol), sin(phipol), 0.0); // beam polarization vector in lab - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // choose helicity frame: z-axis opposite recoil target in rho rest frame. Note that for Primakoff recoil is defined as missing P4 - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); // redefine y normal to production plane - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble CosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = Phi - phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - // compute invariant t - // GDouble t = - 2* recoil.M() * (recoil.E()-recoil.M()); - GDouble t = (beam - p1 - p2).M2(); // use measured particles to compute t - - // calls to fillHistogram go here - // cout << " TwoZPiPlotGenerator: mp1=" << p1.M() << " mp2=" << p2.M() << " mrecoil=" << recoil.M() << " m2pi=" << resonance.M() << endl; - - fillHistogram( k2PiMass, ( resonance ).M() ); - - fillHistogram( kPiPCosTheta, CosTheta ); - - fillHistogram( kPhiPiPlus, p1.Phi() ); - fillHistogram( kPhiPiMinus, p2.Phi() ); - fillHistogram( kPhi, Phi ); - fillHistogram( kphi, phi ); - - fillHistogram( kPsi, psi ); - fillHistogram( kt, -t ); // fill with -t to make positive -} diff --git a/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h b/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h deleted file mode 100644 index f04d9ec075..0000000000 --- a/src/libraries/AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h +++ /dev/null @@ -1,30 +0,0 @@ -#if !(defined TWOZPIPLOTGENERATOR) -#define TWOZPIPLOTGENERATOR - -#include -#include - -#include "IUAmpTools/PlotGenerator.h" - -using namespace std; - -class FitResults; -class Kinematics; - -class TwoZPiPlotGenerator : public PlotGenerator -{ - -public: - - // create an index for different histograms - enum { k2PiMass = 0, kPiPCosTheta, kPhiPiPlus, kPhiPiMinus, kPhi, kphi, kPsi, kt, kNumHists}; - - TwoZPiPlotGenerator( const FitResults& results ); - -private: - - void projectEvent( Kinematics* kin ); - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.cc b/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.cc deleted file mode 100644 index d856f43a3d..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.cc +++ /dev/null @@ -1,65 +0,0 @@ - -#include -#include -#include - -#include "AMPTOOLS_MCGEN/BreitWignerGenerator.h" - -const double BreitWignerGenerator::kPi = 3.14159; - -BreitWignerGenerator::BreitWignerGenerator() : -m_mass( 0 ), -m_width( 0 ) -{} - -BreitWignerGenerator::BreitWignerGenerator( double mass, double width ) : -m_mass( mass ), -m_width( width ) -{} - -pair< double, double > -BreitWignerGenerator::operator()() const -{ - - // generate BW's with 100% efficiency by integrating - // the normalized BW distribution from -infty to rho' - // the value of this func at rho' ranges then from 0 -> 1 - // transform so rho = pi/2 - rho' * pi - // rho ranges from -pi/2 -> pi/2 - // throw rho uniformly in this range and then - // invert to get s - // weight is the reciprocal of the normalized PDF and can be - // used to reweight the events so they are flat in s - // (i.e. flat in two-body phase space) - - double s = -1; - double rho; - - assert( m_mass > 0 && m_width > 0 ); - - // avoid potential funny business at extreme values of rho - while( s < 0 ){ - - rho = random( -kPi/2, kPi/2 ); - s = m_mass * m_mass + m_mass * m_width * tan( rho ); - } - - double weight = 1 / pdf( s ); - - return pair< double, double >( sqrt(s), weight ); -} - -double -BreitWignerGenerator::pdf( double s ) const { - - return m_mass * m_width / - ( kPi * ( ( s - m_mass * m_mass ) * - ( s - m_mass * m_mass ) + - m_mass * m_mass * m_width * m_width ) ); -} - -double -BreitWignerGenerator::random( double low, double hi ) const { - - return( ( hi - low ) * drand48() + low ); -} diff --git a/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.h b/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.h deleted file mode 100644 index 6e1b4778df..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/BreitWignerGenerator.h +++ /dev/null @@ -1,35 +0,0 @@ -#if !defined(BREITWIGNERGENERATOR) -#define BREITWIGNERGENERATOR - -#include - -using namespace std; - -class BreitWignerGenerator -{ - - public: - - BreitWignerGenerator(); - - BreitWignerGenerator( double mass, double width ); - - // output of the generation is a pair of doubles - // the first is the mass and the second is the weight - // to apply to this event to get back phase space - pair< double, double > operator()() const; - - // returns the value of the PDF for some value of s - double pdf( double s ) const; - - private: - - double random( double low, double hi ) const; - - static const double kPi; - - double m_mass; - double m_width; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.cc b/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.cc deleted file mode 100644 index 3d2ab9fe82..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.cc +++ /dev/null @@ -1,1178 +0,0 @@ -// -// CobremsGeneration - class implementation -// -// author: richard.t.jones at uconn.edu -// version: july 27, 2015 -// -// notes: -// -// This class computes the spectrum of bremsstrahlung radiation from a -// crystal radiator. The formalism is that described in the following paper. -// -// W. Kaune, G. Miller, W. Oliver, R.W. Williams, and K.K. Young, -// "Inclusive cross sections for pion and proton production by photons -// using collimated coherent bremsstrahlung", Phys Rev D, vol 11, -// no 3 (1975) pp. 478-494. -// -// The model for the photon beam contains the following parameters. -// 1. electron beam -// * beam energy: mean and rms spread -// * spot on radiator: gaussian model, cylindrical symmetry -// * emittance: gaussian model, cylindrical symmetry -// 2. crystal target -// * implemented for diamond, silicon -// * uniform thickness across beam spot -// * mosaic spread: gaussian model -// * dipole atomic form factor -// * Debye-Waller factor: defines coherent domain in q sum -// 3. downstream collimator -// * fixed distance from radiator -// * sharp cutoff at collimator radius -// * perfect alignment with beam axis assumed -// -// The crystal orientation is computed based on the requested coherent -// edge position requested by the user. For a high-energy electron beam -// this fixes one of the angles of the crystal with respect to the -// electron beam. The other angle must be chosen based on other -// considerations. A default value for this secondary angle parameter -// is assigned below, based on the observation that -// a) it is significantly larger than the primary edge-defining -// angle, so that additional peaks from reciprocal lattice sites -// (hkl) with the same h and different k values do not contribute -// significantly to the spectrum below the endpoint, and -// b) it is small enough, to render it unlikely that a random lattice -// vector from a distant region in q-space will cross through the -// coherent enhancement region as the primary (220) peak is moved -// through its full range in x from 30% to 90% of the endpoint -// for beamline parameters similar to those describing Hall D and GlueX. -// Should the user wish to try other values for this angle, a public -// method is provided for this purpose. - -#define COBREMS_GENERATOR_VERBOSITY 1 -//#define BOOST_PYTHON_WRAPPING 1 - -#include -#include -#include -#include -#include - -const double CobremsGeneration::dpi = 3.1415926535897; -const double CobremsGeneration::me = 0.510998910e-3; -const double CobremsGeneration::alpha = 7.2973525698e-3; -const double CobremsGeneration::hbarc = 0.1973269718e-15; - -CobremsGeneration::CobremsGeneration(double Emax_GeV, double Epeak_GeV) -{ - // Unique constructor for this class, initialize for the given - // endpoint energy and peak position but these can be changed. - - fBeamEnergy = Emax_GeV; - fBeamErms = 6.0e-4; // GeV - fBeamEmittance = 2.5e-9; // m r - fCollimatorSpotrms = 0.0005; // m - fCollimatorDistance = 76.0; // m - fCollimatorDiameter = 0.005; // m - fTargetThickness = 50e-6; // m - fTargetThetay = 0.050; // radians - fTargetThetaz = 0; // radians - setTargetCrystal("diamond"); - setCoherentEdge(Epeak_GeV); - fPhotonEnergyMin = 0.120; // GeV - setPolarizedFlag(false); - setCollimatedFlag(true); - -#if COBREMS_GENERATOR_VERBOSITY > 0 - std::cout << std::endl - << "Initialization for coherent bremsstralung calculation" - << std::endl - << " electron beam energy: " << Emax_GeV << " GeV" - << std::endl - << " primary coherent edge: " << Epeak_GeV << " GeV" - << std::endl; -#endif -} - -void CobremsGeneration::updateTargetOrientation() -{ - resetTargetOrientation(); - RotateTarget(0, dpi/2, 0); // point (1,0,0) along beam - RotateTarget(0, 0, dpi/4); // point (0,1,1) vertically - RotateTarget(0, 0, -fTargetThetaz); - RotateTarget(0, -fTargetThetay, 0); - RotateTarget(-fTargetThetax, 0, 0); -} - -void CobremsGeneration::setTargetCrystal(std::string crystal) -{ - // declare the radiator target crystal type by name - - if (crystal == "diamond") { - fTargetCrystal.name = "diamond"; - fTargetCrystal.Z = 6; - fTargetCrystal.A = 12.01; - fTargetCrystal.density = 3.534; // g/cm^3 - fTargetCrystal.lattice_constant = 3.5668e-10; // m - fTargetCrystal.Debye_Waller_const = 0.40e9; // 1/GeV^2 - } - else if (crystal == "silicon") { - fTargetCrystal.name = "silicon"; - fTargetCrystal.Z = 14; - fTargetCrystal.A = 28.09; - fTargetCrystal.density = 2.320; // g/cm^3 - fTargetCrystal.lattice_constant = 5.431e-10; // m - fTargetCrystal.Debye_Waller_const = 1.5e9; // 1/GeV^2 - } - else { - std::cerr << "Error in CobremsGeneration::setTargetCrystal - " - << "unknown crystal " << crystal << " requested, " - << "cannot continue." << std::endl; - exit(1); - } - - // define the stanard unit cell of the diamond Bravais lattice - fTargetCrystal.nsites = 8; - fTargetCrystal.ucell_site.clear(); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.0, 0.0, 0.0)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.0, 0.5, 0.5)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.5, 0.0, 0.5)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.5, 0.5, 0.0)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.25, 0.25, 0.25)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.25, 0.75, 0.75)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.75, 0.25, 0.75)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.75, 0.75, 0.25)); - fTargetCrystal.primaryHKL = lattice_vector(2,2,0); - - // approximate formula for atomic form factor beta - fTargetCrystal.betaFF = 111 * pow(fTargetCrystal.Z, -1/3.) / me; - - // set mosaic spread to GlueX specification - fTargetCrystal.mosaic_spread = 20e-6; - - // compute the radiation length - fTargetCrystal.radiation_length = getTargetRadiationLength_Schiff(); -} - -double CobremsGeneration::getTargetDebyeWallerConstant(double DebyeT_K, - double T_K) -{ - // Computes the Debye-Waller constant A for a simple model - // assuming an isotropic crystal -- see Kaune et.al. - // - // A(T) = A0 f(T) - // where - // A0 = 3 / (4 * atomicMass_GeV * DebyeTemperature_GeV) - // and - // f(T) = (2 / DebyeTemperature_GeV^2) * - // Integral_dw[0,DebyeTemperature_GeV] - // {w (1 + 2 / (exp(w/T) - 1))} - // - // T is the crystal temperature in GeV and A0 is the limiting - // value of A as T->0. - - double kBoltzmann = 8.617e-14; // GeV/K - double amassGeV = fTargetCrystal.A * 0.932; // GeV - double A0 = 3 / (2 * amassGeV * kBoltzmann * DebyeT_K); // /GeV^2 - double Tnormal = (T_K + 0.1) / DebyeT_K; - int niter = 50; - double f = 0; - for (int iter=0; iter < niter; ++iter) { - double x = (iter + 0.5) / niter; - f += x * (1 + 2 / (exp(x / Tnormal) - 1)) / niter; - } - return A0 * f; -} - -void CobremsGeneration::printBeamlineInfo() -{ - // Print a summary of the target crystal model parameters - - std::cout << " electron beam energy: " << fBeamEnergy << " GeV" - << std::endl - << " electron beam emittance: " - << fBeamEmittance * 1e9 << " mm.urad" - << std::endl - << " radiator crystal: " << fTargetCrystal.name - << ", thickness " << fTargetThickness * 1e6 << " um" - << std::endl - << " radiation length: " - << fTargetCrystal.radiation_length * 100 << " cm," - << " mosaic spread: " - << fTargetCrystal.mosaic_spread * 1e6 << " urad" - << std::endl - << " photon beam collimator half-angle: " - << fCollimatorDiameter / (2 * fCollimatorDistance) - * fBeamEnergy / me << " (m/E)" - << std::endl - << " collimator diameter: " - << fCollimatorDiameter * 100 << " cm" - << std::endl - << " crystal orientation: theta_x " - << fTargetThetax * 1e3 << " mrad" - << std::endl - << " theta_y " - << fTargetThetay * 1e3 << " mrad" - << std::endl << std::endl; -} - -void CobremsGeneration::printTargetCrystalInfo() -{ - // Print a summary of the target crystal model parameters - - double kBoltzmann = 8.617e-14; // GeV/K - double amass = fTargetCrystal.A * 0.932; // GeV - double DebyeTheta0 = 3 / (4 * amass * fTargetCrystal.Debye_Waller_const); - double DebyeTheta300 = DebyeTheta0; - for (int i=0; i < 5; i++) { - DebyeTheta300 = DebyeTheta0 * (1 + - pow(2 * dpi * 300 * kBoltzmann / DebyeTheta300, 2) / 6); - } - - std::cout << "CobremsGeneration crystal type is " << fTargetCrystal.name - << std::endl - << " atomic number Z=" << fTargetCrystal.Z - << ", atomic weight A=" << fTargetCrystal.A << " amu" - << std::endl - << " mass density: " << fTargetCrystal.density << " g/cm^3" - << std::endl - << " radiation length: " << fTargetCrystal.radiation_length * 100 - << " cm" << std::endl - << " Debye-Waller constant: " << fTargetCrystal.Debye_Waller_const - << " /GeV^2 (" << DebyeTheta300 / kBoltzmann << " K)" - << std::endl - << " mosaic spread: " << fTargetCrystal.mosaic_spread * 1e6 - << " urad" << std::endl - << " atomic form-factor cutoff momentum: " - << sqrt(1 / fTargetCrystal.betaFF) * 1e6 << " keV" - << std::endl - << " primary lattice reflection h,k,l=" - << fTargetCrystal.primaryHKL.x << "," - << fTargetCrystal.primaryHKL.y << "," - << fTargetCrystal.primaryHKL.z - << std::endl - << " lattice constant: " << fTargetCrystal.lattice_constant * 1e9 - << " nm" << std::endl - << " occupied sites of the crystal lattice unit cell are:" - << std::endl; - for (unsigned int i=0; i < fTargetCrystal.ucell_site.size(); ++i) { - char s[100]; - snprintf(s, 100, "%4.2f %4.2f %4.2f", fTargetCrystal.ucell_site[i].x, - fTargetCrystal.ucell_site[i].y, - fTargetCrystal.ucell_site[i].z); - std::cout << " " << i + 1 << ": " << s << std::endl; - } - std::cout << " Crystal orientation matrix is:" << std::endl; - for (int i=0; i < 3; ++i) { - char s[100]; - snprintf(s, 100, "%15.12f %15.12f %15.12f", fTargetRmatrix[i][0], - fTargetRmatrix[i][1], - fTargetRmatrix[i][2]); - std::cout << " " << s << std::endl; - } -} - -void CobremsGeneration::applyBeamCrystalConvolution(int nbins, double *xvalues, - double *yvalues) -{ - // Electron beam emittance produces two effects in the coherent - // bremsstrahlung spectrum: - // 1) smears out the collimation acceptance function in production - // angle, so it varies smoothly to zero instead of being a step; - // 2) combines with mosaic spread of the target crystal to smear out - // the relation between photon energy fraction x and production - // angle theta for a given lattice reflection. - // The first one affects the left-hand (low energy) side of the - // coherent peaks in the coherent bremsstrahlung spectrum, while the - // second affects the right-hand (high energy) side, limiting the - // sharpness of the edges in either case. - // - // Effect (1) is taken into account in the way the acceptance function - // is computed on the final state, but effect (2) is more difficult to - // treat analytically because it involves smearing directions in the - // initial state. This is only relevant to the coherent part of the - // spectrum, where it acts by broadening the step on the high side of - // the coherent edge from a sharp drop to a gradually sloping curve. - // One way to take this into account in an effective manner is to treat - // the coherent spectrum at every photon energy bin as being dominated - // by a single reciprocal lattice vector, and smearing out the relation - // x=x(theta) that follows from the two-body nature of the scattering - // from that plane. Considering a 1D spectrum of beam intensity vs x, - // this leads to a convolution of the distribution with an x-dependent - // smearing function. The applyBeamConvolution method computes that - // smearing function for each value of x in the input xvalues array - // and applies it to the input spectrum represented by the yvalues - // array. The yvalues array is overwritten with the convoluted spectrum. - // For simplicity, the xvalues are assumed to be equally spaced. - - double x0 = xvalues[0]; - double x1 = xvalues[nbins - 1]; - double var0 = pow(fTargetCrystal.mosaic_spread, 2) + - pow(fBeamEmittance / fCollimatorSpotrms, 2); - double varMS = Sigma2MS(fTargetThickness); - - // Here we have to guess which reciprocal lattice vector is dominantly - // for the coherent photons in each bin in x. For simplicity, I assume - // it is a (2,2,0) vector. Higher order vectors exhibit more smearing - // but this is a good approximation if the primary peaks in the spectrum - // come from (2,2,0) vectors. - double a = fTargetCrystal.lattice_constant; - double qabs = sqrt(8.0) * hbarc * 2*dpi / a; - double xfact = 2 * fBeamEnergy * qabs / (me*me); - double *norm = new double[nbins]; - double *result = new double[nbins]; - for (int j=0; j < nbins; ++j) { - norm[j] = 0; - result[j] = 0; - for (int i=0; i < nbins; ++i) { - double dx = (x1 - x0) * (j - i) / nbins; - double x = x0 + (x1 - x0) * (j + 0.5) / nbins; - double dalph = dx / xfact / pow(1 - x + 1e-99, 2); - double term; - if (varMS / var0 > 1e-4) { - term = dalph / varMS * - (boost::math::erf(dalph / sqrt(2 * (var0 + varMS))) - - boost::math::erf(dalph / sqrt(2 * var0))) + - sqrt(2 / dpi) / varMS * - (exp(-dalph*dalph / (2 * (var0 + varMS))) * - sqrt(var0 + varMS) - - exp(-dalph*dalph / (2 * var0)) * sqrt(var0)); - } - else { - term = exp(-dalph*dalph / (2 * var0)) / sqrt(2 * dpi * var0); - } - norm[j] += term; - } - } - - for (int i=0; i < nbins; ++i) { - for (int j=0; j < nbins; ++j) { - double dx = (x1 - x0) * (j - i) / nbins; - double x = x0 + (x1 - x0) * (j + 0.5) / nbins; - double dalph = dx / xfact / pow(1 - x + 1e-99, 2); - double term; - if (varMS / var0 > 1e-4) { - term = dalph / varMS * - (boost::math::erf(dalph / sqrt(2 * (var0 + varMS))) - - boost::math::erf(dalph / sqrt(2 * var0))) + - sqrt(2 / dpi) / varMS * - (exp(-dalph*dalph / (2 * (var0 + varMS))) * - sqrt(var0 + varMS) - - exp(-dalph*dalph/ (2 * var0)) * sqrt(var0)); - } - else { - term = exp(-dalph*dalph / (2 * var0)) / sqrt(2 * dpi * var0); - } - result[i] += term * yvalues[j] / norm[j]; - } - } - - for (int i=0; i < nbins; ++i) { - if (fabs(result[i]) > 1e-35) { - yvalues[i] = result[i]; - } - else { - yvalues[i] = 0; - } - } - - delete [] norm; - delete [] result; -} - -double CobremsGeneration::getTargetRadiationLength_PDG() -{ - // PDG formula for radiation length, converted to meters - - double Z = fTargetCrystal.Z; - double N = fTargetCrystal.nsites; - double a = fTargetCrystal.lattice_constant; - double c = alpha * Z; - double s = 4 * N * pow(alpha, 3) * pow(hbarc/(a*me), 2) / a * - (Z*Z * (log(184.15 * pow(Z, -1/3.)) - - c*c * (1 / (1 + c*c) + 0.20206 - 0.0369 * c*c + - 0.0083 * pow(c, 4) - 0.002 * pow(c, 6))) + - Z * log(1194 * pow(Z, -2/3.))); - return 1/s; -} - -double CobremsGeneration::getTargetRadiationLength_Schiff() -{ - // Schiff formula for radiation length, converted to meters - - double Z = fTargetCrystal.Z; - double N = fTargetCrystal.nsites; - double a = fTargetCrystal.lattice_constant; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double s = 4 * N * pow(alpha, 3) * pow(hbarc/(a*me), 2) / a * - Z * (Z + zeta) * log(183 * pow(Z, -1/3.)); - return 1/s; -} - -void CobremsGeneration::setCoherentEdge(double Epeak_GeV) -{ - // Adjust theta_x of the target to align the coherent edge at - // energy Epeak_GeV in the photon spectrum, then orient the - // crystal according to theta_x, theta_y, theta_z tip angles. - - double edge = Epeak_GeV; - double qtotal = hbarc * (2 * dpi / fTargetCrystal.lattice_constant); - lattice_vector hkl = fTargetCrystal.primaryHKL; - qtotal *= sqrt(hkl.x * hkl.x + hkl.y * hkl.y + hkl.z * hkl.z); - double qlong = edge * me*me / (2 * fBeamEnergy * (fBeamEnergy - edge)); - fTargetThetax = -qlong / qtotal; - updateTargetOrientation(); -} - -CobremsGeneration::CobremsGeneration(const CobremsGeneration &src) -{ - // copy constructor - - fTargetCrystal = src.fTargetCrystal; - fTargetThickness = src.fTargetThickness; - fTargetThetax = src.fTargetThetax; - fTargetThetay = src.fTargetThetay; - fTargetThetaz = src.fTargetThetaz; - for (int i=0; i < 3; ++i) - for (int j=0; j < 3; ++j) - fTargetRmatrix[i][j] = src.fTargetRmatrix[i][j]; - fBeamEnergy = src.fBeamEnergy; - fBeamErms = src.fBeamErms; - fBeamEmittance = src.fBeamEmittance; - fCollimatorSpotrms = src.fCollimatorSpotrms; - fCollimatorDistance = src.fCollimatorDistance; - fCollimatorDiameter = src.fCollimatorDiameter; - fQ2theta2 = src.fQ2theta2; - fQ2weight = src.fQ2weight; -} - -CobremsGeneration &CobremsGeneration::operator=(const CobremsGeneration &src) -{ - // assignment operator - - fTargetCrystal = src.fTargetCrystal; - fTargetThickness = src.fTargetThickness; - fTargetThetax = src.fTargetThetax; - fTargetThetay = src.fTargetThetay; - fTargetThetaz = src.fTargetThetaz; - for (int i=0; i < 3; ++i) - for (int j=0; j < 3; ++j) - fTargetRmatrix[i][j] = src.fTargetRmatrix[i][j]; - fBeamEnergy = src.fBeamEnergy; - fBeamErms = src.fBeamErms; - fBeamEmittance = src.fBeamEmittance; - fCollimatorSpotrms = src.fCollimatorSpotrms; - fCollimatorDistance = src.fCollimatorDistance; - fCollimatorDiameter = src.fCollimatorDiameter; - fQ2theta2 = src.fQ2theta2; - fQ2weight = src.fQ2weight; - return *this; -} - -CobremsGeneration::~CobremsGeneration() { } - -double CobremsGeneration::CoherentEnhancement(double x) -{ - // Returns ratio of total bremsstrahlung yield over incoherent yield - // for photon energy k = x*fBeamEnergy - - double yc = Rate_dNcdx(x); - double yi = Rate_dNidx(x); - return (yi + yc) / (yi + 1e-99); -} - -double CobremsGeneration::Rate_dNtdx(double x) -{ - // Returns total bremsstrahlung probability density differential in - // x (scaled photon energy) at photon energy k = x*fBeamEnergy. - - return Rate_dNcdx(x) + Rate_dNidx(x); -} - -double CobremsGeneration::Rate_dNtdx(double x, - double distance_m, double diameter_m) -{ - // Returns total bremsstrahlung probability density differential in x - // (scaled photon energy) at photon energy k = x*fBeamEnergy with - // user-specified variations in the collimator distance and diameter, - // for plotting. Special case: if diameter_m < 0 then interpret its - // absolute value as the collimator radius in characteristic units m/E. - - double dist = fCollimatorDistance; - double diam = fCollimatorDiameter; - fCollimatorDistance = (distance_m > 0)? distance_m : fCollimatorDistance; - fCollimatorDiameter = (diameter_m > 0)? diameter_m : (diameter_m < 0)? - -2 * distance_m * diameter_m * me / fBeamEnergy : - fCollimatorDiameter; - double rate = Rate_dNtdx(x); - fCollimatorDistance = dist; - fCollimatorDiameter = diam; - return rate; -} - -double CobremsGeneration::Rate_dNtdk(double k_GeV) -{ - // Returns total bremsstrahlung probability density differential - // in photon energy k (GeV). - - return Rate_dNtdx(k_GeV / fBeamEnergy) / fBeamEnergy; -} - -double CobremsGeneration::Rate_dNcdx(double x) -{ - // Returns the coherent bremsstrahlung probability density differential - // in x (scaled photon energy) at photon energy k = x*fBeamEnergy. - - double rate = 0; - int npoints = 2; - for (int n=0; n < npoints; ++n) { - double phi = (n + 0.5) * (dpi/2) / npoints; - rate += Rate_dNcdxdp(x, phi); - } - rate *= 2*dpi / npoints; - return rate; -} - -double CobremsGeneration::Rate_dNcdx(double x, - double distance_m, double diameter_m) -{ - // Returns the coherent bremsstrahlung probability density differential - // in x (scaled photon energy) at photon energy k = x*fBeamEnergy with - // user-specified variations in the collimator distance and diameter. - // Special case: if diameter_m < 0 then interpret its absolute - // value as the collimator radius in characteristic units m/E. - - double dist = fCollimatorDistance; - double diam = fCollimatorDiameter; - fCollimatorDistance = (distance_m > 0)? distance_m : fCollimatorDistance; - fCollimatorDiameter = (diameter_m > 0)? diameter_m : (diameter_m < 0)? - -2 * distance_m * diameter_m * me / fBeamEnergy : - fCollimatorDiameter; - double rate = 0; - int npoints = 2; - for (int n=0; n < npoints; ++n) { - double phi = (n + 0.5) * (dpi/2) / npoints; - rate += Rate_dNcdxdp(x, phi); - } - rate *= 2*dpi / npoints; - fCollimatorDistance = dist; - fCollimatorDiameter = diam; - return rate; -} - -double CobremsGeneration::Rate_dNcdxdp(double x, double phi) -{ - // Returns the coherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) and phi (azimuthal emission angle) for - // fixed photon energy k = x*fBeamEnergy and phi. If fPolarizedFlag is - // false (0, default) then the total yield is returned, otherwise it is - // only the polarized fraction. If fCollimatedFlag is false (0) then - // the total yield is returned, otherwise only the part that passes the - // collimator is counted (default). - - double Z = fTargetCrystal.Z; - double a = fTargetCrystal.lattice_constant; - double sigma0 = 16 * dpi * fTargetThickness * Z*Z * pow(alpha, 3) * - fBeamEnergy * hbarc/(a*a) * pow(hbarc / (a * me), 4); - - fQ2theta2.clear(); - fQ2weight.clear(); - double qzmin = 99; - int hmin, kmin, lmin; - double sum = 0; - // can restrict to h=0 for cpu speedup, if crystal alignment is "reasonable" - for (int h = -4; h <= 4; ++h) { - for (int k = -10; k <= 10; ++k) { - for (int l = -10; l <= 10; ++l) { - if (h/2 * 2 == h) { - if (k/2 * 2 != k || l/2 * 2 != l || - (h + k + l)/4 * 4 != h + k + l) - { - continue; - } - } - else if (k/2 * 2 == k || l/2 * 2 == l) { - continue; - } - double ReS = 0; - double ImS = 0; - for (int i=0; i < fTargetCrystal.nsites; ++i) { - double qdota = 2 * dpi * (h * fTargetCrystal.ucell_site[i].x + - k * fTargetCrystal.ucell_site[i].y + - l * fTargetCrystal.ucell_site[i].z); - ReS += cos(qdota); - ImS += sin(qdota); - } - double S2 = ReS*ReS + ImS*ImS; - if (S2 < 1e-4) - continue; - double qnorm = hbarc * 2 * dpi / a; - double q[3]; - q[0] = qnorm * (fTargetRmatrix[0][0] * h + - fTargetRmatrix[0][1] * k + - fTargetRmatrix[0][2] * l); - q[1] = qnorm * (fTargetRmatrix[1][0] * h + - fTargetRmatrix[1][1] * k + - fTargetRmatrix[1][2] * l); - q[2] = qnorm * (fTargetRmatrix[2][0] * h + - fTargetRmatrix[2][1] * k + - fTargetRmatrix[2][2] * l); - double q2 = q[0]*q[0] + q[1]*q[1] + q[2]*q[2]; - double qT2 = q[0]*q[0] + q[1]*q[1]; - double xmax = 2 * fBeamEnergy * q[2]; - xmax /= xmax + me*me; - if (x > xmax || xmax > 1) { - continue; - } - -#if COBREMS_GENERATOR_VERBOSITY > 2 - else { - std::cout << h << "," << k << "," << l << "," - << S2 << "," << q2 << "," << xmax - << std::endl; - } -#endif - - if (q[2] < qzmin) { - qzmin = q[2]; - hmin = h; - kmin = k; - lmin = l; - } - double theta2 = (1 - x) * xmax / (x * (1 - xmax) + 1e-99) - 1; - double betaFF2 = pow(fTargetCrystal.betaFF, 2); - double FF = 1 / (1 + q2 * betaFF2); - sum += sigma0 * qT2 * S2 * pow(FF * betaFF2, 2) * - exp(-q2 * fTargetCrystal.Debye_Waller_const) * - ((1 - x) / pow(x * (1 + theta2) + 1e-99, 2)) * - ((1 + pow(1 - x, 2)) - 8 * (theta2 / pow(1 + theta2, 2) * - (1 - x) * pow(cos(phi), 2))) * - ((fCollimatedFlag)? Acceptance(theta2) : 1) * - ((fPolarizedFlag)? Polarization(x, theta2, phi) : 1); - fQ2theta2.push_back(theta2); - fQ2weight.push_back(sum); - } - } - } - -#if COBREMS_GENERATOR_VERBOSITY > 1 - if (qzmin < 99) { - std::cout << hmin << "," << kmin << "," << lmin - << " is the best plane at x=" << x - << std::endl; - } -#endif - - return sum; -} - -double CobremsGeneration::Rate_dNidx(double x) -{ - // Returns the incoherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) at fixed photon energy k = x*fBeamEnergy. - - if (x > 1) - return 0; - - // Numerical integration in d(theta**2) over [0,inf] - // is mapped onto u=1/(1+theta^2) as (1/u^2) d(u) over [0,1] - int niter = 50; - double dNidx = 0; - double du = 1. / niter; - for (int iter = 0; iter < niter; ++iter) { - double u = (iter + 0.5) / niter; - double theta2 = (1 - u) / u; - dNidx += Rate_dNidxdt2(x, theta2) * du/(u*u); - } - return dNidx; -} - -double CobremsGeneration::Rate_dNBidx(double x) -{ - // In the following paper, a closed form is given for the integral that - // is being performed analytically by dNidx. I include this second form - // here in case some time it might be useful as a cross check. - // - // "Coherent bremsstrahlung in crystals as a tool for producing high - // energy photon beams to be used in photoproduction experiments at - // CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. - // - // Note: in this paper they have swapped subscripts for coherent and - // incoherent intensities. This is not very helpful to the reader! - // - // The result is some 15% lower radiation rate than the result of dNidx. - // I take the latter to be more detailed (because it gives a more - // realistic behaviour at the endpoint and agrees better with the PDG - // radiation length for carbon). Most of this deficiency is remedied - // by simply replacing Z**2 in the cross section with Z*(Z+zeta) as - // recommended by Kaune et.al., and followed by the PDG in their fit - // to radiation lengths. - // - // WARNING - // dNidx and dNBidx give the incoherent radiation rate for crystalline - // radiators. If you take the incoherent radiation formulae here and - // integrate them you will NOT obtain the radiation length for amorphous - // radiators; it will be overestimated by some 15%. The reason is that - // the part of the integral in q-space that is covered by the discrete - // sum has been subtracted to avoid double-counting with the coherent - // part. If you were to spin the crystal fast enough, the coherent - // spectrum should average out to yield the remaining 15% with a - // spectral shape resembling the Bethe-Heitler result. - - double Z = fTargetCrystal.Z; - double betaFF = fTargetCrystal.betaFF; - double a = fTargetCrystal.lattice_constant; - double AoverB2 = fTargetCrystal.Debye_Waller_const / (betaFF * betaFF); - double Tfact = -(1 + AoverB2) * exp(AoverB2) * - boost::math::expint(1, AoverB2); - double psiC1 = 2 * (2 * log(betaFF * me) + Tfact + 2); - double psiC2 = psiC1 - 2/3.; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double dNBidx = fTargetCrystal.nsites * fTargetThickness * - Z * (Z + zeta) * pow(alpha, 3) * - pow(hbarc / (a*me), 2) / (a * x) * - (psiC1 * (1 + pow(1 - x, 2)) - psiC2 * (1 - x) * 2/3.); - return dNBidx; -} - -double CobremsGeneration::Rate_dNidxdt2(double x, double theta2) -{ - // Returns the incoherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) and theta^2 at fixed photon energy - // k = x*fBeamEnergy and production angle theta. Argument theta2 is equal - // to theta^2 expressed in units of (me/fBeamEnergy)^2. If internal flag - // fCollimatedFlag is false (0) then the total yield is returned, - // otherwise only the part that passes the collimator is counted (default). - - double delta = 1.02; - double Z = fTargetCrystal.Z; - double betaFF = fTargetCrystal.betaFF; - double a = fTargetCrystal.lattice_constant; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double MSchiff = 1 / (pow((me * x) / (2*fBeamEnergy * (1 - x) + 1e-99), 2) + - 1 / pow(betaFF * me * (1 + theta2), 2)); - double dNidxdt2 = 2 * fTargetCrystal.nsites * fTargetThickness * Z * - (Z + zeta) * pow(alpha, 3) * pow(hbarc/(a*me), 2) / (a*x) * - ( ((1 + pow(1 - x, 2)) - 4 * theta2 * (1 - x) / - pow(1 + theta2, 2)) / - pow(1 + theta2, 2) * - (log(MSchiff) - 2 * delta * Z / (Z + zeta)) + - 16 * theta2 * (1 - x) / pow(1 + theta2, 4) - - pow(2 - x, 2) / pow(1 + theta2, 2) ) * - ((fCollimatedFlag)? Acceptance(theta2) : 1); - return dNidxdt2; -} - -double CobremsGeneration::Rate_para(double x, double theta2, double phi) -{ - // Returns the relative rate of in-plane polarized flux from coherent - // bremsstrahlung at production angles theta and phi and photon energy - // k = x*fBeamEnergy. The units are arbitrary, but the same as Rate_ortho - // (see below). The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. - - return 0.5 * pow((2 - x) * (1 + theta2), 2) - - 8 * theta2 * (1 - x) * pow(cos(phi), 2) - - 8 * pow(theta2, 2) * (1 - x) * pow(cos(phi) * sin(phi), 2); -} - -double CobremsGeneration::Rate_ortho(double x, double theta2, double phi) -{ - // Returns the relative rate of out-of-plane polarized flux from coherent - // bremsstrahlung at production angles theta and phi and photon energy k - // = x*fBeamEnergy. The units are arbitrary, but the same as Rate_para - // (see above). The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. - - return 0.5 * pow(x * (1 + theta2), 2) + - 8 * pow(theta2, 2) * (1 - x) * pow(cos(phi) * sin(phi), 2); -} - -double CobremsGeneration::Polarization(double x, double theta2) -{ - // Returns the degree of linear polarization in a coherent bremsstrahlung - // beam at photon energy k = x*fBeamEnergy and production angle theta. - // The formula evaluated below is the azimuthal average of the ratio - // (Rate_para - Rate_ortho) / (Rate_para + Rate_ortho) - // The argument theta2 is the production polar angle theta^2 expressed - // in units of (me/fBeamEnergy)^2. - - return 2 * (1 - x) / (pow(1 + theta2, 2) * (pow(1 - x + 1e-99, 2) + 1) - - 4 * theta2 * (1 - x)); -} - -double CobremsGeneration::Polarization(double x, double theta2, double phi) -{ - // Returns the degree of linear polarization in a coherent bremsstrahlung - // beam at photon energy k = x*fBeamEnergy and production angles theta, phi. - // The argument theta2 is the production polar angle theta^2 expressed - // in units of (me/fBeamEnergy)^2. - - double Rpara = Rate_para(x, theta2, phi); - double Rperp = Rate_ortho(x, theta2, phi); - return (Rpara - Rperp) / (Rpara + Rperp); -} - -double CobremsGeneration::AbremsPolarization(double x, double theta2, double phi) -{ - // Returns the degree of linear polarization in an ordinary atomic - // bremsstrahlung beam at photon energy k = x*fBeamEnergy and production - // angles theta,phi. The formula is a parameterization of the linear - // polarization evaluated using the Dirac++ QED Monte Carlo generator. - // The argument theta2 is the production polar angle theta^2 expressed - // in units of (me/fBeamEnergy)^2. - - double Acoeff[3][4] = {{0.93000, 0.64250, 0.66598, 1.62506}, - {0.73000, 1.05648, 0.84643, 1.97061}, - {0.87610, 0.57510, 0.74918, 1.52849}}; - double a[3]; - for (int n=0; n < 3; ++n) { - double A = pow(Acoeff[n][0], 2) + - pow(Acoeff[n][1], 2) * pow(x, 2) + - pow(Acoeff[n][2], 2) * pow(x, 4) + - pow(Acoeff[n][3], 2) * pow(x, 16); - a[n] = A*A; - } - double ppol = theta2 / (a[0] + a[1] * theta2 + a[2] * theta2*theta2); - return ppol * cos(2 * phi); -} - -double CobremsGeneration::Acceptance(double theta2, double phi, - double xshift_m, double yshift_m) -{ - // Returns the acceptance of the collimator for photons emitted at - // polar angle theta and azimuthal angle phi at the radiator. Both - // beam emittance and multiple-scattering in the target contribute - // to smearing of the angular acceptance at the the collimator edge. - // The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. Misalignment of the - // collimator with the beam axis is taken into account by the - // arguments xshift,yshift. - - double theta = sqrt(theta2) * (me/fBeamEnergy); - double xc = fCollimatorDistance * tan(theta) * cos(phi) + xshift_m; - double yc = fCollimatorDistance * tan(theta) * sin(phi) + yshift_m; - double thetaprime = atan2(sqrt(xc*xc + yc*yc), fCollimatorDistance); - return Acceptance(pow(thetaprime * fBeamEnergy/me, 2)); -} - -double CobremsGeneration::Acceptance(double theta2) -{ - // Returns the acceptance of the collimator for photons emitted at - // polar angle theta at the radiator, under the assumption that the - // collimator axis is perfectly aligned with the incident electron - // beam axis back at the radiator. Both beam emittance and - // multiple-scattering in the target contribute to smearing of the - // angular acceptance at the the collimator edge. The argument theta2 - // is the production polar angle theta^2 expressed in units of - // (me/fBeamEnergy)^2. - - double acceptance = 0; - double niter = 50; - double theta = sqrt(theta2); - double thetaC = fCollimatorDiameter / (2 * fCollimatorDistance) * - fBeamEnergy / me; - double var0 = pow((fCollimatorSpotrms / fCollimatorDistance) * - fBeamEnergy / me, 2); - double varMS = Sigma2MS(fTargetThickness) * pow(fBeamEnergy / me, 2); - if (theta < thetaC) { - double u1 = thetaC - theta; - if (u1*u1 / (var0 + varMS) > 20) { - return 1; - } - for (int iter = 0; iter < niter; ++iter) { - double u = u1 * (iter + 0.5) / niter; - double u2 = u * u; - double du2 = 2 * u * u1 / niter; - double pu; - if (varMS / var0 > 1e-4) { - pu = (boost::math::expint(1, u2 / (2 * (var0 + varMS))) - - boost::math::expint(1, u2 / (2 * var0))) / (2 * varMS); - } - else { - pu = exp(-u2 / (2 * var0)) / (2 * var0); - } - acceptance += pu * du2; - } - } - double u0 = fabs(theta - thetaC); - double u1 = fabs(theta + thetaC); - for (int iter = 0; iter < niter; ++iter) { - double u = u0 + (u1 - u0) * (iter + 0.5) / niter; - double u2 = u * u; - double du2 = 2 * u * (u1 - u0) / niter; - double pu; - if (varMS / var0 > 1e-4) { - pu = (boost::math::expint(1, u2 / (2 * (var0 + varMS))) - - boost::math::expint(1, u2 / (2 * var0))) / (2 * varMS); - } - else { - pu = exp(-u2 / (2 * var0)) / (2 * var0); - } - acceptance += pu * du2/dpi * - atan2(sqrt((theta2 - pow(thetaC - u, 2)) * - (pow(thetaC + u, 2) - theta2)), - theta2 - pow(thetaC, 2) + u2); - } - return acceptance; -} - -void CobremsGeneration::RotateTarget(double thetax, - double thetay, - double thetaz) -{ - // Apply a sequence of rotations to the target crystal as - // Rmatrix(out) = Rx(thx) Ry(thy) Rz(thz) Rmatrix(in) - // with rotations understood in the passive sense. - - if (thetaz != 0) { - double sint = sin(thetaz); - double cost = cos(thetaz); - for (int i=0; i < 3; ++i) { - double x = fTargetRmatrix[0][i]; - double y = fTargetRmatrix[1][i]; - fTargetRmatrix[0][i] = cost * x + sint * y; - fTargetRmatrix[1][i] = cost * y - sint * x; - } - } - if (thetay != 0) { - double sint = -sin(thetay); - double cost = cos(thetay); - for (int i=0; i < 3; ++i) { - double x = fTargetRmatrix[0][i]; - double z = fTargetRmatrix[2][i]; - fTargetRmatrix[0][i] = cost * x + sint * z; - fTargetRmatrix[2][i] = cost * z - sint * x; - } - } - if (thetax != 0) { - double sint = sin(thetax); - double cost = cos(thetax); - for (int i=0; i < 3; ++i) { - double y = fTargetRmatrix[1][i]; - double z = fTargetRmatrix[2][i]; - fTargetRmatrix[1][i] = cost * y + sint * z; - fTargetRmatrix[2][i] = cost * z - sint * y; - } - } -} - -double CobremsGeneration::Sigma2MS(double thickness_m) -{ - // Returns the mean-square multiple-scattering angle of the - // electron beam inside the radiator crystal target, in radians. - // This method wraps one of the concrete implementations, see below. - // Some formulas, although valid for a reasonable range of target - // thickness, can go negative for extremely small target thicknesses. - // Here I protect against these unusual cases by taking the absolute value. - - return fabs(Sigma2MS_Geant(thickness_m)); -} - -double CobremsGeneration::Sigma2MS_Kaune(double thickness_m) -{ - // Multiple scattering formula of Kaune et.al. - // with a correction factor from a multiple-scattering calculation - // taking into account the atomic and nuclear form factors for carbon. - // - // Note by RTJ, Oct. 13, 2008: - // I think this formula overestimates multiple scattering in thin targets - // like these diamond radiators, because it scales simply like sqrt(t). - // Although the leading behavior is sqrt(t/radlen), it should increase - // faster than that because of the 1/theta^2 tail of the Rutherford - // distribution that makes the central gaussian region swell with increasing - // number of scattering events. For comparison, I include below the PDG - // formula (sigma2MS_PDG), the Moliere formula used in the Geant3 simulation - // of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for - // thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 - // (sigma2MS_Hanson). The latter two separate the gaussian part from the - // tails in different ways, but both agree that the central part is much - // more narrow than the formulation by Kaune et.al. below. - - double carboncor = 4.2 / 4.6; - double Z = fTargetCrystal.Z; - double a = fTargetCrystal.lattice_constant; - return 8 * dpi * fTargetCrystal.nsites * pow(alpha * Z, 2) * - thickness_m * pow(hbarc / (fBeamEnergy * a), 2) / a * - log(183 * pow(Z, -1/3.)) * - carboncor; -} - -double CobremsGeneration::Sigma2MS_PDG(double thickness_m) -{ - // Evaluates the PDG formula for multiple scattering of the beam electron - // inside the target crystal, with beta=1, charge=1. This formula is said - // to be within 11% for t > 1e-3 rad.len. - - double t = thickness_m / fTargetCrystal.radiation_length; - return pow(13.6e-3 / fBeamEnergy, 2) * t * pow(1 + 0.038 * log(t), 2); -} - -double CobremsGeneration::Sigma2MS_Geant(double thickness_m) -{ - // Returns the Geant3 formula for the rms multiple-scattering angle - // This formula is based on the theory of Moliere scattering. It contains - // a cutoff parameter F that is used for the fractional integral of the - // scattering probability distribution that is included in computing the - // rms. This is needed because the complete distribution of scattering - // angles connects smoothly from a central gaussian (small-angle - // multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford - // scattering regime) through the so-called plural scattering region. - - double rBohr = 0.52917721e-10; // m - double F = 0.98; // probability cutoff in definition of sigma2MS - double Z = fTargetCrystal.Z; - double chi2cc = pow(0.39612e-2, 2) * Z * (Z + 1) * - fTargetCrystal.density / 12; // GeV^2/m - double chi2c = chi2cc * thickness_m / pow(fBeamEnergy, 2); - double chi2alpha = 1.13 * pow(hbarc / (fBeamEnergy * rBohr * 0.885), 2) * - pow(Z, 2/3.) * (1 + 3.34 * pow(alpha * Z, 2)); - double omega0 = chi2c / (1.167 * chi2alpha); // mean number of scatters - double gnu = omega0 / (2 * (1 - F)); - return chi2c / (1 + pow(F, 2)) * ((1 + gnu) / gnu * log(1 + gnu) -1); -} - -double CobremsGeneration::Sigma2MS_Hanson(double thickness_m) -{ - // Formulation of the rms projected angle attributed to Hanson et.al. - // in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere - // theory used to give the 1/e angular width of the scattering distribution. - // In the paper, though, they compare it with experiment for a variety of - // metal foils down to 1e-4 rad.len. in thickness, and show excellent - // agreement with the gaussian approximation out to 4 sigma or so. I - // like this paper because of the excellent agreement between the theory - // and experimental data. - - double Z = fTargetCrystal.Z; - double ttingcm2 = thickness_m * 100 * fTargetCrystal.density; - double EinMeV = fBeamEnergy * 1000; - double theta2max = 0.157 * Z * (Z + 1) / fTargetCrystal.A * - ttingcm2 / pow(EinMeV, 2); - double theta2screen = theta2max * fTargetCrystal.A * - (1 + 3.35 * pow(Z * alpha, 2)) / - (7800 * (Z + 1) * pow(Z, 1/3.) * ttingcm2); - double BminuslogB = log(theta2max / theta2screen) - 0.154; - double Blast = 1; - double B; - for (int i=0; i < 999; ++i) { - B = BminuslogB + log(Blast); - if (B < 1.2) { - B = 1.21; - break; - } - else if (fabs(B - Blast) > 1e-6) { - Blast = B; - } - else { - break; - } - } - return theta2max * (B - 1.2) / 2; -} - -#ifdef BOOST_PYTHON_WRAPPING - -void CobremsGeneration::pyApplyBeamCrystalConvolution(int nbins, pyobject xarr, - pyobject yarr) -{ - using boost::python::extract; - typedef boost::python::tuple pytuple; - pytuple xtuple = extract(xarr.attr("buffer_info")()); - pytuple ytuple = extract(yarr.attr("buffer_info")()); - double *xbuf = reinterpret_cast((int)extract(xtuple[0])); - double *ybuf = reinterpret_cast((int)extract(ytuple[0])); - applyBeamCrystalConvolution(nbins, xbuf, ybuf); -} - -double (CobremsGeneration::*Rate_dNtdx_1)(double) = &CobremsGeneration::Rate_dNtdx; -double (CobremsGeneration::*Rate_dNtdx_3)(double, double, double) = &CobremsGeneration::Rate_dNtdx; -double (CobremsGeneration::*Rate_dNcdx_1)(double) = &CobremsGeneration::Rate_dNcdx; -double (CobremsGeneration::*Rate_dNcdx_3)(double, double, double) = &CobremsGeneration::Rate_dNcdx; -double (CobremsGeneration::*Acceptance_1)(double) = &CobremsGeneration::Acceptance; -double (CobremsGeneration::*Acceptance_4)(double, double, double, double) = &CobremsGeneration::Acceptance; -double (CobremsGeneration::*Polarization_2)(double, double) = &CobremsGeneration::Polarization; -double (CobremsGeneration::*Polarization_3)(double, double, double) = &CobremsGeneration::Polarization; - -BOOST_PYTHON_MODULE(libcobrems) -{ - using boost::python::class_; - using boost::python::enum_; - using boost::python::def; - - class_ - ("CobremsGeneration", - "coherent bremsstrahlung spectrum and polarization calculator, " - "with methods for generating random Monte Carlo samples", - boost::python::init()) - .def("setBeamEnergy", &CobremsGeneration::setBeamEnergy) - .def("setBeamErms", &CobremsGeneration::setBeamErms) - .def("setBeamEmittance", &CobremsGeneration::setBeamEmittance) - .def("setCollimatorSpotrms", &CobremsGeneration::setCollimatorSpotrms) - .def("setCollimatorDistance", &CobremsGeneration::setCollimatorDistance) - .def("setCollimatorDiameter", &CobremsGeneration::setCollimatorDiameter) - .def("setTargetThickness", &CobremsGeneration::setTargetThickness) - .def("setTargetCrystal", &CobremsGeneration::setTargetCrystal) - .def("setCoherentEdge", &CobremsGeneration::setCoherentEdge) - .def("setTargetThetax", &CobremsGeneration::setTargetThetax) - .def("setTargetThetay", &CobremsGeneration::setTargetThetay) - .def("setTargetThetaz", &CobremsGeneration::setTargetThetaz) - .def("setTargetOrientation", &CobremsGeneration::setTargetOrientation) - .def("RotateTarget", &CobremsGeneration::RotateTarget) - .def("getBeamEnergy", &CobremsGeneration::getBeamEnergy) - .def("getBeamErms", &CobremsGeneration::getBeamErms) - .def("getBeamEmittance", &CobremsGeneration::getBeamEmittance) - .def("getCollimatorSpotrms", &CobremsGeneration::getCollimatorSpotrms) - .def("getCollimatorDistance", &CobremsGeneration::getCollimatorDistance) - .def("getCollimatorDiameter", &CobremsGeneration::getCollimatorDiameter) - .def("getTargetThickness", &CobremsGeneration::getTargetThickness) - .def("getTargetCrystal", &CobremsGeneration::getTargetCrystal) - .def("getTargetCrystalNsites", &CobremsGeneration::getTargetCrystalNsites) - .def("getTargetCrystalAtomicNumber", &CobremsGeneration::getTargetCrystalAtomicNumber) - .def("getTargetCrystalAtomicWeight", &CobremsGeneration::getTargetCrystalAtomicWeight) - .def("getTargetCrystalDensity", &CobremsGeneration::getTargetCrystalDensity) - .def("getTargetCrystalLatticeConstant", &CobremsGeneration::getTargetCrystalLatticeConstant) - .def("getTargetCrystalRadiationLength", &CobremsGeneration::getTargetCrystalRadiationLength) - .def("getTargetCrystalDebyeWallerConst", &CobremsGeneration::getTargetCrystalDebyeWallerConst) - .def("getTargetCrystalMosaicSpread", &CobremsGeneration::getTargetCrystalMosaicSpread) - .def("getTargetCrystalBetaFF", &CobremsGeneration::getTargetCrystalBetaFF) - .def("getTargetThetax", &CobremsGeneration::getTargetThetax) - .def("getTargetThetay", &CobremsGeneration::getTargetThetay) - .def("getTargetThetaz", &CobremsGeneration::getTargetThetaz) - .def("getTargetRadiationLength_PDG", &CobremsGeneration::getTargetRadiationLength_PDG) - .def("getTargetRadiationLength_Schiff", &CobremsGeneration::getTargetRadiationLength_Schiff) - .def("getTargetDebyeWallerConstant", &CobremsGeneration::getTargetDebyeWallerConstant) - .def("getCollimatedFlag", &CobremsGeneration::getCollimatedFlag) - .def("setCollimatedFlag", &CobremsGeneration::setCollimatedFlag) - .def("getPolarizedFlag", &CobremsGeneration::getPolarizedFlag) - .def("setPolarizedFlag", &CobremsGeneration::setPolarizedFlag) - .def("applyBeamCrystalConvolution", &CobremsGeneration::pyApplyBeamCrystalConvolution) - .def("printBeamlineInfo", &CobremsGeneration::printBeamlineInfo) - .def("printTargetCrystalInfo", &CobremsGeneration::printTargetCrystalInfo) - .def("CoherentEnhancement", &CobremsGeneration::CoherentEnhancement) - .def("Rate_dNtdx", Rate_dNtdx_1) - .def("Rate_dNtdx", Rate_dNtdx_3) - .def("Rate_dNtdk", &CobremsGeneration::Rate_dNtdk) - .def("Rate_dNcdx", Rate_dNcdx_1) - .def("Rate_dNcdx", Rate_dNcdx_3) - .def("Rate_dNcdxdp", &CobremsGeneration::Rate_dNcdxdp) - .def("Rate_dNidx", &CobremsGeneration::Rate_dNidx) - .def("Rate_dNBidx", &CobremsGeneration::Rate_dNBidx) - .def("Rate_dNidxdt2", &CobremsGeneration::Rate_dNidxdt2) - .def("Rate_para", &CobremsGeneration::Rate_para) - .def("Rate_ortho", &CobremsGeneration::Rate_ortho) - .def("Polarization", Polarization_2) - .def("Polarization", Polarization_3) - .def("Acceptance", Acceptance_1) - .def("Acceptance", Acceptance_4) - .def("Sigma2MS", &CobremsGeneration::Sigma2MS) - .def("Sigma2MS_Kaune", &CobremsGeneration::Sigma2MS_Kaune) - .def("Sigma2MS_PDG", &CobremsGeneration::Sigma2MS_PDG) - .def("Sigma2MS_Geant", &CobremsGeneration::Sigma2MS_Geant) - .def("Sigma2MS_Hanson", &CobremsGeneration::Sigma2MS_Hanson) - .def_readonly("dpi", &CobremsGeneration::dpi) - .def_readonly("me", &CobremsGeneration::me) - .def_readonly("alpha", &CobremsGeneration::alpha) - .def_readonly("hbarc", &CobremsGeneration::hbarc) - ; -} - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.hh b/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.hh deleted file mode 100644 index 75f101fb96..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/CobremsGeneration.hh +++ /dev/null @@ -1,309 +0,0 @@ -// -// CobremsGeneration class header -// -// author: richard.t.jones at uconn.edu -// version: july 27, 2015 -// -// notes: -// -// This class computes differential rates and polarization factors -// for coherent bremsstrahlung by an electron beam passing through -// a crystal radiator. A beamline geometry similar to that in Hall D -// at Jefferson Lab is assumed, consisting of a single radiator -// followed by a collimator located some distance away. Rates are -// computed for both the pre-collimated and post-collimated beams. -// -// This code was ported from cobrems.f, written in Fortran 77. -// -// units: -// Any length is in m; energy,momentum,mass in GeV (c=1); angles in -// radians; time in seconds; current in microAmps. - -#ifndef CobremsGeneration_h -#define CobremsGeneration_h 1 - -#include -#include - -#if BOOST_PYTHON_WRAPPING -#include -#endif - -class CobremsGeneration { - public: - CobremsGeneration(double Emax_GeV, double Epeak_GeV); - CobremsGeneration(const CobremsGeneration &src); - CobremsGeneration &operator=(const CobremsGeneration &src); - ~CobremsGeneration(); - - void setBeamEnergy(double Ebeam_GeV); - void setBeamErms(double Erms_GeV); - void setBeamEmittance(double emit_m_r); - void setCollimatorSpotrms(double spotrms_m); - void setCollimatorDistance(double distance_m); - void setCollimatorDiameter(double diameter_m); - void setTargetThickness(double thickness_m); - void setTargetCrystal(std::string crystal); - void setCoherentEdge(double Epeak_GeV); - void setTargetThetax(double thetax); - void setTargetThetay(double thetay); - void setTargetThetaz(double thetaz); - void setTargetOrientation(double thetax, double thetay, double thetaz); - void setPhotonEnergyMin(double Emin_GeV); - void RotateTarget(double thetax, double thetay, double thetaz); - void setCollimatedFlag(bool flag); - void setPolarizedFlag(bool flag); - - double getBeamEnergy() { - return fBeamEnergy; // (GeV) - } - double getBeamErms() { - return fBeamErms; // (GeV) - } - double getBeamEmittance() { - return fBeamEmittance; // (m rad) - } - double getCollimatorSpotrms() { - return fCollimatorSpotrms; // (m) - } - double getCollimatorDistance() { - return fCollimatorDistance; // (m) - } - double getCollimatorDiameter() { - return fCollimatorDiameter; // (m) - } - double getTargetThickness() { - return fTargetThickness; // (m) - } - std::string getTargetCrystal() { - return fTargetCrystal.name; - } - int getTargetCrystalNsites() { - return fTargetCrystal.nsites; - } - double getTargetCrystalAtomicNumber() { - return fTargetCrystal.Z; - } - double getTargetCrystalAtomicWeight() { - return fTargetCrystal.A; // (amu) - } - double getTargetCrystalDensity() { - return fTargetCrystal.density; // (g/cm^3) - } - double getTargetCrystalLatticeConstant() { - return fTargetCrystal.lattice_constant; // (m) - } - double getTargetCrystalRadiationLength() { - return fTargetCrystal.radiation_length; // (m) - } - double getTargetCrystalDebyeWallerConst() { - return fTargetCrystal.Debye_Waller_const; // (1/GeV^2) - } - double getTargetCrystalMosaicSpread() { - return fTargetCrystal.mosaic_spread; // (rad) - } - double getTargetCrystalBetaFF() { - return fTargetCrystal.betaFF; // (1/GeV^2) - } - double getTargetThetax() { - return fTargetThetax; // (rad) - } - double getTargetThetay() { - return fTargetThetay; // (rad) - } - double getTargetThetaz() { - return fTargetThetaz; // (rad) - } - double getPhotonEnergyMin() { - return fPhotonEnergyMin; // (GeV) - } - bool getCollimatedFlag() { - return fCollimatedFlag; - } - bool getPolarizedFlag() { - return fPolarizedFlag; - } - - double getTargetRadiationLength_PDG(); - double getTargetRadiationLength_Schiff(); - double getTargetDebyeWallerConstant(double DebyeT_K, double T_K); - void applyBeamCrystalConvolution(int nbins, double *xvalues, - double *yvalues); -#if BOOST_PYTHON_WRAPPING - typedef boost::python::object pyobject; - void pyApplyBeamCrystalConvolution(int nbins, pyobject xarr, pyobject yarr); -#endif - void printBeamlineInfo(); - void printTargetCrystalInfo(); - double CoherentEnhancement(double x); - double Rate_dNtdx(double x); - double Rate_dNtdx(double x, double distance_m, double diameter_m); - double Rate_dNtdk(double k_GeV); - double Rate_dNcdx(double x); - double Rate_dNcdx(double x, double distance_m, double diameter_m); - double Rate_dNcdxdp(double x, double phi); - double Rate_dNidx(double x); - double Rate_dNBidx(double x); - double Rate_dNidxdt2(double x, double theta2); - double Rate_para(double x, double theta2, double phi); - double Rate_ortho(double x, double theta2, double phi); - double Polarization(double x, double theta2); - double Polarization(double x, double theta2, double phi); - double AbremsPolarization(double x, double theta2, double phi); - double Acceptance(double theta2, double phi, - double xshift_m, double yshift_m); - double Acceptance(double theta2); - double Sigma2MS(double thickness_m); - double Sigma2MS_Kaune(double thickness_m); - double Sigma2MS_PDG(double thickness_m); - double Sigma2MS_Geant(double thickness_m); - double Sigma2MS_Hanson(double thickness_m); - - // some math and physical constants - static const double dpi; - static const double me; - static const double alpha; - static const double hbarc; - - // statistical record from last sum over reciprocal lattice - std::vector fQ2theta2; - std::vector fQ2weight; - - private: - void resetTargetOrientation(); - void updateTargetOrientation(); - - // description of the radiator crystal lattice, here configured for diamond - // but may be customized to describe any regular crystal - struct lattice_vector { - double x; - double y; - double z; - lattice_vector() - : x(0), y(0), z(0) {} - lattice_vector(double ux, double uy, double uz) - : x(ux), y(uy), z(uz) {} - lattice_vector(const lattice_vector &src) - : x(src.x), y(src.y), z(src.z) {} - lattice_vector &operator=(const lattice_vector &src) { - x = src.x; - y = src.y; - z = src.z; - return *this; - } - }; - struct crystal_parameters_t { - std::string name; - int nsites; - double Z; - double A; // amu - double density; // g/cm^3 - double lattice_constant; // m - double radiation_length; // m - double Debye_Waller_const; // 1/GeV^2 - double mosaic_spread; // rms radians - double betaFF; // 1/GeV^2 - std::vector ucell_site; - lattice_vector primaryHKL; - } fTargetCrystal; - double fTargetThickness; - - // orientation of the radiator with respect to the beam axis - double fTargetThetax; // the "small" angle - double fTargetThetay; // the "large" angle - double fTargetThetaz; - double fTargetRmatrix[3][3]; - - // description of the beam at the radiator - double fBeamEnergy; // GeV - double fBeamErms; // GeV - double fBeamEmittance; // m radians - double fCollimatorSpotrms; // m - double fCollimatorDistance; // m - double fCollimatorDiameter; // m - - // flags to select kind of flux to be computed - bool fCollimatedFlag; - bool fPolarizedFlag; - - // parameters controlling Monte Carlo generation of photons - double fPhotonEnergyMin; // GeV -}; - -inline void CobremsGeneration::setBeamEmittance(double emit_m_r) { - fBeamEmittance = emit_m_r; -} - -inline void CobremsGeneration::setBeamEnergy(double Ebeam_GeV) { - fBeamEnergy = Ebeam_GeV; -} - -inline void CobremsGeneration::setBeamErms(double Erms_GeV) { - fBeamErms = Erms_GeV; -} - -inline void CobremsGeneration::setCollimatorSpotrms(double spotrms_m) { - fCollimatorSpotrms = spotrms_m; -} - -inline void CobremsGeneration::setCollimatorDistance(double distance_m) { - fCollimatorDistance = distance_m; -} - -inline void CobremsGeneration::setCollimatorDiameter(double diameter_m) { - fCollimatorDiameter = diameter_m; -} - -inline void CobremsGeneration::setTargetThickness(double thickness_m) { - fTargetThickness = thickness_m; -} - -inline void CobremsGeneration::setTargetThetax(double thetax) { - fTargetThetax = thetax; - updateTargetOrientation(); -} - -inline void CobremsGeneration::setTargetThetay(double thetay) { - fTargetThetay = thetay; - updateTargetOrientation(); -} - -inline void CobremsGeneration::setTargetThetaz(double thetaz) { - fTargetThetaz = thetaz; - updateTargetOrientation(); -} - -inline void CobremsGeneration::setTargetOrientation(double thetax, - double thetay, - double thetaz) { - fTargetThetax = thetax; - fTargetThetay = thetay; - fTargetThetaz = thetaz; - updateTargetOrientation(); -} - -inline void CobremsGeneration::setPhotonEnergyMin(double Emin_GeV) { - fPhotonEnergyMin = Emin_GeV; -} - -inline void CobremsGeneration::setCollimatedFlag(bool flag) { - fCollimatedFlag = flag; -} - -inline void CobremsGeneration::setPolarizedFlag(bool flag) { - fPolarizedFlag = flag; -} - -inline void CobremsGeneration::resetTargetOrientation() { - fTargetRmatrix[0][0] = 1; - fTargetRmatrix[0][1] = 0; - fTargetRmatrix[0][2] = 0; - fTargetRmatrix[1][0] = 0; - fTargetRmatrix[1][1] = 1; - fTargetRmatrix[1][2] = 0; - fTargetRmatrix[2][0] = 0; - fTargetRmatrix[2][1] = 0; - fTargetRmatrix[2][2] = 1; -} - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.cc b/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.cc deleted file mode 100644 index 8b55045bf8..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.cc +++ /dev/null @@ -1,99 +0,0 @@ - -#include -#include -#include - -#include "AMPTOOLS_MCGEN/DalitzDecayFactory.h" - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -const double DalitzDecayFactory::kPi = 3.14159; - -DalitzDecayFactory::DalitzDecayFactory( double parentMass, const vector& childMass ) : -m_parentMass( parentMass ), -m_childMass( childMass ) -{ - - // for the decay X -> 0 1 2, the max momentum of 2 in X RF is - // m_X / 2, and max momentum of 0 in 01 RF is near m_X / 2 also - - m_maxLorentzFactor = 0.25 * m_parentMass * m_parentMass; - - assert( childMass.size() == 3 ); -} - - -vector -DalitzDecayFactory::generateDecay() const { - - vector child( 3 ); - vector childMom( 3 ); - - // create some useful temporary variables - TLorentzVector isobar; - TVector3 isobarMom; - double isobarMass; - - do{ - - // generate the mass of the isobar ( 01 --> 0 1 ) - isobarMass = random( ( m_childMass[0] + m_childMass[1] ), - ( m_parentMass - m_childMass[2] ) ); - - // let the X decay to isobar + 2 in the X CM - // fill the isobar momentum vector and the bachelor momentum vector - isobarMom. - SetMagThetaPhi( cmMomentum( m_parentMass, isobarMass, m_childMass[2] ), - acos( random( -0.999999, 0.999999 ) ), - random( -kPi, kPi ) ); - childMom[2] = -isobarMom; - - // setup the isobar 4 vector - isobar.SetVect( isobarMom ); - isobar.SetE( sqrt( isobarMom.Mag2() + isobarMass * isobarMass ) ); - - // let the isobar decay to 0 1 in the isobar CM - childMom[0]. - SetMagThetaPhi( cmMomentum( isobarMass, m_childMass[0], m_childMass[1] ), - acos( random( -0.999999, 0.999999 ) ), - random( -kPi, kPi ) ); - childMom[1] = -childMom[0]; - - // now we have childMom[0] and childMom[1] in the isobar rest frame - // and childMom[2] in the resonance rest frame - } - while( ( childMom[0].Mag() * isobarMom.Mag() ) < - random( 0.0, m_maxLorentzFactor ) ); - - // fill the final four-vectors - for( int i = 0; i < 3; ++i ){ - - child[i].SetVect( childMom[i] ); - child[i].SetE( sqrt( childMom[i].Mag2() + - m_childMass[i] * m_childMass[i] ) ); - } - - // boost the isobar children to the resonance rest frame - child[0].Boost( isobar.BoostVector() ); - child[1].Boost( isobar.BoostVector() ); - - return child; -} - -double -DalitzDecayFactory::cmMomentum( double M, double m1, double m2 ) const { - - // mini PDG Eq: 38.16 - - double num1 = ( M * M - ( m1 + m2 ) * ( m1 + m2 ) ); - double num2 = ( M * M - ( m1 - m2 ) * ( m1 - m2 ) ); - - return( sqrt( num1 * num2 ) / ( 2 * M ) ); -} - -double -DalitzDecayFactory::random( double low, double hi ) const { - - return( ( hi - low ) * drand48() + low ); -} diff --git a/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.h b/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.h deleted file mode 100644 index 57287cea2c..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/DalitzDecayFactory.h +++ /dev/null @@ -1,32 +0,0 @@ -#if !defined(DALITZDECAYFACTORY) -#define DALITZDECAYFACTORY - -#include - -#include "TLorentzVector.h" - -using namespace std; - -class DalitzDecayFactory -{ - -public: - - DalitzDecayFactory( double parentMass, const vector& childMass ); - - vector generateDecay() const; - -private: - - static const double kPi; - - double cmMomentum( double M, double m1, double m2 ) const; - double random( double low, double hi ) const; - - double m_parentMass; - vector m_childMass; - - double m_maxLorentzFactor; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.cc b/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.cc deleted file mode 100644 index 066cc41000..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.cc +++ /dev/null @@ -1,103 +0,0 @@ - -#include -#include -#include -#include - -#include "AMPTOOLS_MCGEN/DecayChannelGenerator.h" - -DecayChannelGenerator::DecayChannelGenerator() : -m_bfTotal( 0 ), -m_upperBound( 0 ), -m_index( 0 ), -m_probRenormalized( false ) -{} - -using namespace std; - -void -DecayChannelGenerator::addChannel( unsigned int channel, double bf ) -{ - - m_bfTotal += bf; - - m_index.push_back( channel ); - m_prob.push_back( bf ); - m_upperBound.push_back( m_bfTotal ); - - if( m_probRenormalized ){ - - cout << "ERROR: channels cannot be added after BF normalization!" - << endl; - - assert( false ); - } -} - -unsigned int -DecayChannelGenerator::operator()(){ - - if( fabs( m_bfTotal - 1 ) > 0.001 ){ - - cout << "WARNING: sum of branching fractions: " << m_bfTotal - << "\n\t is not within .1% of 1 -- renormalizing" << endl; - - for( vector< double >::iterator val = m_upperBound.begin(); - val != m_upperBound.end(); - ++val ){ - - (*val) /= m_bfTotal; - } - - for( vector< double >::iterator val = m_prob.begin(); - val != m_prob.end(); - ++val ){ - - (*val) /= m_bfTotal; - } - - m_bfTotal = 1; - m_probRenormalized = true; - } - - double rand = drand48(); - for( unsigned int i = 0; i < m_upperBound.size(); ++i ){ - - if( rand < m_upperBound[i] ){ - - return m_index[i]; - } - } - - return m_index[m_index.size()-1]; -} - -double -DecayChannelGenerator::getProb( unsigned int chan ){ - - if( fabs( m_bfTotal - 1 ) > 0.001 ){ - - cout << "WARNING: sum of branching fractions: " << m_bfTotal - << "\n\t is not within .1% of 1 -- renormalizing" << endl; - - for( vector< double >::iterator val = m_upperBound.begin(); - val != m_upperBound.end(); - ++val ){ - - (*val) /= m_bfTotal; - } - - for( vector< double >::iterator val = m_prob.begin(); - val != m_prob.end(); - ++val ){ - - (*val) /= m_bfTotal; - } - - m_bfTotal = 1; - m_probRenormalized = true; - } - - return m_prob.at( chan ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.h b/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.h deleted file mode 100644 index 5e1d5a27f4..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/DecayChannelGenerator.h +++ /dev/null @@ -1,32 +0,0 @@ -#if !defined(DECAYCHANNELGENERATOR) -#define DECAYCHANNELGENERATOR - -#include - -using namespace std; - -class DecayChannelGenerator { - -public: - - DecayChannelGenerator(); - - void addChannel( unsigned int channelNum, double bf ); - unsigned int operator()(); - - const vector< unsigned int >& availableChannels() const { return m_index; } - - double getProb( unsigned int channelNum ); - -private: - - double m_bfTotal; - - vector< double > m_upperBound; - vector< double > m_prob; - vector< unsigned int > m_index; - - bool m_probRenormalized; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.cc b/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.cc deleted file mode 100644 index 6628564c09..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.cc +++ /dev/null @@ -1,120 +0,0 @@ -/* - * GammaPToNPartP.h - * by Igor Senderovich - * structure based on GammaToXYZP - * written by Matthew Shepherd - */ - -#include "GammaPToNPartP.h" -#include "particleType.h" -#include "AMPTOOLS_MCGEN/DalitzDecayFactory.h" -#include "TGenPhaseSpace.h" -#include "NBodyPhaseSpaceFactory.h" -#include "TLorentzVector.h" -#include "IUAmpTools/Kinematics.h" - -#include - -GammaPToNPartP::GammaPToNPartP( float lowMass, float highMass, - vector &ChildMass, - float beamMaxE, float beamPeakE, float beamLowE, float beamHighE, - ProductionMechanism::Type type, float slope, int seed ) : -m_prodMech( ProductionMechanism::kProton, type, slope, seed ), -m_target( 0, 0, 0, ParticleMass(Proton) ), -m_ChildMass(ChildMass) -{ - m_Npart = ChildMass.size(); - assert(m_Npart>0); - - m_prodMech.setMassRange( lowMass, highMass ); - - // Initialize coherent brem table - float Emax = beamMaxE; - float Epeak = beamPeakE; - float Elow = beamLowE; - float Ehigh = beamHighE; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - cobrem_vs_E = new TH1D("cobrem_vs_E", "Coherent Bremstrahlung vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill histogram - for(int i=1; i<=cobrem_vs_E->GetNbinsX(); i++){ - double x = cobrem_vs_E->GetBinCenter(i)/Emax; - double y = 0; - if(EpeakSetBinContent(i, y); - } - -} - -/** - * The function generates a N particle final - * state event consistent with N-body phase space. - * (No intermediate resonances are used for important sampling.) - */ -Kinematics* -GammaPToNPartP::generate(){ - - double beamE = cobrem_vs_E->GetRandom(); - m_beam.SetPxPyPzE(0,0,beamE,beamE); - - TLorentzVector resonance; - do{ - resonance=m_prodMech.produceResonance( m_beam ); - }while(!(resonance.E() < m_beam.E())); - - - //TLorentzVector tresonance(resonance.px(),resonance.py(), - // resonance.pz(),resonance.e()); - double genWeight = m_prodMech.getLastGeneratedWeight(); - - vector< TLorentzVector > allPart; - allPart.push_back( m_beam ); - allPart.push_back( m_beam + m_target - resonance ); - - // X decay phase space - /*TGenPhaseSpace Xdecay; - Xdecay.SetDecay(tresonance, m_Npart, m_ChildMass); - genWeight *= Xdecay.Generate(); - */ - - NBodyPhaseSpaceFactory psFactory(resonance.M(),m_ChildMass); - vector< TLorentzVector > children = psFactory.generateDecay(false); - genWeight *= psFactory.getLastGeneratedWeight(); - - TVector3 b3(resonance.BoostVector()); // boost vector from parent - for (unsigned int n=0; nPx(),tPart->Py(),tPart->Pz(),tPart->Energy()); - allPart.push_back(Part); - }*/ - - return new Kinematics( allPart, genWeight ); -} - -void -GammaPToNPartP::addResonance( float mass, float width, float bf ){ - - m_prodMech.addResonance( mass, width, bf ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.h b/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.h deleted file mode 100644 index 6e0ea29ce0..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToNPartP.h +++ /dev/null @@ -1,43 +0,0 @@ -#if !defined(GAMMAPTONPARTP) -#define GAMMAPTONPARTP - -/* - * GammaPToNPartP.h - * by Igor Senderovich - * structure based on GammaToXYZP - * written by Matthew Shepherd - */ - -#include "TLorentzVector.h" -#include "TH1.h" -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" - -class Kinematics; - -class GammaPToNPartP { - -public: - - GammaPToNPartP( float lowMass, float highMass, - vector &ChildMass, - float beamMaxE, float beamPeakE, float beamLowE, float beamHigh, ProductionMechanism::Type type, float slope = 6.0, int seed = 0 ); - - Kinematics* generate(); - - void addResonance( float mass, float width, float bf ); - -private: - - ProductionMechanism m_prodMech; - - TLorentzVector m_beam; - TLorentzVector m_target; - - //double m_ChildMass[12]; - vector m_ChildMass; - unsigned int m_Npart; - - TH1D *cobrem_vs_E; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.cc b/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.cc deleted file mode 100644 index ea0da4211e..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.cc +++ /dev/null @@ -1,89 +0,0 @@ -/* - * GammaPToXP.cc - * GlueXTools - * - * Created by Matthew Shepherd on 1/22/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/GammaPToXP.h" - -#include - -GammaPToXP::GammaPToXP( float massX, float beamMaxE, float beamPeakE, float beamLowE, float beamHighE) : -m_target( 0, 0, 0, 0.938 ), -m_childMass( 0 ) { - - m_childMass.push_back( massX ); - - // Initialize coherent brem table - float Emax = beamMaxE; - float Epeak = beamPeakE; - float Elow = beamLowE; - float Ehigh = beamHighE; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - cobrem_vs_E = new TH1D("cobrem_vs_E", "Coherent Bremstrahlung vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill histogram - for(int i=1; i<=cobrem_vs_E->GetNbinsX(); i++){ - double x = cobrem_vs_E->GetBinCenter(i)/Emax; - double y = 0; - if(EpeakSetBinContent(i, y); - } - -} - -Kinematics* -GammaPToXP::generate(){ - - double beamE = cobrem_vs_E->GetRandom(); - m_beam.SetPxPyPzE(0,0,beamE,beamE); - TLorentzVector cm = m_beam + m_target; - - Double_t masses[2] = {0.938,m_childMass[0]}; - TGenPhaseSpace phsp; - phsp.SetDecay(cm,2,masses); - - double phsp_wt_max = phsp.GetWtMax(); - double genWeight; - do { - genWeight = phsp.Generate(); - } - while( random(0., phsp_wt_max) >= genWeight || genWeight != genWeight); - - TLorentzVector *recoil = phsp.GetDecay(0); - TLorentzVector *pX = phsp.GetDecay(1); - - vector< TLorentzVector > allPart; - allPart.push_back( m_beam ); - allPart.push_back( *recoil ); - allPart.push_back( *pX ); - - return new Kinematics( allPart, genWeight ); -} - -double -GammaPToXP::random( double low, double hi ) const { - - return( ( hi - low ) * drand48() + low ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.h b/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.h deleted file mode 100644 index 94d062aeda..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXP.h +++ /dev/null @@ -1,42 +0,0 @@ -#if !defined(GAMMAPTOXP) -#define GAMMAPTOXP - -/* - * GammaPToXP.h - * GlueXTools - * - * Created by Matthew Shepherd on 1/22/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "TLorentzVector.h" -#include "TGenPhaseSpace.h" -#include "TH1.h" - -#include "IUAmpTools/Kinematics.h" - -class Kinematics; - -class GammaPToXP { - -public: - - GammaPToXP( float massX, float beamMaxE, float beamPeakE, float beamLowE, float beamHighE); - - Kinematics* generate(); - -private: - - TLorentzVector m_beam; - TLorentzVector m_target; - - vector< double > m_childMass; - - TH1D *cobrem_vs_E; - - double random( double low, double hi ) const; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.cc b/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.cc deleted file mode 100644 index ede29b146c..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.cc +++ /dev/null @@ -1,96 +0,0 @@ -/* - * GammaPToXYP.cc - * GlueXTools - * - * Created by Matthew Shepherd on 1/22/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/GammaPToXYP.h" -#include "AMPTOOLS_MCGEN/TwoBodyDecayFactory.h" - -#include "IUAmpTools/Kinematics.h" - -#include - -GammaPToXYP::GammaPToXYP( float lowMassXY, float highMassXY, - float massX, float massY, float beamMaxE, float beamPeakE, float beamLowE, float beamHighE, - ProductionMechanism::Type type, float slope, int seed ) : -m_prodMech( ProductionMechanism::kProton, type, slope, seed ), -m_target( 0, 0, 0, 0.938272 ), -m_childMass( 0 ) { - - m_childMass.push_back( massX ); - m_childMass.push_back( massY ); - - m_prodMech.setMassRange( lowMassXY, highMassXY ); - - // Initialize coherent brem table - float Emax = beamMaxE; - float Epeak = beamPeakE; - float Elow = beamLowE; - float Ehigh = beamHighE; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - cobrem_vs_E = new TH1D("cobrem_vs_E", "Coherent Bremstrahlung vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill histogram - for(int i=1; i<=cobrem_vs_E->GetNbinsX(); i++){ - double x = cobrem_vs_E->GetBinCenter(i)/Emax; - double y = 0; - if(EpeakSetBinContent(i, y); - } - -} - -Kinematics* -GammaPToXYP::generate(){ - - double beamE = cobrem_vs_E->GetRandom(); - m_beam.SetPxPyPzE(0,0,beamE,beamE); - - TLorentzVector resonance = m_prodMech.produceResonance( m_beam ); - double genWeight = m_prodMech.getLastGeneratedWeight(); - - vector< TLorentzVector > allPart; - allPart.push_back( m_beam ); - allPart.push_back( m_beam + m_target - resonance ); - - TwoBodyDecayFactory decay( resonance.M(), m_childMass ); - - vector fsPart = decay.generateDecay(); - - for( vector::iterator aPart = fsPart.begin(); - aPart != fsPart.end(); ++aPart ){ - - aPart->Boost( resonance.BoostVector() ); - allPart.push_back( *aPart ); - } - - return new Kinematics( allPart, genWeight ); -} - -void -GammaPToXYP::addResonance( float mass, float width, float bf ){ - - m_prodMech.addResonance( mass, width, bf ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.h b/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.h deleted file mode 100644 index 3675711d2a..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYP.h +++ /dev/null @@ -1,44 +0,0 @@ -#if !defined(GAMMAPTOXYP) -#define GAMMAPTOXYP - -/* - * GammaPToXYP.h - * GlueXTools - * - * Created by Matthew Shepherd on 1/22/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "TH1.h" - -class Kinematics; - -class GammaPToXYP { - -public: - - GammaPToXYP( float lowMassXY, float highMassXY, float massX, float massY, - float beamMaxE, float beamPeakE, float beamLowE, float beamHigh, ProductionMechanism::Type type, float slope = 6.0, int seed = 0 ); - - Kinematics* generate(); - - void addResonance( float mass, float width, float bf ); - -private: - - ProductionMechanism m_prodMech; - - TLorentzVector m_beam; - TLorentzVector m_target; - - vector< double > m_childMass; - - TH1D *cobrem_vs_E; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.cc b/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.cc deleted file mode 100644 index 77ed3ca71c..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.cc +++ /dev/null @@ -1,96 +0,0 @@ -/* - * GammaPToXYZP.cc - * GlueXTools - * - * Created by Matthew Shepherd on 5/25/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "GammaPToXYZP.h" -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/DalitzDecayFactory.h" -#include "IUAmpTools/Kinematics.h" - -#include - -GammaPToXYZP::GammaPToXYZP( float lowMassXYZ, float highMassXYZ, - float massX, float massY, float massZ, - ProductionMechanism::Type type, - float beamMaxE = 12.0, float beamPeakE = 9.0, float beamLowE = 7.0, float beamHighE = 12.0) : - m_prodMech( ProductionMechanism::kProton, type, 7.5 ), // last arg is t dependence - m_target( 0, 0, 0, 0.938 ), - m_childMass( 0 ) -{ - - m_childMass.push_back( massX ); - m_childMass.push_back( massY ); - m_childMass.push_back( massZ ); - - m_prodMech.setMassRange( lowMassXYZ, highMassXYZ ); - // Initialize coherent brem table - float Emax = beamMaxE; - float Epeak = beamPeakE; - float Elow = beamLowE; - float Ehigh = beamHighE; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - cobrem_vs_E = new TH1D("cobrem_vs_E", "Coherent Bremstrahlung vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill histogram - for(int i=1; i<=cobrem_vs_E->GetNbinsX(); i++){ - double x = cobrem_vs_E->GetBinCenter(i)/Emax; - double y = 0; - if(EpeakSetBinContent(i, y); - } -} - -Kinematics* -GammaPToXYZP::generate(){ - - double beamE = cobrem_vs_E->GetRandom(); - m_beam.SetPxPyPzE(0,0,beamE,beamE); - - TLorentzVector resonance = m_prodMech.produceResonance( m_beam ); - double genWeight = m_prodMech.getLastGeneratedWeight(); - - vector< TLorentzVector > allPart; - allPart.push_back( m_beam ); - allPart.push_back( m_beam + m_target - resonance ); - - DalitzDecayFactory decay( resonance.M(), m_childMass ); - - vector fsPart = decay.generateDecay(); - - for( vector::iterator aPart = fsPart.begin(); - aPart != fsPart.end(); ++aPart ){ - - aPart->Boost( resonance.BoostVector() ); - allPart.push_back( *aPart ); - } - - return new Kinematics( allPart, genWeight ); -} - -void -GammaPToXYZP::addResonance( float mass, float width, float bf ){ - - m_prodMech.addResonance( mass, width, bf ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.h b/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.h deleted file mode 100644 index 1f939ef37c..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaPToXYZP.h +++ /dev/null @@ -1,48 +0,0 @@ -#if !defined(GAMMAPTOXYZP) -#define GAMMAPTOXYZP - -/* - * GammaPToXYZP.h - * GlueXTools - * - * Created by Matthew Shepherd on 5/25/10. - * Copyright 2010 Home. All rights reserved. - * - */ - -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" - -#include "TH1D.h" - -class Kinematics; - -class GammaPToXYZP { - -public: - - GammaPToXYZP( float lowMassXYZ, float highMassXYZ, - float massX, float massY, float massZ, - ProductionMechanism::Type type, - float beamMaxE, float beamPeakE, float beamLowE, float beamHighE ); - - Kinematics* generate(); -// AmpVecs* generateMany( int nEvents ); - - void addResonance( float mass, float width, float bf ); - -private: - - ProductionMechanism m_prodMech; - - TLorentzVector m_beam; - TLorentzVector m_target; - - vector< double > m_childMass; - - TH1D *cobrem_vs_E; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.cc b/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.cc deleted file mode 100644 index 512fc6e5cb..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.cc +++ /dev/null @@ -1,101 +0,0 @@ -/* - * GammaZToXYZ.cc - * GlueXTools - * - * Modified GammaPToXYP.cc, replacing proton with heavy Z target - * Elton 4/14/2017 - * - */ - -#include -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/GammaZToXYZ.h" -#include "AMPTOOLS_MCGEN/TwoBodyDecayFactory.h" - -#include "IUAmpTools/Kinematics.h" - -#include - -GammaZToXYZ::GammaZToXYZ( float lowMassXY, float highMassXY, - float massX, float massY, float beamMaxE, float beamPeakE, float beamLowE, float beamHighE, - ProductionMechanism::Type type ) : - -m_prodMech( ProductionMechanism::kZ, type, 6.0 ), // last arg is t dependence -// m_target( 0, 0, 0, 108.), // use mass of Tin -m_target( 0, 0, 0, 208.*0.931494), // use mass of Pb since it is defined in particle tables. -m_childMass( 0 ) { - - m_childMass.push_back( massX ); - m_childMass.push_back( massY ); - - m_prodMech.setMassRange( lowMassXY, highMassXY ); - - // Initialize coherent brem table - float Emax = beamMaxE; - float Epeak = beamPeakE; - float Elow = beamLowE; - float Ehigh = beamHighE; - - int doPolFlux=0; // want total flux (1 for polarized flux) - float emitmr=10.e-9; // electron beam emittance - float radt=50.e-6; // radiator thickness in m - float collDiam=0.005; // meters - float Dist = 76.0; // meters - CobremsGeneration cobrems(Emax, Epeak); - cobrems.setBeamEmittance(emitmr); - cobrems.setTargetThickness(radt); - cobrems.setCollimatorDistance(Dist); - cobrems.setCollimatorDiameter(collDiam); - cobrems.setCollimatedFlag(true); - cobrems.setPolarizedFlag(doPolFlux); - - // Create histogram - cobrem_vs_E = new TH1D("cobrem_vs_E", "Coherent Bremstrahlung vs. E_{#gamma}", 1000, Elow, Ehigh); - - // Fill histogram - for(int i=1; i<=cobrem_vs_E->GetNbinsX(); i++){ - double x = cobrem_vs_E->GetBinCenter(i)/Emax; - double y = 0; - if(EpeakSetBinContent(i, y); - } - -} - -Kinematics* -GammaZToXYZ::generate(){ - - double beamE = cobrem_vs_E->GetRandom(); - m_beam.SetPxPyPzE(0,0,beamE,beamE); - - TLorentzVector resonance = m_prodMech.produceResonanceZ( m_beam); - double genWeight = m_prodMech.getLastGeneratedWeight(); - - vector< TLorentzVector > allPart; - allPart.push_back( m_beam ); - // allPart.push_back( m_beam + m_target - resonance ); - - TwoBodyDecayFactory decay( resonance.M(), m_childMass ); - - vector fsPart = decay.generateDecay(); - - for( vector::iterator aPart = fsPart.begin(); - aPart != fsPart.end(); ++aPart ){ - - aPart->Boost( resonance.BoostVector() ); - allPart.push_back( *aPart ); - } - - allPart.push_back( m_beam + m_target - resonance ); // Move Recoil vector to position 3 after resonance - - return new Kinematics( allPart, genWeight ); -} - -void -GammaZToXYZ::addResonance( float mass, float width, float bf ){ - - m_prodMech.addResonance( mass, width, bf ); -} - diff --git a/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.h b/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.h deleted file mode 100644 index 49cb1342fb..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/GammaZToXYZ.h +++ /dev/null @@ -1,45 +0,0 @@ -#if !defined(GAMMAZTOXYZ) -#define GAMMAZTOXYZ - -/* - * GammaZToXYZ.h - * GlueXTools - * - * Modified GammaPToXYP.h, replacing proton with heavy Z target - * Elton 4/14/2017 - * - */ - -#include "TLorentzVector.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "TH1.h" - -class Kinematics; - -class GammaZToXYZ { - -public: - - GammaZToXYZ( float lowMassXY, float highMassXY, float massX, float massY, - float beamMaxE, float beamPeakE, float beamLowE, float beamHigh, ProductionMechanism::Type type ); - - Kinematics* generate(); - - void addResonance( float mass, float width, float bf ); - -private: - - ProductionMechanism m_prodMech; - - TLorentzVector m_beam; - TLorentzVector m_target; - - vector< double > m_childMass; - - TH1D *cobrem_vs_E; - TH1D *Primakoff_tdist; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.cc b/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.cc deleted file mode 100644 index 3b7ed408ee..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.cc +++ /dev/null @@ -1,124 +0,0 @@ -/* - Generates N-body phase space decays using the Raubold Lynch - method (F.James CERN 68-15 (1968). - Borrows liberally from ROOT class TGenPhaseSpace as well as AcquRoot - class TMCGenerator (J.R.M.Annand -- http://nuclear.gla.ac.uk/~acqusys/doc). - - -- C.Tarbert -*/ - -#include -#include -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TMath.h" - -#include "AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h" - -const double NBodyPhaseSpaceFactory::kPi = 3.14159; - -NBodyPhaseSpaceFactory::NBodyPhaseSpaceFactory( double parentMass, const vector& childMass ) : - m_parentMass( parentMass ), - m_childMass( childMass ) -{ - m_Nd = (int)childMass.size(); -} - -vector -NBodyPhaseSpaceFactory::generateDecay(bool uniformWeights) { - - - vector child( m_Nd ); - - double Tcm = m_parentMass; - int n, m; - for( n=0; n 0. ); - - double emmax = Tcm + m_childMass[0]; - double emmin = 0; - double wt = 1; - for (n=1; n(rnd) ); // sort random numbers ascending - rnd[m_Nd-1] = 1.0; - break; - case 3: // 3 decay particles - rnd[1] = random(0.0,1.0); - irnd[0] = 0; irnd[1] = 1; irnd[2] = 2; - break; - case 2: - irnd[0] = 0; irnd[1] = 1; - break; - } - wt = 0.0; - for (n=0; n wt) ); - - if(uniformWeights) m_lastWt = 1.0; - else m_lastWt = wt; - - // - // Specification of 4-momenta (Raubold-Lynch method) - // - child[0].SetPxPyPzE(0, pd[0], 0 , sqrt(pd[0]*pd[0]+m_childMass[0]*m_childMass[0]) ); - for(n=1;;){ - child[n].SetPxPyPzE(0, -pd[n-1], 0 , - sqrt(pd[n-1]*pd[n-1]+m_childMass[n]*m_childMass[n]) ); - - double cosZ = random(-1.,1.); - double angY = random(0.0, 2.*kPi); - for (m=0; m<=n; m++) { - child[m].RotateZ( acos(cosZ) ); - child[m].RotateY( angY ); - } - if( n == m_Nd-1 ) break; - double beta = pd[n] / sqrt(pd[n]*pd[n] + invMas[n]*invMas[n]); - for (m=0; m<=n; m++) child[m].Boost(0,beta,0); - n++; - } - - return child; -} - -double -NBodyPhaseSpaceFactory::pdk( double a, double b, double c ) const { - - double x = (a-b-c)*(a+b+c)*(a-b+c)*(a+b-c); - x = sqrt(x)/(2*a); - return x; - -} - -double -NBodyPhaseSpaceFactory::random( double low, double hi ) const { - - return( ( hi - low ) * gRandom->Uniform() + low ); -} diff --git a/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h b/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h deleted file mode 100644 index 6a656378b7..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/NBodyPhaseSpaceFactory.h +++ /dev/null @@ -1,51 +0,0 @@ -#if !defined(NBODYPHASESPACEFACTORY) -#define NBODYPHASESPACEFACTORY - -#include - -#include "TLorentzVector.h" -#include "TRandom3.h" - -using namespace std; - -class NBodyPhaseSpaceFactory -{ - - public: - - NBodyPhaseSpaceFactory( double parentMass, const vector& childMass); - - - /** - * Generates N-body phase space decays using the Raubold Lynch - * method (F.James CERN 68-15 (1968). - * Borrows liberally from ROOT class TGenPhaseSpace as well as AcquRoot - * class TMCGenerator (J.R.M.Annand -- http://nuclear.gla.ac.uk/~acqusys/doc) - * - * \param[in] uniformWeights - boolean value selecting whether to perform - * accept/reject on generated events, resulting in uniform event weights, - * or to return the first generated event and set its corresponding weight. - */ - vector generateDecay(bool uniformWeights = true ); - - /** - * Returns the weight of the last-generated event. This is relevant - * in case the last event was generated with uniformWeights=false - */ - double getLastGeneratedWeight() const {return m_lastWt;}; - - private: - - static const double kPi; - - double pdk( double a, double b, double c ) const; - double random( double low, double hi ) const; - - double m_parentMass; - vector m_childMass; // vector of daughter masses - int m_Nd; // number of decay products - double m_lastWt; - -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.cc b/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.cc deleted file mode 100644 index 80d3581e11..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.cc +++ /dev/null @@ -1,197 +0,0 @@ - -#include -#include - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "particleType.h" - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -const double ProductionMechanism::kPi = 3.14159; - -using namespace std; - -ProductionMechanism::ProductionMechanism( Recoil recoil, Type type, double slope, int seed ) : -m_type( type ), -m_lowMass( 0 ), -m_highMass( 0 ), -m_slope( slope ), -m_lastWeight( 1. ) -{ - kMproton=ParticleMass(Proton); - kMneutron=ParticleMass(Neutron); - // kMZ = 108.; // mass of Sn116 - kMZ = 208.*0.931494; // use mass of Pb as it is in the particle table - - // initialize pseudo-random generator - gRandom->SetSeed(seed); - - switch( recoil ){ - // I'm sure the distinction between these doesn't matter! - case kProton: m_recMass = kMproton; break; //old value: 0.9382 - case kNeutron: m_recMass = kMneutron; break; //old value: 0.9395 - case kZ: m_recMass = kMZ; break; //default to Sn116/Pb - default: m_recMass = kMproton; break; //old value: 0.9382 - } -} - -void -ProductionMechanism::setMassRange( double low, double high ){ - - m_lowMass = low; - m_highMass = high; -} - -void -ProductionMechanism::setGeneratorType( Type type ){ - - m_type = type; -} - - -TLorentzVector -ProductionMechanism::produceResonance( const TLorentzVector& beam ){ - - - TLorentzVector target( 0, 0, 0, kMproton ); - - TLorentzRotation lab2cmBoost( -( target + beam ).BoostVector() ); - TLorentzRotation cm2labBoost( ( target + beam ).BoostVector() ); - - double cmEnergy = ( lab2cmBoost * ( target + beam ) ).E(); - double beamMomCM = cmMomentum( cmEnergy, beam.M(), target.M() ); - - // double exptMax = exp(-1.)/m_slope; // Elton 8/19/2016. t*exp(Bt) - double exptMax = 1; // remove factor of t for rho production (no spin flip). set this value for exp(Bt) - - - double t, tMax, resMass, resMomCM; - - do { - do // the resonance mass cannot be larger than CM energy - proton mass - resMass = generateMass(); - while ( cmEnergy < resMass + m_recMass ); - resMomCM = cmMomentum( cmEnergy, resMass, m_recMass ); - - tMax = 4. * beamMomCM * resMomCM; - t = random( 0, tMax ); - } - // while( random( 0., exptMax ) > t*exp(-m_slope*t) ); // Elton 8/19/2016. t*exp(Bt) - while( random( 0., exptMax ) > exp(-m_slope*t) ); // remove factor of t for rho production (no spin flip). Set this line for exp(Bt) - - TVector3 resonanceMomCM; - resonanceMomCM.SetMagThetaPhi( resMomCM, - acos( 1. - 2.*t/tMax ), - random( -kPi, kPi ) ); - - TLorentzVector resonanceCM( resonanceMomCM, - sqrt( resonanceMomCM.Mag2() + - resMass * resMass ) ); - - return cm2labBoost * resonanceCM; -} -TLorentzVector -ProductionMechanism::produceResonanceZ ( const TLorentzVector& beam){ - /* This method is based on produceResonance, which assumes a proton target and exponential t dependence - This method is intended for use with a high Z target in Primakoff production. Elton 4/14/2017 - - */ - - TLorentzVector target( 0, 0, 0, kMZ); - - TLorentzRotation lab2cmBoost( -( target + beam ).BoostVector() ); - TLorentzRotation cm2labBoost( ( target + beam ).BoostVector() ); - - double cmEnergy = ( lab2cmBoost * ( target + beam ) ).E(); - double beamMomCM = cmMomentum( cmEnergy, beam.M(), target.M() ); - - // double exptMax = exp(-1.)/m_slope; // Elton 8/19/2016. t*exp(Bt) - double exptMax = 1; // remove factor of t for rho production (no spin flip). set this value for exp(Bt) - - double t, tMaxkin, tMax, resMass, resMomCM; - // generate the t-distribution. t is positive here (i.e. should be -t) - - do { - resMass = generateMass(); - resMomCM = cmMomentum( cmEnergy, resMass, m_recMass ); - - tMaxkin = 4. * beamMomCM * resMomCM; - tMax = 0.01; // restrict max to make more efficient for Primakoff generation - t = random( 0, tMax ); - } - // while( random( 0., exptMax ) > t*exp(-m_slope*t) ); // Elton 8/19/2016. t*exp(Bt) - while( random( 0., exptMax ) > exp(-m_slope*t) ); // remove factor of t for rho production (no spin flip). Set this line for exp(Bt) - - // cout << endl << "produceResonanceZ, resMomCM=" << resMomCM << " resMass=" << resMass << " t=" << t << " tMax=" << tMax << " cmEnergy=" << cmEnergy << " kMZ=" << kMZ << endl; - - TVector3 resonanceMomCM; - double thetaCM = 2.*sqrt(t/tMaxkin); // acos( 1. - 2.*t/tMax ) -> use small angle approximation to avoid roundoff. - // double thetaCM = acos( 1. - 2.*t/tMaxkin ); - double phiCM = random( -kPi, kPi ); - - resonanceMomCM.SetMagThetaPhi( resMomCM, thetaCM, phiCM); - - TLorentzVector resonanceCM( resonanceMomCM, - sqrt( resonanceMomCM.Mag2() + - resMass * resMass ) ); - // resonanceCM.Print(); - - return cm2labBoost * resonanceCM; -} - -void -ProductionMechanism::addResonance( double mass, double width, double crossSec ){ - - m_decGen.addChannel( m_bwGen.size(), crossSec ); - m_bwGen.push_back( BreitWignerGenerator( mass, width ) ); -} - -double -ProductionMechanism::generateMass(){ - - if( m_type == kFlat ) return random( m_lowMass, m_highMass ); - - double mass = 0; - while( mass < m_lowMass || mass > m_highMass ){ - - unsigned int channel = m_decGen(); - pair< double, double > bw = m_bwGen[channel](); - - mass = bw.first; - } - - double prob = 0; - for( unsigned int i = 0; i < m_bwGen.size(); ++i ){ - - prob += m_bwGen[i].pdf( mass * mass ) * m_decGen.getProb( i ); - } - - // put in the factor of mass so resulting weights can be applied to - // obtain a distribution that is flat in mass instead of flat in s - // (to get weights for reweighting flat in s remove the mass) - - m_lastWeight = 1 / ( prob * mass ); - - return mass; -} - -double -ProductionMechanism::cmMomentum( double M, double m1, double m2 ) const { - - // mini PDG Eq: 38.16 - - double num1 = ( M * M - ( m1 + m2 ) * ( m1 + m2 ) ); - double num2 = ( M * M - ( m1 - m2 ) * ( m1 - m2 ) ); - - return( sqrt( num1 * num2 ) / ( 2 * M ) ); -} - -double -ProductionMechanism::random( double low, double hi ) const { - - return( ( hi - low ) * gRandom->Uniform() + low ); -} - - diff --git a/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.h b/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.h deleted file mode 100644 index ca2497268b..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/ProductionMechanism.h +++ /dev/null @@ -1,62 +0,0 @@ -#if !defined(PRODUCTIONMECHANISM) -#define PRODUCTIONMECHANISM - -#include - -#include "TLorentzVector.h" -#include "TRandom3.h" - -#include "AMPTOOLS_MCGEN/BreitWignerGenerator.h" -#include "AMPTOOLS_MCGEN/DecayChannelGenerator.h" - -using namespace std; - -class ProductionMechanism -{ - -public: - - enum Type { kResonant, kFlat }; - enum Recoil { kProton, kNeutron, kZ }; - - ProductionMechanism( Recoil recoil, Type type, double slope = 5.0, int seed = 0 ); - - void setMassRange( double low, double high ); - void setGeneratorType( Type type ); - - TLorentzVector produceResonance( const TLorentzVector& beam ); - TLorentzVector produceResonanceZ( const TLorentzVector& beam); - - // there may be a better way to do this, like pair< , > - // but sometimes the user doesn't care about the weight - double getLastGeneratedWeight() { return m_lastWeight; } - - void addResonance( double mass, double width, double crossSec ); - -private: - - static const double kPi; - double kMproton,kMneutron,kMZ; - - double generateMass(); - - double cmMomentum( double M, double m1, double m2 ) const; - double random( double low, double hi ) const; - - Type m_type; - - double m_lowMass; - double m_highMass; - double m_slope; - - double m_recMass; - - double m_lastWeight; - - vector< BreitWignerGenerator > m_bwGen; - DecayChannelGenerator m_decGen; - - //TRandom3 *gRandom; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.cc b/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.cc deleted file mode 100644 index 11faa87994..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.cc +++ /dev/null @@ -1,73 +0,0 @@ - -#include -#include -#include - -#include "AMPTOOLS_MCGEN/ResonanceDecayFactory.h" - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom.h" - -using namespace std; - -const double ResonanceDecayFactory::kPi = 3.14159; - -ResonanceDecayFactory::ResonanceDecayFactory( double resMass, double isoMass, double isoWidth, double bachMass ) : -m_resMass( resMass ), -m_isoMass( isoMass ), -m_isoWidth( isoWidth ), -m_bachMass( bachMass ), -m_randGen(){} - -vector< TLorentzVector > -ResonanceDecayFactory::generateDecay() const { - - // initialize this high so we through a random number - double c0Mass = 2 * m_resMass; - - // avoid threshold problems - while( ( c0Mass + m_bachMass > 0.999 * m_resMass ) || ( c0Mass <= 0 ) ){ - -// c0Mass = RandBreitWigner::shoot( m_isoMass, m_isoWidth ); - c0Mass = m_randGen.BreitWigner( m_isoMass, m_isoWidth ); - } - - vector child( 2 ); - vector childMom( 2 ); - - childMom[0].SetMagThetaPhi( cmMomentum( m_resMass, c0Mass, m_bachMass ), - acos( random( -0.999999, 0.999999 ) ), - random( -kPi, kPi ) ); - childMom[1] = -childMom[0]; - - child[0].SetVect( childMom[0] ); - child[0].SetE( sqrt( childMom[0].Mag2() + c0Mass * c0Mass ) ); - - child[1].SetVect( childMom[1] ); - child[1].SetE( sqrt( childMom[1].Mag2() + m_bachMass * m_bachMass ) ); - - return child; -} - -double -ResonanceDecayFactory::cmMomentum( double M, double m1, double m2 ) const { - - // mini PDG Eq: 38.16 - - double num1 = ( M * M - ( m1 + m2 ) * ( m1 + m2 ) ); - double num2 = ( M * M - ( m1 - m2 ) * ( m1 - m2 ) ); - - if( ( num1 * num2 ) < 0 ){ - - cout << "ERROR\t" << M << "\t" << m1 << "\t" << m2 << endl; - } - - return( sqrt( num1 * num2 ) / ( 2 * M ) ); -} - -double -ResonanceDecayFactory::random( double low, double hi ) const { - - return( ( hi - low ) * drand48() + low ); -} diff --git a/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.h b/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.h deleted file mode 100644 index 6ba074cee8..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/ResonanceDecayFactory.h +++ /dev/null @@ -1,35 +0,0 @@ -#if !defined(RESONANCEDECAYFACTORY) -#define RESONANCEDECAYFACTORY - -#include - -#include "TLorentzVector.h" -#include "TRandom.h" - -using namespace std; - -class ResonanceDecayFactory -{ - -public: - - ResonanceDecayFactory( double resMass, double isoMass, double isoWidth, double bachMass ); - - vector< TLorentzVector > generateDecay() const; - -private: - - static const double kPi; - - double cmMomentum( double M, double m1, double m2 ) const; - double random( double low, double hi ) const; - - double m_resMass; - double m_isoMass; - double m_isoWidth; - double m_bachMass; - - mutable TRandom m_randGen; -}; - -#endif diff --git a/src/libraries/AMPTOOLS_MCGEN/SConscript b/src/libraries/AMPTOOLS_MCGEN/SConscript deleted file mode 100644 index 9aa2120821..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS') != None: - - env = env.Clone() - - env.PrependUnique(FORTRANFLAGS = ['-ffixed-line-length-0', '-fno-second-underscore', '-fno-automatic']) - env.AppendUnique(LINKFLAGS = ['-rdynamic', '-Wl,--no-as-needed']) - env.SetOption('warn', 'no-fortran-cxx-mix') # supress warnings about linking fortran with c++ - - sbms.AddAmpTools(env) - sbms.AddROOT(env) - sbms.library(env) - - sbms.AddCobrems(env) diff --git a/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.cc b/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.cc deleted file mode 100644 index ae6f361b34..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.cc +++ /dev/null @@ -1,61 +0,0 @@ - -#include -#include -#include - -#include "TLorentzVector.h" -#include "TLorentzRotation.h" - -#include "AMPTOOLS_MCGEN/TwoBodyDecayFactory.h" - -const double TwoBodyDecayFactory::kPi = 3.14159; - -TwoBodyDecayFactory::TwoBodyDecayFactory( double parentMass, const vector& childMass ) : -m_parentMass( parentMass ), -m_childMass( childMass ) -{ - assert( childMass.size() == 2 ); -} - - -vector -TwoBodyDecayFactory::generateDecay() const { - - vector child( 2 ); - vector childMom( 2 ); - - // let the X decay to isobar + 2 in the X CM - // fill the isobar momentum vector and the bachelor momentum vector - childMom[0]. - SetMagThetaPhi( cmMomentum( m_parentMass, m_childMass[0], m_childMass[1] ), - acos( random( -0.999999, 0.999999 ) ), - random( -kPi, kPi ) ); - childMom[1] = -childMom[0]; - - // fill the final four-vectors - for( int i = 0; i < 2; ++i ){ - - child[i].SetVect( childMom[i] ); - child[i].SetE( sqrt( childMom[i].Mag2() + - m_childMass[i] * m_childMass[i] ) ); - } - - return child; -} - -double -TwoBodyDecayFactory::cmMomentum( double M, double m1, double m2 ) const { - - // mini PDG Eq: 38.16 - - double num1 = ( M * M - ( m1 + m2 ) * ( m1 + m2 ) ); - double num2 = ( M * M - ( m1 - m2 ) * ( m1 - m2 ) ); - - return( sqrt( num1 * num2 ) / ( 2 * M ) ); -} - -double -TwoBodyDecayFactory::random( double low, double hi ) const { - - return( ( hi - low ) * drand48() + low ); -} diff --git a/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.h b/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.h deleted file mode 100644 index 3c28d1efc3..0000000000 --- a/src/libraries/AMPTOOLS_MCGEN/TwoBodyDecayFactory.h +++ /dev/null @@ -1,30 +0,0 @@ -#if !defined(TWOBODYDECAYFACTORY) -#define TWOBODYDECAYFACTORY - -#include - -#include "TLorentzVector.h" - -using namespace std; - -class TwoBodyDecayFactory -{ - -public: - - TwoBodyDecayFactory( double parentMass, const vector& childMass ); - - vector generateDecay() const; - -private: - - static const double kPi; - - double cmMomentum( double M, double m1, double m2 ) const; - double random( double low, double hi ) const; - - double m_parentMass; - vector m_childMass; -}; - -#endif diff --git a/src/libraries/DANA/DApplication.cc b/src/libraries/DANA/DApplication.cc index 6eaf592938..7b614a0e51 100644 --- a/src/libraries/DANA/DApplication.cc +++ b/src/libraries/DANA/DApplication.cc @@ -55,7 +55,7 @@ DApplication::DApplication(int narg, char* argv[]):JApplication(narg, argv) AddPluginPath(string(ptr) + "/" + sbms_osname + "/plugins"); // SBMS AddPluginPath(string(ptr) + "/lib/" + sbms_osname); // BMS } - if(const char *ptr = getenv("HALLD_HOME")){ + if(const char *ptr = getenv("HALLD_RECON_HOME")){ AddPluginPath(string(ptr) + "/" + sbms_osname + "/plugins"); // SBMS AddPluginPath(string(ptr) + "/lib/" + sbms_osname); // BMS } @@ -252,7 +252,7 @@ DGeometry* DApplication::GetDGeometry(unsigned int run_number) _DBG_<<"Make sure you JANA_GEOMETRY_URL environment variable is set."<AddIncludePath("-I${HALLD_HOME}/${BMS_OSNAME}/include/"); + gSystem->AddIncludePath("-I${HALLD_RECON_HOME}/${BMS_OSNAME}/include/"); gSystem->AddIncludePath("-I${ROOT_ANALYSIS_HOME}/${BMS_OSNAME}/include/"); gSystem->Load("$(ROOT_ANALYSIS_HOME)/$(BMS_OSNAME)/lib/libDSelector.so"); } diff --git a/src/plugins/Analysis/bcal_shower/SConstruct b/src/plugins/Analysis/bcal_shower/SConstruct index 10afa273ff..75116692ed 100644 --- a/src/plugins/Analysis/bcal_shower/SConstruct +++ b/src/plugins/Analysis/bcal_shower/SConstruct @@ -5,13 +5,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Get plugin name @@ -40,7 +40,7 @@ bin = "%s/bin" % (plugininstalldir) lib = "%s/lib" % (plugininstalldir) plugins = "%s/%s/plugins" % (plugininstalldir,osname) env = Environment( CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -75,7 +75,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/Analysis/fcal_charged/CalcGainFactors/SConstruct b/src/plugins/Analysis/fcal_charged/CalcGainFactors/SConstruct index 595ee7b6b8..55c249a900 100644 --- a/src/plugins/Analysis/fcal_charged/CalcGainFactors/SConstruct +++ b/src/plugins/Analysis/fcal_charged/CalcGainFactors/SConstruct @@ -5,13 +5,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Get plugin name @@ -40,7 +40,7 @@ bin = "%s/bin" % (plugininstalldir) lib = "%s/lib" % (plugininstalldir) plugins = "%s/%s/plugins" % (plugininstalldir,osname) env = Environment( CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -75,7 +75,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/Analysis/fcal_charged/MakeEigensystem/SConstruct b/src/plugins/Analysis/fcal_charged/MakeEigensystem/SConstruct index 595ee7b6b8..55c249a900 100644 --- a/src/plugins/Analysis/fcal_charged/MakeEigensystem/SConstruct +++ b/src/plugins/Analysis/fcal_charged/MakeEigensystem/SConstruct @@ -5,13 +5,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Get plugin name @@ -40,7 +40,7 @@ bin = "%s/bin" % (plugininstalldir) lib = "%s/lib" % (plugininstalldir) plugins = "%s/%s/plugins" % (plugininstalldir,osname) env = Environment( CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -75,7 +75,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/Analysis/p2pi_trees/SConstruct b/src/plugins/Analysis/p2pi_trees/SConstruct index 39140ad16c..96c918c781 100644 --- a/src/plugins/Analysis/p2pi_trees/SConstruct +++ b/src/plugins/Analysis/p2pi_trees/SConstruct @@ -5,13 +5,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Get plugin name @@ -41,7 +41,7 @@ lib = "%s/lib" % (plugininstalldir) plugins = "%s/%s/plugins" % (plugininstalldir,osname) env = Environment( ENV = os.environ, # Bring in full environement, including PATH CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -80,7 +80,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), # Use C++11 env.PrependUnique( CXXFLAGS = ['-std=c++11']) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/Calibration/BCAL_ADC_4ns/SConstruct b/src/plugins/Calibration/BCAL_ADC_4ns/SConstruct index bdb81fe3e6..ee01bfab6d 100644 --- a/src/plugins/Calibration/BCAL_ADC_4ns/SConstruct +++ b/src/plugins/Calibration/BCAL_ADC_4ns/SConstruct @@ -5,7 +5,7 @@ # This SConstruct file can be copied into a directory containing # the source for a plugin and used to compile it. It will use and # install into the directory specified by the HALLD_MY environment -# variable if defined. Otherwise, it will install in the HALLD_HOME +# variable if defined. Otherwise, it will install in the HALLD_RECON_HOME # directory. # # This file should not need modification. It will be copied in by @@ -29,13 +29,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Add SBMS directory to PYTHONPATH @@ -61,7 +61,7 @@ lib = "%s/lib" % (installdir) plugins = "%s/plugins" % (installdir) env = Environment( ENV = os.environ, # Bring in full environment, including PATH CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -99,7 +99,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/Calibration/CDC_TimeToDistance/README.md b/src/plugins/Calibration/CDC_TimeToDistance/README.md index a91cee5bb9..cd6e35684c 100644 --- a/src/plugins/Calibration/CDC_TimeToDistance/README.md +++ b/src/plugins/Calibration/CDC_TimeToDistance/README.md @@ -14,11 +14,11 @@ This will make it easy to access the files and will work properly with the scrip Additionally, making symlinks to the scripts will also make life easier. -ln -s $HALLD_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/run.py run.py +ln -s $HALLD_RECON_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/run.py run.py -ln -s $HALLD_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/FitTimeToDistance FitTimeToDistance.C +ln -s $HALLD_RECON_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/FitTimeToDistance FitTimeToDistance.C -ln -s $HALLD_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/display.py display.py +ln -s $HALLD_RECON_HOME/src/plugins/Calibration/CDC_TimeToDistance/FitScripts/display.py display.py # Running the scripts With everything prepared as described above, run the python script `run.py` diff --git a/src/plugins/Calibration/FCALpulsepeak/SConstruct b/src/plugins/Calibration/FCALpulsepeak/SConstruct index bdb81fe3e6..ee01bfab6d 100644 --- a/src/plugins/Calibration/FCALpulsepeak/SConstruct +++ b/src/plugins/Calibration/FCALpulsepeak/SConstruct @@ -5,7 +5,7 @@ # This SConstruct file can be copied into a directory containing # the source for a plugin and used to compile it. It will use and # install into the directory specified by the HALLD_MY environment -# variable if defined. Otherwise, it will install in the HALLD_HOME +# variable if defined. Otherwise, it will install in the HALLD_RECON_HOME # directory. # # This file should not need modification. It will be copied in by @@ -29,13 +29,13 @@ import sys import subprocess import glob -# Get HALLD_HOME environment variable, verifying it is set -halld_home = os.getenv('HALLD_HOME') +# Get HALLD_RECON_HOME environment variable, verifying it is set +halld_home = os.getenv('HALLD_RECON_HOME') if(halld_home == None): - print 'HALLD_HOME environment variable not set!' + print 'HALLD_RECON_HOME environment variable not set!' exit(-1) -# Get HALLD_MY if it exists. Otherwise use HALLD_HOME +# Get HALLD_MY if it exists. Otherwise use HALLD_RECON_HOME halld_my = os.getenv('HALLD_MY', halld_home) # Add SBMS directory to PYTHONPATH @@ -61,7 +61,7 @@ lib = "%s/lib" % (installdir) plugins = "%s/plugins" % (installdir) env = Environment( ENV = os.environ, # Bring in full environment, including PATH CPPPATH = [include], - LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_HOME here and prepend HALLD_MY below + LIBPATH = ["%s/%s/lib" %(halld_home, osname)], # n.b. add HALLD_RECON_HOME here and prepend HALLD_MY below variant_dir = ".%s" % (osname)) # Only add HALLD_MY library search path if it already exists @@ -99,7 +99,7 @@ env.Replace( CXX = os.getenv('CXX', 'g++'), CC = os.getenv('CC' , 'gcc'), FC = os.getenv('FC' , 'gfortran') ) -# Add local directory, directories from HALLD_MY and HALLD_HOME to include search path +# Add local directory, directories from HALLD_MY and HALLD_RECON_HOME to include search path #env.PrependUnique(CPPPATH = ['#']) env.PrependUnique(CPPPATH = ['%s/src' % halld_my, '%s/src/libraries' % halld_my, '%s/src/libraries/include' % halld_my]) env.PrependUnique(CPPPATH = ['%s/src' % halld_home, '%s/src/libraries' % halld_home, '%s/src/libraries/include' % halld_home]) diff --git a/src/plugins/SConscript b/src/plugins/SConscript index 822c72d44f..f79730c83e 100644 --- a/src/plugins/SConscript +++ b/src/plugins/SConscript @@ -5,6 +5,6 @@ Import('*') Import('env osname') -subdirs = ['Analysis', 'Utilities', 'Simulation', 'monitoring', 'Calibration', 'include', 'Alignment'] +subdirs = ['Analysis', 'Utilities', 'monitoring', 'Calibration', 'include', 'Alignment'] SConscript(dirs=subdirs, exports='env osname', duplicate=0) diff --git a/src/plugins/Simulation/SConscript b/src/plugins/Simulation/SConscript deleted file mode 100644 index 701bcff1b3..0000000000 --- a/src/plugins/Simulation/SConscript +++ /dev/null @@ -1,11 +0,0 @@ - -import sbms - -Import('*') - -# The following was never integrated into SBMS. This files is here mainly -# as a place holder. It was placed here when src/programs/Simulation/plugins -# was moved to src/plugins/Simulation just before the Git transition. - -# Optional targets -sbms.OptionallyBuild(env, ['extract_ptype_hddm', 'hdparsim', 'recon2mc']) diff --git a/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.cc b/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.cc deleted file mode 100644 index 562077fb29..0000000000 --- a/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.cc +++ /dev/null @@ -1,199 +0,0 @@ -// $Id$ -// -// File: JEventProcessor_extract_ptype_hddm.cc -// Created: Mon Sep 5 12:29:45 EDT 2011 -// Creator: davidl (on Linux ifarm1101 2.6.18-128.7.1.el5 x86_64) -// - - -#include -using namespace std; - -#include "JEventProcessor_extract_ptype_hddm.h" -using namespace jana; - -#include -#include - -// Routine used to create our JEventProcessor -#include -extern "C"{ -void InitPlugin(JApplication *app) { - InitJANAPlugin(app); - app->AddProcessor(new JEventProcessor_extract_ptype_hddm()); -} -} // "C" - - -float vertex[4]={0.0, 0.0, 65.0, 65.0}; - - -//------------------ -// JEventProcessor_extract_ptype_hddm (Constructor) -//------------------ -JEventProcessor_extract_ptype_hddm::JEventProcessor_extract_ptype_hddm() -{ - pthread_mutex_init(&mutex, NULL); - - Nevents =0; - -} - -//------------------ -// ~JEventProcessor_extract_ptype_hddm (Destructor) -//------------------ -JEventProcessor_extract_ptype_hddm::~JEventProcessor_extract_ptype_hddm() -{ - -} - -//------------------ -// init -//------------------ -jerror_t JEventProcessor_extract_ptype_hddm::init(void) -{ - // Get type of particle to extract - PTYPE = Neutron; - gPARMS->SetDefaultParameter("PTYPE", PTYPE, - "GEANT particle type to extract to separate HDDM file."); - - // Get output filename - OUTFILENAME = string(ParticleType((Particle_t)PTYPE)) + ".hddm"; - gPARMS->SetDefaultParameter("OUTPUT_FILENAME", OUTFILENAME, - "Filename of HDDM file to write particles to."); - - // Open output file - if (hddmout == 0) { - std::cout << " Error opening output file \"" << OUTFILENAME << "\"!" - << std::endl; - exit(-1); - } - std::cout << " output file: " << OUTFILENAME << std::endl; - ofsout = new ofstream(OUTFILENAME.c_str()); - hddmout = new hddm_s::ostream(*ofsout); - - // Get vertex info - string vertex_str = "0 0 65 65"; - gPARMS->SetDefaultParameter("VERTEX", vertex_str, - "Vertex to throw particles from (should be" - " string of 4 numbers x y zmin zmax)"); - sscanf(vertex_str.c_str(), "%f %f %f %f", &vertex[0], &vertex[1], - &vertex[2], &vertex[3]); - if (vertex[2] > vertex[3]) { - std::cerr << "Invalid parameter: z_min > z_max" << std::endl; - exit(-1); - } - - // Print message to user - jout << std::endl; - jout << "----------------------------------------" << std::endl; - jout << "extract_ptype_hddm plugin:" << std::endl; - jout << std::endl; - jout << " particle type: " << ParticleType((Particle_t)PTYPE) - << " (set via -PPTYPE=geantid)" << std::endl; - jout << " output filename: " << OUTFILENAME - << " (set via -POUTFILENAME=fname.hddm)" << std::endl; - jout << " vertex: x=" << vertex[0] << " y=" << vertex[1] - << " zmin=" << vertex[2] << " zmax=" << vertex[3] << std::endl; - jout << " (set via -PVERTEX=\"X Y Zmin Zmax\")" - << std::endl; - jout << "----------------------------------------" << std::endl; - jout << std::endl; - - return NOERROR; -} - -//------------------ -// brun -//------------------ -jerror_t JEventProcessor_extract_ptype_hddm::brun(JEventLoop *loop, - int32_t runnumber) -{ - // This is called whenever the run number changes - return NOERROR; -} - -//------------------ -// evnt -//------------------ -jerror_t JEventProcessor_extract_ptype_hddm::evnt(JEventLoop *loop, - uint64_t eventnumber) -{ - vector mcthrowns; - loop->Get(mcthrowns); - - pthread_mutex_lock(&mutex); - - for (unsigned int i=0; i < mcthrowns.size(); i++) { - const DMCThrown *thrown = mcthrowns[i]; - - if (thrown->type != (int)PTYPE) - continue; - - // Start a new event - hddm_s::HDDM record; - hddm_s::PhysicsEventList pes = record.addPhysicsEvents(); - pes().setRunNo(1); - pes().setEventNo(++Nevents); - hddm_s::ReactionList rs = pes().addReactions(); - hddm_s::VertexList vs = rs().addVertices(); - hddm_s::OriginList os = vs().addOrigins(); - hddm_s::ProductList ps = vs().addProducts(); - os().setT(0.0); - os().setVx(vertex[0]); - os().setVy(vertex[1]); - if (vertex[2] < vertex[3]) { - os().setVz(randm(vertex[2],vertex[3])); - } - else { - os().setVz(vertex[2]); - } - - DVector3 mom = thrown->momentum(); - ps().setType((Particle_t)thrown->type); - ps().setPdgtype(thrown->pdgtype); - ps().setId(thrown->myid); - ps().setParentid(thrown->parentid); - ps().setMech(thrown->mech); - hddm_s::MomentumList pmoms = ps().addMomenta(); - pmoms().setPx(mom.X()); - pmoms().setPy(mom.Y()); - pmoms().setPz(mom.Z()); - pmoms().setE(thrown->energy()); - - *hddmout << record; - } - - - pthread_mutex_unlock(&mutex); - - return NOERROR; -} - -//------------------ -// erun -//------------------ -jerror_t JEventProcessor_extract_ptype_hddm::erun(void) -{ - return NOERROR; -} - -//------------------ -// fini -//------------------ -jerror_t JEventProcessor_extract_ptype_hddm::fini(void) -{ - pthread_mutex_lock(&mutex); - if (hddmout) { - delete hddmout; - hddmout = NULL; - } - if (ofsout) { - delete ofsout; - ofsout = NULL; - } - pthread_mutex_unlock(&mutex); - - return NOERROR; -} - diff --git a/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.h b/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.h deleted file mode 100644 index 070a1588f4..0000000000 --- a/src/plugins/Simulation/extract_ptype_hddm/JEventProcessor_extract_ptype_hddm.h +++ /dev/null @@ -1,41 +0,0 @@ -// $Id$ -// -// File: JEventProcessor_extract_ptype_hddm.h -// Created: Mon Sep 5 12:29:45 EDT 2011 -// Creator: davidl (on Linux ifarm1101 2.6.18-128.7.1.el5 x86_64) -// - -#ifndef _JEventProcessor_extract_ptype_hddm_ -#define _JEventProcessor_extract_ptype_hddm_ - -#include -#include - -#include -#include - -class JEventProcessor_extract_ptype_hddm:public jana::JEventProcessor{ - public: - JEventProcessor_extract_ptype_hddm(); - ~JEventProcessor_extract_ptype_hddm(); - const char* className(void){return "JEventProcessor_extract_ptype_hddm";} - - double randm(double low, double high){return ((high - low) * drand48() + low);} - - private: - jerror_t init(void); ///< Called once at program start. - jerror_t brun(jana::JEventLoop *eventLoop, int32_t runnumber); ///< Called everytime a new run number is detected. - jerror_t evnt(jana::JEventLoop *eventLoop, uint64_t eventnumber); ///< Called every event. - jerror_t erun(void); ///< Called everytime run number changes, provided brun has been called. - jerror_t fini(void); ///< Called after last event of last event source has been processed. - - pthread_mutex_t mutex; - std::ofstream *ofsout; - hddm_s::ostream *hddmout; - string OUTFILENAME; - unsigned long Nevents; - unsigned int PTYPE; -}; - -#endif // _JEventProcessor_extract_ptype_hddm_ - diff --git a/src/plugins/Simulation/extract_ptype_hddm/Makefile b/src/plugins/Simulation/extract_ptype_hddm/Makefile deleted file mode 100644 index a793bc4a05..0000000000 --- a/src/plugins/Simulation/extract_ptype_hddm/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES = DANA:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.shlib - diff --git a/src/plugins/Simulation/extract_ptype_hddm/README b/src/plugins/Simulation/extract_ptype_hddm/README deleted file mode 100644 index 7f81919780..0000000000 --- a/src/plugins/Simulation/extract_ptype_hddm/README +++ /dev/null @@ -1,47 +0,0 @@ - -This plugin will extract all particles of a specific -type and write them out as single events to an HDDM -file. The particles are taken from the DMCThrown objects -and therefore represent the generated particles (not -the reconstructed particles). - -This is useful for studying the detector response -to particles with a distribution determined by the input -file, but in a simpler event structure that is not -cluttered by multiple particles. - -For example, to get pull all of the neutrons out of -a file of events produced by bggen (pythia) do the -following: - -hd_ana -PPLUGINS=extract_ptype_hddm -PPTYPE=13 bggen.hddm - -This will produce a file called "neutron.hddm" because the -GEANT particle type for neutrons is 13. - -See src/libraries/include/particleType.h for a list of -particle types. - -There are 3 configuration parameters this plugin uses: - -PTYPE: Used to set the type of particle one wants to extract - -OUTPUTFILENAME: name of the output file. If not set, the -filename will be based on the particle type - -VERTEX: Used to specify the vertex of the particle. Note -that any vertex in the input file is ignored. This should -be specified as a string with 4 numbers representing the -X, Y, Zmin, and Zmax values. If Zmin and Zmax are different, -the represent a span from which the vertex will be -randomly chose for every particle. An example is: - -hd_ana -PVERTEX="0 0 50 80" -PPLUGINS=extract_ptype_hddm bggen.hddm - -this would randomly select a vertex on the beamline in the -range of the full 30cm GlueX target. - -Questions can be sent to: - -davidl@jlab.org - diff --git a/src/plugins/Simulation/hdparsim/DFactoryGeneratorHDParSim.h b/src/plugins/Simulation/hdparsim/DFactoryGeneratorHDParSim.h deleted file mode 100644 index 1e408a93d1..0000000000 --- a/src/plugins/Simulation/hdparsim/DFactoryGeneratorHDParSim.h +++ /dev/null @@ -1,45 +0,0 @@ -// $Id$ -// -// File: DFactoryGeneratorHDParSim.h -// Created: Tue Feb 3 11:25:33 EST 2009 -// Creator: davidl (on Darwin Harriet.local 9.6.0 i386) -// - -#ifndef _DFactoryGeneratorHDParSim_ -#define _DFactoryGeneratorHDParSim_ - -#include -#include -using namespace jana; - -#include "DTrackTimeBased_factory_HDParSim.h" -#include "DPhoton_factory_HDParSim.h" - -class DFactoryGeneratorHDParSim: public JFactoryGenerator{ - public: - DFactoryGeneratorHDParSim(){pthread_mutex_init(&root_mutex, NULL);} - virtual ~DFactoryGeneratorHDParSim(){} - virtual const char* className(void){return static_className();} - static const char* static_className(void){return "DFactoryGeneratorHDParSim";} - - jerror_t GenerateFactories(JEventLoop *loop){ - pthread_mutex_lock(&root_mutex); - - loop->AddFactory(new DTrackTimeBased_factory_HDParSim()); - loop->AddFactory(new DPhoton_factory_HDParSim()); - - pthread_mutex_unlock(&root_mutex); - - return NOERROR; - } - - protected: - - - private: - pthread_mutex_t root_mutex; - -}; - -#endif // _DFactoryGeneratorHDParSim_ - diff --git a/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.cc b/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.cc deleted file mode 100644 index 0993ab89a5..0000000000 --- a/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.cc +++ /dev/null @@ -1,108 +0,0 @@ -// $Id$ -// -// File: DPhoton_factory_HDParSim.cc -// Created: Tue Feb 3 11:29:30 EST 2009 -// Creator: davidl (on Darwin harriet.jlab.org 9.6.0 i386) -// - - -#include -#include -using namespace std; - -#include - -#include "DTrackingResolutionGEANTphoton.h" -#include "DPhoton_factory_HDParSim.h" -using namespace jana; - -//------------------ -// DPhoton_factory_HDParSim (Constructer) -//------------------ -DPhoton_factory_HDParSim::DPhoton_factory_HDParSim(void) -{ - res = new DTrackingResolutionGEANTphoton(); -} - -//------------------ -// init -//------------------ -jerror_t DPhoton_factory_HDParSim::init(void) -{ - - // Allow user to specify that the efficiency cut should not be applied - APPLY_EFFICIENCY_PHOTON = true; // do apply efficiency cut by default - - gPARMS->SetDefaultParameter("HDPARSIM:APPLY_EFFICIENCY_PHOTON", APPLY_EFFICIENCY_PHOTON); - - return NOERROR; -} - -//------------------ -// brun -//------------------ -jerror_t DPhoton_factory_HDParSim::brun(jana::JEventLoop *eventLoop, int32_t runnumber) -{ - return NOERROR; -} - -//------------------ -// evnt -//------------------ -jerror_t DPhoton_factory_HDParSim::evnt(JEventLoop *loop, uint64_t eventnumber) -{ - // The simplest way to do this is to get the list of DMCThrown - // objects and copy those into our own DPhoton objects, but with smeared values. - vector throwns; - loop->Get(throwns); - - for(unsigned int i=0; itype!=1)continue; - - // Create our own DPhoton and copy thrown values into it. - // If it turns out this photon is lost due to inefficiency/acceptance, - // then the object will be deleted below. - DPhoton *photon = new DPhoton; - *((DKinematicData*)photon) = *thrown; - - // Associated objects are not copied by default so we do them "by hand" - vector assoc_objs; - thrown->GetT(assoc_objs); - for(unsigned int j=0; jAddAssociatedObject(assoc_objs[j]); - - // Simultaneously smear the momentum of the particle and test whether - // it passes the efficiency/acceptance cut. - DVector3 mom = photon->momentum(); - TVector3 tmom(mom.X(), mom.Y(), mom.Z()); - bool keep = res->Smear(thrown->type, tmom); - if(keep || !APPLY_EFFICIENCY_PHOTON){ - mom.SetXYZ(tmom.X(), tmom.Y(), tmom.Z()); - photon->setMomentum(mom); - _data.push_back(photon); - }else{ - delete photon; - } - } - - return NOERROR; -} - -//------------------ -// erun -//------------------ -jerror_t DPhoton_factory_HDParSim::erun(void) -{ - return NOERROR; -} - -//------------------ -// fini -//------------------ -jerror_t DPhoton_factory_HDParSim::fini(void) -{ - if(res)delete res; - - return NOERROR; -} - diff --git a/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.h b/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.h deleted file mode 100644 index 1d6a823cda..0000000000 --- a/src/plugins/Simulation/hdparsim/DPhoton_factory_HDParSim.h +++ /dev/null @@ -1,35 +0,0 @@ -// $Id$ -// -// File: DPhoton_factory_HDParSim.h -// Created: Tue Feb 3 11:29:30 EST 2009 -// Creator: davidl (on Darwin harriet.jlab.org 9.6.0 i386) -// - -#ifndef _DPhoton_factory_HDParSim_ -#define _DPhoton_factory_HDParSim_ - -#include -#include "PID/DPhoton.h" - -#include "DTrackingResolution.h" - -class DPhoton_factory_HDParSim:public jana::JFactory{ - public: - DPhoton_factory_HDParSim(); - ~DPhoton_factory_HDParSim(){}; - const char* Tag(void){return "HDParSim";} - - private: - jerror_t init(void); ///< Called once at program start. - jerror_t brun(jana::JEventLoop *eventLoop, int32_t runnumber); ///< Called everytime a new run number is detected. - jerror_t evnt(jana::JEventLoop *eventLoop, uint64_t eventnumber); ///< Called every event. - jerror_t erun(void); ///< Called everytime run number changes, provided brun has been called. - jerror_t fini(void); ///< Called after last event of last event source has been processed. - - bool APPLY_EFFICIENCY_PHOTON; - - DTrackingResolution *res; -}; - -#endif // _DPhoton_factory_HDParSim_ - diff --git a/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.cc b/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.cc deleted file mode 100644 index 3b20fbce3c..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.cc +++ /dev/null @@ -1,151 +0,0 @@ -// $Id$ -// -// File: DTrackTimeBased_factory_HDParSim.cc -// Created: Fri Feb 19 16:08:15 EST 2010 -// Creator: davidl (on Darwin harriet.jlab.org 9.8.0 i386) -// - - -#include -#include -using namespace std; - -#include - -#include -#include - -#include "DFactoryGeneratorHDParSim.h" -#include "DTrackingResolutionGEANT.h" -#include "DTrackTimeBased_factory_HDParSim.h" -using namespace jana; - - -//------------------ -// DTrackTimeBased_factory_HDParSim (Constructor) -//------------------ -DTrackTimeBased_factory_HDParSim::DTrackTimeBased_factory_HDParSim() -{ - res = new DTrackingResolutionGEANT(); -} - -//------------------ -// init -//------------------ -jerror_t DTrackTimeBased_factory_HDParSim::init(void) -{ - // Here, we allow the user to set scale factors for each of the - // resolutions so that 1/2 err and double error type simulations - // can be done. The default scale factors should be 1, but we go - // ahead and get them from the DTrackingResolution object since - // a deafult is set there and presuming we know it here can only - // lead to confusion later, should it change. - double scale_err_pt; - double scale_err_theta; - double scale_err_phi; - res->GetErrorScaleFactors(scale_err_pt, scale_err_theta, scale_err_phi); - - // Set the default or get the overiding values for hte error scale factors. - gPARMS->SetDefaultParameter("HDPARSIM:SCALE_ERR_PT", scale_err_pt); - gPARMS->SetDefaultParameter("HDPARSIM:SCALE_ERR_THETA", scale_err_theta); - gPARMS->SetDefaultParameter("HDPARSIM:SCALE_ERR_PHI", scale_err_phi); - - // Copy config parameter values back into DTrackingResolution object - res->SetErrorScaleFactors(scale_err_pt, scale_err_theta, scale_err_phi); - - // Allow user to specify that the efficiency cut should not be applied - APPLY_EFFICIENCY_CHARGED = true; // do apply efficiency cut by default - - gPARMS->SetDefaultParameter("HDPARSIM:APPLY_EFFICIENCY_CHARGED", APPLY_EFFICIENCY_CHARGED); - - return NOERROR; -} - -//------------------ -// brun -//------------------ -jerror_t DTrackTimeBased_factory_HDParSim::brun(jana::JEventLoop *eventLoop, int32_t runnumber) -{ - return NOERROR; -} - -//------------------ -// evnt -//------------------ -jerror_t DTrackTimeBased_factory_HDParSim::evnt(JEventLoop *loop, uint64_t eventnumber) -{ - // The simplest way to do this is to get the list of DTrackTimeBased - // objects made from the DTrackTimeBased:THROWN factory and copy those - // into our own DTrackTimeBased objects, but with smeared values. - vector particles_thrn; - loop->Get(particles_thrn, "THROWN"); - - for(unsigned int i=0; icandidateid = particles_thrn[i]->id; - part->trackid = particles_thrn[i]->id; - part->FOM = 1.0; - - // Associated objects are not copied by default so we do them "by hand" - vector assoc_objs; - particles_thrn[i]->GetT(assoc_objs); - for(unsigned int j=0; jAddAssociatedObject(assoc_objs[j]); - - // Get the GEANT particle type. The DMCThrown object used to create - // this DTrackTimeBased contains this info and a pointer to it should - // be kept as an associated object. - vector throwns; - part->Get(throwns); - if(throwns.size()!=1){ - _DBG_<<"No associated DMCThrown object with DTrackTimeBased object obtained"<momentum(); - TVector3 tmom(mom.X(), mom.Y(), mom.Z()); - bool keep = res->Smear(thrown->type, tmom); - if(keep || !APPLY_EFFICIENCY_CHARGED){ - mom.SetXYZ(tmom.X(), tmom.Y(), tmom.Z()); - part->setMomentum(mom); - _data.push_back(part); - }else{ - delete part; - } - } - - return NOERROR; -} - -//------------------ -// erun -//------------------ -jerror_t DTrackTimeBased_factory_HDParSim::erun(void) -{ - return NOERROR; -} - -//------------------ -// fini -//------------------ -jerror_t DTrackTimeBased_factory_HDParSim::fini(void) -{ - return NOERROR; -} - diff --git a/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.h b/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.h deleted file mode 100644 index dcd8304162..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackTimeBased_factory_HDParSim.h +++ /dev/null @@ -1,35 +0,0 @@ -// $Id$ -// -// File: DTrackTimeBased_factory_HDParSim.h -// Created: Fri Feb 19 16:08:15 EST 2010 -// Creator: davidl (on Darwin harriet.jlab.org 9.8.0 i386) -// - -#ifndef _DTrackTimeBased_factory_HDParSim_ -#define _DTrackTimeBased_factory_HDParSim_ - -#include -#include - -#include "DTrackingResolution.h" - -class DTrackTimeBased_factory_HDParSim:public jana::JFactory{ - public: - DTrackTimeBased_factory_HDParSim(); - ~DTrackTimeBased_factory_HDParSim(){}; - const char* Tag(void){return "HDParSim";} - - private: - jerror_t init(void); ///< Called once at program start. - jerror_t brun(jana::JEventLoop *eventLoop, int32_t runnumber); ///< Called everytime a new run number is detected. - jerror_t evnt(jana::JEventLoop *eventLoop, uint64_t eventnumber); ///< Called every event. - jerror_t erun(void); ///< Called everytime run number changes, provided brun has been called. - jerror_t fini(void); ///< Called after last event of last event source has been processed. - - bool APPLY_EFFICIENCY_CHARGED; - - DTrackingResolution *res; -}; - -#endif // _DTrackTimeBased_factory_HDParSim_ - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolution.cc b/src/plugins/Simulation/hdparsim/DTrackingResolution.cc deleted file mode 100644 index 8646e11149..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolution.cc +++ /dev/null @@ -1,156 +0,0 @@ -// $Id$ -// -// File: DTrackingResolution.cc -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#include -#include -using namespace std; - -#include "DTrackingResolution.h" -#include "DFactoryGeneratorHDParSim.h" - -// Routine used If we're a plugin -extern "C"{ -void InitPlugin(JApplication *app){ - InitJANAPlugin(app); - app->AddFactoryGenerator(new DFactoryGeneratorHDParSim()); -} -} // "C" - - -//--------------------------------- -// DTrackingResolution (Constructor) -//--------------------------------- -DTrackingResolution::DTrackingResolution() -{ - scale_err_pt = 1.0; - scale_err_theta = 1.0; - scale_err_phi = 1.0; -} - -//--------------------------------- -// ~DTrackingResolution (Destructor) -//--------------------------------- -DTrackingResolution::~DTrackingResolution() -{ - -} - -//---------------- -// SetErrorScaleFactors -//---------------- -void DTrackingResolution::SetErrorScaleFactors(double scale_err_pt, double scale_err_theta, double scale_err_phi) -{ - this->scale_err_pt = scale_err_pt; - this->scale_err_theta =scale_err_theta; - this->scale_err_phi = scale_err_phi; -} - -//---------------- -// GetErrorScaleFactors -//---------------- -void DTrackingResolution::GetErrorScaleFactors(double &scale_err_pt, double &scale_err_theta, double &scale_err_phi) -{ - scale_err_pt = this->scale_err_pt; - scale_err_theta = this->scale_err_theta; - scale_err_phi = this->scale_err_phi; -} - -//---------------- -// Smear -//---------------- -bool DTrackingResolution::Smear(int geanttype, TVector3 &mom) -{ - /// Smear the momentum vector of a charged particle - /// based on reolutions obtained from the GetResolution - /// method. - /// - /// The value of geanttype should specify the particle - /// type using the GEANT particle ids. - /// - /// The units of mom should be GeV/c - - // Efficiency should be based on input values. Calculate that - // now before they are smeared. - bool is_reconstructed = Efficiency(geanttype, mom); - - // Get resolutions - double pt_res, theta_res, phi_res; - GetResolution(geanttype, mom, pt_res, theta_res, phi_res); - - // Scale resolutions (default scale factors are all 1.0) - pt_res *= scale_err_pt; - theta_res *= scale_err_theta; - phi_res *= scale_err_phi; - - // Calculate new values. For each, we make a check that it is - // still in a valid range (e.g. theta is not less than 0). - // In reality, the probablity functions near these hard limits - // would not be gaussian in shape and so should be handled - // quite differently. - double theta_new=-1.0, phi_new=-1.0; - - if(theta_res>0.0){ - while(theta_new<=0.0 || theta_new>M_PI)theta_new = mom.Theta() + rnd.Gaus(0.0, theta_res)/1000.0; - }else{ - theta_new = mom.Theta(); - } - phi_new = mom.Phi() + rnd.Gaus(0.0, phi_res)/1000.0; - while(phi_new<-M_PI)phi_new+=M_PI; - while(phi_new>=M_PI)phi_new-=M_PI; - - // Overwrite input vector with new values. - // For photons, the value returned in "pt_res" is actually the - // total energy resolution. - if(geanttype==1){ - // photons - double E_res = pt_res, E_new=-1.0; - if(mom.Mag()>0.0){ - while(E_new<=0.0) E_new = mom.Mag()*(1.0 + rnd.Gaus(0.0, E_res)); - }else{ - E_new = 0.0; - } - mom.SetMagThetaPhi(E_new, theta_new, phi_new); - }else{ - // not photons - double pt_new=-1.0; - if(mom.Perp()>0.0){ - while(pt_new<=0.0) pt_new = mom.Perp()*(1.0 + rnd.Gaus(0.0, pt_res)); - }else{ - pt_new = 0.0; - } - mom.SetMagThetaPhi(pt_new/sin(theta_new), theta_new, phi_new); - } - return is_reconstructed; -} - -//---------------- -// Efficiency -//---------------- -bool DTrackingResolution::Efficiency(int geanttype, const TVector3 &mom) -{ - /// Return a boolean saying whether this event would be reconstructed - /// or not. The value returned will vary in that if mom points to - /// an area of the detector with 80% efficienct, then this will return - /// "true" 80% of the time and "false" 20% of the time. - /// - /// Geometric acceptance is also included so values of mom pointing - /// away from the detector will always returen "false". - /// - /// This works by calling the GetEfficiency method and then picking a - /// random number between 0 and 1. If the random number is less than or - /// equal to the efficiency value, then true is returned . Otherwise, - /// false is returned. - - double eff = GetEfficiency(geanttype, mom); - - double s = rnd.Rndm(); - - return s<=eff; -} - - - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolution.h b/src/plugins/Simulation/hdparsim/DTrackingResolution.h deleted file mode 100644 index 21905db632..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolution.h +++ /dev/null @@ -1,44 +0,0 @@ -// $Id$ -// -// File: DTrackingResolution.h -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#ifndef _DTrackingResolution_ -#define _DTrackingResolution_ - -#include -#include - -class DTrackingResolution{ - public: - DTrackingResolution(); - virtual ~DTrackingResolution(); - virtual const char* className(void){return static_className();} - static const char* static_className(void){return "DTrackingResolution";} - - // Virtual methods that must be supplied by subclass - // Momenta are in units of GeV/c and angular resolutions - // are in units of milliradians. - virtual void GetResolution(int geanttype, const TVector3 &mom, double &pt_res, double &theta_res, double &phi_res)=0; - virtual double GetEfficiency(int geanttype, const TVector3 &mom)=0; - - // Methods implemented in this class - bool Smear(int geanttype, TVector3 &mom); - bool Efficiency(int geanttype, const TVector3 &mom); - - void SetErrorScaleFactors(double scale_err_pt, double scale_err_theta, double scale_err_phi); - void GetErrorScaleFactors(double &scale_err_pt, double &scale_err_theta, double &scale_err_phi); - - private: - TRandom3 rnd; - - double scale_err_pt; - double scale_err_theta; - double scale_err_phi; - -}; - -#endif // _DTrackingResolution_ - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.cc b/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.cc deleted file mode 100644 index f9d2d907e4..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.cc +++ /dev/null @@ -1,215 +0,0 @@ -// $Id$ -// -// File: DTrackingResolutionGEANT.cc -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#include -#include - -#include -using namespace std; - -#include "DTrackingResolutionGEANT.h" -#include "getwebfile.h" - - -//--------------------------------- -// DTrackingResolutionGEANT (Constructor) -//--------------------------------- -DTrackingResolutionGEANT::DTrackingResolutionGEANT() -{ - //int argc=0; - //TApplication *app = new TApplication("myapp", &argc, NULL); - - - TDirectory *savedir = gDirectory; - - ReadTableInfo("hd_res_charged_pion.root", pion_info); - ReadTableInfo("hd_res_charged_proton.root", proton_info); - - if(savedir)savedir->cd(); - -} - -//---------------- -// ReadTableInfo -//---------------- -void DTrackingResolutionGEANT::ReadTableInfo(const char *fname, TableInfo &ti) -{ - // Get ROOT file from web if it is not already here - char url[512] = "http://www.jlab.org/Hall-D/datatables/"; - strcat(url, fname); - getwebfile(url); - - // Open ROOT file - ti.file = new TFile(fname); - if(!ti.file->IsOpen()){ - cout<GetName()<<"\""<FindObject("dpt_over_pt_sigma"); - if(!ti.pt_res_hist)ti.file->GetObject("dpt_over_pt_sigma", ti.pt_res_hist); - if(!ti.pt_res_hist)ti.pt_res_hist = (TH2D*)gROOT->FindObject("dpt_over_pt_vs_p_vs_theta"); - if(!ti.pt_res_hist)ti.file->GetObject("dpt_over_pt_vs_p_vs_theta", ti.pt_res_hist); - if(!ti.pt_res_hist){ - cout<FindObject("dtheta_sigma"); - if(!ti.theta_res_hist)ti.file->GetObject("dtheta_sigma", ti.theta_res_hist); - if(!ti.theta_res_hist)ti.theta_res_hist = (TH2D*)gROOT->FindObject("dtheta_vs_p_vs_theta"); - if(!ti.theta_res_hist)ti.file->GetObject("dtheta_vs_p_vs_theta", ti.theta_res_hist); - if(!ti.theta_res_hist){ - cout<FindObject("dphi_sigma"); - if(!ti.phi_res_hist)ti.file->GetObject("dphi_sigma", ti.phi_res_hist); - if(!ti.phi_res_hist)ti.phi_res_hist = (TH2D*)gROOT->FindObject("dphi_vs_p_vs_theta"); - if(!ti.phi_res_hist)ti.file->GetObject("dphi_vs_p_vs_theta", ti.phi_res_hist); - if(!ti.phi_res_hist){ - cout<FindObject("eff_vs_p_vs_theta"); - if(!ti.efficiency_hist)ti.file->GetObject("eff_vs_p_vs_theta", ti.efficiency_hist); - if(!ti.efficiency_hist){ - cout<GetYaxis()->FindBin(p); - int thetabin = ti.pt_res_hist->GetXaxis()->FindBin(theta); - - // For tracks with momentum out of the range of our table, use the - // resolutions for the largest momentum we have - if(pbin>ti.pt_res_hist->GetNbinsY())pbin=ti.pt_res_hist->GetNbinsY(); - - if(pbin<1 || pbin>ti.pt_res_hist->GetNbinsY()){pt_res=theta_res=phi_res=0.0; return;} - if(thetabin<1 || thetabin>ti.pt_res_hist->GetNbinsX()){pt_res=theta_res=phi_res=0.0; return;} - - // Here we should do an interpolation from the surrounding bins. - // We have fairly small bins though so I can afford to be - // lazy :) - pt_res = ti.pt_res_hist->GetBinContent(thetabin, pbin); // return as fraction - theta_res = ti.theta_res_hist->GetBinContent(thetabin, pbin); // return in milliradians - phi_res = ti.phi_res_hist->GetBinContent(thetabin, pbin); // return in milliradians -} - -//---------------- -// GetEfficiency -//---------------- -double DTrackingResolutionGEANT::GetEfficiency(TableInfo &ti, int geanttype, const TVector3 &mom) -{ - /// Return the reconstruction efficiency for a charged - /// particle based on results from GEANT-based Monte Carlo studies. - - // Find bins for this momentum. - double p = mom.Mag(); - double theta = mom.Theta()*57.3; - int pbin = ti.efficiency_hist->GetYaxis()->FindBin(p); - int thetabin = ti.efficiency_hist->GetXaxis()->FindBin(theta); - - // For tracks with momentum out of the range of our table, use the - // resolutions for the largest momentum we have - if(pbin>ti.efficiency_hist->GetNbinsY())pbin=ti.efficiency_hist->GetNbinsY(); - - if(pbin<1 || pbin>ti.efficiency_hist->GetNbinsY())return 0.0; - if(thetabin<1 || thetabin>ti.efficiency_hist->GetNbinsX())return 0.0; - - // Here we should do an interpolation from the surrounding bins. - // We have fairly small bins though so I can afford to be - // lazy :) - return ti.efficiency_hist->GetBinContent(thetabin, pbin); -} - - - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.h b/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.h deleted file mode 100644 index f54a3a3760..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANT.h +++ /dev/null @@ -1,49 +0,0 @@ -// $Id$ -// -// File: DTrackingResolutionGEANT.h -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#ifndef _DTrackingResolutionGEANT_ -#define _DTrackingResolutionGEANT_ - -#include -#include - -#include "DTrackingResolution.h" - -class DTrackingResolutionGEANT:public DTrackingResolution{ - public: - - class TableInfo{ - public: - TFile *file; - TH2D* pt_res_hist; - TH2D* theta_res_hist; - TH2D* phi_res_hist; - TH2D* efficiency_hist; - }; - - DTrackingResolutionGEANT(); - virtual ~DTrackingResolutionGEANT(); - virtual const char* className(void){return static_className();} - static const char* static_className(void){return "DTrackingResolutionGEANT";} - - void ReadTableInfo(const char *fname, TableInfo &ti); - - // Accessor methods called through virtual method of DTrackingResolution - void GetResolution(int geanttype, const TVector3 &mom, double &pt_res, double &theta_res, double &phi_res); - double GetEfficiency(int geanttype, const TVector3 &mom); - - // Workhorse methods that actually do the work - void GetResolution(TableInfo &ti, int geanttype, const TVector3 &mom, double &pt_res, double &theta_res, double &phi_res); - double GetEfficiency(TableInfo &ti, int geanttype, const TVector3 &mom); - - private: - TableInfo pion_info; - TableInfo proton_info; -}; - -#endif // _DTrackingResolutionGEANT_ - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.cc b/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.cc deleted file mode 100644 index fd8ca3686e..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.cc +++ /dev/null @@ -1,155 +0,0 @@ -// $Id$ -// -// File: DTrackingResolutionGEANT.cc -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#include -#include - -#include -#include -using namespace std; - -#include - -#include "DTrackingResolutionGEANTphoton.h" -#include "getwebfile.h" - -#define rad2deg (180.0/M_PI) - -//--------------------------------- -// DTrackingResolutionGEANT (Constructor) -//--------------------------------- -DTrackingResolutionGEANTphoton::DTrackingResolutionGEANTphoton() -{ - //int argc=0; - //TApplication *app = new TApplication("myapp", &argc, NULL); - - // Get ROOT file from web if it is not already here - const char *url = "http://www.jlab.org/Hall-D/datatables/hd_res_photon.root"; - getwebfile(url); - - TDirectory *savedir = gDirectory; - - //---------------- hd_res_photon ------------------ - // Open ROOT file - file = new TFile("hd_res_photon.root"); - if(!file->IsOpen()){ - cout<GetName()<<"\""<FindObject("dE_over_E_vs_p_vs_theta"); - if(!E_res_hist)file->GetObject("dE_over_E_vs_p_vs_theta", E_res_hist); - if(!E_res_hist){ - cout<FindObject("dtheta_vs_p_vs_theta"); - if(!theta_res_hist)file->GetObject("dtheta_vs_p_vs_theta", theta_res_hist); - if(!theta_res_hist){ - cout<FindObject("dphi_vs_p_vs_theta"); - if(!phi_res_hist)file->GetObject("dphi_vs_p_vs_theta", phi_res_hist); - if(!phi_res_hist){ - cout<FindObject("eff_vs_p_vs_theta"); - if(!efficiency_hist)file->GetObject("eff_vs_p_vs_theta", efficiency_hist); - if(!efficiency_hist){ - cout<cd(); -} - -//--------------------------------- -// ~DTrackingResolutionGEANT (Destructor) -//--------------------------------- -DTrackingResolutionGEANTphoton::~DTrackingResolutionGEANTphoton() -{ - if(file)delete file; -} - - -//---------------- -// GetResolution -//---------------- -void DTrackingResolutionGEANTphoton::GetResolution(int geanttype, const TVector3 &mom, double &E_res, double &theta_res, double &phi_res) -{ - /// Return the energy and angular resolutions for a charged - /// particle based on results from GEANT-based Monte Carlo studies. - - // Find bins for this momentum. - // Note that we assume the 3 histograms have the same format. - // Namely, number of bins and range so we only need to calculate - // the theta and p bins once. - double p = mom.Mag(); - double theta = mom.Theta()*rad2deg; - int pbin = E_res_hist->GetYaxis()->FindBin(p); - int thetabin = E_res_hist->GetXaxis()->FindBin(theta); - - if(pbin<1 || pbin>E_res_hist->GetNbinsY()){E_res=theta_res=phi_res=0.0; return;} - if(thetabin<1 || thetabin>E_res_hist->GetNbinsX()){E_res=theta_res=phi_res=0.0; return;} - - // Here we should do an interpolation from the surrounding bins. - // We have fairly small bins though so I can afford to be - // lazy :) - E_res = E_res_hist->GetBinContent(thetabin, pbin); // return as fraction - theta_res = theta_res_hist->GetBinContent(thetabin, pbin); // return in milliradians - phi_res = phi_res_hist->GetBinContent(thetabin, pbin); // return in milliradians -} - -//---------------- -// GetEfficiency -//---------------- -double DTrackingResolutionGEANTphoton::GetEfficiency(int geanttype, const TVector3 &mom) -{ - /// Return the reconstruction efficiency for a charged - /// particle based on results from GEANT-based Monte Carlo studies. - - // Find bins for this momentum. - double p = mom.Mag(); - double theta = mom.Theta()*rad2deg; - int pbin = efficiency_hist->GetYaxis()->FindBin(p); - int thetabin = efficiency_hist->GetXaxis()->FindBin(theta); - - if(pbin<1 || pbin>efficiency_hist->GetNbinsY())return 0.0; - if(thetabin<1 || thetabin>efficiency_hist->GetNbinsX())return 0.0; - - // Here we should do an interpolation from the surrounding bins. - // We have fairly small bins though so I can afford to be - // lazy :) - return efficiency_hist->GetBinContent(thetabin, pbin); -} - - diff --git a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.h b/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.h deleted file mode 100644 index a3df57d0ad..0000000000 --- a/src/plugins/Simulation/hdparsim/DTrackingResolutionGEANTphoton.h +++ /dev/null @@ -1,36 +0,0 @@ -// $Id$ -// -// File: DTrackingResolutionGEANT.h -// Created: Mon Feb 25 15:06:17 EST 2008 -// Creator: davidl (on Darwin fwing-dhcp13.jlab.org 8.11.1 i386) -// - -#ifndef _DTrackingResolutionGEANT_ -#define _DTrackingResolutionGEANT_ - -#include -#include - -#include "DTrackingResolution.h" - -class DTrackingResolutionGEANTphoton:public DTrackingResolution{ - public: - DTrackingResolutionGEANTphoton(); - virtual ~DTrackingResolutionGEANTphoton(); - virtual const char* className(void){return static_className();} - static const char* static_className(void){return "DTrackingResolutionGEANT";} - - void GetResolution(int geanttype, const TVector3 &mom, double &E_res, double &theta_res, double &phi_res); - double GetEfficiency(int geanttype, const TVector3 &mom); - - private: - TFile *file; - TH2D* E_res_hist; - TH2D* theta_res_hist; - TH2D* phi_res_hist; - TH2D* efficiency_hist; - -}; - -#endif // _DTrackingResolutionGEANT_ - diff --git a/src/plugins/Simulation/hdparsim/Makefile b/src/plugins/Simulation/hdparsim/Makefile deleted file mode 100644 index 41b9b43244..0000000000 --- a/src/plugins/Simulation/hdparsim/Makefile +++ /dev/null @@ -1,8 +0,0 @@ - -SOLIB_NAME = hdparsim.so - -PACKAGES := ROOT:CURL:DANA -ADDITIONAL_MODULES = HDDM - - -include $(HALLD_HOME)/src/BMS/Makefile.shlib diff --git a/src/plugins/Simulation/hdparsim/getwebfile.c b/src/plugins/Simulation/hdparsim/getwebfile.c deleted file mode 100644 index 7b7547fad4..0000000000 --- a/src/plugins/Simulation/hdparsim/getwebfile.c +++ /dev/null @@ -1,151 +0,0 @@ - -#include -#include - -#ifdef HAS_CURL -#include -#endif // HAS_CURL - -#include "getwebfile.h" - -static int getwebfile_printprogress(void *clientp, double dltotal, double dlnow, double ultotal, double ulnow); - -/*---------------- -/* getwebfile -/*----------------*/ -int getwebfile(const char *url) -{ - FILE *f; - int ungzip = 0; - - /* Check if file is already here */ - const char *fname = url; - const char *ptr; - do{ - ptr = strstr(fname, "/"); - if(ptr)fname=&ptr[1]; - }while(ptr!=NULL); - f = fopen(fname,"r"); - if(f){ - /* File already exists. Do nothing. */ - fclose(f); - printf("Using local file \"%s\"\n", fname); - }else{ -#ifdef HAS_CURL - /* File does not exist. Try downloading. */ - CURL *curl; - printf("No local file: \"%s\".\nAttempting download from %s \n", fname, url); - - /* This should be done globally when there is only one thread */ - curl_global_init(CURL_GLOBAL_ALL); - - /* File does not exist. Try obtaining from URL */ - curl = curl_easy_init(); - - /* Setup the options for the download */ - f = fopen(fname,"w"); - curl_easy_setopt(curl, CURLOPT_VERBOSE, 0); - curl_easy_setopt(curl, CURLOPT_URL, url); - curl_easy_setopt(curl, CURLOPT_WRITEDATA, f); - curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 0); - curl_easy_setopt(curl, CURLOPT_PROGRESSFUNCTION, getwebfile_printprogress); - - /* Download the file */ - curl_easy_perform(curl); - - /* Close CURL */ - curl_easy_cleanup(curl); - - /* Close the downloaded file */ - printf("\n"); - fclose(f); - - /* This should be done at program exit when there is only one thread */ - curl_global_cleanup(); - - /* Set flag to automatically ungzip if this is a gzipped file */ - ungzip = 1; - -#else // HAS_CURL - static int message_printed=0; - if(!message_printed){ - printf("\nFile not compiled with CURL support! This is most likely\n"); - printf("because the curl-config script was not in the PATH when\n"); - printf("this was compiled. It was most likely not in your path\n"); - printf("because the curl-devel package was not installed on your\n"); - printf("system. \n"); - printf("The curl package is only used to automatically download\n"); - printf("the data tables needed by this package. I will now attempt\n"); - printf("to get them by running curl externally via the following:\n"); - printf("\n"); - - message_printed = 1; - } - - char cmd[256]; - sprintf(cmd," curl %s -o %s\n", url, fname); - printf("%s\n", cmd); - system(cmd); -#endif // HAS_CURL - } - - /* If the file is gzipped (and has a .gz suffix) then unzip it */ - if(strlen(fname)>3 && !strcmp(&fname[strlen(fname)-3], ".gz")){ - char *uncompressed_fname = strdup(fname); - char cmd[256]; - - uncompressed_fname[strlen(uncompressed_fname)-3] = 0; /* cut off ".gz" suffix */ - - /* Check if the uncompressed file already exists. Only uncompress if either */ - /* it doesn't exist or was just now (re)downloaded. */ - f = fopen(uncompressed_fname,"r"); - if(!f){ - ungzip = 1; - }else{ - if(ungzip){ - printf("Un-gzipped version (\"%s\") already exists. Overwriting with\n", uncompressed_fname); - printf("file just downloaded (\"%s\")\n", fname); - }else{ - printf("Using existing un-gzipped file \"%s\"\n", uncompressed_fname); - } - fclose(f); - } - - /* Ungzip the file, explicitly giving it's uncompressed filename */ - if(ungzip){ - sprintf(cmd, "gzip -cd %s > %s", fname, uncompressed_fname); - printf("The file \"%s\" appears to be gzipped. Attempting to uncompress with:\n", fname); - printf(" %s\n", cmd); - system(cmd); - } - - /* free memory allocated for uncompressed filename */ - free(uncompressed_fname); - } - - return 0; -} - -/*---------------- -/* getwebfile_printprogress -/*----------------*/ -int getwebfile_printprogress(void *clientp, double dltotal, double dlnow, double ultotal, double ulnow) -{ - printf(" %dkB \r", (unsigned long)(dlnow/1024.0)); - fflush(stdout); -} - - -#if 0 -/* For testing */ -int m ain(int narg, char *argv[]) -{ - - const char *url = "http://zeus.phys.uconn.edu/halld/tagger/simulation/taggerBfield-quad-map.gz"; - - getwebfile(url); - - return 0; -} -#endif - diff --git a/src/plugins/Simulation/hdparsim/getwebfile.h b/src/plugins/Simulation/hdparsim/getwebfile.h deleted file mode 100644 index 907e2a75f8..0000000000 --- a/src/plugins/Simulation/hdparsim/getwebfile.h +++ /dev/null @@ -1,16 +0,0 @@ - -#ifndef GETWEBFILE -#define GETWEBFILE - -#ifdef __cplusplus -extern "C" { -#endif - -int getwebfile(const char *url); - -#ifdef __cplusplus -} -#endif - - -#endif //GETWEBFILE diff --git a/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.cc b/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.cc deleted file mode 100644 index 35a0879212..0000000000 --- a/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.cc +++ /dev/null @@ -1,262 +0,0 @@ -// $Id$ -// -// File: JEventProcessor_recon2mc.cc -// Created: Tue Nov 10 13:07:57 EST 2015 -// Creator: davidl (on Linux gluon47.jlab.org 2.6.32-358.23.2.el6.x86_64 x86_64) -// - -#include - -#include "JEventProcessor_recon2mc.h" -using namespace jana; - -#include -#include - -// These parameters are exposed as JANA config. -// parameters below in init. -string OUTFILENAME = "recon2mc.hddm"; -double MIN_FOM = 1.0E-2; // minimum FOM to accept -double MIN_P = 0.0; // minimum momentum in GeV/c -double MAX_P = 20.0; // maximum momentum in GeV/c -vector pids_to_keep; -double VX = -1000.0; // vertex to override reconstructed one -double VY = -1000.0; // This is only used if the VERTEX config. -double VZ = -1000.0; // parameter is set. -bool OVERRIDE_VERTEX = false; - -using namespace hddm_s; - -// Routine used to create our JEventProcessor -#include -#include -extern "C"{ -void InitPlugin(JApplication *app){ - InitJANAPlugin(app); - app->AddProcessor(new JEventProcessor_recon2mc()); -} -} // "C" - - -//------------------ -// JEventProcessor_recon2mc (Constructor) -//------------------ -JEventProcessor_recon2mc::JEventProcessor_recon2mc() -{ - ostr_s = NULL; - pthread_mutex_init(&mutex, NULL); -} - -//------------------ -// ~JEventProcessor_recon2mc (Destructor) -//------------------ -JEventProcessor_recon2mc::~JEventProcessor_recon2mc() -{ - -} - -//------------------ -// init -//------------------ -jerror_t JEventProcessor_recon2mc::init(void) -{ - // Open output HDDM file - ofs.open(OUTFILENAME.c_str()); - if (! ofs.is_open()) { - std::cout << " Error opening output file \"" << OUTFILENAME << "\"!" << std::endl; - exit(-1); - } - ostr_s = new hddm_s::ostream(ofs); - //ostr_s->setCompression(hddm_s::k_bz2_compression); // hdgeant can't handle compressed files - //ostr_s->setIntegrityChecks(hddm_s::k_crc32_integrity); // hdgeant can't handle integrity checks - - string pidlist = "8,9"; - string vertex = ""; - gPARMS->SetDefaultParameter("OUTFILENAME", OUTFILENAME, "Filename for output HDDM file"); - gPARMS->SetDefaultParameter("MIN_FOM", MIN_FOM, "Minimum tracking FOM for track to be passed to output"); - gPARMS->SetDefaultParameter("MIN_P", MIN_P, "Minimum reconstructed track momentum in GeV/c for track to be passed to output"); - gPARMS->SetDefaultParameter("MAX_P", MAX_P, "Maximum reconstructed track momentum in GeV/c for track to be passed to output"); - gPARMS->SetDefaultParameter("PIDLIST", pidlist, "Comma separated list of GEANT particle numbers indicating types of particles to keep. Empty string means keep them all (probably not what you want)"); - gPARMS->SetDefaultParameter("VERTEX", vertex, "Comma separated vertex coordinates in cm. If empty (default) the reconstructed vertex is used."); - - // Parse PIDLIST - if(pidlist.length()>0){ - stringstream ss(pidlist); - int i; - while (ss >> i){ - pids_to_keep.push_back(i); - if (ss.peek() == ',') ss.ignore(); - } - } - - // Parse VERTEX - if(vertex.length()>0){ - stringstream ss(vertex); - - ss >> VX; - if (ss.peek() == ',') ss.ignore(); - ss >> VY; - if (ss.peek() == ',') ss.ignore(); - ss >> VZ; - - OVERRIDE_VERTEX = true; - } - - jout << "=========================================" << endl; - jout << "recon2mc settings:" << endl; - jout << "-------------------" << endl; - jout << " OUTFILENAME: " << OUTFILENAME << endl; - jout << " MIN_FOM: " << MIN_FOM << endl; - jout << " MIN_P: " << MIN_P << " GeV/c" << endl; - jout << " MAX_P: " << MAX_P << " GeV/c" << endl; - jout << "PIDs to keep: "; - for(uint32_t i=0; i" << endl; - } - - jout << "=========================================" << endl; - - return NOERROR; -} - -//------------------ -// brun -//------------------ -jerror_t JEventProcessor_recon2mc::brun(JEventLoop *eventLoop, int32_t runnumber) -{ - runNumber = runnumber; - - return NOERROR; -} - -//------------------ -// evnt -//------------------ -jerror_t JEventProcessor_recon2mc::evnt(JEventLoop *loop, uint64_t eventnumber) -{ - // Get list of tracks - vector tbts; - loop->Get(tbts); - - // Copy tracks we want to keep to special list - vector tbts_to_keep; - for(uint32_t i=0; iFOM < MIN_FOM) continue; - - // Filter tracks outside acceptable momentum range - double p = tbt->pmag(); - if( pMAX_P) continue; - - // Optionally filter out undesired types - if( !pids_to_keep.empty() ){ - int pid = tbt->PID(); - bool keep = false; - for(uint32_t i=0; itime() ); - origin.setVx( OVERRIDE_VERTEX ? VX:tbt->x() ); - origin.setVy( OVERRIDE_VERTEX ? VY:tbt->y() ); - origin.setVz( OVERRIDE_VERTEX ? VZ:tbt->z() ); - - vtx.addProducts(); - Product &prod = vtx.getProduct(); - prod.setMech(0); - prod.setParentid(0); - prod.setPdgtype( PDGtype(tbt->PID()) ); - prod.setType(tbt->PID()); - - prod.addMomenta(); - Momentum &mom = prod.getMomentum(); - mom.setE( tbt->energy() ); - mom.setPx( tbt->px() ); - mom.setPy( tbt->py() ); - mom.setPz( tbt->pz() ); - - prod.addPropertiesList(); - Properties &prop = prod.getProperties(); - prop.setCharge( tbt->charge() ); - prop.setMass( tbt->mass() ); - - } - - // Write hddm event to output - pthread_mutex_lock(&mutex); - *ostr_s << hddm; - pthread_mutex_unlock(&mutex); - - return NOERROR; -} - -//------------------ -// erun -//------------------ -jerror_t JEventProcessor_recon2mc::erun(void) -{ - // This is called whenever the run number changes, before it is - // changed to give you a chance to clean up before processing - // events from the next run number. - return NOERROR; -} - -//------------------ -// fini -//------------------ -jerror_t JEventProcessor_recon2mc::fini(void) -{ - - // Close output HDDM file - delete ostr_s; - ofs.close(); - - return NOERROR; -} - diff --git a/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.h b/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.h deleted file mode 100644 index 34256951de..0000000000 --- a/src/plugins/Simulation/recon2mc/JEventProcessor_recon2mc.h +++ /dev/null @@ -1,38 +0,0 @@ -// $Id$ -// -// File: JEventProcessor_recon2mc.h -// Created: Tue Nov 10 13:07:57 EST 2015 -// Creator: davidl (on Linux gluon47.jlab.org 2.6.32-358.23.2.el6.x86_64 x86_64) -// - -#ifndef _JEventProcessor_recon2mc_ -#define _JEventProcessor_recon2mc_ - -#include -#include -#include - -using namespace std; - -class JEventProcessor_recon2mc:public jana::JEventProcessor{ - public: - JEventProcessor_recon2mc(); - ~JEventProcessor_recon2mc(); - const char* className(void){return "JEventProcessor_recon2mc";} - - private: - jerror_t init(void); ///< Called once at program start. - jerror_t brun(jana::JEventLoop *eventLoop, int32_t runnumber); ///< Called everytime a new run number is detected. - jerror_t evnt(jana::JEventLoop *eventLoop, uint64_t eventnumber); ///< Called every event. - jerror_t erun(void); ///< Called everytime run number changes, provided brun has been called. - jerror_t fini(void); ///< Called after last event of last event source has been processed. - - - int runNumber; - hddm_s::ostream *ostr_s; - ofstream ofs; - pthread_mutex_t mutex; -}; - -#endif // _JEventProcessor_recon2mc_ - diff --git a/src/plugins/Simulation/recon2mc/README b/src/plugins/Simulation/recon2mc/README deleted file mode 100644 index 22101ced1b..0000000000 --- a/src/plugins/Simulation/recon2mc/README +++ /dev/null @@ -1,52 +0,0 @@ - -Nov. 11, 2015 -David Lawrence - - -This plugin will extract reconstructed particle -parameters and write them to an HDDM file that -can then be used as input to a simulation job. -For now, it only deals with charged tracks. The -simplest usage example is: - -> hd_ana -PPLUGINS=recon2mc hd_rawdata_002931_002.evio - - -A few configuration parameters exist that can be -used to filter which tracks are written. These are: - -OUTFILENAME Filename for output HDDM file - -MIN_FOM Minimum tracking FOM for track to be - passed to output - -MIN_P Minimum reconstructed track momentum in - GeV/c for track to be passed to output - -MAX_P Maximum reconstructed track momentum in - GeV/c for track to be passed to output - -PIDLIST Comma separated list of GEANT particle - numbers indicating types of particles to - keep. Empty string means keep them all - (probably not what you want) - -VERTEX Comma separated vertex coordinates in cm. - If empty (default) the reconstructed vertex - is used. - - -Usually, one will want to filter on the particle -type. Otherwise, all mass hypotheses will be written -out resulting in multiple tracks on top of one another. - -The VERTEX parameter is provided in case you would like -to force all particles to come from a specific location -(e.g. the center of the target). Otherwise, the single -track reconstructed vertex will be used. - -If you want to apply other criteria to filter out -events or tracks you will need to modify the -JEventProcessor_recon2mc.cc file. There is a comment -block in the evnt() method that indicates the best -place to do this. diff --git a/src/plugins/Simulation/recon2mc/SConscript b/src/plugins/Simulation/recon2mc/SConscript deleted file mode 100644 index 1fb423a396..0000000000 --- a/src/plugins/Simulation/recon2mc/SConscript +++ /dev/null @@ -1,14 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -env.AppendUnique(LIBS=['DAQ']); - -sbms.AddDANA(env) -sbms.plugin(env) - - diff --git a/src/plugins/Utilities/danaevio/JEventProcessor_danaevio.cc b/src/plugins/Utilities/danaevio/JEventProcessor_danaevio.cc index 064a3db9b9..8f183c9f10 100644 --- a/src/plugins/Utilities/danaevio/JEventProcessor_danaevio.cc +++ b/src/plugins/Utilities/danaevio/JEventProcessor_danaevio.cc @@ -19,7 +19,7 @@ // dana_evio_dict.xml is corresponding evio2xml dictionary // // E.g. to run: -// $HALLD_HOME/bin/Linux_CentOS5-x86_64-gcc4.1.2/hd_ana --plugin=danaevio -PEVIO:DANAEVIO="all" ../Event.hddm +// $HALLD_RECON_HOME/bin/Linux_CentOS5-x86_64-gcc4.1.2/hd_ana --plugin=danaevio -PEVIO:DANAEVIO="all" ../Event.hddm // // // Elliott Wolin, 19-Jul-2010 diff --git a/src/programs/AmplitudeAnalysis/Examples/Makefile b/src/programs/AmplitudeAnalysis/Examples/Makefile deleted file mode 100644 index db0fc4ba0f..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/Makefile +++ /dev/null @@ -1,7 +0,0 @@ -DIRS += threepi_binned - -ifdef AMPPLOTTER -DIRS += threepi_all -endif - -include $(HALLD_HOME)/src/BMS/Makefile.dirs diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_all/Makefile b/src/programs/AmplitudeAnalysis/Examples/threepi_all/Makefile deleted file mode 100644 index fc730b8271..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_all/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES = AmpTools:AmpPlotter:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_all/README b/src/programs/AmplitudeAnalysis/Examples/threepi_all/README deleted file mode 100644 index 70ff98715d..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_all/README +++ /dev/null @@ -1,179 +0,0 @@ - -Requirements: - -This example requires that version 0.6 or later of AmpTools -(amptools.sourceforge.net). Compile the main AmpTools library and set -the environment variable AMPTOOLS to point this directory (the directory -that contains (GPUManager, GPUUtils, IUAmpTools, ...) *before* compiling -the GlueX source tree. - -This example also requires version 0.6 or later of the AmpPlotter -package that is distributed with AmpTools. Compile the AmpPlotter library -and set the environment variable AMPPLOTTER to point to the top-level -directory of AmpPlotter (that contains the Makefile). - -The goals of this example are: - -A. (i) Generate gamma p -> pi+ pi- pi+ n events, both with physics amplitudes and without - (ii) Pass generated events through mock toy_detector or the simulated GlueX detector -B. Perform a fit to extract the production amplitudes for several resonances -C. Use the AmpPlotter library to view projections of the fit - -<><><><><><><> Quick recipe for doing example <><><><><><><><> -cd $HALLD_HOME/src/programs/AmplitudeAnalysis/Examples/threepi_all -cp ../../../Simulation/gen_3pi/gen_3pi.cfg . -gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -l 0.7 -u 2.0 -n 50000 -toy_detector threepi_data_gen.root threepi_data.root -gen_3pi -c gen_3pi.cfg -o threepi_gen.root -f -l 0.7 -u 2.0 -n 200000 -toy_detector threepi_gen.root threepi_acc.root -fit -c fit_3pi.cfg -threepi_plotter threepi.fit -<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - -<><><><>Alternate recipe that uses the GlueX Detector <><><><><><> -cd $HALLD_HOME/src/programs/AmplitudeAnalysis/Examples/threepi_all -cp ../../../Simulation/gen_3pi/gen_3pi.cfg . -gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -hd threepi_data_gen.hddm -l 0.7 -u 2.0 -n 50000 - --> run HDGeant on threepi_data_gen.hddm and anlayze the output and --> write it to a file called threepi_data.root using the format --> encoded in the ROOTDataReader and put it in this directory - -gen_3pi -c gen_3pi.cfg -o threepi_gen.root -hd threepi_gen.hddm -f -l 0.7 -u 2.0 -n 200000 - --> run HDGeant on threepi_gen.hddm and anlayze the output and --> write it to a file called threepi_acc.root using the format --> encoded in the ROOTDataReader and put it in this directory - -fit -c fit_3pi.cfg -threepi_plotter threepi.fit -<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - -------------------------------------------------- -A. Generate MC events -------------------------------------------------- - -1. We first need to create a sample of MC that will act as the - data. This sample should be generated with appropriate - physics angular distributions. The executable gen_3pi is - provided for this. You should copy the configuration file - distributed with gen_3pi to the current working directory. - - cp ../../../Simulation/gen_3pi/gen_3pi.cfg . - - To generate at least 50000 events with 3 pi invariant mass - from 0.7-2.0 GeV/c^2 run the command: - - gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -l 0.7 -u 2.0 -n 50000 - - You can examine the gen_3pi.cfg file to see the various generated - resonances and strengths. The default file utilizes 100% - polarized beam, but this can be altered as noted in the file. - - In reality the file would then be passed through HDGeant and also - some reconstruction program. To save, time, we will use the - executable toy_detector, which randomly throws away some events - based on M(pi+pi-pi+) (examine source for details). Run: - - toy_detector threepi_data_gen.root threepi_data.root - - The file threepi_data.root is the analog of reconstructed data - acquired with the detector. The file threepi_data_gen.root - has no analog in a real analysis as it would correspond to - list of the actual four-vectors produced in the pure signal events. - -1. (Alternate) You can use the -hd flag to write out an HDDM - version of the generated file. - - gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -hd threepi_data_gen.hddm -l 0.7 -u 2.0 -n 50000 - - Instead of using the toy_detector application then take this - HDDM file and pass it through HDGeant and the analysis framework. - Write the output of the analysis to a file called threepi_data.root - and place it in this directory. It is important that the output - be formatted properly. These examples utilize the ROOTDataReader - in the library AMPTOOLS_DATAIO. You may have to examine the source - code of this data reader to understand the expected format of the - source tree. Proper order of the particles in the final state - arrays is important. - -2. Normalization of the probability distribution functions used in - the fit depends on Monte-Carlo integration of the product of - the detector acceptance and the model-predicted density of events - over phase space. In order to construct these integrals we need - samples of generated and accepted Monte Carlo which do not have - any physics amplitudes. We use the -f flag to gen_3pi to do this. - (A configuration file is still needed although its contents are not used.) - - gen_3pi -c gen_3pi.cfg -o threepi_gen.root -f -l 0.7 -u 2.0 -n 200000 - - Again we will use the toy_detector application: - - toy_detector threepi_gen.root threepi_acc.root - - These two files represent files that would actually be present in an - analysis that uses real data (with the exception that toy_detector - would be replaced by HDGeant + reconstruction). - -2. (Alternate) Write a copy of the phase space MC to an HDDM file also - - gen_3pi -c ../../../Simulation/gen_3pi/gen_3pi.cfg -o threepi_gen.root -hd threepi_gen.hddm -f -l 0.7 -u 2.0 -n 200000 - - As in step 1 above, perform the detector simulation and analysis and - write the output to a ROOT file in this directory called - threepi_acc.root - -------------------------------------------------- -B. Perform fit -------------------------------------------------- - -1. In this fit we are simply going to try to fit for what was input to the - the generator. We will perform a "mass dependent fit" under the assumption - that the resonances in 3 pi are described by the simple Breit-Wigner - shapes that we generated. The file fit_3pi.cfg is provided to configure - the fit. Note the only difference between it and the gen_3pi.cfg file - used to generate the sample is that the locations of the input and - MC files are specified and one of the fit parameters is fixed to be real. - (There is always an arbitrary overall phase when performing a fit that - needs to be removed by fixing a parameter to be real.) - - Perform the fit by executing the command: - - fit -c fit_3pi.cfg - - You can examine the output on the screen. The results of the fit will - be written to the file threepi.fit. This file contains information - about the configuration of the fit as well as the parameter values, - covariances, and information about the convergence of MINUIT. - - -------------------------------------------------- -C. View fit results using AmpPlotter GUI package -------------------------------------------------- - -1. To view the results of the fit we will use the threepi_plotter - application. The application generates plots of data and - the Monte Carlo that has been weighted by the intensity - determined by the fit. First examine the source code of - threepi_plotter. The only relevant items are the definition - of the PlotGenerator (in the example ThreePiPlotGenerator) and - the registration of the amplitudes and data readers used in - the fit. - -2. The definition of ThreePiPlotGenerator can be found in the library - AMPTOOLS_DATAIO. The source for this class specifies which 1D - histograms to create and how to fill these histograms for a single - event. It is useful to look at distributions that can be used to - distinguish the various physics amplitudes like invariant masses - and angles. - -3. Start up the plotter GUI, passing in the fit results on the command - line: - - threepi_plotter threepi.fit - - The GUI allows you to turn off and on amplitudes, select a projection - and generate plots of data and/or MC. Access to both the accepted - and generated MC is provided so the acceptance can be studied in - the variables of interest. \ No newline at end of file diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_all/fit_3pi.cfg b/src/programs/AmplitudeAnalysis/Examples/threepi_all/fit_3pi.cfg deleted file mode 100644 index 7ff821ed1c..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_all/fit_3pi.cfg +++ /dev/null @@ -1,131 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - - -# useful masses and widths -define a1 1.23 0.4 -define a2 1.318 0.105 -define pi1 1.60 0.2 -define pi2 1.67 0.259 - -define rho 0.775 0.146 -define f2 1.270 0.185 - -# J, P and isospin definitions for resonances -define a2JPI 2 1 1 -define pi2JPI 2 -1 1 -define a1JPI 1 1 1 -define pi1JPI 1 -1 1 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -define rho0pi+ 1 1 1 -1 1 - -# isobar definitions for f2pi final state -define f2pi+ 2 0 1 -1 1 - -fit threepi - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -reaction Pi+Pi-Pi+ gamma n Pi+ Pi- Pib - -genmc Pi+Pi-Pi+ ROOTDataReader threepi_gen.root -accmc Pi+Pi-Pi+ ROOTDataReader threepi_acc.root -data Pi+Pi-Pi+ ROOTDataReader threepi_data.root - -normintfile Pi+Pi-Pi+ threepi_ni.txt - -# this file has the y polarization states if partial or unpolarized beams -# are needed -#include gen_3pi_ypol.cfg - -# consider just x polarized amplitudes -sum Pi+Pi-Pi+ xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S ThreePiAngles beamX a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner a1 0 23 4 -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D ThreePiAngles beamX a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner a2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P ThreePiAngles beamX pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner pi1 1 23 4 -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S ThreePiAngles beamX pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner pi2 0 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::xpol::pi2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P ThreePiAngles beamX pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner pi2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi2_rhopi_P 0 1 4 3 2 - -initialize Pi+Pi-Pi+::xpol::a1_rhopi_S cartesian 3.0 0.0 real -initialize Pi+Pi-Pi+::xpol::a2_rhopi_D cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi1_rhopi_P cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_f2pi_S cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_rhopi_P cartesian 1.0 0.0 - - - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_all/threepi_plotter.cc b/src/programs/AmplitudeAnalysis/Examples/threepi_all/threepi_plotter.cc deleted file mode 100644 index 62f942795b..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_all/threepi_plotter.cc +++ /dev/null @@ -1,99 +0,0 @@ -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/ThreePiPlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" -#include "AMPTOOLS_AMPS/ThreePiAngles.h" - -typedef ThreePiPlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerAmplitude( ThreePiAngles() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); -} - - -// THE USER SHOULD NOT HAVE TO CHANGE ANYTHING BELOW THIS LINE -// ************************************************************* - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter *** " << endl << endl; - - if (argc <= 1){ - cout << "Usage:" << endl << endl; - cout << "\tthreepi_plotter " << endl << endl; - return 0; - } - - - // ************************ - // parse the command line parameters - // ************************ - - string resultsName(argv[1]); - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - - // ************************ - // start the GUI - // ************************ - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - PlotFactory factory( plotGen ); - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - - app.Run(); - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/Makefile b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/Makefile deleted file mode 100644 index 021d064270..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/Makefile +++ /dev/null @@ -1,4 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/README b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/README deleted file mode 100644 index acd78edf19..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/README +++ /dev/null @@ -1,221 +0,0 @@ -Requirements: - -This example requires that version 0.6 or later of AmpTools -(amptools.sourceforge.net). Compile the main AmpTools library and set -the environment variable AMPTOOLS to point this directory (the directory -that contains (GPUManager, GPUUtils, IUAmpTools, ...) *before* compiling -the GlueX source tree. - -The goals of this example are: - -A. (i) Generate gamma p -> pi+ pi- pi+ n events, both with physics amplitudes and without - (ii) Pass generated events through mock toy_detector or the simulated GlueX detector -B. Perform a fit to extract the production amplitudes as a function of M(pi+ pi- pi+) -C. Collect results of multiple fits in a table and display the output - -<><><><><><><> Quick recipe for doing example <><><><><><><><> -cd $HALLD_HOME/src/programs/AmplitudeAnalysis/Examples/threepi_binned -cp ../../../Simulation/gen_3pi/gen_3pi.cfg . -gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -l 0.7 -u 2.0 -n 50000 -toy_detector threepi_data_gen.root threepi_data.root -gen_3pi -c gen_3pi.cfg -o threepi_gen.root -f -l 0.7 -u 2.0 -n 200000 -toy_detector threepi_gen.root threepi_acc.root -./divideData.pl -cd threepi_fit/bin_10 -fit -c bin_10.cfg -s ../param_init.cfg -cd ../.. -./driveFit.pl -plot_3pi -o threepi_fit.txt -root -l drawWaves.C -<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - -<><><><>Alternate recipe that uses the GlueX Detector <><><><><><> -cd $HALLD_HOME/src/programs/AmplitudeAnalysis/Examples/threepi_binned -cp ../../../Simulation/gen_3pi/gen_3pi.cfg . -gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -hd threepi_data_gen.hddm -l 0.7 -u 2.0 -n 50000 - --> run HDGeant on threepi_data_gen.hddm and anlayze the output and --> write it to a file called threepi_data.root using the format --> encoded in the ROOTDataReader and put it in this directory - -gen_3pi -c gen_3pi.cfg -o threepi_gen.root -hd threepi_gen.hddm -f -l 0.7 -u 2.0 -n 200000 - --> run HDGeant on threepi_gen.hddm and anlayze the output and --> write it to a file called threepi_acc.root using the format --> encoded in the ROOTDataReader and put it in this directory - -./divideData.pl -cd threepi_fit/bin_10 -fit -c bin_10.cfg -s ../param_init.cfg -cd ../.. -./driveFit.pl -plot_3pi -o threepi_fit.txt -root -l drawWaves.C -<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><> - - -------------------------------------------------- -A. Generate MC events -------------------------------------------------- - -1. We first need to create a sample of MC that will act as the - data. This sample should be generated with appropriate - physics angular distributions. The executable gen_3pi is - provided for this. You should copy the configuration file - distributed with gen_3pi to the current working directory. - - cp ../../../Simulation/gen_3pi/gen_3pi.cfg . - - To generate at least 50000 events with 3 pi invariant mass - from 0.7-2.0 GeV/c^2 run the command: - - gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -l 0.7 -u 2.0 -n 50000 - - You can examine the gen_3pi.cfg file to see the various generated - resonances and strengths. The default file utilizes 100% - polarized beam, but this can be altered as noted in the file. - - In reality the file would then be passed through HDGeant and also - some reconstruction program. To save, time, we will use the - executable toy_detector, which randomly throws away some events - based on M(pi+pi-pi+) (examine source for details). Run: - - toy_detector threepi_data_gen.root threepi_data.root - - The file threepi_data.root is the analog of reconstructed data - acquired with the detector. The file threepi_data_gen.root - has no analog in a real analysis as it would correspond to - list of the actual four-vectors produced in the pure signal events. - -1. (Alternate) You can use the -hd flag to write out an HDDM - version of the generated file. - - gen_3pi -c gen_3pi.cfg -o threepi_data_gen.root -hd threepi_data_gen.hddm -l 0.7 -u 2.0 -n 50000 - - Instead of using the toy_detector application then take this - HDDM file and pass it through HDGeant and the analysis framework. - Write the output of the analysis to a file called threepi_data.root - and place it in this directory. It is important that the output - be formatted properly. These examples utilize the ROOTDataReader - in the library AMPTOOLS_DATAIO. You may have to examine the source - code of this data reader to understand the expected format of the - source tree. Proper order of the particles in the final state - arrays is important. - -2. Normalization of the probability distribution functions used in - the fit depends on Monte-Carlo integration of the product of - the detector acceptance and the model-predicted density of events - over phase space. In order to construct these integrals we need - samples of generated and accepted Monte Carlo which do not have - any physics amplitudes. We use the -f flag to gen_3pi to do this. - (A configuration file is still needed although its contents are not used.) - - gen_3pi -c gen_3pi.cfg -o threepi_gen.root -f -l 0.7 -u 2.0 -n 200000 - - Again we will use the toy_detector application: - - toy_detector threepi_gen.root threepi_acc.root - - These two files represent files that would actually be present in an - analysis that uses real data (with the exception that toy_detector - would be replaced by HDGeant + reconstruction). - -2. (Alternate) Write a copy of the phase space MC to an HDDM file also - - gen_3pi -c ../../../Simulation/gen_3pi/gen_3pi.cfg -o threepi_gen.root -hd threepi_gen.hddm -f -l 0.7 -u 2.0 -n 200000 - - As in step 1 above, perform the detector simulation and analysis and - write the output to a ROOT file in this directory called - threepi_acc.root - -------------------------------------------------- -B. Perform fit -------------------------------------------------- - -1. We are intersted in extracting the production amplitudes as a function - of M(pi+pi-pi+). For each of the produced resonances, we expect the - production amplitudes to trace out Breit-Wigners as a function of M(pi+pi-pi+). - (This is precisely the behavior we have generated with the configuration - file gen_3pi.cfg.) In order to extract the production amplitudes as - a function of resonance mass, we divide the data into bins of M(pi+pi-pi+) - and then perform a fit in each bin. The parameters of this fit are related - to the production amplitudes for the various resonances. - - A PERL script, which invokes the command line tool split_mass, is provided - to do this division and organize the fits. Examine the variables - at the top of divideData.pl to ensure they are correct. Then run - - ./divideData.pl - - This should create a directory called threepi_fit and inside of this - directory are (by default) 65 subdirectories spanning M(pi+pi-pi+) from - 0.7 to 2.0 GeV/c^2. - - Note: The behavior of the fit, e.g., amplitudes in the fit, free parameters, - input polarization, etc., is controlled by the template file. For fits - with full polarization, the relevant file is threepi_pol_TEMPLATE.cfg. - This file will be utilized by the script to generate configuration files - in each of the bin directories. The default template is a good match - to the generated gen_3pi.cfg file used above. It is instructive to - examine and understand the differences in the amplitude structure in - these two files. - -2. A common practice is to seed the fit of one bin with the best fit values of - the previous bin. Since parameters tend to be continusously varying - this starts the fit off close to minimum. In order to do this - we need a seed to start the process. One can simply go into any - directory and do a fit and copy the fit output to seed file. - The example below uses bin 10 for this: - - cd threepi_fit/bin_10 - fit -c bin_10.cfg -s ../param_init.cfg - cd .. - - The -s flag passed to fit tells the fit application to write out a - "seed file" which is the parameter initialization of the configuration - file. The seed file is only written if the fit was successful. This seed - file can be included using the include command in the config file for - the next fit. Now it is time to sequentially fit all bins. Check the - variables at the top of the driveFit.pl script. Then run: - - ./driveFit - - This will fit all bins and log the fit output to files in each directory. - -------------------------------------------------- -C. View fit results -------------------------------------------------- - -1. The raw fit parameters are not particularly meaningful. One - needs both the fit parameters and the integrals of the amplitudes - over phase space to construct a quantity like the fit-predicted - number of events for a particular amplitude. Because of this - a simple C++ command line tool (plot_3pi.cc), which utilizes - the fitting framework, has been provided to generate a text - file of meaningful numbers that can be passed into ROOT. - - Examine the source code of plot_3pi.cc. Some important numbers - and paths are hard-coded at the begining of main{}. In the body - of the program note the correspondence between the amplitude - names used in the function calls and those in the fit configuration file. - (Again, this is hard-coded. It could for example be derived from a - configuration file, or a GUI -- this is a simple specialized tool - for quickly generating some numbers.) To generate a table of numbers - run: - - plot_3pi -o threepi_fit.txt - - You can examine the file threepi_fit.txt -- for each bin of mass - (left column) is listed the predicted number of generated events - for each of the amplitudes along with the error on this number. - The numbers of events listed have been corrected for acceptance - based on the Monte-Carlo samples. - -2. A ROOT script has been provided to read in this file and - and make a plot. Execute the script by running: - - root -l drawWaves.C - - The plot that contains all waves is particularly interesting. - It could, in principle, be compared to the M(pi+pi-pi+) mass - distribution in the file threepi_data_gen.root diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/divideData.pl b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/divideData.pl deleted file mode 100755 index e23c8b01a4..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/divideData.pl +++ /dev/null @@ -1,89 +0,0 @@ -#!/usr/bin/perl - -use Cwd; - -$lowMass = 0.7; -$highMass = 2.0; -$nBins = 65; - -$fitName = "threepi_fit"; - -# put a limit on the number of data events to process -# gen MC and acc MC smaples are not limited -$maxEvts = 1E9; - -# this directory can be adjusted if you want to do the fit elsewhere -# but it needs to be an explicit path -$workingDir = getcwd(); - -# these files must exist in the working directory. If you don't know how -# to generate them or don't have them, see the documentation in gen_3pi -# the Simulation area of the repository -$dataFile = "$workingDir/threepi_data.root"; -$accMCFile = "$workingDir/threepi_acc.root"; -$genMCFile = "$workingDir/threepi_gen.root"; - -# this file sould be used for partially polarized or unpolarized beam fits -#$cfgTempl = "$workingDir/threepi_unpol_TEMPLATE.cfg"; - -# this file should be used when there is 100% beam polarization -$cfgTempl = "$workingDir/threepi_pol_TEMPLATE.cfg"; - - -### things below here probably don't need to be modified - -# this is where the goodies for the fit will end up -$fitDir = "$workingDir/$fitName/"; -mkdir $fitDir unless -d $fitDir; - -chdir $fitDir; - -# use the split_mass command line tool to divide up the -# data into bins of resonance mass - -@dataParts = split /\//, $dataFile; -$dataTag = pop @dataParts; -$dataTag =~ s/\.root//; -system( "split_mass $dataFile $dataTag $lowMass $highMass $nBins $maxEvts" ); - -@accMCParts = split /\//, $accMCFile; -$accMCTag = pop @accMCParts; -$accMCTag =~ s/\.root//; -system( "split_mass $accMCFile $accMCTag $lowMass $highMass $nBins" ); - -@genMCParts = split /\//, $genMCFile; -$genMCTag = pop @genMCParts; -$genMCTag =~ s/\.root//; -system( "split_mass $genMCFile $genMCTag $lowMass $highMass $nBins" ); - -# make directories to perform the fits in -for( $i = 0; $i < $nBins; ++$i ){ - - mkdir "bin_$i" unless -d "bin_$i"; - - system( "mv *\_$i.root bin_$i" ); - - chdir "bin_$i"; - - open( CFGOUT, ">bin_$i.cfg" ); - open( CFGIN, $cfgTempl ); - - while( ){ - - s/DATAFILE/$dataTag\_$i.root/; - s/ACCMCFILE/$accMCTag\_$i.root/; - s/GENMCFILE/$genMCTag\_$i.root/; - s/NIFILE/bin_$i.ni/; - s/FITNAME/bin_$i/; - - print CFGOUT $_; - } - - close CFGOUT; - close CFGIN; - - system( "touch param_init.cfg" ); - - chdir $fitDir; -} - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/drawWaves.C b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/drawWaves.C deleted file mode 100644 index 8a3a26668a..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/drawWaves.C +++ /dev/null @@ -1,147 +0,0 @@ - -{ - - ifstream in; - in.open( "threepi_fit.txt" ); - - enum { kMaxPoints = 100 }; - - double ll = 0.7; - double ul = 2.0; - - double eventCounter = 0; - - double mass[kMaxPoints]; - double masse[kMaxPoints]; - double rhoPiSWave[kMaxPoints]; - double rhoPiSWavee[kMaxPoints]; - double rhoPiDWave[kMaxPoints]; - double rhoPiDWavee[kMaxPoints]; - double rhoPiPXWave[kMaxPoints]; - double rhoPiPXWavee[kMaxPoints]; - double f2PiSWave[kMaxPoints]; - double f2PiSWavee[kMaxPoints]; - double rhoPiPWave[kMaxPoints]; - double rhoPiPWavee[kMaxPoints]; - double all[kMaxPoints]; - double alle[kMaxPoints]; - double phaseDP[kMaxPoints]; - double phaseDPe[kMaxPoints]; - double phaseDS[kMaxPoints]; - double phaseDSe[kMaxPoints]; - - int line = 0; - while( ! in.eof() ){ - - in >> mass[line] - >> rhoPiSWave[line] >> rhoPiSWavee[line] - >> rhoPiDWave[line] >> rhoPiDWavee[line] - >> rhoPiPXWave[line] >> rhoPiPXWavee[line] - >> f2PiSWave[line] >> f2PiSWavee[line] - >> rhoPiPWave[line] >> rhoPiPWavee[line] - >> all[line] >> alle[line] - >> phaseDP[line] >> phaseDPe[line] - >> phaseDS[line] >> phaseDSe[line]; - - eventCounter += all[line]; - - line++; - } - - TGraphErrors rhoPiSWaveGraph( line, mass, rhoPiSWave, masse, rhoPiSWavee ); - rhoPiSWaveGraph.SetMarkerStyle( 20 ); - rhoPiSWaveGraph.SetMarkerSize( .5 ); - TGraphErrors rhoPiDWaveGraph( line, mass, rhoPiDWave, masse, rhoPiDWavee ); - rhoPiDWaveGraph.SetMarkerStyle( 20 ); - rhoPiDWaveGraph.SetMarkerSize( 0.5 ); - TGraphErrors rhoPiPXWaveGraph( line, mass, rhoPiPXWave, masse, rhoPiPXWavee ); - rhoPiPXWaveGraph.SetMarkerStyle( 20 ); - rhoPiPXWaveGraph.SetMarkerSize( 0.5 ); - TGraphErrors f2PiSWaveGraph( line, mass, f2PiSWave, masse, f2PiSWavee ); - f2PiSWaveGraph.SetMarkerStyle( 20 ); - f2PiSWaveGraph.SetMarkerSize( 0.5 ); - TGraphErrors rhoPiPWaveGraph( line, mass, rhoPiPWave, masse, rhoPiPWavee ); - rhoPiPWaveGraph.SetMarkerStyle( 20 ); - rhoPiPWaveGraph.SetMarkerSize( 0.5 ); - TGraphErrors allGraph( line, mass, all, masse, alle ); - allGraph.SetMarkerStyle( 20 ); - allGraph.SetMarkerSize( 0.5 ); - TGraphErrors phaseDPGraph( line, mass, phaseDP, masse, phaseDPe ); - phaseDPGraph.SetMarkerStyle( 20 ); - phaseDPGraph.SetMarkerSize( 0.5 ); - TGraphErrors phaseDSGraph( line, mass, phaseDS, masse, phaseDSe ); - phaseDSGraph.SetMarkerStyle( 20 ); - phaseDSGraph.SetMarkerSize( 0.5 ); - - TCanvas* can = new TCanvas( "can", "Amplitude Analysis Plots", 800, 800 ); - can->Divide( 2, 4 ); - - can->cd( 1 ); - TH1F h1( "h1", "1^{+} #rho#pi S", 1, ll, ul ); - h1.SetMaximum( 3100 ); - h1.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h1.SetStats( 0 ); - h1.Draw(); - rhoPiSWaveGraph.Draw( "P" ); - - can->cd( 2 ); - TH1F h2( "h2", "1^{-} #rho#pi P", 1, ll, ul ); - h2.SetMaximum( 300 ); - h2.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h2.SetStats( 0 ); - h2.Draw(); - rhoPiPXWaveGraph.Draw( "P" ); - - can->cd( 3 ); - TH1F h3( "h3", "2^{+} #rho#pi D", 1, ll, ul ); - h3.SetMaximum( 2000 ); - h3.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h3.SetStats( 0 ); - h3.Draw(); - rhoPiDWaveGraph.Draw( "P" ); - - can->cd( 4 ); - TH1F h4( "h4", "2^{-} f_{2}#pi S", 1, ll, ul ); - h4.SetMaximum( 1200 ); - h4.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h4.SetStats( 0 ); - h4.Draw(); - f2PiSWaveGraph.Draw( "P" ); - - can->cd( 5 ); - TH1F h5( "h5", "2^{-} #rho#pi P", 1, ll, ul ); - h5.SetMaximum( 1200 ); - h5.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h5.SetStats( 0 ); - h5.Draw(); - rhoPiPWaveGraph.Draw( "P" ); - - can->cd( 6 ); - TH1F h6( "h6", "3#pi All Waves", 1, ll, ul ); - h6.SetMaximum( 4000 ); - h6.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h6.SetStats( 0 ); - h6.Draw(); - allGraph.Draw( "P" ); - - can->cd( 7 ); - TH1F h7( "h7", "Phase( 2^{+} #rho#pi D ) - Phase( 1^{-} #rho#pi P )", 1, ll, ul ); - h7.SetMaximum( 6.28 ); - h7.SetMinimum( -6.28 ); - h7.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h7.SetStats( 0 ); - h7.Draw(); - phaseDPGraph.Draw( "P" ); - - can->cd( 8 ); - TH1F h8( "h8", "Phase( 2^{+} #rho#pi D ) - Phase( 2^{-} f_{2}#pi S )", 1, ll, ul ); - h8.SetMaximum( 6.28 ); - h8.SetMinimum( -6.28 ); - h8.GetXaxis()->SetTitle( "3#pi Invariant Mass [GeV/c^{2}]" ); - h8.SetStats( 0 ); - h8.Draw(); - phaseDSGraph.Draw( "P" ); - - cout << "Total number of events: " << eventCounter << endl; -} - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/driveFit.pl b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/driveFit.pl deleted file mode 100755 index 5f49f768ff..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/driveFit.pl +++ /dev/null @@ -1,35 +0,0 @@ -#!/usr/bin/perl - -use Cwd; - -# be sure that these settings agree with what was used in the divideData script -$nBins = 65; -$fitName = "threepi_fit"; - -# this directory can be adjusted if you want to do the fit elsewhere -# but it needs to be an explicit path -$workingDir = getcwd(); - -# this is the name of the file that will be used to store values used -# to see the parameters inthe fit -$seedFile = "param_init.cfg"; - -### things below here probably don't need to be modified - -$fitDir = "$workingDir/$fitName"; -$lastParams = "$fitDir/$seedFile"; - -for( $i = 0; $i < $nBins; ++$i ){ - - chdir $fitDir; - chdir "bin_$i"; - - print "Fitting in bin $i...\n"; - - system( "fit -c bin_$i.cfg -s $seedFile > bin_$i.log" ); - - if( -e "$seedFile" ){ system( "cp -f $seedFile .." ); } - - chdir $fitDir; -} - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/plot_3pi.cc b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/plot_3pi.cc deleted file mode 100644 index 06ab64651c..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/plot_3pi.cc +++ /dev/null @@ -1,138 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "IUAmpTools/FitResults.h" - -using namespace std; - -int main( int argc, char* argv[] ){ - - // these params should probably come in on the command line - double lowMass = 0.7; - double highMass = 2.0; - enum{ kNumBins = 65 }; - string fitDir( "threepi_fit" ); - - // set default parameters - - string outfileName(""); - - // parse command line - - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outfileName = argv[++i]; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t Ouput text file" << endl; - exit(1);} - } - - if (outfileName.size() == 0){ - cout << "No output file specified" << endl; - exit(1); - } - - double step = ( highMass - lowMass ) / kNumBins; - - ofstream outfile; - outfile.open( outfileName.c_str() ); - - // descend into the directory that contains the bins - chdir( fitDir.c_str() ); - - for( int i = 0; i < kNumBins; ++i ){ - - ostringstream dir; - dir << "bin_" << i; - chdir( dir.str().c_str() ); - - ostringstream resultsFile; - resultsFile << "bin_" << i << ".fit"; - - FitResults results( resultsFile.str() ); - if( !results.valid() ){ - - chdir( ".." ); - continue; - } - - // print out the bin center - outfile << lowMass + step * i + step / 2. << "\t"; - - bool yPol = false; - - vector< string > rhoPiS; - rhoPiS.push_back( "Pi+Pi-Pi+::xpol::J1_rhopi_S" ); - if( yPol ) rhoPiS.push_back( "Pi+Pi-Pi+::ypol::J1_rhopi_S" ); - pair< double, double > rhoPiSInt = results.intensity( rhoPiS ); - outfile << rhoPiSInt.first << "\t" << rhoPiSInt.second << "\t"; - - vector< string > rhoPiD; - rhoPiD.push_back( "Pi+Pi-Pi+::xpol::J2_rhopi_D" ); - if( yPol ) rhoPiD.push_back( "Pi+Pi-Pi+::ypol::J2_rhopi_D" ); - pair< double, double > rhoPiDInt = results.intensity( rhoPiD ); - outfile << rhoPiDInt.first << "\t" << rhoPiDInt.second << "\t"; - - vector< string > rhoPiPX; - rhoPiPX.push_back( "Pi+Pi-Pi+::xpol::J1_rhopi_P" ); - if( yPol ) rhoPiPX.push_back( "Pi+Pi-Pi+::ypol::J1_rhopi_P" ); - pair< double, double > rhoPiPXInt = results.intensity( rhoPiPX ); - outfile << rhoPiPXInt.first << "\t" << rhoPiPXInt.second << "\t"; - - vector< string > f2PiS; - f2PiS.push_back( "Pi+Pi-Pi+::xpol::J2_f2pi_S" ); - if( yPol ) f2PiS.push_back( "Pi+Pi-Pi+::ypol::J2_f2pi_S" ); - pair< double, double > f2PiSInt = results.intensity( f2PiS ); - outfile << f2PiSInt.first << "\t" << f2PiSInt.second << "\t"; - - vector< string > rhoPiP; - rhoPiP.push_back( "Pi+Pi-Pi+::xpol::J2_rhopi_P" ); - if( yPol ) rhoPiP.push_back( "Pi+Pi-Pi+::ypol::J2_rhopi_P" ); - pair< double, double > rhoPiPInt = results.intensity( rhoPiP ); - outfile << rhoPiPInt.first << "\t" << rhoPiPInt.second << "\t"; - - vector< string > all; - all.push_back( "Pi+Pi-Pi+::xpol::J1_rhopi_S" ); - all.push_back( "Pi+Pi-Pi+::xpol::J2_rhopi_D" ); - all.push_back( "Pi+Pi-Pi+::xpol::J1_rhopi_P" ); - all.push_back( "Pi+Pi-Pi+::xpol::J2_f2pi_S" ); - all.push_back( "Pi+Pi-Pi+::xpol::J2_rhopi_P" ); - if( yPol ) all.push_back( "Pi+Pi-Pi+::ypol::J1_rhopi_S" ); - if( yPol ) all.push_back( "Pi+Pi-Pi+::ypol::J2_rhopi_D" ); - if( yPol ) all.push_back( "Pi+Pi-Pi+::ypol::J1_rhopi_P" ); - if( yPol ) all.push_back( "Pi+Pi-Pi+::ypol::J2_f2pi_S" ); - if( yPol ) all.push_back( "Pi+Pi-Pi+::ypol::J2_rhopi_P" ); - pair< double, double > allInt = results.intensity( all ); - outfile << allInt.first << "\t" << allInt.second << "\t"; - - pair< double, double > phaseDP = - results.phaseDiff( "Pi+Pi-Pi+::xpol::J2_rhopi_D", - "Pi+Pi-Pi+::xpol::J1_rhopi_P" ); - - outfile << phaseDP.first << "\t" << phaseDP.second << "\t"; - - pair< double, double > phaseDS = - results.phaseDiff( "Pi+Pi-Pi+::xpol::J2_rhopi_D", - "Pi+Pi-Pi+::xpol::J2_f2pi_S" ); - - outfile << phaseDS.first << "\t" << phaseDS.second << "\t"; - - outfile << endl; - - chdir( ".." ); - } - - return 0; -} diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_pol_TEMPLATE.cfg b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_pol_TEMPLATE.cfg deleted file mode 100644 index fc5080c753..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_pol_TEMPLATE.cfg +++ /dev/null @@ -1,117 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -# useful masses and widths -define a1 1.23 0.4 -define a2 1.318 0.105 -define pi1 1.60 0.2 -define pi2 1.67 0.259 - -define rho 0.775 0.146 -define f2 1.270 0.185 - -# J, P and isospin definitions for amplitudes -define a2JPI 2 1 1 -define pi2JPI 2 -1 1 -define a1JPI 1 1 1 -define pi1JPI 1 -1 1 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -define rho0pi+ 1 1 1 -1 1 - -# isobar definitions for f2pi final state -define f2pi+ 2 0 1 -1 1 - -# some definitions for adjusting the beam polarization -define polFrac 1.0 -define beamX 0 polFrac -define beamY 1 polFrac - -fit FITNAME - -reaction Pi+Pi-Pi+ gamma n Pi+ Pi- Pib - -genmc Pi+Pi-Pi+ ROOTDataReader GENMCFILE -accmc Pi+Pi-Pi+ ROOTDataReader ACCMCFILE -data Pi+Pi-Pi+ ROOTDataReader DATAFILE - -normintfile Pi+Pi-Pi+ NIFILE - -# consider just x polarized amplitudes -sum Pi+Pi-Pi+ xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_S ThreePiAngles beamX a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_D ThreePiAngles beamX a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_P ThreePiAngles beamX pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::J2_f2pi_S ThreePiAngles beamX pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::xpol::J2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::xpol::J2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_P ThreePiAngles beamX pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J2_rhopi_P 0 1 4 3 2 - -initialize Pi+Pi-Pi+::xpol::J1_rhopi_S cartesian 10 0 real - -include param_init.cfg - diff --git a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_unpol_TEMPLATE.cfg b/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_unpol_TEMPLATE.cfg deleted file mode 100644 index b6ec6b9c78..0000000000 --- a/src/programs/AmplitudeAnalysis/Examples/threepi_binned/threepi_unpol_TEMPLATE.cfg +++ /dev/null @@ -1,151 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -# useful masses and widths -define a1 1.23 0.4 -define a2 1.318 0.105 -define pi1 1.60 0.2 -define pi2 1.67 0.259 - -define rho 0.775 0.146 -define f2 1.270 0.185 - -# J, P and isospin definitions for resonances -define a2JPI 2 1 1 -define pi2JPI 2 -1 1 -define a1JPI 1 1 1 -define pi1JPI 1 -1 1 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -define rho0pi+ 1 1 1 -1 1 - -# isobar definitions for f2pi final state -define f2pi+ 2 0 1 -1 1 - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -fit FITNAME - -reaction Pi+Pi-Pi+ gamma n Pi+ Pi- Pib - -genmc Pi+Pi-Pi+ ROOTDataReader GENMCFILE -accmc Pi+Pi-Pi+ ROOTDataReader ACCMCFILE -data Pi+Pi-Pi+ ROOTDataReader DATAFILE - -normintfile Pi+Pi-Pi+ NIFILE - -# sum for each polarization -sum Pi+Pi-Pi+ xpol -sum Pi+Pi-Pi+ ypol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_S ThreePiAngles beamX a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::J1_rhopi_S ThreePiAngles beamY a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::J1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::J1_rhopi_S 0 1 4 3 2 - -constrain Pi+Pi-Pi+::xpol::J1_rhopi_S Pi+Pi-Pi+::ypol::J1_rhopi_S - - -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_D ThreePiAngles beamX a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::J2_rhopi_D ThreePiAngles beamY a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::J2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::J2_rhopi_D 0 1 4 3 2 - -constrain Pi+Pi-Pi+::xpol::J2_rhopi_D Pi+Pi-Pi+::ypol::J2_rhopi_D - - -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_P ThreePiAngles beamX pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::J1_rhopi_P ThreePiAngles beamY pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::J1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::J1_rhopi_P 0 1 4 3 2 - -constrain Pi+Pi-Pi+::xpol::J1_rhopi_P Pi+Pi-Pi+::ypol::J1_rhopi_P - - -amplitude Pi+Pi-Pi+::xpol::J2_f2pi_S ThreePiAngles beamX pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::xpol::J2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::xpol::J2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::J2_f2pi_S ThreePiAngles beamY pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::ypol::J2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::ypol::J2_f2pi_S 0 1 4 3 2 - -constrain Pi+Pi-Pi+::xpol::J2_f2pi_S Pi+Pi-Pi+::ypol::J2_f2pi_S - - -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_P ThreePiAngles beamX pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::J2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::J2_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::J2_rhopi_P ThreePiAngles beamY pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::J2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::J2_rhopi_P 0 1 4 3 2 - -constrain Pi+Pi-Pi+::xpol::J2_rhopi_P Pi+Pi-Pi+::ypol::J2_rhopi_P - -initialize Pi+Pi-Pi+::xpol::J1_rhopi_S cartesian 10 0 real - -include param_init.cfg diff --git a/src/programs/AmplitudeAnalysis/Makefile b/src/programs/AmplitudeAnalysis/Makefile deleted file mode 100644 index f4ec581b2f..0000000000 --- a/src/programs/AmplitudeAnalysis/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -DIRS += fit split_mass toy_detector Examples - -include $(HALLD_HOME)/src/BMS/Makefile.dirs diff --git a/src/programs/AmplitudeAnalysis/SConscript b/src/programs/AmplitudeAnalysis/SConscript deleted file mode 100644 index 170151d122..0000000000 --- a/src/programs/AmplitudeAnalysis/SConscript +++ /dev/null @@ -1,9 +0,0 @@ - -import sbms - -Import('*') - -subdirs = ['fit', 'twopi_plotter', 'twopi_plotter_amp', 'twopi_plotter_mom', 'twopi_plotter_primakoff', 'split_mass', 'split_t', 'threepi_plotter_schilling', 'omega_radiative_plotter', 'project_moments'] - -SConscript(dirs=subdirs, exports='env osname', duplicate=0) - diff --git a/src/programs/AmplitudeAnalysis/fit/Makefile b/src/programs/AmplitudeAnalysis/fit/Makefile deleted file mode 100644 index db5da03fef..0000000000 --- a/src/programs/AmplitudeAnalysis/fit/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/AmplitudeAnalysis/fit/SConscript b/src/programs/AmplitudeAnalysis/fit/SConscript deleted file mode 100644 index 4ade045d40..0000000000 --- a/src/programs/AmplitudeAnalysis/fit/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - - sbms.executable(env) - diff --git a/src/programs/AmplitudeAnalysis/fit/fit.cc b/src/programs/AmplitudeAnalysis/fit/fit.cc deleted file mode 100644 index 10558cef90..0000000000 --- a/src/programs/AmplitudeAnalysis/fit/fit.cc +++ /dev/null @@ -1,130 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include - -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataReaderBootstrap.h" -#include "AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h" -#include "AMPTOOLS_AMPS/TwoPSAngles.h" -#include "AMPTOOLS_AMPS/TwoPSHelicity.h" -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_amp.h" -#include "AMPTOOLS_AMPS/TwoPiWt_primakoff.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_primakoff.h" -#include "AMPTOOLS_AMPS/ThreePiAngles.h" -#include "AMPTOOLS_AMPS/ThreePiAnglesSchilling.h" -#include "AMPTOOLS_AMPS/TwoPiAnglesRadiative.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" -#include "AMPTOOLS_AMPS/BreitWigner3body.h" -#include "AMPTOOLS_AMPS/b1piAngAmp.h" -#include "AMPTOOLS_AMPS/Uniform.h" -#include "AMPTOOLS_AMPS/polCoef.h" - -#include "MinuitInterface/MinuitMinimizationManager.h" -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" -#include "IUAmpTools/ConfigFileParser.h" -#include "IUAmpTools/ConfigurationInfo.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - // set default parameters - - bool useMinos = false; - - string configfile; - string seedfile; - - // parse command line - - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seedfile = argv[++i]; } - if (arg == "-n") useMinos = true; - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << " -n \t\t\t\t\t use MINOS instead of MIGRAD" << endl; - cout << " -c \t\t\t\t config file" << endl; - cout << " -s \t\t\t for seeding next fit based on this fit (optional)" << endl; - exit(1);} - } - - if (configfile.size() == 0){ - cout << "No config file specified" << endl; - exit(1); - } - - ConfigFileParser parser(configfile); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - cfgInfo->display(); - - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerAmplitude( BreitWigner3body() ); - AmpToolsInterface::registerAmplitude( TwoPSAngles() ); - AmpToolsInterface::registerAmplitude( TwoPSHelicity() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles_amp() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles_primakoff() ); - AmpToolsInterface::registerAmplitude( TwoPiWt_primakoff() ); - AmpToolsInterface::registerAmplitude( ThreePiAngles() ); - AmpToolsInterface::registerAmplitude( ThreePiAnglesSchilling() ); - AmpToolsInterface::registerAmplitude( TwoPiAnglesRadiative() ); - AmpToolsInterface::registerAmplitude( b1piAngAmp() ); - AmpToolsInterface::registerAmplitude( polCoef() ); - AmpToolsInterface::registerAmplitude( Uniform() ); - - AmpToolsInterface::registerDataReader( ROOTDataReader() ); - AmpToolsInterface::registerDataReader( ROOTDataReaderBootstrap() ); - AmpToolsInterface::registerDataReader( ROOTDataReaderWithTCut() ); - - AmpToolsInterface ati( cfgInfo ); - - cout << "LIKELIHOOD BEFORE MINIMIZATION: " << ati.likelihood() << endl; - - MinuitMinimizationManager* fitManager = ati.minuitMinimizationManager(); - - if( useMinos ){ - - fitManager->minosMinimization(); - } - else{ - - fitManager->migradMinimization(); - } - - bool fitFailed = - ( fitManager->status() != 0 && fitManager->eMatrixStatus() != 3 ); - - if( fitFailed ){ - cout << "ERROR: fit failed use results with caution..." << endl; - } - - cout << "LIKELIHOOD AFTER MINIMIZATION: " << ati.likelihood() << endl; - - ati.finalizeFit(); - - if( seedfile.size() != 0 && !fitFailed ){ - - ati.fitResults()->writeSeed( seedfile ); - } - - return 0; -} - - diff --git a/src/programs/AmplitudeAnalysis/omega_radiative_plotter/SConscript b/src/programs/AmplitudeAnalysis/omega_radiative_plotter/SConscript deleted file mode 100644 index 69434df6f8..0000000000 --- a/src/programs/AmplitudeAnalysis/omega_radiative_plotter/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddCERNLIB(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/omega_radiative_plotter/omega_radiative_plotter.cc b/src/programs/AmplitudeAnalysis/omega_radiative_plotter/omega_radiative_plotter.cc deleted file mode 100644 index 6810312921..0000000000 --- a/src/programs/AmplitudeAnalysis/omega_radiative_plotter/omega_radiative_plotter.cc +++ /dev/null @@ -1,257 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/OmegaRadiativePlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h" -#include "AMPTOOLS_AMPS/TwoPiAnglesRadiative.cc" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -typedef OmegaRadiativePlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( TwoPiAnglesRadiative() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); - AmpToolsInterface::registerDataReader( ROOTDataReaderWithTCut() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\tomega_radiative_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "omega_radiative_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - cout << "Loading Fit results" << endl; - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - cout << "Fit results loaded" << endl; - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - cout << " Initialized ati and PlotGen" << endl; - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - cout << "Reaction " << reactionName << " enabled" << endl; - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - cout << "Looping over input data" << endl; - // loop over data, accMC, and genMC - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < OmegaRadiativePlotGenerator::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == OmegaRadiativePlotGenerator::kOmegaMass) histname += "MOmega"; - else if (ivar == OmegaRadiativePlotGenerator::kCosTheta) histname += "cosTheta"; - else if (ivar == OmegaRadiativePlotGenerator::kPhi) histname += "Phi"; - else if (ivar == OmegaRadiativePlotGenerator::kphi) histname += "phi"; - else if (ivar == OmegaRadiativePlotGenerator::kPsi) histname += "psi"; - else if (ivar == OmegaRadiativePlotGenerator::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kBkgnd) histname += "bkgnd"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve SDME parameters for plotting and asymmetry - // ************************ - - cout << "Checking Parameters" << endl; - // parameters to check - vector< string > pars; - pars.push_back("rho000"); - pars.push_back("rho100"); - pars.push_back("rho1m10"); - - pars.push_back("rho111"); - pars.push_back("rho001"); - pars.push_back("rho101"); - pars.push_back("rho1m11"); - - pars.push_back("rho102"); - pars.push_back("rho1m12"); - - // file for writing parameters (later switch to putting in ROOT file) - ofstream outfile; - outfile.open( "omega_radiative_fitPars.txt" ); - - for(unsigned int i = 0; i > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[3]) + results.parValue(pars[6]); - double SigmaN_err = covMatrix[5][5] + covMatrix[8][8] + 2*covMatrix[5][8]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[2]); - double SigmaD_err = 0.5*0.5*covMatrix[2][2] + covMatrix[4][4] - 2*0.5*covMatrix[2][4]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - outfile << Sigma << "\t" << Sigma_err << "\t"; - - double P = 2*results.parValue(pars[6]) - results.parValue(pars[4]); - double P_err = sqrt(2*2*covMatrix[8][8] + covMatrix[6][6] - 2*2*covMatrix[6][8]); - outfile << P << "\t" << P_err << "\t"; - - outfile << endl; - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - cout << " Initialized App " << endl; - PlotFactory factory( plotGen ); - cout << " Created Plot Factory " << endl; - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - cout << " Main frame created " << endl; - - app.Run(); - cout << " App running" << endl; - } - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/project_moments/3j.cc b/src/programs/AmplitudeAnalysis/project_moments/3j.cc deleted file mode 100644 index 50b21188b1..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/3j.cc +++ /dev/null @@ -1,273 +0,0 @@ -#include -#include -#include -#include - -using namespace std; - -#include "Math/SpecFunc.h" - -#include "wave.h" -#include "3j.h" - -namespace { - #if ROOT_VERSION_CODE < ROOT_VERSION(5,28,0) - long long - fac(long long n) - { - long long result = 1; - if (n > 1) - for (int i = 1; i <= n; i++) - result *= i; - return result; - } - - - // Calculate the 3j-symbol from the explicit expression given in http://dlmf.nist.gov/34.2 - // First their delta (34.2.5): - - double - delta(long j1, long j2, long j3) - { - // Valid argument range is assumed. This is assured in the 3j function. - double result = (sqrt(fac(j1 + j2 - j3) * fac(j1 - j2 + j3) * fac(-j1 + j2 + j3)) - / sqrt(fac(j1 + j2 + j3 + 1))); - //cout << "delta = " << result << endl; - return result; - } - - - // The complete prefactor in (34.2.4). Again, rangechecks are left to the main function. - double - prefactor(long j1, long j2, long j3, long m1, long m2, long m3) - { - int sign = ((j1 - j2 - m3) & 0x1) ? -1 : 1; // odd / even - double result = sign*delta(j1, j2, j3)*sqrt(fac(j1+m1)*fac(j1-m1)*fac(j2+m2)*fac(j2-m2)*fac(j3+m3)*fac(j3-m3)); - //cout << "prefactor = " << result << endl; - return result; - } - #endif - - - double - theta(int m) - { - if (m == 0) - return .5; - else - return sqrt(.5); - } -} - -double -getCoefficient(int eps, int L, int M, int l1, int m1, int l2, int m2) -{ - double threeJ1 = threeJ(L, l1, l2, 0, 0, 0); - - int sign = ((m1 + M) & 0x1) ? -1 : 1; - int sign1 = ((m1 + 1) & 0x1) ? -1 : 1; - int sign2 = ((m2 + 1) & 0x1) ? -1 : 1; - int sign12 = ((m1 + m2) & 0x1) ? -1 : 1; - double parentheses = (threeJ(L, l1, l2, -M, -m1, m2) - + threeJ(L, l1, l2, -M, m1, m2) * eps * sign1 - + threeJ(L, l1, l2, -M, -m1, -m2) * eps * sign2 - + threeJ(L, l1, l2, -M, m1, -m2) * sign12) * sign; - - return(theta(m1)*theta(m2)*sqrt((2*l1+1)*(2*l2+1)) - *threeJ1*parentheses); -} - - -double -threeJ(long j1, long j2, long j3, long m1, long m2, long m3) -{ -#if ROOT_VERSION_CODE >= ROOT_VERSION(5,28,0) - return ROOT::Math::wigner_3j(2*j1, 2*j2, 2*j3, 2*m1, 2*m2, 2*m3); -#else - if (j1 < 0 || j2 < 0 || j3 < 0) - return 0; - if (j1 > j2 + j3) - return 0; - if (j2 > j3 + j1) - return 0; - if (j3 > j1 + j2) - return 0; - if (abs(j1 - j2) > j3) - return 0; - if (abs(j2 - j3) > j1) - return 0; - if (abs(j3 - j1) > j2) - return 0; - if (m1 + m2 + m3 != 0) - return 0; - if (abs(m1) > j1 || abs(m2) > j2 || abs(m3) > j3) - return 0; - - // The 3j-symbol is != 0. Find the valid range for the summation in loc.cit. (34.2.4) - long minS = 0; - minS = max(minS, -(j3 - j2 + m1)); - minS = max(minS, -(j3 - j1 - m2)); - long maxS = j1 + j2 - j3; // needs refinement - maxS = min(maxS, j1 - m1); - maxS = min(maxS, j2 + m2); - - if (minS > maxS) - return 0; - - double sum = 0; - for (int s = minS; s <= maxS; s++) - { - double add = ((s & 0x1 ? -1. : 1.) - / fac(s) / fac(j1+j2-j3-s) - / fac(j1-m1-s) / fac(j2+m2-s) - / fac(j3-j2+m1+s) / fac(j3-j1-m2+s)); - //cout << add << endl; - sum+=add; - } - - return prefactor(j1,j2,j3,m1,m2,m3)*sum; -#endif -} - - -// Returns the list of non-zero moments for the given waveset. -std::vector > -listOfMoments(const waveset& ws) -{ - // Find maximum L, M. - size_t maxL = 0, maxM = 0; - for (size_t iWs = 0; iWs < ws.size(); iWs++) - { - const vector& w = ws[iWs].waves; - for (size_t iW = 0; iW < w.size(); iW++) - { - maxL = std::max(w[iW].l, maxL); - maxM = std::max(w[iW].m, maxM); - } - } - - std::vector > result; - for (size_t L = 0; L <= 2*maxL; L++) - for (size_t M = 0; M <= 2*maxM; M++) - { - for (size_t iWs = 0; iWs < ws.size(); iWs++) - { - int eps = ws[iWs].reflectivity; - - const vector& w = ws[iWs].waves; - for (size_t iW1 = 0; iW1 < w.size(); iW1++) - { - const wave& w1 = w[iW1]; - for (size_t iW2 = 0; iW2 < w.size(); iW2++) - { - const wave& w2 = w[iW2]; - double coeff = getCoefficient(eps, L, M, w1.l, w1.m, w2.l, w2.m); - if (coeff != 0) - { - result.push_back(std::pair(L, M)); - goto nextM; - } - } - } - } - nextM: ; - } - return result; -} - - -double -decomposeMoment(const std::pair& LM, const waveset& ws, const vector& x) -{ - return decomposeMoment(LM.first, LM.second, ws, x); -} - -double -decomposeMoment(const std::pair& LM, const waveset& ws, const double* x) -{ - return decomposeMoment(LM.first, LM.second, ws, x); -} - -// Calculates moment H(LM) from the waveset ws with corresponding fit results x. -double -decomposeMoment(int L, int M, const waveset& ws, const vector& x) -{ - return decomposeMoment(L, M, ws, &x[0]); -} - -double -decomposeMoment(int L, int M, const waveset& ws, const double* x) -{ - double result = 0; - for (size_t iWs = 0; iWs < ws.size(); iWs++) - { - int eps = ws[iWs].reflectivity; - - const vector& w = ws[iWs].waves; - for (size_t iW1 = 0; iW1 < w.size(); iW1++) - { - const wave& w1 = w[iW1]; - for (size_t iW2 = 0; iW2 < w.size(); iW2++) - { - const wave& w2 = w[iW2]; - double coeff = getCoefficient(eps, L, M, w1.l, w1.m, w2.l, w2.m); - result += coeff*(x[w1.getIndex()]*x[w2.getIndex()] + x[w1.getIndex()+1]*x[w2.getIndex()+1]); - //result[wavePair(w1.getIndex(), w2.getIndex())] = coeff; - } - } - } - - return result; -} - -double -decomposeMomentError(const std::pair& LM, - const waveset& ws, const vector& x, const vector< vector< double > >& covMat) -{ - return decomposeMomentError(LM.first, LM.second, ws, x, covMat); -} - -double -decomposeMomentError(int L, int M, const waveset& ws, const vector& x, const vector< vector< double > >& covMat) -{ - double resultSquare = 0; - for (size_t iWs = 0; iWs < ws.size(); iWs++) - { - int eps = ws[iWs].reflectivity; - - const vector& w = ws[iWs].waves; - for (size_t iW1 = 0; iW1 < w.size(); iW1++) - { - const wave& w1 = w[iW1]; - for (size_t iW2 = 0; iW2 < w.size(); iW2++) - { - const wave& w2 = w[iW2]; - double coeff = getCoefficient(eps, L, M, w1.l, w1.m, w2.l, w2.m); - - double re1 = x[w1.getIndex()]; - double im1 = x[w1.getIndex() + 1]; - double re2 = x[w2.getIndex()]; - double im2 = x[w2.getIndex() + 1]; - - double errRe1_2 = covMat[w1.getIndex()][w1.getIndex()]; - double errIm1_2 = covMat[w1.getIndex() + 1][w1.getIndex() + 1]; - double errRe2_2 = covMat[w2.getIndex()][w2.getIndex()]; - double errIm2_2 = covMat[w2.getIndex() + 1][w2.getIndex() + 1]; - - double covReRe = covMat[w1.getIndex()][w2.getIndex()]; - - // The covariance between the imaginary parts is only non-zero if neither was fixed - double covImIm = covMat[w1.getIndex() + 1][w2.getIndex() + 1]; - - resultSquare += fabs(coeff)*(re2*re2*errRe1_2 - + re1*re1*errRe2_2 - + im2*im2*errIm1_2 - + im1*im1*errIm2_2 - + 2*re1*re2*covReRe - + 2*im1*im2*covImIm); - } - } - } - - return sqrt(resultSquare); -} diff --git a/src/programs/AmplitudeAnalysis/project_moments/3j.h b/src/programs/AmplitudeAnalysis/project_moments/3j.h deleted file mode 100644 index c9db94e73c..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/3j.h +++ /dev/null @@ -1,39 +0,0 @@ -#ifndef THREEJ_H__ -#define THREEJ_H__ - -#include -#include - -#include "wave.h" - -class wavePair : public std::pair -{ - public: - wavePair(size_t a, size_t b) - : std::pair(a,b) - {} - - - bool operator<(const wavePair& o) - { - if (o.first < this->first) - return true; - return o.second < this->second; - } -}; - -double threeJ(long j1, long j2, long j3, long m1, long m2, long m3); - -std::vector > listOfMoments(const waveset& ws); - -double getCoefficient(int eps, int L, int M, int l1, int m1, int l2, int m2); -double decomposeMoment(const std::pair& LM, const waveset& ws, const vector& x); -double decomposeMoment(const std::pair& LM, const waveset& ws, const double* x); -double decomposeMoment(int L, int M, const waveset& ws, const vector& x); -double decomposeMoment(int L, int M, const waveset& ws, const double* x); - -double decomposeMomentError(const std::pair& LM, const waveset& ws, const vector& x, const vector< vector< double > >& covMat); -double decomposeMomentError(int L, int M, const waveset& ws, const vector& x, const vector< vector< double > >& covMat); - - -#endif diff --git a/src/programs/AmplitudeAnalysis/project_moments/SConscript b/src/programs/AmplitudeAnalysis/project_moments/SConscript deleted file mode 100644 index 0c9cde0719..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/SConscript +++ /dev/null @@ -1,23 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - ROOT_LIBS = "MathMore" - env.AppendUnique(LIBS = ROOT_LIBS.split()) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/project_moments/project_moments.cc b/src/programs/AmplitudeAnalysis/project_moments/project_moments.cc deleted file mode 100644 index a673887d0c..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/project_moments.cc +++ /dev/null @@ -1,191 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "IUAmpTools/FitResults.h" - -#include "wave.h" -#include "3j.h" - -#include "TFile.h" - -using namespace std; - -int main( int argc, char* argv[] ){ - - // set default parameters - - double lowMass = 0.28; - double highMass = 2.00; - int kNumBins = 86; - string fitDir(""); - - string outfileName("moments.root"); - bool print = false; - - // parse command line - - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-f"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else fitDir = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outfileName = argv[++i]; } - if (arg == "-p") - print = true; - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "(optional) -f \t : Fit Directory" << endl; - cout << "(optional) -o \t : Output file (default: moments.root)" << endl; - cout << "(optional) -p\t\t : Print equations" << endl; - exit(1);} - } - - // Set waveset, has to be same order as in fit.cfg! - - vector negative; - negative.push_back(wave("S0", 0, 0)); - negative.push_back(wave("P0", 1, 0)); - negative.push_back(wave("P-", 1, 1)); - negative.push_back(wave("D0", 2, 0)); - negative.push_back(wave("D-", 2, 1)); - - vector positive; - positive.push_back(wave("P+", 1, 1)); - positive.push_back(wave("D+", 2, 1)); - - coherent_waves wsPos, wsNeg; - wsPos.reflectivity = +1; - wsPos.waves = positive; - - wsNeg.reflectivity = -1; - wsNeg.waves = negative; - - waveset ws; - ws.push_back(wsNeg); - ws.push_back(wsPos); - - size_t lastIdx = 0; - for (size_t i = 0; i < ws.size(); i++) - for (size_t j = 0; j < ws[i].waves.size(); j++, lastIdx += 2) - ws[i].waves[j].setIndex(lastIdx); - - // Find the non-zero moments for the given waveset. - std::vector > vecMom = listOfMoments(ws); - - // Prepare the moment histograms and print moment equations - map, TH1D*> hMoments; - for (std::vector >::const_iterator it = vecMom.begin(); it != vecMom.end(); it++) - { - - char name[999]; - char title[999]; - snprintf(name, 999, "hMoment%zd%zd", it->first, it->second); - snprintf(title, 999, "Moment H(%zd,%zd)", it->first, it->second); - hMoments[*it] = new TH1D(name, title, kNumBins, lowMass, highMass); - - if (print){ - cout << "H(" << it->first << ", " << it->second << ") = "; - for (size_t iCoh = 0; iCoh < ws.size(); iCoh++) - { - const coherent_waves& waves = ws[iCoh]; - int eps = waves.reflectivity; - - for (size_t i = 0; i < waves.waves.size(); i++) - { - const wave& w1 = waves.waves[i]; - for (size_t j = 0; j <= i; j++) - { - const wave& w2 = waves.waves[j]; - - double coeff = getCoefficient(eps, it->first, it->second, w1.getL(), w1.getM(), w2.getL(), w2.getM()); - if (coeff == 0) - continue; - - if (j == i) - { - if (coeff > 0) - cout << "+ " << coeff; - else if (coeff < 0) - cout << "- " << -coeff; - cout << " |" << w1.getName() << "|^2 "; - } - else - { - if (coeff > 0) - cout << "+ " << 2*coeff; - else if (coeff < 0) - cout << "- " << -2*coeff; - cout << " Re(" << w1.getName() << "* " << w2.getName() << ") "; - } - } - } - } - cout << endl; - } - } - - - if (fitDir.size() == 0){ - cout << "No fit directory specified. Try -h for usage." << endl; - exit(1); - } - - TFile *outfile = new TFile(outfileName.c_str(), "recreate"); - if (!outfile->IsOpen()) exit(1); - - // descend into the directory that contains the bins - chdir( fitDir.c_str() ); - - for( int i = 0; i < kNumBins; ++i ){ - - ostringstream dir; - dir << "bin_" << i; - chdir( dir.str().c_str() ); - - ostringstream resultsFile; - resultsFile << "bin_" << i << ".fit"; - - FitResults results( resultsFile.str() ); - if( !results.valid() ){ - - chdir( ".." ); - continue; - } - - if ( 2*ws.getNwaves() != results.parValueList().size() ){ - cout << "Different number of waves in fit result. Check waveset!" << endl; - outfile->Close(); - exit(1); - } - - for (std::vector >::const_iterator it = vecMom.begin(); it != vecMom.end(); it++) - { - hMoments[*it]->SetBinContent(i + 1, decomposeMoment(*it, ws, results.parValueList())); - hMoments[*it]->SetBinError(i + 1, decomposeMomentError(*it, ws, results.parValueList(), results.errorMatrix())); - } - - chdir( ".." ); - } - - - for (std::vector >::const_iterator it = vecMom.begin(); it != vecMom.end(); it++) - { - hMoments[*it]->Write(); - } - - outfile->Close(); - cout << "Moment histograms written to " << outfileName << endl; - - return 0; -} diff --git a/src/programs/AmplitudeAnalysis/project_moments/wave.cc b/src/programs/AmplitudeAnalysis/project_moments/wave.cc deleted file mode 100644 index d062d5e407..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/wave.cc +++ /dev/null @@ -1,17 +0,0 @@ -#include -#include - -#include "wave.h" - -wave::wave(const wave& o) -{ - l = o.l; - m = o.m; - name = o.name; - idx = o.idx; - phaseLocked = o.phaseLocked; -} - - -waveset::waveset() { return; } - diff --git a/src/programs/AmplitudeAnalysis/project_moments/wave.h b/src/programs/AmplitudeAnalysis/project_moments/wave.h deleted file mode 100644 index 9b5cd1d224..0000000000 --- a/src/programs/AmplitudeAnalysis/project_moments/wave.h +++ /dev/null @@ -1,81 +0,0 @@ -#ifndef WAVE_H__ -#define WAVE_H__ - -#include -#include -#include -#include - -#include "TH1.h" - -using namespace std; - -struct wave { - string name; - size_t l, m; - size_t idx; // Index into the fit variables. - bool phaseLocked; - - wave(const char* name_, int ll, int mm) - : name(name_), l(ll), m(mm), phaseLocked(false) { } - wave(const char* name_, int ll, int mm, int nBins, double lower, double upper, bool phaseLocked_ = false) - : name(name_), l(ll), m(mm), phaseLocked(phaseLocked_) { } - wave(const wave& o); - - ~wave() {} // histograms are owned by ROOT - - void setIndex(int idx_) { idx = idx_; } - size_t getIndex() const { return idx; } - - const string& getName() const { return name; } - size_t getL() const { return l; } - size_t getM() const { return m; } - -}; - -struct coherent_waves { - int reflectivity; - int spinflip; - std::vector waves; - - coherent_waves() {}; - coherent_waves(const coherent_waves& o) { reflectivity = o.reflectivity; spinflip = o.spinflip; waves = o.waves; } - - std::vector& getWaves() { return waves; } - const std::vector& getWaves() const { return waves; } - size_t getNwaves() const { return waves.size(); } - - void print() { cout << "| ";for (size_t i = 0; i < waves.size(); i++) { cout << waves[i].getName() << " "; } cout << endl; } - -}; - -struct waveset : public std::vector { -public: - waveset(); - - size_t getNwaves() const { - size_t count = 0; - for (size_t i = 0; i < this->size(); i++) - count += (*this)[i].waves.size(); - return count; - } - - size_t getNparams() const { - size_t count = 0; - for (size_t i = 0; i < this->size(); i++) - { - const vector& w = (*this)[i].waves; - for (size_t j = 0; j < w.size(); j++) - { - if (w[j].phaseLocked) - count += 1; - else - count += 2; - } - } - return count; - } - -}; - -#endif diff --git a/src/programs/AmplitudeAnalysis/split_mass/Makefile b/src/programs/AmplitudeAnalysis/split_mass/Makefile deleted file mode 100644 index db5da03fef..0000000000 --- a/src/programs/AmplitudeAnalysis/split_mass/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/AmplitudeAnalysis/split_mass/SConscript b/src/programs/AmplitudeAnalysis/split_mass/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/split_mass/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/split_mass/split_mass.cc b/src/programs/AmplitudeAnalysis/split_mass/split_mass.cc deleted file mode 100644 index 9ff99e8d96..0000000000 --- a/src/programs/AmplitudeAnalysis/split_mass/split_mass.cc +++ /dev/null @@ -1,142 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" - -#include "TLorentzVector.h" - -#include "TH1F.h" -using namespace std; - -#define DEFTREENAME "kin" - -void Usage() -{ - cout << "Usage:\n split_mass [maxEvents]\n"; - cout << " split_mass -T [tree name]\n\n"; - cout << " overwrites the default ROOT tree name (\"kin\") in output and/or input files\n"; - cout << " To specify input and output names delimit with \':\' ex. -T inKin:outKin\n"; - cout << " Use -t to update existing files with new tree, instead of overwritting.\n"; - exit(1); -} - - -pair GetTreeNames(char* treeArg) -{ - pair treeNames(DEFTREENAME,""); - string treeArgStr(treeArg); - size_t delimPos=treeArgStr.find(':',1); - - if (delimPos != string::npos){ - treeNames.first=treeArgStr.substr(0,delimPos); - treeNames.second=treeArgStr.substr(delimPos+1); - }else - treeNames.second=treeArgStr; - - return treeNames; -} - - -int main( int argc, char* argv[] ){ - - unsigned int maxEvents = 4294967000; //close to 4byte int range - - //string treeName( "kin" ); - pair treeNames(DEFTREENAME,DEFTREENAME); - - bool recreate=true; - - if( argc < 6 ) Usage(); - - string outBase( argv[2] ); - - double lowMass = atof( argv[3] ); - double highMass = atof( argv[4] ); - int numBins = atoi( argv[5] ); - - // A somewhat convoluted way to allow tree name specification - // via "-t [name]" in the arg. list after the standard args - if( argc > 6 ) { - for(int i=6; i<=7 && i dataReaderArgs; - dataReaderArgs.push_back( argv[1] ); - dataReaderArgs.push_back( treeNames.first ); - - // open reader - ROOTDataReader in( dataReaderArgs ); - - enum { kMaxBins = 1000 }; - assert( numBins < kMaxBins ); - - double step = ( highMass - lowMass ) / numBins; - - ROOTDataWriter* outFile[kMaxBins]; - - for( int i = 0; i < numBins; ++i ){ - - ostringstream outName; - outName << outBase << "_" << i << ".root"; - outFile[i] = new ROOTDataWriter( outName.str(), - treeNames.second.c_str(), - recreate, in.hasWeight()); - } - - unsigned int eventCount = 0; - - Kinematics* event; - while( ( event = in.getEvent() ) != NULL && eventCount++ < maxEvents ){ - - vector< TLorentzVector > fs = event->particleList(); - - TLorentzVector x; - // the first two entries in this list are the beam and the recoil - // skip them in computing the mass - for( vector< TLorentzVector >::iterator particle = fs.begin() + 2; - particle != fs.end(); ++particle ){ - - x += *particle; - } - - int bin = static_cast< int >( floor( ( x.M() - lowMass ) / step ) ); - if( ( bin < numBins ) && ( bin >= 0 ) ){ - - outFile[bin]->writeEvent( *event ); - delete event; - } - } - - for( int i = 0; i < numBins; ++i ){ - - delete outFile[i]; - } - - return 0; -} diff --git a/src/programs/AmplitudeAnalysis/split_t/SConscript b/src/programs/AmplitudeAnalysis/split_t/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/split_t/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/split_t/split_t.cc b/src/programs/AmplitudeAnalysis/split_t/split_t.cc deleted file mode 100644 index b63718cc00..0000000000 --- a/src/programs/AmplitudeAnalysis/split_t/split_t.cc +++ /dev/null @@ -1,139 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" - -#include "TLorentzVector.h" - -#include "TH1F.h" -using namespace std; - -#define DEFTREENAME "kin" - -void Usage() -{ - cout << "Usage:\n split_t [maxEvents]\n"; - cout << " split_mass -T [tree name]\n\n"; - cout << " overwrites the default ROOT tree name (\"kin\") in output and/or input files\n"; - cout << " To specify input and output names delimit with \':\' ex. -T inKin:outKin\n"; - cout << " Use -t to update existing files with new tree, instead of overwritting.\n"; - exit(1); -} - - -pair GetTreeNames(char* treeArg) -{ - pair treeNames(DEFTREENAME,""); - string treeArgStr(treeArg); - size_t delimPos=treeArgStr.find(':',1); - - if (delimPos != string::npos){ - treeNames.first=treeArgStr.substr(0,delimPos); - treeNames.second=treeArgStr.substr(delimPos+1); - }else - treeNames.second=treeArgStr; - - return treeNames; -} - - -int main( int argc, char* argv[] ){ - - unsigned int maxEvents = 4294967000; //close to 4byte int range - - //string treeName( "kin" ); - pair treeNames(DEFTREENAME,DEFTREENAME); - - bool recreate=true; - - if( argc < 6 ) Usage(); - - string outBase( argv[2] ); - - double lowT = atof( argv[3] ); - double highT = atof( argv[4] ); - int numBins = atoi( argv[5] ); - - // A somewhat convoluted way to allow tree name specification - // via "-t [name]" in the arg. list after the standard args - if( argc > 6 ) { - for(int i=6; i<=7 && i dataReaderArgs; - dataReaderArgs.push_back( argv[1] ); - dataReaderArgs.push_back( treeNames.first ); - - // open reader - ROOTDataReader in( dataReaderArgs ); - - enum { kMaxBins = 1000 }; - assert( numBins < kMaxBins ); - - double step = ( highT - lowT ) / numBins; - - ROOTDataWriter* outFile[kMaxBins]; - - for( int i = 0; i < numBins; ++i ){ - - ostringstream outName; - outName << outBase << "_" << i << ".root"; - outFile[i] = new ROOTDataWriter( outName.str(), - treeNames.second.c_str(), - recreate, in.hasWeight()); - } - - unsigned int eventCount = 0; - - Kinematics* event; - while( ( event = in.getEvent() ) != NULL && eventCount++ < maxEvents ){ - - vector< TLorentzVector > fs = event->particleList(); - - // the second entry in this list is the recoil - TLorentzVector Target(0,0,0,0.938272046); - TLorentzVector Recoil(fs[1]); - - double t = -1 * (Recoil - Target).M2(); - - int bin = static_cast< int >( floor( ( t - lowT ) / step ) ); - if( ( bin < numBins ) && ( bin >= 0 ) ){ - - outFile[bin]->writeEvent( *event ); - delete event; - } - } - - for( int i = 0; i < numBins; ++i ){ - - delete outFile[i]; - } - - return 0; -} diff --git a/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/SConscript b/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/SConscript deleted file mode 100644 index 69434df6f8..0000000000 --- a/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddCERNLIB(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/threepi_plotter_schilling.cc b/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/threepi_plotter_schilling.cc deleted file mode 100644 index e1df728836..0000000000 --- a/src/programs/AmplitudeAnalysis/threepi_plotter_schilling/threepi_plotter_schilling.cc +++ /dev/null @@ -1,259 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/ThreePiPlotGeneratorSchilling.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataReaderWithTCut.h" -#include "AMPTOOLS_AMPS/ThreePiAnglesSchilling.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" -#include "AMPTOOLS_AMPS/BreitWigner3body.h" - -typedef ThreePiPlotGeneratorSchilling PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( ThreePiAnglesSchilling() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerAmplitude( BreitWigner3body() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); - AmpToolsInterface::registerDataReader( ROOTDataReaderWithTCut() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\tthreepi_schilling_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "threepi_schilling_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - cout << "Loading Fit results" << endl; - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - cout << "Fit results loaded" << endl; - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - cout << " Initialized ati and PlotGen" << endl; - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - cout << "Reaction " << reactionName << " enabled" << endl; - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - cout << "Looping over input data" << endl; - // loop over data, accMC, and genMC - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < ThreePiPlotGeneratorSchilling::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == ThreePiPlotGeneratorSchilling::k3PiMass) histname += "M3pi"; - else if (ivar == ThreePiPlotGeneratorSchilling::kCosTheta) histname += "cosTheta"; - else if (ivar == ThreePiPlotGeneratorSchilling::kPhi) histname += "Phi"; - else if (ivar == ThreePiPlotGeneratorSchilling::kphi) histname += "phi"; - else if (ivar == ThreePiPlotGeneratorSchilling::kPsi) histname += "psi"; - else if (ivar == ThreePiPlotGeneratorSchilling::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kBkgnd) histname += "bkgnd"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve SDME parameters for plotting and asymmetry - // ************************ - - cout << "Checking Parameters" << endl; - // parameters to check - vector< string > pars; - pars.push_back("rho000"); - pars.push_back("rho100"); - pars.push_back("rho1m10"); - - pars.push_back("rho111"); - pars.push_back("rho001"); - pars.push_back("rho101"); - pars.push_back("rho1m11"); - - pars.push_back("rho102"); - pars.push_back("rho1m12"); - - // file for writing parameters (later switch to putting in ROOT file) - ofstream outfile; - outfile.open( "threepi_schilling_fitPars.txt" ); - - for(unsigned int i = 0; i > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[3]) + results.parValue(pars[6]); - double SigmaN_err = covMatrix[5][5] + covMatrix[8][8] + 2*covMatrix[5][8]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[2]); - double SigmaD_err = 0.5*0.5*covMatrix[2][2] + covMatrix[4][4] - 2*0.5*covMatrix[2][4]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - outfile << Sigma << "\t" << Sigma_err << "\t"; - - double P = 2*results.parValue(pars[6]) - results.parValue(pars[4]); - double P_err = sqrt(2*2*covMatrix[8][8] + covMatrix[6][6] - 2*2*covMatrix[6][8]); - outfile << P << "\t" << P_err << "\t"; - - outfile << endl; - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - cout << " Initialized App " << endl; - PlotFactory factory( plotGen ); - cout << " Created Plot Factory " << endl; - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - cout << " Main frame created " << endl; - - app.Run(); - cout << " App running" << endl; - } - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/toy_detector/Makefile b/src/programs/AmplitudeAnalysis/toy_detector/Makefile deleted file mode 100644 index db5da03fef..0000000000 --- a/src/programs/AmplitudeAnalysis/toy_detector/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/AmplitudeAnalysis/toy_detector/toy_detector.cc b/src/programs/AmplitudeAnalysis/toy_detector/toy_detector.cc deleted file mode 100644 index 9d5bbbe8eb..0000000000 --- a/src/programs/AmplitudeAnalysis/toy_detector/toy_detector.cc +++ /dev/null @@ -1,61 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include - -#include "IUAmpTools/Kinematics.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" - -#include "CLHEP/Vector/LorentzVector.h" - -#include "TRandom.h" - -using namespace std; -using namespace CLHEP; - -int main( int argc, char* argv[] ){ - - string treeName( "kin" ); - - if( argc < 3 ){ - - cout << "Usage: toy_detector " << endl; - return 1; - } - - vector< string > dataReaderArgs; - dataReaderArgs.push_back( argv[1] ); - dataReaderArgs.push_back( treeName ); - - ROOTDataReader in( dataReaderArgs ); - ROOTDataWriter out( argv[2] ); - - Kinematics* event; - while( ( event = in.getEvent() ) != NULL ){ - - vector< HepLorentzVector > fs = event->particleList(); - - HepLorentzVector x; - // the first two entries in this list are the beam and the recoil - // skip them in computing the mass - for( vector< HepLorentzVector >::iterator particle = fs.begin() + 2; - particle != fs.end(); ++particle ){ - - x += *particle; - } - - // an acceptance that is linearly rising with mass - if( x.m() > drand48() * 3 ) - out.writeEvent( *event ); - - delete event; - } - - return 0; -} diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter/SConscript b/src/programs/AmplitudeAnalysis/twopi_plotter/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter/twopi_plotter.cc b/src/programs/AmplitudeAnalysis/twopi_plotter/twopi_plotter.cc deleted file mode 100644 index 37ac14452d..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter/twopi_plotter.cc +++ /dev/null @@ -1,247 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/TwoPiPlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -typedef TwoPiPlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\ttwopi_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "twopi_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - - // loop over data, accMC, and genMC - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < TwoPiPlotGenerator::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == TwoPiPlotGenerator::k2PiMass) histname += "M2pi"; - else if (ivar == TwoPiPlotGenerator::kPiPCosTheta) histname += "cosTheta"; - else if (ivar == TwoPiPlotGenerator::kPhi) histname += "Phi"; - else if (ivar == TwoPiPlotGenerator::kphi) histname += "phi"; - else if (ivar == TwoPiPlotGenerator::kPsi) histname += "psi"; - else if (ivar == TwoPiPlotGenerator::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve SDME parameters for plotting and asymmetry - // ************************ - - // parameters to check - vector< string > pars; - pars.push_back("rho000"); - pars.push_back("rho100"); - pars.push_back("rho1m10"); - - pars.push_back("rho111"); - pars.push_back("rho001"); - pars.push_back("rho101"); - pars.push_back("rho1m11"); - - pars.push_back("rho102"); - pars.push_back("rho1m12"); - - // file for writing parameters (later switch to putting in ROOT file) - ofstream outfile; - outfile.open( "twopi_fitPars.txt" ); - - for(unsigned int i = 0; i > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[3]) + results.parValue(pars[6]); - double SigmaN_err = covMatrix[5][5] + covMatrix[8][8] + 2*covMatrix[5][8]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[2]); - double SigmaD_err = 0.5*0.5*covMatrix[2][2] + covMatrix[4][4] - 2*0.5*covMatrix[2][4]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - outfile << Sigma << "\t" << Sigma_err << "\t"; - - double P = 2*results.parValue(pars[6]) - results.parValue(pars[4]); - double P_err = sqrt(2*2*covMatrix[8][8] + covMatrix[6][6] - 2*2*covMatrix[6][8]); - outfile << P << "\t" << P_err << "\t"; - - outfile << endl; - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - PlotFactory factory( plotGen ); - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - - app.Run(); - } - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/RootScripts/twopi_amp.C b/src/programs/AmplitudeAnalysis/twopi_plotter_amp/RootScripts/twopi_amp.C deleted file mode 100644 index 943f3da468..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/RootScripts/twopi_amp.C +++ /dev/null @@ -1,568 +0,0 @@ -void twopi_amp(void) -{ -// File: twopi_amp.C - // Output histograms and fits generated from amp fitting of parameters. -// - - gStyle->SetPalette(1,0); - gStyle->SetOptStat(111111); - gStyle->SetOptFit(111111); - gStyle->SetPadRightMargin(0.15); - gStyle->SetPadLeftMargin(0.15); - gStyle->SetPadBottomMargin(0.15); - - char string[256]; - map sdme; - sdme[0]="RE g1VM1\t"; - sdme[1]="RE g1VM0\t"; - sdme[2]="IM g1VM0\t\t"; - sdme[3]="RE g1VM-1\t"; - sdme[4]="IM g1VM-1\t"; - sdme[5]="RE g-1VM1\t"; - sdme[6]="IM g-1VM1\t"; - sdme[7]="RE g-1VM0\t"; - sdme[8]="IM g-1VM0\t"; - sdme[9]="RE g-1VM-1\t"; - sdme[10]="IM g-1VM-1\t"; - - const Int_t nparms=11; - Double_t parms[nparms]; - Double_t parms_err[nparms]; - - bool genfile(false); - - // TString filename = "twopi_amp"; - TString filename = "twopi_amp_fitPars"; - - TString infile = filename+".fit2"; // file with parameters - TFile *f = new TFile(filename+".root","read"); - - cout << "Opening parameters file: " << infile.Data() << endl; - cout << "Opening root file: " << (filename+".root").Data() << endl; - - - TH1F *M2pigen = (TH1F*)f->Get("M2pigen"); - TH1F *M2piacc = (TH1F*)f->Get("M2piacc"); - TH1F *M2pidat = (TH1F*)f->Get("M2pidat"); - - TH1F *cosThetagen = (TH1F*)f->Get("cosThetagen"); - TH1F *cosThetaacc = (TH1F*)f->Get("cosThetaacc"); - TH1F *cosThetadat = (TH1F*)f->Get("cosThetadat"); - - TH1F *psigen = (TH1F*)f->Get("psigen"); - TH1F *psiacc = (TH1F*)f->Get("psiacc"); - TH1F *psidat = (TH1F*)f->Get("psidat"); - - TH1F *Phigen = (TH1F*)f->Get("Phigen"); - TH1F *Phiacc = (TH1F*)f->Get("Phiacc"); - TH1F *Phidat = (TH1F*)f->Get("Phidat"); - - TH1F *phigen = (TH1F*)f->Get("phigen"); - TH1F *phiacc = (TH1F*)f->Get("phiacc"); - TH1F *phidat = (TH1F*)f->Get("phidat"); - - TH1F *tgen = (TH1F*)f->Get("tgen"); - TH1F *tacc = (TH1F*)f->Get("tacc"); - TH1F *tdat = (TH1F*)f->Get("tdat"); - - - TCanvas *c0 = new TCanvas("c0", "c0",200,10,1000,700); - - c0->Divide(3,2); - c0->cd(1); - // gPad->SetLogy(); - Double_t xmin = 0; - Double_t xmax = 2; - Double_t ymin = 100; - Double_t ymax = 10000; - - M2pigen->SetTitle(filename); - // M2pigen->GetXaxis()->SetRangeUser(xmin,xmax); - // M2pigen->GetYaxis()->SetRangeUser(ymin,ymax); - M2pigen->GetXaxis()->SetTitleSize(0.05); - M2pigen->GetYaxis()->SetTitleSize(0.05); - M2pigen->GetXaxis()->SetTitle("M(#pi^{+}#pi^{-})"); - M2pigen->SetMarkerColor(4); - M2pigen->Draw("p"); - // M2piacc->Draw("samep"); - M2pidat->SetMarkerColor(2); - M2pidat->SetLineColor(2); - M2pidat->SetMarkerStyle(20); - M2pidat->SetMarkerSize(0.1); - M2pidat->Draw("samep"); - - TLegend *leg = new TLegend(0.6,0.3,0.8,0.5); - leg->AddEntry(M2pigen,"Gen","lp"); - leg->AddEntry(M2piacc,"Acc","lp"); - leg->AddEntry(M2pidat,"Data","lp"); - leg->Draw(); - - c0->cd(2); - // gPad->SetLogy(); - ymin = 0; - ymax = 5000; - - cosThetagen->SetTitle(filename); - // cosThetagen->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) cosThetagen->GetYaxis()->SetRangeUser(ymin,ymax); - cosThetagen->GetXaxis()->SetTitleSize(0.05); - cosThetagen->GetYaxis()->SetTitleSize(0.05); - cosThetagen->GetXaxis()->SetTitle("cos(#theta)"); - cosThetagen->SetLineColor(4); - cosThetagen->Draw("p"); - // cosThetaacc->Draw("samep"); - cosThetadat->SetMarkerColor(2); - cosThetadat->SetLineColor(2); - cosThetadat->SetMarkerStyle(20); - cosThetadat->SetMarkerSize(0.1); - cosThetadat->Draw("samep"); - - c0->cd(3); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - TF1 *cos2phi = new TF1("cos2phi","[0]*(1+[1]*cos(2*x))",-3.14159,3.14159); - - psigen->SetTitle(filename); - // psigen->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) psigen->GetYaxis()->SetRangeUser(ymin,ymax); - psigen->GetXaxis()->SetTitleSize(0.05); - psigen->GetYaxis()->SetTitleSize(0.05); - psigen->GetXaxis()->SetTitle("#psi"); - psigen->SetMarkerColor(4); - psigen->Fit(cos2phi); - psigen->Draw("p"); - // psiacc->Draw("samep"); - psidat->SetMarkerColor(2); - psidat->SetLineColor(2); - psidat->SetMarkerStyle(20); - psidat->SetMarkerSize(0.1); - psidat->Draw("samep"); - - c0->cd(4); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - Phigen->SetTitle(filename); - // Phigen->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) Phigen->GetYaxis()->SetRangeUser(ymin,ymax); - Phigen->GetXaxis()->SetTitleSize(0.05); - Phigen->GetYaxis()->SetTitleSize(0.05); - Phigen->GetXaxis()->SetTitle("#Phi"); - Phigen->SetMarkerColor(4); - Phigen->Fit(cos2phi); - Phigen->Draw("p"); - // Phiacc->Draw("samep"); - Phidat->SetMarkerColor(2); - Phidat->SetLineColor(2); - Phidat->SetMarkerStyle(20); - Phidat->SetMarkerSize(0.1); - Phidat->Draw("samep"); - - c0->cd(5); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - phigen->SetTitle(filename); - // phigen->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) phigen->GetYaxis()->SetRangeUser(ymin,ymax); - phigen->GetXaxis()->SetTitleSize(0.05); - phigen->GetYaxis()->SetTitleSize(0.05); - phigen->GetXaxis()->SetTitle("#phi"); - phigen->SetMarkerColor(4); - phigen->Fit(cos2phi); - phigen->Draw("p"); - // phiacc->Draw("samep"); - phidat->SetMarkerColor(2); - phidat->SetLineColor(2); - phidat->SetMarkerStyle(20); - phidat->SetMarkerSize(0.1); - phidat->Draw("samep"); - - c0->cd(6); - gPad->SetLogy(); - xmin = 0; - xmax = 3; - - tgen->SetTitle(filename); - tgen->GetXaxis()->SetRangeUser(xmin,xmax); - // tgen->GetYaxis()->SetRangeUser(ymin,ymax); - tgen->GetXaxis()->SetTitleSize(0.05); - tgen->GetYaxis()->SetTitleSize(0.05); - tgen->GetXaxis()->SetTitle("-t"); - tgen->SetMarkerColor(4); - tgen->Fit("expo","","",0.2,1.3); - tgen->Draw("p"); - // tacc->Draw("samep"); - tdat->SetMarkerColor(2); - tdat->SetLineColor(2); - tdat->SetMarkerStyle(20); - tdat->SetMarkerSize(0.1); - tdat->Draw("samep"); - - - TCanvas *c2 = new TCanvas("c2", "c2",200,10,1000,700); - - c2->Divide(3,2); - c2->cd(1); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - - TH1F *M2piAcceptance = (TH1F*)M2piacc->Clone("M2piAcceptance"); - M2piAcceptance->SetTitle("Acceptance"); - // M2piAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) M2piAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - M2piAcceptance->Divide(M2pigen); - M2piAcceptance->GetXaxis()->SetTitleSize(0.05); - M2piAcceptance->GetYaxis()->SetTitleSize(0.05); - M2piAcceptance->GetXaxis()->SetTitle("M(#pi^{+}#pi^{-})"); - M2piAcceptance->SetMarkerColor(4); - M2piAcceptance->Draw("p"); - - c2->cd(2); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - - TH1F *cosThetaAcceptance = (TH1F*)cosThetaacc->Clone("cosThetaAcceptance"); - cosThetaAcceptance->SetTitle("Acceptance"); - // cosThetaAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) cosThetaAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - cosThetaAcceptance->Divide(cosThetagen); - cosThetaAcceptance->GetXaxis()->SetTitleSize(0.05); - cosThetaAcceptance->GetYaxis()->SetTitleSize(0.05); - cosThetaAcceptance->GetXaxis()->SetTitle("cos(#theta)"); - cosThetaAcceptance->SetMarkerColor(4); - cosThetaAcceptance->Draw("p"); - - c2->cd(3); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - - TH1F *psiAcceptance = (TH1F*)psiacc->Clone("psiAcceptance"); - psiAcceptance->SetTitle("Acceptance"); - // psiAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) psiAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - psiAcceptance->Divide(psigen); - psiAcceptance->GetXaxis()->SetTitleSize(0.05); - psiAcceptance->GetYaxis()->SetTitleSize(0.05); - psiAcceptance->GetXaxis()->SetTitle("#psi"); - psiAcceptance->SetMarkerColor(4); - psiAcceptance->Draw("p"); - - c2->cd(4); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - - TH1F *PhiAcceptance = (TH1F*)Phiacc->Clone("PhiAcceptance"); - PhiAcceptance->SetTitle("Acceptance"); - // PhiAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) PhiAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - PhiAcceptance->Divide(Phigen); - PhiAcceptance->GetXaxis()->SetTitleSize(0.05); - PhiAcceptance->GetYaxis()->SetTitleSize(0.05); - PhiAcceptance->GetXaxis()->SetTitle("#Phi"); - PhiAcceptance->SetMarkerColor(4); - PhiAcceptance->Draw("p"); - - c2->cd(5); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - - TH1F *phiAcceptance = (TH1F*)phiacc->Clone("phiAcceptance"); - phiAcceptance->SetTitle("Acceptance"); - // phiAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) phiAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - phiAcceptance->Divide(phigen); - phiAcceptance->GetXaxis()->SetTitleSize(0.05); - phiAcceptance->GetYaxis()->SetTitleSize(0.05); - phiAcceptance->GetXaxis()->SetTitle("#phi"); - phiAcceptance->SetMarkerColor(4); - phiAcceptance->Draw("p"); - - c2->cd(6); - // gPad->SetLogy(); - ymin = 0; - ymax = 1.2; - xmin = 0; - xmax = 3; - - TH1F *tAcceptance = (TH1F*)tacc->Clone("tAcceptance"); - tAcceptance->SetTitle("Acceptance"); - tAcceptance->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) tAcceptance->GetYaxis()->SetRangeUser(ymin,ymax); - tAcceptance->Divide(tgen); - tAcceptance->GetXaxis()->SetTitleSize(0.05); - tAcceptance->GetYaxis()->SetTitleSize(0.05); - tAcceptance->GetXaxis()->SetTitle("-t"); - tAcceptance->SetMarkerColor(4); - tAcceptance->Draw("p"); - - TCanvas *c1 = new TCanvas("c1", "c1",200,10,1000,700); - - c1->Divide(3,2); - c1->cd(1); - // gPad->SetLogy(); - ymin = 100; - ymax = 10000; - - M2piacc->SetTitle(filename); - // M2piacc->GetXaxis()->SetRangeUser(xmin,xmax); - // M2piacc->GetYaxis()->SetRangeUser(ymin,ymax); - M2piacc->GetXaxis()->SetTitleSize(0.05); - M2piacc->GetYaxis()->SetTitleSize(0.05); - M2piacc->GetXaxis()->SetTitle("M(#pi^{+}#pi^{-})"); - M2piacc->SetMarkerColor(1); - M2piacc->SetLineColor(1); - M2piacc->Draw("p"); - // M2piacc->Draw("samep"); - M2pidat->SetMarkerColor(2); - M2pidat->SetLineColor(2); - M2pidat->SetMarkerStyle(20); - M2pidat->SetMarkerSize(0.1); - M2pidat->Draw("samep"); - - TLegend *leg1 = new TLegend(0.6,0.3,0.8,0.5); - leg1->AddEntry(M2pigen,"Gen","lp"); - leg1->AddEntry(M2piacc,"Acc","lp"); - leg1->AddEntry(M2pidat,"Data","lp"); - leg1->Draw(); - - c1->cd(2); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - cosThetaacc->SetTitle(filename); - // cosThetaacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) cosThetaacc->GetYaxis()->SetRangeUser(ymin,ymax); - cosThetaacc->GetXaxis()->SetTitleSize(0.05); - cosThetaacc->GetYaxis()->SetTitleSize(0.05); - cosThetaacc->GetXaxis()->SetTitle("cos(#theta)"); - cosThetaacc->SetLineColor(1); - cosThetaacc->SetMarkerColor(1); - cosThetaacc->Draw("p"); - // cosThetaacc->Draw("samep"); - cosThetadat->SetMarkerColor(2); - cosThetadat->SetLineColor(2); - cosThetadat->SetMarkerStyle(20); - cosThetadat->SetMarkerSize(0.1); - cosThetadat->Draw("samep"); - - c1->cd(3); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - psiacc->SetTitle(filename); - // psiacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) psiacc->GetYaxis()->SetRangeUser(ymin,ymax); - psiacc->GetXaxis()->SetTitleSize(0.05); - psiacc->GetYaxis()->SetTitleSize(0.05); - psiacc->GetXaxis()->SetTitle("#psi"); - psiacc->SetMarkerColor(1); - psiacc->SetLineColor(1); - psiacc->Fit(cos2phi); - psiacc->Draw("p"); - // psiacc->Draw("samep"); - psidat->SetMarkerColor(2); - psidat->SetLineColor(2); - psidat->SetMarkerStyle(20); - psidat->SetMarkerSize(0.1); - psidat->Draw("samep"); - - c1->cd(4); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - Phiacc->SetTitle(filename); - // Phiacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) Phiacc->GetYaxis()->SetRangeUser(ymin,ymax); - Phiacc->GetXaxis()->SetTitleSize(0.05); - Phiacc->GetYaxis()->SetTitleSize(0.05); - Phiacc->GetXaxis()->SetTitle("#Phi"); - Phiacc->SetMarkerColor(1); - Phiacc->SetLineColor(1); - Phiacc->Fit(cos2phi); - Phiacc->Draw("p"); - // Phiacc->Draw("samep"); - Phidat->SetMarkerColor(2); - Phidat->SetLineColor(2); - Phidat->SetMarkerStyle(20); - Phidat->SetMarkerSize(0.1); - Phidat->Draw("samep"); - - - c1->cd(5); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - phiacc->SetTitle(filename); - // phiacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) phiacc->GetYaxis()->SetRangeUser(ymin,ymax); - phiacc->GetXaxis()->SetTitleSize(0.05); - phiacc->GetYaxis()->SetTitleSize(0.05); - phiacc->GetXaxis()->SetTitle("#phi"); - phiacc->SetMarkerColor(1); - phiacc->SetLineColor(1); - phiacc->Fit(cos2phi); - phiacc->Draw("p"); - // phiacc->Draw("samep"); - phidat->SetMarkerColor(2); - phidat->SetLineColor(2); - phidat->SetMarkerStyle(20); - phidat->SetMarkerSize(0.1); - phidat->Draw("samep"); - - c1->cd(6); - gPad->SetLogy(); - xmin = 0; - xmax = 3; - - tacc->SetTitle(filename); - tacc->GetXaxis()->SetRangeUser(xmin,xmax); - // tacc->GetYaxis()->SetRangeUser(ymin,ymax); - tacc->GetXaxis()->SetTitleSize(0.05); - tacc->GetYaxis()->SetTitleSize(0.05); - tacc->GetXaxis()->SetTitle("-t"); - tacc->SetMarkerColor(1); - tacc->SetLineColor(1); - tacc->Draw("p"); - // tacc->Draw("samep"); - tdat->SetMarkerColor(2); - tdat->SetLineColor(2); - tdat->SetMarkerStyle(20); - tdat->SetMarkerSize(0.1); - tdat->Draw("samep"); - - TCanvas *c3 = new TCanvas("c3", "c3",200,10,700,700); - - c3->Divide(2,2); - c3->cd(1); - // gPad->SetLogy(); - ymin = 100; - ymax = 10000; - - M2piacc->SetTitle(filename); - // M2piacc->GetXaxis()->SetRangeUser(xmin,xmax); - // M2piacc->GetYaxis()->SetRangeUser(ymin,ymax); - M2piacc->GetXaxis()->SetTitleSize(0.05); - M2piacc->GetYaxis()->SetTitleSize(0.05); - M2piacc->GetXaxis()->SetTitle("M(#pi^{+}#pi^{-})"); - M2piacc->SetMarkerColor(1); - M2piacc->Draw("p"); - // M2piacc->Draw("samep"); - M2pidat->SetMarkerColor(2); - M2pidat->SetLineColor(2); - M2pidat->SetMarkerStyle(20); - M2pidat->SetMarkerSize(0.1); - M2pidat->Draw("samep"); - - c3->cd(2); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - cosThetaacc->SetTitle(filename); - // cosThetaacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) cosThetaacc->GetYaxis()->SetRangeUser(ymin,ymax); - cosThetaacc->GetXaxis()->SetTitleSize(0.05); - cosThetaacc->GetYaxis()->SetTitleSize(0.05); - cosThetaacc->GetXaxis()->SetTitle("cos(#theta)"); - cosThetaacc->SetLineColor(1); - cosThetaacc->Draw("p"); - // cosThetaacc->Draw("samep"); - cosThetadat->SetMarkerColor(2); - cosThetadat->SetLineColor(2); - cosThetadat->SetMarkerStyle(20); - cosThetadat->SetMarkerSize(0.1); - cosThetadat->Draw("samep"); - - c3->cd(3); - // gPad->SetLogy(); - ymin = 0; - ymax = 4000; - - // TF1 *cos2phi = new TF1("cos2phi","[0]*(1+[1]*cos(2*x))",-3.14159,3.14159); - - psiacc->SetTitle(filename); - // psiacc->GetXaxis()->SetRangeUser(xmin,xmax); - if (!genfile) psiacc->GetYaxis()->SetRangeUser(ymin,ymax); - psiacc->GetXaxis()->SetTitleSize(0.05); - psiacc->GetYaxis()->SetTitleSize(0.05); - psiacc->GetXaxis()->SetTitle("#psi"); - psiacc->SetMarkerColor(1); - psiacc->Fit(cos2phi); - psiacc->Draw("p"); - // psiacc->Draw("samep"); - psidat->SetMarkerColor(2); - psidat->SetLineColor(2); - psidat->SetMarkerStyle(20); - psidat->SetMarkerSize(0.1); - psidat->Draw("samep"); - - - c3->cd(4); - - // now read and print fitted values - - ifstream parameters; - parameters.open (infile.Data()); - if (!parameters) { - cout << "ERROR: Failed to open data file= " << infile.Data() << endl; - return; - } - - TString line; - while (line.ReadLine(parameters)){ - - TObjArray *tokens = line.Tokenize("\t"); - Int_t ntokens = tokens->GetEntries(); - - cout << " ntokens=" << ntokens << " line=" << line.Data() << endl; - Int_t jmax = ntokens/2 > nparms? nparms: ntokens/2; - for (Int_t j=0; jAt(2*j))->GetString()).Atof(); - parms_err[j] = (((TObjString*)tokens->At(2*j+1))->GetString()).Atof(); - } - - } // end loop over lines - - sprintf (string,"AmpTool Fit\n"); - printf("string=%s",string); - TLatex *t1 = new TLatex(0.2,0.95,string); - // t1->SetNDC(); - t1->SetTextSize(0.04); - t1->Draw(); - - for (Int_t j=0; jSetNDC(); - t1->SetTextSize(0.04); - t1->Draw(); - } - - - parameters.close(); - - - c0->SaveAs(filename+".pdf("); - c1->SaveAs(filename+".pdf"); - c2->SaveAs(filename+".pdf"); - c3->SaveAs(filename+".pdf)"); -} diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/SConscript b/src/programs/AmplitudeAnalysis/twopi_plotter_amp/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/twopi_plotter_amp.cc b/src/programs/AmplitudeAnalysis/twopi_plotter_amp/twopi_plotter_amp.cc deleted file mode 100644 index 5cef077934..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_amp/twopi_plotter_amp.cc +++ /dev/null @@ -1,255 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/TwoPiPlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_amp.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -typedef TwoPiPlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles_amp() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\ttwopi_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "twopi_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - - // loop over data, accMC, and genMC - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < TwoPiPlotGenerator::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == TwoPiPlotGenerator::k2PiMass) histname += "M2pi"; - else if (ivar == TwoPiPlotGenerator::kPiPCosTheta) histname += "cosTheta"; - else if (ivar == TwoPiPlotGenerator::kPhi) histname += "Phi"; - else if (ivar == TwoPiPlotGenerator::kphi) histname += "phi"; - else if (ivar == TwoPiPlotGenerator::kPsi) histname += "psi"; - else if (ivar == TwoPiPlotGenerator::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve amplitudes for output - // ************************ - - // parameters to check - vector< string > pars; - pars.push_back("Pi+Pi-::helplusN+::g1VM1_re"); - pars.push_back("Pi+Pi-::helplusN+::g1VM0_re"); - pars.push_back("Pi+Pi-::helplusN+::g1VM0_im"); - - pars.push_back("Pi+Pi-::helplusN+::g1VM-1_re"); - pars.push_back("Pi+Pi-::helplusN+::g1VM-1_im"); - pars.push_back("Pi+Pi-::helplusN+::g-1VM1_re"); - pars.push_back("Pi+Pi-::helplusN+::g-1VM1_im"); - - pars.push_back("Pi+Pi-::helplusN+::g-1VM0_re"); - pars.push_back("Pi+Pi-::helplusN+::g-1VM0_im"); - pars.push_back("Pi+Pi-::helplusN+::g-1VM-1_re"); - pars.push_back("Pi+Pi-::helplusN+::g-1VM-1_im"); - - // file for writing parameters (later switch to putting in ROOT file) - ofstream outfile; - outfile.open( "twopi_fitPars.txt" ); - - for(unsigned int i = 0; i > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[3]) + results.parValue(pars[6]); - double SigmaN_err = covMatrix[5][5] + covMatrix[8][8] + 2*covMatrix[5][8]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[2]); - double SigmaD_err = 0.5*0.5*covMatrix[2][2] + covMatrix[4][4] - 2*0.5*covMatrix[2][4]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - - double P = 2*results.parValue(pars[6]) - results.parValue(pars[4]); - double P_err = sqrt(2*2*covMatrix[8][8] + covMatrix[6][6] - 2*2*covMatrix[6][8]); - - Sigma = Sigma_err = P = P_err = 0; - outfile << Sigma << "\t" << Sigma_err << "\t"; - outfile << P << "\t" << P_err << "\t"; - - outfile << endl; - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - PlotFactory factory( plotGen ); - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - - app.Run(); - } - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_mom/SConscript b/src/programs/AmplitudeAnalysis/twopi_plotter_mom/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_mom/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_mom/twopi_plotter_mom.cc b/src/programs/AmplitudeAnalysis/twopi_plotter_mom/twopi_plotter_mom.cc deleted file mode 100644 index b99b129e29..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_mom/twopi_plotter_mom.cc +++ /dev/null @@ -1,243 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/TwoPiPlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_AMPS/TwoPSHelicity.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -typedef TwoPiPlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( TwoPSHelicity() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\ttwopi_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "twopi_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - - // loop over data, accMC, and genMC - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < TwoPiPlotGenerator::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == TwoPiPlotGenerator::k2PiMass) histname += "M2pi"; - else if (ivar == TwoPiPlotGenerator::kPiPCosTheta) histname += "cosTheta"; - else if (ivar == TwoPiPlotGenerator::kPhi) histname += "Phi"; - else if (ivar == TwoPiPlotGenerator::kphi) histname += "phi"; - else if (ivar == TwoPiPlotGenerator::kPsi) histname += "psi"; - else if (ivar == TwoPiPlotGenerator::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve amplitudes for output - // ************************ - /* - // parameters to check - vector< string > pars; - pars.push_back("Pi+Pi-::Positive::S0+_re"); - pars.push_back("Pi+Pi-::Positive::S0+_im"); - - // file for writing parameters (later switch to putting in ROOT file) - ofstream outfile; - outfile.open( "twopi_fitPars.txt" ); - - for(unsigned int i = 0; i > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[3]) + results.parValue(pars[6]); - double SigmaN_err = covMatrix[5][5] + covMatrix[8][8] + 2*covMatrix[5][8]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[2]); - double SigmaD_err = 0.5*0.5*covMatrix[2][2] + covMatrix[4][4] - 2*0.5*covMatrix[2][4]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - - double P = 2*results.parValue(pars[6]) - results.parValue(pars[4]); - double P_err = sqrt(2*2*covMatrix[8][8] + covMatrix[6][6] - 2*2*covMatrix[6][8]); - - Sigma = Sigma_err = P = P_err = 0; - outfile << Sigma << "\t" << Sigma_err << "\t"; - outfile << P << "\t" << P_err << "\t"; - - outfile << endl; - */ - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - PlotFactory factory( plotGen ); - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - - app.Run(); - } - - return 0; - -} - diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/SConscript b/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/SConscript deleted file mode 100644 index be2fabbbd2..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('AMPPLOTTER', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddAmpTools(env) - sbms.AddAmpPlotter(env) - sbms.AddROOT(env) - - sbms.executable(env) diff --git a/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/twopi_plotter_primakoff.cc b/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/twopi_plotter_primakoff.cc deleted file mode 100644 index cca4d7da6b..0000000000 --- a/src/programs/AmplitudeAnalysis/twopi_plotter_primakoff/twopi_plotter_primakoff.cc +++ /dev/null @@ -1,279 +0,0 @@ -#include -#include -#include -#include - -#include "TClass.h" -#include "TApplication.h" -#include "TGClient.h" -#include "TROOT.h" -#include "TH1.h" -#include "TStyle.h" -#include "TClass.h" -#include "TFile.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/FitResults.h" - -#include "AmpPlotter/PlotterMainWindow.h" -#include "AmpPlotter/PlotFactory.h" - -#include "AMPTOOLS_DATAIO/TwoZPiPlotGenerator.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/TwoPiWt_primakoff.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_primakoff.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -typedef TwoZPiPlotGenerator PlotGen; - -void atiSetup(){ - - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles_primakoff() ); - AmpToolsInterface::registerAmplitude( TwoPiWt_primakoff() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerDataReader( ROOTDataReader() ); -} - -using namespace std; - -int main( int argc, char* argv[] ){ - - - // ************************ - // usage - // ************************ - - cout << endl << " *** Viewing Results Using AmpPlotter and writing root histograms *** " << endl << endl; - - if (argc < 2){ - cout << "Usage:" << endl << endl; - cout << "\ttwopi_plotter -o " << endl << endl; - return 0; - } - - bool showGui = false; - string outName = "twopi_plot.root"; - string resultsName(argv[1]); - for (int i = 2; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-g"){ - showGui = true; - } - if (arg == "-o"){ - outName = argv[++i]; - } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -o \t output file path" << endl; - cout << "\t -g \t show GUI" << endl; - exit(1); - } - } - - - // ************************ - // parse the command line parameters - // ************************ - - cout << "Fit results file name = " << resultsName << endl; - cout << "Output file name = " << outName << endl << endl; - - // ************************ - // load the results and display the configuration info - // ************************ - - FitResults results( resultsName ); - if( !results.valid() ){ - - cout << "Invalid fit results in file: " << resultsName << endl; - exit( 1 ); - } - - // ************************ - // set up the plot generator - // ************************ - - atiSetup(); - PlotGen plotGen( results ); - - // ************************ - // set up an output ROOT file to store histograms - // ************************ - - TFile* plotfile = new TFile( outName.c_str(), "recreate"); - TH1::AddDirectory(kFALSE); - - string reactionName = results.reactionList()[0]; - plotGen.enableReaction( reactionName ); - vector sums = plotGen.uniqueSums(); - - - // loop over sum configurations (one for each of the individual contributions, and the combined sum of all) - for (unsigned int isum = 0; isum <= sums.size(); isum++){ - - // turn on all sums by default - for (unsigned int i = 0; i < sums.size(); i++){ - plotGen.enableSum(i); - } - - // for individual contributions turn off all sums but the one of interest - if (isum < sums.size()){ - for (unsigned int i = 0; i < sums.size(); i++){ - if (i != isum) plotGen.disableSum(i); - } - } - - - // loop over data, accMC, and genMC and kBkgnd - for (unsigned int iplot = 0; iplot < PlotGenerator::kNumTypes; iplot++){ - if (isum < sums.size() && iplot == PlotGenerator::kData) continue; // only plot data once - - // loop over different variables - for (unsigned int ivar = 0; ivar < TwoZPiPlotGenerator::kNumHists; ivar++){ - - // set unique histogram name for each plot (could put in directories...) - string histname = ""; - if (ivar == TwoZPiPlotGenerator::k2PiMass) histname += "M2pi"; - else if (ivar == TwoZPiPlotGenerator::kPiPCosTheta) histname += "cosTheta"; - else if (ivar == TwoZPiPlotGenerator::kPhi) histname += "Phi"; - else if (ivar == TwoZPiPlotGenerator::kphi) histname += "phi"; - else if (ivar == TwoZPiPlotGenerator::kPsi) histname += "psi"; - else if (ivar == TwoZPiPlotGenerator::kt) histname += "t"; - else continue; - - if (iplot == PlotGenerator::kData) histname += "dat"; - if (iplot == PlotGenerator::kAccMC) histname += "acc"; - if (iplot == PlotGenerator::kGenMC) histname += "gen"; - if (iplot == PlotGenerator::kBkgnd) histname += "bkgnd"; - - if (isum < sums.size()){ - //ostringstream sdig; sdig << (isum + 1); - //histname += sdig.str(); - - // get name of sum for naming histogram - string sumName = sums[isum]; - histname += "_"; - histname += sumName; - } - - Histogram* hist = plotGen.projection(ivar, reactionName, iplot); - TH1* thist = hist->toRoot(); - thist->SetName(histname.c_str()); - plotfile->cd(); - thist->Write(); - - } - } - } - - plotfile->Close(); - - // ************************ - // retrieve amplitudes for output - // ************************ - - // get parameter list - - // parameters to check - vector< string > pars; - /* pars.push_back("Primakoff::Aplus::g1V00_re"); - pars.push_back("Primakoff::Aplus::g1V00_im"); - pars.push_back("Primakoff::Aplus::g1V11_re"); - pars.push_back("Primakoff::Aplus::g1V11_im"); - pars.push_back("Primakoff::Aplus::g1V10_re"); - pars.push_back("Primakoff::Aplus::g1V10_im"); - pars.push_back("Primakoff::Aplus::g1V1-1_re"); - pars.push_back("Primakoff::Aplus::g1V1-1_im");*/ - - vector parlist; - parlist = results.ampList("Primakoff"); - for(unsigned int j=0; j > covMatrix; - covMatrix = results.errorMatrix(); - - double SigmaN = results.parValue(pars[0]) + results.parValue(pars[0]); - double SigmaN_err = covMatrix[0][0] + covMatrix[0][0] + 2*covMatrix[0][0]; - - double SigmaD = 0.5*(1 - results.parValue(pars[0])) + results.parValue(pars[0]); - double SigmaD_err = 0.5*0.5*covMatrix[0][0] + covMatrix[0][0] - 2*0.5*covMatrix[0][0]; - - double Sigma = SigmaN/SigmaD; - double Sigma_err = fabs(Sigma) * sqrt(SigmaN_err/SigmaN/SigmaN + SigmaD_err/SigmaD/SigmaD); - - double P = 2*results.parValue(pars[0]) - results.parValue(pars[0]); - double P_err = sqrt(2*2*covMatrix[0][0] + covMatrix[0][0] - 2*2*covMatrix[0][0]); - - Sigma = Sigma_err = P = P_err = 0; - outfile << "Sigma" << "\t" << Sigma << "\t" << Sigma_err << "\t"; - outfile << "P" << "\t" << P << "\t" << P_err << "\t"; - - // output covariance matrix. Output only half since A+ and A- are constrained to be the same. - for (unsigned int j=0; j< covMatrix.size()/2; j++) { - outfile << endl; - for (unsigned int jj=0; jj< covMatrix.size()/2; jj++) { - outfile.width(20); - outfile << covMatrix[j][jj]; - } - } - - - outfile << endl; - - // ************************ - // start the GUI - // ************************ - - if(showGui) { - - cout << ">> Plot generator ready, starting GUI..." << endl; - - int dummy_argc = 0; - char* dummy_argv[] = {}; - TApplication app( "app", &dummy_argc, dummy_argv ); - - gStyle->SetFillColor(10); - gStyle->SetCanvasColor(10); - gStyle->SetPadColor(10); - gStyle->SetFillStyle(1001); - gStyle->SetPalette(1); - gStyle->SetFrameFillColor(10); - gStyle->SetFrameFillStyle(1001); - - PlotFactory factory( plotGen ); - PlotterMainWindow mainFrame( gClient->GetRoot(), factory ); - - app.Run(); - } - - return 0; - -} - diff --git a/src/programs/SConscript b/src/programs/SConscript index 064e2944ad..2dc37bcdce 100644 --- a/src/programs/SConscript +++ b/src/programs/SConscript @@ -5,6 +5,6 @@ Import('*') Import('env osname') -subdirs = ['Analysis', 'Utilities', 'Simulation', 'AmplitudeAnalysis'] +subdirs = ['Analysis', 'Utilities'] SConscript(dirs=subdirs, exports='env osname', duplicate=0) diff --git a/src/programs/Simulation/BGRate_calc/BGRate_calc.cc b/src/programs/Simulation/BGRate_calc/BGRate_calc.cc deleted file mode 100644 index 26eb63de40..0000000000 --- a/src/programs/Simulation/BGRate_calc/BGRate_calc.cc +++ /dev/null @@ -1,274 +0,0 @@ -#include -#include -using namespace std; -#include -#include -#include -#include - -#include -#include "CobremsGeneration.hh" -#include "TFile.h" -#include "TH1D.h" - -// /w/halld-scifs1a/home/scole/gluex_top/sim-recon/master/Linux_CentOS7-x86_64-gcc4.8.5/bin is location -// of the executable - -static void show_usage(string argStr) -{ - cout<"<"<"<"<"<"<"<"<"<"<"<"<setBeamEnergy(beam_energy); - cobrems->setCoherentEdge(coherent_peak); - cobrems->setBeamErms(beam_energy_rms); - cobrems->setBeamEmittance(beam_emittance); - cobrems->setCollimatorDistance(collimator_distance); - cobrems->setCollimatorDiameter(collimator_diameter); - cobrems->setTargetThickness(radiator_thickness); - cobrems->setCollimatedFlag(true); - - cobrems->printBeamlineInfo(); - - double Emin = endpoint_energy_low; - double Emax = endpoint_energy_high; - - double x0 = Emin / beam_energy; - double x1 = Emax / beam_energy; - - double xvals[nbins]; - double yvals[nbins]; - - if (coherent_peak > 0.0) - { - cout<<"Polarized BGRate"<Rate_dNtdx(xvals[i]) * beam_on_current / 1.6e-13; - } - } - else - { - cout<<"Amorphous BGRate"<Rate_dNidx(xvals[i]) * beam_on_current / 1.6e-13; - } - } - - cobrems->applyBeamCrystalConvolution(nbins, xvals, yvals); - - TH1D* dRtdkH1 = new TH1D("dRtdkH1", "", nbins, Emin, Emax); - dRtdkH1->GetXaxis()->SetRangeUser(Emin + (Emax - Emin)/10., Emax); - - for(int i=0; i < nbins; i++) - { - dRtdkH1->Fill(xvals[i]*beam_energy, yvals[i]/beam_energy); - } - - double persec = (Emax - Emin) * 1./nbins; - double erate = dRtdkH1->Integral(dRtdkH1->FindBin(endpoint_energy_low), dRtdkH1->FindBin(endpoint_energy_high) - 1) * persec; - - if (coherent_peak == 0.0) - { - erate = erate * getTargetRadiationLength_Schiff(13, 4, 404.95e-12) / cobrems->getTargetRadiationLength_Schiff(); - } - - if (write == true) - { - char charBuff[50]; - sprintf(charBuff, "\\mbox{photon beam spectrum vs }E_\\gamma \\mbox{ (/GeV/s)} runNo: %i", runNo); - dRtdkH1->SetTitle(charBuff); - sprintf(charBuff, "BGRate_%i.root", runNo); - cout<<"Saving file"<Write(); - f->Write(); - f->Close(); - } - - - cout<<"BGRate GHz = "< - -#include - - -extern "C" { - void GetDOCA(int ipart, float x[3], float p[5], float doca[3]); - void gfpart_(int *ipart, char * chnpar, int *itrtyp, float *amass, float *charge, float *tlife, float *ubuf, int *nubuf); - -#include "geant3.h" -} - - -#include -#include - -extern DMagneticFieldMap *Bmap; // from clibDB.cc - -//----------------- -// GetDOCA -//------------------ -void GetDOCA(int ipart, float x[3], float p[5], float doca[3]) -{ - /* Project the particle from the given position with the given momentum - * to the DOCA as determined by the origin of the local coordinate system. - * - * The values of x and p are in the global coordinate system while doca - * is in the local coordinate system. - */ - - /* Get the charge of this particle (jeesh!) */ - int nubuf, itrtyp; - float ubuf[10], amass,charge,tlife; - char chnpar[99]; - gfpart_(&ipart, chnpar,&itrtyp,&amass,&charge,&tlife,ubuf,&nubuf); - - // We need to define the coordinate system of the wire. The only way - // we have of doing this (that I know of) is via the transformCoord() - // routine. - float origin[3] = {0.0, 0.0, 0.0}; - float sdir[3] = {1.0, 0.0, 0.0}; - float tdir[3] = {0.0, 1.0, 0.0}; - float udir[3] = {0.0, 0.0, 1.0}; - float origin_global[3], sdir_global[3], tdir_global[3], udir_global[3]; - transformCoord(origin,"local",origin_global,"global"); - transformCoord(sdir,"local",sdir_global,"global"); - transformCoord(tdir,"local",tdir_global,"global"); - transformCoord(udir,"local",udir_global,"global"); - DCoordinateSystem wire; - wire.origin.SetXYZ(origin_global[0], origin_global[1], origin_global[2]); - wire.sdir.SetXYZ(sdir_global[0], sdir_global[1], sdir_global[2]); - wire.tdir.SetXYZ(tdir_global[0], tdir_global[1], tdir_global[2]); - wire.udir.SetXYZ(udir_global[0], udir_global[1], udir_global[2]); - wire.sdir -= wire.origin; - wire.tdir -= wire.origin; - wire.udir -= wire.origin;wire.L=200.0; - - // Create a "short" reference trajectory that uses only local memory - // and will be swum just a couple of steps. - DReferenceTrajectory::swim_step_t steps[64]; - DReferenceTrajectory rt(Bmap , charge , steps , 64); - - DVector3 pos(x[0], x[1], x[2]); - DVector3 mom(p[0], p[1], p[2]); - mom *= p[4]; - rt.Swim(pos, mom, charge, 2.0); // swim for a maximum of 2cm - - // Get the DOCA - rt.DistToRT(&wire); - rt.GetLastDOCAPoint(pos, mom); - - pos -= wire.origin; - - doca[0] = pos.Dot(wire.sdir); - doca[1] = pos.Dot(wire.tdir); - doca[2] = pos.Dot(wire.udir); -} - - -#endif diff --git a/src/programs/Simulation/HDGeant/HDGeant_tutorial.txt b/src/programs/Simulation/HDGeant/HDGeant_tutorial.txt deleted file mode 100644 index d41738d73c..0000000000 --- a/src/programs/Simulation/HDGeant/HDGeant_tutorial.txt +++ /dev/null @@ -1,163 +0,0 @@ - -Getting started with HDGeant -D. Lawrence 11/11/04 - - -Here are some instructions for getting started with the Hall-D -Geant-3 based simulation HDGeant. These include: - -A. Getting and compiling the source code -B. Running the program -C. Analyzing the output file. - -=============================================================== - -A. Getting and compiling the source code ----------------------------------------- -The source code is currently being kept in a CVS repository -on the JLab CUE. You must have a CUE account and you must -belong to the "halld" unix group. (Contact the JLab computer -center for help with both of these.) - -I'm going to assume you are working on a machine outside of JLab. -(All of these instructions will work onsite as well.) - -First, you will need to create a directory where your files will -be kept. I use a directory called HallD in my home directory. -Set your HALLD_HOME environment variable to point to this directory. - -(In order to build the supporting tools which are required for -modifying the geometry) you'll need to have XERCES installed and -the xerces perl module. You can download these for free from the web. -After both of these packages are installed, make sure your -environment has the appropriate variables set. Here is a list of -the variables I have set for my CUE account: - -setenv HALLD_HOME /group/halld/Software/builds/latest -setenv JAVAROOT /apps -setenv HALLD_EXTERNALPACKAGES /group/halld/Software/ExternalPackages -setenv XERCESCROOT ${HALLD_EXTERNALPACKAGES}/xerces-c-src_2_5_0 -setenv XERCES_INCLUDE ${HALLD_EXTERNALPACKAGES}/include -setenv XERCES_LIB ${HALLD_EXTERNALPACKAGES}/lib/${OSNAME} -setenv PERL5LIB ${HALLD_EXTERNALPACKAGES}/perl_mods/lib/site_perl/5.8.2/i686-linux -setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:${XERCES_LIB} -setenv PATH ${HALLD_EXTERNALPACKAGES}/bin:${HALLD_EXTERNALPACKAGES}/bin/${OSNAME}:${PATH} - -NOTES: -- You MUST set your JAVAROOT environment variable or else the - schema-hddm script will fail with a very misleading error message. This - should point to the directory containing bin/java. For example, if - your java executable is /usr/bin/java (i.e. this is what "which java" - returns) then you should set JAVAROOT to /usr. - -- The HALLD_EXTERNALPACKAGES environment variable is not required. It is - just convienient for defining the other environment variables since things - like xerces must be install in a non-standard place on the CUE. - - -CHECKING OUT THE CODE -- - - - - - - - - - - -1. Make sure your CVS_RSH environment variable is set to point to ssh. - You can do this with something like "setenv CVS_RSH `which ssh`" - -2. Check out the needed files with: - - cvs -d davidl@cvs.jlab.org:/group/halld/Repositories/cvsroot co HDGeant hdds src include - - Where you should replace the "davidl" with your own JLab CUE account name - -3. For historical reasons, the include directory is placed on the a level - parallel with HDGeant and src. The Makefile will assume it is in - the src directory. The easiest thing to do is to create a symbolic link: - - cd src - ln -s ../include . - cd .. - -You should now have 4 directories "HDGeant", "hdds", "include" and -"src" in your HALLD_HOME directory. - - -COMPILING THE CODE -- - - - - - - - - - -Since we're only interested in HDGeant here and not HDFast, we just -need to build the hddsGeant3.F file from the XML source. - -1. cd into "hdds" and do a "make hddsGeant3.F". This will build - the hdds-geant executable and run it on the main_HDDS.xml to - produce hddsGeant3.F. The hddsGeant3.F file is FORTRAN source - which contains all of the geometry definitions for the entire - GlueX detector. The make file also copies it into ../HDGeant - where is will be compiled and used. - - It's worth noting here that this is where you would make changes - to the geomtery. The .xml files kept in the hdds directory can be - modified and the the hddsGeant3.F regenerated by re-running - "make hddsGeant3.F". - -2. A separate library exists in the HDGeant in the "gelhad" - subdirectory. The *new* Makefile doesn't handle this properly - just yet so you must explicitly build this before building - HDGeant. To do this, cd into "HDGeant/gelhad" and do a "make". - This should go fairly quickly. When it's done cd back up into - the HDGeant directory. - -3. Now, you should be in the HDGeant directory. just type "make". - Don't worry if it seems to take a long time to compile hddsGeant3.F. - This is a HUGE file so just be patient. When it is all done, - you should end up with 2 different executables gxint and hdgeant. - They will be placed in the the $HALLD_HOME/bin/$OSNAME directory. - (for example ~/HallD/bin/Linux). - - -RUNNING HDGEANT -- - - - - - - - -There are two versions of HDGeant. One is just called "hdgeant" and -is a batch-mode version. The other is "gxint" and is the interactive -version. The README file in the HDGeant directory gives some instructions -on running the interactive version. - -I'll just give a couple of hints here (note that even though I use -"hdgeant", these should be valid for the gxint executable as well): - -1. When running hdgeant, make sure the control.in and dsolenoid.table - files exist in the current working directory. - -2. To test hdgeant without an input file of generated events, - just comment out the "INFILE" and "BEAM" lines in control.in - placing a "C" as the first character in each line. - -3. The simulation produces several output files. The one with the - detector responses that you want is called hdgeant.hddm. - - - -Looking at the output -- - - - - - - - - - - -There are a few ways to look at the output data from hdgeant. The first -is to checkout and build the hddm package : -cvs -d davidl@cvs.jlab.org:/group/halld/Repositories/cvsroot co hddm -There is a tool called hddm-xml provided by this package that will -display the contents in XML form. - -The second option is to build "hd_dump" which is based on the DANA -framework. The source code for this program already exists in the -src directory: -1. cd into src/library and do a "make" -2. cd into src/programs/Analysis/hd_dump and do "make" -Running hd_dump with no arguments will print a usage message. - -The third (and probably most useful) option is to build a custom -executable that can be used to define and fill your own histograms. -To do this, take a look at the example program: - - src/programs/Analysis/hd_ana - -Try building and using it as-is first to make sure it all works. -It will produce a couple of sample histograms. The only files you'll -need to modify are the MyProcessor.cc and MyProcessor.h (All of the -work is done in MyProcessor.cc). - - - - diff --git a/src/programs/Simulation/HDGeant/Makefile b/src/programs/Simulation/HDGeant/Makefile deleted file mode 100644 index 9477bf299d..0000000000 --- a/src/programs/Simulation/HDGeant/Makefile +++ /dev/null @@ -1,32 +0,0 @@ -# Default makefile for HDGeant -# this just invokes make in the gelhad directory and -# then make with Makefile.bms in this directory. - -DIRS += gelhad hitutil - -.PHONY: all install depclean clean pristine relink env current_dir - -.PHONY: $(DIRS) - -all install depclean clean pristine relink env: $(DIRS) current_dir - - -ifndef CERN - @echo ===================================================== - @echo WARNING: CERN not defined! Skipping build of hdgeant! - @echo - @echo To build hdgeant, set the CERN and CERN_LEVEL - @echo environment variables and make sure the cernlib - @echo script is in your path. - @echo ===================================================== -else - - -$(DIRS): - $(MAKE) -C $@ $(MAKECMDGOALS) - -current_dir: - $(MAKE) -f Makefile.bms $(MAKECMDGOALS) - - -endif # CERN \ No newline at end of file diff --git a/src/programs/Simulation/HDGeant/Makefile.bms b/src/programs/Simulation/HDGeant/Makefile.bms deleted file mode 100644 index d69060292e..0000000000 --- a/src/programs/Simulation/HDGeant/Makefile.bms +++ /dev/null @@ -1,40 +0,0 @@ - -PACKAGES := CERNLIB:DANA:ROOT -#FFLAGS = -Wno-globals -CFLAGS += -I$(HALLD_MY)/src/libraries/HDDM -I$(HALLD_HOME)/src/libraries/HDDM -CXXFLAGS += -I$(HALLD_MY)/src/libraries/HDDM -I$(HALLD_HOME)/src/libraries/HDDM -#ADDITIONAL_MODULES += HDDM HDGEOMETRY hddsGeant3 -ADDITIONAL_MODULES += hddsGeant3 -LIB_DIRS += $(HDDS_HOME)/lib/$(BMS_OSNAME) -MISC_LIBS += -lgelhad$(DEBUG_SUFFIX) - -# A compatible motif is not so easily available on OSX -ifneq ($(shell uname), Darwin) - FFLAGS += -DCERNLIB_MOTIF -endif - -# The following line was used for the fine-grained DOCA calculations -# These were disabled 6/24/2009 -# ADDITIONAL_MODULES += TRACKING - -# Mac OS X 10.5 seems to have a picky linker that spits out -# tons of warnings about "can't find atom for N_GSYM stabs" -# for each of the cernlib routines. -# I can't find much on the web about it and don't recall -# anyone else using 10.5 complaining. No such warnings seem to -# exist for pure C++ code with no FORTRAN. The fix is -# therefore to supress all warnings for HDGeant, but only -# for this specific platform/OS since a global solution -# applied through BMS core files would supress warnings -# uneccessarily. -ifeq ($(BMS_OSNAME), Darwin_macosx10.5-i386-gcc4.0.1) - LD_FLAGS += -w -endif -ifeq ($(BMS_OSNAME), Darwin_macosx10.6-i386-gcc4.2.1) - LD_FLAGS += -w -endif - -include $(HALLD_HOME)/src/BMS/Makefile.bin - -MISC_LIBS += -L/sw/lib -lXm -L/usr/X11R6/lib -lXt -lhitutil$(DEBUG_SUFFIX) \ - -lxstream -lbz2 -lz diff --git a/src/programs/Simulation/HDGeant/README.txt b/src/programs/Simulation/HDGeant/README.txt deleted file mode 100644 index 74ef6620b2..0000000000 --- a/src/programs/Simulation/HDGeant/README.txt +++ /dev/null @@ -1,117 +0,0 @@ - - Build Notes for HDGeant - Richard Jones - July 10, 2001 - (updated October 30, 2003) - -This document is intended as a quick-start guide for building and using -the hdds tools. For more information and for discussion of features and -bugs, please go to http://portal.gluex.org and look for "forums". - -1) Since you are reading this, you have already done the first step. - From your cvs source directory you typed: - - halld> cvs checkout HDGeant - - To build the HDGeant executable you also need to check out the include - module. If you want to be able to browse and modify the detector geometry - (probably) then you should also check out the hdds module, and if you want - to play with the hits structures (maybe) then you should check out the - hddm module. The following lines do all three. - - halld> cvs checkout include - halld> cvs checkout hdds - halld> cvs checkout hddm - -2) Download the xerces-c xml library from xml.apache.org and unpack - it somewhere on your system or GlueX working area. Getting the sources - and doing the build yourself (next step) makes sure that you have a - working installation for your configuration. - -3) Build the xerces xml library for your system. - - This is pretty simple. The instructions are found on the xml.apache.org - web site. There are just three steps: define XERCESCROOT to point to the - base directory where you unpacked xerces-c, then runConfigure and gmake. - The result is a shared library in the directory xerces-c/lib. - -4) Somewhere, perferably at the top of your cvs source directory you - should make a script called setup that sets up some environment - variables that are needed to locate the CERN libraries on your system. - What that looks like depends on your shell, but for tcsh it looks like: - - halld> cat setup - setenv CVS_RSH ssh - setenv CVSROOT @login1.jlab.org:/halld/cvsroot - setenv CERN - setenv CERN_LEVEL - setenv CERN_ROOT ${CERN}/${CERN_LEVEL} - setenv HALLD_ROOT - setenv PATH ${HALLD_ROOT}/bin.Linux:${CERN_ROOT}/bin:${PATH} - setenv BUILDS ${HALLD_ROOT} - setenv HALLDLIB ${HALLD_ROOT}/lib.Linux - setenv QQ_DIR ${HALLD_ROOT}/libmcfast/qq_v9_2b_Linux+2.2 - setenv STDHEP_DIR ${HALLD_ROOT}/libmcfast/stdhep_v4_08_Linux+2.2 - setenv XERCESCROOT - setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:/${XERCESCROOT}/lib - - For the bash or ksh shells you should use the export command instead of - setenv. You will need to source this file before every session, (or - invoke it with the . operator for ksh or bash). - -5) Now go to HDGeant and build the interactive version. - - halld> cd ../HDGeant - halld> make hdgeant++ - - Now find the start of the long string of errors that was just produced by - make, and find out what you did wrong in steps 1..5. Iterate until the - package builds without errors. - -6) Start up interactive Geant and plot the detector. - - halld> ./hdgeant++ - ... lots of output - GEANT> exec ray#init -halld -10000 -10000 -10000 - GEANT> exec ray#draw - -Now you are on your way... Right now why don't you stop and send an email -to richard.t.jones@uconn.edu letting me know how things went. - -Richard Jones -Storrs, Connecticut - - -Special note for users of Redhat 9 ----------------------------------- - -During the link step you may get an error that the library gcc_s is not -found on your system. This seems to be a fault of g77 under gcc 3.2. -The following workaround was verified to work by Ed Brash. - -Building the non-interactive hdgeant requires a library called libgcc_s.a -(appears to be a g77 requirement). This library is no longer present in -gcc3.2. The fix is to make a softlink from libgcc.a to libgcc_s.a in the -/usr/lib/gcc-lib/i386-redhat-linux/3.2 directory. - - -Special note for users of Fedora --------------------------------- -The same note given above for Redhat 9 also applies to Fedora core X, -except that the path to the libgcc_s.a library changes slightly with -the release of gcc. For FC3, for example, the complete library path is -/usr/lib/gcc/i386-redhat-linux/3.4.2/libgcc_s.a . - - -Mailing lists -------------- - -Please post problem reports, suggestions and fixes to the appropriate -forum on the GlueX message board. The moderator of the list will respond -to any requests or forward them to the correct party. - -http://zeus.phys.uconn.edu/forums/gluex.org diff --git a/src/programs/Simulation/HDGeant/SConscript b/src/programs/Simulation/HDGeant/SConscript deleted file mode 100644 index 46a7d4f863..0000000000 --- a/src/programs/Simulation/HDGeant/SConscript +++ /dev/null @@ -1,38 +0,0 @@ - -import os -import sbms -import subprocess - -Import('*') - -# Verify CERN environment variable is set -if os.getenv('CERN', 'nada')=='nada': - if env.Dir('.').srcnode().abspath.startswith(env.GetLaunchDir()): - print '============================================================' - print 'CERN environment variable not set. Skipping build of HDGeant' - print '============================================================' - -else: - - # get env object and clone it - env = env.Clone() - - #bms_osname = os.environ['BMS_OSNAME'] - bms_osname = env['OSNAME'] - bms_split = bms_osname.split('gcc') - if len(bms_split) >= 2 : - versions = bms_split[1].split('.') - if int(versions[0]) >= 4 and int(versions[1]) >= 8 or int(versions[0]) >= 5: - env.PrependUnique(FORTRANFLAGS = ['-fno-aggressive-loop-optimizations']) - - SConscript(dirs=['gelhad', 'hitutil', 'utilities'], exports='env osname', duplicate=0) - - env.AppendUnique(LIBS = ['hddsGeant3', 'gelhad', 'hitutil']) - - sbms.AddCERNLIB(env) - sbms.AddDANA(env) - sbms.AddROOT(env) - - env.AppendUnique(CPPPATH = '#libraries/HDDM') - - sbms.executables(env) diff --git a/src/programs/Simulation/HDGeant/backgrounds.inc b/src/programs/Simulation/HDGeant/backgrounds.inc deleted file mode 100644 index f16bf1a19b..0000000000 --- a/src/programs/Simulation/HDGeant/backgrounds.inc +++ /dev/null @@ -1,23 +0,0 @@ -c -c These parameters describe the background particle flux that is -c superimposed on top of the standard generation. -c -c author: Richard Jones -c date: March 22, 2005 -c -c Notes: -c ------- -c bgrate: the rate (1/ns) of beam photons above the threshold BCUTE -c for discrete bremsstrahlung to generate during the ADC gate; -c default value of 0 represents a background-free simulation. -c bggate: time (ns) of the start (1) and end (2) of the gate during -c which random background is simulated, relative to the time -c of the photon that originated the event. -c bgtagonly: flag saying whether to tag and track all of the background -c beam photons generated within bggate (bgtagonly=0), or to -c only record their tags but not track them (bgtagonly=1). - - real bgrate - real bggate(2) - integer bgtagonly - common /backgrounds/bgrate,bggate,bgtagonly diff --git a/src/programs/Simulation/HDGeant/beamgen.F b/src/programs/Simulation/HDGeant/beamgen.F deleted file mode 100644 index fd585ec961..0000000000 --- a/src/programs/Simulation/HDGeant/beamgen.F +++ /dev/null @@ -1,277 +0,0 @@ - subroutine beamgen(t0) - real t0 ! beam bucket, ns -* -* Generates a single beam photon according to the coherent bremsstrahlung -* model in cobrems.F using beam energy and primary coherent edge energies -* specified by the user. The photon begins its lifetime just upstream of -* the primary collimator (WARNING: position hard-wired in the code below) -* and is tracked by the simulation from there forward, but its time t0 -* identifies its beam bucket, ie. the time the photon would reach the time- -* reference plane at the middle of the target. Beam bucket t0=0 is the -* one that generates the event and defines the time origin for all hit times. -* -* To enable beam motion spreading, define the beam box size below (cm) -* #define BEAM_BOX_SIZE 5 - -#include "geant321/gcunit.inc" -#include "geant321/gcflag.inc" -#include "geant321/gckine.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcscan.inc" -#include "geant321/gcomis.inc" -#include "geant321/gctrak.inc" -#include "controlparams.inc" -#include "backgrounds.inc" -#include "cobrems.inc" - - real vertex(4),plab(5),pbeam - real rhom,phim - real rhop,phip - real rhoc,phic - integer nvert,nt - real rndm(20) - -c freqMaximum = probability density cutoff for coherent/incoherent -c bremsstrahlung generator, defined on the measure [dx dphi dy] where -c x = E_gamma/E_end_point -c phi = azimuthal angle (radians) -c y = a normalized polar angle parameter defined by the relation -c dy = theta0^2 dtheta^2 / (theta0^2 + theta^2)^2 with 0<=y<=1. -c The probability is for a single electron, so the scale is that of -c the target thickness (radiation lengths) divided by 2pi. A good -c choice for freqMaximum is the target thickness in radiation lengths. -c A warning is printed in the simulation output log each time a value -c freq > freqMaximum is generated; a few ppm of these is no problem. - real xMinimum,freqMaximum,beamStartZ,Theta02 - common /coherentGen/xMinimum,freqMaximum,beamStartZ,Theta02 - data xMinimum/0.01/ - data freqMaximum/1.0e-4/ - data beamStartZ/-2400.0/ - data Theta02/1.8/ - save /coherentGen/ - - integer nProfileBins - parameter (nProfileBins=500) - real freqProfile(nProfileBins) - real freqIntegral(nProfileBins) - common /freqTables/freqProfile,freqIntegral - data freqProfile/nProfileBins*0/ - data freqIntegral/nProfileBins*0/ - save /freqTables/ - real Wincoh - data Wincoh/0.1/ - - integer nubuf - real ubuf(10) - - logical hexist - external hexist - common /genstate/ppol,rndm - save /genstate/ - - real x, theta2 - - call GRNDM(rndm,7) - phim = REAL(rndm(1)*TWOPI) - rhom = mospread*sqrt(-2*log(rndm(2))) - thxMosaic = rhom*cos(phim) - thyMosaic = rhom*sin(phim) - phib = REAL(rndm(3)*TWOPI) - rhob = sqrt(-2*log(rndm(4))) - thxBeam = (emitx/spot)*rhob*cos(phib) - thyBeam = (emity/spot)*rhob*sin(phib) - phis = REAL(rndm(5)*TWOPI) - varMS = sigma2MS(t*rndm(6)) - rhos = sqrt(-2*varMS*log(rndm(7))) - thxMS = rhos*cos(phis) - thyMS = rhos*sin(phis) - cos45 = REAL(1/sqrt(2d0)) - rotate(1,1) = 0 - rotate(1,2) = cos45 !point (1,0,0) along beam - rotate(1,3) = -cos45 !point (0,1,1) vertically - rotate(2,1) = 0 - rotate(2,2) = cos45 - rotate(2,3) = cos45 - rotate(3,1) = 1 - rotate(3,2) = 0 - rotate(3,3) = 0 - call rotmat(rotate,thxBeam+thxMS-thx-thxMosaic,0d0,0d0) - call rotmat(rotate,0d0,thyBeam+thyMS-thy-thyMosaic,0d0) - if (freqIntegral(nProfileBins).eq.0) then - x1 = 1 - x0 = xMinimum**(1./nProfileBins) - freqProfile(1) = dNcdxdp((x0+x1)/2,REAL(TWOPI/8)) - do ip=2,nProfileBins - x1 = x0 - x0 = xMinimum**(ip*1./nProfileBins) - freqProfile(ip) = dNcdxdp((x0+x1)/2,REAL(TWOPI/8)) - enddo - freqMaximum = 0 - do ip=1,nProfileBins-5 - if (freqProfile(ip).lt.freqProfile(ip+1)*0.8) then - freqProfile(ip) = freqProfile(ip+1)*0.8 - elseif (freqProfile(ip).lt.freqProfile(ip+2)*0.6) then - freqProfile(ip) = freqProfile(ip+2)*0.6 - elseif (freqProfile(ip).lt.freqProfile(ip+3)*0.4) then - freqProfile(ip) = freqProfile(ip+3)*0.4 - elseif (freqProfile(ip).lt.freqProfile(ip+4)*0.2) then - freqProfile(ip) = freqProfile(ip+4)*0.2 - endif - if (freqMaximum < freqProfile(ip)) then - freqMaximum = freqProfile(ip) - endif - enddo - x1 = 1 - x0 = xMinimum**(1./nProfileBins) - freqIntegral(1) = freqProfile(1)*(x1-x0) - do ip=2,nProfileBins - x1 = x0 - x0 = xMinimum**(ip*1./nProfileBins) - freqIntegral(ip) = freqIntegral(ip-1) - + +freqProfile(ip)*(x1-x0) - enddo - freqMaximum = REAL(4*TWOPI)*freqIntegral(nProfileBins) - endif - -c To get pure incoherent radiation, eg. using the amorphous radiator, -c set the x rotation angle to 0 by assigning Epeak = 0 in control.in - - do i=1,1000000000 - call GRNDM(rndm,5) - if (thx.ne.0.and.rndm(1).gt.1/(Wincoh+1)) then !try coherent generation - f = freqIntegral(nProfileBins)*rndm(2) - do ip=1,nProfileBins - if (f.le.freqIntegral(ip)) then - x1 = xMinimum**((ip-1.)/nProfileBins) - x0 = xMinimum**((ip*1.)/nProfileBins) - if (ip.gt.1) then - f1 = freqIntegral(ip-1) - else - f1 = 0 - endif - f0 = freqIntegral(ip) - fp = freqProfile(ip) - x = (x0*(f-f1)+x1*(f0-f))/(f0-f1) - go to 4 - endif - enddo - 4 continue - phi = REAL(rndm(3)*TWOPI) - freq = dNcdxdp(x,phi) - f = freq*rndm(4) - do iq=1,q2points - if (f.le.q2weight(iq)) then - theta2 = q2theta2(iq) - goto 5 - endif - enddo - 5 continue - freq = freq*freqIntegral(nProfileBins)/fp - freq = REAL(freq*TWOPI) - ppol = polarization(x,theta2,phi) - else !try incoherent generation - x = xMinimum**rndm(2) - phi = REAL(rndm(3)*TWOPI) - theta2 = Theta02*rndm(4)/(1-rndm(4)+1e-30) - freq = dNidxdt2(x,theta2) - freq = freq*(Theta02+theta2)**2/Theta02 - freq = freq*x*(-log(xMinimum)) - freq = freq*Wincoh - if (freq.gt.freqMaximum) then - Wincoh = Wincoh * 0.8 - cycle - endif - ppol = abrems_polarization(x,theta2,phi) - endif - if (freq.gt.freqMaximum) then - print *, 'Warning from beamgen: freq=',freq, - + ' is greater than freqMaximum=',freqMaximum - endif - if (freq.ge.freqMaximum*rndm(5)) then - goto 50 - endif - enddo - print *, 'Error in beamgen:', - + ' photon beam generator failed, giving up!' - stop - -50 continue - -#if DEBUG_CB_BEAM_GENERATOR - print *, 'success after',i,' attempts' - if (.not.hexist(20)) then - call hbnt(20,'coherent generator state',' ') - call hbnt(21,'incoherent generator state',' ') - call hbname(20,'genstate',ppol,'ppol:r') - call hbname(20,'genstate',rndm(1),'varndm(5):r') - call hbname(21,'genstate',ppol,'ppol:r') - call hbname(21,'genstate',rndm(1),'varndm(5):r') - endif - if (ppol.eq.0) then - call hfnt(21) - else - call hfnt(20) - endif -#endif - - call GRNDM(rndm,2) - phip = REAL(rndm(1)*TWOPI) - rhop = sqrt(-2*log(rndm(2))) - pbeam = E+Erms*rhop*cos(phip) - theta = sqrt(theta2)*(me/E) - thetaX = thxBeam+thxMS+theta*cos(phi) - thetaY = thyBeam+thyMS+theta*sin(phi) - plab(5) = pbeam*x - plab(1) = plab(5)*thetaX - plab(2) = plab(5)*thetaY - plab(3) = sqrt(plab(5)**2-plab(1)**2-plab(2)**2) - plab(4) = plab(5) - call GRNDM(rndm,2) - phic = REAL(rndm(1)*TWOPI) - rhoc = spot*sqrt(-2*log(rndm(2))) - vertex(1) = (rhoc*cos(phic)-D*thxBeam+D*thetaX)*100 - vertex(2) = (rhoc*sin(phic)-D*thyBeam+D*thetaY)*100 - vertex(3) = beamStartZ - ubuf(1) = ppol - nubuf = 1 -#if defined BEAM_BOX_SIZE - call GRNDM(rndm,2) - ubuf(2) = rndm(1)*BEAM_BOX_SIZE - ubuf(3) = rndm(2)*BEAM_BOX_SIZE - vertex(1) = vertex(1) + ubuf(2) - vertex(2) = vertex(2) + ubuf(3) - nubuf = 3 -#endif - call settofg(vertex,t0) - if (bgtagonly.eq.0 .or. t0.eq.0) then - call GSVERT(vertex,0,0,ubuf,nubuf,nvert) - call GSKINE(plab,1,nvert,0,0,nt) ! push the beam photon on the stack - endif - vertex(4) = TOFG - if (genbeam_mode(1).eq.0) then - call hitTagger(vertex,vertex,plab,plab,0.,1,0,0) - endif - end - - function abrems_polarization(x, theta2, phi) - real abrems_polarization - real x ! photon energy in units of endpoint energy E0 - real theta2 ! photon polar angle**2 in units of (mElectron/E0)**2 - real phi ! photon azimuthal angle in radians - real pol - real Acoeff(3,4) - data Acoeff/0.93000, 0.73000, 0.87610, - + 0.64250, 1.05648, 0.57510, - + 0.66598, 0.84643, 0.74918, - + 1.62506, 1.97061, 1.52849/ - real a(3) - do n=1,3 - a(n) = Acoeff(n,1)**2 + - + Acoeff(n,2)**2 * x**2 + - + Acoeff(n,3)**2 * x**4 + - + Acoeff(n,4)**2 * x**16 - a(n) = a(n)**2 - enddo - pol = theta2 / (a(1) + a(2) * theta2 + a(3) * theta2**2) - abrems_polarization = pol * cos(2*phi) - end diff --git a/src/programs/Simulation/HDGeant/bintree.c b/src/programs/Simulation/HDGeant/bintree.c deleted file mode 100644 index f783ab893f..0000000000 --- a/src/programs/Simulation/HDGeant/bintree.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * bintree.c - library for managing binary tree of hits pointers - * - * version 1.0 -Richard Jones July 16, 2001 - */ - -#include -#include -#include - -void** getTwig(binTree_t** tree, int mark) -{ - binTree_t* node = *tree; - if (node == 0) - { - node = *tree = malloc(sizeof(binTree_t)); - node->mark = mark; - node->left = 0; - node->right = 0; - node->this_node = 0; - return &node->this_node; - } - else if (mark == node->mark) - { - return &node->this_node; - } - else if (mark < node->mark) - { - return getTwig(&node->left, mark); - } - else - { - assert (node->mark >= 0); - return getTwig(&node->right, mark); - } -} - -void* pickTwig(binTree_t** tree) -{ - binTree_t* node = *tree; - if (node == 0) - { - return 0; - } - else if (node->left) - { - return pickTwig(&node->left); - } - else - { - void* twig = node->this_node; - *tree = node->right; - free(node); - return twig; - } -} diff --git a/src/programs/Simulation/HDGeant/bintree.h b/src/programs/Simulation/HDGeant/bintree.h deleted file mode 100644 index da8b87c8e4..0000000000 --- a/src/programs/Simulation/HDGeant/bintree.h +++ /dev/null @@ -1,9 +0,0 @@ -typedef struct hitTree_s { - int mark; - struct hitTree_s* left; - struct hitTree_s* right; - void* this_node; -} binTree_t; - -void** getTwig(binTree_t** tree, int mark); -void* pickTwig(binTree_t** tree); diff --git a/src/programs/Simulation/HDGeant/calibDB.cc b/src/programs/Simulation/HDGeant/calibDB.cc deleted file mode 100644 index 8b5cb773a1..0000000000 --- a/src/programs/Simulation/HDGeant/calibDB.cc +++ /dev/null @@ -1,459 +0,0 @@ - -#include -#include -#include - -#include -#include -#include -using namespace std; - -#include -#include -#include -#include -#include -#include -#include "HDGEOMETRY/DMagneticFieldMapSpoiled.h" -#include "HDGEOMETRY/DMagneticFieldMapParameterized.h" -#include "HDGEOMETRY/DMagneticFieldMapNoField.h" -#include "HDGEOMETRY/DMagneticFieldMapPSConst.h" -#include "HDGEOMETRY/DMagneticFieldMapPS2DMap.h" - -extern "C" { -#include "calibDB.h" -}; -#include "controlparams.h" - - -extern "C" int hddsgeant3_runtime_(void); // called from uginit.F. defined in calibDB.cc -extern "C" void md5geom_(char *md5); -void init_runtime_xml(void); -void md5geom_runtime(char *md5); -extern "C" const char* GetMD5Geom(void); - -extern "C" { - int getcalib_(const char* namepath, unsigned int *Nvals, float* vals) { - int retval; - char name[999]; - int n; - for (n=0; n < 999 && namepath[n] != ' '; ++n) - name[n] = namepath[n]; - name[n] = 0; - retval = GetCalib(name, Nvals, vals); - return retval; - } -}; - -bool nofield=false; -DMagneticFieldMap *Bmap=NULL; -DMagneticFieldMapPS *PS_Bmap=NULL; -static JCalibration *jcalib=NULL; -//static void *dlgeom_handle=NULL; -//string HDDS_XML = "$HDDS_HOME/main_HDDS.xml"; - -extern "C" { - void md5geom_wrapper_(char *md5); -} - - -//---------------- -// initcalibdb_ -//---------------- -void initcalibdb_(char *bfield_type, char *bfield_map, char *PS_bfield_type, char *PS_bfield_map, int *runno) -{ - ios::sync_with_stdio(true); - - if(!japp){ - _DBG_<<" JApplication missing, exiting !!"<GetJCalibration(*runno); - - // The actual DMagneticFieldMap subclass can be specified in - // the control.in file. Since it is read in as integers of - // "MIXED" format through ffkey though (who knows what that - // means!) then there can be trailing white space at the end - // of the string. Here, we terminate the string with a null - // to eliminate that white space. - while(strlen(bfield_type)>0 && bfield_type[strlen(bfield_type)-1]==' ')bfield_type[strlen(bfield_type)-1] = 0; - while(strlen(bfield_map)>0 && bfield_map[strlen(bfield_map)-1]==' ')bfield_map[strlen(bfield_map)-1] = 0; - while(strlen(PS_bfield_type)>0 && PS_bfield_type[strlen(PS_bfield_type)-1]==' ')PS_bfield_type[strlen(PS_bfield_type)-1] = 0; - while(strlen(PS_bfield_map)>0 && PS_bfield_map[strlen(PS_bfield_map)-1]==' ')PS_bfield_map[strlen(PS_bfield_map)-1] = 0; - - // Read in the field map from the appropriate source - if(bfield_type[0] == 0)strcpy(bfield_type, "CalibDB"); - string bfield_type_str(bfield_type); - - const char *ccdb_help = - " \n" - " Could not load the solenoid field map from the CCDB!\n" - " Please specify the solenoid field map to use on the command line, e.g.:\n" - " \n" - " -PBFIELD_MAP=Magnets/Solenoid/solenoid_1200A_poisson_20140520\n" - " or\n" - " -PBFIELD_TYPE=NoField\n"; - - if(bfield_type_str=="CalibDB"){ - // if the magnetic field is specified in control.in, then use that value instead of the CCDB values - if(strlen(bfield_map)) - Bmap = new DMagneticFieldMapFineMesh(japp,*runno,bfield_map); - else { - - // see if we can load the name of the magnetic field map to use from the calib DB - map bfield_map_name; - if(jcalib->GetCalib("/Magnets/Solenoid/solenoid_map", bfield_map_name)) { - // if we can't find information in the CCDB, then quit with an error message - _DBG_< PS_bfield_map_name; - if(jcalib->GetCalib("/Magnets/PairSpectrometer/ps_magnet_map", PS_bfield_map_name)) { - // if we can't find information in the CCDB, then quit with an error message - _DBG_<GetField(x, y, z, Bx, By, Bz); - - B[0] = Bx; - B[1] = By; - B[2] = Bz; -} - -//---------------- -// gufld_db_ -//---------------- -void gufld_db_(float *r, float *B) -{ - /// Wrapper function to allow the FORTRAN gufld routine to - /// use the C++ class DMagneticFieldMap to access the - /// B-field. - if (nofield){ - B[0]=0.; - B[1]=0.; - B[2]=0.; - - return; - } - - - if(!Bmap){ - _DBG_<<"Call to gufld_db when Bmap not intialized! Exiting."<GetField(x, y, z, Bx, By, Bz); - - B[0] = Bx; - B[1] = By; - B[2] = Bz; -} - -//---------------- -// GetCalib -//---------------- -int GetCalib(const char* namepath, unsigned int *Nvals, float* vals) -{ - /// C-callable routine for accessing calibration constants. - /// The values specified by "namepath" will be read into the array - /// "vals". The "vals" array should have enough memory allocated - /// to hold *Nvals elements. If not, only the first *Nvals elements - /// will be copied and a non-zero value returned. If the number - /// of values in the database are less than *Nvals, then all values - /// are copied, *Nvals is updated to reflect the number of valid - /// elements in "vals", and a value of 0 is returned. - - if(!jcalib){ - _DBG_<<"ERROR - GetCalib() called when jcalib not set!"< vvals; - jcalib->Get(namepath, vvals); - if(vvals.size()<*Nvals)*Nvals = vvals.size(); - for(unsigned int i=0; i<*Nvals; i++)vals[i] = vvals[i]; - - return vvals.size()>*Nvals; // return 0 if OK, 1 if not -} - -//---------------- -// GetLorentzDeflections -//---------------- -void GetLorentzDeflections(float *lorentz_x, float *lorentz_z, float **lorentz_nx, float **lorentz_nz - , const unsigned int Nxpoints, const unsigned int Nzpoints) -{ - /// C-callable routine for accessing calibration constants. - /// The values specified by "namepath" will be read into the array - /// "vals". The "vals" array should have enough memory allocated - /// to hold *Nvals elements. If not, only the first *Nvals elements - /// will be copied and a non-zero value returned. If the number - /// of values in the database are less than *Nvals, then all values - /// are copied, *Nvals is updated to reflect the number of valid - /// elements in "vals", and a value of 0 is returned. - - // Make sure jcalib is set - if(!jcalib){ - _DBG_<<"ERROR - GetLorentzDeflections() called when jcalib not set!"< > tvals; - jcalib->Get("FDC/lorentz_deflections", tvals); - if(tvals.size() != Nxpoints*Nzpoints){ - _DBG_<<"ERROR - GetLorentzDeflections() number of elements in calib DB"<::iterator iter; - for(iter=tvals[0].begin(); iter!=tvals[0].end(); iter++)cout<first<<" "; - cout< &row = tvals[i]; - unsigned int xindex = i/Nzpoints; - unsigned int zindex = i%Nzpoints; - lorentz_x[xindex] = row["x"]; - lorentz_z[zindex] = row["z"]; - lorentz_nx[xindex][zindex] = row["nx"]; - lorentz_nz[xindex][zindex] = row["nz"]; - } -} -//---------------- -// GetConstants -//---------------- -int GetConstants(const char* namepath, int *Nvals, float* vals, mystr_t *strings) -{ - /// C-callable routine for accessing calibration constants. - /// The values specified by "namepath" will be read into the array - /// "vals". The "vals" array should have enough memory allocated - /// to hold *Nvals elements. If not, only the first *Nvals elements - /// will be copied and a non-zero value returned. If the number - /// of values in the database are less than *Nvals, then all values - /// are copied, *Nvals is updated to reflect the number of valid - /// elements in "vals", and a value of 0 is returned. - /// Similar the variable names are stored in the array strings. - - if(!jcalib){ - _DBG_<<"ERROR - GetConstants() called when jcalib not set!"< detparms; - jcalib->Get(namepath, detparms); - - if((int)detparms.size()<*Nvals) - *Nvals = (int)detparms.size(); - int i=0; - for( map::iterator ii=detparms.begin(); ii!=detparms.end(); ++ii){ - if (i<*Nvals){ - strcpy (strings[i].str, (*ii).first.c_str()); - vals[i++] = (*ii).second; - } - } - return (int)detparms.size()>*Nvals; // return 0 if OK, 1 if not -} - - -//---------------- -// GetColumn -//---------------- -// Get a single column from the database by its key (string) -int GetColumn(const char* namepath, int *Nvals, float* vals, char *key_cstr){ - - if(!jcalib){ - _DBG_<<"ERROR - GetColumn() called when jcalib not set!"< >detparms; - jcalib->Get(namepath, detparms); - - if (*Nvals!=int(detparms.size())){ - _DBG_ << "ERROR - Array size mismatch: " << *Nvals << " != " - << detparms.size() - << " (ccdb)" << endl; - _DBG_ << " for " << namepath < &row = detparms[i]; - vals[i]=row[key]; - } - - return 0; -} - - - - -//---------------- -// GetArrayConstants -//---------------- -int GetArrayConstants(const char* namepath, int *Nvals, float* vals, mystr_t *strings) -{ - /// C-callable routine for accessing calibration constants. - /// The values specified by "namepath" will be read into the array - /// "vals". The "vals" array should have enough memory allocated - /// to hold *Nvals elements. If not, only the first *Nvals elements - /// will be copied and a non-zero value returned. If the number - /// of values in the database are less than *Nvals, then all values - /// are copied, *Nvals is updated to reflect the number of valid - /// elements in "vals", and a value of 0 is returned. - /// Similar the variable names are stored in the array strings. - - if(!jcalib){ - _DBG_<<"ERROR - GetArrayConstants() called when jcalib not set!"< >detparms; - jcalib->Get(namepath, detparms); - - unsigned int i=0; - int j=0; - for (i=0;i::iterator ii=detparms[i].begin(); ii!=detparms[i].end(); ++ii){ - if (j<*Nvals){ - strcpy (strings[j].str, (*ii).first.c_str()); - vals[j] = (*ii).second; - j++; - } - else return 1; - } - } - *Nvals=j; - - return 0; // return 0 if OK, 1 if not -} - -//------------------ -// GetMD5Geom -//------------------ -const char* GetMD5Geom(void) -{ - // Get the MD5 checksum of the geometry that will be - // used for the simulation. This will retrieve the - // geometry checksum from either what has been statically - // linked in, or dynamically, whichever is being used. - - // This is a little odd since the string originates - // in a FORTRAN routine. - static char md5[256]; - memset(md5, 0, 256); - md5geom_wrapper_(md5); - - md5[32] = 0; // truncate string at 32 characters (FORTRAN adds a space) - - return md5; -} diff --git a/src/programs/Simulation/HDGeant/calibDB.h b/src/programs/Simulation/HDGeant/calibDB.h deleted file mode 100644 index 87d1dcc71f..0000000000 --- a/src/programs/Simulation/HDGeant/calibDB.h +++ /dev/null @@ -1,26 +0,0 @@ - - -// This file contains C-callable routine signatures for the routines -// in calibDB.cc. It is specifically intended to give access to the -// calibration DB to C and FORTRAN routines. This is needed since the -// calibration DB API is in C++. -// -// This file should contain no C++ code. - -typedef struct { - char str[128]; -}mystr_t; - - -void initcalibdb_(char *bfield_type, char *bfield_map, - char *PS_bfield_type, char *PS_bfield_map,int *runno); -void gufld_db_(float *r, float *B); -void gufld_ps_(float *r, float *B); -int GetCalib(const char* namepath, unsigned int *Nvals, float* vals); -void GetLorentzDeflections(float *lorentz_x, float *lorentz_z, - float **lorentz_nx, float **lorentz_nz, - const unsigned int Nxpoints, - const unsigned int Nzpoints); -int GetConstants(const char* namepath, int *Nvals, float* vals, mystr_t* strings); -int GetArrayConstants(const char* namepath, int *Nvals, float* vals, mystr_t* strings); -int GetColumn(const char* namepath, int *Nvals, float* vals, char *key_cstr); diff --git a/src/programs/Simulation/HDGeant/cobrems.F b/src/programs/Simulation/HDGeant/cobrems.F deleted file mode 100644 index 752c74f371..0000000000 --- a/src/programs/Simulation/HDGeant/cobrems.F +++ /dev/null @@ -1,688 +0,0 @@ -C This program calculates the spectrum of bremsstrahlung radiation from a -C crystal radiator. The formalism is that described in the following paper. -C W. Kaune, G. Miller, W. Oliver, R.W. Williams, and K.K. Young, -C -C "Inclusive cross sections for pion and proton production by photons -C using collimated coherent bremsstrahlung", Phys Rev D, vol 11, -C no 3 (1975) pp. 478-494. -C -C Author: Richard Jones 8-July-1997 -C -#define vector real - - Subroutine cobrems(Emax,Epeak,emitmr,radt,dist,coldiam,polar) - real Emax,Epeak,emitmr,radt,dist,coldiam - integer polar - include 'cobrems.inc' - integer i - real c - dpi=acos(-1d0) - me=5.1099891e-4 !electron mass (GeV) - alpha=7.2973525698e-3 !fine structure constant - hbarc=1.973269718e-16 !Planck's constant * speed of light (GeV m) - Z=6 !atomic number of diamond -c Z=14 !atomic number of silicon - a=3.5668e-10 !dimension of diamond unit cell (m) -c a=5.43e-10 !dimension of silicon unit cell (m) - Aphonon=0.40e9 !phonon-free recoil constant (GeV**-2) - betaFF=111*Z**(-1/3.)/me !cutoff for atomic form-factor (/GeV) - mospread=20e-6 !crystal r.m.s. mosaic spread - E=Emax !electron beam energy (GeV) - Erms=6.0e-4 !electron beam energy rms spread (GeV) - emit=emitmr !electron beam emittance (m r) - spot=0.0005 !electron beam spot size at collimator (m) - D=dist !distance from radiator to collimator (m) - t=radt !thickness of radiator (m) - collim=coldiam !collimator diameter (m) - -c spot = spot * 1e-6 -c emit = emit * 1e-6 -c t = t * 1e-6 -c mospread = mospread * 1e-6 - - thx=-0.0300/E !rotation of crystal about x (first) - thy=0.050 !rotation of crystal about y (second) -C-- require Epeak < Emax - if (Epeak.ge.Emax) then - return - endif -C-- decide if you want total or polarized flux - unpolar=(polar.eq.0) -C-- approximate calculation of angle from primary edge energy - edge=Epeak !desired position of primary edge - qtotal=9.8e-6 !Qtot for dominant lattice vector - qlong=edge/(E-edge)*me**2/(2*E) - thx=-qlong/qtotal -c thx=48e-6 !special values for NA59 setup -c thy=35e-6 !special values for NA59 setup -C-- PDG formula for radiation length, converted to meters - c=alpha*Z - radlen=4*nsites*alpha**3*(hbarc/(a*me))**2/a - + *( (Z**2)*(log(184.15*Z**(-1/3.)) - + -(c**2)*(1/(1+c**2) + 0.20206 - 0.0369*(c**2) - + + 0.0083*(c**4) - 0.002*(c**6))) - + + Z*log(1194*Z**(-2/3))) -C-- Schiff formula for radiation length, converted to meters -c zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) -c radlen=4*nsites*alpha**3*(hbarc/(a*me))**2/a -c + *Z*(Z+zeta)*log(183*Z**(-1/3.)) -C-- use either one formula or the other from above - radlen=1/radlen - write(6,*) - write(6,1000) - 1000 format('Initialization for coherent bremsstralung calculation') - write(6,1010) E - 1010 format(' electron beam energy:',f12.3,'GeV') - write(6,1012) emit*1e9 - 1012 format(' electron beam emittance:',f12.3,'mm.urad') - write(6,1020) 'diamond',t*1e6 - 1020 format(' radiator crystal: ',a10,', thickness',f8.0,'um') - write(6,1030) radlen*1e2,mospread*1e6 - 1030 format(' radiation length:',f8.1,'cm, mosaic spread:',f8.1,'urad') - write(6,1040) collim/(2*D)*(E/me) - 1040 format(' photon beam collimator half-angle:',f12.3,'(m/E)') - write(6,1045) colDiam*1e2 - 1045 format(' Collimator diameter:',f8.3,'cm') - write(6,1050) thx*1e3,thy*1e3 - 1050 format(' crystal orientation: theta-x',f10.3,'mrad', - + /' theta-y',f10.3,'mrad') - -C define the unit cell of the radiator crystal - ucell(1,1)=0 - ucell(2,1)=0 - ucell(3,1)=0 - do i=1,3 - ucell(1,1+i)=ucell(1,1)+0.5 - ucell(2,1+i)=ucell(2,1)+0.5 - ucell(3,1+i)=ucell(3,1)+0.5 - ucell(i,1+i)=ucell(i,1+i)-0.5 - enddo - ucell(1,5)=0.25 - ucell(2,5)=0.25 - ucell(3,5)=0.25 - do i=1,3 - ucell(1,5+i)=ucell(1,5)+0.5 - ucell(2,5+i)=ucell(2,5)+0.5 - ucell(3,5+i)=ucell(3,5)+0.5 - ucell(i,5+i)=ucell(i,5+i)-0.5 - enddo -C define the crystal->lab rotation matrix - rotate(1,1)=1 - rotate(1,2)=0 - rotate(1,3)=0 - rotate(2,1)=0 - rotate(2,2)=1 - rotate(2,3)=0 - rotate(3,1)=0 - rotate(3,2)=0 - rotate(3,3)=1 - call rotmat(rotate,0d0,dpi/2,0d0) !point (1,0,0) along beam - call rotmat(rotate,0d0,0d0,dpi/4) !point (0,1,1) vertically - call rotmat(rotate,-thx,0d0,0d0) !the goniometer-x rotation - call rotmat(rotate,0d0,-thy,0d0) !the goniometer-y rotation - write(6,2000) (rotate(1,j),j=1,3) - write(6,2000) (rotate(2,j),j=1,3) - write(6,2000) (rotate(3,j),j=1,3) -2000 format(3f12.6) - end - - real function cohrat(x) - real x - include 'cobrems.inc' - real yc,yi - yc=dNcdx(x) - yi=dNidx(x) - cohrat=(yc+yi)/(yi+1e-30) - end - - real function dNtdx(x) - real x - include 'cobrems.inc' - dNtdx=dNcdx(x)+dNidx(x) - end - - real function dNtdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - dNtdx3=dNcdx(x)+dNidx(x) - end - - real function dNtdk(k) - real k - include 'cobrems.inc' - dNtdk=dNtdx(k/E)/E - end - - real function dNcdx(x) - real x - include 'cobrems.inc' - integer npoints,n - real phi,S - S=0 - npoints=2 - do n=1,npoints - phi=REAL((n-0.5)*dpi/(2*npoints)) - S=S+REAL(dNcdxdp(x,phi)) - enddo - dNcdx=REAL(2*dpi*S/npoints) - end - - real function dNcdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - integer npoints,n - real phi,S - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - S=0 - npoints=2 - do n=1,npoints - phi=REAL((n-0.5)*dpi/(2*npoints)) - S=S+REAL(dNcdxdp(x,phi)) - enddo - dNcdx3=REAL(2*dpi*S/npoints) - end - - real function dNcdxdp(x,phi) - real x,phi - include 'cobrems.inc' - integer h,k,l - double precision ReS,ImS,S2 - double precision q2,qT2,q(3),qdota - real xmax,theta2,FF,sum - integer hmin,kmin,lmin - real q3min - integer i - real sigma0 - sigma0=REAL(16*dpi*t*Z**2*alpha**3*E*(hbarc/a**2)*(hbarc/a/me)**4) - q2points=0 - q3min=1 - sum=0 - do h=-4,4 ! can replace with 0,0 for cpu speed-up if crystal alignment is "reasonable" - do k=-10,10 - do l=-10,10 -c do k=-2,-2 -c do l=-2,-2 - if (h/2*2.eq.h) then - if (k/2*2.ne.k) then - goto 10 - elseif (l/2*2.ne.l) then - goto 10 - elseif ((h+k+l)/4*4.ne.h+k+l) then - goto 10 - endif - elseif (k/2*2.eq.k) then - goto 10 - elseif (l/2*2.eq.l) then - goto 10 - endif - ReS=0 - ImS=0 - do i=1,nsites - qdota=2*dpi*(h*ucell(1,i) + k*ucell(2,i) + l*ucell(3,i)) - ReS=ReS+cos(qdota) - ImS=ImS+sin(qdota) - enddo - S2=ReS**2+ImS**2 - if (S2.lt.1e-4) then - goto 10 - endif - qnorm=REAL(2*dpi*hbarc/a) - q(1)=qnorm*(rotate(1,1)*h + rotate(1,2)*k + rotate(1,3)*l) - q(2)=qnorm*(rotate(2,1)*h + rotate(2,2)*k + rotate(2,3)*l) - q(3)=qnorm*(rotate(3,1)*h + rotate(3,2)*k + rotate(3,3)*l) - q2=q(1)**2+q(2)**2+q(3)**2 - qT2=q(1)**2+q(2)**2 - xmax=REAL(2*E*q(3)) - xmax=xmax/(xmax+me**2) - if ((x.gt.xmax).or.(xmax.gt.1)) then - goto 10 - else -c write(6,*) h,k,l,S2 -c write(6,*) q2,xmax - endif - if (q(3).lt.q3min) then - q3min=REAL(q(3)) - hmin=h - kmin=k - lmin=l - endif - theta2=(1-x)*xmax/(x*(1-xmax)) - 1 - FF=REAL(1/(1+q2*betaFF**2)) - sum=REAL(sum+sigma0*qT2*S2*exp(-Aphonon*q2) - + * (FF*betaFF**2)**2 - + * ((1-x)/(x*(1+theta2))**2) - + * ((1+(1-x)**2) - + - 8*(theta2/(1+theta2)**2)*(1-x)*cos(phi)**2) - + * acceptance(theta2) - + * polarization(x,theta2,phi)) -C comment out the preceding line to disable polarization -RTJ - q2points=q2points+1 - q2theta2(q2points)=theta2 - q2weight(q2points)=sum -10 continue - enddo - enddo - enddo - dNcdxdp=sum -c if (q3min.lt.1) write(6,*) hmin,kmin,lmin,' best plane at',x - end - - real function dNidx(x) - real x - include 'cobrems.inc' - integer iter,niter - real theta2 !numerical integration over d(theta**2) over [0,inf] - real u,du !is transformed by u=1/(1+theta**2) to d(u) over [0,1] - niter=50 - dNidx=0 - if (x.gt.1) then - return - endif - du=1./niter - do iter=1,niter - u=(iter-0.5)/niter - theta2=(1-u)/u - dNidx=dNidx+dNidxdt2(x,theta2)*du/u**2 - enddo -c write(6,*) dNidx - end - -C In the following paper, a closed form is given for the integral that -C is being performed analytically by dNidx. I include this second form -C here in case some time it might be useful as a cross check. -C -C "Coherent bremsstrahlung in crystals as a tool for producing high -C energy photon beams to be used in photoproduction experiments at -C CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. -C -C Note: in this paper they have swapped subscripts for coherent and -C incoherent intensities. This is not very helpful to the reader! -C -C The result is some 15% lower radiation rate than the result of dNidx. -C I take the latter to be more detailed (because it gives a more -C realistic behaviour at the endpoint and agrees better with the PDG -C radiation length for carbon). Most of this deficiency is remedied -C by simply replacing Z**2 in the cross section with Z*(Z+zeta) as -C recommended by Kaune et.al., and followed by the PDG in their fit -C to radiation lengths. -C -C WARNING -C dNidx and dNBidx give the incoherent radiation rate for crystalline -C radiators. If you take the incoherent radiation formulae here and -C integrate them you will NOT obtain the radiation length for amorphous -C radiators; it will be overestimated by some 15%. The reason is that -C the part of the integral in q-space that is covered by the discrete -C sum has been subtracted to avoid double-counting with the coherent -C part. If you were to spin the crystal fast enough, the coherent -C spectrum would average out to yield the remaining 15% with a spectral -C shape resembling the Bethe-Heitler result. - - real function dNBidx(x) - real x - include 'cobrems.inc' - real psiC1,psiC2 - real AoverB2,Tfact - real zeta - AoverB2=Aphonon/betaFF**2 - Tfact=-(1+AoverB2)*exp(AoverB2)*EXPINT(AoverB2) - psiC1=2*(2*log(betaFF*me)+Tfact+2) - psiC2=psiC1-2/3. - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - dNBidx=nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + * (psiC1*(1+(1-x)**2) - psiC2*(1-x)*2/3.) - end - - real function dNidxdt2(x,theta2) - real x,theta2 - include 'cobrems.inc' - real MSchiff,delta,zeta - delta=1.02 - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - MSchiff=1/(((me*x)/(2*E*(1-x)))**2 + 1/(betaFF*me*(1+theta2))**2) - dNidxdt2=2*nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + *( ((1+(1-x)**2)-4*theta2*(1-x)/(1+theta2)**2)/(1+theta2)**2 - + *(log(MSchiff) - 2*delta*Z/(Z+zeta)) - + + 16*theta2*(1-x)/(1+theta2)**4 - (2-x)**2/(1+theta2)**2 ) - + * acceptance(theta2) -c write(6,*) dNidxdt2 - end - - real function rpara(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rpara=0.5*((1+1-x)**2)*(1+theta2)**2 - + -8*theta2*(1-x)*cos(phi)**2 - + -8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function rortho(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rortho=0.5*x**2*(1+theta2)**2 - + +8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function polarization(x,theta2,phi) - real x,theta2,phi - real Npara,Nperp -c real paverage - include 'cobrems.inc' - if (unpolar) then - polarization=1 - return - endif - -c This formula was taken from Eq. A5 of Kaune, Miller, et.al. -c PhysRevD.11.479, but it has been averaged over phi already. -c 8/30/2017 - replacing this with the full phi-dependent -c expression below, based on Eq. A4. -c paverage=2*(1-x)/((1+theta2)**2*((1-x)**2+1) - 4*theta2*(1-x)) - - Npara = 0.5*(2-x)**2*(1+theta2)**2 - 8*theta2*(1-x)*cos(phi)**2 - - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 - Nperp = 0.5*x**2*(1+theta2)**2 + - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 -c write(6,*) 'Npara,Nperp,pol,asym=',Npara,Nperp,paverage, -c + real(Npara - Nperp) / real(Npara + Nperp) - polarization = (Npara - Nperp) / (Npara + Nperp) - end - - real function acceptance2(theta2,phi,xshift,yshift) - real theta2,phi,xshift,yshift - include 'cobrems.inc' - real xc,yc - real theta - theta=sqrt(theta2)*me/E - xc=D*tan(theta)*cos(phi)+xshift - yc=D*tan(theta)*sin(phi)+yshift - acceptance2 = acceptance((atan2(sqrt(xc**2+yc**2),D)*(E/me))**2) - end - - real function acceptance(theta2) - real theta2 - include 'cobrems.inc' - vector sig(4) - real u,var0,varMS,thetaC - real pu,du2,u0,u1,u2 - integer iter,niter - real theta -Comment out the following lines to enable collimation -RTJ - acceptance=1 - return -Comment out the preceding lines to enable collimation -RTJ - acceptance=0 - niter=50 - theta=sqrt(theta2) - thetaC=collim/(2*D)*(E/me) - var0=(spot/D*(E/me))**2 - varMS=sigma2MS(t)*(E/me)**2 - sig(1)=sqrt(var0) - sig(2)=sqrt(varMS) - if (theta.lt.thetaC) then - u1=thetaC-theta - if (u1**2/(var0+varMS).gt.20) then - acceptance=1 - return - endif - do iter=1,niter - u=u1*(iter-0.5)/niter - u2=u**2 - du2=2*u*u1/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=acceptance + pu*du2 - enddo - endif - u0=abs(theta-thetaC) - u1=abs(theta+thetaC) - do iter=1,niter - u=u0+(u1-u0)*(iter-0.5)/niter - u2=u**2 - du2=2*u*(u1-u0)/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=REAL(acceptance + pu*du2/dpi - + * atan2(sqrt((theta2-(thetaC-u)**2)*((thetaC+u)**2-theta2)), - + theta2-thetaC**2+u2)) - enddo - end - - subroutine rotmat(matrix,thx,thy,thz) - double precision matrix(3,3),thx,thy,thz -C Matrix(out) = Rx(thx) Ry(thy) Rz(thz) Matrix(in) -C with rotations understood in the passive sense - double precision x,y,z - double precision sint,cost - integer i - if (thz.ne.0) then - sint=sin(thz) - cost=cos(thz) - do i=1,3 - x=matrix(1,i) - y=matrix(2,i) - matrix(1,i)=cost*x+sint*y - matrix(2,i)=-sint*x+cost*y - enddo - endif - if (thy.ne.0) then - sint=-sin(thy) - cost=cos(thy) - do i=1,3 - x=matrix(1,i) - z=matrix(3,i) - matrix(1,i)=cost*x+sint*z - matrix(3,i)=-sint*x+cost*z - enddo - endif - if (thx.ne.0) then - sint=sin(thx) - cost=cos(thx) - do i=1,3 - y=matrix(2,i) - z=matrix(3,i) - matrix(2,i)=cost*y+sint*z - matrix(3,i)=-sint*y+cost*z - enddo - endif - end - - subroutine convol(nbins) - integer nbins - include 'cobrems.inc' - vector hisx(10000),hisy(10000),sig(4) - real norm(10000),result(10000) - real x,x0,x1,dx - real alph,dalph - real var0,varMS - real term - integer i,ii,j - x0=hisx(1) - x1=hisx(nbins) - var0=(mospread**2+(emit/spot)**2) - varMS=sigma2MS(t) - sig(3)=sqrt(var0)*E/me - sig(4)=sqrt(varMS)*E/me -C--Here we have to guess which characteristic angle alph inside the crystal -C is dominantly responsible for the coherent photons in this bin in x. -C I just use the smallest of the two angles, but this does not work when -C both angles are small, and you have to be more clever -- BEWARE!!! -C--In any case, fine-tuning below the mosaic spread limit makes no sense. - alph=REAL(min(abs(thx),abs(thy))) - if (alph.eq.0) then - alph=REAL(max(abs(thx),abs(thy))) - else - alph=max(alph,mospread) - endif - - do j=1,nbins - norm(j)=0 - result(j)=0 - do i=-nbins,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - norm(j)=norm(j)+term - enddo - enddo - -c write(6,*) norm - - do i=-nbins,nbins - if (i.lt.1) then - ii=1-i - else - ii=i - endif - do j=1,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - result(ii)=result(ii)+term*hisy(j)/norm(j) - enddo - enddo - - do i=1,nbins - if (abs(result(i)).gt.1e-35) then - hisy(i)=result(i) - else - hisy(i)=0 - endif - enddo - end - - real function sigma2MS(tt) - real tt -C--Chose one of the available implementations of this function below. -c Some formulas, although valid for a reasonable range of target thickness, -c can go negative for extremely small target thicknesses. Here I protect -c against these unusual cases by taking the absolute value. [rtj] - sigma2MS=abs(sigma2MS_Geant(tt)) - end - - real function sigma2MS_Kaune(tt) - real tt - include 'cobrems.inc' -C--Multiple scattering formula of Kaune et.al. -c with a correction factor from a multiple-scattering calculation -c taking into account the atomic and nuclear form factors for carbon. - -c--Note by RTJ, Oct. 13, 2008: -c I think this formula overestimates multiple scattering in thin targets -c like these diamond radiators, because it scales simply like sqrt(tt). -c Although the leading behavior is sqrt(tt/radlen), it should increase -c faster than that because of the 1/theta**2 tail of the Rutherford -c distribution that makes the central gaussian region swell with increasing -c number of scattering events. For comparison, I include below the PDG -c formula (sigma2MS), the Moliere formula used in the Geant3 simulation -c of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for -c thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 -c (sigma2MS_Hanson). The latter two separate the gaussian part from the -c tails in different ways, but both agree that the central part is much -c more narrow than the formulation by Kaune et.al. below. - - carboncor=4.2/4.6 - sigma2MS_Kaune=REAL(8*dpi*nsites*alpha**2*Z**2 - + *tt*(hbarc/(E*a))**2/a - + *log(183*Z**(-1/3.)) - + *carboncor) - end - - real function sigma2MS_pdg(tt) - real tt - include 'cobrems.inc' -C--The PDG formula instead (with beta=1, charge=1) -c This formula is said to be within 11% for t > 1e-3 rad.len. - sigma2MS_pdg=(13.6e-3/E)**2*(tt/radlen) - + *(1+0.038*log(tt/radlen))**2 - end - - real function sigma2MS_Geant(tt) - real tt - include 'cobrems.inc' -C--Geant3 formula for the rms multiple-scattering angle -c This formula is based on the theory of Moliere scattering. It contains -c a cutoff parameter F that is used for the fractional integral of the -c scattering probability distribution that is included in computing the -c rms. This is needed because the complete distribution of scattering -c angles connects smoothly from a central gaussian (small-angle -c multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford -c scattering regime) through the so-called plural scattering region. - F=0.98 ! probability cutoff in definition of sigma2MS - density=3.534 ! g/cm^3 - chi2cc=(0.39612e-2)**2*(Z*(Z+1))*(density/12) ! GeV^2/m - chi2c=chi2cc*(tt/E**2) - rBohr=0.52917721e-10 ! m - chi2alpha=1.13*(hbarc/(E*rBohr*0.885))**2 - + *Z**(2/3.)*(1+3.34*(alpha*Z)**2) - omega0=chi2c/(1.167*chi2alpha) ! mean number of scatters - gnu=omega0/(2*(1-F)) - sigma2MS_Geant=chi2c/(1+F**2)*((1+gnu)/gnu*log(1+gnu)-1) - end - - real function sigma2MS_Hanson(tt) - real tt - include 'cobrems.inc' -C--Formulation of the rms projected angle attributed to Hanson et.al. -c in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere -c theory used to give the 1/e angular width of the scattering distribution. -c In the paper, though, they compare it with experiment for a variety of -c metal foils down to 1e-4 rad.len. in thickness, and show excellent -c agreement with the gaussian approximation out to 4 sigma or so. I -c like this paper because of the excellent agreement between the theory -c and experimental data. - density=3.534 ! g/cm^3 - ttingcm=tt*100*density - Atomicweight=12.01 - EinMeV=E*1000 - theta2max=0.157*Z*(Z+1)/Atomicweight*(ttingcm/EinMeV**2) - theta2screen=theta2max*Atomicweight*(1+3.35*(Z*alpha)**2) - + /(7800*(Z+1)*Z**(1/3.)*ttingcm) - BminuslogB=log(theta2max/theta2screen)-0.154 - Blast=1 - do i=1,999 - B=BminuslogB+log(Blast) - if (B.lt.1.2) then - B=1.21 - goto 10 - elseif (abs(B-Blast).gt.1e-6) then - Blast=B - else - goto 10 - endif - enddo - 10 continue - sigma2MS_Hanson=theta2max*(B-1.2)/2 - end diff --git a/src/programs/Simulation/HDGeant/cobrems.inc b/src/programs/Simulation/HDGeant/cobrems.inc deleted file mode 100644 index b690f0abf3..0000000000 --- a/src/programs/Simulation/HDGeant/cobrems.inc +++ /dev/null @@ -1,16 +0,0 @@ -C units: length in m; energy,momentum,mass in GeV; angles in radians - common /cophys/dpi,me,alpha,hbarc - real me,alpha,hbarc - double precision dpi - integer nsites - parameter (nsites=8) - common /cotarg/Z,a,radlen,Aphonon,mospread,betaFF,ucell(3,nsites) - real Z,a,radlen,Aphonon,mospread,betaFF,ucell - common /cosetup/thx,thy,rotate(3,3),E,Erms,emit,spot,D,t,collim - double precision thx,thy,rotate - real E,Erms,emit,spot,D,t,collim - common /coQ2list/q2points,q2theta2(1000),q2weight(1000) - integer q2points - real q2theta2,q2weight - common /coselect/unpolar - logical unpolar diff --git a/src/programs/Simulation/HDGeant/control.in b/src/programs/Simulation/HDGeant/control.in deleted file mode 100644 index dd61d8c1c8..0000000000 --- a/src/programs/Simulation/HDGeant/control.in +++ /dev/null @@ -1,441 +0,0 @@ -c This is the control file for the GEANT simulation. Parameters defined -c in this file control the kind and extent of simulation that is performed. -c The full list of options is given in section BASE-40 of the GEANT manual. -c -c In addition, some new cards have been defined to set up the input source -c for the simulation. Three kinds of simulation runs are available, selected -c by which of the following three "cards" are present below. -c 1. Input from Monte Carlo generator (card INFILE) -c 2. Built-in coherent bremsstrahlung source (card BEAM) -c 3. Built-in single-track event generator (card KINE) -c The order of the list is significant, that is if INFILE is present then the -c BEAM and KINE cards are ignored, otherwise if BEAM is present then KINE is -c ignored. For example, the 3-card sequence: -c INFILE 'phi-1680.hddm' -c SKIP 25 -c TRIG 100 -c instructs HDGeant to open ./phi-1680.hddm, skip the first 25 events and then -c process the following 100 input events and stop. If the end of the file is -c reached before the event count specified in card TRIG is exhausted then the -c processing will stop at the end of file. -INFILE 'bggen.hddm' -TRIG 1000000 -RUNG 9001 - -c The BEAM card configures the built-in coherent bremsstralung photon -c beam generator in HDGeant. If the INFILE card is not present and BEAM -c is specified, the internal coherent bremsstralung generator is the primary -c source of events for the simulation. If INFILE is specified, the primary -c event source is the external Monte Carlo generator that produced the file, -c but the BEAM card may still be present, and it is needed if beam-related -c backgrounds are being superimposed on top of the primary event signals, -c as requested with the BGRATE card (see below). The beam card accepts -c the following five parameters. -c Emax - end-point energy of the electron beam (GeV) -c Epeak - energy of the primary coherent peak edge (GeV) -c Emin - minimum energy of the coherent bremsstrahlung beam (GeV) -c collz - z position of collimator in m -c colld - diameter of collimator in m -c Eemit - electron beam emittance in m.rad -c radthick - dimaond radiator thickneess in m -c Omitting the final parameter Emin results in the default value being used. -c Setting Epeak to zero selects an amorphous radiator instead of diamond. -cBEAM 10. 9.999 0.0012 76.00 0.005 10.e-9 20.e-6 - -c The GENBEAM card configures the simulation program to act purely as a -c Monte Carlo event generator, and not to actually track any of the particles -c that it generates. The events are written to the output file with only the -c MC section filled out (reactions tag). This file can be fed back later to -c HDGeant using the INFILE card above to carry out the actual simulation. -c This provides access to the built-in photon beam generator of HDGeant to -c someone who wants to study the properties of the beam apart from its -c interactions in the target. Three keywords are currently supported. -c 'precol' - single-photon events starting upstream of the primary -c collimator, with correlated spatial and momentum -c distributions for the well-tuned GlueX beamline. -c 'postcol' - single-photon events starting downstream of the secondary -c collimator. Beam photons have been tracked through the -c system of collimators and sweep magnets but then stopped -c before entry into the pair spectrometer. -c 'postconv' - e+e- pair and e+e-/e-recoil events generated in the -c TPOL target. Beam photons have been tracked through -c the system of collimators and then pair-converted in -c the TPOL coverter using a custom polarization-sensitive -c pair/triplet production generator. They are saved as -c a single vertex within the PTAR target. -c The first two modes are supported by both HDGeant and HDGeant4, while -c postconv is only supported at present by HDGeant4. -cGENBEAM 'postconv' - -c Commenting out the following line will disable simulated hits output. -OUTFILE 'bgtest.hddm' - -c The following are used to automatically invoke the mcsmear program -c to do the final stage digitization of hits after the simulation -c stage is complete. This simply invokes the mcsmear program passing -c it any optional arguments supplied here and then optionally deletes -c the OUTFILE specified above leaving only the smeared file. This stage -c can be invoked by hand afterwards, but having it done automatically -c here allows hdgeant and mcsmear to function as though it were a single -c program. The specific keys are as follows. -c -c POSTSMEAR - set this 1 to auto-invoke the mcsmear program and 0 to not -c DELETEUNSMEARED - set this to 1 to delete the OUTFILE after running mcsmear -c MCSMEAROPTS - String to specify additional arguments to pass to mcsmear -POSTSMEAR 1 -DELETEUNSMEARED 1 -c MCSMEAROPTS '-t1000 -d0' - -c The following card enables single-track generation (for testing). -c For a single-particle gun, set the momentum (GeV/c), direction -c theta,phi (degrees) and vertex position (cm), and for the particle -c type insert the Geant particle type code plus 100 (eg. 101=gamma, -c 103=electron, 107=pi0, 108=pi+, 109=pi-, 114=proton). If you use -c the particle code but do not add 100 then theta,phi are ignored -c and the particle direction is generated randomly over 4pi sr. -c For a listing of the Geant particle types, see the following URL. -c http://wwwasdoc.web.cern.ch/wwwasdoc/geant_html3/node72.html -c The meaning of the arguments to KINE are as follows. -c - particle = GEANT particle type of primary track + 100 -c - momentum = initial track momentum, central value (GeV/c) -c - theta = initial track polar angle, central value (degrees) -c - phi = initial track azimuthal angle, central value (degrees) -c - delta_momentum = spread in initial track momentum, full width (GeV/c) -c - delta_theta = spread in initial track polar angle, full width (degrees) -c - delta_phi = spread in initial track azimuthal angle, full width (degrees) -c -c If you do explicitly specify the momentum/angle (by adding 100 as -c described above, you may also choose to distibute tracks evenly in -c log(P) or log(theta) by setting the appropriate PLOG and TLOG flags -c to a non-zero value. -c PLOG 1 -c TLOG 1 -c -c particle momentum theta phi delta_momentum delta_theta delta_phi -KINE 108 1.0 50. 0. 0. 0. 360. - -c The SCAP card determines the vertex position for the particle gun. It -c supports the following three arguments, all of which default to 0. -c -c vertex_x vertex_y vertex_z -SCAP 0. 0. 65. - -c The TGTWIDTH card is used to determine an extended volume from -c which the particle gun will generate vertexes. The vertex position -c is sampled evenly from a cylindrical volume whose radius is given -c by the first parameter and whose full z-extent is given by the second. -c The volume is centered on the coordinates specified by SCAP above. -c If the card is not specified, then both the r and z extent default -c to zero meaning the vertex is always located at the point specified -c by SCAP. Note that this only affects the particle gun. Events read -c from a file contain their own vertex information. -c -c vertex_extent_r vertext_extent_z -c TGTWIDTH 0.5 0.2 - -c If you specify a non-zero value for vertex_x and/or vertex_y above then -c all tracks will emerge from the given point. If you leave them at zero, -c you have the option of specifying the HALO card which causes the simulation -c to generate events with a transverse profile modeled after the 12 GeV -c electron beam. The argument only argument to HALO is fhalo, the fraction -c of the beam that lies in the halo region surrounding the core gaussian. -c The nominal value taken from CASA technical note JLAB-TN-06-048 is 5e-5. -c This card is only effective for electron beam simulations with gxtwist. -c -c fhalo -HALO 5e-5 - -c The following lines control the rate (GHz) of background beam photons -c that are overlayed on each event in the simulation, in addition to the -c particles produced by the standard generation mechanism. BGGATE expects -c two values in ns, which define the window around the trigger time that -c background beam photons are overlaid on the simulation. The value you -c should enter for BGRATE depends on many details of the photon beam: the -c endpoint energy, the low-energy cutoff to be used in generating beam -c photons, the location of coherent edge, the electron beam spot size and -c emittance at the primary collimator, the electron beam current, etc. To -c find the setting that is right for you, follow these steps in order. -c 1) Check the BEAM card above that it has correct values for the electron -c beam energy (field 1) and the low-energy cutoff that you want to use -c in your simulation (field 3). Remember these values. -c 2) Open a new tab in a web browser and enter the following URL, -c http://zeus.phys.uconn.edu/halld/cobrems/ratetool.cgi which displays -c a form containing many fields describing the electron beam and the -c photon beamline. Enter the correct values in all fields in the -c left-most column of parameters. The right column of parameters -c defines the windows over which the tool will compute integrals of -c the beam rate. Set the "end-point" window to span the full range -c from your beamEmin (see step 1 above) to the electron beam endpoint, -c Then click the Plot Spectrum button. After a few seconds, the form will -c respond with a few plots and rate numbers in bold text. Record the -c value given for the "end-point rate". This is your BGRATE value. -c 3) Enter your BGRATE value found in step 2 after BGRATE in the line -c below, and remove any characters before the BGRATE keyword. You are -c now ready to go. If you ever change anything in the beamline geometry -c eg. the collimator diameter, the coherent edge position, or the value -c of beamEmin, do not forget to come back and change your BGRATE. -cBGGATE -200. 200. -cBGRATE 4.80 - -c The above cards BGRATE, BGGATE normally cause the simulation to add -c accidental tagger hits to the simulated output record, in addition to -c adding these beam photons to the list of particles to be tracked through -c the detector. If you want the accidental tagger hits to be added to the -c simulated output record but you do not want to track the background -c beam photons, remove the comment in front of BGTAGONLY below. -c NOTICE: If you turn on BGTAGONLY then you might as well raise the -c minimum energy of beam photons being generated to the lower bound of -c the tagger energy range you are interested in, which might be 3 GeV for -c low-intensity running, 7 GeV for high-intensity running, or even 8 GeV -c if you are only interested in the region of the coherent peak. This -c minimum is the third field of the BEAM card above. Remember that if -c you change beamEmin, you also need to change BGRATE to match, as -c described above. -cBGTAGONLY 1 - -c The following line controls the uncertainty of the event time reference -c relative to the RF structure of the beam. The event time reference is -c normally set by the level 1 trigger, whose transitions are synced to -c a clock in the trigger processor whose resolution is more coarse than -c the accelerator RF clock. Using a digitized copy of the RF clock signal, -c all times in the event can be synchronized offline to a nearby RF bucket, -c but the RF bucket closest to the trigger time will not in general be the -c one that contained the beam photon that produced the trigger. The spread -c of trigger RF buckets times relative to the interaction RF bucket is -c set by the TREFSIGMA card below, specified as a RMS value in ns. The -c the displacement of the (unknown) true RF bucket from the trigger RF -c bucket will be generated by the simulation in multiples of 2 ns. If -c this line is commented out, a default value of 10ns is assumed. The -c decimal point is significant. -TREFSIGMA 10. - -c The following card seeds the random number generator, though it may be -c overridden if seeds are found in the input file (see below). It must be -c unique for each run. There are two ways to specify the random seed here. -c 1. One argument, must be an integer in the range [1,215] -c 2. Two arguments, must be a pair of positive Integer*4 numbers -c In the first case, one of a limited set of prepared starting seeds is -c chosen from a list. These seeds have been certified to produce random -c sequences that do not repeat within the first 10^9 or so random numbers. -c For cases where more choices are needed, the two-argument form gives -c access to a total of 2^62 choices, with no guarantees about closed loops. -c -c NOTE: If one uses events read from an HDDM file and that file contains -c random number seeds for the event, those seeds will be used, overwriting -c any value(s) specified here. Most event generators do not include the -c seeds. The seeds are written to the output HDDM file though so if one -c uses the output file for input to another invocation of hdgeant(++) -c then the same seeds will be used. You may check for seeds in the input -c file using hddm-xml file.hddm | grep random . -RNDM 121 - -c The following line controls the cutoffs for tracking of particles. -c CUTS cutgam cutele cutneu cuthad cutmuo bcute bcutm dcute dcutm ppcutm tofmax -c - cutgam = Cut for gammas (0.001 GeV) -c - cutele = Cut for electrons (0.001 GeV) -c - cutneu = Cut for neutral hadrons (0.01 GeV) -c - cuthad = Cut for charged hadrons (0.01 GeV) -c - cutmuo = Cut for muons (0.01 GeV) -c - bcute = Cut for electron brems. (CUTGAM) -c - bcutm = Cut for muon brems. (CUTGAM) -c - dcute = Cut for electron delta-rays. (10 TeV) -c - dcutm = Cut for muon delta-rays. (10 TeV) -c - ppcutm = Cut for e+e- pairs by muons. (0.01 GeV) -c - tofmax = Time of flight cut (1.E+10 sec) -c - gcuts = 5 user words (0.) -c Only the first 5 fields (the ones that start with 'cut') -c are supported by hdgeant4. -CUTS 1e-4 1e-4 1e-3 1e-3 1e-4 - -c Geant4 introduced the concept of ?a unique cut in range? which allows the user -c to specify the threshold for secondaries production in terms of the range that -c the secondary would have in the medium in which it is generated, rather than -c in terms of a threshold energy. The RANGECUT card below supports the same -c sequence as the first 5 arguments of the CUTS card above, except that the -c values are interpreted as threshold ranges (cm) instead of kinetic energies. -c This card is supported by hdgeant4 only. It is complementary to the CUTS card -c in that CUTS are applied to the corresponding particles when they are being -c tracked, whereas RANGECUTS are used to decide whether they should be -c generated (as secondaries) in the first place. - -RANGECUTS 0.1 0.1 1.0 1.0 0.1 - -c Geant4 physics models are more comprehensive than the ones provided in G3, -c and one consequence of this is that some particles (eg. neutrons) seem to go -c on and on in Geant4 for lifetimes of many seconds in some cases. The following -c card tells the simulation to stop tracks that are still being followed after -c this much time (seconds) has gone by. This card is only supported by hdgeant4. -c There is an equivalent feature in hdgeant3 (see field 12 of CUTS card above) -c but normally it is not needed to get efficient operation, so it is almost -c never needed. - -TOFMAX 1e-5 - -c The following line controls a set of generic flags that are used to -c control aspects of the simulation generally related to debugging. -c For normal debugging runs these should be left at zero (or omitted). -c At present the following functionality is defined (assumes debug on). -c SWIT(2) = 0 turns off trajectory tracing -c = 2 turns on step-by-step trace during tracking (verbose!) -c = 3 turns on trajectory plotting after tracking is done -c = 4 turns on step-by-step plotting during tracking -c SWIT(3) = 1 stores track trajectories for plotting after tracking is done -c SWIT(4) = 0 trace trajectories of all particle types -c = 3 trace only charged particle trajectories -c This card is only supported by hdgeant3. -SWIT 0 0 0 0 0 0 0 0 0 0 - -c The following card enables the GelHad package (from BaBar) -c on/off ecut scale mode thresh -c This card is only supported by hdgeant3. -GELH 1 0.2 1.0 4 0.160 - -c The following card selects the hadronic physics package -c HADR 0 no hadronic interactions -c HADR 1 GHEISHA only (default) -c HADR 2 GHEISHA only, with no generation of secondaries -c HADR 3 FLUKA (with GHEISHA for neutrons below 20MeV) -c HADR 4 FLUKA (with MICAP for neutrons below 20MeV) -HADR 1 - -c The following cards are needed if optical photons are being -c being generated and tracked in the simulation. The CKOV directive -c enables Cerenkov generation in materials for which the refractive -c index table has been specified. The LABS card enables absorption -c of optical photons. The ABAN directive controls a special feature -c of Geant which allows it to "abandon" tracking of charged particles -c once their remaining range drops below the distance to the next -c discrete interaction or geometric boundary. Particles abandoned -c during tracking are stopped immediately and dump all remaining energy -c where they lie. The remaining energy is dumped in the correct volume -c so this is OK in most cases, but it can cut into the yield of -c Cerenkov photons (eg. in a lead glass calorimeter) at the end of -c a particle track. If this might be important, set ABAN to 0. -CKOV 1 -LABS 1 - -c The following card prevents GEANT tracking code from abandoning the -c tracking of particles near the end of their range, once it determines -c that their fate is just to stop (i.e. electrons and protons). This -c behaviour is normal in most cases, but in the case of Cerenkov light -c generation it leads to an underestimate for the yields. -c ABAN 1 abandon stopping tracks (default) -c ABAN 0 do not abandon stopping tracks -c This card is only supported by hdgeant3. -ABAN 0 - -c The following card sets up the simulation to perform debugging on -c a subset of the simulated events. -c DEBUG first last step -c - first (int) = event number of first event to debug -c - last (int) = event number of last event to debug -c - step (int) = only debug one event every step events -DEBU 1 10 1000 - -c The following card can be used to turn off generation of secondary -c particles in the simulation, ordinarily it should be 0 (or omitted). -NOSECONDARIES 0 - -c The following card tells the simulation to store particle trajectories -c in the event output stream. This output can be verbose, use with caution. -c The value set here determines the amount of output recorded: -c -c TRAJECTORIES = 0 don't store trajectory info -c TRAJECTORIES = 1 store birth and death points of primary tracks -c TRAJECTORIES = 2 store birth and death points of all particles -c TRAJECTORIES = 3 store full trajectory of primary tracks -c TRAJECTORIES = 4 store full trajectory of primary tracks and birth/death points of secondaries -c TRAJECTORIES = 5 store full trajectory for all particles -c -TRAJECTORIES 0 - -c The following tracking parameters are defined for each tracking medium -c TMAXFD (REAL) maximum angular deviation due to the magnetic field -c permitted in one step (degrees) -c DEEMAX (REAL) maximum fractional energy loss in one step (0< DEEMAX <=0.1) -c STEMAX (REAL) maximum step permitted (cm) -c STMIN (REAL) minimum value for the maximum step imposed by energy loss, -c multiple scattering, Cerenkov or magnetic field effects (cm) -c Normally they are assigned appropriate values calculated automatically by -c Geant when the geometry is defined, overwriting the values declared by -c the user code in the GSTMED() call. Users who know what they are doing can -c force Geant to instead use the values passed in the arguments to GSTMED() -c by removing the comment in front of the following card. Any parameters with -c zero values are still assigned automatic values even when AUTO is turned off. -c This card is only supported by hdgeant3. -cAUTO 0 - -c The magnetic field map is accessed through the HDGEOMETRY library -c so that the same map can be used for both simulation and reconstruction. -c There are multiple map types and for each type, more than one map may -c exist. The map types consist of the default type of "CalibDB", the -c constant type of "Const", the spoiled field type of "Spoiled", or -c "NoField" if the simulation should be performed with the solenoid off. -c The type is set using the BFIELDTYPE card. If no BFIELDTYPE card is -c present, then no the default type "CalibDB" is used. -c The specific parameters used for the field can be specified using the -c BFIELDMAP card. If undefined, then the default that is hardcoded into -c the HDGEOMETRY library is used. Note that these correspond to the -c similarly named configuration parameters used in the reconstruction, -c the difference being that underscores are not allowed here. To -c specify the values to the reconstruction code used here, use the -c -PBFIELD_TYPE=CalibDB and -PBFIELD_MAP=Magnets/Solenoid/solenoid_1500 -cBFIELDMAP 'Magnets/Solenoid/solenoid_1200A_poisson_20140520' -cBFIELDTYPE 'NoField' - -c The pair spectrometer magnetic field map can also be accessed through the -c HDGGEOMTRY library in a similar fashion to the solenoid field. The cards -c PSBFIELDMAP and PSBFIELDTYPE correspond in form and meaning to BFIELDMAP -c and BFIELDTYPE, except that only "Const" and "CalibDB" (default) are -c supported values for PSBFIELDTYPE. To specify the values used here to -c the reconstruction code, use options -PPSBFIELD_TYPE=CalibDB and -c -PPSBFIELD_MAP=Magnets/PairSpectrometer/PS_1.8T_20150513_test -c on the jana command line. -cPSBFIELDMAP 'Magnets/PairSpectrometer/PS_1.8T_20150513_test' -cPSBFIELDTYPE 'Const' - -c Use this card to enable/disable ( SAVEHITS 1/0 ) writing events with no -c hits in the detector to the hddm output file. Default value is 0. - SAVEHITS 0 - -c This card is used to enable/disable ( SHOWERS_IN_COL 1/0 ) simulation of -c showers in the primary and secondary collimators placed in the collimator cave. -c The default value is set to 0. - SHOWERSINCOL 0 - -c This card enables/disables (DRIFTCLUSTERS 1/0) simulation of electron -c clusters within a drift cell in the FDC or the CDC -c The default value is 0. - DRIFTCLUSTERS 0 - -c The following cards allow one to switch on/off some physics processes in GEANT: -c MULS 0 no multiple scattering -c 1 Moliere or Coulomb scattering (default) -c -c BREM 0 no bremsstrahlung -c 1 bremsstrahlung (default) -c -c COMP 0 no Compton -c 1 Compton scattering (default) -c -c PAIR 0 no pair production -c 1 pair production (default) -c -c LOSS 0 (controls energy losses) no energy loss -c 1 delta-rays are produced above the threshold. Reduced fluctuations from -c delta-rays below the threshold are added to the energy losses. The threshold -c energies for delta-ray production can be set using the CUTS card (see above). -c The fields 'dcute' and 'dcutm' in the CUTS card correspond to energy thresholds -c for electron and muon delta-rays, respectively. The default energy threshold -c value is 100 keV (default see uginit.F 12/16/2011 DL). -c 2 no delta-rays are produced. Complete fluctuations are calculated . -c -c DCAY 0 no decay in flight -c 1 decay in flight with generation of secondaries (default) -c 2 decay in flight without generation of secondaries -c -c DRAY 0 no delta ray production -c 1 delta ray production with generation of secondaries (default) -c 2 delta ray production without generation of secondaries - -END diff --git a/src/programs/Simulation/HDGeant/controlparams.h b/src/programs/Simulation/HDGeant/controlparams.h deleted file mode 100644 index 196f1055a5..0000000000 --- a/src/programs/Simulation/HDGeant/controlparams.h +++ /dev/null @@ -1,22 +0,0 @@ - -// This needs to be kept in sync with controlparams.inc!! - -#ifdef __cplusplus -extern "C" { -#endif - -typedef struct { - int writenohits; - int shoersincol; - int driftclusters; - float tgwidth[2]; - int runtime_geom; - int get_next_evt; - float trigger_time_signa_ns; - int event_count; -}controlparams_t; -extern controlparams_t controlparams_; - -#ifdef __cplusplus -} // extern "C" -#endif diff --git a/src/programs/Simulation/HDGeant/controlparams.inc b/src/programs/Simulation/HDGeant/controlparams.inc deleted file mode 100644 index f6aefdbde2..0000000000 --- a/src/programs/Simulation/HDGeant/controlparams.inc +++ /dev/null @@ -1,16 +0,0 @@ - integer writenohits, showersincol, driftclusters, runtime_geom - real tgtwidth - integer get_next_evt - real trigger_time_sigma_ns - integer event_count - integer override_run_number - common /controlparams/ writenohits, showersincol, driftclusters - + ,tgtwidth(2),runtime_geom,get_next_evt - + ,trigger_time_sigma_ns - + ,event_count,override_run_number - - integer genbeam_precol - integer genbeam_postcol - integer genbeam_mode - common /genbeam_pars/ genbeam_precol, genbeam_postcol, - + genbeam_mode(20) diff --git a/src/programs/Simulation/HDGeant/copytocplusplus.cc b/src/programs/Simulation/HDGeant/copytocplusplus.cc deleted file mode 100644 index 9c521b9808..0000000000 --- a/src/programs/Simulation/HDGeant/copytocplusplus.cc +++ /dev/null @@ -1,42 +0,0 @@ - -#include - -#include -#include -using namespace std; - - -string INFILE; -string OUTFILE; -bool POSTSMEAR = false; -string MCSMEAROPTS; -bool DELETEUNSMEARED = false; -float BGGATE1=-200.0; -float BGGATE2= 200.0; - -// Declare routines callable from FORTRAN -extern "C"{ - - // The following allows one to specify that mcsmear should - // automatically be run after hdgeant_ returns. This is - // controlled by the POSTSMEAR and MCSMEAROPTS keyowrds - // in the control.in file. - void copytocplusplus_(char *infile, char *outfile, int *postsmear, char *mcsmearopts, int *deleteunsmeared){ - if(infile)INFILE = infile; - if(outfile){ - OUTFILE= outfile; - POSTSMEAR = *postsmear != 0; - if(POSTSMEAR && mcsmearopts)MCSMEAROPTS = mcsmearopts; - DELETEUNSMEARED = *deleteunsmeared != 0; - } - } - - // Copy the values of BGGATE card to global variables - // visible from C++. This is to allow the bcalHit.cc - // routines to use them to set the histogram limits - void copygatetocplusplus_(float *bggate1, float *bggate2){ - BGGATE1 = *bggate1; - BGGATE2 = *bggate2; - } -} - diff --git a/src/programs/Simulation/HDGeant/dbug.kumac b/src/programs/Simulation/HDGeant/dbug.kumac deleted file mode 100644 index dec0245816..0000000000 --- a/src/programs/Simulation/HDGeant/dbug.kumac +++ /dev/null @@ -1,52 +0,0 @@ -MACRO dbug key=help - if ([key] = help) then - message 'Usage: dbug [-] [ [-] [...]]' - message 'where is one of the following:' - message '1) none - disables all debugging options' - message '2) printout - enables step-by-step debug printout during tracking' - message '3) store - stores step-by-step track coordinates during tracking' - message '4) plot - plots the tracks on the current drawing view' - message '5) plotnow - plots at every step instead of at end of track' - message '6) neutrals - renders neutral tracks visible during plotting' - exitm - endif - while [1] <> ' ' do - case [1] in - (none) - switch 1 0 - switch 2 0 - switch 3 0 - debug off - (-none) - message 'This is meaningless!' - (printout) - switch 2 2 - debug on - (-printout) - switch 2 0 - (store) - switch 3 1 - debug on - (-store) - switch 3 0 - (plot) - switch 3 1 - switch 2 3 - debug on - (-plot) - switch 2 0 - (plotnow) - switch 2 4 - debug on - (-plotnow) - switch 2 0 - (neutrals) - switch 4 0 - debug on - (-neutrals) - switch 4 3 - switch 2 3 - endcase - shift - endwhile -RETURN diff --git a/src/programs/Simulation/HDGeant/dl_routines.cc b/src/programs/Simulation/HDGeant/dl_routines.cc deleted file mode 100644 index 74d8696b12..0000000000 --- a/src/programs/Simulation/HDGeant/dl_routines.cc +++ /dev/null @@ -1,244 +0,0 @@ - -#include -#include -#include - -#include -#include -#include -#include -using namespace std; - -#include -#include -#include -#include "HDGEOMETRY/DMagneticFieldMapSpoiled.h" -#include "HDGEOMETRY/DMagneticFieldMapParameterized.h" - - -//---------------------------------------------------------- -// This file contains routines used to implement dynamic -// geometry linking in hdgeant. The routines generated -// by the hdds-geant utility (part of the HDDS) package -// are what are linked here. Here is how it works: -// -// The routines that were called from the hdgeant core -// have been replaced with a corresponding wrapper routine -// that is defined here. The wrapper simply calls the -// actual function using a function pointer. For example: -// -// void md5geom_wrapper_(char *md5){ -// -// (*md5geom_ptr)(md5); -// } -// -// where the global variable md5geom_ptr is of type -// pointer to a function with format: -// "void md5geom_(char *md5)" -// -// Whereas previously one might simply call: -// -// md5geom_(md5); -// -// now one calls: -// -// md5geom_wrapper(md5); -// -// -// The function pointers are all initialized to point to -// the statically linked routines so that they are what -// is used if the user does not specify the XML geometry -// be used. The pointers are initialized to point to the -// static routines with statements like this: -// -// typeof(md5geom_) *md5geom_ptr = md5geom_; -// -// where the use of typeof() makes it so we don't have -// to enter the signature of the function twice. -// -// If the user does specify that the XML source be used -// to dynamically regenerate the geometry, then the -// pointers are updated to point to routines found in -// the shared object. The shared object is generated at -// run time using the hdds-geant utility to generate a -// FORTRAN source file which is then compiled into a -// shared object and opened using the dl library. -// -// This should work for most all modifications to the -// geometry. The one problem would be if a major change -// was made that required another routine be generated -// by hdds-geant. For example, a getsection_() routine -// is added. In that case, one would need to add the -// declaration of a wrapper routine below and a function -// pointer for it. One would also need to add a call -// to GetRoutine() and then make sure all places in the -// code using the routine called the wrapper function. -//---------------------------------------------------------- - -extern "C" { - - void init_runtime_xml_(void); - - - // Declare statically linked routines - void hddsgeant3_(void); - void md5geom_(char *md5); - float guplsh_(int *medi0, int *medi1); - void gufld_(float *r, float *B); - void getoptical_(int *imat, float *E, float *refl, float *abs1, float *rind, float *plsh, float *eff); - - // Initialize routine pointers to use statically linked routines - __typeof__(hddsgeant3_) *hddsgeant3_ptr = hddsgeant3_; - __typeof__(md5geom_) *md5geom_ptr = md5geom_; - __typeof__(guplsh_) *guplsh_ptr = guplsh_; - __typeof__(gufld_) *gufld_ptr = gufld_; - __typeof__(getoptical_) *getoptical_ptr = getoptical_; - - // Trivial wrapper routines use pointer to dispatch call - void hddsgeant3_wrapper_(void){ (*hddsgeant3_ptr)(); } - void md5geom_wrapper_(char *md5){ (*md5geom_ptr)(md5); } - float guplsh_wrapper_(int *medi0, int *medi1){ return (*guplsh_ptr)(medi0, medi1); } - void gufld_wrapper_(float *r, float *B){ (*gufld_ptr)(r, B); } - void getoptical_wrapper_(int *imat, float *E, float *refl, float *abs1, float *rind, float *plsh, float *eff){ (*getoptical_ptr)(imat, E, refl, abs1, rind, plsh, eff);} - - // Below are several more routines which need to be implemented - // using the same three steps as above. However, all of them - // have the same format of returning an int and taking no - // arguments. We compact things a bit using the following - // macro which would expand to something like this: - // - // int getcolumn_(void); - // int (*getcolumn_ptr)(void) = getcolumn_; - // int getcolumn_wrapper_(void) { return ( *getcolumn_ptr)(); } - // -#define MakeDispatcherINT(N) \ - int N(void); \ - int (* N ## ptr)(void) = N; \ - int N ## wrapper_(void) { return ( *N ## ptr)(); } - - MakeDispatcherINT(getcolumn_); - MakeDispatcherINT(getlayer_); - MakeDispatcherINT(getmap_); - MakeDispatcherINT(getmodule_); - MakeDispatcherINT(getpackage_); - MakeDispatcherINT(getplane_); - MakeDispatcherINT(getring_); - MakeDispatcherINT(getrow_); - MakeDispatcherINT(getsector_); -} - - -void GetRoutine(void **ptr, const char *rname); - -static void *dlgeom_handle=NULL; -string HDDS_XML = "$HDDS_HOME/main_HDDS.xml"; - - -//------------------ -// init_runtime_xml_ -//------------------ -void init_runtime_xml_(void) -{ - int retcode; - - cout< tmp.F"; - cout << cmd << endl; - retcode = system(cmd.c_str()); - if(retcode) cerr << "Error running command: " << retcode << endl; - - // Compile FORTRAN into shared object - cout<solenoid.map - - From: P. Brindza - Date: September 21, 2001 - - This file contains a field map of the LASS solenoid. It was generated - by P. Brindza from his 2D model of the magnet. Here are Paul's notes. - - [P Brindza, September 21, 2001] - - The solenoid model has all 17 superconducting coils and all the yoke - modifications that I have proposed and that have been agreed to by the D - team as per the last collaboration meeting. The yoke also has the large - hole on the upstream end that we discussed at the last meeting. - - As an aside it would be useful to try to compare the performance of the - magnet with and without the large upstream hole in the yoke. If this is - something that you can do I can easily send you a grid from the other model. - - I have added a 4 inch thick iron wall at Z = 280.75 inches to simulate - the magnetic effect of the iron phototube frame for the lead glass - detector. - - The physical end of the iron yoke is at 200.75 inches. - - The grid is on a one inch spacing because my model was done in inches. - This is because the drawings are in inches and my dog ate the homework - where I converted them all to metric! - - If a finer grid is desired please let me know. - - The text file has 6 entries for each point , X , Y , Z , Bx , By , Bz - The range is from 0) -{ - if (/[^-.Ee0-9]$/) - { - @f = split(" "); - next if (@f != 6); - $f[3]=0 if (abs($f[3])<1e-10); - $f[4]=0 if (abs($f[4])<1e-10); - $f[5]=0 if (abs($f[5])<1e-10); - print "$f[3] $f[4] $f[5]\n"; - } -} diff --git a/src/programs/Simulation/HDGeant/fint.F b/src/programs/Simulation/HDGeant/fint.F deleted file mode 100644 index 67063191a0..0000000000 --- a/src/programs/Simulation/HDGeant/fint.F +++ /dev/null @@ -1,90 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2001/10/04 06:21:26 brash -* This routine is part of the cern library, but suffered arithmetic errors on the -* alpha. I changed this file to trap these situations. EJB -* -* Revision 1.1.1.1 1996/02/15 17:48:36 mclareni -* Kernlib -* -* -#include "kernnum/pilot.h" - FUNCTION FINT(NARG,ARG,NENT,ENT,TABLE) -C -C INTERPOLATION ROUTINE. AUTHOR C. LETERTRE. -C MODIFIED BY B. SCHORR, 1.07.1982. -C - INTEGER NENT(9) - REAL ARG(9), ENT(9), TABLE(9) - INTEGER INDEX(32) - REAL WEIGHT(32) - LOGICAL MFLAG, RFLAG - FINT = 0. - IF(NARG .LT. 1 .OR. NARG .GT. 5) GOTO 300 - LMAX = 0 - ISTEP = 1 - KNOTS = 1 - INDEX(1) = 1 - WEIGHT(1) = 1. - DO 100 N = 1, NARG - X = ARG(N) - NDIM = NENT(N) - LOCA = LMAX - LMIN = LMAX + 1 - LMAX = LMAX + NDIM - IF(NDIM .GT. 2) GOTO 10 - IF(NDIM .EQ. 1) GOTO 100 - H = X - ENT(LMIN) - IF(H .EQ. 0.) GOTO 90 - ISHIFT = ISTEP - IF(X-ENT(LMIN+1) .EQ. 0.) GOTO 21 - ISHIFT = 0 - ETA = H / (ENT(LMIN+1) - ENT(LMIN)) - GOTO 30 - 10 LOCB = LMAX + 1 - 11 LOCC = (LOCA+LOCB) / 2 - IF(X-ENT(LOCC)) 12, 20, 13 - 12 LOCB = LOCC - GOTO 14 - 13 LOCA = LOCC - 14 IF(LOCB-LOCA .GT. 1) GOTO 11 - LOCA = MIN0( MAX0(LOCA,LMIN), LMAX-1 ) - ISHIFT = (LOCA - LMIN) * ISTEP - ETA = (X - ENT(LOCA)) / (ENT(LOCA+1) - ENT(LOCA)) - GOTO 30 - 20 ISHIFT = (LOCC - LMIN) * ISTEP - 21 DO 22 K = 1, KNOTS - INDEX(K) = INDEX(K) + ISHIFT - 22 CONTINUE - GOTO 90 - 30 DO 31 K = 1, KNOTS - INDEX(K) = INDEX(K) + ISHIFT - INDEX(K+KNOTS) = INDEX(K) + ISTEP - WEIGHT(K+KNOTS) = WEIGHT(K) * ETA - WEIGHT(K) = WEIGHT(K) - WEIGHT(K+KNOTS) - 31 CONTINUE - KNOTS = 2*KNOTS - 90 ISTEP = ISTEP * NDIM - 100 CONTINUE - DO 200 K = 1, KNOTS - I = INDEX(K) - if(abs(table(i)).lt.1.0E-10)table(i)=0.0 - if(abs(weight(k)).lt.1.0E-10)weight(k)=0.0 - FINT = FINT + WEIGHT(K) * TABLE(I) - 200 CONTINUE - RETURN - 300 CALL KERMTR('E104.1',LGFILE,MFLAG,RFLAG) - IF(MFLAG) THEN - IF(LGFILE .EQ. 0) THEN - WRITE(*,1000) NARG - ELSE - WRITE(LGFILE,1000) NARG - ENDIF - ENDIF - IF(.NOT. RFLAG) CALL ABEND - RETURN -1000 FORMAT( 7X, 24HFUNCTION FINT ... NARG =,I6, - + 17H NOT WITHIN RANGE) - END diff --git a/src/programs/Simulation/HDGeant/flukaaf.dat b/src/programs/Simulation/HDGeant/flukaaf.dat deleted file mode 100644 index 9b8932ec12..0000000000 --- a/src/programs/Simulation/HDGeant/flukaaf.dat +++ /dev/null @@ -1,4011 +0,0 @@ - 1 2 3 4 5 6 7 7 8 9 10 11 12 13 14 16 17 17 - 18 20 21 21 22 24 25 25 26 28 29 29 30 33 34 35 36 38 - 39 41 42 47 48 48 49 53 54 55 56 59 60 60 61 64 65 65 - 66 70 71 72 73 77 78 79 80 84 85 85 86 91 92 93 94 99 - 100 101 102 105 106 106 107 111 112 112 113 119 120 120 121 127 128 128 - 129 134 135 136 137 144 145 146 147 156 157 158 159 166 167 167 168 176 - 177 177 178 184 185 186 187 190 191 191 192 198 199 199 200 206 207 208 - 209 215 216 216 217 223 224 224 225 230 231 231 232 238 239 240 241 246 - 247 248 249 253 254 255 256 262 263 264 265 270 271 271 272 278 279 280 - 281 284 285 285 286 286 287 287 288 288 289 289 290 290 291 291 292 292 - 293 293 294 296 297 297 298 298 299 299 300 300 301 301 302 302 303 303 - 304 304 - 1 2 4 3 7 6 9 11 10 12 13 14 15 16 18 17 19 20 - 22 21 23 24 26 25 27 28 29 30 31 32 34 33 36 35 37 40 - 36 38 39 41 40 40 44 42 46 48 43 45 48 46 47 49 50 51 - 50 52 53 50 54 55 56 54 57 58 59 58 60 62 61 64 63 65 - 64 66 68 67 70 69 71 74 72 70 73 76 75 80 78 82 76 77 - 74 79 81 84 86 82 83 80 78 85 87 88 86 87 84 89 90 94 - 92 91 96 93 98 96 92 95 100 97 94 97 102 104 101 99 100 96 - 98 103 106 108 105 110 104 102 107 109 114 112 111 110 113 116 106 108 - 115 113 120 118 116 119 117 124 112 112 114 115 121 123 130 128 126 125 - 124 122 123 120 127 132 129 131 134 136 130 128 124 126 133 138 137 136 - 135 134 130 132 139 138 140 142 138 136 141 142 144 146 143 145 148 150 - 145 152 154 147 149 148 150 144 153 151 158 160 156 157 155 154 152 159 - 164 162 163 161 160 158 156 165 166 168 167 170 164 162 169 174 172 173 - 171 176 170 168 175 176 180 178 177 179 176 174 181 180 184 186 182 183 - 180 187 185 192 190 189 188 187 186 184 193 191 195 194 196 198 192 190 - 197 202 200 199 201 198 204 196 205 203 208 206 207 204 209 209 210 222 - 223 226 227 232 231 238 235 234 237 244 243 247 247 251 254 257 - 0.999850000000000 1.500000000000000E-004 0.999998700000000 - 1.300000000000000E-006 0.925800000000000 7.420000000000000E-002 - 1.00000000000000 0.802200000000000 0.197800000000000 - 0.988900000000000 1.110000000000000E-002 0.996300000000000 - 3.700000000000000E-003 0.997590000000000 2.040000000000000E-003 - 3.700000000000000E-004 1.00000000000000 0.911335258510691 - 8.840713792415629E-002 2.576035651531538E-004 1.00000000000000 - 0.787000000000000 0.111700000000000 0.101300000000000 - 1.00000000000000 0.922029826844160 4.704233810429386E-002 - 3.092783505154639E-002 1.00000000000000 0.950057003420205 - 4.220253215192912E-002 7.600456027361642E-003 1.400084005040303E-004 - 0.755300000000000 0.244700000000000 0.996000000000000 - 3.370000000000000E-003 6.300000000000000E-004 0.931076348260557 - 6.880564206264915E-002 1.180096767934971E-004 0.967757069986124 - 2.079319604300388E-002 6.448586002775087E-003 1.856713616898090E-003 - 1.796819629256216E-003 1.347614721942162E-003 1.00000000000000 - 0.739400000000000 7.929999999999998E-002 7.279999999999999E-002 - 5.509999999999999E-002 5.339999999999999E-002 0.997600000000000 - 2.400000000000000E-003 0.837600000000000 9.550000000000000E-002 - 4.310000000000000E-002 2.380000000000000E-002 1.00000000000000 - 0.916600000000000 5.820000000000000E-002 2.190000000000000E-002 - 3.300000000000000E-003 1.00000000000000 0.682740000000000 - 0.260950000000000 3.593000000000000E-002 1.134000000000000E-002 - 9.039999999999999E-003 0.690900000000000 0.309100000000000 - 0.486847389558233 0.279216867469880 0.186445783132530 - 4.126506024096385E-002 6.224899598393573E-003 0.604000000000000 - 0.396000000000000 0.365363463653635 0.274272572742726 - 0.205179482051795 7.759224077592240E-002 7.759224077592240E-002 - 1.00000000000000 0.498200000000000 0.235200000000000 - 9.190000000000000E-002 9.020000000000000E-002 7.580000000000001E-002 - 8.699999999999999E-003 0.505400000000000 0.494600000000000 - 0.569000000000000 0.173700000000000 0.115600000000000 - 0.115500000000000 2.270000000000000E-002 3.499999999999999E-003 - 0.721500000000000 0.278500000000000 0.825600000000000 - 9.859999999999999E-002 7.020000000000000E-002 5.600000000000001E-003 - 1.00000000000000 0.514600000000000 0.174000000000000 - 0.171100000000000 0.112300000000000 2.799999999999999E-002 - 1.00000000000000 0.237800000000000 0.165300000000000 - 0.158400000000000 0.157200000000000 9.630000000000001E-002 - 9.460000000000000E-002 9.039999999999999E-002 1.00000000000000 - 0.316163232646529 0.185837167433487 0.170734146829366 - 0.127225445089018 0.126225245049010 5.511102220444088E-002 - 1.870374074814963E-002 1.00000000000000 0.273272672732727 - 0.267073292670733 0.222277772222778 0.118088191180882 - 0.109689031096890 9.599040095990399E-003 0.518200000000000 - 0.481800000000000 0.288571142885711 0.240675932406759 - 0.127487251274873 0.123887611238876 0.122587741225877 - 7.579242075792421E-002 1.219878012198780E-002 8.799120087991200E-003 - 0.957200000000000 4.280000000000000E-002 0.328500000000000 - 0.240300000000000 0.143000000000000 8.580000000000000E-002 - 7.610000000000000E-002 5.940000000000000E-002 4.720000000000000E-002 - 9.599999999999999E-003 6.600000000000000E-003 3.500000000000000E-003 - 0.572500000000000 0.427500000000000 0.344803448034480 - 0.317903179031790 0.187101871018710 6.990069900699007E-002 - 4.610046100461004E-002 2.460024600246002E-002 8.700087000870008E-003 - 8.900089000890008E-004 1.00000000000000 0.268883866967982 - 0.264384136951783 0.211787292762434 0.104393736375817 - 8.869467831930082E-002 4.079755214687118E-002 1.919884806911585E-002 - 9.599424034557925E-004 8.999460032398054E-004 1.00000000000000 - 0.716614332286646 0.113202264045281 7.810156203124062E-002 - 6.590131802636053E-002 2.420048400968019E-002 1.010020200404008E-003 - 9.700194003880077E-004 0.999110000000000 8.899999999999999E-004 - 0.884861940335823 0.110707749542468 2.500175012250857E-003 - 1.930135109457662E-003 1.00000000000000 0.270019920318725 - 0.237549800796813 0.175498007968127 0.121215139442231 - 8.266932270916334E-002 5.707171314741035E-002 5.597609561752987E-002 - 1.00000000000000 0.267200000000000 0.227100000000000 - 0.149700000000000 0.138300000000000 0.112400000000000 - 7.439999999999999E-002 3.089999999999999E-002 0.521800000000000 - 0.478200000000000 0.248700000000000 0.219000000000000 - 0.204700000000000 0.156800000000000 0.147300000000000 - 2.149999999999999E-002 2.000000000000000E-003 1.00000000000000 - 0.279557945278864 0.253268784349517 0.247713339021051 - 0.187297871073987 2.271780321819011E-002 8.928394277891312E-003 - 5.158627805003868E-004 1.00000000000000 0.334113364534581 - 0.270710828433137 0.229409176367055 0.148805952238090 - 1.560062402496100E-002 1.360054402176087E-003 1.00000000000000 - 0.318415920796040 0.218210910545527 0.161308065403270 - 0.143107155357768 0.127306365318266 3.030151507575378E-002 - 1.350067503375169E-003 0.974100000000000 2.590000000000000E-002 - 0.352364763523648 0.271372862713729 0.184981501849815 - 0.137486251374862 5.199480051994800E-002 1.799820017998200E-003 - 0.999877000368999 1.229996310011070E-004 0.306400000000000 - 0.284100000000000 0.264100000000000 0.144000000000000 - 1.400000000000000E-003 0.625000000000000 0.375000000000000 - 0.403555555555556 0.266666666666667 0.162626262626263 - 0.134343434343434 1.656565656565656E-002 1.606060606060606E-002 - 1.818181818181818E-004 0.626000000000000 0.374000000000000 - 0.337990874246395 0.328991117239835 0.252993169184432 - 7.209805335255949E-002 7.799789405686048E-003 1.269965710925805E-004 - 1.00000000000000 0.297982121072736 0.231286122832630 - 0.168389896606204 0.132192068475891 0.100193988360698 - 6.849589024658520E-002 1.459912405255685E-003 0.705000000000000 - 0.295000000000000 0.523104620924185 0.236047209441888 - 0.226045209041808 1.480296059211842E-002 1.00000000000000 - 1.00000000000000 1.00000000000000 1.00000000000000 - 1.00000000000000 1.00000000000000 1.00000000000000 - 1.00000000000000 1.00000000000000 0.992254260156914 - 7.196042176802758E-003 5.496976662835440E-004 1.00000000000000 - 1.00000000000000 1.00000000000000 1.00000000000000 - 1.00000000000000 1.00000000000000 1.00000000000000 - 1.00000000000000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 5.155720000000000E-025 6.352660000000000E-028 0.000000000000000E+000 - 2.206280000000000E-024 1.074000000000000E-026 3.268510000000000E-003 - 5.313590000000000E-024 5.741770000000000E-026 7.364860000000000E-003 - 1.011680000000000E-023 1.917390000000000E-025 1.290260000000000E-002 - 1.693820000000000E-023 4.948320000000000E-025 2.003300000000000E-002 - 2.614920000000000E-023 1.085180000000000E-024 2.861950000000000E-002 - 3.817710000000000E-023 2.127230000000000E-024 3.864270000000000E-002 - 5.351240000000000E-023 3.841620000000000E-024 5.006100000000000E-002 - 7.271770000000000E-023 6.517220000000000E-024 6.284210000000000E-002 - 9.643750000000000E-023 1.052530000000000E-023 7.694360000000000E-002 - 1.254090000000000E-022 1.633610000000000E-023 9.232970000000000E-002 - 1.604740000000000E-022 2.453840000000000E-023 0.108963000000000 - 2.025950000000000E-022 3.586240000000000E-023 0.126807000000000 - 2.528670000000000E-022 5.120600000000000E-023 0.145824000000000 - 3.125390000000000E-022 7.166590000000000E-023 0.165979000000000 - 3.830320000000000E-022 9.857380000000000E-023 0.187236000000000 - 4.659630000000000E-022 1.335380000000000E-022 0.209560000000000 - 5.631680000000000E-022 1.784910000000000E-022 0.232915000000000 - 6.767310000000000E-022 2.357490000000000E-022 0.257269000000000 - 8.090190000000000E-022 3.080720000000000E-022 0.282588000000000 - 9.627150000000000E-022 3.987420000000000E-022 0.308839000000000 - 1.140860000000000E-021 5.116500000000000E-022 0.335990000000000 - 1.346890000000000E-021 6.513920000000000E-022 0.364010000000000 - 1.584700000000000E-021 8.233900000000000E-022 0.392867000000000 - 1.858710000000000E-021 1.034020000000000E-021 0.422532000000000 - 2.173890000000000E-021 1.290760000000000E-021 0.452976000000000 - 2.535880000000000E-021 1.602390000000000E-021 0.484169000000000 - 2.951020000000000E-021 1.979130000000000E-021 0.516085000000000 - 3.426510000000000E-021 2.432970000000000E-021 0.548696000000000 - 3.970430000000000E-021 2.977830000000000E-021 0.581975000000000 - 4.591930000000000E-021 3.629910000000000E-021 0.615897000000000 - 5.301320000000000E-021 4.408080000000000E-021 0.650438000000000 - 6.110190000000000E-021 5.334170000000000E-021 0.685572000000000 - 7.031620000000000E-021 6.433510000000000E-021 0.721278000000000 - 8.080359999999999E-021 7.735410000000000E-021 0.757531000000000 - 9.272980000000001E-021 9.273750000000000E-021 0.794311000000000 - 1.062820000000000E-020 1.108770000000000E-020 0.831596000000000 - 1.216690000000000E-020 1.322230000000000E-020 0.869366000000000 - 1.391280000000000E-020 1.572970000000000E-020 0.907601000000000 - 1.589240000000000E-020 1.866970000000000E-020 0.946281000000000 - 1.813550000000000E-020 2.211120000000000E-020 0.985390000000000 - 2.067580000000000E-020 2.613350000000000E-020 1.02491000000000 - 2.355090000000000E-020 3.082750000000000E-020 1.06482000000000 - 2.680310000000000E-020 3.629760000000000E-020 1.10511000000000 - 3.048000000000000E-020 4.266350000000000E-020 1.14576000000000 - 3.463490000000000E-020 5.006250000000000E-020 1.18675000000000 - 3.932760000000000E-020 5.865150000000000E-020 1.22808000000000 - 4.462540000000000E-020 6.861040000000000E-020 1.26972000000000 - 5.060360000000000E-020 8.014490000000001E-020 1.31166000000000 - 5.734670000000000E-020 9.348980000000000E-020 1.35390000000000 - 6.494960000000000E-020 1.089140000000000E-019 1.39642000000000 - 7.351840000000000E-020 1.267230000000000E-019 1.43920000000000 - 8.317220000000000E-020 1.472680000000000E-019 1.48224000000000 - 9.404460000000000E-020 1.709460000000000E-019 1.52552000000000 - 1.062850000000000E-019 1.982130000000000E-019 1.56904000000000 - 1.200610000000000E-019 2.295870000000000E-019 1.61278000000000 - 1.355600000000000E-019 2.656570000000000E-019 1.65674000000000 - 1.529920000000000E-019 3.070940000000000E-019 1.70090000000000 - 1.725920000000000E-019 3.546630000000000E-019 1.74526000000000 - 1.946240000000000E-019 4.092320000000000E-019 1.78980000000000 - 2.193830000000000E-019 4.717880000000000E-019 1.83453000000000 - 2.471970000000000E-019 5.434540000000000E-019 1.87943000000000 - 2.784370000000000E-019 6.255030000000000E-019 1.92450000000000 - 3.135140000000000E-019 7.193820000000000E-019 1.96973000000000 - 3.528910000000000E-019 8.267340000000000E-019 2.01510000000000 - 3.970840000000000E-019 9.494210000000001E-019 2.06063000000000 - 4.466700000000000E-019 1.089560000000000E-018 2.10629000000000 - 5.022950000000000E-019 1.249540000000000E-018 2.15209000000000 - 5.646810000000000E-019 1.432080000000000E-018 2.19802000000000 - 6.346350000000000E-019 1.640260000000000E-018 2.24407000000000 - 7.130580000000000E-019 1.877560000000000E-018 2.29024000000000 - 8.009570000000000E-019 2.147930000000000E-018 2.33652000000000 - 8.994600000000000E-019 2.455830000000000E-018 2.38291000000000 - 1.009820000000000E-018 2.806320000000000E-018 2.42941000000000 - 1.133450000000000E-018 3.205130000000000E-018 2.47601000000000 - 1.271920000000000E-018 3.658710000000000E-018 2.52270000000000 - 1.426980000000000E-018 4.174370000000000E-018 2.56949000000000 - 1.600580000000000E-018 4.760400000000000E-018 2.61636000000000 - 1.794910000000000E-018 5.426130000000000E-018 2.66332000000000 - 2.012430000000000E-018 6.182120000000000E-018 2.71037000000000 - 2.255830000000000E-018 7.040290000000000E-018 2.75749000000000 - 2.528180000000000E-018 8.014109999999999E-018 2.80469000000000 - 2.832870000000000E-018 9.118780000000000E-018 2.85197000000000 - 3.173680000000000E-018 1.037150000000000E-017 2.89931000000000 - 3.554850000000000E-018 1.179150000000000E-017 2.94672000000000 - 3.981080000000000E-018 1.340080000000000E-017 2.99420000000000 - 4.457660000000000E-018 1.522400000000000E-017 3.04174000000000 - 4.990440000000000E-018 1.728880000000000E-017 3.08934000000000 - 5.585990000000000E-018 1.962660000000000E-017 3.13700000000000 - 6.251610000000000E-018 2.227280000000000E-017 3.18472000000000 - 6.995440000000000E-018 2.526710000000000E-017 3.23250000000000 - 7.826600000000000E-018 2.865450000000000E-017 3.28032000000000 - 8.755199999999999E-018 3.248550000000000E-017 3.32820000000000 - 9.792559999999999E-018 3.681690000000000E-017 3.37612000000000 - 1.095130000000000E-017 4.171310000000000E-017 3.42410000000000 - 1.224540000000000E-017 4.724620000000000E-017 3.47211000000000 - 1.369060000000000E-017 5.349740000000000E-017 3.52018000000000 - 1.530440000000000E-017 6.055840000000000E-017 3.56828000000000 - 1.710610000000000E-017 6.853210000000001E-017 3.61643000000000 - 1.911760000000000E-017 7.753440000000000E-017 3.66462000000000 - 2.136290000000000E-017 8.769340000000001E-017 3.71263000000000 - 2.386910000000000E-017 9.916040000000000E-017 3.76091000000000 - 2.666610000000000E-017 1.120980000000000E-016 3.80923000000000 - 2.978750000000000E-017 1.266920000000000E-016 3.85758000000000 - 3.327050000000000E-017 1.431510000000000E-016 3.90596000000000 - 3.715670000000000E-017 1.617090000000000E-016 3.95438000000000 - 4.149220000000000E-017 1.826300000000000E-016 4.00283000000000 - 4.632870000000000E-017 2.062100000000000E-016 4.05130000000000 - 5.172360000000000E-017 2.327820000000000E-016 4.09981000000000 - 5.774079999999999E-017 2.627210000000000E-016 4.14835000000000 - 6.445160000000000E-017 2.964450000000000E-016 4.19691000000000 - 7.193530000000000E-017 3.344280000000000E-016 4.24551000000000 - 8.028020000000000E-017 3.772000000000000E-016 4.29412000000000 - 8.958470000000000E-017 4.253550000000000E-016 4.34277000000000 - 9.995840000000001E-017 4.795620000000000E-016 4.39144000000000 - 1.115230000000000E-016 5.405720000000000E-016 4.44013000000000 - 1.244150000000000E-016 6.092260000000000E-016 4.48885000000000 - 1.387850000000000E-016 6.864710000000000E-016 4.53759000000000 - 1.548010000000000E-016 7.733660000000000E-016 4.58635000000000 - 1.726510000000000E-016 8.711040000000000E-016 4.63513000000000 - 1.925440000000000E-016 9.810190000000001E-016 4.68394000000000 - 2.147110000000000E-016 1.104610000000000E-015 4.73276000000000 - 2.394110000000000E-016 1.243560000000000E-015 4.78161000000000 - 2.669310000000000E-016 1.399750000000000E-015 4.83047000000000 - 2.975930000000000E-016 1.575300000000000E-015 4.87936000000000 - 3.317500000000000E-016 1.772580000000000E-015 4.92826000000000 - 3.698020000000000E-016 1.994240000000000E-015 4.97719000000000 - 4.121870000000000E-016 2.243270000000000E-015 5.02612000000000 - 4.593980000000000E-016 2.523020000000000E-015 5.07508000000000 - 5.119790000000000E-016 2.837220000000000E-015 5.12406000000000 - 5.705400000000000E-016 3.190070000000000E-015 5.17305000000000 - 6.357550000000000E-016 3.586280000000000E-015 5.22205000000000 - 7.083770000000000E-016 4.031120000000000E-015 5.27108000000000 - 7.892430000000000E-016 4.530500000000000E-015 5.32011000000000 - 8.792820000000000E-016 5.091040000000000E-015 5.36917000000000 - 9.795310000000000E-016 5.720150000000000E-015 5.41823000000000 - 1.091140000000000E-015 6.426130000000000E-015 5.46732000000000 - 1.215390000000000E-015 7.218290000000000E-015 5.51641000000000 - 1.353710000000000E-015 8.107039999999999E-015 5.56552000000000 - 1.507680000000000E-015 9.104050000000000E-015 5.61465000000000 - 1.679060000000000E-015 1.022240000000000E-014 5.66378000000000 - 1.869810000000000E-015 1.147670000000000E-014 5.71293000000000 - 2.082120000000000E-015 1.288330000000000E-014 5.76209000000000 - 2.318400000000000E-015 1.446060000000000E-014 5.81127000000000 - 2.581350000000000E-015 1.622900000000000E-014 5.86045000000000 - 2.873960000000000E-015 1.821160000000000E-014 5.90965000000000 - 3.199570000000000E-015 2.043400000000000E-014 5.95886000000000 - 3.561880000000000E-015 2.292510000000000E-014 6.00808000000000 - 3.965010000000000E-015 2.571700000000000E-014 6.05731000000000 - 4.413540000000000E-015 2.884560000000000E-014 6.10655000000000 - 4.912560000000000E-015 3.235150000000000E-014 6.15581000000000 - 5.467720000000000E-015 3.627950000000000E-014 6.20507000000000 - 6.085320000000000E-015 4.068010000000000E-014 6.25434000000000 - 6.772350000000000E-015 4.560990000000000E-014 6.30363000000000 - 7.536580000000001E-015 5.113180000000000E-014 6.35292000000000 - 8.386650000000000E-015 5.731639999999999E-014 6.40222000000000 - 9.332170000000000E-015 6.424270000000001E-014 6.45153000000000 - 1.038380000000000E-014 7.199890000000000E-014 6.50085000000000 - 1.155340000000000E-014 8.068380000000000E-014 6.55018000000000 - 1.285420000000000E-014 9.040770000000000E-014 6.59952000000000 - 1.430080000000000E-014 1.012940000000000E-013 6.64887000000000 - 1.590950000000000E-014 1.134810000000000E-013 6.69822000000000 - 1.769840000000000E-014 1.271220000000000E-013 6.74759000000000 - 1.968760000000000E-014 1.423890000000000E-013 6.79696000000000 - 2.189940000000000E-014 1.594770000000000E-013 6.84634000000000 - 2.435870000000000E-014 1.785990000000000E-013 6.89573000000000 - 2.709310000000000E-014 1.999970000000000E-013 6.94512000000000 - 3.013320000000000E-014 2.239390000000000E-013 6.99453000000000 - 3.351310000000000E-014 2.507270000000000E-013 7.04394000000000 - 3.727070000000000E-014 2.806950000000000E-013 7.09336000000000 - 4.144790000000000E-014 3.142190000000000E-013 7.14278000000000 - 4.609150000000000E-014 3.517180000000000E-013 7.19221000000000 - 5.125350000000000E-014 3.936610000000000E-013 7.24165000000000 - 5.699130000000000E-014 4.405710000000000E-013 7.29110000000000 - 6.336920000000000E-014 4.930310000000000E-013 7.34055000000000 - 7.045820000000001E-014 5.516960000000000E-013 7.39001000000000 - 7.833750000000001E-014 6.172940000000000E-013 7.43947000000000 - 8.709470000000000E-014 6.906400000000000E-013 7.48894000000000 - 9.682750000000000E-014 7.726430000000000E-013 7.53842000000000 - 1.076440000000000E-013 8.643190000000000E-013 7.58791000000000 - 1.196650000000000E-013 9.668000000000001E-013 7.63740000000000 - 1.330240000000000E-013 1.081360000000000E-012 7.68689000000000 - 1.478680000000000E-013 1.209400000000000E-012 7.73639000000000 - 1.643650000000000E-013 1.352510000000000E-012 7.78590000000000 - 1.826950000000000E-013 1.512450000000000E-012 7.83541000000000 - 2.030630000000000E-013 1.691190000000000E-012 7.88493000000000 - 2.256940000000000E-013 1.890920000000000E-012 7.93445000000000 - 2.508400000000000E-013 2.114100000000000E-012 7.98398000000000 - 2.787780000000000E-013 2.363460000000000E-012 8.03352000000000 - 3.098190000000000E-013 2.642070000000000E-012 8.08306000000000 - 3.443050000000000E-013 2.953320000000000E-012 8.13260000000000 - 3.826180000000000E-013 3.301030000000000E-012 8.18215000000000 - 4.251820000000000E-013 3.689440000000000E-012 8.23170000000000 - 4.724660000000000E-013 4.123290000000000E-012 8.28126000000000 - 5.249940000000000E-013 4.607880000000000E-012 8.33082000000000 - 5.833440000000000E-013 5.149110000000000E-012 8.38039000000000 - 6.481610000000000E-013 5.753550000000000E-012 8.42997000000000 - 7.201590000000000E-013 6.428570000000000E-012 8.47954000000000 - 8.001330000000000E-013 7.182350000000000E-012 8.52912000000000 - 8.889620000000000E-013 8.024039999999999E-012 8.57871000000000 - 9.876250000000000E-013 8.963859999999999E-012 8.62830000000000 - 1.097210000000000E-012 1.001320000000000E-011 8.67789000000000 - 1.218920000000000E-012 1.118470000000000E-011 8.72749000000000 - 1.354090000000000E-012 1.249260000000000E-011 8.77710000000000 - 1.504220000000000E-012 1.395260000000000E-011 8.82670000000000 - 1.670940000000000E-012 1.558240000000000E-011 8.87631000000000 - 1.856100000000000E-012 1.740160000000000E-011 8.92593000000000 - 2.061720000000000E-012 1.943220000000000E-011 8.97555000000000 - 2.290060000000000E-012 2.169860000000000E-011 9.02517000000000 - 2.543630000000000E-012 2.422800000000000E-011 9.07480000000000 - 2.825200000000000E-012 2.705090000000000E-011 9.12442000000000 - 3.137860000000000E-012 3.020110000000000E-011 9.17406000000000 - 3.485040000000000E-012 3.371640000000000E-011 9.22370000000000 - 3.870540000000000E-012 3.763910000000000E-011 9.27334000000000 - 4.298570000000000E-012 4.201590000000000E-011 9.32298000000000 - 4.773830000000000E-012 4.689940000000000E-011 9.37263000000000 - 5.301510000000000E-012 5.234790000000000E-011 9.42228000000000 - 5.887380000000000E-012 5.842660000000000E-011 9.47193000000000 - 6.537840000000000E-012 6.520790000000000E-011 9.52159000000000 - 7.260010000000000E-012 7.277290000000000E-011 9.57125000000000 - 8.061750000000000E-012 8.121160000000000E-011 9.62091000000000 - 8.951840000000000E-012 9.062460000000000E-011 9.67058000000000 - 9.939980000000000E-012 1.011240000000000E-010 9.72025000000000 - 1.103690000000000E-011 1.128350000000000E-010 9.76993000000000 - 1.225470000000000E-011 1.258960000000000E-010 9.81960000000000 - 1.360650000000000E-011 1.404620000000000E-010 9.86928000000000 - 1.510720000000000E-011 1.567070000000000E-010 9.91896000000000 - 1.677290000000000E-011 1.748230000000000E-010 9.96865000000000 - 1.862200000000000E-011 1.950250000000000E-010 10.0183000000000 - 2.067450000000000E-011 2.175520000000000E-010 10.0680000000000 - 2.295270000000000E-011 2.426700000000000E-010 10.1177000000000 - 2.548140000000000E-011 2.706770000000000E-010 10.1674000000000 - 2.828820000000000E-011 3.019030000000000E-010 10.2171000000000 - 3.140340000000000E-011 3.367180000000000E-010 10.2668000000000 - 3.486110000000000E-011 3.755310000000000E-010 10.3165000000000 - 3.869870000000000E-011 4.188020000000000E-010 10.3662000000000 - 4.295790000000000E-011 4.670390000000000E-010 10.4159000000000 - 4.768500000000000E-011 5.208120000000000E-010 10.4656000000000 - 5.293120000000000E-011 5.807520000000000E-010 10.5154000000000 - 5.875350000000000E-011 6.475650000000000E-010 10.5651000000000 - 6.521490000000000E-011 7.220360000000000E-010 10.6148000000000 - 7.238569999999999E-011 8.050400000000000E-010 10.6645000000000 - 8.034330000000000E-011 8.975520000000000E-010 10.7142000000000 - 8.917420000000000E-011 1.000660000000000E-009 10.7640000000000 - 9.897390000000000E-011 1.115560000000000E-009 10.8137000000000 - 1.098490000000000E-010 1.243610000000000E-009 10.8634000000000 - 1.219160000000000E-010 1.386320000000000E-009 10.9132000000000 - 1.353060000000000E-010 1.545330000000000E-009 10.9629000000000 - 1.501650000000000E-010 1.722530000000000E-009 11.0126000000000 - 1.666520000000000E-010 1.919970000000000E-009 11.0624000000000 - 1.849470000000000E-010 2.139970000000000E-009 11.1121000000000 - 2.052460000000000E-010 2.385090000000000E-009 11.1619000000000 - 2.277690000000000E-010 2.658190000000000E-009 11.2116000000000 - 2.527590000000000E-010 2.962460000000000E-009 11.2614000000000 - 2.804870000000000E-010 3.301450000000000E-009 11.3111000000000 - 3.112510000000000E-010 3.679090000000000E-009 11.3609000000000 - 3.453840000000000E-010 4.099790000000000E-009 11.4106000000000 - 3.832540000000000E-010 4.568450000000000E-009 11.4604000000000 - 4.252690000000000E-010 5.090500000000000E-009 11.5101000000000 - 4.718830000000000E-010 5.672020000000000E-009 11.5599000000000 - 5.235970000000000E-010 6.319770000000000E-009 11.6097000000000 - 5.809690000000000E-010 7.041250000000000E-009 11.6594000000000 - 6.446180000000000E-010 7.844840000000000E-009 11.7092000000000 - 7.152290000000000E-010 8.739870000000001E-009 11.7589000000000 - 7.935620000000000E-010 9.736690000000000E-009 11.8087000000000 - 8.804610000000000E-010 1.084690000000000E-008 11.8585000000000 - 9.768610000000000E-010 1.208320000000000E-008 11.9083000000000 - 1.083800000000000E-009 1.346010000000000E-008 11.9580000000000 - 1.202430000000000E-009 1.499340000000000E-008 12.0078000000000 - 1.334020000000000E-009 1.670080000000000E-008 12.0576000000000 - 1.479990000000000E-009 1.860220000000000E-008 12.1074000000000 - 1.641910000000000E-009 2.071930000000000E-008 12.1572000000000 - 1.821510000000000E-009 2.307670000000000E-008 12.2069000000000 - 2.020740000000000E-009 2.570160000000000E-008 12.2567000000000 - 2.241720000000000E-009 2.862420000000000E-008 12.3065000000000 - 2.486830000000000E-009 3.187810000000000E-008 12.3563000000000 - 2.758700000000000E-009 3.550100000000000E-008 12.4061000000000 - 3.060260000000000E-009 3.953440000000000E-008 12.4559000000000 - 3.394730000000000E-009 4.402480000000000E-008 12.5057000000000 - 3.765700000000000E-009 4.902380000000000E-008 12.5555000000000 - 4.177160000000000E-009 5.458890000000000E-008 12.6053000000000 - 4.633510000000000E-009 6.078400000000000E-008 12.6551000000000 - 5.139640000000000E-009 6.768030000000000E-008 12.7049000000000 - 5.700990000000000E-009 7.535700000000000E-008 12.7547000000000 - 6.323560000000000E-009 8.390210000000000E-008 12.8045000000000 - 7.014030000000000E-009 9.341360000000000E-008 12.8543000000000 - 7.779790000000000E-009 1.040000000000000E-007 12.9041000000000 - 8.629030000000000E-009 1.157840000000000E-007 12.9539000000000 - 9.570860000000000E-009 1.288990000000000E-007 13.0037000000000 - 1.061530000000000E-008 1.434970000000000E-007 13.0535000000000 - 1.177370000000000E-008 1.597430000000000E-007 13.1033000000000 - 1.305820000000000E-008 1.778230000000000E-007 13.1531000000000 - 1.448270000000000E-008 1.979450000000000E-007 13.2029000000000 - 1.606250000000000E-008 2.203380000000000E-007 13.2527000000000 - 1.781430000000000E-008 2.452580000000000E-007 13.3026000000000 - 1.975690000000000E-008 2.729900000000000E-007 13.3524000000000 - 2.191110000000000E-008 3.038500000000000E-007 13.4022000000000 - 2.429990000000000E-008 3.381900000000000E-007 13.4520000000000 - 2.694870000000000E-008 3.764010000000000E-007 13.5018000000000 - 2.988600000000000E-008 4.189190000000000E-007 13.5516000000000 - 3.314310000000000E-008 4.662290000000000E-007 13.6015000000000 - 3.675460000000000E-008 5.188690000000000E-007 13.6513000000000 - 4.075920000000000E-008 5.774380000000000E-007 13.7011000000000 - 4.519970000000000E-008 6.426030000000000E-007 13.7509000000000 - 5.012320000000000E-008 7.151050000000000E-007 13.8008000000000 - 5.558250000000000E-008 7.957680000000000E-007 13.8506000000000 - 6.163569999999999E-008 8.855100000000000E-007 13.9004000000000 - 6.834730000000000E-008 9.853469999999999E-007 13.9503000000000 - 7.578890000000000E-008 1.096420000000000E-006 14.0001000000000 - 8.403990000000000E-008 1.219980000000000E-006 14.0499000000000 - 9.318800000000000E-008 1.357430000000000E-006 14.0998000000000 - 1.033310000000000E-007 1.510340000000000E-006 14.1496000000000 - 1.145760000000000E-007 1.680430000000000E-006 14.1994000000000 - 1.270440000000000E-007 1.869640000000000E-006 14.2493000000000 - 1.408680000000000E-007 2.080100000000000E-006 14.2991000000000 - 1.561930000000000E-007 2.314210000000000E-006 14.3490000000000 - 1.731840000000000E-007 2.574600000000000E-006 14.3988000000000 - 1.920220000000000E-007 2.864240000000000E-006 14.4486000000000 - 2.129060000000000E-007 3.186380000000000E-006 14.4985000000000 - 2.360590000000000E-007 3.544680000000000E-006 14.5483000000000 - 2.617270000000000E-007 3.943190000000000E-006 14.5982000000000 - 2.901830000000000E-007 4.386410000000000E-006 14.6480000000000 - 3.217290000000000E-007 4.879340000000000E-006 14.6979000000000 - 3.567020000000000E-007 5.427550000000000E-006 14.7477000000000 - 3.954720000000000E-007 6.037220000000000E-006 14.7976000000000 - 4.384520000000000E-007 6.715240000000000E-006 14.8474000000000 - 4.860970000000000E-007 7.469260000000000E-006 14.8973000000000 - 5.389150000000000E-007 8.307759999999999E-006 14.9471000000000 - 5.974660000000000E-007 9.240210000000001E-006 14.9970000000000 - 6.623720000000000E-007 1.027710000000000E-005 15.0468000000000 - 7.343220000000000E-007 1.143010000000000E-005 15.0967000000000 - 8.140800000000000E-007 1.271230000000000E-005 15.1465000000000 - 9.024910000000000E-007 1.413790000000000E-005 15.1964000000000 - 1.000490000000000E-006 1.572320000000000E-005 15.2462000000000 - 1.109130000000000E-006 1.748580000000000E-005 15.2961000000000 - 1.229550000000000E-006 1.944570000000000E-005 15.3460000000000 - 1.363030000000000E-006 2.162490000000000E-005 15.3958000000000 - 1.510990000000000E-006 2.404770000000000E-005 15.4457000000000 - 1.674990000000000E-006 2.674160000000000E-005 15.4955000000000 - 1.856780000000000E-006 2.973660000000000E-005 15.5454000000000 - 2.058280000000000E-006 3.306640000000000E-005 15.5953000000000 - 2.281620000000000E-006 3.676840000000000E-005 15.6451000000000 - 2.529170000000000E-006 4.088410000000000E-005 15.6950000000000 - 2.803560000000000E-006 4.545970000000000E-005 15.7449000000000 - 3.107690000000000E-006 5.054640000000000E-005 15.7947000000000 - 3.444780000000000E-006 5.620120000000000E-005 15.8446000000000 - 3.818410000000000E-006 6.248749999999999E-005 15.8945000000000 - 4.232510000000000E-006 6.947580000000000E-005 15.9443000000000 - 4.691490000000000E-006 7.724410000000000E-005 15.9942000000000 - 5.200190000000000E-006 8.587960000000000E-005 16.0441000000000 - 5.764000000000000E-006 9.547870000000000E-005 16.0939000000000 - 6.388890000000000E-006 1.061490000000000E-004 16.1438000000000 - 7.081460000000000E-006 1.180090000000000E-004 16.1937000000000 - 7.849040000000000E-006 1.311930000000000E-004 16.2435000000000 - 8.699749999999999E-006 1.458470000000000E-004 16.2934000000000 - 9.642569999999999E-006 1.621340000000000E-004 16.3433000000000 - 1.068750000000000E-005 1.802380000000000E-004 16.3932000000000 - 1.184550000000000E-005 2.003600000000000E-004 16.4430000000000 - 1.312900000000000E-005 2.227240000000000E-004 16.4929000000000 - 1.455130000000000E-005 2.475800000000000E-004 16.5428000000000 - 1.612760000000000E-005 2.752060000000000E-004 16.5927000000000 - 1.787460000000000E-005 3.059090000000000E-004 16.6426000000000 - 1.981060000000000E-005 3.400320000000000E-004 16.6924000000000 - 2.195610000000000E-005 3.779550000000000E-004 16.7423000000000 - 2.433380000000000E-005 4.201000000000000E-004 16.7922000000000 - 2.696870000000000E-005 4.669380000000000E-004 16.8421000000000 - 2.988880000000000E-005 5.189890000000000E-004 16.8920000000000 - 3.312480000000000E-005 5.768330000000000E-004 16.9418000000000 - 3.671080000000000E-005 6.411140000000000E-004 16.9917000000000 - 4.068470000000000E-005 7.125470000000000E-004 17.0416000000000 - 4.508840000000000E-005 7.919260000000000E-004 17.0915000000000 - 4.996850000000000E-005 8.801340000000000E-004 17.1414000000000 - 5.537620000000000E-005 9.781519999999999E-004 17.1913000000000 - 6.136880000000000E-005 1.087070000000000E-003 17.2411000000000 - 6.800930000000000E-005 1.208100000000000E-003 17.2910000000000 - 7.536780000000000E-005 1.342580000000000E-003 17.3409000000000 - 8.352190000000000E-005 1.492000000000000E-003 17.3908000000000 - 9.255750000000000E-005 1.658040000000000E-003 17.4407000000000 - 1.025700000000000E-004 1.842520000000000E-003 17.4906000000000 - 1.136640000000000E-004 2.047490000000000E-003 17.5405000000000 - 1.259580000000000E-004 2.275240000000000E-003 17.5904000000000 - 1.395800000000000E-004 2.528280000000000E-003 17.6403000000000 - 1.546750000000000E-004 2.809420000000000E-003 17.6902000000000 - 1.714000000000000E-004 3.121780000000000E-003 17.7401000000000 - 1.899330000000000E-004 3.468810000000000E-003 17.7899000000000 - 2.104680000000000E-004 3.854370000000000E-003 17.8398000000000 - 2.332220000000000E-004 4.282710000000000E-003 17.8897000000000 - 2.584340000000000E-004 4.758600000000000E-003 17.9396000000000 - 2.863690000000000E-004 5.287290000000000E-003 17.9895000000000 - 3.173220000000000E-004 5.874630000000000E-003 18.0394000000000 - 3.516180000000000E-004 6.527120000000000E-003 18.0893000000000 - 3.896180000000000E-004 7.251990000000000E-003 18.1392000000000 - 4.317210000000000E-004 8.057230000000000E-003 18.1891000000000 - 4.783720000000000E-004 8.951770000000000E-003 18.2390000000000 - 5.300590000000000E-004 9.945490000000000E-003 18.2889000000000 - 5.873270000000000E-004 1.104940000000000E-002 18.3388000000000 - 6.507790000000000E-004 1.227560000000000E-002 18.3887000000000 - 7.210800000000000E-004 1.363770000000000E-002 18.4386000000000 - 7.989710000000000E-004 1.515080000000000E-002 18.4885000000000 - 8.852690000000001E-004 1.683140000000000E-002 18.5384000000000 - 9.808820000000000E-004 1.869830000000000E-002 18.5883000000000 - 1.086810000000000E-003 2.077200000000000E-002 18.6382000000000 - 1.204180000000000E-003 2.307530000000000E-002 18.6881000000000 - 1.334210000000000E-003 2.563380000000000E-002 18.7380000000000 - 1.478270000000000E-003 2.847550000000000E-002 18.7879000000000 - 1.637880000000000E-003 3.163180000000000E-002 18.8378000000000 - 1.814710000000000E-003 3.513740000000000E-002 18.8877000000000 - 2.010620000000000E-003 3.903120000000000E-002 18.9376000000000 - 2.227660000000000E-003 4.335580000000000E-002 18.9875000000000 - 2.468110000000000E-003 4.815900000000000E-002 19.0374000000000 - 2.734500000000000E-003 5.349360000000000E-002 19.0874000000000 - 3.029630000000000E-003 5.941840000000000E-002 19.1373000000000 - 3.356590000000000E-003 6.599850000000000E-002 19.1872000000000 - 3.718810000000000E-003 7.330639999999999E-002 19.2371000000000 - 4.120090000000000E-003 8.142260000000000E-002 19.2870000000000 - 4.564650000000000E-003 9.043619999999999E-002 19.3369000000000 - 5.057140000000000E-003 0.100446000000000 19.3868000000000 - 5.602740000000000E-003 0.111563000000000 19.4367000000000 - 6.207160000000000E-003 0.123909000000000 19.4866000000000 - 6.876740000000000E-003 0.137619000000000 19.5365000000000 - 7.618510000000000E-003 0.152844000000000 19.5865000000000 - 8.440240000000000E-003 0.169751000000000 19.6364000000000 - 9.350549999999999E-003 0.188527000000000 19.6863000000000 - 1.035900000000000E-002 0.209376000000000 19.7362000000000 - 1.147610000000000E-002 0.232529000000000 19.7861000000000 - 1.271360000000000E-002 0.258239000000000 19.8360000000000 - 1.408450000000000E-002 0.286788000000000 19.8859000000000 - 1.560310000000000E-002 0.318489000000000 19.9358000000000 - 1.728530000000000E-002 0.353691000000000 19.9857000000000 - 1.914880000000000E-002 0.392779000000000 20.0357000000000 - 2.121310000000000E-002 0.436181000000000 20.0856000000000 - 2.349980000000000E-002 0.484374000000000 20.1355000000000 - 2.603280000000000E-002 0.537885000000000 20.1854000000000 - 2.883870000000000E-002 0.597302000000000 20.2353000000000 - 3.194690000000000E-002 0.663274000000000 20.2852000000000 - 3.538990000000000E-002 0.736524000000000 20.3352000000000 - 3.920370000000000E-002 0.817855000000000 20.3851000000000 - 4.342820000000000E-002 0.908156000000000 20.4350000000000 - 4.810770000000000E-002 1.00842000000000 20.4849000000000 - 5.329120000000000E-002 1.11973000000000 20.5348000000000 - 5.903280000000000E-002 1.24332000000000 20.5848000000000 - 6.539270000000000E-002 1.38054000000000 20.6347000000000 - 7.243740000000000E-002 1.53289000000000 20.6846000000000 - 8.024060000000000E-002 1.70202000000000 20.7345000000000 - 8.888390000000000E-002 1.88980000000000 20.7844000000000 - 9.845780000000000E-002 2.09828000000000 20.8344000000000 - 0.109062000000000 2.32972000000000 20.8843000000000 - 0.120808000000000 2.58667000000000 20.9342000000000 - 0.133819000000000 2.87193000000000 20.9841000000000 - 0.148229000000000 3.18861000000000 21.0340000000000 - 0.164191000000000 3.54017000000000 21.0840000000000 - 0.181870000000000 3.93046000000000 21.1339000000000 - 0.201453000000000 4.36372000000000 21.1838000000000 - 0.223142000000000 4.84469000000000 21.2337000000000 - 0.247166000000000 5.37862000000000 21.2837000000000 - 0.273774000000000 5.97134000000000 21.3336000000000 - 0.303246000000000 6.62930000000000 21.3835000000000 - 0.335888000000000 7.35969000000000 21.4334000000000 - 0.372042000000000 8.17046000000000 21.4834000000000 - 0.412086000000000 9.07046000000000 21.5333000000000 - 0.456437000000000 10.0695000000000 21.5832000000000 - 0.505560000000000 11.1784000000000 21.6331000000000 - 0.559966000000000 12.4094000000000 21.6831000000000 - 0.620224000000000 13.7758000000000 21.7330000000000 - 0.686963000000000 15.2925000000000 21.7829000000000 - 0.760880000000000 16.9760000000000 21.8329000000000 - 0.842747000000000 18.8446000000000 21.8828000000000 - 0.933417000000000 20.9187000000000 21.9327000000000 - 1.03384000000000 23.2209000000000 21.9826000000000 - 1.14506000000000 25.7762000000000 22.0326000000000 - 1.26823000000000 28.6124000000000 22.0825000000000 - 1.40466000000000 31.7604000000000 22.1324000000000 - 1.55574000000000 35.2544000000000 22.1824000000000 - 1.72308000000000 39.1324000000000 22.2323000000000 - 1.90840000000000 43.4366000000000 22.2822000000000 - 2.11364000000000 48.2137000000000 22.3321000000000 - 2.34095000000000 53.5157000000000 22.3821000000000 - 2.59269000000000 59.4002000000000 22.4320000000000 - 2.87149000000000 65.9312000000000 22.4819000000000 - 3.18025000000000 73.1795000000000 22.5319000000000 - 3.52220000000000 81.2239000000000 22.5818000000000 - 3.90089000000000 90.1519000000000 22.6317000000000 - 4.32029000000000 100.060000000000 22.6817000000000 - 4.78475000000000 111.057000000000 22.7316000000000 - 5.29912000000000 123.260000000000 22.7815000000000 - 5.86876000000000 136.804000000000 22.8315000000000 - 6.49961000000000 151.834000000000 22.8814000000000 - 7.19824000000000 168.514000000000 22.9313000000000 - 7.97193000000000 187.025000000000 22.9813000000000 - 8.82874000000000 207.567000000000 23.0312000000000 - 9.77759000000000 230.364000000000 23.0811000000000 - 10.8284000000000 255.662000000000 23.1311000000000 - 11.9920000000000 283.735000000000 23.1810000000000 - 13.2807000000000 314.889000000000 23.2309000000000 - 14.7077000000000 349.460000000000 23.2809000000000 - 16.2881000000000 387.823000000000 23.3308000000000 - 18.0381000000000 430.395000000000 23.3808000000000 - 19.9762000000000 477.635000000000 23.4307000000000 - 22.1223000000000 530.055000000000 23.4806000000000 - 24.4989000000000 588.224000000000 23.5306000000000 - 27.1308000000000 652.771000000000 23.5805000000000 - 30.0452000000000 724.394000000000 23.6304000000000 - 33.2726000000000 803.870000000000 23.6804000000000 - 36.8465000000000 892.057000000000 23.7303000000000 - 40.8041000000000 989.910000000000 23.7803000000000 - 45.1866000000000 1098.49000000000 23.8302000000000 - 50.0396000000000 1218.97000000000 23.8801000000000 - 55.4135000000000 1352.65000000000 23.9301000000000 - 61.3644000000000 1500.97000000000 23.9800000000000 - 67.9541000000000 1665.55000000000 24.0300000000000 - 75.2511000000000 1848.16000000000 24.0799000000000 - 83.3313000000000 2050.78000000000 24.1298000000000 - 92.2787000000000 2275.59000000000 24.1798000000000 - 102.187000000000 2525.02000000000 24.2297000000000 - 113.158000000000 2801.77000000000 24.2797000000000 - 125.306000000000 3108.83000000000 24.3296000000000 - 138.758000000000 3449.51000000000 24.3795000000000 - 153.654000000000 3827.50000000000 24.4295000000000 - 170.148000000000 4246.87000000000 24.4794000000000 - 188.412000000000 4712.15000000000 24.5294000000000 - 208.636000000000 5228.37000000000 24.5793000000000 - 231.030000000000 5801.10000000000 24.6293000000000 - 255.826000000000 6436.52000000000 24.6792000000000 - 283.283000000000 7141.48000000000 24.7291000000000 - 313.685000000000 7923.58000000000 24.7791000000000 - 347.349000000000 8791.28000000000 24.8290000000000 - 384.624000000000 9753.92000000000 24.8790000000000 - 425.897000000000 10821.9000000000 24.9289000000000 - 471.597000000000 12006.7000000000 24.9789000000000 - 522.200000000000 13321.1000000000 25.0288000000000 - 578.230000000000 14779.3000000000 25.0788000000000 - 640.270000000000 16397.0000000000 25.1287000000000 - 708.963000000000 18191.7000000000 25.1786000000000 - 785.023000000000 20182.6000000000 25.2286000000000 - 869.240000000000 22391.2000000000 25.2785000000000 - 962.489000000000 24841.3000000000 25.3285000000000 - 1065.74000000000 27559.4000000000 25.3784000000000 - 1180.06000000000 30574.6000000000 25.4284000000000 - 1306.63000000000 33919.5000000000 25.4783000000000 - 1446.78000000000 37630.0000000000 25.5283000000000 - 1601.96000000000 41746.1000000000 25.5782000000000 - 1773.77000000000 46312.1000000000 25.6282000000000 - 1964.01000000000 51377.2000000000 25.6781000000000 - 2174.64000000000 56995.8000000000 25.7280000000000 - 2407.84000000000 63228.4000000000 25.7780000000000 - 2666.05000000000 70142.0000000000 25.8279000000000 - 2951.94000000000 77811.1000000000 25.8779000000000 - 3268.48000000000 86318.0000000000 25.9278000000000 - 3618.94000000000 95754.4000000000 25.9778000000000 - 4006.96000000000 106222.000000000 26.0277000000000 - 4436.58000000000 117832.000000000 26.0777000000000 - 4912.24000000000 130711.000000000 26.1276000000000 - 5438.88000000000 144996.000000000 26.1776000000000 - 6021.96000000000 160842.000000000 26.2275000000000 - 6667.53000000000 178418.000000000 26.2775000000000 - 7382.29000000000 197913.000000000 26.3274000000000 - 8173.62000000000 219536.000000000 26.3774000000000 - 9049.77000000000 243521.000000000 26.4273000000000 - 10019.8000000000 270124.000000000 26.4773000000000 - 11093.7000000000 299632.000000000 26.5272000000000 - 12282.8000000000 332360.000000000 26.5772000000000 - 13599.2000000000 368661.000000000 26.6271000000000 - 15056.7000000000 408925.000000000 26.6771000000000 - 16670.3000000000 453582.000000000 26.7270000000000 - 18456.8000000000 503113.000000000 26.7770000000000 - 20434.6000000000 558049.000000000 26.8269000000000 - 22624.4000000000 618980.000000000 26.8769000000000 - 25048.7000000000 686558.000000000 26.9268000000000 - 27732.7000000000 761510.000000000 26.9768000000000 - 30704.2000000000 844639.000000000 27.0267000000000 - 33994.0000000000 936837.000000000 27.0767000000000 - 37636.1000000000 1039090.00000000 27.1266000000000 - 41668.4000000000 1152500.00000000 27.1766000000000 - 46132.5000000000 1278280.00000000 27.2265000000000 - 51074.6000000000 1417770.00000000 27.2765000000000 - 56546.1000000000 1572480.00000000 27.3265000000000 - 62603.5000000000 1744060.00000000 27.3764000000000 - 69309.6000000000 1934350.00000000 27.4264000000000 - 76733.8000000000 2145380.00000000 27.4763000000000 - 84953.0000000000 2379430.00000000 27.5263000000000 - 94052.2000000000 2638990.00000000 27.5762000000000 - 104126.000000000 2926850.00000000 27.6262000000000 - 115278.000000000 3246080.00000000 27.6761000000000 - 127624.000000000 3600110.00000000 27.7261000000000 - 141292.000000000 3992740.00000000 27.7760000000000 - 156424.000000000 4428150.00000000 27.8260000000000 - 173175.000000000 4911010.00000000 27.8760000000000 - 191720.000000000 5446500.00000000 27.9259000000000 - 212250.000000000 6040330.00000000 27.9759000000000 - 234977.000000000 6698870.00000000 28.0258000000000 - 260138.000000000 7429170.00000000 28.0758000000000 - 287992.000000000 8239030.00000000 28.1257000000000 - 318827.000000000 9137110.00000000 28.1757000000000 - 352962.000000000 10133000.0000000 28.2256000000000 - 390752.000000000 11237400.0000000 28.2756000000000 - 432586.000000000 12462100.0000000 28.3256000000000 - 478897.000000000 13820200.0000000 28.3755000000000 - 530164.000000000 15326200.0000000 28.4255000000000 - 586919.000000000 16996300.0000000 28.4754000000000 - 649747.000000000 18848100.0000000 28.5254000000000 - 719298.000000000 20901700.0000000 28.5753000000000 - 796292.000000000 23178800.0000000 28.6253000000000 - 881526.000000000 25703900.0000000 28.6752000000000 - 975879.000000000 28503900.0000000 28.7252000000000 - 1080330.00000000 31608700.0000000 28.7752000000000 - 1195950.00000000 35051500.0000000 28.8251000000000 - 1323950.00000000 38869000.0000000 28.8751000000000 - 1465640.00000000 43102100.0000000 28.9250000000000 - 1622500.00000000 47796000.0000000 28.9750000000000 - 1796130.00000000 53000700.0000000 29.0250000000000 - 1988340.00000000 58771800.0000000 29.0749000000000 - 2201110.00000000 65171000.0000000 29.1249000000000 - 2436640.00000000 72266600.0000000 29.1748000000000 - 2697370.00000000 80134200.0000000 29.2248000000000 - 2985990.00000000 88857800.0000000 29.2747000000000 - 3305490.00000000 98530600.0000000 29.3247000000000 - 3659150.00000000 109256000.000000 29.3747000000000 - 4050650.00000000 121148000.000000 29.4246000000000 - 4484030.00000000 134333000.000000 29.4746000000000 - 4963750.00000000 148953000.000000 29.5246000000000 - 5494790.00000000 165163000.000000 29.5745000000000 - 6082620.00000000 183136000.000000 29.6245000000000 - 6733310.00000000 203064000.000000 29.6744000000000 - 7453600.00000000 225159000.000000 29.7244000000000 - 8250920.00000000 249657000.000000 29.7744000000000 - 9133500.00000000 276819000.000000 29.8243000000000 - 10110500.0000000 306934000.000000 29.8743000000000 - 11191900.0000000 340324000.000000 29.9242000000000 - 12389000.0000000 377344000.000000 29.9742000000000 - 13714100.0000000 418389000.000000 30.0242000000000 - 15180800.0000000 463896000.000000 30.0741000000000 - 16804400.0000000 514350000.000000 30.1241000000000 - 18601600.0000000 570288000.000000 30.1740000000000 - 20590900.0000000 632307000.000000 30.2240000000000 - 22793000.0000000 701066000.000000 30.2740000000000 - 25230400.0000000 777299000.000000 30.3239000000000 - 27928500.0000000 861816000.000000 30.3739000000000 - 30915000.0000000 955518000.000000 30.4238000000000 - 34220800.0000000 1059400000.00000 30.4738000000000 - 37879900.0000000 1174580000.00000 30.5238000000000 - 41930200.0000000 1302260000.00000 30.5737000000000 - 46413400.0000000 1443820000.00000 30.6237000000000 - 51375900.0000000 1600760000.00000 30.6737000000000 - 56868800.0000000 1774750000.00000 30.7236000000000 - 62948900.0000000 1967650000.00000 30.7736000000000 - 69678800.0000000 2181490000.00000 30.8235000000000 - 77128000.0000000 2418570000.00000 30.8735000000000 - 85373400.0000000 2681390000.00000 30.9235000000000 - 94500000.0000000 2972760000.00000 30.9734000000000 - 104602000.000000 3295780000.00000 31.0234000000000 - 115784000.000000 3653880000.00000 31.0733000000000 - 128160000.000000 4050860000.00000 31.1233000000000 - 141860000.000000 4490950000.00000 31.1733000000000 - 157023000.000000 4978840000.00000 31.2233000000000 - 173806000.000000 5519700000.00000 31.2732000000000 - 192384000.000000 6119280000.00000 31.3232000000000 - 212946000.000000 6783960000.00000 31.3731000000000 - 235705000.000000 7520800000.00000 31.4231000000000 - 260896000.000000 8337630000.00000 31.4731000000000 - 288779000.000000 9243140000.00000 31.5230000000000 - 319641000.000000 10246900000.0000 31.5730000000000 - 353800000.000000 11359700000.0000 31.6230000000000 - 391609000.000000 12593200000.0000 31.6729000000000 - 433458000.000000 13960600000.0000 31.7229000000000 - 479777000.000000 15476500000.0000 31.7729000000000 - 531045000.000000 17156800000.0000 31.8228000000000 - 587790000.000000 19019400000.0000 31.8728000000000 - 650596000.000000 21084200000.0000 31.9227000000000 - 720113000.000000 23373100000.0000 31.9727000000000 - 797055000.000000 25910300000.0000 32.0227000000000 - 882216000.000000 28722800000.0000 32.0726000000000 - 976474000.000000 31840400000.0000 32.1226000000000 - 1080800000.00000 35296200000.0000 32.1726000000000 - 1196270000.00000 39127000000.0000 32.2225000000000 - 1324070000.00000 43373300000.0000 32.2725000000000 - 1465530000.00000 48080200000.0000 32.3225000000000 - 1622090000.00000 53297700000.0000 32.3724000000000 - 1795370000.00000 59081100000.0000 32.4224000000000 - 1987160000.00000 65491700000.0000 32.4724000000000 - 2199430000.00000 72597600000.0000 32.5223000000000 - 2434380000.00000 80474200000.0000 32.5723000000000 - 2694410000.00000 89204900000.0000 32.6223000000000 - 2982210000.00000 98882400000.0000 32.6722000000000 - 3300750000.00000 109609000000.000 32.7222000000000 - 3653310000.00000 121499000000.000 32.7722000000000 - 4043510000.00000 134678000000.000 32.8221000000000 - 4475370000.00000 149287000000.000 32.8721000000000 - 4953350000.00000 165478000000.000 32.9221000000000 - 5482370000.00000 183426000000.000 32.9720000000000 - 6067880000.00000 203318000000.000 33.0220000000000 - 6715900000.00000 225368000000.000 33.0720000000000 - 7433110000.00000 249807000000.000 33.1219000000000 - 8226900000.00000 276895000000.000 33.1719000000000 - 9105440000.00000 306920000000.000 33.2219000000000 - 10077800000.0000 340198000000.000 33.2718000000000 - 11153900000.0000 377083000000.000 33.3218000000000 - 12344900000.0000 417966000000.000 33.3718000000000 - 13663100000.0000 463279000000.000 33.4218000000000 - 15122000000.0000 513502000000.000 33.4717000000000 - 16736700000.0000 569168000000.000 33.5217000000000 - 18523700000.0000 630865000000.000 33.5717000000000 - 20501500000.0000 699247000000.000 33.6216000000000 - 22690300000.0000 775038000000.000 33.6716000000000 - 25112900000.0000 859040000000.000 33.7216000000000 - 27794000000.0000 952143000000.000 33.7715000000000 - 30761300000.0000 1055330000000.00 33.8215000000000 - 34045300000.0000 1169700000000.00 33.8715000000000 - 37679800000.0000 1296450000000.00 33.9214000000000 - 41702300000.0000 1436940000000.00 33.9714000000000 - 46154100000.0000 1592640000000.00 34.0214000000000 - 51081000000.0000 1765210000000.00 34.0713000000000 - 56533700000.0000 1956470000000.00 34.1213000000000 - 62568400000.0000 2168440000000.00 34.1713000000000 - 69247000000.0000 2403360000000.00 34.2213000000000 - 76638500000.0000 2663730000000.00 34.2712000000000 - 84818700000.0000 2952290000000.00 34.3212000000000 - 93871900000.0000 3272100000000.00 34.3712000000000 - 103891000000.000 3626530000000.00 34.4211000000000 - 114980000000.000 4019340000000.00 34.4711000000000 - 127251000000.000 4454690000000.00 34.5211000000000 - 140832000000.000 4937160000000.00 34.5710000000000 - 155863000000.000 5471870000000.00 34.6210000000000 - 172497000000.000 6064460000000.00 34.6710000000000 - 190906000000.000 6721210000000.00 34.7209000000000 - 211279000000.000 7449050000000.00 34.7709000000000 - 233826000000.000 8255670000000.00 34.8209000000000 - 258778000000.000 9149600000000.00 34.8708000000000 - 286393000000.000 10140300000000.0 34.9208000000000 - 316954000000.000 11238200000000.0 34.9708000000000 - 350775000000.000 12454900000000.0 35.0208000000000 - 388204000000.000 13803300000000.0 35.0707000000000 - 429627000000.000 15297700000000.0 35.1207000000000 - 475469000000.000 16953700000000.0 35.1707000000000 - 526201000000.000 18789000000000.0 35.2207000000000 - 582345000000.000 20822800000000.0 35.2706000000000 - 644478000000.000 23076700000000.0 35.3206000000000 - 713239000000.000 25574500000000.0 35.3706000000000 - 789334000000.000 28342500000000.0 35.4205000000000 - 873547000000.000 31410000000000.0 35.4705000000000 - 966743000000.000 34809300000000.0 35.5205000000000 - 1069880000000.00 38576400000000.0 35.5704000000000 - 1184020000000.00 42751000000000.0 35.6204000000000 - 1310330000000.00 47377200000000.0 35.6704000000000 - 1450110000000.00 52503800000000.0 35.7204000000000 - 1604800000000.00 58184900000000.0 35.7703000000000 - 1775990000000.00 64480500000000.0 35.8203000000000 - 1965440000000.00 71457000000000.0 35.8703000000000 - 2175090000000.00 79188000000000.0 35.9203000000000 - 2407110000000.00 87755200000000.0 35.9702000000000 - 2663860000000.00 97248800000000.0 36.0202000000000 - 2948000000000.00 107769000000000. 36.0702000000000 - 3262440000000.00 119427000000000. 36.1201000000000 - 3610410000000.00 132346000000000. 36.1701000000000 - 3995490000000.00 146661000000000. 36.2201000000000 - 4421630000000.00 162524000000000. 36.2701000000000 - 4893210000000.00 180103000000000. 36.3200000000000 - 5415080000000.00 199582000000000. 36.3700000000000 - 5992600000000.00 221167000000000. 36.4200000000000 - 6631690000000.00 245085000000000. 36.4700000000000 - 7338940000000.00 271589000000000. 36.5199000000000 - 8121590000000.00 300958000000000. 36.5699000000000 - 8987690000000.00 333502000000000. 36.6199000000000 - 9946140000000.00 369564000000000. 36.6698000000000 - 11006800000000.0 409524000000000. 36.7198000000000 - 12180500000000.0 453803000000000. 36.7698000000000 - 13479300000000.0 502868000000000. 36.8198000000000 - 14916700000000.0 557235000000000. 36.8697000000000 - 16507300000000.0 617479000000000. 36.9197000000000 - 18267400000000.0 684233000000000. 36.9697000000000 - 20215200000000.0 758201000000000. 37.0197000000000 - 22370600000000.0 840162000000000. 37.0696000000000 - 24755800000000.0 930980000000000. 37.1196000000000 - 27395300000000.0 1.031610000000000E+015 37.1696000000000 - 30316100000000.0 1.143120000000000E+015 37.2196000000000 - 33548400000000.0 1.266670000000000E+015 37.2695000000000 - 37125100000000.0 1.403570000000000E+015 37.3195000000000 - 41083100000000.0 1.555260000000000E+015 37.3695000000000 - 45463100000000.0 1.723340000000000E+015 37.4194000000000 - 50309800000000.0 1.909580000000000E+015 37.4694000000000 - 55673200000000.0 2.115940000000000E+015 37.5194000000000 - 61608300000000.0 2.344590000000000E+015 37.5694000000000 - 68176000000000.0 2.597940000000000E+015 37.6194000000000 - 75443700000000.0 2.878660000000000E+015 37.6693000000000 - 83486000000000.0 3.189700000000000E+015 37.7193000000000 - 92385500000000.0 3.534330000000000E+015 37.7693000000000 - 102233000000000. 3.916190000000000E+015 37.8192000000000 - 113131000000000. 4.339290000000000E+015 37.8692000000000 - 125190000000000. 4.808080000000000E+015 37.9192000000000 - 138534000000000. 5.327510000000000E+015 37.9692000000000 - 153300000000000. 5.903020000000000E+015 38.0191000000000 - 169640000000000. 6.540690000000000E+015 38.0691000000000 - 187721000000000. 7.247220000000000E+015 38.1191000000000 - 207729000000000. 8.030040000000000E+015 38.1691000000000 - 229869000000000. 8.897390000000000E+015 38.2191000000000 - 254369000000000. 9.858380000000000E+015 38.2690000000000 - 281479000000000. 1.092310000000000E+016 38.3190000000000 - 311477000000000. 1.210290000000000E+016 38.3690000000000 - 344673000000000. 1.341000000000000E+016 38.4189000000000 - 381406000000000. 1.485820000000000E+016 38.4689000000000 - 422053000000000. 1.646270000000000E+016 38.5189000000000 - 467031000000000. 1.824050000000000E+016 38.5689000000000 - 516801000000000. 2.021010000000000E+016 38.6189000000000 - 571874000000000. 2.239240000000000E+016 38.6688000000000 - 632815000000000. 2.481030000000000E+016 38.7188000000000 - 700250000000000. 2.748920000000000E+016 38.7688000000000 - 774868000000000. 3.045710000000000E+016 38.8188000000000 - 857438000000000. 3.374550000000000E+016 38.8687000000000 - 948803000000000. 3.738870000000000E+016 38.9187000000000 - 1.049900000000000E+015 4.142520000000000E+016 38.9687000000000 - 1.161770000000000E+015 4.589730000000000E+016 39.0187000000000 - 1.285560000000000E+015 5.085200000000000E+016 39.0686000000000 - 1.422540000000000E+015 5.634140000000000E+016 39.1186000000000 - 1.574110000000000E+015 6.242310000000000E+016 39.1686000000000 - 1.741830000000000E+015 6.916120000000000E+016 39.2186000000000 - 1.927410000000000E+015 7.662630000000000E+016 39.2685000000000 - 2.132760000000000E+015 8.489690000000000E+016 39.3185000000000 - 2.359990000000000E+015 9.405990000000000E+016 39.3685000000000 - 2.611420000000000E+015 1.042120000000000E+017 39.4185000000000 - 2.889640000000000E+015 1.154590000000000E+017 39.4684000000000 - 3.197490000000000E+015 1.279190000000000E+017 39.5184000000000 - 3.538130000000000E+015 1.417240000000000E+017 39.5684000000000 - 3.915060000000000E+015 1.570180000000000E+017 39.6184000000000 - 4.332130000000000E+015 1.739610000000000E+017 39.6684000000000 - 4.793630000000000E+015 1.927330000000000E+017 39.7183000000000 - 5.304290000000000E+015 2.135300000000000E+017 39.7683000000000 - 5.869330000000000E+015 2.365700000000000E+017 39.8183000000000 - 6.494570000000000E+015 2.620950000000000E+017 39.8683000000000 - 7.186390000000000E+015 2.903730000000000E+017 39.9182000000000 - 7.951890000000000E+015 3.217020000000000E+017 39.9682000000000 - 8.798920000000000E+015 3.564090000000000E+017 40.0182000000000 - 9.736170000000000E+015 3.948600000000000E+017 40.0682000000000 - 1.077320000000000E+016 4.374580000000000E+017 40.1181000000000 - 1.192070000000000E+016 4.846490000000000E+017 40.1681000000000 - 1.319050000000000E+016 5.369300000000000E+017 40.2181000000000 - 1.459540000000000E+016 5.948490000000000E+017 40.2681000000000 - 1.614990000000000E+016 6.590140000000000E+017 40.3181000000000 - 1.787000000000000E+016 7.300980000000000E+017 40.3680000000000 - 1.977330000000000E+016 8.088470000000000E+017 40.4180000000000 - 2.187930000000000E+016 8.960870000000000E+017 40.4680000000000 - 2.420950000000000E+016 9.927330000000000E+017 40.5180000000000 - 2.678790000000000E+016 1.099800000000000E+018 40.5679000000000 - 2.964080000000000E+016 1.218410000000000E+018 40.6179000000000 - 3.279750000000000E+016 1.349810000000000E+018 40.6679000000000 - 3.629030000000000E+016 1.495370000000000E+018 40.7179000000000 - 4.015510000000000E+016 1.656630000000000E+018 40.7679000000000 - 4.443130000000000E+016 1.835280000000000E+018 40.8178000000000 - 4.916290000000000E+016 2.033180000000000E+018 40.8678000000000 - 5.439830000000000E+016 2.252410000000000E+018 40.9178000000000 - 6.019110000000000E+016 2.495280000000000E+018 40.9678000000000 - 6.660070000000000E+016 2.764320000000000E+018 41.0178000000000 - 7.369280000000000E+016 3.062370000000000E+018 41.0677000000000 - 8.153990000000000E+016 3.392540000000000E+018 41.1177000000000 - 9.022250000000000E+016 3.758290000000000E+018 41.1677000000000 - 9.982950000000000E+016 4.163470000000000E+018 41.2177000000000 - 1.104590000000000E+017 4.612320000000000E+018 41.2677000000000 - 1.222210000000000E+017 5.109540000000000E+018 41.3176000000000 - 1.352350000000000E+017 5.660350000000000E+018 41.3676000000000 - 1.496340000000000E+017 6.270520000000000E+018 41.4176000000000 - 1.655660000000000E+017 6.946440000000000E+018 41.4676000000000 - 1.831940000000000E+017 7.695200000000000E+018 41.5175000000000 - 2.026980000000000E+017 8.524640000000000E+018 41.5675000000000 - 2.242800000000000E+017 9.443460000000000E+018 41.6175000000000 - 2.481580000000000E+017 1.046130000000000E+019 41.6675000000000 - 2.745780000000000E+017 1.158880000000000E+019 41.7175000000000 - 3.038110000000000E+017 1.283780000000000E+019 41.7674000000000 - 3.361560000000000E+017 1.422130000000000E+019 41.8174000000000 - 3.719430000000000E+017 1.575390000000000E+019 41.8674000000000 - 4.115400000000000E+017 1.745170000000000E+019 41.9174000000000 - 4.553520000000000E+017 1.933230000000000E+019 41.9674000000000 - 5.038280000000000E+017 2.141550000000000E+019 42.0173000000000 - 5.574630000000000E+017 2.372320000000000E+019 42.0673000000000 - 6.168070000000000E+017 2.627950000000000E+019 42.1173000000000 - 6.824680000000000E+017 2.911110000000000E+019 42.1673000000000 - 7.551170000000000E+017 3.224780000000000E+019 42.2173000000000 - 8.354990000000000E+017 3.572230000000000E+019 42.2672000000000 - 9.244360000000000E+017 3.957110000000000E+019 42.3172000000000 - 1.022840000000000E+018 4.383440000000000E+019 42.3672000000000 - 1.131710000000000E+018 4.855700000000000E+019 42.4172000000000 - 1.252180000000000E+018 5.378810000000000E+019 42.4671000000000 - 1.385460000000000E+018 5.958270000000000E+019 42.5171000000000 - 1.532930000000000E+018 6.600140000000000E+019 42.5671000000000 - 1.696100000000000E+018 7.311130000000000E+019 42.6171000000000 - 1.876620000000000E+018 8.098690000000000E+019 42.6671000000000 - 2.076370000000000E+018 8.971070000000000E+019 42.7171000000000 - 2.297360000000000E+018 9.937390000000000E+019 42.7670000000000 - 2.541880000000000E+018 1.100780000000000E+020 42.8170000000000 - 2.812420000000000E+018 1.219340000000000E+020 42.8670000000000 - 3.111740000000000E+018 1.350670000000000E+020 42.9170000000000 - 3.442920000000000E+018 1.496140000000000E+020 42.9669000000000 - 3.809340000000000E+018 1.657280000000000E+020 43.0169000000000 - 4.214760000000000E+018 1.835760000000000E+020 43.0669000000000 - 4.663310000000000E+018 2.033460000000000E+020 43.1169000000000 - 5.159600000000000E+018 2.252450000000000E+020 43.1669000000000 - 5.708690000000000E+018 2.495020000000000E+020 43.2169000000000 - 6.316210000000000E+018 2.763690000000000E+020 43.2668000000000 - 6.988380000000000E+018 3.061300000000000E+020 43.3168000000000 - 7.732070000000000E+018 3.390940000000000E+020 43.3668000000000 - 8.554890000000000E+018 3.756070000000000E+020 43.4168000000000 - 9.465250000000000E+018 4.160500000000000E+020 43.4668000000000 - 1.047250000000000E+019 4.608470000000000E+020 43.5167000000000 - 1.158690000000000E+019 5.104660000000000E+020 43.5667000000000 - 1.281980000000000E+019 5.654260000000000E+020 43.6167000000000 - 1.418400000000000E+019 6.263010000000000E+020 43.6667000000000 - 1.569330000000000E+019 6.937290000000000E+020 43.7167000000000 - 1.736320000000000E+019 7.684150000000000E+020 43.7666000000000 - 1.921070000000000E+019 8.511380000000001E+020 43.8166000000000 - 2.125480000000000E+019 9.427650000000000E+020 43.8666000000000 - 2.351630000000000E+019 1.044250000000000E+021 43.9166000000000 - 2.601850000000000E+019 1.156660000000000E+021 43.9666000000000 - 2.878680000000000E+019 1.281170000000000E+021 44.0166000000000 - 3.184970000000000E+019 1.419080000000000E+021 44.0665000000000 - 3.523840000000000E+019 1.571830000000000E+021 44.1165000000000 - 3.898760000000000E+019 1.741010000000000E+021 44.1665000000000 - 4.313570000000000E+019 1.928400000000000E+021 44.2165000000000 - 4.772500000000000E+019 2.135950000000000E+021 44.2665000000000 - 5.280260000000000E+019 2.365840000000000E+021 44.3164000000000 - 5.842020000000000E+019 2.620460000000000E+021 44.3664000000000 - 6.463550000000000E+019 2.902480000000000E+021 44.4164000000000 - 7.151190000000000E+019 3.214850000000000E+021 44.4664000000000 - 7.911980000000000E+019 3.560820000000000E+021 44.5164000000000 - 8.753690000000000E+019 3.944010000000000E+021 44.5663000000000 - 9.684940000000000E+019 4.368430000000000E+021 44.6163000000000 - 1.071520000000000E+020 4.838510000000000E+021 44.6663000000000 - 1.185510000000000E+020 5.359160000000000E+021 44.7163000000000 - 1.311630000000000E+020 5.935820000000000E+021 44.7663000000000 - 1.451160000000000E+020 6.574510000000000E+021 44.8163000000000 - 1.605530000000000E+020 7.281920000000000E+021 44.8662000000000 - 1.776310000000000E+020 8.065420000000000E+021 44.9162000000000 - 1.965270000000000E+020 8.933190000000000E+021 44.9662000000000 - 2.174320000000000E+020 9.894310000000001E+021 45.0162000000000 - 2.405610000000000E+020 1.095880000000000E+022 45.0662000000000 - 2.661490000000000E+020 1.213780000000000E+022 45.1161000000000 - 2.944590000000000E+020 1.344360000000000E+022 45.1661000000000 - 3.257800000000000E+020 1.488990000000000E+022 45.2161000000000 - 3.604320000000000E+020 1.649170000000000E+022 45.2661000000000 - 3.987690000000000E+020 1.826570000000000E+022 45.3161000000000 - 4.411840000000000E+020 2.023060000000000E+022 45.3661000000000 - 4.881090000000000E+020 2.240680000000000E+022 45.4160000000000 - 5.400250000000000E+020 2.481700000000000E+022 45.4660000000000 - 5.974620000000001E+020 2.748640000000000E+022 45.5160000000000 - 6.610070000000000E+020 3.044290000000000E+022 45.5660000000000 - 7.313110000000000E+020 3.371730000000000E+022 45.6160000000000 - 8.090900000000001E+020 3.734370000000000E+022 45.6660000000000 - 8.951410000000000E+020 4.136020000000000E+022 45.7159000000000 - 9.903420000000001E+020 4.580850000000000E+022 45.7659000000000 - 1.095670000000000E+021 5.073510000000000E+022 45.8159000000000 - 1.212190000000000E+021 5.619140000000000E+022 45.8659000000000 - 1.341110000000000E+021 6.223440000000000E+022 45.9159000000000 - 1.483730000000000E+021 6.892720000000000E+022 45.9659000000000 - 1.641520000000000E+021 7.633940000000000E+022 46.0158000000000 - 1.816090000000000E+021 8.454860000000000E+022 46.0658000000000 - 2.009230000000000E+021 9.364040000000000E+022 46.1158000000000 - 2.222890000000000E+021 1.037100000000000E+023 46.1658000000000 - 2.459280000000000E+021 1.148610000000000E+023 46.2158000000000 - 2.720800000000000E+021 1.272120000000000E+023 46.2657000000000 - 3.010130000000000E+021 1.408900000000000E+023 46.3157000000000 - 3.330230000000000E+021 1.560380000000000E+023 46.3657000000000 - 3.684350000000000E+021 1.728150000000000E+023 46.4157000000000 - 4.076130000000000E+021 1.913950000000000E+023 46.4657000000000 - 4.509570000000000E+021 2.119730000000000E+023 46.5157000000000 - 4.989090000000000E+021 2.347620000000000E+023 46.5656000000000 - 5.519590000000000E+021 2.600010000000000E+023 46.6156000000000 - 6.106490000000000E+021 2.879530000000000E+023 46.6656000000000 - 6.755800000000000E+021 3.189080000000000E+023 46.7156000000000 - 7.474130000000000E+021 3.531910000000000E+023 46.7656000000000 - 8.268840000000000E+021 3.911580000000000E+023 46.8156000000000 - 9.148040000000000E+021 4.332060000000000E+023 46.8655000000000 - 1.012070000000000E+022 4.797730000000000E+023 46.9155000000000 - 1.119680000000000E+022 5.313440000000000E+023 46.9655000000000 - 1.238720000000000E+022 5.884570000000000E+023 47.0155000000000 - 1.370430000000000E+022 6.517080000000000E+023 47.0655000000000 - 1.516130000000000E+022 7.217559999999999E+023 47.1155000000000 - 1.677330000000000E+022 7.993309999999999E+023 47.1654000000000 - 1.855660000000000E+022 8.852419999999999E+023 47.2154000000000 - 2.052940000000000E+022 9.803840000000000E+023 47.2654000000000 - 2.271200000000000E+022 1.085750000000000E+024 47.3154000000000 - 2.512660000000000E+022 1.202440000000000E+024 47.3654000000000 - 2.779790000000000E+022 1.331660000000000E+024 47.4154000000000 - 3.075320000000000E+022 1.474770000000000E+024 47.4653000000000 - 3.402260000000000E+022 1.633250000000000E+024 47.5153000000000 - 3.763950000000000E+022 1.808770000000000E+024 47.5653000000000 - 4.164090000000000E+022 2.003140000000000E+024 47.6153000000000 - 4.606760000000000E+022 2.218390000000000E+024 47.6653000000000 - 5.096490000000000E+022 2.456760000000000E+024 47.7153000000000 - 5.638270000000000E+022 2.720750000000000E+024 47.7652000000000 - 6.237640000000000E+022 3.013090000000000E+024 47.8152000000000 - 6.900720000000000E+022 3.336840000000000E+024 47.8652000000000 - 7.634270000000000E+022 3.695370000000000E+024 47.9152000000000 - 8.445799999999999E+022 4.092410000000000E+024 47.9652000000000 - 9.343579999999999E+022 4.532100000000000E+024 48.0152000000000 - 1.033680000000000E+023 5.019020000000000E+024 48.0652000000000 - 1.143560000000000E+023 5.558250000000000E+024 48.1151000000000 - 1.265110000000000E+023 6.155390000000000E+024 48.1651000000000 - 1.399580000000000E+023 6.816670000000000E+024 48.2151000000000 - 1.548350000000000E+023 7.548980000000000E+024 48.2651000000000 - 1.712930000000000E+023 8.359940000000000E+024 48.3151000000000 - 1.895000000000000E+023 9.258010000000000E+024 48.3651000000000 - 2.096420000000000E+023 1.025250000000000E+025 48.4150000000000 - 2.319240000000000E+023 1.135380000000000E+025 48.4650000000000 - 2.565750000000000E+023 1.257340000000000E+025 48.5150000000000 - 1 1 2 3 3 4 0 1 1 1 2 2 - 0.000000000000000E+000 0.000000000000000E+000 0.705880000000000 - 0.705880000000000 0.705880000000000 0.705880000000000 - 1.00000000000000 1.00000000000000 3.00000000000000 - 3.00000000000000 3.00000000000000 2.00000000000000 - 8.07131000000004 7.28897545999993 13.1357354599999 - 14.9497831614761 14.9311833068413 2.42492104827388 - 26.1700000000000 19.2500000000000 24.2100000000000 - 20.9200000000000 23.1500000000000 18.0100000000000 - 19.5500000000000 16.9400000000000 19.7300000000000 - 17.0700000000000 18.2100000000000 14.9900000000000 - 16.0100000000000 12.0400000000000 13.2700000000000 - 11.0900000000000 12.1700000000000 10.2600000000000 - 11.0400000000000 8.41000000000000 9.79000000000000 - 7.36000000000000 8.15000000000000 5.63000000000000 - 5.88000000000000 3.17000000000000 3.32000000000000 - 0.820000000000000 1.83000000000000 0.970000000000000 - 2.33000000000000 1.27000000000000 2.92000000000000 - 1.61000000000000 2.91000000000000 1.35000000000000 - 2.40000000000000 0.890000000000000 1.74000000000000 - 0.360000000000000 0.950000000000000 -0.650000000000000 - -4.000000000000000E-002 -1.73000000000000 -0.960000000000000 - -2.87000000000000 -2.05000000000000 -4.05000000000000 - -3.40000000000000 -5.72000000000000 -3.75000000000000 - -4.13000000000000 -2.42000000000000 -2.85000000000000 - -1.01000000000000 -1.33000000000000 0.540000000000000 - -2.000000000000000E-002 1.74000000000000 0.750000000000000 - 2.24000000000000 1.00000000000000 1.98000000000000 - 0.790000000000000 1.54000000000000 0.390000000000000 - 1.08000000000000 0.000000000000000E+000 0.780000000000000 - -0.350000000000000 0.580000000000000 -0.550000000000000 - 0.590000000000000 -0.610000000000000 0.590000000000000 - -0.350000000000000 0.320000000000000 -0.960000000000000 - -0.520000000000000 -2.08000000000000 -2.46000000000000 - -3.64000000000000 -1.55000000000000 -0.960000000000000 - 0.970000000000000 0.880000000000000 2.37000000000000 - 1.75000000000000 2.72000000000000 1.90000000000000 - 2.55000000000000 1.46000000000000 1.93000000000000 - 0.860000000000000 1.17000000000000 8.000000000000000E-002 - 0.390000000000000 -0.760000000000000 -0.390000000000000 - -1.51000000000000 -1.17000000000000 -2.36000000000000 - -1.95000000000000 -3.06000000000000 -2.62000000000000 - -3.55000000000000 -2.95000000000000 -3.75000000000000 - -3.07000000000000 -3.79000000000000 -3.06000000000000 - -3.77000000000000 -3.05000000000000 -3.78000000000000 - -3.12000000000000 -3.90000000000000 -3.35000000000000 - -4.24000000000000 -3.86000000000000 -4.92000000000000 - -5.06000000000000 -6.77000000000000 -7.41000000000000 - -9.18000000000000 -10.1600000000000 -11.1200000000000 - -9.76000000000000 -9.23000000000000 -7.96000000000000 - -7.65000000000000 - -8.32000000000000 -15.9000000000000 -11.5100000000000 - -14.3100000000000 -11.5700000000000 -15.9000000000000 - -13.9100000000000 -16.0300000000000 -12.1300000000000 - -13.8700000000000 -12.2500000000000 -14.4000000000000 - -13.0700000000000 -15.8000000000000 -13.8100000000000 - -14.9800000000000 -12.6300000000000 -13.7600000000000 - -11.3700000000000 -12.3800000000000 -9.23000000000000 - -9.65000000000000 -7.64000000000000 -9.17000000000000 - -8.05000000000000 -9.72000000000000 -8.87000000000000 - -10.7600000000000 -8.64000000000000 -8.89000000000000 - -6.60000000000000 -7.13000000000000 -4.77000000000000 - -5.33000000000000 -3.06000000000000 -3.79000000000000 - -1.72000000000000 -2.79000000000000 -0.930000000000000 - -2.19000000000000 -0.520000000000000 -1.90000000000000 - -0.450000000000000 -2.20000000000000 -1.22000000000000 - -3.07000000000000 -2.42000000000000 -4.37000000000000 - -3.94000000000000 -6.08000000000000 -4.49000000000000 - -4.50000000000000 -3.14000000000000 -2.93000000000000 - -1.04000000000000 -1.36000000000000 0.690000000000000 - 0.210000000000000 2.11000000000000 1.33000000000000 - 3.29000000000000 2.46000000000000 4.30000000000000 - 3.32000000000000 4.79000000000000 3.62000000000000 - 4.97000000000000 3.64000000000000 4.63000000000000 - 3.07000000000000 4.06000000000000 2.49000000000000 - 3.30000000000000 1.46000000000000 2.06000000000000 - 0.510000000000000 0.740000000000000 -1.18000000000000 - -1.26000000000000 -3.54000000000000 -3.97000000000000 - -5.26000000000000 -4.18000000000000 -3.71000000000000 - -2.10000000000000 -1.70000000000000 -8.000000000000000E-002 - -0.180000000000000 0.940000000000000 0.270000000000000 - 1.13000000000000 8.000000000000000E-002 0.910000000000000 - -0.310000000000000 0.490000000000000 -0.780000000000000 - 8.000000000000000E-002 -1.15000000000000 -0.230000000000000 - -1.41000000000000 -0.420000000000000 -1.55000000000000 - -0.550000000000000 -1.66000000000000 -0.660000000000000 - -1.73000000000000 -0.750000000000000 -1.74000000000000 - -0.780000000000000 -1.69000000000000 -0.780000000000000 - -1.60000000000000 -0.750000000000000 -1.46000000000000 - -0.670000000000000 -1.26000000000000 -0.510000000000000 - -1.04000000000000 -0.530000000000000 -1.84000000000000 - -2.42000000000000 -4.52000000000000 -4.76000000000000 - -6.33000000000000 -6.76000000000000 -7.81000000000000 - -5.80000000000000 -5.37000000000000 -3.63000000000000 - -3.35000000000000 -1.75000000000000 -1.88000000000000 - -0.610000000000000 -0.900000000000000 9.000000000000000E-002 - -0.320000000000000 0.550000000000000 -0.130000000000000 - 0.700000000000000 -6.000000000000000E-002 0.490000000000000 - -0.200000000000000 0.400000000000000 -0.220000000000000 - 0.360000000000000 -9.000000000000000E-002 0.580000000000000 - 0.120000000000000 0.750000000000000 0.150000000000000 - 0.700000000000000 0.170000000000000 1.11000000000000 - 0.890000000000000 1.85000000000000 1.62000000000000 - 2.54000000000000 2.29000000000000 3.20000000000000 - 2.91000000000000 3.84000000000000 3.53000000000000 - 4.48000000000000 4.15000000000000 5.12000000000000 - 4.78000000000000 5.75000000000000 5.39000000000000 - 6.31000000000000 5.91000000000000 6.87000000000000 - 6.33000000000000 7.13000000000000 6.61000000000000 - 7.30000000000000 6.31000000000000 6.27000000000000 - 4.83000000000000 4.49000000000000 2.85000000000000 - 2.32000000000000 0.580000000000000 -0.110000000000000 - -0.980000000000000 0.810000000000000 1.77000000000000 - 3.37000000000000 4.13000000000000 5.60000000000000 - 6.15000000000000 7.29000000000000 7.35000000000000 - 7.95000000000000 7.67000000000000 8.16000000000000 - 7.83000000000000 8.31000000000000 8.01000000000000 - 8.53000000000000 8.27000000000000 - 0.000000000000000E+000 5.44000000000000 0.000000000000000E+000 - 2.76000000000000 0.000000000000000E+000 3.34000000000000 - 0.000000000000000E+000 2.70000000000000 0.000000000000000E+000 - 1.90000000000000 0.000000000000000E+000 2.12000000000000 - 0.000000000000000E+000 2.13000000000000 0.000000000000000E+000 - 1.54000000000000 0.000000000000000E+000 1.42000000000000 - 0.000000000000000E+000 1.51000000000000 0.000000000000000E+000 - 1.73000000000000 0.000000000000000E+000 1.44000000000000 - 0.000000000000000E+000 1.45000000000000 0.000000000000000E+000 - 1.37000000000000 0.000000000000000E+000 1.09000000000000 - 0.000000000000000E+000 1.36000000000000 0.000000000000000E+000 - 1.42000000000000 0.000000000000000E+000 1.33000000000000 - 0.000000000000000E+000 1.20000000000000 0.000000000000000E+000 - 1.00000000000000 0.000000000000000E+000 1.16000000000000 - 0.000000000000000E+000 1.28000000000000 0.000000000000000E+000 - 1.38000000000000 0.000000000000000E+000 1.38000000000000 - 0.000000000000000E+000 1.32000000000000 0.000000000000000E+000 - 1.04000000000000 0.000000000000000E+000 1.11000000000000 - 0.000000000000000E+000 1.13000000000000 0.000000000000000E+000 - 1.21000000000000 0.000000000000000E+000 1.43000000000000 - 0.000000000000000E+000 1.15000000000000 0.000000000000000E+000 - 0.990000000000000 0.000000000000000E+000 0.910000000000000 - 0.000000000000000E+000 0.920000000000000 0.000000000000000E+000 - 1.00000000000000 0.000000000000000E+000 1.11000000000000 - 0.000000000000000E+000 1.23000000000000 0.000000000000000E+000 - 0.850000000000000 0.000000000000000E+000 0.980000000000000 - 0.000000000000000E+000 0.720000000000000 0.000000000000000E+000 - 0.800000000000000 0.000000000000000E+000 0.770000000000000 - 0.000000000000000E+000 0.890000000000000 0.000000000000000E+000 - 0.920000000000000 0.000000000000000E+000 0.800000000000000 - 0.000000000000000E+000 0.810000000000000 0.000000000000000E+000 - 0.690000000000000 0.000000000000000E+000 0.700000000000000 - 0.000000000000000E+000 0.760000000000000 0.000000000000000E+000 - 0.730000000000000 0.000000000000000E+000 0.800000000000000 - 0.000000000000000E+000 0.740000000000000 0.000000000000000E+000 - 0.730000000000000 0.000000000000000E+000 0.720000000000000 - 0.000000000000000E+000 0.720000000000000 0.000000000000000E+000 - 0.720000000000000 0.000000000000000E+000 0.710000000000000 - 0.000000000000000E+000 0.690000000000000 0.000000000000000E+000 - 0.680000000000000 0.000000000000000E+000 0.660000000000000 - 0.000000000000000E+000 0.610000000000000 0.000000000000000E+000 - 0.420000000000000 0.000000000000000E+000 0.360000000000000 - 0.000000000000000E+000 0.410000000000000 0.000000000000000E+000 - 0.490000000000000 - 0.000000000000000E+000 5.98000000000000 0.000000000000000E+000 - 2.77000000000000 0.000000000000000E+000 3.16000000000000 - 0.000000000000000E+000 3.01000000000000 0.000000000000000E+000 - 1.68000000000000 0.000000000000000E+000 1.73000000000000 - 0.000000000000000E+000 2.17000000000000 0.000000000000000E+000 - 1.74000000000000 0.000000000000000E+000 1.75000000000000 - 0.000000000000000E+000 1.72000000000000 0.000000000000000E+000 - 1.63000000000000 0.000000000000000E+000 1.41000000000000 - 0.000000000000000E+000 1.29000000000000 0.000000000000000E+000 - 1.47000000000000 0.000000000000000E+000 1.32000000000000 - 0.000000000000000E+000 1.46000000000000 0.000000000000000E+000 - 1.44000000000000 0.000000000000000E+000 1.46000000000000 - 0.000000000000000E+000 1.52000000000000 0.000000000000000E+000 - 1.51000000000000 0.000000000000000E+000 1.47000000000000 - 0.000000000000000E+000 1.45000000000000 0.000000000000000E+000 - 1.28000000000000 0.000000000000000E+000 1.23000000000000 - 0.000000000000000E+000 1.27000000000000 0.000000000000000E+000 - 0.620000000000000 0.000000000000000E+000 0.760000000000000 - 0.000000000000000E+000 1.23000000000000 0.000000000000000E+000 - 1.22000000000000 0.000000000000000E+000 1.40000000000000 - 0.000000000000000E+000 1.36000000000000 0.000000000000000E+000 - 1.30000000000000 0.000000000000000E+000 1.29000000000000 - 0.000000000000000E+000 1.24000000000000 0.000000000000000E+000 - 1.28000000000000 0.000000000000000E+000 1.24000000000000 - 0.000000000000000E+000 1.20000000000000 0.000000000000000E+000 - 0.940000000000000 0.000000000000000E+000 1.00000000000000 - 0.000000000000000E+000 1.05000000000000 0.000000000000000E+000 - 0.540000000000000 0.000000000000000E+000 0.600000000000000 - 0.000000000000000E+000 0.750000000000000 0.000000000000000E+000 - 0.750000000000000 0.000000000000000E+000 0.850000000000000 - 0.000000000000000E+000 0.970000000000000 0.000000000000000E+000 - 1.02000000000000 0.000000000000000E+000 1.05000000000000 - 0.000000000000000E+000 1.06000000000000 0.000000000000000E+000 - 1.07000000000000 0.000000000000000E+000 1.06000000000000 - 0.000000000000000E+000 1.05000000000000 0.000000000000000E+000 - 1.02000000000000 0.000000000000000E+000 0.970000000000000 - 0.000000000000000E+000 0.910000000000000 0.000000000000000E+000 - 0.830000000000000 0.000000000000000E+000 0.740000000000000 - 0.000000000000000E+000 0.660000000000000 0.000000000000000E+000 - 0.610000000000000 0.000000000000000E+000 0.610000000000000 - 0.000000000000000E+000 0.900000000000000 0.000000000000000E+000 - 0.520000000000000 0.000000000000000E+000 0.810000000000000 - 0.000000000000000E+000 0.680000000000000 0.000000000000000E+000 - 0.720000000000000 0.000000000000000E+000 0.770000000000000 - 0.000000000000000E+000 0.680000000000000 0.000000000000000E+000 - 0.670000000000000 0.000000000000000E+000 0.800000000000000 - 0.000000000000000E+000 0.680000000000000 0.000000000000000E+000 - 0.640000000000000 0.000000000000000E+000 0.580000000000000 - 0.000000000000000E+000 0.550000000000000 0.000000000000000E+000 - 0.570000000000000 0.000000000000000E+000 0.570000000000000 - 0.000000000000000E+000 0.550000000000000 0.000000000000000E+000 - 0.600000000000000 0.000000000000000E+000 0.580000000000000 - 0.000000000000000E+000 0.580000000000000 0.000000000000000E+000 - 0.610000000000000 0.000000000000000E+000 0.630000000000000 - 0.000000000000000E+000 0.650000000000000 0.000000000000000E+000 - 0.660000000000000 0.000000000000000E+000 0.650000000000000 - 0.000000000000000E+000 0.650000000000000 0.000000000000000E+000 - 0.640000000000000 0.000000000000000E+000 0.640000000000000 - 0.000000000000000E+000 0.630000000000000 0.000000000000000E+000 - 0.610000000000000 0.000000000000000E+000 0.590000000000000 - 0.000000000000000E+000 0.550000000000000 0.000000000000000E+000 - 0.390000000000000 0.000000000000000E+000 0.360000000000000 - 0.000000000000000E+000 0.400000000000000 0.000000000000000E+000 - 0.400000000000000 0.000000000000000E+000 0.400000000000000 - 0.000000000000000E+000 0.400000000000000 0.000000000000000E+000 - 0.400000000000000 0.000000000000000E+000 0.400000000000000 - 0.000000000000000E+000 0.400000000000000 - 0.360000000000000 0.510000000000000 0.600000000000000 - 0.660000000000000 0.680000000000000 0.690000000000000 - 0.690000000000000 0.770000000000000 0.810000000000000 - 0.850000000000000 0.890000000000000 0.930000000000000 - 0.970000000000000 1.00000000000000 8.000000000000000E-002 - 0.000000000000000E+000 -6.000000000000000E-002 -0.100000000000000 - -0.100000000000000 -0.100000000000000 -0.100000000000000 - 1.00000000000000 1.25992104989487 1.44224957030741 - 1.58740105196820 1.70997594667670 1.81712059283214 - 1.91293118277239 2.00000000000000 2.08008382305190 - 2.15443469003188 2.22398009056932 2.28942848510666 - 2.35133468772076 2.41014226417523 2.46621207433047 - 2.51984209978975 2.57128159065824 2.62074139420890 - 2.66840164872194 2.71441761659491 2.75892417638112 - 2.80203933065539 2.84386697985157 2.88449914061482 - 2.92401773821287 2.96249606840737 3.00000000000000 - 3.03658897187566 3.07231682568585 3.10723250595386 - 3.14138065239139 3.17480210393640 3.20753432999583 - 3.23961180127748 3.27106631018859 3.30192724889463 - 3.33222185164595 3.36197540679896 3.39121144301417 - 3.41995189335339 3.44821724038273 3.47602664488645 - 3.50339806038672 3.53034833532606 3.55689330449006 - 3.58304787101595 3.60882608013869 3.63424118566428 - 3.65930571002297 3.68403149864039 3.70842976926619 - 3.73251115681725 3.75628575422107 3.77976314968462 - 3.80295246076139 3.82586236554478 3.84850113127680 - 3.87087664062780 3.89299641587326 3.91486764116886 - 3.93649718310217 3.95789160968041 3.97905720789639 - 4.00000000000000 4.02072575858906 4.04124002062219 - 4.06154810044568 4.08165510191735 4.10156592970235 - 4.12128529980856 4.14081774942285 4.16016764610381 - 4.17933919638123 4.19833645380841 4.21716332650875 - 4.23582358425489 4.25432086511501 4.27265868169792 - 4.29084042702621 4.30886938006377 4.32674871092222 - 4.34448148576861 4.36207067145484 4.37951913988789 - 4.39682967215818 4.41400496244210 4.43104762169363 - 4.44796018113863 4.46474509558454 4.48140474655716 - 4.49794144527541 4.51435743547400 4.53065489608349 - 4.54683594377634 4.56290263538697 4.57885697021333 - 4.59470089220704 4.61043629205845 4.62606500918274 - 4.64158883361278 4.65700950780383 4.67232872835526 - 4.68754814765360 4.70266937544151 4.71769398031653 - 4.73262349116337 4.74745939852340 4.76220315590460 - 4.77685618103502 4.79141985706278 4.80589553370533 - 4.82028452835046 4.83458812711164 4.84880758583988 - 4.86294413109428 4.87699896107331 4.89097324650875 - 4.90486813152402 4.91868473445873 4.93242414866094 - 4.94608744324870 4.95967566384230 4.97318983326859 - 4.98663095223865 5.00000000000000 5.01329793496458 - 5.02652569531348 5.03968419957949 5.05277434720856 - 5.06579701910089 5.07875307813270 5.09164336965949 - 5.10446872200146 5.11722994691205 5.12992784003009 - 5.14256318131647 5.15513673547577 5.16764925236362 - 5.18010146738029 5.19249410185110 5.20482786339420 - 5.21710344627617 5.22932153175598 5.24148278841779 - 5.25358787249290 5.26563742817144 5.27763208790408 - 5.28957247269421 5.30145919238090 5.31329284591305 - 5.32507402161499 5.33680329744389 5.34848124123936 - 5.36010841096536 5.37168535494483 5.38321261208728 - 5.39469071210959 5.40612017575022 5.41750151497718 - 5.42883523318981 5.44012182541480 5.45136177849642 - 5.46255557128140 5.47370367479843 5.48480655243262 - 5.49586466009501 5.50687844638735 5.51784835276224 - 5.52877481367887 5.53965825675446 5.55049910291155 - 5.56129776652123 5.57205465554262 5.58277017165842 - 5.59344471040698 5.60407866131077 5.61467240800149 - 5.62522632834186 5.63574079454424 5.64621617328617 - 5.65665282582291 5.66705110809706 5.67741137084543 - 5.68773395970313 5.69801921530506 5.70826747338486 - 5.71847906487132 5.72865431598244 5.73879354831717 - 5.74889707894483 5.75896522049240 5.76899828122963 - 5.77899656515213 5.78896037206240 5.79888999764900 - 5.80878573356370 5.81864786749696 5.82847668325146 - 5.83827246081400 5.84803547642573 5.85776600265065 - 5.86746430844261 5.87713065921074 5.88676531688334 - 5.89636853997037 5.90594058362449 5.91548169970072 - 5.92499213681474 5.93447214039994 5.94392195276313 - 5.95334181313905 5.96273195774369 5.97209261982640 - 5.98142402972088 5.99072641489509 6.00000000000000 - 6.00924500691737 6.01846165480645 6.02765016014974 - 6.03681073679769 6.04594359601251 6.05504894651110 - 6.06412699450696 6.07317794375132 6.08220199557340 - 6.09119934891978 6.10017020039306 6.10911474428961 - 6.11803317263662 6.12692567522842 6.13579243966196 - 6.14463365137169 6.15344949366368 6.16224014774904 - 6.17100579277672 6.17974660586564 6.18846276213620 - 6.19715443474113 6.20582179489575 6.21446501190772 - 6.22308425320606 6.23167968436975 6.24025146915571 - 6.24879976952624 6.25732474567597 6.26582655605827 - 6.27430535741117 6.28276130478279 6.29119455155629 - 6.29960524947437 6.30799354866327 6.31635959765638 - 6.32470354341737 6.33302553136292 6.34132570538500 - 6.34960420787280 6.35786117973420 6.36609676041689 - 6.37431108792909 6.38250429885991 6.39067652839931 - 6.39882791035777 6.40695857718556 6.41506865999165 - 6.42315828856237 6.43122759137962 6.43927669563891 - 6.44730572726691 6.45531481093889 6.46330407009565 - 6.47127362696036 6.47922360255497 6.48715411671635 - 6.49506528811226 6.50295723425693 6.51083007152643 - 6.51868391517377 6.52651887934375 6.53433507708757 - 6.54213262037718 6.54991162011937 6.55767218616971 - 6.56541442734614 6.57313845144243 6.58084436524139 - 6.58853227452786 6.59620228410148 6.60385449778925 - 6.61148901845794 6.61910594802623 6.62670538747667 - 6.63428743686750 6.64185219534421 6.64939976115097 - 6.65693023164187 -5.563810000000000E-067 34426700.0000000 - 2.69000000000000 2.29184000000000 2.09819000000000 - 1.97582000000000 1.88867000000000 1.82212000000000 - 1.76892000000000 1.72500000000000 1.68785000000000 - 1.65583000000000 1.62781000000000 1.60300000000000 - 1.58081000000000 1.56078000000000 1.54258000000000 - 1.52592000000000 1.51060000000000 1.49643000000000 - 1.48328000000000 1.47102000000000 1.45955000000000 - 1.44878000000000 1.43865000000000 1.42909000000000 - 1.42005000000000 1.41148000000000 1.40333000000000 - 1.39558000000000 1.38819000000000 1.38113000000000 - 1.37438000000000 1.36791000000000 1.36171000000000 - 1.35575000000000 1.35002000000000 1.34451000000000 - 1.33919000000000 1.33407000000000 1.32912000000000 - 1.32434000000000 1.31971000000000 1.31523000000000 - 1.31089000000000 1.30669000000000 1.30261000000000 - 1.29865000000000 1.29480000000000 1.29106000000000 - 1.28742000000000 1.28388000000000 1.28044000000000 - 1.27708000000000 1.27380000000000 1.27061000000000 - 1.26750000000000 1.26446000000000 1.26149000000000 - 1.25859000000000 1.25576000000000 1.25299000000000 - 1.25028000000000 1.24763000000000 1.24504000000000 - 1.24250000000000 1.24001000000000 1.23758000000000 - 1.23519000000000 1.23285000000000 1.23055000000000 - 1.22830000000000 1.22609000000000 1.22392000000000 - 1.22180000000000 1.21971000000000 1.21765000000000 - 1.21564000000000 1.21366000000000 1.21171000000000 - 1.20979000000000 1.20791000000000 1.20606000000000 - 1.20424000000000 1.20245000000000 1.20069000000000 - 1.19895000000000 1.19724000000000 1.19556000000000 - 1.19391000000000 1.19228000000000 1.19067000000000 - 1.18909000000000 1.18752000000000 1.18599000000000 - 1.18447000000000 1.18298000000000 1.18150000000000 - 1.18005000000000 1.17861000000000 1.17720000000000 - 1.17581000000000 1.17443000000000 1.17307000000000 - 1.17173000000000 1.17040000000000 1.16910000000000 - 1.16781000000000 1.16653000000000 1.16527000000000 - 1.16403000000000 1.16280000000000 1.16159000000000 - 1.16039000000000 1.15921000000000 1.15804000000000 - 1.15688000000000 1.15574000000000 1.15460000000000 - 1.15349000000000 1.15238000000000 1.15129000000000 - 1.15021000000000 1.14914000000000 1.14808000000000 - 1.14703000000000 1.14600000000000 1.14498000000000 - 1.14396000000000 1.14296000000000 1.14197000000000 - 1.14099000000000 1.14001000000000 1.13905000000000 - 1.13810000000000 1.13716000000000 1.13622000000000 - 1.13530000000000 1.13438000000000 1.13348000000000 - 1.13258000000000 1.13169000000000 1.13081000000000 - 1.12994000000000 1.12907000000000 1.12822000000000 - 1.12737000000000 1.12653000000000 1.12569000000000 - 1.12487000000000 1.12405000000000 1.12324000000000 - 1.12244000000000 1.12164000000000 1.12085000000000 - 1.12007000000000 1.11929000000000 1.11852000000000 - 1.11776000000000 1.11700000000000 1.11625000000000 - 1.11551000000000 1.11477000000000 1.11404000000000 - 1.11331000000000 1.11259000000000 1.11188000000000 - 1.11117000000000 1.11047000000000 1.10977000000000 - 1.10908000000000 1.10840000000000 1.10772000000000 - 1.10704000000000 1.10637000000000 1.10571000000000 - 1.10505000000000 1.10439000000000 1.10374000000000 - 1.10310000000000 1.10246000000000 1.10182000000000 - 1.10119000000000 1.10056000000000 1.09994000000000 - 1.09933000000000 1.09871000000000 1.09811000000000 - 1.09750000000000 1.09690000000000 1.09631000000000 - 1.09572000000000 1.09513000000000 1.09455000000000 - 1.09397000000000 1.09339000000000 1.09282000000000 - 1.09225000000000 1.09169000000000 1.09113000000000 - 1.09058000000000 1.09002000000000 1.08948000000000 - 1.08893000000000 1.08839000000000 1.08785000000000 - 1.08732000000000 1.08679000000000 1.08626000000000 - 1.08574000000000 1.08522000000000 1.08470000000000 - 1.08419000000000 1.08368000000000 1.08317000000000 - 1.08267000000000 1.08216000000000 1.08167000000000 - 1.08117000000000 1.08068000000000 1.08019000000000 - 1.07970000000000 1.07922000000000 1.07874000000000 - 1.07826000000000 1.07779000000000 1.07732000000000 - 1.07685000000000 1.07638000000000 1.07592000000000 - 1.07546000000000 1.07500000000000 1.07455000000000 - 1.07409000000000 1.07364000000000 1.07320000000000 - 1.07275000000000 1.07231000000000 1.07187000000000 - 1.07143000000000 1.07100000000000 1.07057000000000 - 1.07014000000000 1.06971000000000 1.06928000000000 - 1.06886000000000 1.06844000000000 1.06802000000000 - 1.06760000000000 1.06719000000000 1.06678000000000 - 1.06637000000000 1.06596000000000 1.06556000000000 - 1.06515000000000 1.06475000000000 1.06435000000000 - 1.06396000000000 1.06356000000000 1.06317000000000 - 1.06278000000000 1.06239000000000 1.06200000000000 - 1.06162000000000 1.06123000000000 1.06085000000000 - 1.06047000000000 1.06010000000000 1.05972000000000 - 1.05935000000000 1.05898000000000 1.05861000000000 - 1.05824000000000 1.05787000000000 1.05751000000000 - 1.05715000000000 1.05679000000000 1.05643000000000 - 1.05607000000000 1.05572000000000 1.05536000000000 - 1.05501000000000 1.05466000000000 1.05431000000000 - 1.05396000000000 1.05362000000000 1.05328000000000 - 1.05293000000000 1.05259000000000 1.05225000000000 - 1.05192000000000 1.05158000000000 1.05125000000000 - 1.05091000000000 1.05058000000000 1.05025000000000 - 1.04992000000000 3.984620000000000E+028 2.171050000000000E-056 - 0.598513000000000 0.434469000000000 0.356520000000000 - 0.308110000000000 0.274114000000000 0.248467000000000 - 0.228183000000000 0.211594000000000 0.197684000000000 - 0.185790000000000 0.175462000000000 0.166378000000000 - 0.158303000000000 0.151061000000000 0.144516000000000 - 0.138561000000000 0.133111000000000 0.128098000000000 - 0.123466000000000 0.119167000000000 0.115163000000000 - 0.111422000000000 0.107915000000000 0.104620000000000 - 0.101514000000000 9.858040000000000E-002 9.580360000000000E-002 - 9.317000000000000E-002 9.066740000000000E-002 8.828530000000000E-002 - 8.601399999999999E-002 8.384519999999999E-002 8.177130000000001E-002 - 7.978550000000000E-002 7.788170000000000E-002 7.605430000000001E-002 - 7.429810000000001E-002 7.260890000000000E-002 7.098230000000000E-002 - 6.941440000000000E-002 6.790180000000000E-002 6.644140000000000E-002 - 6.503000000000000E-002 6.366510000000000E-002 6.234400000000000E-002 - 6.106450000000000E-002 5.982440000000000E-002 5.862170000000000E-002 - 5.745460000000000E-002 5.632120000000000E-002 5.522010000000000E-002 - 5.414960000000000E-002 5.310830000000000E-002 5.209510000000000E-002 - 5.110850000000000E-002 5.014740000000000E-002 4.921080000000000E-002 - 4.829760000000000E-002 4.740690000000000E-002 4.653770000000000E-002 - 4.568910000000000E-002 4.486040000000000E-002 4.405080000000000E-002 - 4.325960000000000E-002 4.248600000000000E-002 4.172940000000000E-002 - 4.098920000000000E-002 4.026480000000000E-002 3.955570000000000E-002 - 3.886130000000000E-002 3.818110000000000E-002 3.751460000000000E-002 - 3.686140000000000E-002 3.622100000000000E-002 3.559300000000000E-002 - 3.497700000000000E-002 3.437260000000000E-002 3.377950000000000E-002 - 3.319730000000000E-002 3.262570000000000E-002 3.206440000000000E-002 - 3.151300000000000E-002 3.097130000000000E-002 3.043890000000000E-002 - 2.991570000000000E-002 2.940130000000000E-002 2.889550000000000E-002 - 2.839810000000000E-002 2.790880000000000E-002 2.742750000000000E-002 - 2.695380000000000E-002 2.648760000000000E-002 2.602880000000000E-002 - 2.557700000000000E-002 2.513210000000000E-002 2.469400000000000E-002 - 2.426250000000000E-002 2.383740000000000E-002 2.341860000000000E-002 - 2.300580000000000E-002 2.259900000000000E-002 2.219800000000000E-002 - 2.180270000000000E-002 2.141300000000000E-002 2.102860000000000E-002 - 2.064950000000000E-002 2.027560000000000E-002 1.990680000000000E-002 - 1.954280000000000E-002 1.918370000000000E-002 1.882930000000000E-002 - 1.847950000000000E-002 1.813430000000000E-002 1.779340000000000E-002 - 1.745690000000000E-002 1.712460000000000E-002 1.679650000000000E-002 - 1.647240000000000E-002 1.615230000000000E-002 1.583610000000000E-002 - 1.552360000000000E-002 1.521500000000000E-002 1.491000000000000E-002 - 1.460850000000000E-002 1.431070000000000E-002 1.401620000000000E-002 - 1.372510000000000E-002 1.343740000000000E-002 1.315290000000000E-002 - 1.287160000000000E-002 1.259350000000000E-002 1.231840000000000E-002 - 1.204630000000000E-002 1.177720000000000E-002 1.151100000000000E-002 - 1.124770000000000E-002 1.098720000000000E-002 1.072940000000000E-002 - 1.047440000000000E-002 1.022200000000000E-002 9.972200000000001E-003 - 9.724999999999999E-003 9.480400000000000E-003 9.238200000000000E-003 - 8.998400000000000E-003 8.761100000000001E-003 8.526100000000000E-003 - 8.293399999999999E-003 8.063000000000001E-003 7.834900000000001E-003 - 7.608900000000000E-003 7.385200000000000E-003 7.163600000000000E-003 - 6.944000000000000E-003 6.726600000000000E-003 6.511200000000000E-003 - 6.297800000000000E-003 6.086400000000000E-003 5.876900000000000E-003 - 5.669300000000000E-003 5.463600000000000E-003 5.259800000000000E-003 - 5.057800000000000E-003 4.857600000000000E-003 4.659200000000000E-003 - 4.462500000000000E-003 4.267600000000000E-003 4.074300000000000E-003 - 3.882800000000000E-003 3.692800000000000E-003 3.504500000000000E-003 - 3.317800000000000E-003 3.132700000000000E-003 2.949200000000000E-003 - 2.767100000000000E-003 2.586600000000000E-003 2.407600000000000E-003 - 2.230100000000000E-003 2.054000000000000E-003 1.879300000000000E-003 - 1.706100000000000E-003 1.534200000000000E-003 1.363700000000000E-003 - 1.194600000000000E-003 1.026800000000000E-003 8.603000000000000E-004 - 6.952000000000000E-004 5.313000000000000E-004 3.687000000000000E-004 - 2.074000000000000E-004 4.730000000000000E-005 -1.116000000000000E-004 - -2.693000000000000E-004 -4.258000000000000E-004 -5.811000000000000E-004 - -7.353000000000000E-004 -8.883000000000000E-004 -1.040200000000000E-003 - -1.190900000000000E-003 -1.340600000000000E-003 -1.489200000000000E-003 - -1.636700000000000E-003 -1.783100000000000E-003 -1.928500000000000E-003 - -2.072800000000000E-003 -2.216100000000000E-003 -2.358400000000000E-003 - -2.499700000000000E-003 -2.640000000000000E-003 -2.779300000000000E-003 - -2.917600000000000E-003 -3.055000000000000E-003 -3.191500000000000E-003 - -3.327000000000000E-003 -3.461600000000000E-003 -3.595300000000000E-003 - -3.728000000000000E-003 -3.859900000000000E-003 -3.990900000000000E-003 - -4.121000000000000E-003 -4.250300000000000E-003 -4.378700000000000E-003 - -4.506300000000000E-003 -4.633000000000000E-003 -4.758900000000000E-003 - -4.884000000000000E-003 -5.008300000000000E-003 -5.131700000000000E-003 - -5.254400000000000E-003 -5.376300000000000E-003 -5.497500000000000E-003 - -5.617800000000000E-003 -5.737400000000000E-003 -5.856300000000000E-003 - -5.974400000000000E-003 -6.091800000000000E-003 -6.208400000000000E-003 - -6.324400000000000E-003 -6.439600000000000E-003 -6.554100000000000E-003 - -6.667900000000000E-003 -6.781100000000000E-003 -6.893500000000000E-003 - -7.005300000000000E-003 -7.116400000000000E-003 -7.226800000000000E-003 - -7.336600000000000E-003 -7.445700000000000E-003 -7.554200000000000E-003 - -7.662100000000000E-003 -7.769300000000000E-003 -7.875900000000000E-003 - -7.981900000000000E-003 -8.087300000000000E-003 -8.192000000000000E-003 - -8.296200000000000E-003 -8.399800000000001E-003 -8.502700000000000E-003 - -8.605099999999999E-003 -8.706900000000000E-003 -8.808200000000000E-003 - -8.908900000000001E-003 -9.009000000000000E-003 -9.108500000000000E-003 - -9.207500000000000E-003 -9.306000000000000E-003 -9.403900000000000E-003 - -9.501300000000001E-003 -9.598100000000000E-003 -9.694500000000000E-003 - -9.790300000000000E-003 -9.885500000000000E-003 -9.980299999999999E-003 - -1.007460000000000E-002 -1.016830000000000E-002 -1.026160000000000E-002 - -1.035440000000000E-002 -1.044660000000000E-002 -1.053840000000000E-002 - -1.062970000000000E-002 -1.072060000000000E-002 -1.081090000000000E-002 - -1.090080000000000E-002 -1.099020000000000E-002 -1.107920000000000E-002 - -1.116770000000000E-002 -1.125580000000000E-002 -1.134340000000000E-002 - -1.143050000000000E-002 -1.151730000000000E-002 -1.160350000000000E-002 - -1.168940000000000E-002 -1.177480000000000E-002 -1.185980000000000E-002 - -1.194440000000000E-002 5.078110000000000E+017 -9.816000000000000E-054 - 0.000000000000000E+000 1.00000000000000 1.00000000000000 - 1.00000000000000 1.00000000000000 2.00000000000000 - 2.00000000000000 2.00000000000000 3.00000000000000 - 3.00000000000000 3.00000000000000 4.00000000000000 - 4.00000000000000 4.00000000000000 5.00000000000000 - 5.00000000000000 5.00000000000000 6.00000000000000 - 6.00000000000000 7.00000000000000 7.00000000000000 - 8.00000000000000 8.00000000000000 9.00000000000000 - 9.00000000000000 10.0000000000000 10.0000000000000 - 11.0000000000000 11.0000000000000 11.0000000000000 - 11.0000000000000 11.0000000000000 12.0000000000000 - 13.0000000000000 13.0000000000000 14.0000000000000 - 14.0000000000000 15.0000000000000 15.0000000000000 - 16.0000000000000 16.0000000000000 17.0000000000000 - 17.0000000000000 18.0000000000000 18.0000000000000 - 18.0000000000000 19.0000000000000 19.0000000000000 - 20.0000000000000 20.0000000000000 21.0000000000000 - 21.0000000000000 22.0000000000000 22.0000000000000 - 23.0000000000000 23.0000000000000 24.0000000000000 - 24.0000000000000 25.0000000000000 25.0000000000000 - 26.0000000000000 26.0000000000000 27.0000000000000 - 27.0000000000000 28.0000000000000 28.0000000000000 - 28.0000000000000 29.0000000000000 29.0000000000000 - 29.0000000000000 30.0000000000000 30.0000000000000 - 30.0000000000000 30.0000000000000 30.0000000000000 - 30.0000000000000 30.0000000000000 30.0000000000000 - 31.0000000000000 31.0000000000000 32.0000000000000 - 32.0000000000000 33.0000000000000 33.0000000000000 - 34.0000000000000 34.0000000000000 35.0000000000000 - 35.0000000000000 36.0000000000000 36.0000000000000 - 36.0000000000000 36.0000000000000 36.0000000000000 - 37.0000000000000 37.0000000000000 37.0000000000000 - 38.0000000000000 38.0000000000000 39.0000000000000 - 40.0000000000000 40.0000000000000 41.0000000000000 - 41.0000000000000 42.0000000000000 42.0000000000000 - 43.0000000000000 43.0000000000000 44.0000000000000 - 44.0000000000000 45.0000000000000 45.0000000000000 - 46.0000000000000 46.0000000000000 47.0000000000000 - 47.0000000000000 47.0000000000000 47.0000000000000 - 48.0000000000000 48.0000000000000 48.0000000000000 - 49.0000000000000 49.0000000000000 49.0000000000000 - 49.0000000000000 49.0000000000000 49.0000000000000 - 49.0000000000000 49.0000000000000 49.0000000000000 - 49.0000000000000 50.0000000000000 50.0000000000000 - 51.0000000000000 51.0000000000000 52.0000000000000 - 52.0000000000000 53.0000000000000 53.0000000000000 - 54.0000000000000 54.0000000000000 54.0000000000000 - 54.0000000000000 55.0000000000000 55.0000000000000 - 55.0000000000000 56.0000000000000 57.0000000000000 - 58.0000000000000 58.0000000000000 59.0000000000000 - 59.0000000000000 60.0000000000000 60.0000000000000 - 61.0000000000000 61.0000000000000 62.0000000000000 - 62.0000000000000 63.0000000000000 63.0000000000000 - 63.0000000000000 64.0000000000000 64.0000000000000 - 65.0000000000000 65.0000000000000 66.0000000000000 - 66.0000000000000 67.0000000000000 67.0000000000000 - 67.0000000000000 67.0000000000000 68.0000000000000 - 68.0000000000000 68.0000000000000 69.0000000000000 - 69.0000000000000 69.0000000000000 70.0000000000000 - 70.0000000000000 71.0000000000000 71.0000000000000 - 72.0000000000000 72.0000000000000 72.0000000000000 - 72.0000000000000 73.0000000000000 73.0000000000000 - 74.0000000000000 74.0000000000000 74.0000000000000 - 74.0000000000000 75.0000000000000 76.0000000000000 - 76.0000000000000 76.0000000000000 76.0000000000000 - 77.0000000000000 77.0000000000000 77.0000000000000 - 78.0000000000000 78.0000000000000 78.0000000000000 - 79.0000000000000 79.0000000000000 79.0000000000000 - 80.0000000000000 80.0000000000000 81.0000000000000 - 81.0000000000000 81.0000000000000 81.0000000000000 - 82.0000000000000 82.0000000000000 82.0000000000000 - 82.0000000000000 83.0000000000000 83.0000000000000 - 84.0000000000000 84.0000000000000 85.0000000000000 - 85.0000000000000 86.0000000000000 86.0000000000000 - 87.0000000000000 87.0000000000000 87.0000000000000 - 87.0000000000000 87.0000000000000 88.0000000000000 - 88.0000000000000 88.0000000000000 89.0000000000000 - 89.0000000000000 90.0000000000000 90.0000000000000 - 90.0000000000000 91.0000000000000 91.0000000000000 - 91.0000000000000 92.0000000000000 92.0000000000000 - 93.0000000000000 93.0000000000000 94.0000000000000 - 94.0000000000000 94.0000000000000 94.0000000000000 - 95.0000000000000 95.0000000000000 96.0000000000000 - 96.0000000000000 8.07131000000004 13.1357354599999 - 14.9497831614761 25.9197974264349 33.7897359197236 - 17.5968624734944 26.1107959337053 31.6087529649761 - 24.9546049697993 33.8297356071101 40.9396800400558 - 25.0298043820859 34.8997272446982 40.9696798055956 - 29.5297692130642 37.9997030171499 45.2696461996415 - 25.3698017248709 34.4297309179072 22.1998264994929 - 26.9497893766366 9.48992583244087 17.9498597146800 - 8.64993239732492 12.8398996510580 -0.189998515085750 - 6.66994787169448 -1.12999116866788 2.65997921120050 - 8.37993450746622 10.6099170792621 16.4098717503008 - 4.12996772265340 -4.14996756634664 -0.839993435115946 - -12.6699009796655 -7.00994521447950 -14.5598862086764 - -12.2999038713406 -22.2398261868793 -18.0998585423793 - -24.4198091494421 -23.1398191530750 -32.2707477912223 - -29.7297676499965 -29.7297676499965 -35.6977210080584 - -32.2197481898045 -41.2856773359488 -39.5716907314384 - -43.2196622210848 -40.1396862923263 -46.8896335387937 - -45.3296457307212 -49.0096169702768 -46.2096388532237 - -52.7895874282986 -52.0495932116488 -55.4775664206696 - -52.9495861778445 -59.0095388168952 -58.9295394421223 - -61.8495166213348 -59.7905327131161 -65.1239910300100 - -66.0204840235594 -63.4695039604870 -65.3894889550377 - -65.9394846566018 -63.3895045857141 -67.3234738401737 - -68.1334675097498 -65.0294917685595 -65.6694867667431 - -62.4595118539786 -62.5495111505981 -58.9095395984290 - -58.0795460851597 -62.8095091186102 -59.5295347529194 - -66.3394815304665 -65.7894858289025 -69.9494533170957 - -66.1594829372274 -72.5694328409098 -70.8594462051380 - -74.2094200237552 -71.0894444076102 -76.7893998601827 - -75.1794124428772 -71.7694390931803 -69.1494595693663 - -64.9194926282467 -69.4594571466114 -66.5494798892455 - -62.7695094312237 -69.0794601164399 -67.3794734025148 - -71.4994412033216 -76.5994013450970 -73.0494290895475 - -76.3594032207781 -75.4094106453494 -80.4993708652782 - -77.1393971248144 -80.0293745384871 -79.5093786024629 - -83.8193449183555 -80.8093684425233 -82.9293518740064 - -82.5293550001417 -86.3253253331180 -83.6393463251163 - -85.1593344458023 -84.9093363996369 -82.6193542967613 - -82.2393572665898 -86.7063223554742 -84.2293417140668 - -83.9803436600860 -85.8413291157417 -83.5993466377299 - -83.4393478881840 -81.0993661760753 -80.4993708652782 - -77.8993911851574 -77.1693968903542 -74.3394190077612 - -73.1194285424738 -70.0794523011018 -77.4793944675994 - -76.3894029863180 -78.9793827445922 -73.8694226809702 - -77.5993935297588 -74.8294151782455 -76.7194004072564 - -71.7294394057938 -75.7494079881344 -73.1794280735535 - -68.9994607416670 -66.0494837969146 -68.3594657434834 - -63.9295003654315 -61.7195176373288 -65.5594876264303 - -67.5394721520607 -70.7094473774387 -67.4694726991344 - -68.6794632425752 -67.4394729335945 -70.1454517852895 - -67.3594735588216 -68.4494650401030 -67.0994755908095 - -69.3674578656226 -66.8594774664907 -67.2394744966622 - -65.9294847347552 -63.5395034134133 -65.5064880406432 - -64.3594970048361 -64.6794945039279 -62.1095145893469 - -63.6105028585243 -62.5825108926920 -62.3155129793873 - -60.2695289695691 -58.7925405128236 -56.0995615595293 - -57.7135489455735 -56.4905585037320 -53.7295800818807 - -53.8495791440401 -52.2895913359676 -49.5896124373807 - -50.9856015271686 -49.6596118903070 -49.1096161887430 - -46.6796351800147 -47.4026295295252 -45.9896405725980 - -43.2686618381332 -41.4796758197731 -41.3596767576137 - -38.5996983279470 -39.8926882227148 -38.6566978824728 - -35.4697227899555 -34.2197325591282 -34.3427315978416 - -35.8747196247435 -33.3867390693049 -32.4167466501829 - -29.6897679626100 -29.4397699164446 -28.4297778099361 - -25.5198005525702 -27.4197857034277 -26.5997921120050 - -23.7398144638721 -23.8598135260315 -22.9798204035291 - -20.1998421301692 -22.2988257257744 -20.9548362295889 - -21.0408355574698 -16.7678689524097 -13.6498933206341 - -9.25092770030669 -10.4918180022536 -7.56194090041284 - -3.13997545983818 -0.185298551817839 1.70998663577175 - 5.96995334243119 5.95995342058457 8.35453470597581 - 10.5299177044892 14.1998890221981 14.3798876154373 - 16.3698720629143 18.3821563361094 21.7098303290086 - 23.7898140731052 27.4597853908141 29.5797688222972 - 28.9407738162983 32.7197442821354 34.5597299019132 - 35.9097193512067 39.1496940295111 38.7319972939778 - 40.6116826034867 44.1496549528203 45.5396440895002 - 47.6396276772901 51.2695993076126 50.5718047611555 - 52.7115880378949 54.3095755489846 57.5195504617491 - 57.7520486446830 59.8025326193320 63.1565064066879 - 65.2894897365716 67.1294753563494 70.4894490968131 - 70.7474470804559 72.9854295897291 7.28897545999993 - 0.000000000000000E+000 14.9311833068413 2.42492104827388 - 11.3899109832984 14.0871899029867 14.9080834873757 - 20.9467362928931 11.3479113115426 12.6075014673426 - 20.1758423177373 13.3693955128365 16.5618705623694 - 23.6568151125452 9.87312283760328 13.6928929845746 - 21.0598354089784 13.2738962592013 15.5998780807247 - 3.79897030953033 8.11993653945414 2.82597791385436 - 3.34997381861717 -5.94895350655329 -2.14998319702296 - -6.88794616795076 -5.62995599964616 -15.0162826417561 - -10.7499159851148 -9.78992348783942 -3.89996952018118 - -2.88997741367272 -9.36992677028145 -20.2498417394023 - -15.0398824573141 -20.7698376754264 -19.0098514304216 - -26.8617900643864 -22.9998202472223 -27.5397847655871 - -27.3997858597344 -34.4197309960606 -31.9797500654857 - -35.8067201561865 -36.6107138726546 -35.4197231807224 - -42.3425690759179 -44.2156544370079 -46.5546361569320 - -44.5386519126537 -49.7326113197873 -49.4686133830366 - -51.8625946731170 -49.9296097801657 -55.1058693256308 - -55.2645680853366 -57.4865507196552 -56.2095606998421 - -60.6609259106458 -61.4365198490695 -62.8965084386758 - -61.5035193254418 -65.5120879968773 -67.0973756072217 - -67.2609743286324 -66.2561821814842 -67.3044739886652 - -70.0057528770922 -68.4164652980092 -69.5593563658592 - -70.1409518204585 -68.5904639381403 -69.7294550364701 - -68.0194684006984 -68.5594641804158 -66.4394807489327 - -66.4094809833928 -63.6795023192660 -69.5694562869243 - -69.4294573810716 -72.6394322938361 -70.1894514414146 - -75.4094106453494 -75.9414064875895 -78.6693851673470 - -75.9594063469134 -80.7063692475032 -79.6883772035174 - -81.7163613540116 -79.5693781335427 -77.9693906380837 - -75.1194129117975 -72.9194301055414 -78.9593829008989 - -75.1394127554907 -73.0694289332407 -76.2794038460052 - -73.1894279954001 -77.8893912633108 -79.9593750855608 - -78.9493829790523 -83.5613469347127 -80.6093700055910 - -82.6993536715342 -82.5393549219883 -86.3323252784107 - -83.7093457780427 -85.0193355399497 -85.1093348365692 - -88.3343096321037 -86.0293276464581 -86.6193230354086 - -87.0393197529666 -90.0188964663850 -88.0923115234155 - -88.7169066419553 -86.4153246297376 -87.4493165486780 - -87.7293143603833 -85.6993302255197 -89.2011028577686 - -89.9452970415939 -87.8203136491875 -88.2393103745608 - -85.9013286468214 -86.0233276933502 -83.5993466377299 - -83.4393478881840 -80.6393697711308 -80.3793718031187 - -82.0993583607371 -79.6093778209291 -82.9293518740064 - -82.6693539059944 -83.7953451059236 -79.4293792276900 - -82.2143574619732 -80.0293745384871 -80.6293698492842 - -77.2393963432806 -74.9994138496380 -70.9494455017576 - -74.0094215868228 -72.0294370611924 -67.8194699637660 - -69.4594571466114 -72.2394354199714 -72.5094333098301 - -71.3694422193156 -73.6814241502537 -70.9444455408343 - -71.2894428445426 -70.7594469866718 -72.4534337474890 - -70.1954513945226 -70.0824522776558 -69.4644571075348 - -70.6904475259302 -68.5614641647851 -67.9424690024794 - -67.4654727303957 -65.7594860633626 -66.3814812022223 - -65.9664844455876 -64.8954928158148 -63.0665071100683 - -63.2855053985092 -62.9845077509260 -60.9165239130453 - -60.1035302669153 -59.2045372929043 -57.3795515558964 - -56.2255605747967 -56.9395549946452 -54.6905725713407 - -53.4895819575619 -52.3815906169565 -50.2996068884906 - -50.4616056224058 -49.7786109602818 -48.4246215422496 - -46.4166372354487 -45.2786461293035 -42.8206653394047 - -43.3696610487840 -42.4976678637589 -41.2046779689911 - -39.0056951549197 -37.9697032516101 -35.5197223991886 - -36.3877156154751 -34.8257278230333 -34.5187302223421 - -32.5137458920951 -31.6917523163031 -32.6517448135784 - -30.4307621714445 -29.9207661572669 -29.1037725423982 - -27.2997866412682 -26.3997936750726 -27.3557862036093 - -25.2768024516973 -24.7028069377014 -23.8368137057843 - -22.2688259602345 -22.4628244440589 -21.7588299460570 - -17.6238622624803 -14.7378848175462 -11.8649072710127 - -8.13493642222407 -5.24295902418203 -1.20899055125617 - -0.540495775809725 1.76898617466680 4.38196575318818 - 8.09893670357625 8.83063098509331 10.5989171652308 - 13.2648963295393 16.3378723130052 17.2346653042099 - 18.8128529700432 21.9871281618153 23.6655150445517 - 27.1847875400321 28.8947741758039 30.7197599128117 - 33.7597361541837 33.8119357462231 35.4469229681452 - 37.4868070256369 40.3486846589206 42.3196692548891 - 42.4416683014178 45.3883452719609 47.3066302797977 - 49.3060146538106 52.2095919611947 52.9525861543984 - 54.7145723837726 57.1696531963359 59.8781320284925 - 61.8968162516693 64.9194926282467 65.5294878608904 - 67.3884733321768 69.8474541142602 72.9494298710813 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 25.1298036005521 11.6799087168503 18.3748563931613 - 15.7699767513357 4.94172137847450 12.4160029639799 - 12.0516058118891 8.66783225743037 0.000000000000000E+000 - 3.12500557683379 3.01989639830399 0.101509206665023 - 5.68155559637471 7.86993849328868 -0.783023880355761 - 3.33137396398246 -1.709986635771748E-002 -4.699963267910651E-002 - -8.02603727331440 -5.15505971115025 -8.41743421439104 - -9.35692687188084 -16.2122732946116 -14.5848860132929 - -16.8480683256196 -18.2118576670614 -15.8898758142766 - -15.0998819883938 -11.2899117648322 -20.5698392384941 - -24.5498081334482 -24.9398050854663 -30.6656603356215 - -26.9077897048808 -29.7977671185535 -29.8027670794768 - -35.0399261489878 -33.0674415647424 -35.0225262849747 - -36.5877140524074 -41.4656759291879 -40.8092810591759 - -43.1378628603794 -44.3301535421517 -44.4976522330826 - -48.5583204973389 -51.4316980407462 -52.1986920463819 - -51.4384979876019 -55.2832679391898 -56.9308550626386 - -57.7095489768348 -56.9083552384838 -60.1785296807649 - -62.1513142626658 -62.2259136796416 -61.6461182109746 - -64.2185981060172 -66.7448783621284 -65.5779874818465 - -65.4224886971316 -65.9090848941880 -68.8977615364869 - -67.8790694979719 -67.0846757064765 -69.3209582290358 - -68.9046614825611 -69.9052536625337 -72.5820327424365 - -71.2929428171889 -73.4215261814601 -71.8555384202797 - -73.2129278117397 -71.2137434361637 -71.7594391713337 - -73.7194238532709 -72.0594368267322 -76.3904029785027 - -77.5853936391736 -79.0243823929020 -77.7583922871201 - -81.4711632703325 -83.2623492714988 -84.5950388559977 - -82.6013544374374 -86.2023262944046 -85.9340283912599 - -83.6653461219176 -82.8913521709893 -80.2793725846526 - -82.3813561568117 -81.2323651366353 -78.4293870430282 - -82.9535516848753 -81.2913646755303 -82.3453564381639 - -86.1883264038194 -83.5153472942183 -84.5993388223917 - -84.9093363996369 -88.0983114765235 -85.9373283654693 - -86.3713249736125 -86.8593211597275 -89.5223003474819 - -87.6053153294852 -87.4553165017859 -88.2253104839755 - -90.5771921030817 -89.0496040417923 -88.5753077486072 - -89.5403002068059 -88.2523102729614 -88.9433048725627 - -91.6528836961225 -90.0659960982826 -91.1010880086261 - -89.5876998363588 -88.3226097235431 -89.2168027350678 - -87.6127152716517 -88.2513102807767 -86.4013247391524 - -86.7033223789202 -84.7293378063978 -84.6293385879316 - -82.3793561724424 -85.2003341253735 -85.2123340315894 - -85.9013286468214 -83.9693437460547 -86.5053239263572 - -86.4243245593996 -86.5593235043289 -82.7693531244606 - -84.9243362824068 -83.2843490995614 -79.9793749292540 - -77.8193918103844 -78.3093879808687 -74.9294143967117 - -72.9194301055414 -75.7594079099811 -75.4394104108893 - -77.4063950381191 -74.3734187420397 -73.5494251818784 - -73.3854264635938 -74.7604157175039 -72.5564329425092 - -71.7254394370552 -71.8244386633367 -72.5354331066313 - -70.8244464786749 -69.4744570293814 -69.5354565526458 - -67.8394698074593 -68.0554681193462 -68.1804671424290 - -66.3784812256683 -64.9364924953859 -64.5174957700126 - -64.9204926204314 -62.5365112521975 -61.3055208728788 - -61.2685211620463 -59.7905327131161 -59.3015365348165 - -59.2495369412141 -57.5455502585503 -55.5615657641812 - -55.1585689137625 -53.3805828094337 -52.8785867327335 - -52.4335902105589 -50.3466065211697 -48.9136177205493 - -48.2366230115332 -48.2276230818713 -46.3466377825223 - -45.6866429406455 -43.8016576725579 -41.9096724591777 - -41.2076779455451 -41.1246785942182 -38.9776953737492 - -38.6986975542286 -36.6977131927202 -36.2827164360856 - -34.4577306990777 -34.7647282997689 -32.8017436412777 - -31.1617564584323 -31.1497565522163 -29.5907687363285 - -29.5567690020500 -29.5137693381096 -27.6717837339625 - -25.9877968949919 -25.7687986065510 -24.3528096730698 - -23.7768141747046 -23.7948140340285 -20.0578432399472 - -18.8788524542309 -18.2678572294025 -14.8008843251799 - -12.4439027459319 -10.3809188689746 -6.66294792640184 - -4.47896499510038 -1.26199013704324 2.23698251708854 - 3.64897148183106 5.21195926645751 8.61693265523108 - 11.4699103580713 12.9568987366635 14.3118881468803 - 17.8248606915973 20.2188419816778 21.6258309854970 - 24.3008100794674 25.8497979735086 26.7577908771815 - 29.5806688152634 30.8610588085045 33.4228387871712 - 35.9337191636386 36.9144114991365 38.1423019026827 - 40.9160802244977 43.4256606111251 44.8689493312475 - 47.4522291418845 48.5847202910140 50.1224082733685 - 52.9317863169575 55.4622665402443 57.1769531392839 - 58.4491431966107 61.0008232542123 62.6155106347858 - 65.4834882203960 67.9894686351585 69.7210551021190 - 71.1692437839463 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 27.9397816394518 22.9217208576002 - 28.9118740421616 15.7027772765264 10.6499167666486 - 17.3378644976670 5.34555822232834 2.86341762124810 - 2.85537768408342 -4.73698297858683 -0.809893670357625 - 0.872493181117456 -1.48736837562233 -7.04294495657334 - -5.73305519388480 -5.18395948528698 -9.52952552295348 - -13.9304911276502 -13.1906969094374 -12.2075045934779 - -17.1941656207311 -21.4910320390045 -21.8935288933309 - -24.4315090580027 -22.9485206481492 -24.0918117128731 - -26.3366941682204 -29.9309660775505 -28.8460745564109 - -29.5215692771499 -31.7615517707925 -34.7147286905358 - -33.2407402103442 -33.5349379110718 -35.5594220889197 - -38.5435987663875 -38.4050998488119 -37.8104044965934 - -41.0661790514155 -41.7552736658659 -44.9306488490412 - -48.4873210522279 -47.9565252006094 -49.2189153345265 - -51.4473979180454 -55.4148669106913 -54.6869725994759 - -55.5538658243593 -57.4781507853041 -60.6036263584647 - -59.3419362190768 -59.8435322989032 -61.1524220694071 - -64.4696961435858 -61.9802155998701 -62.7955092280249 - -62.2106137992162 -66.0006841783031 -62.6533103393660 - -63.7228019808619 -66.8779773219069 -66.9714765911728 - -67.0954756220709 -70.5608485387980 -67.8924693932463 - -68.2314667438467 -70.9484455095729 -70.8591462074826 - -73.0333292153744 -72.2900350245152 -73.9151223238092 - -72.7394315123023 -75.9200066548377 -77.7606922691448 - -77.9753905911917 -77.4973943269233 -79.9839748933035 - -82.4312557668264 -82.1581579011952 -82.7370533768960 - -84.8682367208473 -87.9099129489332 -87.6946146315755 - -86.4800241240852 -86.3488251494576 -84.8213370873867 - -84.2263417375129 -87.2632180031124 -85.6627305115611 - -85.4440322207756 -85.6109309163956 -83.5293471848035 - -85.9688281192861 -86.0181277339899 -86.3263253253027 - -89.0998036494623 -87.2607180226507 -86.9513204407164 - -87.8543133834660 -89.9122972995001 -88.3703093507515 - -87.6013153607466 -88.7213066075678 -90.3482938920126 - -89.2533024498079 -87.9993122502420 -89.3713015275980 - -90.5592922429763 -90.0343963452473 -91.5253846925781 - -90.3981935020273 -87.9663125081481 -89.4823006600955 - -88.4203089599846 -88.5073082800502 -90.3032942437029 - -89.1648031414653 -90.5175925688759 -89.0183042864124 - -90.0652961037533 -88.2843100228706 -88.9916044950819 - -87.0063200108728 -87.3473173458425 -87.4503165408626 - -85.7053301786277 -87.6613148918263 -88.1243112733247 - -87.6643148683803 -86.3573250830272 -87.7323143369373 - -88.2723101166547 -87.2303182602370 -84.3193410106864 - -83.0073512644101 -80.0173746322712 -81.6093621902528 - -80.4303714045365 -77.1193972811212 -76.8393994694158 - -78.1433892782149 -76.8693992349557 -76.0624055419336 - -77.0483978360102 -74.5734171789721 -72.8834303868936 - -73.3624266433466 -73.7034239783163 -72.0704367407635 - -70.0974521604257 -70.7664469319645 -70.4094497220402 - -69.1704594052442 -69.6734554741291 -67.2024747858297 - -66.0464838203606 -65.1674906900428 -65.9394846566018 - -62.9235082276617 -61.8735164337667 -60.5825265233683 - -61.5645188487062 -60.3605282583734 -60.7585251478688 - -57.8205481093323 -56.7255566671276 -56.8705555339035 - -55.8295636696706 -54.5475736889341 -54.5665735404427 - -51.7205957828951 -50.5196051691162 -49.2826148366895 - -49.6236121716592 -46.4396370556959 -45.4296449491874 - -45.7906421278503 -44.1906546323914 -42.7866656051262 - -42.9866640420585 -39.7096896529217 -38.3227004927957 - -38.4796992657876 -36.6997131770895 -35.6977210080584 - -32.7677439069992 -33.3597392803190 -32.2557479084523 - -32.5717454388055 -31.8457511127410 -30.7347597955817 - -30.9637580058692 -28.0797805453045 -27.0597885169494 - -27.1847875400321 -25.9417972544975 -24.7938062265057 - -25.1168037021515 -21.0698353308250 -20.0328434353307 - -17.1498659669506 -17.4748634269657 -16.3728720394683 - -15.9628752437570 -11.6529089278644 -8.62493259270837 - -6.58894850473687 -3.38897351381898 -1.17899078571631 - 0.244998085242151 4.30696633933855 7.04994490186598 - 9.37692671557408 10.2629197911845 14.5178865369206 - 16.6168701325258 19.2558495078484 19.9928437479442 - 22.3028256945130 23.1888187701234 25.8060983150389 - 28.8697743711873 29.8867664229884 32.1652486157404 - 33.7797359978770 34.5967296127457 38.0097029389966 - 39.9506877694252 41.0391792624296 42.8886648079617 - 45.0866476298484 46.1604392377383 49.3886140082636 - 51.4425979555591 53.6955803476022 54.8010717077459 - 58.6845413568801 60.6455260310020 61.8105169261330 - 64.0194996620510 66.1494830153808 67.2424744732161 - 71.1154442044115 73.1694281517069 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 35.0847257988607 0.000000000000000E+000 39.4996912941427 - 25.2298028190182 32.0697493621052 23.1048194266118 - 8.00823741242742 17.6598619811281 10.6919164384044 - 1.95164474711713 5.31895843021633 1.75088631612442 - 6.84394651182564 -2.18578291723385 -0.394096919975231 - -5.47055724541107 -5.199959360241571E-002 -8.91283034267252 - -7.14304417425799 -12.3852032046923 -7.15944404608645 - -16.9491675354889 -20.2043420950002 -24.4393089970431 - -24.3045100505506 -26.5856922222012 -24.4381090064215 - -29.0134732481232 -30.2310637321675 -30.9476581316962 - -28.8017749026303 -33.8059357931151 -34.8465276604742 - -35.1382253807401 -32.1204489658676 -36.1847172019887 - -37.5459065637504 -39.0036951705504 -44.1223551661790 - -42.0007717472004 -44.4724524300291 -45.3286457385366 - -50.2576072167348 -48.2394229896503 -50.7038037295309 - -50.9438018538497 -56.2509603762871 -54.0234777849528 - -56.0362620542402 -56.0985615673446 -60.2238293267301 - -56.3517595885010 -58.3428440273812 -56.5795578081669 - -61.1685219435801 -56.6895569484797 -58.8355401767641 - -56.4095591367744 -61.6205184110473 -62.4495119321319 - -58.7695406925764 -63.1195066958554 -64.3384971689582 - -63.0895069303155 -67.8934693854310 -68.2084669235995 - -72.2121356333301 -72.1684359748604 -75.2586118239024 - -74.6055169280997 -77.0308979727786 -76.0694054872262 - -75.8904068861717 -77.7063926935176 -80.5903701540824 - -78.9863826898848 -79.7513767111511 -81.0943662151520 - -84.5114395093599 -83.0065512706623 -84.2973411826238 - -84.8588367943115 -88.7639062746344 -87.8918130903908 - -88.4554086856662 -87.1160191535302 -86.3664250119077 - -86.7858217341548 -85.6073309445309 -87.5438158101285 - -88.1147113483519 -87.3255175162168 -89.2209027030249 - -87.9509126285043 -86.7763218084005 -88.0233120626739 - -89.3993013087685 -88.4213089521693 -86.9283206204691 - -88.4033090928453 -89.2503024732539 -88.5393080299594 - -86.4083246844450 -88.4043090850300 -88.6573071077495 - -88.3313096555497 -84.8693367122504 -87.0043200265034 - -86.9293206126538 -88.6533071390108 -87.6703148214882 - -87.1883185884812 -89.4033012775072 -86.1393267867710 - -86.1593266304642 -87.9693124847021 -87.3603172442431 - -88.8403056775426 -87.9103129458071 -88.9793045912106 - -87.7333143291219 -88.5043083034962 -86.8963208705600 - -88.4203089599846 -89.2853021997171 -88.0883115546769 - -86.9083207767759 -87.8693132662359 -88.9053051695456 - -87.1293190495862 -86.5233237856811 -86.9653203313016 - -88.0803116171996 -85.4373322731383 -84.5343393303887 - -83.0643508189358 -80.7493689114436 -79.6243777036991 - -80.9223675593901 -79.0393822756719 -79.3343799701471 - -77.1343971638911 -74.7554157565805 -74.6494165850064 - -74.7024161707935 -73.1184285502891 -70.2394510506477 - -71.2554431102641 -70.5264488076456 -69.4244574201483 - -66.4324808036401 -67.3174738870658 -66.3874811553303 - -65.1964904633980 -66.3344815695432 -62.7695094312237 - -61.9775156209716 -60.1605298214410 -61.5815187158455 - -57.4495510088227 -57.0995537441911 -57.8805476404120 - -57.3185520326320 -55.2995678117998 -56.3295597620015 - -55.2695680462599 -51.9795937587225 -52.3495908670474 - -51.4695977445449 -49.7196114213867 -50.4296058724966 - -46.5896358833952 -45.8286418308675 -43.4096607361705 - -44.5796515922248 -43.4896601109434 -44.2326543041472 - -40.2896851200256 -39.1556939826190 -36.8097123174024 - -37.7877046740016 -36.5697141930835 -37.3177083472106 - -33.8697352944965 -31.9697501436390 -31.0197575682103 - -32.2057482992192 -31.0497573337502 -27.3497862505013 - -28.3297785914699 -27.4997850782006 -25.2798024282513 - -26.1597955507538 -25.3268020609304 -21.0398355652851 - -21.5998311886958 -20.8198372846595 -17.5758626376165 - -18.1898578389989 -13.3098959778491 -12.6399012141257 - -12.8878992759218 -11.9759064035102 -8.76093152982238 - -8.66593227227951 -5.70595540568046 -4.32796617521645 - 0.308997585060509 2.97497674936898 5.88095403799628 - 6.64394807489327 11.5599096546909 13.7468925625463 - 16.9338676550636 17.1968655996297 22.3298254834989 - 23.7978140105825 24.3198099309760 26.0287965745630 - 26.8317902988465 29.2207716280036 31.2007561536341 - 31.6067529806068 35.6257215707627 37.2897085660400 - 40.0416870582294 40.3416847136280 42.1596705053432 - 46.0196403381379 46.6396354926282 48.4166216047723 - 51.0896007143734 51.7115958532331 56.0995615595293 - 57.7995482734544 60.9095239677527 61.4645196302400 - 63.3765046873135 64.0956990665223 68.5494642585692 - 70.2194512069544 73.4994255726453 74.0684211257179 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 33.6097373264845 0.000000000000000E+000 - 24.1098115721970 16.4778712188578 25.3198021156378 - 12.9298989476776 17.5678627001392 10.9119147190300 - 18.2098576826921 6.76794710579134 10.7399160632682 - 3.82397011414688 11.2599119992923 -0.589995388950486 - 4.18996725373311 -3.15997530353142 -14.0618901007148 - -19.0439511639186 -26.0148966831962 -21.0028358544526 - -18.3790563603369 -23.0487198650523 -17.4258638099172 - -24.7992061843029 -22.0598275936402 -27.2817867819443 - -20.5268395745536 -28.6432761413614 -25.1218036630748 - -29.3237708230238 -23.8498136041849 -31.8787508548348 - -37.0705102791622 -34.6177294486236 -42.8176653628507 - -37.6127060416858 -42.6253668657402 -40.2276856045765 - -48.3316222690761 -42.6396667539809 -48.0092247887411 - -45.3336456994599 -53.9015787376425 -47.6196278335969 - -51.6612962463446 -47.5896280680570 -54.1835765337172 - -47.7496268176029 -51.7695953999435 -47.5496283806705 - -54.4295746111440 -47.1496315068058 -51.5195973537780 - -56.6495572610933 -54.1695766431319 -56.2995599964616 - -61.5895186533228 -56.4895585115474 -58.9295394421223 - -63.6695023974194 -65.2944896974949 -69.1584594990282 - -70.3024505582814 -73.2409275929102 -73.4574259008895 - -74.4384182340427 -77.8963912086034 -75.4444103718126 - -76.2124043696328 -76.7364002743956 -80.6403697633155 - -77.8343916931544 -79.2383807204196 -79.4293792276900 - -83.6203464736078 -80.6203699196222 -82.6533540310398 - -86.6362229033294 -86.4474243788653 -87.2083184321745 - -88.4116090279780 -87.7114145002778 -88.7942060378297 - -87.2233183149444 -86.4333244890615 -87.6191152216335 - -85.5913310695763 -87.4093168612915 -87.9243128363923 - -87.4773163298485 -85.1493345239557 -87.0743194794298 - -87.1303190417708 -86.9863201671795 -84.0993427300608 - -86.5233237856811 -85.8333291782644 -85.9403283420232 - -81.7393611742588 -84.4423400493998 -82.1893576573567 - -82.4193558598289 -85.3693328045813 -85.1633344145410 - -81.3693640659340 -83.8193449183555 -83.9993435115946 - -82.3493564069026 -85.1593344458023 -85.2893334298084 - -87.4493165486780 -87.1093192058929 -89.1613031688190 - -88.3153097805951 -89.8604977043346 -88.6968067990436 - -89.8803975488094 -88.0653117344297 -87.1743186978959 - -87.5683156186527 -88.9673046849946 -86.6693226446417 - -86.0393275683048 -85.9093285842987 -87.5643156499141 - -84.8533368372958 -84.6923380955653 -86.0173277402422 - -83.7893451528156 -83.9993435115946 -83.7453454966905 - -81.4293635970137 -79.4413791339059 -79.2643805172208 - -76.2344041976954 -76.4384026033664 -75.7644078709043 - -74.1674203519994 -70.8524462598454 -71.3284425397444 - -70.3914498627163 -69.1564595146589 -65.4294886424242 - -66.8894772320305 -65.0294917685595 -64.3894967703759 - -66.0514837812839 -61.6795179499423 -61.5395190440897 - -59.1695375664411 -60.8795242022129 -56.1595610906090 - -56.0995615595293 -53.1495846147768 -55.0995693748674 - -54.5295738296102 -56.1195614032225 -51.5995967285510 - -51.4095982134652 -52.3695907107406 -50.0796086078650 - -49.4496135315280 -50.5696047783493 -46.1196395566041 - -45.7696422919725 -42.8896648001463 -44.2196544057466 - -39.3396925445968 -38.9796953581185 -40.0896866830932 - -39.5096912159893 -36.4897148183106 -37.8297043457574 - -32.8697431098347 -32.4897460796632 -33.4097388895521 - -32.8757430629427 -30.4797617884929 -25.5898000054965 - -27.0197888295629 -26.8097904707839 -27.8497823428323 - -25.1498034442453 -24.6298075082211 -25.8997975827417 - -20.6098389258805 -20.4598400981813 -21.4098326736100 - -17.7798610432875 -17.3598643257296 -18.2498573700786 - -12.9598987132175 -12.7299005107452 -8.68993208471139 - -9.55992528536720 -8.99392970884859 -9.60792491023096 - -4.21996701927297 -3.68997116140219 -3.55597220865751 - -0.964992458198676 2.53098021937912 3.28497432661415 - 8.70093199874267 10.8369153051804 14.4698869120568 - 14.6628854036966 0.000000000000000E+000 21.9588283829894 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 27.1857875322168 28.8797742930340 0.000000000000000E+000 - 33.7577361698144 35.2317246500060 0.000000000000000E+000 - 38.3617001879975 0.000000000000000E+000 44.4596525300654 - 44.6496510451512 47.8896257234555 49.1696157198227 - 49.3976139379256 54.2795757834447 55.7095646075111 - 59.1895374101343 59.3315363003563 64.7994935660873 - 65.9694844221416 66.3794812178530 67.9294691040788 - 71.5394408907081 71.8904381475244 77.2593961869738 - 78.5993857144207 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 4.83996217376331 -7.06994474555921 -13.3288958293577 - -9.38492665305137 -1.47998843329952 -11.1689127104881 - -6.64994802800124 -13.1638971188885 -4.45996514359181 - -14.0798899600387 -9.03992934934304 -15.7798766739638 - -8.01993732098796 -18.0198591676064 -13.4998944929348 - -19.4598479135194 -29.4607697523225 -22.9198208724494 - -29.1697720265859 -24.4698087586752 -34.4297309179072 - -27.2297871883419 -34.2297324809748 -29.4097701509047 - -39.2096935605908 -31.5297535823878 -38.4996991094809 - -32.6297449855159 -42.2596697238094 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 -47.0796320538795 0.000000000000000E+000 - -46.6196356489350 -51.1396003236065 -46.4996365867756 - -53.8695789877333 -56.9795546820317 -62.0195152927274 - -64.1594985679037 -69.0994599601332 -70.2354510819090 - -74.1494204926755 -70.8594462051380 -72.1894358107383 - -71.4594415159351 -75.9984060421152 -72.4394338569037 - -73.6914240721003 -73.1294284643204 -77.9393908725438 - -74.4294183043808 -76.4194027518579 -75.2194121302636 - -80.1663734677858 -82.1983575870186 -86.8063215739404 - -86.8023216052018 -84.1553422924019 -86.0123277793189 - -85.8203292798638 -86.0693273338446 -88.2253104839755 - -85.5163316557266 -85.2293338987287 -85.4273323512917 - -82.3293565632093 -84.7993372593241 -83.8493446838953 - -84.3353408856410 -80.5853701931591 -83.4993474192637 - -81.8993599238047 -82.6193542967613 -77.4293948583663 - -80.8393682080632 -77.5493939205257 -78.5393861833410 - -73.0694289332407 -76.6194011887902 -77.6093934516054 - -80.8493681299098 -78.0693898565499 -78.8293839168929 - -82.0493587515040 -77.1493970466610 -78.0093903254702 - -80.8893678172963 -81.5293628154799 -84.0393431989811 - -84.3293409325330 -86.2053262709586 -85.9343283889153 - -87.5623156655448 -86.8623211362815 -86.7253222069828 - -88.4523087098938 -85.5693312415137 -85.2673336017458 - -84.5493392131586 -86.4993239732492 -83.2093496857117 - -83.1273503265695 -82.0493587515040 -84.2193417922202 - -84.2023419250810 -85.9483282795005 -82.9583516473616 - -81.4153637064284 -81.2693648474678 -80.9833670826545 - -77.5343940377558 -76.2674039397893 -75.1304128258287 - -71.0974443450876 -71.6074403592651 -70.1154520197496 - -69.1544595302896 -64.6344948556181 -66.0544837578379 - -63.9295003654315 -63.0895069303155 -58.4295433497913 - -60.1895295947962 -60.1295300637165 -57.3995513995896 - -59.3395362378336 -54.3695750800643 -54.5795734388433 - -51.2595993857659 -53.4795820357152 -47.9496252545353 - -48.3996217376331 -50.0296089986319 -50.1196082952514 - -46.8996334606403 -48.8096185333444 -48.4696211905594 - -43.5796594075630 -45.1496471374821 -44.9696485442430 - -41.6196747256258 -43.3496612050908 -37.8897038768371 - -37.9297035642236 -34.0597338095823 -35.9797188041330 - -35.6297215395014 -37.2097091912671 -31.7297520193202 - -31.6897523319337 -28.0597807016112 -29.8797664776958 - -29.2097717139724 -30.9597580371306 -25.6697993802694 - -22.2898257961124 -22.0698275154868 -23.8098139167984 - -23.5498159487863 -17.7598611995943 -19.4098483042863 - -19.2998491639735 -15.0498823791607 -16.7398691712392 - -16.4098717503008 -10.5199177826426 -11.9699064504022 - -11.9699064504022 -7.59994060342999 -8.96992989641671 - -2.64997928935388 -2.76997835151330 -3.75997061432852 - -3.63997155216910 0.779993904036236 -0.109999140312802 - 0.289997733551934 8.999929661956566E-002 5.94995349873795 - 7.97993763360149 12.1409051139794 12.3619033867897 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 54.2795757834447 0.000000000000000E+000 - 58.0295464759266 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 70.0194527700221 - 70.1304519025195 0.000000000000000E+000 76.9993982189617 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - -2.20998272810267 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 -12.4699025427332 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 -57.5095505399024 -60.6095263123542 - -65.1094911433324 -67.0894756689629 -65.4594884079641 - -70.3894498783470 0.000000000000000E+000 -67.9094692603856 - 0.000000000000000E+000 -71.4394416722419 0.000000000000000E+000 - -69.3394580844520 0.000000000000000E+000 -72.9194301055414 - 0.000000000000000E+000 -70.9694453454508 -75.9794061906067 - -78.9353830884670 -83.6093465595765 -82.5703546797128 - -83.4513477943999 -86.0743272947679 -82.5593547656816 - -83.1673500139560 -82.1113582669530 -77.9293909506972 - -81.3293643785475 -79.4293792276900 -80.5993700837443 - -75.8494072066006 -79.3393799310704 -76.9893982971151 - -78.3993872774883 -72.3994341695173 -76.1194050964593 - -71.7594391713337 -73.4694258071054 -67.4394729335945 - -71.4394416722419 -67.0894756689629 -68.6994630862685 - -73.2694273701730 -74.4794179136139 -68.6694633207286 - -72.5294331535233 -73.6394244784979 -70.5694484715861 - -74.2594196329883 -75.3894108016562 -78.7493845421199 - -79.4593789932298 -82.5593547656816 -82.7593532026139 - -85.4813319292635 -85.1153347896772 -87.3023176975327 - -83.7693453091224 -83.7393455435825 -82.1693578136634 - -84.7693374937842 -80.9893670357625 -81.3993638314738 - -79.4093793839968 -82.0293589078108 -77.4993943112926 - -78.1793889968627 -80.4693710997383 -81.0593664886888 - -79.5103785946476 -81.9633594236231 -80.6553696460854 - -77.1103973514592 -75.2064122318630 -70.6394479245124 - -71.4334417191339 -69.1394596475197 -68.6004638599869 - -63.7095020848059 -64.9534923625252 -62.4395120102853 - -62.0565150035598 -56.9395549946452 -58.4895428808711 - -55.5295660142720 -55.2895678899532 -57.5495502272889 - -52.0795929771887 -52.3395909452007 -48.7696188459580 - -51.2795992294592 -45.3596454962611 -46.0996397129109 - -41.9496721465642 -44.4996522174519 -44.8896491694700 - -46.9196333043336 -41.0996787896016 -41.5096755853130 - -43.3696610487840 -39.6196903563021 -39.7096896529217 - -41.8096732407116 -35.8197200545871 -36.2697165376850 - -32.0097498310255 -34.1197333406620 -27.6397839840533 - -28.1797797637707 -30.0097654617018 -30.2197638204808 - -26.1397957070605 -28.3497784351632 -21.9298286096342 - -22.2898257961124 -24.0198122755774 -24.1598111814301 - -20.2298418957090 -13.6698931643274 -15.5598783933382 - -15.9798751108962 -17.6798618248213 -13.2098967593829 - -13.2298966030762 -15.0698822228539 -8.46993380408579 - -8.66993224101816 -10.5199177826426 -5.87995404581162 - -5.99995310797104 -7.76993927482250 -1.03999187204831 - -1.17999077790097 3.69997108324881 1.92998491639735 - 1.96998460378383 0.609995232643723 7.39994216649762 - 7.17994388587201 6.16995177936356 6.13995201382370 - 10.8699150472742 10.3899187986365 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 -57.9595470230003 -63.8495009906585 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 -77.3093957962069 - 0.000000000000000E+000 -78.3393877464086 -79.6323776411763 - -77.7593922793047 -81.2693648474678 -76.5094020484774 - 0.000000000000000E+000 -75.5294097075088 -70.1294519103349 - -74.0994208834424 -71.1494439386900 -73.0894287769339 - -66.1894827027672 -70.3994498001936 -65.3194895021114 - -67.4694726991344 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 -62.6295105253711 -66.8494775446440 - 0.000000000000000E+000 -64.5294956762286 -69.0494603509001 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - -77.7593922793047 -78.6793850891936 -81.1193660197685 - -81.5993622684062 -79.4693789150765 -82.3393564850560 - -77.9693906380837 -78.4693867304146 -76.2894037678518 - -79.1893811033712 -74.2094200237552 -75.0294136151779 - -72.2994349510511 -75.4794100982757 -75.9094067376803 - -78.9773827602228 -74.4094184606875 -75.6354088790830 - -77.9353909038052 -75.9094067376803 -70.5094489405064 - -67.7694703545329 -67.5294722302141 -62.0395151364206 - -63.4395041949472 -60.4095278754218 -60.3095286569556 - -54.5295738296102 -56.4495588241609 -53.0595853181573 - -53.2695836769363 -47.2296308815787 -49.4896132189145 - -49.9296097801657 -46.1296394784507 -48.7596189241114 - -42.3696688641222 -43.0796633152321 -38.6696977808734 - -41.4796758197731 -34.6497291985328 -35.6997209924277 - -38.1297020011560 -38.9196958270388 -34.1597330280485 - -36.8397120829422 -37.4097076281995 -30.8897585842043 - -33.1597408433866 -33.8397355289567 -29.3497706198250 - -31.6297528008540 -24.7498065703806 -25.6297996928830 - -20.7898375191197 -23.2098186060013 -23.6898148546390 - -26.0397964885943 -19.1098506488878 -19.8598447873842 - -14.9398832388479 -17.4998632315822 -17.8598604180605 - -20.2198419738624 -13.0498980098370 0.000000000000000E+000 - -8.30993505453990 -10.8099155161945 -11.0599135623600 - -4.04996834788045 -6.02995287351090 -6.66994787169448 - 0.000000000000000E+000 -3.73997077063528 -3.94996912941427 - 3.15997530353142 1.22999038713406 0.869993200655801 - 5.97995326427781 3.95996905126089 0.000000000000000E+000 - 0.000000000000000E+000 9.11992872411599 8.85993075610391 - 0.000000000000000E+000 0.000000000000000E+000 12.2399043402609 - 10.8699150472742 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - -69.8794538641694 -71.4794413596284 -68.5094645711827 - -71.9394377645728 -72.9394299492347 -67.8094700419194 - -64.2094981771368 0.000000000000000E+000 -61.5295191222431 - -57.9395471793070 -58.1995451473191 -51.8095950873300 - -53.8695789877333 -50.0496088423251 -50.4496057161899 - -43.8096576100352 -46.4696368212357 -42.2196700364229 - -42.7996655035268 -45.7496424482792 -38.8396964522659 - -39.7096896529217 -34.8497276354651 -38.0397027045364 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 -30.5497612414192 -33.5297379517115 - -26.1797953944470 -27.3197864849615 -29.9097662432357 - -24.9298051636197 -25.6397996147296 -28.5397769502489 - -21.1898343929844 -22.4098248582718 -16.7998687023189 - -19.8598447873842 0.000000000000000E+000 0.000000000000000E+000 - -15.8298762831969 -16.8998679207851 -11.7399082479300 - -14.3298880062042 0.000000000000000E+000 0.000000000000000E+000 - -9.86992286261236 -10.8499152035810 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 6.27995091967636 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 - 0.130000000000000 0.250000000000000 0.380000000000000 - 0.500000000000000 0.630000000000000 0.750000000000000 - 0.880000000000000 1.00000000000000 1.13000000000000 - 1.25000000000000 1.38000000000000 1.50000000000000 - 1.63000000000000 1.75000000000000 1.88000000000000 - 2.00000000000000 2.13000000000000 2.25000000000000 - 2.38000000000000 3.94000000000000 2.63000000000000 - 2.75000000000000 2.88000000000000 3.55000000000000 - 4.35000000000000 3.25000000000000 3.38000000000000 - 3.96000000000000 3.63000000000000 3.75000000000000 - 3.88000000000000 4.82000000000000 4.44000000000000 - 4.43000000000000 4.43000000000000 4.42000000000000 - 4.63000000000000 5.66000000000000 5.81000000000000 - 5.95000000000000 5.49000000000000 6.18000000000000 - 7.11000000000000 6.96000000000000 7.20000000000000 - 7.73000000000000 6.41000000000000 6.85000000000000 - 6.77000000000000 6.91000000000000 7.26000000000000 - 7.20000000000000 6.86000000000000 8.06000000000000 - 7.81000000000000 7.82000000000000 8.41000000000000 - 8.13000000000000 7.19000000000000 8.35000000000000 - 8.13000000000000 8.02000000000000 8.93000000000000 - 8.90000000000000 9.69000000000000 9.65000000000000 - 10.5500000000000 9.38000000000000 9.72000000000000 - 10.6600000000000 11.9800000000000 12.7600000000000 - 12.1000000000000 12.8600000000000 13.0300000000000 - 12.8100000000000 12.5400000000000 12.6500000000000 - 12.0000000000000 12.6900000000000 14.0500000000000 - 13.3300000000000 13.2800000000000 13.2300000000000 - 13.1700000000000 8.66000000000000 11.0900000000000 - 10.4000000000000 13.4700000000000 10.1700000000000 - 12.2200000000000 11.6200000000000 12.9500000000000 - 13.1500000000000 13.5700000000000 12.8700000000000 - 16.1600000000000 14.7100000000000 15.6900000000000 - 14.0900000000000 18.5600000000000 16.2200000000000 - 16.6700000000000 17.1300000000000 17.0000000000000 - 16.8600000000000 15.3300000000000 15.6100000000000 - 16.7700000000000 17.9300000000000 17.4500000000000 - 16.9700000000000 17.8800000000000 17.5800000000000 - 15.7800000000000 16.8300000000000 17.4900000000000 - 16.0300000000000 15.0800000000000 16.7400000000000 - 17.7400000000000 17.4300000000000 18.1400000000000 - 17.0600000000000 19.0100000000000 17.0200000000000 - 17.0200000000000 17.0200000000000 18.5100000000000 - 17.2000000000000 16.7500000000000 16.9700000000000 - 16.9400000000000 16.9100000000000 17.6900000000000 - 15.5500000000000 14.5600000000000 14.3500000000000 - 16.5500000000000 18.2900000000000 17.8000000000000 - 17.0500000000000 21.3100000000000 19.1500000000000 - 19.5100000000000 19.8700000000000 20.3900000000000 - 20.9000000000000 21.8500000000000 22.8900000000000 - 25.6800000000000 24.6400000000000 24.9100000000000 - 23.2400000000000 22.8500000000000 22.4600000000000 - 21.9800000000000 21.6400000000000 21.7500000000000 - 21.8500000000000 21.7700000000000 21.6900000000000 - 23.7400000000000 21.3500000000000 23.0300000000000 - 20.6600000000000 21.8100000000000 20.7700000000000 - 22.1800000000000 22.5800000000000 22.5500000000000 - 21.4500000000000 21.1600000000000 21.0200000000000 - 20.8700000000000 22.0900000000000 22.0000000000000 - 21.2800000000000 23.0500000000000 21.7000000000000 - 21.4500000000000 22.2800000000000 23.0000000000000 - 22.1100000000000 23.5600000000000 22.8300000000000 - 24.8800000000000 22.6400000000000 23.2700000000000 - 23.8900000000000 23.9200000000000 23.9400000000000 - 21.1600000000000 22.3000000000000 21.7500000000000 - 21.1900000000000 20.7200000000000 20.2400000000000 - 21.3400000000000 19.0000000000000 17.9300000000000 - 17.8500000000000 15.7000000000000 13.5400000000000 - 11.7800000000000 10.0200000000000 10.9800000000000 - 10.2800000000000 11.7200000000000 13.8100000000000 - 14.4600000000000 15.3000000000000 16.1500000000000 - 16.9900000000000 17.8400000000000 18.6800000000000 - 19.5300000000000 20.3700000000000 21.2200000000000 - 22.0600000000000 22.9100000000000 23.7500000000000 - 24.6000000000000 25.4400000000000 26.2900000000000 - 27.1300000000000 27.9800000000000 28.8200000000000 - 29.6700000000000 30.7100000000000 30.5300000000000 - 31.4500000000000 29.6300000000000 30.1500000000000 - 30.6500000000000 30.2700000000000 29.5200000000000 - 30.0800000000000 29.8000000000000 29.8700000000000 - 32.4512260786668 32.5858784690347 32.7205308594026 - 32.8551832497705 32.9898356401384 33.1244880305063 - 33.2591404208742 33.3937928112421 33.5284452016101 - 33.6630975919780 - 0.100000000000000 0.900000000000000 F T F - 0.178441146042939 0.176854755447340 0.175457523511159 - 0.178440798291086 0.177847580665707 0.177178950695165 - 0.176542728233259 0.175967661944468 0.175456823596599 - 0.175005168033411 0.174605505760961 0.174250735402598 - 0.173934480416989 0.173651244352414 0.173396399197021 - 0.176284676038272 0.176005252123378 0.175741801502665 - 0.175493821420086 0.175260563010190 0.175041152196171 - 0.174834694659134 0.174640301295590 0.174457108584218 - 0.174284274484268 0.174121060727579 0.173966751275695 - 0.173820693656522 0.173682295461442 0.173550990323865 - 0.173426281108896 0.173307698178998 0.173194833498812 - 0.173087290981306 0.172984722514601 0.172886786445479 - 0.172793190434770 0.172703651742762 0.172617938672571 - 0.172535787912517 0.172457013428583 0.172381393903792 - 0.172308745673507 0.172238919838372 0.172171736659333 - 0.172107057186978 0.172044744904835 0.171984673531151 - 0.171926718099366 0.171870789914284 0.171816765250475 - 0.171764562450018 0.171714071153700 0.171665228454992 - 0.171617948837318 0.171572158885393 0.171527796465106 - 0.171484782600370 0.171443063233302 0.171402581095653 - 0.171363282082134 0.171325108165235 0.171288031882564 - 0.171251987132930 0.171216938064970 0.171182837032322 - 0.171149666076201 0.171117361544088 0.171085916272709 - 0.171055270179356 0.171025419508950 0.170996314310324 - 0.170967926663031 0.170940243344760 0.170913232205649 - 0.170886875980471 0.170861138037182 0.170836003406656 - 0.170811450916359 0.170787454244663 0.170764013982761 - 0.170741085618302 0.170718671627445 0.170696755166074 - 0.170675300794188 0.170654319456517 0.170633776821819 - 0.170613665685691 0.170593965931055 0.170574684426576 - 0.170555782619628 0.170537268427738 0.170519130476294 - 0.170501344654811 0.170483900681757 0.170466801495381 - 0.170450037279425 0.170433579262678 0.170417444570396 - 0.170401604974142 0.170386052236448 0.170370791270107 - 0.170355814336234 0.170341094662250 0.170326650782861 - 0.170312456565112 0.170298505345497 0.170284809827809 - 0.170271338174411 0.170258110004008 0.170245100286411 - 0.170232309760820 0.170219733138796 0.170207365023389 - 0.170195200380670 0.170183227927957 0.170171455642058 - 0.170159878853221 0.170148480521709 0.170137262548154 - 0.170126214451279 0.170115344811094 0.170104649766787 - 0.170094112839613 0.170083730213538 0.170073517430401 - 0.170063451920238 0.170053530360435 0.170043762084085 - 0.170034143891283 0.170024660091918 0.170015313939387 - 0.170006102636771 0.169997023222620 0.169988072979511 - 0.169979242956101 0.169970549313136 0.169961970825056 - 0.169953504917733 0.169945161748312 0.169936932719445 - 0.169928815557190 0.169920808009674 0.169912914235195 - 0.169905119655493 0.169897422161807 0.169889838489013 - 0.169882341748084 0.169874948835945 0.169867651572232 - 0.169860448196458 0.169853343127943 0.169846316142078 - 0.169839390288340 0.169832545363639 0.169825779791752 - 0.169819110606634 0.169812517715288 0.169805999652889 - 0.169799573531819 0.169793213216579 0.169786942051128 - 0.169780733957195 0.169774612417112 0.169768557503757 - 0.169762568109508 0.169756655207108 0.169750817692467 - 0.169745035930372 0.169739333332254 0.169733690356599 - 0.169728105889472 0.169722597391865 0.169717139122623 - 0.169711754746491 0.169706418591380 0.169701148180695 - 0.169695942518575 0.169690782287533 0.169685691105419 - 0.169680643521851 0.169675663171359 0.169670730807017 - 0.169665851795987 0.169661025223985 0.169656250313439 - 0.169651526273317 0.169646852299504 0.169642221592594 - 0.169637651703675 0.169633117456545 0.169628642544881 - 0.169624207987350 0.169619819190840 0.169615469398103 - 0.169611176200974 0.169606920700169 0.169602708317220 - 0.169598538512418 0.169594410564779 0.169590323957695 - 0.169586272035110 0.169582266304065 0.169578306192436 - 0.169574373008326 0.169570490429236 0.169566633679605 - 0.169562820437863 0.169559044050722 0.169555304116932 - 0.169551606109689 0.169547937468310 0.169544303738611 - 0.169540704526921 0.169537139294262 0.169533601574138 - 0.169530102999001 0.169526643124760 0.169523209450670 - 0.169519801559757 0.169516437102556 0.169513097653856 - 0.169509782744194 0.169506510052757 0.169503261191319 - 0.169500035711533 0.169496851295283 0.169493683574667 - 0.169490556155754 0.169487444697369 0.169484372898017 - 0.169481316300907 0.169478298672298 0.169475301655411 - 0.169472330860674 0.169469386058103 0.169466460839528 - 0.169463566961235 0.169460704087973 0.169457853953814 - 0.169455034202520 0.169452238546337 0.169449472730705 - 0.169446724492888 0.169443993492467 0.169441297499142 - 0.169438618198596 0.169435955395394 0.169433326746792 - 0.169430714075063 0.169428123063354 0.169425553483127 - 0.169423005066731 0.169420471664465 0.169417964895747 - 0.169415484605056 0.169413012593961 0.169410572502353 - 0.169408146248256 7.217811636347234E-002 8.129581305187805E-002 - 8.763518850627663E-002 7.218141089560161E-002 7.629665779441844E-002 - 7.975838337086377E-002 8.273410813243250E-002 8.533494778667595E-002 - 8.763835851510482E-002 8.970041250018267E-002 9.156300834527263E-002 - 9.325822231701057E-002 9.481115044026464E-002 9.624176041170709E-002 - 9.756622460019979E-002 8.390592500058276E-002 8.516576505378123E-002 - 8.635159855841179E-002 8.747089261043796E-002 8.853007076980608E-002 - 8.953470157219140E-002 9.048961000631973E-002 9.139904978210528E-002 - 9.226673915807433E-002 9.309599314911385E-002 9.388974538863536E-002 - 9.465062230496527E-002 9.538096702045375E-002 9.608289819186931E-002 - 9.675832101606661E-002 9.740897610978053E-002 9.803642214170383E-002 - 9.864208949465036E-002 9.922729251439434E-002 9.979322340196760E-002 - 0.100340979931685 0.100871575887651 0.101385929903472 - 0.101884913754470 0.102369318926122 0.102839882933118 - 0.103297294810415 0.103742179364428 0.104175142553832 - 0.104596738339593 0.105007471902239 0.105407844236502 - 0.105798296733111 0.106179255187926 0.106551127986591 - 0.106914287147969 0.107269091106383 0.107615861066063 - 0.107954924728797 0.108286579681937 0.108611098765514 - 0.108928748194359 0.109239788684674 0.109544459353559 - 0.109842978511874 0.110135561586462 0.110422421936752 - 0.110703750042038 0.110979735621353 0.111250542322180 - 0.111516351457543 0.111777319301768 0.112033603497464 - 0.112285337429965 0.112532678447346 0.112775742970325 - 0.113014672155580 0.113249584280920 0.113480596837192 - 0.113707826834900 0.113931369127343 0.114151344924641 - 0.114367836158129 0.114580956017153 0.114790778741458 - 0.114997410296863 0.115200922405123 0.115401396815165 - 0.115598925529541 0.115793566653947 0.115985406548847 - 0.116174515662534 0.116360948586984 0.116544784192359 - 0.116726081284428 0.116904905394561 0.117081306588761 - 0.117255341848112 0.117427079668710 0.117596559905743 - 0.117763834066252 0.117928960955008 0.118091988827839 - 0.118252950929834 0.118411905962712 0.118568893263216 - 0.118723955300774 0.118877133243469 0.119028467009513 - 0.119177999828028 0.119325760241685 0.119471784694222 - 0.119616117604559 0.119758788816404 0.119899831699828 - 0.120039278673024 0.120177165770476 0.120313510010947 - 0.120448354760467 0.120581724431914 0.120713647179746 - 0.120844150394864 0.120973265281125 0.121101004132129 - 0.121227405853383 0.121352490488138 0.121476286548875 - 0.121598808250998 0.121720078321718 0.121840132612647 - 0.121958974454873 0.122076638606477 0.122193141031349 - 0.122308501754049 0.122422740308391 0.122535875752981 - 0.122647931270115 0.122758911260415 0.122868847196111 - 0.122977751794877 0.123085641952360 0.123192538765356 - 0.123298444569628 0.123403388899420 0.123507382550368 - 0.123610440564153 0.123712577643911 0.123813812771141 - 0.123914150788966 0.124013605436743 0.124112199378532 - 0.124209941156755 0.124306848255100 0.124402919414206 - 0.124498180805870 0.124592639873942 0.124686313048736 - 0.124779198017428 0.124871319970512 0.124962685368521 - 0.125053305068166 0.125143189704421 0.125232349696378 - 0.125320795252924 0.125408536378227 0.125495582877047 - 0.125581944359882 0.125667634890590 0.125752649778009 - 0.125837016652865 0.125920725816772 0.126003804567010 - 0.126086247505659 0.126168063009872 0.126249268605447 - 0.126329867710583 0.126409872899623 0.126489277973719 - 0.126568109188802 0.126646355396887 0.126724042588474 - 0.126801163997243 0.126877731369864 0.126953751664708 - 0.127029227047783 0.127104173565835 0.127178593145891 - 0.127252496937402 0.127325877288539 0.127398754468430 - 0.127471129949994 0.127543009772208 0.127614404549025 - 0.127685310758861 0.127755734133056 0.127825689670826 - 0.127895178235994 0.127964205279528 0.128032776161746 - 0.128100896154270 0.128168570441926 0.128235804124596 - 0.128302606909864 0.128368969660553 0.128434915998067 - 0.128500436624008 0.128565536236182 0.128630228850935 - 0.128694519024914 0.128758401845150 0.128821886419460 - 0.128884977090149 0.128947673429828 0.129009993753892 - 0.129071923395203 0.129133480544145 0.129194664515607 - 0.129255483974383 0.129315928695073 0.129376016639231 - 0.129435746880525 0.129495123143852 0.129554149098818 - 0.129612828360811 0.129671164492032 0.129729165718308 - 0.129786821351112 0.129844148946463 0.129901151866688 - 0.129957819266574 0.130014168565947 0.130070202984722 - 0.130125911529303 0.130181316214604 0.130236405955283 - 0.130291183787717 0.130345666884864 0.130399844025581 - 0.130453718121252 0.130507306230306 0.130560592272772 - 0.130613597962412 0.130666311866948 0.130718741436558 - 0.130770884621190 0.130822753534339 0.130874350790485 - 0.130925669497008 0.130976712194073 0.131027495601637 - 0.131078003246160 0.131128256524014 0.131178243630740 - 0.131227971685051 0.131277438294142 0.131326655259925 - 0.131375620130170 0.131424339908834 0.131472802593370 - 0.131521029365266 0.131569003416439 0.131616741131761 - 0.131664244633432 0.131711506518753 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.100000000000000 0.100000000000000 0.100000000000000 - 0.446954236795279 0.680434579027796 0.861355896853944 - 0.606689359698639 0.745352165247297 0.867393077575275 - 0.977029354965613 1.07697864081173 1.16911231968359 - 1.25478190619091 1.33500026261228 1.41054827228344 - 1.48204247445287 1.54997904961819 1.61476417374020 - 1.29038544290716 1.35202128663984 1.41120279126526 - 1.46815734932654 1.52308048180927 1.57614177088282 - 1.62748898040696 1.67725226113397 1.72554642865628 - 1.77247389909183 1.81812588545020 1.86258443841741 - 1.90592337624535 1.94820958249603 1.98950380602565 - 2.02986148516595 2.06933310972744 2.10796499122491 - 2.14579987510557 2.18287697322382 2.21923264275415 - 2.25490050238092 2.28991163270456 2.32429506275074 - 2.35807788885051 2.39128518387733 2.42394066023784 - 2.45606624552965 2.48768267185614 2.51880948299468 - 2.54946478621939 2.57966599499936 2.60942920819502 - 2.63876979918970 2.66770225705142 2.69624036745160 - 2.72439711161486 2.75218478800088 2.77961514716860 - 2.80669935972806 2.83344791550437 2.85987085947196 - 2.88597798121165 2.91177841012328 2.93728079398672 - 2.96249349217416 2.98742464163109 3.01208171843496 - 3.03647221746167 3.06060295585377 3.08448085967152 - 3.10811220679070 3.13150341007324 3.15466009402053 - 3.17758836000250 3.20029332509671 3.22278057052307 - 3.24505513836153 3.26712185247458 3.28898554119785 - 3.31065055649551 3.33212160713440 3.35340267423068 - 3.37449808291129 3.39541161407346 3.41614719054460 - 3.43670852106378 3.45709905350782 3.47732242395673 - 3.49738189219208 3.51728069941448 3.53702212837034 - 3.55660901032504 3.57604452204250 3.59533133620270 - 3.61447247736970 3.63347039070479 3.65232769659488 - 3.67104721113544 3.68963123066387 3.70808206427462 - 3.72640216665651 3.74459395155060 3.76265925854741 - 3.78060055939850 3.79841988613629 3.81611917891331 - 3.83370041954676 3.85116568371653 3.86851671984380 - 3.88575538376023 3.90288346175359 3.91990267131077 - 3.93681484557251 3.95362144372381 3.97032422974991 - 3.98692479355389 4.00342448665367 4.01982499890596 - 4.03612773482882 4.05233417768865 4.06844562617021 - 4.08446351069644 4.10038907872220 4.11622377611129 - 4.13196886764005 4.14762556349875 4.16319495626631 - 4.17867834300547 4.19407708595495 4.20939191478972 - 4.22462429808325 4.23977526712432 4.25484578967558 - 4.26983691536205 4.28474977781112 4.29958539738685 - 4.31434456402497 4.32902844144892 4.34363791152155 - 4.35817395645417 4.37263739214037 4.38702907271101 - 4.40135007271860 4.41560107608359 4.42978297836644 - 4.44389660522174 4.45794283388990 4.47192227020007 - 4.48583580302322 4.49968433314780 4.51346837969396 - 4.52718896854553 4.54084645493752 4.55444180897292 - 4.56797566128979 4.58144871062359 4.59486159307829 - 4.60821495260077 4.62150953919530 4.63474599258449 - 4.64792477204054 4.66104666416971 4.67411227642970 - 4.68712203540480 4.70007675510666 4.71297678478872 - 4.72582299002543 4.73861549046403 4.75135528661053 - 4.76404263854062 4.77667824317469 4.78926241204732 - 4.80179583281582 4.81427892100500 4.82671227833203 - 4.83909646654396 4.85143158011366 4.86371861237040 - 4.87595751207012 4.88814925998964 4.90029391934607 - 4.91239200792993 4.92444414313962 4.93645044967150 - 4.94841173555975 4.96032811185569 4.97220024377018 - 4.98402826310310 4.99581278926472 5.00755414643144 - 5.01925272540106 5.03090898429239 5.04252321745824 - 5.05409561755935 5.06562694173814 5.07711723835377 - 5.08856704808923 5.09997666401001 5.11134649605381 - 5.12267670489948 5.13396781319215 5.14522016857341 - 5.15643387895131 5.16760956653850 5.17874733007693 - 5.18984754814576 5.20091055879241 5.21193667067692 - 5.22292622537718 5.23387934943487 5.24479658867183 - 5.25567797372798 5.26652408153752 5.27733489650393 - 5.28811086330232 5.29885231040412 5.30955952533603 - 5.32023255206254 5.33087188545517 5.34147777758267 - 5.35205036280622 5.36258989866218 5.37309676697404 - 5.38357121961047 5.39401339010858 5.40442348575305 - 5.41480197903458 5.42514891739274 5.43546449935388 - 5.44574918972038 5.45600302652356 5.46622626461740 - 5.47641918015619 5.48658202316903 5.49671475451265 - 5.50681808447275 5.51689173555353 5.52693611551213 - 5.53695160335896 5.54693809534512 5.55689617483478 - 5.56682567983284 5.57672688914588 5.58660012034794 - 5.59644552954144 5.60626337713158 5.61605363187990 - 5.62581661577916 5.63555275372181 5.64526171685252 - 5.65494420420633 5.66460016074435 5.67422964551140 - 5.68383295696217 5.69341036332645 5.70296195942155 - 5.71248799730987 5.72198847547864 5.73146374742780 - 5.74091366025185 5.75033882113332 5.75973912396630 - 5.76911477266374 1.31638374772749 1.31301479128529 - 1.31258170576189 1.78651765784193 1.78360027129278 - 1.78229934255929 1.78171349400699 1.78145960468310 - 1.78136080700509 1.78133121831877 1.78132763126180 - 1.78132832927348 1.78132252785475 1.78130517008433 - 1.78127439093290 2.25041138173802 2.25027887459302 - 2.25019553440087 2.25014553141220 2.25011767092553 - 2.25010394334230 2.25009871026269 2.25009796263730 - 2.25009881491187 2.25009907834994 2.25009747520856 - 2.25009298240193 2.25008495642702 2.25007304925782 - 2.25005693199261 2.25003656291683 2.25001188676167 - 2.24998308055404 2.24995020431302 2.24991346252648 - 2.24987290986279 2.24982878462180 2.24978121646143 - 2.24973057397274 2.24967680929455 2.24962034982011 - 2.24956119591214 2.24949952162413 2.24943568187558 - 2.24936965110375 2.24930164519732 2.24923180932037 - 2.24916028166188 2.24908712702496 2.24901266458165 - 2.24893681377170 2.24885981598863 2.24878157300874 - 2.24870238181336 2.24862226574238 2.24854130991387 - 2.24845966337169 2.24837726190000 2.24829424439252 - 2.24821067667831 2.24812662012269 2.24804206006464 - 2.24795726579896 2.24787207218737 2.24778659870842 - 2.24770081540643 2.24761498431703 2.24752884893965 - 2.24744274262763 2.24735640007382 2.24727015365157 - 2.24718380669785 2.24709738581772 2.24701106924021 - 2.24692480484221 2.24683869338895 2.24675260021938 - 2.24666662304824 2.24658077927305 2.24649500775896 - 2.24640956084154 2.24632413682484 2.24623898798524 - 2.24615412754327 2.24606932662134 2.24598491866981 - 2.24590067111661 2.24581667520356 2.24573285666001 - 2.24564947102171 2.24556619542624 2.24548328550769 - 2.24540074872496 2.24531842306365 2.24523631371717 - 2.24515459415444 2.24507326938353 2.24499208830940 - 2.24491139644572 2.24483094017853 2.24475072186935 - 2.24467091668879 2.24459152804127 2.24451229707584 - 2.24443357407263 2.24435509928310 2.24427687320615 - 2.24419916124260 2.24412161105529 2.24404457829180 - 2.24396779699001 2.24389135617974 2.24381525701948 - 2.24373949878921 2.24366408177922 2.24358891491696 - 2.24351417954119 2.24343987585476 2.24336582150651 - 2.24329210625892 2.24321863735042 2.24314559817963 - 2.24307298933365 2.24300062428454 2.24292850028430 - 2.24285689794231 2.24278553473043 2.24271440892666 - 2.24264370763421 2.24257343035754 2.24250338629330 - 2.24243366831780 2.24236427591240 2.24229520666932 - 2.24222645937905 2.24215793604379 2.24208992411160 - 2.24202213357008 2.24195456107078 2.24188739946132 - 2.24182055009722 2.24175401128141 2.24168778098273 - 2.24162195659918 2.24155633965061 2.24149092699406 - 2.24142601416364 2.24136120259100 2.24129678918030 - 2.24123267193781 2.24116884938758 2.24110541987228 - 2.24104208115769 2.24097923281517 2.24091657123682 - 2.24085409389594 2.24079210326022 2.24073029324576 - 2.24066866133800 2.24060751213537 2.24054643483390 - 2.24048583757476 2.24042530736761 2.24036525520622 - 2.24030536879772 2.24024564699469 2.24018629398472 - 2.24012730967616 2.24006837969279 2.24000991889911 - 2.23995161258673 2.23989345801693 2.23983576977311 - 2.23977812394733 2.23972094190894 2.23966379799514 - 2.23960700881910 2.23955057302133 2.23949416966101 - 2.23943822353752 2.23938230533597 2.23932684160433 - 2.23927150915970 2.23921641446342 2.23916155489341 - 2.23910692918637 2.23905253575262 2.23899837267431 - 2.23894433029503 2.23889073335451 2.23883714415007 - 2.23878399779436 2.23873096521877 2.23867815409077 - 2.23862545290328 2.23857319017716 2.23852103441887 - 2.23846909382100 2.23841736795014 2.23836585399066 - 2.23831455153197 2.23826334773171 2.23821246312478 - 2.23816189690378 2.23811131291754 2.23806115709502 - 2.23801097962041 2.23796111610689 2.23791145196153 - 2.23786198722310 2.23781283271514 2.23776376128566 - 2.23771488427375 2.23766620141899 2.23761771039839 - 2.23756929613479 2.23752118546529 2.23747337770533 - 2.23742564274554 2.23737797878342 2.23733072895961 - 2.23728354838768 2.23723643425898 2.23718973177709 - 2.23714309440044 2.23709651935328 2.23705035353962 - 2.23700413238527 2.23695831854997 2.23691244600690 - 2.23686698029614 2.23682145185438 2.23677632874556 - 2.23673125850188 2.23668635610704 2.23664162187675 - 2.23659693531562 2.23655253227802 2.23650841189523 - 2.23646421832773 2.23642030498062 2.23637655244317 - 2.23633307948450 2.23628964709060 2.23624625267818 - 2.23620325497479 2.23616029326960 2.23611736711366 - 2.23607483507337 2.23603233664886 2.23598999014511 - 2.23594779496639 2.23590574982162 2.23586373383888 - 2.23582198650796 2.23578050883213 2.23573893483736 - 2.23569774930676 2.23565658753281 0.778535295339175 - 0.769559969937697 0.765094446294627 1.05657792870164 - 1.05033923396818 1.04608436767054 1.04291972779625 - 1.04041483697828 1.03833970615725 1.03656239532245 - 1.03500084121343 1.03360255713590 1.03233161434628 - 1.03116386510464 1.03007998980880 1.31591487151620 - 1.31440668310954 1.31303360562624 1.31177293569894 - 1.31060659745200 1.30951938530414 1.30850103252299 - 1.30754122447866 1.30663372607165 1.30577150321674 - 1.30494956448182 1.30416346493825 1.30341018977712 - 1.30268625091908 1.30198947804547 1.30131642991061 - 1.30066625971533 1.30003712245962 1.29942678721803 - 1.29883421337079 1.29825831436820 1.29769754907608 - 1.29715222767923 1.29662008814242 1.29610098586136 - 1.29559397312283 1.29509814376889 1.29461420447784 - 1.29414020742657 1.29367560169650 1.29322149777016 - 1.29277538098659 1.29233850418119 1.29191036069838 - 1.29148950234076 1.29107646553058 1.29067006564389 - 1.29027193836430 1.28987990843859 1.28949399337670 - 1.28911488022456 1.28874238199566 1.28837517766630 - 1.28801329898556 1.28765736610193 1.28730721730360 - 1.28696185032076 1.28662145756593 1.28628537343501 - 1.28595508421544 1.28562890099332 1.28530698421421 - 1.28498903723283 1.28467629799114 1.28436673721872 - 1.28406202500305 1.28376077582124 1.28346345193849 - 1.28316968943523 1.28287895044403 1.28259283171072 - 1.28230903236619 1.28202975865931 1.28175257296478 - 1.28147975080604 1.28120881979287 1.28094165307513 - 1.28067810440129 1.28041603946534 1.28015832982770 - 1.27990260916282 1.27964897602764 1.27939943034243 - 1.27915185955625 1.27890674607716 1.27866354371123 - 1.27842354952474 1.27818648073003 1.27795055112289 - 1.27771756511772 1.27748762238292 1.27725912860696 - 1.27703228217364 1.27680871705189 1.27658682859781 - 1.27636699021598 1.27614905211591 1.27593314451130 - 1.27571940011958 1.27550671124401 1.27529665739433 - 1.27508921506428 1.27488281077307 1.27467823773994 - 1.27447541157459 1.27427447064941 1.27407445722419 - 1.27387745376542 1.27368157764896 1.27348716471821 - 1.27329458645689 1.27310336368523 1.27291309363049 - 1.27272576923216 1.27253914735889 1.27235415415002 - 1.27216992382617 1.27198763664726 1.27180765053639 - 1.27162764359144 1.27145038632875 1.27127380278233 - 1.27109870159065 1.27092468982693 1.27075209911180 - 1.27058075894884 1.27040983546574 1.27024185494951 - 1.27007425612419 1.26990778146969 1.26974264678965 - 1.26957780802934 1.26941573478784 1.26925409219096 - 1.26909352719937 1.26893416963545 1.26877573658266 - 1.26861769330250 1.26846145544781 1.26830721745085 - 1.26815320121590 1.26800010829562 1.26784725545521 - 1.26769713833317 1.26754703457046 1.26739800442369 - 1.26724907897768 1.26710293620232 1.26695672835505 - 1.26681142039034 1.26666727488577 1.26652374957761 - 1.26638136529923 1.26623983668550 1.26609898716297 - 1.26595921107263 1.26582027778689 1.26568128427142 - 1.26554478852410 1.26540750029576 1.26527277347891 - 1.26513711573340 1.26500314387576 1.26487083555581 - 1.26473835390563 1.26460661133755 1.26447492770222 - 1.26434561021621 1.26421552798746 1.26408771098421 - 1.26395901037713 1.26383184744127 1.26370525543837 - 1.26357967449627 1.26345547018757 1.26333119993213 - 1.26320741521862 1.26308367548299 1.26296218738628 - 1.26284058065418 1.26271973130249 1.26259934730265 - 1.26247890929242 1.26235996463832 1.26224244341415 - 1.26212476633346 1.26200760249285 1.26189101490400 - 1.26177523014187 1.26165991342791 1.26154527809452 - 1.26143119498198 1.26131678507201 1.26120468934847 - 1.26109153019174 1.26097976183488 1.26086943967149 - 1.26075889585465 1.26064782833041 1.26053834508260 - 1.26042919916354 1.26032079986017 1.26021391248725 - 1.26010549001870 1.25999966124178 1.25989326304941 - 1.25978733707937 1.25968107478105 1.25957720807550 - 1.25947299633926 1.25936913995374 1.25926591802610 - 1.25916293246946 1.25906068293604 1.25895877059453 - 1.25885646114519 1.25875650005529 1.25865610068437 - 1.25855498940024 1.25845642383974 1.25835750168453 - 1.25825785002487 1.25816069964643 1.25806193572697 - 1.25796459568833 1.25786876157113 1.25777141108022 - 1.25767535965598 1.25758077387210 1.25748463994569 - 1.25739079830236 1.25729554930697 1.25720164622747 - 1.25710819756682 1.25701605858976 1.25692347394259 - 1.25683018730473 1.25673813840580 1.25664764124739 - 1.25655568232194 1.25646590957045 1.25637456039960 - 1.25628465333834 1.25619501390010 1.25610671609591 - 1.25601798055924 1.25592940977575 1.25584038878929 - 1.25575372287482 1.25566531925392 1.25557926471252 - 1.25549265099483 1.25540514863169 1.25531928208049 - 1.995685895545864E-002 2.177115436048020E-002 2.300290209214514E-002 - 1.995752452760037E-002 2.078307507895309E-002 2.146892990160294E-002 - 2.205261809280136E-002 2.255855981916636E-002 2.300351245878934E-002 - 2.339944672528240E-002 2.375520745476195E-002 2.407749911564056E-002 - 2.437152220645288E-002 2.464138218499233E-002 2.489038236949494E-002 - 2.228104624980776E-002 2.252576433647243E-002 2.275530243398843E-002 - 2.297125926318719E-002 2.317500219852179E-002 2.336771039512381E-002 - 2.355039937005067E-002 2.372396108187790E-002 2.388917060996332E-002 - 2.404671695171613E-002 2.419720684585317E-002 2.434118170323583E-002 - 2.447912235478672E-002 2.461146250951741E-002 2.473859061698240E-002 - 2.486086108969864E-002 2.497858945253040E-002 2.509206488891356E-002 - 2.520155273640586E-002 2.530729259243782E-002 2.540950468719804E-002 - 2.550839208988480E-002 2.560413772912871E-002 2.569691582618335E-002 - 2.578688358305378E-002 2.587418734876340E-002 2.595896376261524E-002 - 2.604133580309966E-002 2.612142357579129E-002 2.619933619748683E-002 - 2.627517246562161E-002 2.634903146645627E-002 2.642099916752880E-002 - 2.649115890301361E-002 2.655959085154777E-002 2.662636742240088E-002 - 2.669155865027930E-002 2.675522647782176E-002 2.681743516138269E-002 - 2.687824246184478E-002 2.693770088907943E-002 2.699586198874229E-002 - 2.705277656729910E-002 2.710849081507209E-002 2.716304646790258E-002 - 2.721648504886174E-002 2.726884802995340E-002 2.732017185152482E-002 - 2.737049316448296E-002 2.741984278869695E-002 2.746825609076380E-002 - 2.751576281210947E-002 2.756239332753850E-002 2.760817254487828E-002 - 2.765313133356722E-002 2.769729111289908E-002 2.774067941528678E-002 - 2.778331858057614E-002 2.782523098353073E-002 2.786643909355725E-002 - 2.790696033299412E-002 2.794681855112931E-002 2.798602848119329E-002 - 2.802461242095615E-002 2.806258361905482E-002 2.809996297827577E-002 - 2.813676345445919E-002 2.817300051400407E-002 2.820869217619184E-002 - 2.824384858453819E-002 2.827848667350942E-002 2.831261973661382E-002 - 2.834625743912410E-002 2.837941527745258E-002 2.841210411724918E-002 - 2.844433650594682E-002 2.847612143970584E-002 2.850746963325333E-002 - 2.853839459631136E-002 2.856890317623126E-002 2.859900504252637E-002 - 2.862871165567237E-002 2.865803206482134E-002 2.868697185859737E-002 - 2.871554267799937E-002 2.874375167360712E-002 2.877160679373502E-002 - 2.879911573942679E-002 2.882628597437039E-002 2.885312579364016E-002 - 2.887964009593732E-002 2.890583568610118E-002 2.893172128843105E-002 - 2.895730225268572E-002 2.898258480131658E-002 2.900757497668138E-002 - 2.903227971054538E-002 2.905670151659962E-002 2.908084912438056E-002 - 2.910472685732692E-002 2.912833995226777E-002 2.915169350198786E-002 - 2.917479352581225E-002 2.919764164712888E-002 2.922024575280190E-002 - 2.924260934291771E-002 2.926473792958699E-002 2.928663370740600E-002 - 2.930830089110210E-002 2.932974679168401E-002 2.935097113860957E-002 - 2.937198103724642E-002 2.939277922126769E-002 2.941336939754722E-002 - 2.943375518089371E-002 2.945394009700236E-002 2.947392865623725E-002 - 2.949372100162508E-002 2.951332362093966E-002 2.953273863975788E-002 - 2.955196917861585E-002 2.957101935706504E-002 2.958988893256588E-002 - 2.960858402935216E-002 2.962710641380890E-002 2.964545885982910E-002 - 2.966364407807475E-002 2.968166579244259E-002 2.969952444375179E-002 - 2.971722256294930E-002 2.973476477586837E-002 2.975215242872941E-002 - 2.976938896576738E-002 2.978647347525144E-002 2.980341145206689E-002 - 2.982020403797854E-002 2.983685448080853E-002 2.985336167332540E-002 - 2.986973092710780E-002 2.988596320115929E-002 2.990206048938739E-002 - 2.991802474448196E-002 2.993385787901621E-002 2.994956176651188E-002 - 2.996513824246977E-002 2.998058910536688E-002 2.999591611762182E-002 - 3.001112208669559E-002 3.002620546516391E-002 3.004117223391817E-002 - 3.005601969805165E-002 3.007075377625159E-002 3.008537279050318E-002 - 3.009987827468215E-002 3.011427389702206E-002 3.012856005275029E-002 - 3.014273927285839E-002 3.015680973186510E-002 3.017077715431598E-002 - 3.018463857855628E-002 3.019839967967480E-002 3.021205852763926E-002 - 3.022561750021731E-002 3.023907786864710E-002 3.025243979711382E-002 - 3.026570667930814E-002 3.027887863523409E-002 3.029195793199421E-002 - 3.030494247703675E-002 3.031783666543573E-002 3.033064053355579E-002 - 3.034335518290589E-002 3.035598278157937E-002 3.036852222215681E-002 - 3.038097454954973E-002 3.039334296335082E-002 3.040562738788300E-002 - 3.041782881627533E-002 3.042994822496153E-002 3.044198657404309E-002 - 3.045394480764269E-002 3.046582385424835E-002 3.047762571459804E-002 - 3.048934802425703E-002 3.050099601733808E-002 3.051256729986956E-002 - 3.052406272649334E-002 3.053548531495980E-002 3.054683589373614E-002 - 3.055811310056308E-002 3.056931882571567E-002 3.058045385839364E-002 - 3.059151788613988E-002 3.060251494141889E-002 3.061344141961726E-002 - 3.062430133014201E-002 3.063509431326233E-002 3.064582217755441E-002 - 3.065648236033778E-002 3.066707882860586E-002 3.067761117852377E-002 - 3.068808008599163E-002 3.069848621677480E-002 3.070883022670056E-002 - 3.071911276185000E-002 3.072933555004159E-002 3.073949594453477E-002 - 3.074959783716733E-002 3.075964183730714E-002 3.076962526982352E-002 - 3.077955200131480E-002 3.078942261507976E-002 3.079923440912727E-002 - 3.080899231869834E-002 3.081869362511419E-002 3.082833887829120E-002 - 3.083793189897172E-002 3.084746994393401E-002 3.085695354023733E-002 - 3.086638648739766E-002 3.087576492552672E-002 3.088509373377408E-002 - 3.089437013080626E-002 3.090359570205106E-002 3.091276983890293E-002 - 3.092189520779807E-002 3.093097228136474E-002 3.093999933725362E-002 - 3.094897683470980E-002 3.095790851050115E-002 3.096679043410282E-002 - 3.097562742548471E-002 3.098441663628713E-002 3.099315959112932E-002 - 3.100185561915273E-002 3.101050732933447E-002 3.101911403995121E-002 - 3.102767725449151E-002 3.103619408909388E-002 3.104466932360456E-002 - 3.105309896767310E-002 3.106148669599610E-002 3.106983289142617E-002 - 3.107813573954309E-002 0.185693632080300 0.195148210789810 - 0.201400346186374 0.185697158442746 0.190037537686309 - 0.193594372772626 0.196588130842567 0.199159480881945 - 0.201403413041125 0.203386850174637 0.205158678747753 - 0.206755570472722 0.208205720382171 0.209531198837098 - 0.210749653788469 0.197751736606150 0.198993451958266 - 0.200153651136967 0.201241294371986 0.202264003738091 - 0.203228321367726 0.204139835679039 0.205003448370645 - 0.205823380681686 0.206603384280003 0.207346740134794 - 0.208056369013717 0.208734847884787 0.209384499909948 - 0.210007393949012 0.210605421475120 0.211180246672779 - 0.211733397363538 0.212266276643176 0.212780140762039 - 0.213276143836918 0.213755350050491 0.214218705412365 - 0.214667124398616 0.215101420449632 0.215522351721093 - 0.215930627308774 0.216326873611831 0.216711717281454 - 0.217085719191360 0.217449378069455 0.217803212399456 - 0.218147653524634 0.218483126876101 0.218810046652480 - 0.219128778588669 0.219439681350979 0.219743060904238 - 0.220039251215499 0.220328544564552 0.220611200704025 - 0.220887479783102 0.221157643521955 0.221421924456447 - 0.221680526797830 0.221933659095079 0.222181535070862 - 0.222424334490563 0.222662243659862 0.222895408141058 - 0.223124013159199 0.223348204266728 0.223568135747886 - 0.223783923050484 0.223995731252801 0.224203655327371 - 0.224407840650778 0.224608395188950 0.224805429868446 - 0.224999058879318 0.225189359767884 0.225376462064693 - 0.225560426965206 0.225741376178661 0.225919363435722 - 0.226094503425686 0.226266851226024 0.226436482971128 - 0.226603496055780 0.226767928646408 0.226929872704540 - 0.227089393481212 0.227246529593426 0.227401365810890 - 0.227553952425387 0.227704353805535 0.227852608082155 - 0.227998767649006 0.228142907366018 0.228285051823616 - 0.228425248219951 0.228563558369852 0.228700026389029 - 0.228834670631584 0.228967556673373 0.229098716353307 - 0.229228188336908 0.229356010066993 0.229482217813409 - 0.229606854836681 0.229729938969434 0.229851503231304 - 0.229971595889016 0.230090239893929 0.230207465394110 - 0.230323301651221 0.230437785203246 0.230550919250560 - 0.230662754978334 0.230773310293812 0.230882610500088 - 0.230990680193511 0.231097551428044 0.231203223044895 - 0.231307742085104 0.231411122422446 0.231513393624276 - 0.231614560254874 0.231714642612265 0.231813684910246 - 0.231911673812266 0.232008652526089 0.232104631183157 - 0.232199627599826 0.232293659143474 0.232386742747078 - 0.232478903081329 0.232570131777535 0.232660469021642 - 0.232749921985565 0.232838505629681 0.232926242720173 - 0.233013123020264 0.233099184940495 0.233184433909323 - 0.233268883202798 0.233352545790096 0.233435442513083 - 0.233517569414476 0.233598938593328 0.233679578223415 - 0.233759491698850 0.233838698503833 0.233917185171727 - 0.233994987045833 0.234072106532547 0.234148562163898 - 0.234224339533160 0.234299473091814 0.234373964364710 - 0.234447822851217 0.234521057851714 0.234593678472959 - 0.234665693633299 0.234737112067693 0.234807942332582 - 0.234878192810596 0.234947879903377 0.235016987094655 - 0.235085555026980 0.235153558674219 0.235221038376116 - 0.235287976991566 0.235354381804111 0.235420276343069 - 0.235485659423373 0.235550546112599 0.235614918568107 - 0.235678816184770 0.235742212668835 0.235805147174501 - 0.235867601360752 0.235929589558257 0.235991117787868 - 0.236052183760103 0.236112809677367 0.236172993038002 - 0.236232747638987 0.236292054369475 0.236350943231969 - 0.236409411325717 0.236467463858336 0.236525114150845 - 0.236582350821143 0.236639178807166 0.236695619374437 - 0.236751669088440 0.236807332638420 0.236862614633839 - 0.236917519606127 0.236972052010390 0.237026216227073 - 0.237080024773663 0.237133457255807 0.237186550680844 - 0.237239284514539 0.237291662785973 0.237343705883719 - 0.237395417709956 0.237446785677062 0.237497821773905 - 0.237548529716555 0.237598904947239 0.237648975709618 - 0.237698712686136 0.237748144009662 0.237797264897669 - 0.237846086946605 0.237894588832786 0.237942798483265 - 0.237990710907026 0.238038329280884 0.238085656733473 - 0.238132696346190 0.238179451154116 0.238225932367132 - 0.238272118269728 0.238318036423992 0.238363689689673 - 0.238409056219295 0.238454163452275 0.238499014124630 - 0.238543586264216 0.238587915417870 0.238631979535214 - 0.238675781195766 0.238719347614927 0.238762656628707 - 0.238805710708253 0.238848536965639 0.238891104903760 - 0.238933449793847 0.238975549295847 0.239017413939626 - 0.239059037770831 0.239100439484169 0.239141621291213 - 0.239182568917805 0.239223284513940 0.239263794885779 - 0.239304069213595 0.239344142476831 0.239383992027016 - 0.239423628103397 0.239463044460009 0.239502259514039 - 0.239541266967897 0.239580076959001 0.239618666677025 - 0.239657070902778 0.239695258545083 0.239733256107460 - 0.239771065377186 0.239808671653993 0.272781742544511 - 0.271970967003571 0.271252841601382 0.272781565342448 - 0.272478946798018 0.272137050321145 0.271810925505433 - 0.271515474220994 0.271252480917569 0.271019530985467 - 0.270813063099977 0.270629522511881 0.270465697728265 - 0.270318808587378 0.270186506692013 0.271678425742497 - 0.271534806539347 0.271399258054886 0.271271545524439 - 0.271151304966950 0.271038105184688 0.270931501920720 - 0.270831051191468 0.270736320035814 0.270646884625835 - 0.270562373097715 0.270482423606038 0.270406705919105 - 0.270334919804199 0.270266777543498 0.270202026479193 - 0.270140427484586 0.270081772783004 0.270025860246054 - 0.269972512190962 0.269921553860621 0.269872835772650 - 0.269826213110272 0.269781567344615 0.269738763223291 - 0.269697705525920 0.269658280447327 0.269620393625397 - 0.269583968674528 0.269548912982881 0.269515155090076 - 0.269482624695203 0.269451256739305 0.269420986758363 - 0.269391769152969 0.269363539952517 0.269336257097933 - 0.269309863470696 0.269284326701353 0.269259602554348 - 0.269235653076160 0.269212446174277 0.269189940908705 - 0.269168109341235 0.269146921824695 0.269126350339458 - 0.269106364786402 0.269086951046096 0.269068074747312 - 0.269049717337597 0.269031854069158 0.269014475729791 - 0.268997549153582 0.268981070757222 0.268965009214525 - 0.268949362706607 0.268934105191605 0.268919222163153 - 0.268904706812410 0.268890542398555 0.268876719977452 - 0.268863220440224 0.268850036031759 0.268837155737163 - 0.268824565833585 0.268812266712903 0.268800235096186 - 0.268788472354864 0.268776969718745 0.268765708651981 - 0.268754694960780 0.268743910682396 0.268733352089557 - 0.268723008672564 0.268712884087971 0.268702958139308 - 0.268693235028835 0.268683708826371 0.268674366909476 - 0.268665203915740 0.268656221425363 0.268647414317427 - 0.268638767509977 0.268630290032218 0.268621967083079 - 0.268613794362514 0.268605774479794 0.268597903395048 - 0.268590167062978 0.268582575249147 0.268575114241246 - 0.268567780558215 0.268560580899423 0.268553498548237 - 0.268546543838029 0.268539703628014 0.268532978324383 - 0.268526365163528 0.268519861323943 0.268513464174215 - 0.268507167795841 0.268500976398346 0.268494887540132 - 0.268488892272436 0.268482991607561 0.268477180044466 - 0.268471462108311 0.268465835779970 0.268460292401476 - 0.268454829975410 0.268449456688904 0.268444160677149 - 0.268438940200988 0.268433800180362 0.268428738940648 - 0.268423748233925 0.268418829780210 0.268413982115480 - 0.268409203688793 0.268404493077313 0.268399845576749 - 0.268395269699973 0.268390754281730 0.268386297973125 - 0.268381906126861 0.268377574223405 0.268373301071464 - 0.268369085491134 0.268364929677085 0.268360825959542 - 0.268356773233009 0.268352780313408 0.268348833047969 - 0.268344940337866 0.268341097880324 0.268337304752616 - 0.268333563286138 0.268329862834668 0.268326215540089 - 0.268322610766952 0.268319047688558 0.268315535279494 - 0.268312062961102 0.268308629964978 0.268305245307399 - 0.268301895225864 0.268298592019061 0.268295321953761 - 0.268292097401975 0.268288907869899 0.268285752776551 - 0.268282637904788 0.268279562675766 0.268276516747940 - 0.268273512457253 0.268270539511135 0.268267597324787 - 0.268264695099888 0.268261819276528 0.268258982325156 - 0.268256170721554 0.268253393700632 0.268250650739798 - 0.268247931662084 0.268245248914262 0.268242589087284 - 0.268239964637114 0.268237365423154 0.268234794275294 - 0.268232250713324 0.268229734329029 0.268227244707052 - 0.268224781425094 0.268222340901081 0.268219932386466 - 0.268217542613751 0.268215184072011 0.268212846758352 - 0.268210533523757 0.268208240807789 0.268205977884152 - 0.268203734792383 0.268201514391258 0.268199316397410 - 0.268197140431889 0.268194986223438 0.268192850264358 - 0.268190738621570 0.268188650994616 0.268186577530701 - 0.268184530712882 0.268182497480903 0.268180487155448 - 0.268178496229884 0.268176524493530 0.268174574832828 - 0.268172640626363 0.268170724798771 0.268168827143278 - 0.268166947376479 0.268165082089598 0.268163237416656 - 0.268161413124347 0.268159602622084 0.268157805690561 - 0.268156031637381 0.268154270747785 0.268152522774738 - 0.268150797041275 0.268149083851715 0.268147382970113 - 0.268145703721241 0.268144033255666 0.268142384022371 - 0.268140743185671 0.268139123243579 0.268137511299102 - 0.268135919886264 0.268134339324774 0.268132772573885 - 0.268131219512790 0.268129676762296 0.268128150523094 - 0.268126640618931 0.268125137416589 0.268123650222027 - 0.268122175719433 0.268120716939570 0.268119267415089 - 0.268117826966734 0.268116404967464 0.268114991757841 - 0.268113587235058 0.268112200713035 0.268110822604055 - 0.268109455906118 0.268108100499025 0.268106756241934 - 0.268105419891244 0.268104097576437 0.268102789215892 - 0.268101485210153 0.268100198029759 0.268098918136578 - 67.7329901571050 75.8185959181902 665.182572850822 - 115.869434091927 160.474181027104 1097.60845421896 - 185.087281132147 201.180482264731 662.042826436802 - 244.094685964488 1032.11296678146 1405.64706946553 - 1568.74091061950 1570.42610797630 325.762297411258 - 942.246985030232 913.888756757840 380.322661044247 - 932.450578501054 1456.48228150973 393.327320551373 - 1208.22198352078 431.984301710938 1423.00601067542 - 450.397526670683 1418.60951506139 1575.31030014282 - 1661.60986125894 1578.72127037594 593.451575015394 - 1557.89334730101 540.437791767525 550.187460904607 - 574.136219618147 577.996930476474 587.604265609717 - 599.141826804382 736.540754818391 608.014526076899 - 617.476754844676 2064.71679871272 645.579348029656 - 648.399841665227 660.014401741465 842.565263209839 - 868.914260264792 904.254418931116 2164.06941927571 - 877.577090938868 894.147000191452 758.054933402812 - 962.515379751506 2360.89204853276 959.257505790396 - 976.676610822792 1105.98077404774 1019.13384110420 - 1019.02602855263 857.749564606297 878.375848692263 - 862.753445598153 913.571887336457 922.536285300584 - 1090.16228442131 918.408154951307 1112.03312696188 - 940.485862650182 951.671203381407 1139.08658802296 - 975.547408260313 984.619582764978 1004.07731621232 - 2978.01461118769 1014.44563733305 1030.90979621815 - 1047.59605870857 1051.38603904683 1046.08358750619 - 1054.88610192596 1340.88662177640 1385.73377455442 - 1433.70327496086 2789.05749299599 1398.01829385113 - 1400.08689447013 1157.60158582894 1418.89898960785 - 1185.77122425342 1192.86632657964 1227.65464317587 - 1221.09634456603 1258.77882024325 1559.21820969156 - 1608.45549274736 1601.23870313912 1630.26809198997 - 1630.26985174964 1659.97502977156 854.080570923614 - 1706.50933891242 -0.130185471214501 82.0498419323812 - -1.03865527039585 69.5432733613805 32.2189358819872 - -1.08446730998720 85.2513898382939 589.920264839048 - -0.866781115105599 155.301520842655 -0.748750546576173 - -0.954524174123868 -0.960170006610870 -1.00311861630991 - 38.8949011382710 -0.751425125053170 -0.651998794070653 - 26.7430876450646 -0.563531075854446 -0.943273471681448 - 20.2808332216394 -0.713322503731803 20.5774256422459 - -0.832243422064763 45.6459555230136 -0.757720956452089 - -0.827635900509698 -0.915303649236434 -0.785401570320002 - 39.1735667852763 -0.684986320792960 44.7268924106343 - 43.4133241843749 13.6425064596990 13.7062770347847 - 38.6419031414253 13.8152866402807 24.4928147078077 - 36.2334325846038 35.5641473799184 -0.786268577590054 - 14.0641210622149 13.6817579085061 12.5204255472278 - 26.0376262180393 26.2444330184680 67.8704674018086 - -0.701309955980143 19.9568638468402 18.2492042659512 - 13.4070519380001 13.8576360225394 -0.693780376099139 - 14.1561834501077 12.7577637605657 137.692410115846 - 12.7436162929327 12.8471364564147 33.8707664227871 - 14.6719071215938 19.0830354357760 34.7730281271450 - 12.4364792951429 14.6353400564036 14.4775896126756 - 15.1852341018403 37.2917561400758 13.0474758270438 - 15.7980827311535 12.3907342196970 12.2619572804764 - 12.3011774816685 -0.664201942021106 42.3165606445522 - 11.6493054915886 11.5780842678644 11.2132796034755 - 10.1232487537406 31.1954592092284 13.7204628607811 - 15.7550505147410 17.2115836011293 -0.575987813877370 - 15.5554116646713 15.2039559527080 12.2054188539429 - 12.7490582684386 11.6073556458973 11.6702752838360 - 12.0072693397109 11.9545435694687 13.1104486087288 - 6.98626607828786 5.58453704278612 5.77330562755682 - 5.02505000967392 5.02506737416108 4.27968220164206 - 18.6474053148371 3.21165967713564 -0.429953657644099 - 20.6855791766191 -0.717969219726807 6.78049703941272 - 9.35520688994885 0.728808672136311 13.8952811596836 - 34.5361277725552 -0.833830129243419 19.4849989792895 - -0.600599348487693 0.687357755229946 -0.688254138130586 - -0.721209836794927 9.19993649175603 0.748163797131075 - -0.702715424028785 -7.20987803488949 0.637136661794896 - -0.752686200971265 5.86219371816205 -0.724661287530780 - 5.95857497279935 0.778818143046712 8.59093284928841 - -0.734075563871811 0.763772858760134 0.818633928037552 - 0.749927855737226 11.8282035112330 0.690742387460465 - 8.38152532084861 8.22809672204246 4.76215997628856 - 4.76613296085012 7.68229260681019 4.72367940027844 - 10.2725568984350 7.39332019538979 7.31015946342246 - 0.740691099121688 4.75363423824256 4.66990820147272 - 4.39898676845254 12.0240956008849 12.6273197038833 - 24.8552417497111 -0.701866598890901 9.00351980398225 - 8.55189394521363 4.63942905018503 8.00844676587766 - -0.689019527908062 7.39572168117921 7.25009773439900 - 42.4060129342340 7.58714059113161 7.28350711959655 - 7.50904163157153 5.06228621607496 5.59582729721060 - 7.77995129070978 4.74858385514185 7.59558530756835 - 4.86691566791234 7.66901142536209 7.64377465945414 - 4.61521680258704 -7.74978877418055 4.49956832755414 - 4.48391237069158 4.52364361113207 0.664895459830414 - 8.09023469886606 4.37371885617621 4.35501486641223 - 4.25773636043296 3.95127277093269 6.76929108087507 - 8.62190019376292 10.3134217306707 -12.5822173351067 - 0.682464359263113 10.0014233474378 -9.75178413371484 - 4.35136471128321 7.48564375300070 4.34202468123414 - -4.37080016532772 4.51614683927094 4.49186953033173 - -4.72581902327362 7.48765797733824 7.25268260835427 - 7.27976118719583 7.17841533816674 7.17849405320447 - 7.06117136305611 2.77366511498159 6.95092563236516 - 162.553921566724 195.418307565019 -6.00130379892909 - -43.0188827876788 197.052628711985 -4.04937730764168 - 111.856465340286 801.999672496536 117.202452135629 - 37.6720350741586 -1.30947847621951 -3.32577185927466 - -3.50711526072291 -2.98082130355943 4052.68587909283 - 869.129291422670 24.7773890695073 13065.3522514445 - 95.1647382709331 93.1028176731605 463.494934357538 - 7.75857039045726 698.409629612660 5.22566311710325 - -61.5156164833308 42.7088127207074 -25.0079960050309 - -8.35639663094240 31.6704270423812 4.14726658800307 - 44.2575406789008 -72.2452873677243 -73.1800948044479 - 887.362006230175 984.266461906330 -75.1789399824850 - 1696.71606875237 4.88137271263817 -75.2278742891984 - -76.5718315473945 -44.8257033160945 1409.42309346682 - 1969.22163700593 2915.29021499002 5.56686672234588 - 5.72283516514152 6.87065481825032 2.29365125985335 - 4.50773490383628 4.55759501959422 3410.03975312034 - 7.49195091608922 -41.9695160127477 5.80549497617779 - 7.24801956277299 16.8309992225084 7.85160880757816 - 6.33957624988680 -126.429300819666 -72000.8541287100 - -56.3681365523469 -103.339471934831 2606.87997269383 - 5.19695819016656 1598.70169513283 4.65426208518786 - -105.546789368186 2019.74785729127 4.07126444366289 - 3564.59343129981 4168.98697045531 1260.28612647291 - -14.7895313941701 -101.324729149212 3685.58396440766 - 1532.00412708613 747.338978116175 4402.61428093370 - -72.4609598016362 4.55544986840982 5.84257257123679 - 8.19543074043737 0.915663918094231 5.53611081654923 - 5.44199275643736 2692.39450713957 4.13072258174985 - 1101.02961724373 962.576555025957 543.737360375725 - 814.714921526147 3393.43148540985 11.9644409746508 - 14.0858924831709 13.7802589901800 15.0178506552208 - 15.0178863764060 16.2762038056774 -4.86921394023521 - 18.2099802445748 -5.67901926650714 -4.97155665843574 - 3.09190769426196 -3.19958677767614 -8.62812618112795 - 2.81397728962948 7.60207016685699 -11.0270226314512 - 9.55634363270122 5.73932258868365 1.98232474609784 - 2.68265986170219 -2.65739805014587 -2.73220976476402 - -28.2173845511261 17.2204831792290 6.78808964594402 - 42.2551863957267 11.6944040282775 -13.3980664774771 - -15.6560425168144 5.84869675424636 -18.2184674074461 - 7.81604875903698 -7.06727318917924 10.9592332500335 - -10.6705209701391 9.11690361264305 11.8734947545762 - 2.71691973185975 13.3297510364404 6.72457518488130 - 6.74579511510728 18.2189721449425 18.9135040688507 - 6.82972367899174 22.7705120678839 2.68503783282703 - 6.86048168970714 6.89775753871355 12.1166892565746 - 23.2278112691698 24.8246617457993 26.2574170817975 - -2.67572816525882 -2.66581185105223 -2.70373507159306 - 5.57540384771646 -2.68792301858895 -2.70644923723912 - -29.8814970397812 -3.02848347927886 13.3966746890656 - -2.94109070965943 -3.07827598708370 -3.41264557994766 - 3.09562021969419 -3.04950942141777 -8.22468705294798 - -196.295251359907 9.67374428121576 -7.65879268410552 - -29.4840534266906 -2.84311512250433 -32.9998372393940 - 2.76688893721196 -7.37574934538902 -26.8584520528795 - -2.67266820977226 -29.1349194077684 -30.0710172107269 - -22.7851470356644 9.08184197213474 7.09789164451231 - -28.3963609336565 -25.6067157071597 -21.4630906235332 - -29.6257034545388 6.06923713131390 -2.55932890091005 - -2.65863293986076 2.83614994899265 2.33154888117122 - -2.60947558564611 -2.60752480946929 -28.2214077297034 - -2.58913609915951 -25.4777975507908 -24.9249318276573 - -23.0402176810423 -25.2605810963786 33.5331771798398 - -3.10158834269080 -3.19237625858075 3.18039918363604 - -3.22585323551510 -3.22585390540105 -3.26818978370647 - -1.53577562784641 3.32289119425470 2.245000000000000E-002 - 0.201000000000000 0.000000000000000E+000 1.680000000000000E-002 - 8.000000000000000E-003 4.439099999999999E-002 2.312900000000000E-002 - 6.049000000000000E-002 4.000000000000000E-003 1.630000000000000E-002 - 1.000000000000000E-003 2.008070620517118E-002 2.000000000000000E-002 - 1.978832714156626E-002 0.000000000000000E+000 1.927298413644493E-002 - 1.000000000000000E-003 3.000000000000000E-003 0.000000000000000E+000 - 1.734465313652002E-002 0.000000000000000E+000 2.000000000000000E-003 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 3.000000000000000E-003 0.000000000000000E+000 3.000000000000000E-003 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 3.000000000000000E-003 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 7.695933752943111E-003 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 1.000000000000000E-003 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 1.000000000000000E-003 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 7.382716607354267E-003 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 7.078964802252524E-003 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 0.000000000000000E+000 0.000000000000000E+000 0.000000000000000E+000 - 1.843629105080054E-002 3.798362174350185E-002 1.200000000000000E-002 - 1.317237308749320E-002 1.200000000000000E-002 1.489470235587796E-002 - 1.233497727675813E-002 1.285543263010093E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.368160168175772E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.391032167319767E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.666778258987562E-002 1.625554909288714E-002 - 1.591668689780140E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 1.259436108092836E-002 1.362718334436635E-002 1.778398168473416E-002 - 2.307196187658076E-002 1.470555429400495E-002 1.978291810147374E-002 - 2.303424289043007E-002 2.713696277122805E-002 2.370696576764288E-002 - 2.164259802862675E-002 2.132007848646355E-002 1.978771559425813E-002 - 2.073806735614954E-002 2.056534279880984E-002 1.775862097415827E-002 - 1.785400400775197E-002 1.959970116366359E-002 1.650073245313672E-002 - 2.107700538357553E-002 1.835473756101359E-002 1.543787547468385E-002 - 1.724863324015160E-002 1.692430995960952E-002 1.755671279453666E-002 - 1.200000000000000E-002 1.200000000000000E-002 1.200000000000000E-002 - 2.007235040916432E-002 2.072207446568267E-002 2.010940570438069E-002 - 1.200000000000000E-002 1.492592521640383E-002 1.220927458918939E-002 - 3.030042938732257E-002 1.200000000000000E-002 1.252005942892061E-002 - 1.300979318155476E-002 2.147005089376972E-002 1.781978221772817E-002 - 2.108672242341920E-002 2.102048754147479E-002 2.069439477421361E-002 - 2.076209486579146E-002 2.056757011557935E-002 2.929859594265454E-002 - 2.922286117991111E-002 2.923561467185242E-002 2.919389360585583E-002 - 2.919389793352542E-002 2.914379021696404E-002 2.882592831548406E-002 - 2.909072235241390E-002 207.345459040867 126.808280041395 - 526.470864406831 543.065681609426 603.719154986680 - 580.334741859072 696.316864683526 776.755137757670 - 969.796628551507 912.202905751388 912.786378395824 - 981.811522525053 1092.33343806190 1099.11660651185 - 1154.54797334818 1234.78351778426 1068.29473358366 - 1156.75963080538 1131.69959376039 1323.52540818226 - 1228.74568515311 1198.19046544764 1320.01828353207 - 1342.48720623605 1383.43373999434 1471.47779354518 - 1266.34812511062 1363.68747920602 1571.70950880039 - 1553.88188633079 1562.27531776339 1587.57813717509 - 1595.91310151113 1590.31885903007 1591.86046896170 - 1622.19667925242 1608.84614221570 1646.95492891532 - 1635.96390477803 1643.35354137409 1652.39491217141 - 1687.41304335673 1690.08039821329 1713.82643510765 - 1763.60332192770 1770.00971335083 1736.93860815780 - 1991.70598079751 1904.48045528270 1911.40923353429 - 1935.81816123317 1969.67219324250 1989.07514423817 - 2010.16883693306 2033.98963352068 2143.00441959709 - 2094.71306301427 2086.41449436166 2124.68378932364 - 2150.17430216698 2196.08834463275 2190.66866262454 - 2214.02865763938 2262.87506241305 2315.09167107339 - 2318.22119681943 2351.76137989558 2388.03116624500 - 2389.10313268487 2438.70305328634 2456.24497323331 - 2485.54175169601 2479.06308214315 2674.11887587923 - 2563.60778316744 2520.16179511420 2511.08546150002 - 2499.19198753996 2574.94398080211 2507.98023006946 - 2536.03617948725 2604.43836472137 2634.11753992464 - 2578.22928988771 2588.60097259082 2784.71360977614 - 2756.75851995573 2834.16561736765 2846.91682683695 - 2911.14043888759 2898.65258169405 2977.81682918408 - 3060.40247075345 3187.33703516505 3169.28837146778 - 3241.79146198004 3241.79092138789 3314.26928832939 - 3321.91967255706 3423.79158731440 - 222.416603317021 194.030007867155 581.662635062325 - 1067.36025821244 1173.99748073334 1062.14901959531 - 826.325819610748 1316.56722725267 1137.82747289107 - 1021.15512190847 1407.07409257103 1809.65973463832 - 1815.96748881437 2169.81164175290 1646.21617448126 - 1538.04881927315 1280.71318447704 899.978637200776 - 1168.29211125935 593.351232344279 1263.76573377770 - 1406.35274018452 1575.10588631105 1795.96381695763 - 2027.05504271969 2340.85988788457 1978.93445996465 - 2219.93905308457 1218.40588197166 1103.00116798552 - 1198.16788666346 1208.50288953484 1218.01867271803 - 1242.30595469648 1248.33450328724 1276.98780457877 - 1293.28687670057 1312.51257985226 1326.48657075119 - 1275.86348685019 1389.32558430914 1437.80435107687 - 1458.34914039334 1539.01784508312 1581.33205366074 - 1670.51116719197 1710.84880332497 1855.60284334712 - 1944.71610335745 2035.77858434662 2103.83990050168 - 2276.18719029762 2254.90517986174 2644.03077488165 - 2336.66086239326 2580.28695606946 2822.26206882924 - 2843.57469861163 2858.15971085891 3024.53181143196 - 3038.07997451754 2979.28353875037 3210.59147868259 - 3286.80272375129 3519.98020784630 3409.25936356733 - 2823.52762997858 3700.58144072165 3405.63504081882 - 3667.24913747850 3460.77471530776 3613.16407515940 - 4496.99856368775 3698.52611972311 3301.17023155766 - 3058.59217976990 2486.95908628268 2537.23400604408 - 1445.30087388715 2469.60418876377 2951.55400621892 - 3352.94874929349 3591.09133549443 3591.25570879776 - 3290.90207334628 5006.49879955135 5826.57450445285 - 6366.88220241843 6550.93715855354 7501.83776656631 - 7306.62735218817 8709.39153762045 8512.22503573930 - 9998.46225390475 9773.09517878987 10660.7846651822 - 10663.7819462762 11579.3933564789 12286.4461515460 - 13002.7660459598 -1.23772454516813 3.06386167943644 - -1.26477457994377 -3.32512037103658 -3.30277963587130 - -1.94168703541120 -0.769813503196809 -2.06422046483010 - -2.21798777441006 0.656875414192024 -2.04550664809691 - -2.95235881189203 -3.23682497087142 -4.01531026642102 - -2.52552407483116 -2.09864753844885 -0.797140135883153 - 2.64436861978816 -0.170561289688515 7.62678973394863 - 0.693221204769310 0.486796948771578 -0.240425965912123 - -1.12023202721432 -1.34631871146980 -1.65927392623540 - -1.40588496468785 -1.74201621305859 1.66885129476492 - 4.59136057753833 3.20008572931974 3.26879577289976 - 3.30623795728855 3.31445773958171 3.31019365484880 - 3.26508555270857 3.20518541449486 3.15412358281285 - 3.10410672753140 3.42085659003782 2.78750000290205 - 2.82953360428688 2.81490862015163 2.78963966611297 - 2.74356825019647 2.61283030795422 2.54234832264456 - 2.25700279232960 2.06325116301646 2.51043272191803 - 1.40838197605061 0.833278576207242 0.899894477608372 - -0.451734805784948 0.778122873822093 -2.988517607523618E-003 - -0.753847602695252 -0.774585514494653 -0.789497917200668 - -1.15017822380519 -1.16243406742636 -0.806121038781837 - -1.37044527697596 -1.37717078446355 -1.70718958474081 - -1.59507675193112 8.024753165083813E-002 -2.10577199492120 - -1.40299696280735 -1.84963651654540 -1.32461770328922 - -1.53034495528611 -2.62568288524056 -1.60599407997023 - -0.870120678134128 -0.556135836236043 1.29052683236957 - 0.787679789570852 7.57971274195160 1.53958041812355 - 0.199553324605204 -0.643074441195629 -1.03736175788442 - -1.03744883725864 -0.161076583360367 -2.33269866148222 - -3.25301387968462 -3.55721457976068 -3.64950383600555 - -4.05514439751972 -3.98074363695051 -4.44191123705286 - -4.38751742146024 -4.74984755504668 -4.70074041160041 - -4.87825522548623 -4.87948502348079 -5.03176372310760 - -5.13295427458729 -5.22447656122274 0.621598543733159 - -12.4839980453756 -0.412277728073746 7.04082879663345 - 6.26516661785970 1.03135774666432 -2.62193996672898 - 1.47040150816820 3.59153849872157 -8.62652524873010 - 2.48839973293238 5.75627481235640 6.67876097604667 - 9.37066710164659 4.26167983004657 2.89685394534211 - -1.08849630472299 -12.1664776727881 -2.21796292742692 - -28.7251122334231 -6.16054027983151 -5.98273215436767 - -3.04248418786718 8.552399357955441E-002 0.469774773143334 - 0.898364263381963 1.21260109558540 1.01277812230391 - -9.69824071558264 -19.5371546957055 -14.1558674374933 - -14.1971670875248 -14.1729315426278 -13.9689438269648 - -13.9034673773315 -13.5411508429653 -13.2463353214890 - -12.9760031386748 -12.7514046573068 -13.7211906147358 - -11.4308490634108 -11.6623072369216 -11.6472873339738 - -11.6957275504611 -11.6151332739583 -11.3090893472718 - -11.1289246836688 -10.3515189374691 -9.79889275077505 - -12.0115875391719 -7.55461607804986 -5.65162476053135 - -5.87247105787351 -1.14968291952994 -5.57541210072413 - -2.90532455769516 -0.230235122536160 -0.187156095822191 - -0.155936844352131 1.07025280561793 1.09483028874712 - -0.343076900272498 1.67401766721613 1.55806781909755 - 2.71038097600802 2.53190332142046 -3.61624112176552 - 4.30877965334910 1.63950611941747 3.14942425652900 - 1.12156515231340 1.72783130551112 5.16995897027034 - 2.13487670184023 -0.255129782620519 -0.777816931222458 - -7.09498595835517 -4.76931552957600 -28.0077401814477 - -7.39407257915214 -2.68495299629862 0.273188749243716 - 1.63080912631324 1.63102134586732 -1.45366805048034 - 6.03337452272000 9.27362818553268 10.3043785417104 - 10.6164684868201 11.9850506947508 11.7362298355561 - 13.2756793105961 13.0942030930896 14.2921501182219 - 14.1302487874371 14.7124661335434 14.7167435214552 - 15.2115499148452 15.5362595998898 15.8328463372402 - -0.491520349825810 16.4101387176199 2.30540587126529 - -8.21097336843830 -6.52691350906175 1.45291499601356 - 6.27184973503466 0.810533638526066 -3.73224263433007 - 15.7343054207833 -1.73719297580736 -6.55586035646889 - -7.59568407903777 -11.4194247245824 -4.04842646647485 - -2.20681937852305 2.95222506717529 18.0084113648689 - 3.37035279230307 41.5659550044541 10.1272483238909 - 10.5666508786142 5.75399373166938 1.13083909864566 - 1.01801812035805 1.13719671452332 -0.473193454462162 - 1.32819356373240 16.1328368180362 29.4416652779339 - 21.2166975327088 21.1290267786743 20.9758579249137 - 20.5136319642407 20.3827716045483 19.7103768777391 - 19.2194578038427 18.7673003180851 18.4073867486280 - 20.1306874718062 16.3093410180271 16.6659270781706 - 16.6584031488612 16.7766211963344 16.7032214943771 - 16.3402132267041 16.1174136396014 15.1278767634304 - 14.4101980238272 18.2998611461637 11.3722680253932 - 8.81842195395070 9.11544642669664 2.23855138965914 - 8.93851715736504 5.14299371528491 1.15112957508743 - 1.13847961252007 1.12916280418522 -0.602145785050374 - -0.608502201304532 1.81586662632146 -1.21132168088927 - -0.820431597772678 -2.60233924774031 -2.54833958480317 - 6.95678981605543 -5.13079901578869 -0.892432028019230 - -3.04153323754871 0.223251833821613 -0.519848430603934 - -5.18486926324859 -1.25057584728824 2.13377230864300 - 2.29144911957043 11.6123907160319 7.51193546688740 - 41.8397440936302 11.4704279967990 4.38395185342740 - -7.239653462617071E-002 -2.07774343957153 -2.07798220203689 - 2.56181501842837 -8.56492613290864 -13.4340992265649 - -14.9468796410426 -15.4043301500021 -17.4087166986002 - -17.0468619470964 -19.2848551145744 -19.0197958191801 - -20.7530159649166 -20.5189117383209 -21.3556591469591 - -21.3620185018360 -22.0694648517084 -22.5289293159363 - -22.9538365276803 0.757527909420183 -9.44944521838354 - -1.78025280416351 4.84651305169607 3.52025389537239 - -1.90653114157260 -4.81455356944119 -1.47184948710073 - 2.15807563429797 -11.3386631480622 0.710688670941776 - 3.90936234850923 4.43078480603660 6.91395273894781 - 2.02483279985699 0.880885949868907 -2.19418413553600 - -11.6192943299188 -1.79108973163566 -27.1508718888352 - -6.83016401181417 -7.54594384977733 -4.02129760183142 - -0.906681456352114 -1.07434956850477 -1.55984173768131 - 6.285950630655962E-002 -1.82979624101538 -11.3298138988101 - -19.6016889446349 -13.9245043792815 -13.8171779802291 - -13.6747930262736 -13.3187512264195 -13.2215927165866 - -12.7330314932982 -12.3886461696147 -12.0759598905353 - -11.8291603994715 -13.3369003585255 -10.3830322804332 - -10.6140550442188 -10.6110631429024 -10.6906863294816 - -10.6543778608199 -10.4362905828696 -10.3005860176488 - -9.69273530985470 -9.24782603602960 -12.2123000117892 - -7.39944992354049 -5.84200432920899 -6.02357834046790 - -1.44259661788375 -6.07281564193326 -3.60101820687928 - -0.878431812156330 -0.901273031147632 -0.918088128208956 - 0.202760080124789 0.188808110728448 -1.63352657715630 - 0.442701772959540 4.717772207773797E-002 1.31513834181785 - 1.40197085805673 -5.27753295420337 3.12791052606502 - 8.948919310603415E-002 1.50147373597199 -0.861878402262922 - -0.441135025606639 2.47839520968395 0.102238338135743 - -2.11034194306033 -1.86774264699318 -8.18157200384718 - -5.02160436293244 -28.1909902463170 -7.82728452941452 - -3.01149316934107 2.794076964118403E-002 1.36723593680843 - 1.36733478577486 -1.85838101792182 5.65699044363242 - 9.03031334713575 10.0432667322759 10.3493484017418 - 11.6907428064495 11.4499242004394 12.9402561014644 - 12.7627010987485 13.9146047555016 13.7585821867031 - 14.3118291759944 14.3162536136396 14.7825813807538 - 15.0828125527272 15.3640833850756 -0.331263040553284 - 2.03744964745919 0.438864926175240 -1.12607301612396 - -0.761687437288881 0.608857353791649 1.27013170069034 - 0.496760931263345 -0.504869454755113 2.92810950514188 - -0.133888298473656 -0.926067737968114 -1.02794940252289 - -1.63737227079082 -0.411637481045171 -0.142315567754252 - 0.552530250554967 2.78940002799529 0.307557297696647 - 6.67599245759464 1.68170991048224 1.95654473598756 - 1.00090845072453 0.212346728667741 0.304990049729217 - 0.511734178538956 1.938366288244370E-003 0.590602203790280 - 2.89826913058730 4.86351336190421 3.39298237512705 - 3.36068527121544 3.32019122651811 3.22731311148153 - 3.20229372205892 3.07720181654110 2.98973002608862 - 2.91206089880305 2.85037171517896 3.33309390330137 - 2.48606722872967 2.54114884648464 2.54032388347555 - 2.55807339082178 2.55043150410313 2.49846770320728 - 2.46609922362613 2.32143562123649 2.21503686725283 - 3.04150882703865 1.79288206665071 1.43438501786484 - 1.47628625643854 0.326151763691070 1.52606942993845 - 0.917821731303788 0.219863609006095 0.232453364978580 - 0.241806925601985 -3.272488112968032E-002 -2.524452024736238E-002 - 0.477872719583811 -5.696089741532916E-002 7.149848950467189E-002 - -0.265689714470930 -0.317061590485158 1.43539402222875 - -0.753510951145285 5.569883463988144E-002 -0.296288482270673 - 0.337304057689721 0.246165357642990 -0.444681619815064 - 0.101607892884234 0.646797508194861 0.507203416209330 - 2.11314477705417 1.22365761621435 7.07289250085264 - 1.98082764027056 0.766599073354097 -3.779711371840801E-003 - -0.335902837893040 -0.335908778608166 0.510582309852459 - -1.38049615514363 -2.26129602917194 -2.51459353969880 - -2.59110247339935 -2.92664124610984 -2.86667898181199 - -3.23820353543287 -3.19368652810461 -3.48069448760429 - -3.44161428220817 -3.57891005116188 -3.58008219734881 - -3.69557662441363 -3.76936165687869 -3.83938492095079 - 2.245000000000000E-002 0.184000000000000 4.995456808291191E-003 - 1.700000000000000E-002 2.200000000000000E-002 8.000000000000000E-002 - 4.000000000000000E-002 8.000000000000000E-002 1.071388187345269E-002 - 4.200000000000000E-002 4.000000000000000E-002 5.000000000000000E-002 - 5.000000000000000E-002 4.000000000000000E-002 3.954393247688096E-002 - 3.834360119586522E-002 3.505770321755805E-002 3.152542951603161E-002 - 3.213249785003090E-002 2.629679961095212E-002 3.784581327835196E-002 - 4.000000000000000E-002 4.460073469802006E-002 4.680084097329058E-002 - 5.324945396240532E-002 6.000000000000000E-002 5.000000000000000E-002 - 6.500000000000000E-002 3.789606515127635E-002 3.942183973854008E-002 - 4.153622276903409E-002 4.304563483080672E-002 4.422716344734613E-002 - 4.631418488436640E-002 4.678225205483591E-002 4.876414745464152E-002 - 4.960894072651007E-002 5.069449076882333E-002 5.134436530260107E-002 - 5.174584585002585E-002 5.269957342504428E-002 5.453232790405289E-002 - 5.515804916715826E-002 5.772374660951764E-002 5.886071994143913E-002 - 6.104476060183125E-002 6.193730479194276E-002 6.477070798830334E-002 - 6.626482578087686E-002 6.999999999999999E-002 6.963025748668962E-002 - 7.158306194131865E-002 7.134440689671144E-002 7.278354010221125E-002 - 7.330773588439302E-002 7.473116582992502E-002 7.523453213187041E-002 - 7.561862389812245E-002 7.586982245006768E-002 7.692138687576607E-002 - 7.712956261514614E-002 7.882115760397239E-002 7.931310773387135E-002 - 8.092440801189553E-002 8.000000000000000E-002 8.225433454407435E-002 - 8.368285100632117E-002 8.503540404339392E-002 8.600764989096830E-002 - 8.839769980232332E-002 8.952512626205164E-002 9.158802953652141E-002 - 9.499999999999999E-002 9.247825870525096E-002 9.210420061901224E-002 - 9.148278586701411E-002 9.118054807133953E-002 9.075325202013876E-002 - 9.000000000000001E-002 9.266446200694359E-002 9.400230284414772E-002 - 9.499999999999999E-002 9.560183108778503E-002 9.560252525934770E-002 - 9.594515183254111E-002 0.100016082717832 0.100352634640763 - 0.101359724045338 0.101694814547458 0.103364200005449 - 0.103031024281191 0.105347676670228 0.105024388274803 - 0.107334377472957 0.107005246555151 0.108318954137637 - 0.108318937988878 0.109629792206280 0.110608214675099 - 0.111583208369679 1.432910631689862E-002 4.833325903694274E-002 - 6.222275648154255E-003 8.413921485323494E-003 9.616455129747566E-003 - 2.380988120888511E-002 1.841484010832272E-002 2.361429713409051E-002 - 7.816553507523420E-003 1.970700273051601E-002 1.676399479991240E-002 - 1.735596694002415E-002 1.673698861555367E-002 1.299134472680727E-002 - 1.586236562216881E-002 1.661615134390072E-002 1.930796920633007E-002 - 2.434456072905426E-002 2.153417698396758E-002 2.644190413145755E-002 - 2.264860832499861E-002 2.210553636931107E-002 2.273912394757618E-002 - 2.188204824810470E-002 2.230765303261347E-002 2.209986723992064E-002 - 2.261684299071079E-002 2.292501518997497E-002 2.425100162551922E-002 - 2.622322105528265E-002 2.687154210438619E-002 2.753772895628333E-002 - 2.805257046590821E-002 2.889408224361021E-002 2.908133703295294E-002 - 2.986250290888359E-002 3.019394013581575E-002 3.060415189263862E-002 - 3.084012467742422E-002 3.183529376642485E-002 3.155315084918532E-002 - 3.162988717116327E-002 3.164509437727544E-002 3.172597506673532E-002 - 3.173080143106130E-002 3.174532435238223E-002 3.174269223921990E-002 - 3.171076657008501E-002 3.166889224151025E-002 3.125250504899098E-002 - 3.253599915646574E-002 3.293199803629464E-002 3.287998779222579E-002 - 3.322237478218969E-002 3.330574546664998E-002 3.360328609911782E-002 - 3.383613467269808E-002 3.391557496341518E-002 3.396808797136938E-002 - 3.430481656697063E-002 3.434276378717301E-002 3.455006217328945E-002 - 3.489286887623665E-002 3.519094670206362E-002 3.429065735821592E-002 - 3.652343816719581E-002 3.585222278468762E-002 3.861182135927092E-002 - 3.740568222324602E-002 3.892978998451915E-002 3.810779131070235E-002 - 3.884460149744492E-002 3.858802548950652E-002 4.065937459996354E-002 - 4.086543496905867E-002 4.332792573262651E-002 4.165920122893570E-002 - 4.402246939378456E-002 4.124498382094741E-002 4.337510554909374E-002 - 4.484440119235690E-002 4.600807818518968E-002 4.663529770286970E-002 - 4.663472087274564E-002 4.482216624128142E-002 4.787901458208471E-002 - 5.049642645398719E-002 5.100613921173114E-002 5.115832938682963E-002 - 5.180152102964582E-002 5.168491465318384E-002 5.238198498160255E-002 - 5.231526617717978E-002 5.280928000715800E-002 5.274166592729824E-002 - 5.298862564575122E-002 5.299277752579554E-002 5.318804858075203E-002 - 5.331841776405580E-002 5.342317780750782E-002 156.482114078369 - 114.807292333697 492.293372730001 651.910738053537 - 665.316537977239 430.290497182148 519.554387339780 - 523.200776972053 831.515911652783 722.060578169282 - 770.701059065608 811.788198915636 780.727287824262 - 921.134357141456 854.825507003871 853.976400925825 - 863.545791909875 896.329284341857 884.991883946947 - 883.072782456065 991.204427788963 1050.98623310669 - 1070.56995999429 1085.48685694993 1129.38823705917 - 1169.85980767326 1138.74361325352 1057.99679591235 - 1056.46994835592 1222.80642028685 1196.89033465403 - 1213.96834259834 1227.38247351983 1251.78371853089 - 1257.23439982511 1280.46837791555 1290.17859839236 - 1302.92351530975 1310.61546157986 1305.50721457195 - 1340.93329398661 1377.22101983233 1389.54694128219 - 1439.62906679740 1461.77639964560 1503.87881396248 - 1520.96143272239 1574.95075171800 1602.97564474394 - 1678.60988317012 1610.29124554946 1626.94218967726 - 1624.92120871995 1628.81918960721 1644.59423434348 - 1653.50900141857 1651.80398626344 1655.62776607810 - 1658.07365713004 1665.26250295514 1667.34852492133 - 1689.05368348985 1688.02634512469 1705.03415563964 - 1741.48686910915 1727.24810352050 1744.24633857131 - 1722.72589634463 1731.02459542531 1728.02371473784 - 1734.22508360606 1733.84488186800 1728.35132854769 - 1770.98973588670 1779.64287090667 1788.66674018995 - 1798.78661124248 1802.65540431718 1769.41174433761 - 1876.13970045519 1952.61890996569 2011.64824414431 - 2048.19403837133 2048.24362088227 2070.91177478251 - 2331.63169947478 2358.31683507195 2428.10054299849 - 2451.63841443949 2571.29955370118 2547.19301769365 - 2718.11844875558 2693.90893041841 2870.25755724313 - 2844.61934318837 2947.43612724335 2947.44233478492 - 3052.15525503342 3131.68201671531 3212.29894364813 diff --git a/src/programs/Simulation/HDGeant/gdrawp.F b/src/programs/Simulation/HDGeant/gdrawp.F deleted file mode 100644 index 2a59848adf..0000000000 --- a/src/programs/Simulation/HDGeant/gdrawp.F +++ /dev/null @@ -1,233 +0,0 @@ -* -* $Id: gdrawp.F,v 1.2 1996/09/30 13:37:32 ravndal Exp $ -* -* $Log: gdrawp.F,v $ -* Revision 1.2 1996/09/30 13:37:32 ravndal -* Backward compatibility for view banks -* -* Revision 1.1.1.1 1995/10/24 10:20:24 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.27 by S.Giani -*-- Author : - SUBROUTINE GDRAWP(U,V,NP) -C. -C. ****************************************************************** -C. * * -C. * Draw the polyline described by U and V vectors, * -C. * of length NP. * -C. * * -C. * Depending on IDVIEW it draws on screen (IDVIEW=0) * -C. * or stores in the current view bank (IDVIEW>0). * -C. * * -C. * In LINATT (common GCDRAW) there is * -C. * a bit mask for the line attributes : * -C. * * -C. * Bit 1- 7 = Used by view bank (LENGU) * -C. * Bit 8-10 = Line width * -C. * Bit 11-13 = Line style * -C. * Bit 14-16 = Fill area * -C. * Bit 17-24 = Line color * -C. * * -C. * ==>Called by : GDRAWV * -C. * Author : P.Zanarini ; S.Giani 1992 ******** * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcdraw.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcflag.inc" -#include "geant321/gcspee.inc" -* - COMMON/SP3D/ISPFLA -* - DIMENSION U(*),V(*) - SAVE LFILOL - DATA LFILOL/-1/ - -* I introduced the following fix because of a coordinate wraparound -* feature that caused lines starting on the screen and extending beyond -* 1100cm in user coordinates off the screen viewing area to cross over -* and go the wrong way across the screen. There are even bizarre cases -* where the wrapped endpoint ends up somewhere else within the viewing -* area. This probably has to do with a conversion from real to integer*16 -* coordinates without a check for overflow of the integer*16 value. -* WARNING: this introduces a small angular distortion for lines that are -* not vertical or horizontal by moving the endpoint to a smaller absolute -* value coordinate. For viewing screen dimensions of 10cm, cutting off -* large coordinates at 10m should not produce a noticeable distortion. -* -Richard Jones, March 16, 2009. - -#define VIEWING_AREA_CLIP_CM 1000. -#ifdef VIEWING_AREA_CLIP_CM - do i=1,NP - U(i) = max(-VIEWING_AREA_CLIP_CM,U(i)) - U(i) = min(+VIEWING_AREA_CLIP_CM,U(i)) - V(i) = max(-VIEWING_AREA_CLIP_CM,V(i)) - V(i) = min(+VIEWING_AREA_CLIP_CM,V(i)) - enddo -#endif -C. -C. ------------------------------------------------------------------ -C. - LLEP=ABS(LEP) - LINFLA=0 - IF (IDVIEW.EQ.0.OR.IDVIEW.EQ.-175) GO TO 40 -C -C Store on view bank IDVIEW -C - JV=LQ(JDRAW-IDVIEW) - IGU=IGU+1 -C - 10 IF (IGU.LE.MAXGU) GO TO 20 -C -C Push graphic unit banks -C - IF(MORGU.EQ.0)MORGU=100 - MORPUS=MAX(MORGU,MAXGU/4) - JV = LQ(JV-1) - CALL MZPUSH(IXCONS,JV,0,MORPUS,'I') - IF(IEOTRI.NE.0)GO TO 50 - JV=LQ(JDRAW-IDVIEW) - JV = LQ(JV-2) - CALL MZPUSH(IXCONS,JV,0,MORPUS,'I') - IF(IEOTRI.NE.0)GO TO 50 - JV=LQ(JDRAW-IDVIEW) - MAXGU=MAXGU+MORPUS - GO TO 10 -C - 20 IF ((IGS+NP).LE.MAXGS) GO TO 30 -C -C Push graphic segment banks -C - IF(MORGS.EQ.0)MORGS=100 - MORPUS=MAX(MORGS,MAXGS/4,NP) - JV = LQ(JV-4) - CALL MZPUSH(IXCONS,JV,0,MORPUS,'I') - IF(IEOTRI.NE.0)GO TO 50 - JV=LQ(JDRAW-IDVIEW) - JV = LQ(JV-5) - CALL MZPUSH(IXCONS,JV,0,MORPUS,'I') - IF(IEOTRI.NE.0)GO TO 50 - JV=LQ(JDRAW-IDVIEW) - MAXGS=MAXGS+MORPUS -* - GO TO 20 -C - 30 CONTINUE - Q(JV+13)=GTHETA - Q(JV+14)=GPHI - Q(JV+15)=GPSI - Q(JV+16)=GU0 - Q(JV+17)=GV0 - Q(JV+18)=GSCU - Q(JV+19)=GSCV - JV1=LQ(JV-1) - JV2=LQ(JV-2) - JV4=LQ(JV-4) - JV5=LQ(JV-5) -* - CALL UCOPY(U,Q(JV4+IGS+1),NP) - CALL UCOPY(V,Q(JV5+IGS+1),NP) -C -C Bit 1- 7 = LENGU -C Bit 8-24 = Line attribute -C - ISUM=0 - CALL MVBITS(LINATT,0,24,ISUM,0) - IFIL=IBITS(ISUM,13,3) - IF(IFIL.EQ.0)THEN - CALL MVBITS(NP,0,7,ISUM,0) - ELSE - CALL MVBITS(NP,0,10,ISUM,0) - ENDIF - Q(JV1+IGU)=ISUM -C - Q(JV2+IGU)=IGS+1 - IGS=IGS+NP - GO TO 999 -C -C Draw vectors on screen -C - 40 CONTINUE -C -C Extract the new line attributes -C - LINCOL=IBITS(LINATT,16,8) - CALL ISFACI(LINCOL) - LINFIL=IBITS(LINATT,13,3) - IF(IDVIEW.NE.-175.OR.LINFIL.EQ.0)THEN - LINWID=IBITS(LINATT,7,3) - IF(LINWID.GT.1)LINWID=LINWID*2 - ELSE - LINWID=8-LINFIL - IF(LINFIL.EQ.1)LINWID=2 - IF(LINWID.GT.1)LINWID=LINWID*2 - IF(ZZFV.GT.1.)LINWID=INT(LINWID*ZZFV) - ENDIF - LINSTY=IBITS(LINATT,10,3) - IF(LINSTY.EQ.7)LINSTY=1 - IF(LINFIL.LE.1.OR.IDVIEW.EQ.-175.OR.ISPFLA.EQ.1) - +CALL ISPLCI(LINCOL) - WLINW=LINWID - CALL IGSET('LWID',WLINW) -C -C If NP=1 draw a marker -C - IF (NP.EQ.1) THEN - CALL IPM(1,U,V) - ELSE -C -C -C Fill area -C -*SG - IF(IDVIEW.EQ.-175)THEN - IF(LINFIL.GT.0.AND.NP.GT.2.AND.LINSTY.NE.6)THEN - CALL ISFAIS(1) - CALL IFA(NP,U,V) - ENDIF - ENDIF -C -C If NP>1 draw a line with a given style -C and draw black edges both for HIDE OFF -C and SHAD options in case of FILL -C - CALL UCTOH('ON ',IFLH,4,4) - IF(IHIDEN.NE.IFLH.AND.LINFIL.GT.0)THEN - CALL ISPLCI(1) - ENDIF - IF(LINSTY.EQ.6.AND.LINFIL.NE.0)THEN - LINSTY=1 - LINFLA=1 - CALL ISPLCI(1) - CALL IGSET('LWID',3.) - IF(LINWID.GE.12)CALL IGSET('LWID',6.) - IF(LINWID.LE.4)CALL IGSET('LWID',1.) - ENDIF - IF(LLEP.LE.10.OR.LINFIL.EQ.0.OR.LINFLA.NE.1)THEN - IF (LINSTY.EQ.1) THEN -*** call write_dxf_pline(np,u,v,lincol,linwid,1) - CALL IPL(NP,U,V) -C - ELSE IF (LINSTY.GT.1.AND.LINSTY.LE.4) THEN - CALL ISLN(LINSTY) - CALL IPL(NP,U,V) - CALL ISLN(1) -C - ENDIF - ENDIF -C - ENDIF -C - GO TO 999 -C - 50 WRITE (CHMAIL,10000) - CALL GMAIL(0,0) -C -10000 FORMAT (' *** GDRAWP ***: Memory overflow in pushing a bank') - 999 END - diff --git a/src/programs/Simulation/HDGeant/geant3.h b/src/programs/Simulation/HDGeant/geant3.h deleted file mode 100644 index 66849a956a..0000000000 --- a/src/programs/Simulation/HDGeant/geant3.h +++ /dev/null @@ -1,51 +0,0 @@ -void gsvert_(float vert[3], int* ntbeam, int* nttarg, - float ubuf[], int* nubuf, int* nvtx); - -void gfvert_(int* nvtx, float vert[3], int* ntbeam, int* nttarg, - float* tofg, float ubuf[], int* nubuf); - -void gskine_(float plab[3], Particle_t* ipart, int* nv, - float ubuf[], int* nubuf, int* nt); - -void gfkine_(int* itra, float vert[3], float pvert[3], Particle_t* ipart, - int* nvert, float ubuf[], int* nubuf); - -void gfpart_(Particle_t* kind, char chnpar[4], int* itrtyp, float* amass, - float* charge, float* tlife, float* ubuf, int* nubuf); - -void grndm_(float v[], int* len); - -/* convenience interface function for gmtod_ and gdtom_ */ - -#define transformCoord(xin,sin,xout,sout) \ - transformcoord_(xin,sin,xout,sout,strlen(sin),strlen(sout)) - - -/* Type declarations to avoid "implicit function declaration" errors */ -void transformcoord_(float* xin, const char* sin, float* xout, const char* sout, int, int); -int getsector_(void); -int getlayer_(void); -int getmodule_(void); -int getrow_(void); -int getcolumn_(void); -int getplane_(void); -int getring_(void); - - -void hddsgeant3_wrapper_(void); -void md5geom_wrapper_(char *md5); -float guplsh_wrapper_(int *medi0, int *medi1); -void gufld_wrapper_(float *r, float *B); -void getoptical_wrapper_(int *imat, float *E, float *refl, float *abs1, float *rind, float *plsh, float *eff); - -int getcolumn_wrapper_(void); -int getlayer_wrapper_(void); -int getmap_wrapper_(void); -int getmodule_wrapper_(void); -int getpackage_wrapper_(void); -int getplane_wrapper_(void); -int getring_wrapper_(void); -int getrow_wrapper_(void); -int getsector_wrapper_(void); - - diff --git a/src/programs/Simulation/HDGeant/gelhad/Makefile b/src/programs/Simulation/HDGeant/gelhad/Makefile deleted file mode 100644 index fb97dd7af4..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -PACKAGES := CERNLIB - -FFLAGS += -DCERNLIB_MOTIF -D_GELH_ -DCERNLIB_TYPE -I.. - -include $(HALLD_HOME)/src/BMS/Makefile.lib - diff --git a/src/programs/Simulation/HDGeant/gelhad/Makefile.orig b/src/programs/Simulation/HDGeant/gelhad/Makefile.orig deleted file mode 100644 index d85f1381e3..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/Makefile.orig +++ /dev/null @@ -1,68 +0,0 @@ -BUILDS = $(HALLD_HOME)/src - -OStype = $(shell uname) -ARCHtype = $(shell uname -m) -BINDIR = $(BUILDS)/bin.$(OStype) - -ifeq ($(OStype),Linux) - ifeq ($(ARCHtype),alpha) - CC := gcc - CPP := g++ - F77 := g77 - AR := ar - NETLIB := -lnsl - XLIBS := -L/usr/X11R6/lib -lXpm -lSM -lXm -lXt -lICE -lXext -lX11 -lXp - COPTS = -g - FOPTS = -g -Wno-globals - GLIBS := -L/usr/lib/gcc-lib/alpha-redhat-linux/egcs-2.91.66/ -lg2c - else - CC := gcc - CPP := g++ - F77 := gfortran - AR := ar - NETLIB := -lnsl - XLIBS := -L/usr/X11R6/lib -lXpm -lSM -lXm -lXt -lICE -lXext -lX11 -lXp - COPTS = -g - FOPTS = -g - GLIBS := - endif -endif -ifeq ($(OStype),OSF1) - CC := cc - CPP := g++ - F77 := f77 - AR := ar - NETLIB := - STATIC := - XLIBS := -L/usr/lib -lXm -lSM -lICE -lXt -lX11 -lm -lPW -ldnet_stub - COPTS = -g -D_Tru64 - FOPTS = -g -fpe4 - LOPTS = -g -non_shared -fpe4 - GLIBS := -L/r5da/applications/gcc/lib/gcc-lib/alphaev5-dec-osf4.0f/2.95.3 -lg2c -lgcc -endif - -OBJS = caspim.o caspip.o gamate.o gelboost.o gelh_outp.o \ - gelh_last.o gelh_vrfy.o geltwobod.o gheishp.o begran.o \ - ghstopp.o gmmate.o gpgheip.o gphad.o gpsig.o grmate.o gtgama.o \ - labframe.o recoilframe.o sigmagamma.o sigmag.o bimsel.o - -libgelhad.a: symlink $(OBJS) - $(AR) rv $@ $(OBJS) - -symlink: - rm -f gelhad - ln -s . gelhad - -.F.o: - $(F77) -c -o $@ $(FOPTS) -I$(CERN_ROOT)/include -Ighcdes -I. \ - -DCERNLIB_MOTIF -D_GELH_ -DCERNLIB_TYPE \ - $< - -.f.o: - $(F77) $(FOPTS) -I$(CERN_ROOT)/include -c -o $@ $< - -.c.o: - $(CC) $(COPTS) -I. -I$(BUILDS)/include -I$(CERN_ROOT)/include -c -o $@ $< - -clean: - rm -f *.o core last.kumac* paw.metafile cmedt.edt diff --git a/src/programs/Simulation/HDGeant/gelhad/SConscript b/src/programs/Simulation/HDGeant/gelhad/SConscript deleted file mode 100644 index e664473ad0..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/SConscript +++ /dev/null @@ -1,14 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddCERNLIB(env) -env.AppendUnique(FORTRANFLAGS=['-DCERNLIB_TYPE', '-D_GELH_', '-DCERNLIB_TYPE']) -env.AppendUnique(FORTRANPATH=['..']) -sbms.library(env) - - diff --git a/src/programs/Simulation/HDGeant/gelhad/begran.F b/src/programs/Simulation/HDGeant/gelhad/begran.F deleted file mode 100644 index 2d20407854..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/begran.F +++ /dev/null @@ -1,32 +0,0 @@ -* Random Number Generators for BEGET, JETSET, etc... -* should be based on GEANT - -* Doug Wright, Feb 1994 -* Fred Kral, September 23, 1994 - Beget v021 now handles all but begran.F. -* - This routine added to bbforce.F. -* - This fragment moved from bbrandom.F. - -****************************** -* BEGET - real function begran() -****************************** - implicit none -#include "geant321/gcunit.inc" -c integer*4 i - real*4 r - logical*4 first - save first - data first /.true./ - - if (first) then - first = .false. - write (lout,1000) - end if - 1000 format (/' >> this version of begran (BEGET random numbers) ', - + ' uses GEANT grndm'/) - - call grndm(r,1) - begran = r - - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/bimsel.F b/src/programs/Simulation/HDGeant/gelhad/bimsel.F deleted file mode 100644 index 10075bf712..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/bimsel.F +++ /dev/null @@ -1,427 +0,0 @@ -#define CERNLIB_DOUBLE 1 -#define CERNLIB_GFORTRAN 1 -* -* $Id: bimsel.F,v 1.3 2006/09/15 09:34:51 mclareni Exp $ -* -* $Log: bimsel.F,v $ -* Revision 1.3 2006/09/15 09:34:51 mclareni -* Submitted mods for gcc4/gfortran and MacOSX, corrected to work also on slc4 with gcc3.4 and 4.1 -* -* Revision 1.2 1997/10/17 10:00:03 mclareni -* Remove SAVE statement for NT -* -* Revision 1.1.1.1 1995/10/24 10:22:00 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.45 by S.Giani -*-- Author : -*$ CREATE BIMSEL.FOR -*COPY BIMSEL -* -*=== bimsel ===========================================================* -* - SUBROUTINE BIMSEL ( JPROJ, TXX, TYY, TZZ, LBCHCK ) - -#include "geant321/dblprc.inc" -#include "geant321/dimpar.inc" -#include "geant321/iounit.inc" -* -*----------------------------------------------------------------------* -*----------------------------------------------------------------------* -* -#include "geant321/balanc.inc" -#include "geant321/eva0.inc" -#include "geant321/nucdat.inc" -#include "geant321/nucgeo.inc" -#include "geant321/part.inc" -#include "geant321/parevt.inc" -#include "geant321/resnuc.inc" -* - PARAMETER ( FEFFEC = 1.518066780142162 D+00 ) - PARAMETER ( BETMAX = 0.4 D+00 ) -* - REAL RNDM(2) -* - LOGICAL LBCHCK, LFERMI, LLMDBR -* - SAVE ABTAR , ZZTAR , SIGMP0, SIGMN0, - & AMNHLP, RHOBIM, RPRONU, RADPRP, RADPRN, DSKRED, RHRUSF, - & AUSFL , ZUSFL , BNDSAV, RADHLP, BFCHLP, BIMCLM, PRCOLP, - & PRCOLN, IBTOLD, ICTOLD, KPROJ , NTRIAL, ITFRMI - SAVE SBHAL0, SBSKI0, SBCEN0, SBCEN1, SBSKI1, SBHAL1 -#if !defined(CERNLIB_WINNT) && !defined(CERNLIB_GFORTRAN) - SAVE -#else - SAVE LLMDBR -#endif - DATA IBTOLD, ICTOLD / 2*0 / -* - KPROJ = JPROJ - AUSFL = IBTAR - ZUSFL = ICHTAR - RHRUSF = 1.D+00 - BEPROJ = PNUCCO / ( EKECON + AM (KPROJ) ) - CXIMPC = TXX - CYIMPC = TYY - CZIMPC = TZZ - NTRIAL = 0 - RHOBIM = - AINFNT - IF ( KPROJ .EQ. 1 .OR. KPROJ .EQ. 8 ) THEN - IPWELL = 1 + KPROJ / 8 - WLLRED = 1.D+00 - BNDNUC = BNENRG (IPWELL) - ELSE - IPWELL = 0 - IF ( IBAR (KPROJ) .EQ. 0 ) THEN - IF ( KPROJ .LE. 11 ) THEN - WLLRED = 0.D+00 - BNDNUC = 0.D+00 - ELSE - WLLRED = POTMES - BNDNUC = BNENRG (3) - END IF - ELSE - WLLRED = POTBAR - BNDNUC = BNENRG (3) - END IF - END IF - BNDSAV = BNDNUC - IF ( IBAR (KPROJ) .NE. 0 ) THEN - RPRONU = 1.D+00 - ELSE IF ( KPROJ .NE. 7 ) THEN - RPRONU = 0.8164965809277260D+00 - ELSE - RPRONU = 0.D+00 - END IF - IF ( LBCHCK ) THEN - LFERMI = .FALSE. - EKESIG = EKECON - PPRSIG = PNUCCO - CALL SIGFER ( KPTOIP (KPROJ), EKESIG, PPRSIG, LFERMI ) - PRCOLP = ZUSFL / AUSFL * SIGMAP - PRCOLN = ( AUSFL - ZUSFL ) / AUSFL * SIGMAN - SIGMAA = PRCOLP + PRCOLN - PRCOLP = PRCOLP / SIGMAA - PRCOLN = 1.D+00 - PRCOLP - END IF - IF ( RPRONU .GT. ANGLGB ) THEN - IF ( LPARWV ) THEN - LLMDBR = .TRUE. - TMP102 = 1.D-02 - PDEBRO = MAX ( PNUCCO, TMP102 ) - ALMBAR = PLABRC / PDEBRO - DEBRLM = 0.5D+00 * ALMBAR - RADCOR = SQRT ( (RPRONU * RMSPRO)**2 + ALMBAR**2 ) - & / ( RMSPRO * RPRONU ) - ELSE - PDEBRO = ( EKECON + BNDNUC ) * ( EKECON + BNDNUC + 2.D+00 - & * AM (KPROJ) ) - LLMDBR = .FALSE. - DEBRLM = 0.D+00 - ALMBAR = 0.D+00 - LLLMAX = -1 - RADCOR = SQRT ( (RPRONU * RMSPRO)**2 + PLABRC**2 / PDEBRO - & ) / ( RMSPRO * RPRONU ) - END IF - ELSE - RADCOR = 0.D+00 - LLMDBR = .FALSE. - DEBRLM = 0.D+00 - END IF - RADCO2 = RADCOR - RADPRO = MIN ( TWOTWO * RMSPRO * RPRONU * RADCOR, SKGT16 ) - RADPRP = RADPRO - RADPRN = RADPRO - IF ( IBTAR .NE. IBTOLD .OR. ICHTAR .NE. ICTOLD ) THEN - IBTOLD = IBTAR - ICTOLD = ICHTAR - ABTAR = IBTAR - ZZTAR = ICHTAR - AR1O3 = RMASS (IBTAR) - AMNHLP = 0.5D+00 * ( AMNUCL (1) + AMNUCL (2) ) - HKAP = ABTAR**2 / ( ZZTAR**2 + ( ABTAR - ZZTAR )**2 ) - HHLP (1) = ( HKAP * ZZTAR )**0.3333333333333333D+00 / AR1O3 - HHLP (2) = ( HKAP * ( ABTAR - ZZTAR ) ) - & **0.3333333333333333D+00 / AR1O3 - RHOCEN = RHOTAB (IBTAR) - ALPHAL = ALPTAB (IBTAR) - RADIU0 = RADTAB (IBTAR) - SKINDP = SKITAB (IBTAR) - HALODP = HALTAB (IBTAR) - RADIU1 = RADIU0 + SKINDP - RADTOT = RADIU1 + HALODP - RHOCOR = ONEMNS * RHOCEN - RHOSKN = ALPHAL * RHOCEN - PFRCEN (1) = HHLP (1) * PFRTAB (IBTAR) - PFRCEN (2) = HHLP (2) * PFRTAB (IBTAR) - RHOAVE = RHATAB (IBTAR) - PFRAVE = PFATAB (IBTAR) - EKFAVE = EKATAB (IBTAR) - OMALHL = 1.D+00 - ALPHAL - RAD1O2 = RADIU0 + 0.5D+00 * SKINDP / OMALHL - SKNEFF = SKINDP / OMALHL - RADSKN = RADIU0 + SKNEFF - EKFCEN (1) = SQRT ( AMNUSQ (1) + PFRCEN (1)**2 ) - AMNUCL (1) - EKFCEN (2) = SQRT ( AMNUSQ (2) + PFRCEN (2)**2 ) - AMNUCL (2) - IF ( PFRCEN (1) .GT. PFRCEN (2) ) THEN - ITNCMX = 1 - ELSE - ITNCMX = 2 - END IF - CALL NCLVST ( IBTAR, ICHTAR ) - END IF - IF ( IPWELL .LE. 0 ) IPWELL = ITNCMX - CALL NCLVIN - IF ( EKECON .LT. 2.D+00 * GAMMIN ) THEN - EKECON = 0.D+00 - PNUCCO = 0.D+00 - LABRST = .TRUE. - RADPRO = 0.D+00 - RADSIG = ( RADTOT + DEBRLM ) * BFCLMB - RADMAX = RADTOT - LLLMAX = -1 - OPACTY = 2.D+00 - CALL RSTSEL (KPROJ) - RETURN - END IF - RADMAX = RADTOT + RADPRO - BIMCLM = RDCLMB * BFCLMB - IF ( LLMDBR ) THEN - RADHLP = RADMAX - IF ( RADHLP .LE. RDCLMB ) THEN - BFCMAX = BFCLMB - BFCHLP = 0.5D+00 * CLMBBR * RDCLMB / EKECON - ELSE - BFCHLP = 0.5D+00 * CLMBBR * RDCLMB / EKECON - BFCMAX = SQRT ( 1.D+00 - CLMBBR * RDCLMB / EKECON / RADHLP ) - END IF - BIMMAX = RADHLP * BFCMAX - LLLMAX = INT ( BIMMAX / ALMBAR ) - RADSIG = ALMBAR * ( LLLMAX + 1.D+00 ) - SIGGEO = PI * RADSIG * RADSIG - ELSE - RADHLP = RADTOT + RADPRO + DEBRLM - IF ( RADHLP .LE. RDCLMB ) THEN - BFCMAX = BFCLMB - ELSE - BFCHLP = 0.5D+00 * CLMBBR * RDCLMB / EKECON - BFCMAX = SQRT ( 1.D+00 - CLMBBR * RDCLMB / EKECON / RADHLP ) - END IF - RADSIG = RADHLP * BFCMAX - END IF - R0TRAJ = - RADTOT - R1TRAJ = - R0TRAJ - 4200 CONTINUE - CALL GRNDM(RNDM,2) - RPHI1 = 2.D+00 * RNDM (1) - 1.D+00 - RPHI2 = 2.D+00 * RNDM (2) - 1.D+00 - RPHI12 = RPHI1 * RPHI1 - RPHI22 = RPHI2 * RPHI2 - RSQ = RPHI12 + RPHI22 - IF ( RSQ .GT. 1.D+00 ) GO TO 4200 - SINPHI = 2.D+00 * RPHI1 * RPHI2 / RSQ - COSPHI = ( RPHI12 - RPHI22 ) / RSQ - SINT02 = 1.D+00 - CZIMPC * CZIMPC - IF ( SINT02 .LT. ANGLSQ ) THEN - UBIMPC = COSPHI - VBIMPC = SINPHI - WBIMPC = 0.D+00 - ELSE - SINTH0 = SQRT ( SINT02 ) - SINPH0 = CYIMPC / SINTH0 - COSPH0 = CXIMPC / SINTH0 - UBIMPC = COSPHI * COSPH0 * CZIMPC - SINPHI * SINPH0 - VBIMPC = COSPHI * SINPH0 * CZIMPC + SINPHI * COSPH0 - WBIMPC = - COSPHI * SINTH0 - END IF - GO TO 4500 - ENTRY BIMNXT ( LBCHCK ) - IF ( EKECON .LT. 2.D+00 * GAMMIN ) THEN - LABRST = .TRUE. - CALL RSTNXT - RETURN - END IF - 4300 CONTINUE - BNDNUC = BNDSAV - SIGMAP = SIGMP0 - SIGMAN = SIGMN0 - 4400 CONTINUE - CALL GRNDM(RNDM,1) - ANMFP = - LOG ( 1.D+00 - RNDM (1) ) / DSKRED - IF ( SBRES * SIGMAA .GT. ANMFP ) THEN - GO TO 6000 - END IF - 4500 CONTINUE - 5000 CONTINUE - SBUSED = 0.D+00 - NTRIAL = NTRIAL + 1 - IF ( LLMDBR ) THEN - ALLMAX = LLLMAX + 1.D+00 - CALL GRNDM(RNDM,2) - RNDLLL = ALLMAX * MAX ( RNDM (1), RNDM (2) ) - LLLACT = INT (RNDLLL) - BIMPTR = RNDLLL * ALMBAR - BIMPTR = ABS (BIMPTR) - IF ( BIMPTR .LE. BIMCLM ) THEN - BFCEFF = BFCLMB - ELSE - HLPHLP = BFCHLP / BIMPTR - BFCEFF = 1.D+00 / ( HLPHLP + SQRT ( HLPHLP * HLPHLP - & + 1.D+00 ) ) - END IF - BIMPTR = BIMPTR / BFCEFF - IF ( BIMPTR .GT. RADHLP ) GO TO 5000 - ELSE - CALL GRNDM(RNDM,2) - BIMPTR = RADSIG * MAX ( RNDM (1), RNDM (2) ) - IF ( BIMPTR .LE. BIMCLM ) THEN - BFCEFF = BFCLMB - ELSE - HLPHLP = BFCHLP / BIMPTR - BFCEFF = 1.D+00 / ( HLPHLP + SQRT ( HLPHLP * HLPHLP - & + 1.D+00 ) ) - END IF - BIMPTR = BIMPTR / BFCEFF - END IF - BIMMEM = BIMPTR - IF ( BIMPTR .GT. RADTOT - RADPRO ) THEN - BIMPCT = 0.5D+00 * ( RADTOT + BIMPTR - RADPRO ) - IF ( BIMPTR .GE. RADTOT ) THEN - X1 = BIMPTR - RADTOT - ANGRED = ACOS ( 2.D+00 * X1 / ( RADPRO + X1 ) ) / PI - X1 = X1 / ( R0PROT * RPRONU * RADCO2 ) - DSKRED = ( 0.5D+00 * X1 * X1 + X1 + 1.D+00 ) * EXP (-X1) - & * ANGRED - ELSE - X1 = RADPRO + BIMPTR - RADTOT - ANGRED = ACOS ( 2.D+00 * X1 / ( RADPRO + X1 ) ) / PI - X1 = X1 / ( R0PROT * RPRONU * RADCO2 ) - DSKRED = 1.D+00 - ( 0.5D+00 * X1 * X1 + X1 + 1.D+00 ) - & * EXP (-X1) * ANGRED - END IF - ELSE - DSKRED = 1.D+00 - BIMPCT = BIMPTR - END IF - IF ( .NOT. LBCHCK ) THEN - RHOSAV = RHOBIM - RHOBIM = FRHONC ( BIMPCT ) - IF ( RHOBIM .EQ. RHOSAV ) GO TO 5500 - PFRBIM = FPFRNC ( RHOBIM, ITNCMX ) - EKFBIM = FEKFNC ( PFRBIM, ITNCMX ) - RHOHLP = FRHONC ( BIMPTR ) - PFRHLP = FPFRNC ( RHOHLP, IPWELL ) - PFRHLP = 0.5D+00 * PFRHLP * PFRHLP / AMNUSQ (IPWELL) - IF ( BIMPTR .GT. RADTOT ) BNDNUC = BNDNUC * ( 1.D+00 - & - ( BIMPTR - RADTOT ) / ( RADHLP - RADTOT ) ) - VPRBIM = WLLRED * ( AMNUCL (IPWELL) * PFRHLP - & * ( 1.D+00 - 0.5D+00 * PFRHLP ) + BNDNUC ) - LFERMI = .TRUE. - EKESIG = EKECON - PPRSIG = PNUCCO - CALL SIGFER ( KPTOIP (KPROJ), EKESIG, PPRSIG, LFERMI ) - PRCOLP = ZUSFL / AUSFL * SIGMAP - PRCOLN = ( AUSFL - ZUSFL ) / AUSFL * SIGMAN - SIGMAA = PRCOLP + PRCOLN - PRCOLP = PRCOLP / SIGMAA - PRCOLN = 1.D+00 - PRCOLP - 5500 CONTINUE - ELSE - RHOBIM = FRHONC ( BIMPCT ) - END IF - XBIMPC = UBIMPC * BIMPCT - YBIMPC = VBIMPC * BIMPCT - ZBIMPC = WBIMPC * BIMPCT - CALL GRNDM(RNDM,1) - ANMFP = - LOG ( 1.D+00 - RNDM (1) ) / DSKRED - IF ( BIMPCT .GT. RAD1O2 ) THEN - SBTTSQ = 4.D+00 * ( RADTOT**2 - BIMPCT**2 ) * RHOBIM**2 - IF ( SBTTSQ .LE. ( ANMFP / SIGMAA )**2 ) GO TO 5000 - END IF - CALL SBCOMP ( SBHAL0, SBSKI0, SBCEN0, SBCEN1, SBSKI1, SBHAL1 ) - SBTOT = SBHAL0 + SBSKI0 + SBCEN0 + SBCEN1 + SBSKI1 + SBHAL1 - SBTOT = RHRUSF * SBTOT - IF ( SBTOT * SIGMAA .LE. ANMFP ) GO TO 5000 - 6000 CONTINUE - SBUSED = SBUSED * RHRUSF + ANMFP / SIGMAA - SBRES = SBTOT - SBUSED - SBUSED = SBUSED / RHRUSF - LELSTC = .TRUE. - NTARGT = 1 - CALL GRNDM(RNDM,1) - IF ( RNDM (1) .LT. PRCOLP ) THEN - KNUCIM = 1 - ITFRMI = 1 - ELSE - KNUCIM = 8 - ITFRMI = 2 - END IF - IPRTYP = KPROJ * 10 + KNUCIM - CALL RSCOMP ( SBHAL0, SBSKI0, SBCEN0, SBCEN1, SBSKI1, SBHAL1 ) - BNDNUC = BNDSAV - RHOIMP = FRHONC ( ABS (RIMPCT) ) - PFRIMP = FPFRNC ( RHOIMP, ITFRMI ) - EKFIMP = FEKFNC ( PFRIMP, ITFRMI ) - RIMHLP = ABS (RIMPTR) - RHOIMT = FRHONC ( RIMHLP ) - PFRPRO = FPFRNC ( RHOIMT, IPWELL ) - EKFPRO = FEKFNC ( PFRPRO, IPWELL ) - IF ( RIMHLP .GT. RADTOT ) BNDNUC = BNDNUC * ( 1.D+00 - ( RIMHLP - & - RADTOT ) / ( RADHLP - RADTOT )) - VPRWLL = WLLRED * ( EKFPRO + BNDNUC ) - EKEWLL = EKECON + VPRWLL - EPSWLL = EKEWLL + AM (KPROJ) - IF ( .NOT. LBCHCK ) THEN - PPRWLL = SQRT ( EKEWLL * ( EKEWLL + 2.D+00 * AM (KPROJ) ) ) - CALL PHDWLL ( UBIMPC, VBIMPC, WBIMPC ) - PNFRMI = PFNCLV ( ITFRMI, .TRUE. ) - IF ( PNFRMI .LT. -100.D+00 ) GO TO 4400 - CALL RACO ( PXFERM, PYFERM, PZFERM ) - PXFERM = PXFERM * PNFRMI - PYFERM = PYFERM * PNFRMI - PZFERM = PZFERM * PNFRMI - ERES = EKEWLL + AM (KPROJ) + AM (KNUCIM) + EKFERM - PXRES = PXPROJ + PXFERM - PYRES = PYPROJ + PYFERM - PZRES = PZPROJ + PZFERM - PTRES2 = PXRES**2 + PYRES**2 + PZRES**2 - UMO2 = ERES**2 - PTRES2 - EKESIG = 0.5D+00 * ( UMO2 - AM (KPROJ)**2 - AM (KNUCIM)**2 ) - & / AM (KNUCIM) - AM (KPROJ) - EKFIMP = MAX ( EKFERM, EKFIMP ) - ELSE - EKESIG = EPSWLL - AM (KPROJ) - END IF - PPRSIG = SQRT ( EKESIG * ( EKESIG + 2.D+00 * AM (KPROJ) ) ) - SIGMN0 = SIGMAN - SIGMP0 = SIGMAP - LFERMI = .FALSE. - CALL SIGFER ( KPTOIP (KPROJ), EKESIG, PPRSIG, LFERMI ) - IF ( KNUCIM .EQ. 1 ) THEN - SIGMAR = SIGMAP / SIGMP0 - ELSE - SIGMAR = SIGMAN / SIGMN0 - END IF - SIGMAR = MIN ( SIGMAR, ONEONE ) - CALL GRNDM(RNDM,1) - RNDREJ = RNDM(1) - IF ( RNDREJ .GE. SIGMAR ) GO TO 4300 - IF ( LBCHCK ) THEN - ZITA = 0.5D+00 * ( EKFIMP + EKFPRO ) / EKEWLL - IF ( ZITA .LE. 0.5D+00 ) THEN - PZITA = 1.D+00 - 1.4D+00 * ZITA - ELSE - PZITA = 1.D+00 - 1.4D+00 * ZITA + 0.4D+00 * ZITA - & * ( 2.D+00 - 1.D+00 / ZITA )**2.5D+00 - END IF - RNDREJ = RNDREJ / SIGMAR - IF ( RNDREJ .GE. PZITA ) GO TO 4300 - ELSE - PZITA = 1.D+00 - END IF - OPACTY = 1.D+00 / NTRIAL - RETURN -*=== End of subroutine Bimsel =========================================* - END diff --git a/src/programs/Simulation/HDGeant/gelhad/caspim.F b/src/programs/Simulation/HDGeant/gelhad/caspim.F deleted file mode 100644 index 459286dd46..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/caspim.F +++ /dev/null @@ -1,470 +0,0 @@ - SUBROUTINE CASPIM(INT,NFL) -c SUBROUTINE CASPIM(K,INT,NFL) -C -C *** CASCADE OF PI- *** -C *** NVE 04-MAY-1988 CERN GENEVA *** -C -C ORIGIN : H.FESEFELDT 13-SEP-1987 -C -C PI- UNDERGOES INTERACTION WITH NUCLEON WITHIN NUCLEUS. -C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS. -C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE -C IS DEGRADED IN ENERGY. NO OTHER PARTICLES PRODUCED. -C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/ -C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA. -C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS -C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS. -C -#include "ghcdes/mxgkgh.inc" -#include "ghcdes/consts.inc" -#include "ghcdes/curpar.inc" -#include "ghcdes/result.inc" -#include "ghcdes/prntfl.inc" -#include "ghcdes/limits.inc" -#include "ghcdes/kginit.inc" -C - REAL N - DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2) - DIMENSION RNDM(1) - SAVE PMUL,ANORM - DATA SUPP/0.,0.4,0.55,0.65,0.75,0.82,0.86,0.90,0.94,0.98/ - DATA CECH/1.,0.95,0.79,0.32,0.19,0.16,0.14,0.12,0.10,0.08/ - DATA B/0.7,0.7/,C/1.25/ -C - INTEGER *4 NFLFORCE/0/ - CHARACTER *(*) COMMAND - INTEGER *4 IDUMM -C -C --- INITIALIZATION INDICATED BY KGINIT(16) --- - IF (KGINIT(16) .NE. 0) GO TO 10 - KGINIT(16)=1 -C -C --- INITIALIZE PMUL AND ANORM ARRAYS --- - DO 9000 J=1,1200 - DO 9001 I=1,2 - PMUL(I,J)=0.0 - IF (J .LE. 60) ANORM(I,J)=0.0 - 9001 CONTINUE - 9000 CONTINUE -C -C *** COMPUTATION OF NORMALIZATION CONSTANTS *** -C -C --- P TARGET --- - L=0 - DO 1100 NP1=1,20 - NP=NP1-1 - NMM1=NP1-1 - IF (NMM1 .LE. 1) NMM1=1 - NPP1=NP1+1 -C - DO 1101 NM1=NMM1,NPP1 - NM=NM1-1 -C - DO 1102 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF (L .GT. 1200) GOTO 1199 - NT=NP+NM+NZ - IF (NT .LE. 0) GO TO 1102 - IF (NT .GT. 60) GO TO 1102 - PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C) - ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L) - 1102 CONTINUE -C - 1101 CONTINUE -C - 1100 CONTINUE -C - 1199 CONTINUE -C -C --- N TARGET --- - L=0 - DO 1200 NP1=1,20 - NP=NP1-1 - NPP1=NP1+2 -C - DO 1201 NM1=NP1,NPP1 - NM=NM1-1 -C - DO 1202 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF (L .GT. 1200) GO TO 1299 - NT=NP+NM+NZ - IF (NT .LE. 0) GO TO 1202 - IF (NT .GT. 60) GO TO 1202 - PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C) - ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L) - 1202 CONTINUE -C - 1201 CONTINUE -C - 1200 CONTINUE -C - 1299 CONTINUE -C - DO 3 I=1,60 - IF (ANORM(1,I) .GT. 0.0) ANORM(1,I)=1.0/ANORM(1,I) - IF (ANORM(2,I) .GT. 0.0) ANORM(2,I)=1.0/ANORM(2,I) - 3 CONTINUE -C - IF (.NOT. NPRT(10)) GO TO 10 - WRITE(NEWBCD,2001) - DO 4 NFL=1,2 - WRITE(NEWBCD,2002) NFL - WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60) - WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200) - 4 CONTINUE -C -C --- CHOOSE PROTON OR NEUTRON AS TARGET --- - 10 CONTINUE - IF(NFLFORCE.EQ.0) THEN - NFL=2 - CALL GRNDM(RNDM,1) - IF (RNDM(1) .LT. ZNO2/ATNO2) NFL=1 - ELSE - NFL=NFLFORCE - ENDIF !NFLFORCE.EQ.0 - TARMAS=RMASS(14) - IF (NFL .EQ. 2) TARMAS=RMASS(16) - S=AMASQ+TARMAS**2+2.0*TARMAS*EN - RS=SQRT(S) - ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6) - ENP(9)=SQRT(ENP(8)) - EAB=RS-TARMAS-RMASS(9) -C -C --- ELASTIC SCATTERING --- - NP=0 - NM=0 - NZ=0 - N=0.0 - IPA(1)=9 - IPA(2)=14 - IF (NFL .EQ. 2) IPA(2)=16 - IF (INT .EQ. 2) GOTO 20 - GOTO 100 -C -C --- CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT. - 20 CONTINUE - IF (EAB .LE. RMASS(9)) GO TO 55 -C -C --- SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM --- - IEAB=IFIX(EAB*5.0)+1 - IF (IEAB .GT. 10) GO TO 22 - CALL GRNDM(RNDM,1) - IF (RNDM(1) .LT. SUPP(IEAB)) GO TO 22 -C -C --- CHARGE EXCHANGE REACTION (IS INCLUDED IN INELASTIC CROSS SECTION) - IPLAB=IFIX(P*5.0)+1 - IF (IPLAB .GT. 10) IPLAB=10 - CALL GRNDM(RNDM,1) - IF (RNDM(1) .GT. CECH(IPLAB)) GO TO 23 -C - IF (NFL .EQ. 1) GOTO 24 -C -C --- N TARGET --- - INT=1 - IPA(1)=9 - IPA(2)=16 - GO TO 100 -C -C --- P TARGET --- - 24 CONTINUE - IPA(1)=8 - IPA(2)=16 - GO TO 100 -C - 23 CONTINUE - N=1.0 -C - IF (NFL .EQ. 1) GO TO 26 -C -C --- N TARGET --- - DUM=-(1+B(2))**2/(2.0*C**2) - IF (DUM .LT. EXPXL) DUM=EXPXL - IF (DUM .GT. EXPXU) DUM=EXPXU - W0=EXP(DUM) - DUM=-(-1+B(2))**2/(2.0*C**2) - IF (DUM .LT. EXPXL) DUM=EXPXL - IF (DUM .GT. EXPXU) DUM=EXPXU - WM=EXP(DUM) - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - NP=0 - NM=0 - NZ=1 - IF (RAN .LT. W0/(W0+WM)) GO TO 50 - NP=0 - NM=1 - NZ=0 - GO TO 50 -C -C --- P TARGET --- - 26 CONTINUE - DUM=-(1+B(1))**2/(2.0*C**2) - IF (DUM .LT. EXPXL) DUM=EXPXL - IF (DUM .GT. EXPXU) DUM=EXPXU - W0=EXP(DUM) - WP=EXP(DUM) - DUM=-(-1+B(1))**2/(2.0*C**2) - IF (DUM .LT. EXPXL) DUM=EXPXL - IF (DUM .GT. EXPXU) DUM=EXPXU - WM=EXP(DUM) - WP=WP*10. - WT=W0+WP+WM - WP=W0+WP - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - NP=0 - NM=0 - NZ=1 - IF (RAN .LT. W0/WT) GO TO 50 - NP=1 - NM=0 - NZ=0 - IF (RAN .LT. WP/WT) GO TO 50 - NP=0 - NM=1 - NZ=0 - GOTO 50 -C - 22 CONTINUE - ALEAB=LOG(EAB) -C -C --- NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP --- - N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB - $ +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB - N=N-2.0 -C -C --- NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION --- - ANPN=0.0 - DO 21 NT=1,60 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LT. EXPXL) TEST=EXPXL - IF (TEST .GT. EXPXU) TEST=EXPXU - DUM1=PI*NT/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 - ANPN=ANPN+ADDNVE - 21 CONTINUE - ANPN=1.0/ANPN -C - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - EXCS=0.0 - IF (NFL .EQ. 2) GO TO 40 -C -C --- P TARGET --- - L=0 - DO 310 NP1=1,20 - NP=NP1-1 - NMM1=NP1-1 - IF (NMM1 .LE. 1) NMM1=1 - NPP1=NP1+1 -C - DO 311 NM1=NMM1,NPP1 - NM=NM1-1 -C - DO 312 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF (L .GT. 1200) GO TO 80 - NT=NP+NM+NZ - IF (NT .LE. 0) GO TO 312 - IF (NT .GT. 60) GO TO 312 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LT. EXPXL) TEST=EXPXL - IF (TEST .GT. EXPXU) TEST=EXPXU - DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 - EXCS=EXCS+ADDNVE - IF (RAN .LT. EXCS) GOTO 50 - 312 CONTINUE -C - 311 CONTINUE -C - 310 CONTINUE - GOTO 80 -C -C --- N TARGET --- - 40 CONTINUE - L=0 - DO 410 NP1=1,20 - NP=NP1-1 - NPP1=NP1+2 -C - DO 411 NM1=NP1,NPP1 - NM=NM1-1 -C - DO 412 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF (L .GT. 1200) GO TO 80 - NT=NP+NM+NZ - IF (NT .LE. 0) GO TO 412 - IF (NT .GT. 60) GO TO 412 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LT. EXPXL) TEST=EXPXL - IF (TEST .GT. EXPXU) TEST=EXPXU - DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 - EXCS=EXCS+ADDNVE - IF (RAN .LT. EXCS) GOTO 50 - 412 CONTINUE -C - 411 CONTINUE -C - 410 CONTINUE - GO TO 80 -C - 50 CONTINUE - IF (NFL .EQ. 2) GO TO 65 -C -C --- P TARGET --- - IF (NP .EQ. NM) GO TO 61 - IF (NP .EQ. 1+NM) GO TO 63 - IPA(1)=8 - IPA(2)=14 - GO TO 100 -C - 61 CONTINUE - CALL GRNDM(RNDM,1) - IF (RNDM(1) .LT. 0.75) GO TO 62 - IPA(1)=8 - IPA(2)=16 - GO TO 100 -C - 62 CONTINUE - IPA(1)=9 - IPA(2)=14 - GO TO 100 -C - 63 CONTINUE - IPA(1)=9 - IPA(2)=16 - GO TO 100 -C -C --- N TARGET --- - 65 CONTINUE - IF (NP .EQ. -1+NM) GO TO 66 - IF (NP .EQ. NM) GO TO 68 - IPA(1)=8 - IPA(2)=16 - GO TO 100 -C - 66 CONTINUE - CALL GRNDM(RNDM,1) - IF (RNDM(1) .LT. 0.50) GO TO 67 - IPA(1)=8 - IPA(2)=16 - GO TO 100 -C - 67 CONTINUE - IPA(1)=9 - IPA(2)=14 - GO TO 100 -C - 68 CONTINUE - IPA(1)=9 - IPA(2)=16 - GO TO 100 -C - 70 CONTINUE - IF (NPRT(4)) WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ - CALL STPAIR - IF (INT .EQ. 1) CALL TWOB(9,NFL,N) - IF (INT .EQ. 2) CALL GENXPT(9,NFL,N) - GO TO 9999 -C -C --- ENERGETICALLY NOT POSSIBLE TO PRODUCE CASCADE-PARTICLES --- -C --- CONTINUE WITH QUASI-ELASTIC SCATTERING --- - 55 CONTINUE - IF (NPRT(4)) WRITE(NEWBCD,1001) - GO TO 53 -C -C --- EXCLUSIVE REACTION NOT FOUND --- - 80 CONTINUE - IF (NPRT(4)) WRITE(NEWBCD,1004) RS,N -C - 53 CONTINUE - INT=1 - NP=0 - NM=0 - NZ=0 - N=0.0 - IPA(1)=9 - IPA(2)=14 - IF (NFL .EQ. 2) IPA(2)=16 -C - 100 CONTINUE - DO 101 I=3,60 - IPA(I)=0 - 101 CONTINUE - IF (INT .LE. 0) GO TO 131 -C -c 120 CONTINUE - NT=2 - IF (NP .EQ. 0) GO TO 122 - DO 121 I=1,NP - NT=NT+1 - IPA(NT)=7 - 121 CONTINUE -C - 122 CONTINUE - IF (NM .EQ. 0) GO TO 124 - DO 123 I=1,NM - NT=NT+1 - IPA(NT)=9 - 123 CONTINUE -C - 124 CONTINUE - IF (NZ .EQ. 0) GO TO 130 - DO 125 I=1,NZ - NT=NT+1 - IPA(NT)=8 - 125 CONTINUE -C - 130 CONTINUE - IF (NPRT(4)) WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20) - IF (IPA(1) .EQ. 7) NP=NP+1 - IF (IPA(1) .EQ. 8) NZ=NZ+1 - IF (IPA(1) .EQ. 9) NM=NM+1 - GO TO 70 -C - 131 CONTINUE - IF (NPRT(4)) WRITE(NEWBCD,2005) -C -1001 FORMAT('0*CASPIM* CASCADE ENERGETICALLY NOT POSSIBLE', - $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING') -1003 FORMAT(' *CASPIM* PION- -INDUCED CASCADE, AVAIL. ENERGY',2X,F8.4, - $ 2X,'',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES') -1004 FORMAT(' *CASPIM* PION- -INDUCED CASCADE, EXCLUSIVE REACTION', - $ ' NOT FOUND TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X, - * '',2X,F8.4) -2001 FORMAT('0*CASPIM* TABLES FOR MULTIPLICITY DATA PION- INDUCED', - $ 'REACTION FOR DEFINITION OF NUMBERS SEE FORTRAN CODING') -2002 FORMAT(' *CASPIM* TARGET PARTICLE FLAG',2X,I5) -2003 FORMAT(1H ,10E12.4) -2004 FORMAT(' *CASPIM* ',I3,2X,'PARTICLES, MASS INDEX ARRAY',2X,20I4) -2005 FORMAT(' *CASPIM* NO PARTICLES PRODUCED') -C - 9999 CONTINUE - RETURN -C - ENTRY CASPIMSET(COMMAND,IDUMM) - IF(COMMAND.EQ.'SET:NFLFORCE') THEN - NFLFORCE=IDUMM - ENDIF !COMMAND.EQ.'SET:NFLFORCE' -C - END diff --git a/src/programs/Simulation/HDGeant/gelhad/caspip.F b/src/programs/Simulation/HDGeant/gelhad/caspip.F deleted file mode 100644 index 2064ee5233..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/caspip.F +++ /dev/null @@ -1,368 +0,0 @@ - SUBROUTINE CASPIP(INT,NFL) -c SUBROUTINE CASPIP(K,INT,NFL) -C -C *** CASCADE OF PI+ *** -C *** NVE 04-MAY-1988 CERN GENEVA *** -C -C ORIGIN : H.FESEFELDT (18-SEP-1987) -C -C PI+ UNDERGOES INTER ACTION WITH NUCLEON WITHIN NUCLEUS. -C CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE PIONS/KAONS. -C IF NOT ASSUME NUCLEAR EXCITATION OCCURS AND INPUT PARTICLE -C IS DEGRADED IN ENERGY. NO OTHER PARTICLES PRODUCED. -C IF REACTION IS POSSIBLE FIND CORRECT NUMBER OF PIONS/PROTONS/ -C NEUTRONS PRODUCED USING AN INTERPOLATION TO MULTIPLICITY DATA. -C REPLACE SOME PIONS OR PROTONS/NEUTRONS BY KAONS OR STRANGE BARYONS -C ACCORDING TO AVERAGE MULTIPLICITY PER INELASTIC REACTIONS. -C -#include "ghcdes/mxgkgh.inc" -#include "ghcdes/consts.inc" -#include "ghcdes/curpar.inc" -#include "ghcdes/result.inc" -#include "ghcdes/prntfl.inc" -#include "ghcdes/limits.inc" -#include "ghcdes/kginit.inc" -C - REAL N - DIMENSION PMUL(2,1200),ANORM(2,60),SUPP(10),CECH(10),B(2) - DIMENSION RNDM(1) - SAVE PMUL,ANORM - DATA SUPP/0.,0.2,0.45,0.55,0.65,0.75,0.85,0.90,0.94,0.98/ - DATA CECH/0.33,0.27,0.29,0.31,0.27,0.18,0.13,0.10,0.09,0.07/ - DATA B/0.7,0.7/,C/1.25/ -C - INTEGER *4 NFLFORCE/0/ - CHARACTER *(*) COMMAND - INTEGER *4 IDUMM -C -C --- INITIALIZATION INDICATED BY KGINIT(18) --- - IF (KGINIT(18) .NE. 0) GO TO 10 - KGINIT(18)=1 -C -C --- INITIALIZE PMUL AND ANORM ARRAYS --- - DO 9000 J=1,1200 - DO 9001 I=1,2 - PMUL(I,J)=0.0 - IF (J .LE. 60) ANORM(I,J)=0.0 - 9001 CONTINUE - 9000 CONTINUE -C -C** COMPUTE NORMALIZATION CONSTANTS -C** FOR P AS TARGET -C - L=0 - DO 1 NP1=1,20 - NP=NP1-1 - NMM1=NP1-2 - IF(NMM1.LE.1) NMM1=1 - DO 1 NM1=NMM1,NP1 - NM=NM1-1 - DO 1 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF(L.GT.1200) GOTO 1 - NT=NP+NM+NZ - IF(NT.LE.0.OR.NT.GT.60) GOTO 1 - PMUL(1,L)=PMLTPC(NP,NM,NZ,NT,B(1),C) - ANORM(1,NT)=ANORM(1,NT)+PMUL(1,L) - 1 CONTINUE -C** FOR N AS TARGET - L=0 - DO 2 NP1=1,20 - NP=NP1-1 - NMM1=NP1-1 - IF(NMM1.LE.1) NMM1=1 - NPP1=NP1+1 - DO 2 NM1=NMM1,NPP1 - NM=NM1-1 - DO 2 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF(L.GT.1200) GOTO 2 - NT=NP+NM+NZ - IF(NT.LE.0.OR.NT.GT.60) GOTO 2 - PMUL(2,L)=PMLTPC(NP,NM,NZ,NT,B(2),C) - ANORM(2,NT)=ANORM(2,NT)+PMUL(2,L) - 2 CONTINUE - DO 3 I=1,60 - IF(ANORM(1,I).GT.0.) ANORM(1,I)=1./ANORM(1,I) - IF(ANORM(2,I).GT.0.) ANORM(2,I)=1./ANORM(2,I) - 3 CONTINUE - IF(.NOT.NPRT(10)) GOTO 10 - WRITE(NEWBCD,2001) - DO 4 NFL=1,2 - WRITE(NEWBCD,2002) NFL - WRITE(NEWBCD,2003) (ANORM(NFL,I),I=1,60) - WRITE(NEWBCD,2003) (PMUL(NFL,I),I=1,1200) - 4 CONTINUE -C** CHOOSE PROTON OR NEUTRON AS TARGET - 10 CONTINUE - IF(NFLFORCE.EQ.0) THEN - NFL=2 - CALL GRNDM(RNDM,1) - IF(RNDM(1).LT.ZNO2/ATNO2) NFL=1 - ELSE - NFL=NFLFORCE - ENDIF !NFLFORCE.EQ.0 - TARMAS=RMASS(14) - IF (NFL .EQ. 2) TARMAS=RMASS(16) - S=AMASQ+TARMAS**2+2.0*TARMAS*EN - RS=SQRT(S) - ENP(8)=AMASQ+TARMAS**2+2.0*TARMAS*ENP(6) - ENP(9)=SQRT(ENP(8)) - EAB=RS-TARMAS-RMASS(7) -C -C** ELASTIC SCATTERING - NP=0 - NM=0 - NZ=0 - N=0. - IPA(1)=7 - IPA(2)=14 - IF(NFL.EQ.2) IPA(2)=16 - IF(INT.EQ.2) GOTO 20 -C** FOR PI+ N REACTIONS CHANGE SOME OF THE ELASTIC CROSS SECTION -C** TO PI+ N --> PI0 P - IF(NFL.EQ.1) GOTO 100 - IPLAB=IFIX(P *5.)+1 - IF(IPLAB.GT.10) IPLAB=10 - CALL GRNDM(RNDM,1) - IF(RNDM(1).GT.CECH(IPLAB)/ATNO2**0.42) GOTO 100 - IPA(1)=8 - IPA(2)=14 - GOTO 100 -C** CHECK IF ENERGETICALLY POSSIBLE TO PRODUCE ONE EXTRA PION IN REACT. - 20 IF (EAB .LE. RMASS(7)) GOTO 55 -C** SUPPRESSION OF HIGH MULTIPLICITY EVENTS AT LOW MOMENTUM - IEAB=IFIX(EAB*5.)+1 - IF(IEAB.GT.10) GOTO 22 - CALL GRNDM(RNDM,1) - IF(RNDM(1).LT.SUPP(IEAB)) GOTO 22 - N=1. - GOTO (23,24),NFL - 23 CONTINUE - TEST=-(1+B(1))**2/(2.0*C**2) - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - W0=EXP(TEST) - WP=EXP(TEST) - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - NP=0 - NM=0 - NZ=1 - IF(RAN.LT.W0/(W0+WP)) GOTO 50 - NP=1 - NM=0 - NZ=0 - GOTO 50 - 24 CONTINUE - TEST=-(1+B(2))**2/(2.0*C**2) - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - W0=EXP(TEST) - WP=EXP(TEST) - TEST=-(-1+B(2))**2/(2.0*C**2) - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - WM=EXP(TEST) - WT=W0+WP+WM - WP=W0+WP - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - NP=0 - NM=0 - NZ=1 - IF(RAN.LT.W0/WT) GOTO 50 - NP=1 - NM=0 - NZ=0 - IF(RAN.LT.WP/WT) GOTO 50 - NP=0 - NM=1 - NZ=0 - GOTO 50 -C - 22 ALEAB=LOG(EAB) -C** NO. OF TOTAL PARTICLES VS SQRT(S)-2*MP - N=3.62567+0.665843*ALEAB+0.336514*ALEAB*ALEAB - * +0.117712*ALEAB*ALEAB*ALEAB+0.0136912*ALEAB*ALEAB*ALEAB*ALEAB - N=N-2. -C** NORMALIZATION CONSTANT FOR KNO-DISTRIBUTION - ANPN=0. - DO 21 NT=1,60 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - DUM1=PI*NT/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 - ANPN=ANPN+ADDNVE - 21 CONTINUE - ANPN=1./ANPN -C** P OR N AS TARGET - CALL GRNDM(RNDM,1) - RAN=RNDM(1) - EXCS=0. - GOTO (30,40),NFL -C** FOR P AS TARGET - 30 L=0 - DO 31 NP1=1,20 - NP=NP1-1 - NMM1=NP1-2 - IF(NMM1.LE.1) NMM1=1 - DO 31 NM1=NMM1,NP1 - NM=NM1-1 - DO 31 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF(L.GT.1200) GOTO 31 - NT=NP+NM+NZ - IF(NT.LE.0.OR.NT.GT.60) GOTO 31 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - DUM1=ANPN*PI*NT*PMUL(1,L)*ANORM(1,NT)/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GE. 1.0E-10)) ADDNVE=DUM1*DUM3 - EXCS=EXCS+ADDNVE - IF(RAN.LT.EXCS) GOTO 50 - 31 CONTINUE - GOTO 80 -C** FOR N AS TARGET - 40 L=0 - DO 41 NP1=1,20 - NP=NP1-1 - NMM1=NP1-1 - IF(NMM1.LE.1) NMM1=1 - NPP1=NP1+1 - DO 41 NM1=NMM1,NPP1 - NM=NM1-1 - DO 41 NZ1=1,20 - NZ=NZ1-1 - L=L+1 - IF(L.GT.1200) GOTO 41 - NT=NP+NM+NZ - IF(NT.LE.0.OR.NT.GT.60) GOTO 41 - TEST=-(PI/4.0)*(NT/N)**2 - IF (TEST .LE. EXPXL) TEST=EXPXL - IF (TEST .GE. EXPXU) TEST=EXPXU - DUM1=ANPN*PI*NT*PMUL(2,L)*ANORM(2,NT)/(2.0*N*N) - DUM2=ABS(DUM1) - DUM3=EXP(TEST) - ADDNVE=0.0 - IF (DUM2 .GE. 1.0) ADDNVE=DUM1*DUM3 - IF ((DUM2 .LT. 1.0) .AND. (DUM3 .GT. 1.0E-10)) ADDNVE=DUM1*DUM3 - EXCS=EXCS+ADDNVE - IF(RAN.LT.EXCS) GOTO 50 - 41 CONTINUE - GOTO 80 - 50 GOTO (60,65),NFL - 60 IF(NP.EQ.1+NM) GOTO 61 - IF(NP.EQ.2+NM) GOTO 63 - IPA(1)=7 - IPA(2)=14 - GOTO 100 - 61 CALL GRNDM(RNDM,1) - IF(RNDM(1).LT.0.5) GOTO 62 - IPA(1)=7 - IPA(2)=16 - GOTO 100 - 62 IPA(1)=8 - IPA(2)=14 - GOTO 100 - 63 IPA(1)=8 - IPA(2)=16 - GOTO 100 - 65 IF(NP.EQ.NM) GOTO 66 - IF(NP.EQ.1+NM) GOTO 68 - IPA(1)=7 - IPA(2)=14 - GOTO 100 - 66 CALL GRNDM(RNDM,1) - IF(RNDM(1).LT.0.25) GOTO 67 - IPA(1)=7 - IPA(2)=16 - GOTO 100 - 67 IPA(1)=8 - IPA(2)=14 - GOTO 100 - 68 IPA(1)=8 - IPA(2)=16 - GOTO 100 - 70 IF(NPRT(4)) - *WRITE(NEWBCD,1003) EAB,N,NFL,NP,NM,NZ - CALL STPAIR - IF(INT.EQ.1) CALL TWOB(7,NFL,N) - IF(INT.EQ.2) CALL GENXPT(7,NFL,N) - GO TO 9999 - 55 IF(NPRT(4)) - *WRITE(NEWBCD,1001) - GOTO 53 -C** EXCLUSIVE REACTION NOT FOUND - 80 IF(NPRT(4)) - *WRITE(NEWBCD,1004) RS,N - 53 INT=1 - NP=0 - NM=0 - NZ=0 - N=0. - IPA(1)=7 - IPA(2)=14 - IF(NFL.EQ.2) IPA(2)=16 - 100 DO 101 I=3,60 - 101 IPA(I)=0 - IF(INT.LE.0) GOTO 131 - NT=2 - IF(NP.EQ.0) GOTO 122 - DO 121 I=1,NP - NT=NT+1 - 121 IPA(NT)=7 - 122 IF(NM.EQ.0) GOTO 124 - DO 123 I=1,NM - NT=NT+1 - 123 IPA(NT)=9 - 124 IF(NZ.EQ.0) GOTO 130 - DO 125 I=1,NZ - NT=NT+1 - 125 IPA(NT)=8 - 130 IF(NPRT(4)) - *WRITE(NEWBCD,2004) NT,(IPA(I),I=1,20) - IF(IPA(1).EQ.7) NP=NP+1 - IF(IPA(1).EQ.8) NZ=NZ+1 - IF(IPA(1).EQ.9) NM=NM+1 - GOTO 70 - 131 IF(NPRT(4)) - *WRITE(NEWBCD,2005) -C -1001 FORMAT('0*CASPIP* CASCADE ENERGETICALLY NOT POSSIBLE', - $ ' CONTINUE WITH QUASI-ELASTIC SCATTERING') -1003 FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,', - $ ' AVAIL. ENERGY',2X,F8.4, - $ 2X,'',2X,F8.4,2X,'FROM',4(2X,I3),2X,'PARTICLES') -1004 FORMAT(' *CASPIP* PION+ -INDUCED CASCADE,', - $ ' EXCLUSIVE REACTION NOT FOUND', - $ ' TRY ELASTIC SCATTERING AVAIL. ENERGY',2X,F8.4,2X, - $ '',2X,F8.4) -2001 FORMAT('0*CASPIP* TABLES FOR MULT. DATA PION+ INDUCED REACTION', - $ ' FOR DEFINITION OF NUMBERS SEE FORTRAN CODING') -2002 FORMAT(' *CASPIP* TARGET PARTICLE FLAG',2X,I5) -2003 FORMAT(1H ,10E12.4) -2004 FORMAT(' *CASPIP* ',I3,2X,'PARTICLES , MASS INDEX ARRAY',2X,20I4) -2005 FORMAT(' *CASPIP* NO PARTICLES PRODUCED') -C - 9999 CONTINUE - RETURN -C - ENTRY CASPIPSET(COMMAND,IDUMM) - IF(COMMAND.EQ.'SET:NFLFORCE') THEN - NFLFORCE=IDUMM - ENDIF !COMMAND.EQ.'SET:NFLFORCE' - RETURN - END diff --git a/src/programs/Simulation/HDGeant/gelhad/gamate.F b/src/programs/Simulation/HDGeant/gelhad/gamate.F deleted file mode 100644 index 30ea9eb7e8..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gamate.F +++ /dev/null @@ -1,25 +0,0 @@ - subroutine gamate(alo,aup,yes) -c -c -c check if material contains material with -c A between alo and aup -c subroutine gamat(alo,aup,yes) - implicit none - logical yes - integer *4 i,nmix - real *4 alo,aup -#include "geant321/gcmate.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcbank.inc" -c - yes=.true. - if(q(jma+6).lt.aup+0.5.and.q(jma).gt.alo-0.5) return - nmix=INT(abs(q(jma+11))) - if(nmix.ge.2) then - do 1000 i=1,nmix - if(q(jmixt+i).lt.aup+0.5.and.q(jmixt+i).gt.alo-0.5) return - 1000 continue - endif - yes=.false. - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gelboost.F b/src/programs/Simulation/HDGeant/gelhad/gelboost.F deleted file mode 100644 index a64b6d90de..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelboost.F +++ /dev/null @@ -1,78 +0,0 @@ -!Tue Nov 15 17:22:07 PST 1994 - version 1.01 - A. Snyder -!Remove fortran 90ism -!Mon Mar 17 10:57:46 PST 1997 - A. Snyder -!Modified to be |gelhad| version -! - subroutine gelboost(pin,to,pout,sign) - implicit none - real *4 pin(5),to(5),pout(5),sign - real *4 pto,work,pinp,ein,poutp,eout,pinx,piny,poutx,pouty - real *4 x(3),y(3),z(3) - real *4 beta,gamma - logical ok -! - pto=sqrt(to(1)**2+to(2)**2+to(3)**2) - gamma=to(4)/to(5) - beta=pto/to(4) - z(1)=to(1)/pto - z(2)=to(2)/pto - z(3)=to(3)/pto - work=sqrt(z(1)**2+z(2)**2) - if(work.gt.0.1) then - x(1)=z(1)*z(3)/work - x(2)=z(2)*z(3)/work - x(3)=-work - else if(work.eq.0.0) then - x(1)=1.0 - x(2)=0.0 - x(3)=0.0 - else - x(1)=1.0 - x(2)=0.0 - x(3)=0.0 - call gelperp(x,z,x,ok) - if(.not.ok) then - x(1)=0.0 - x(2)=1.0 - x(3)=0.0 - call gelperp(x,z,x,ok) - endif - endif - y(1)=z(2)*x(3)-z(3)*x(2) - y(2)=z(3)*x(1)-z(1)*x(3) - y(3)=z(1)*x(2)-z(2)*x(1) - ein=pin(4) - pinp=z(1)*pin(1)+z(2)*pin(2)+z(3)*pin(3) - pinx=x(1)*pin(1)+x(2)*pin(2)+x(3)*pin(3) - piny=y(1)*pin(1)+y(2)*pin(2)+y(3)*pin(3) - poutx=pinx - pouty=piny - poutp=gamma*(pinp-sign*beta*ein) - eout=gamma*(ein-sign*beta*pinp) - pout(1)=poutp*z(1)+poutx*x(1)+pouty*y(1) - pout(2)=poutp*z(2)+poutx*x(2)+pouty*y(2) - pout(3)=poutp*z(3)+poutx*x(3)+pouty*y(3) - pout(4)=eout - return - end -c - subroutine geldot(u,v,dotp) - implicit none - real *4 u(3),v(3),dotp - dotp=u(1)*v(1)+u(2)*v(2)+u(3)*v(3) - return - end -c - subroutine gelperp(x,z,xp,ok) - implicit none - real *4 x(3),z(3),xp(3),xdotz,temp - logical ok - call geldot(x,z,xdotz) - xp(1)=x(1)-xdotz*z(1) - xp(2)=x(2)-xdotz*z(2) - xp(3)=x(3)-xdotz*z(3) - call geldot(xp,xp,temp) - temp=sqrt(temp) - ok=temp.gt.0.1 - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gelh_last.F b/src/programs/Simulation/HDGeant/gelhad/gelh_last.F deleted file mode 100644 index 1ffa5a67d6..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelh_last.F +++ /dev/null @@ -1,34 +0,0 @@ - Subroutine Gelh_last ! statistics printed -* -*..History: -* Kral 1/18/96 - Print event counts. -* Kral 1/19/96 - Add interaction count. -* - implicit none -#include "gnbase/gelhad_db.inc" -#include "gelhad/gelhadused.inc" - logical print/.true./ - save print - logical init/.false./ - save init - -*..Print summary - if (print) then - if (.not. init) then - init = .true. - if (jphadr_gelhad .ne. 0) then - write (6, *) - write (6, *) - $ 'GELH_LAST: GELHAD event summary' - write (6, *) ' nevtot = ', nevtot_gelh - write (6, *) ' nevhad = ', nevhad_gelh, - $ REAL(nevhad_gelh)/REAL(MAX(nevtot_gelh, 1)) - write (6, *) ' nevout = ', nevout_gelh - write (6, *) ' ninthad = ', ninthad_gelh - write (6, *) - endif - endif - endif - - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gelh_outp.F b/src/programs/Simulation/HDGeant/gelhad/gelh_outp.F deleted file mode 100644 index d0015abe0a..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelh_outp.F +++ /dev/null @@ -1,110 +0,0 @@ -#include "gnbase/Flags.h" - Subroutine Gelh_outp(Iskip) -******-****************************************************************-******* -* -*..Description: -* Called after each event. For analysis and output flagging. -* If ISKIP is set to 1 by this routine, event is NOT output (1=output veto). -* -* Called from gnbbg/gucall.F. -* -*..Author: Frederic Kral -*..History: -* Kral 12/24/95 - GELHAD User Output Routine selects gelhad events only. -* Kral 1/18/96 - Use jphadr switch in new gelhad.db scheme. -* Kral 1/19/96 - Print number of interactions per event. -* - Option jphadr = 3 only saves if ==1 interaction/event. -* - Print skipped events. -* Kral 1/19/96 - Add interaction count. -* RT Jones 7/10/02 - Suppress special BaBar code using conditional BABAR -* -******-****************************************************************-******* - IMPLICIT NONE -*..Include: -#ifdef _GELH_ -# ifdef BABAR -#include "gnbase/run_db.inc" -# endif -#include "geant321/gcflag.inc" -C from gelhad V00-00-03 and onwards -#include "gelhad/gelhadused.inc" -C from gelhad V00-00-05 and onwards -#include "gnbase/gelhad_db.inc" -#endif -*..Input: -*..Output: - Integer*4 Iskip ! Output veto -*..Local: -#ifdef _GELH_ -#ifdef BABAR - Logical*1 First/.true./ - Save First -#endif -#endif - -*=====-================================================================-======= - -*..Clear to not skip - Iskip = 0 - -#ifdef _GELH_ -# ifdef BABAR - If (First) then - First = .false. - If (jphadr_gelhad .ge. 2) then - Write (6, *) - CALL UT_ERR_FORM('W', 1, 'GELH_OUTP', - $ '(''Modified to only save GELHAD beam crossings'')', - $ 0, 0, 0, 0, 0, 0) - Write (6, *) '*****************************************' - Write (6, *) 'GELH_OUTP warns: bad mode for normal runs' - Write (6, *) 'If normal run, set gelhad.db / jphadr < 2' - If (jphadr_gelhad .ge. 3) then - Write (6, *) 'This run only saves when ==1 interaction.' - Endif ! (jphadr_gelhad >= 3) - Write (6, *) '*****************************************' - Write (6, *) - Elseif (jphadr_gelhad .ge. 1) then - CALL UT_ERR_FORM('I', 2, 'GELH_OUTP', - $ '(''GELHAD on - all beam crossings saved as usual'')', - $ 0, 0, 0, 0, 0, 0) - Endif ! (jphadr_gelhad >= 2) - Endif ! (First) - -*.. Skipping logic - If (jphadr_gelhad .ge. 3) then -*.. GELHAD on with jphadr =3, skip `events' without ==1 GELHAD interaction - If (gelhadused .and. ngelhperev .eq. 1) then - if (ev_debug.gt.1) print *,' GELH_OUTP: Event ',ievent,IDEVT, - + ' saved, has ==1 interaction' - Else - Iskip = 1 ! SKIP THIS EVENT if not gelhad - Endif - Elseif (jphadr_gelhad .ge. 2) then -*.. GELHAD on with jphadr =2, skip `events' without GELHAD interaction - If (gelhadused) then - if (ev_debug.gt.1) print *,' GELH_OUTP: Event ',ievent,IDEVT, - + ' saved, has n interactions = ', ngelhperev - Else - Iskip = 1 ! SKIP THIS EVENT if not gelhad - Endif - Endif ! (jphadr_gelhad) - -*..Print skips as well - if (iskip .eq. 1 .and. ev_debug .gt. 1) - + print *,' GELH_OUTP: Event ',ievent,IDEVT, - + ' skipped, n = ', ngelhperev, - + ' gelhadused = ', gelhadused - -# endif - -*..Count output - nevtot_gelh = nevtot_gelh + 1 - if (gelhadused) nevhad_gelh = nevhad_gelh + 1 - if (iskip .eq. 0) nevout_gelh = nevout_gelh + 1 - if (gelhadused) ninthad_gelh = ninthad_gelh + ngelhperev -#endif - -c 999 Return - Return - End diff --git a/src/programs/Simulation/HDGeant/gelhad/gelh_vrfy.F b/src/programs/Simulation/HDGeant/gelhad/gelh_vrfy.F deleted file mode 100644 index 3605c6ddde..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelh_vrfy.F +++ /dev/null @@ -1,41 +0,0 @@ - Subroutine Gelh_vrfy ! verify parameters from database/ffread cards -* -*..History: -* Kral 1/18/96 - Use this when the db common block is used (default). -* - Clear event counts. -* Kral 1/19/96 - Add interaction count. -* - implicit none -#include "gnbase/gelhad_db.inc" -#include "gelhad/gelhadused.inc" - logical print/.true./ - save print - logical init/.false./ - save init - -*..Clear output - nevtot_gelh = 0 - nevhad_gelh = 0 - nevout_gelh = 0 - ninthad_gelh = 0 - -*..Print verification - if (print) then - if (.not. init) then - init = .true. - if (jphadr_gelhad .ne. 0) then - write (6, *) - write (6, *) - $ 'GELH_VRFY: GELHAD hadronic interactions are on' - write (6, *) ' jphadr = ', jphadr_gelhad - write (6, *) ' ecut = ', ecut_gelhad - write (6, *) ' scale = ', scale_gelhad - write (6, *) ' mode = ', mode_gelhad - write (6, *) ' ethresh = ', ethresh_gelhad - write (6, *) - endif - endif - endif - - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gelhad.db b/src/programs/Simulation/HDGeant/gelhad/gelhad.db deleted file mode 100644 index 5ced99eb13..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelhad.db +++ /dev/null @@ -1,31 +0,0 @@ -incname gelhad ! include file name - -structure gelhad -!!!!!! Warning - you may not change the order of the 5 first parameters for -!!!!!! backwards compatibility with FFREAD - int jphadr 1 ! Run: (0=default) - ! 0=off - ! 1=save all events (as usual) - ! 2=save only GELHAD events - ! 3=save only GELHAD events with ==1 interaction - real ecut 0.2 ! Energy below which no interactions take place - real scale 1.0 ! Cross section scale factor (1.0=nominal) - int mode 4 ! GPHAD Model control: (4=default) - ! 1=>g->N absorption model - ! 2=>g->pi gamma becomes pi model - ! 3=>undefined - ! 4=>hybrid model - ! g->N below "pi" threshold - ! g->pi above "pi" threshold - ! 5=>g->N with momentum conservation - ! 6=>g->pi with momentum conservation - ! 7=>hyprd model of 5 and 6 - ! 8=>g->rho (vector dominance model) - ! 9=>g->D (quasi-deuteron model) - ! 10=>hybrid of 8 and 9 - ! g->rho above ethresh - ! g->D below ethresh - ! note: default ethresh not sensible - ! for this model - real ethresh 0.150 ! GPHAD Effective pion threshold for mode=4. -end gelhad diff --git a/src/programs/Simulation/HDGeant/gelhad/gelhadused.inc b/src/programs/Simulation/HDGeant/gelhad/gelhadused.inc deleted file mode 100644 index fec0db2d8e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gelhadused.inc +++ /dev/null @@ -1,15 +0,0 @@ -c |gelhadused| is set to |.true.| when |gphad| is called - integer lmecgelh ! GELHAD mechanism name - parameter (lmecgelh = 212) - common/gelhadused/gelhadused - $ ,nevtot_gelh - $ ,nevhad_gelh - $ ,nevout_gelh - $ ,ngelhperev - $ ,ninthad_gelh - logical gelhadused ! there was an interaction in this event - integer nevtot_gelh ! total events - integer nevhad_gelh ! total hadronic interaction events - integer nevout_gelh ! total events output - integer ngelhperev ! Number of gelhad interactions per event - integer ninthad_gelh! total interactions diff --git a/src/programs/Simulation/HDGeant/gelhad/geltwobod.F b/src/programs/Simulation/HDGeant/gelhad/geltwobod.F deleted file mode 100644 index 5c47a306ae..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/geltwobod.F +++ /dev/null @@ -1,70 +0,0 @@ -!Tue Nov 15 17:22:07 PST 1994 - version 1.01 - A. Snyder -!Fortran 90ism removed -!Mon Mar 17 10:57:46 PST 1997 - version 2.00 - A. Snyder -!Modified to |gelhad| version - add cos(theta) dependence -!Fri Apr 4 10:32:29 PST 1997 - version 2.01 - A. Snyder -!Make rho decay angular distribution default to sin^2(theta) -! - subroutine geltwob(p,k,l) - implicit none - save - real *4 p(5),k(5),l(5) - real *4 mp,mk,ml,ek,el,pk,pl - real *4 ctheta,stheta,cphi,sphi,phi,temp - real *4 pi/3.141592/ - real *4 a/1.0/ - real *4 b/-1.0/ - real *4 value - character *(*) command -c integer *4 dum - mp=p(5) - mk=k(5) - ml=l(5) - ek=(mp**2+mk**2-ml**2)/(2.0*mp) - el=(mp**2+ml**2-mk**2)/(2.0*mp) - pk=sqrt(ek**2-mk**2) - pl=pk - call gelpicang(a,b,ctheta,stheta) - call gelrndm(temp,1) - phi=2.0*pi*temp - cphi=cos(phi) - sphi=sin(phi) - k(4)=ek - k(1)=pk*stheta*cphi - k(2)=pk*stheta*sphi - k(3)=pk*ctheta - l(4)=el - l(1)=-k(1) - l(2)=-k(2) - l(3)=-k(3) - call gelboost(k,p,k,-1.0) - call gelboost(l,p,l,-1.0) - return -! - entry geltwobdo(command,value) - if(command.eq.'set:a') then - a=value - else if(command.eq.'set:b') then - b=value - else if(command.eq.'tell:a') then - value=a - else if(command.eq.'tell:b') then - value=b - endif - return - end -! - subroutine gelpicang(a,b,c,s) - real *4 a,b,c,s,temp(2),max,test - max=a - if((max+b).gt.max) max=max+b - 1000 continue - call gelrndm(temp,2) - c=-1.0+2.0*temp(1) - test=(a+b*c**2)/max - if(temp(2).lt.test) go to 1099 - go to 1000 - 1099 continue - s=sqrt(1.0-c**2) - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/blank.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/blank.inc deleted file mode 100644 index f45b604917..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/blank.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /blank from PAM geanh321 **** - PARAMETER (MXGKPV=MXGKGH) - COMMON /VECUTY/ PV(10,MXGKPV) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/blankp.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/blankp.inc deleted file mode 100644 index 1d1c0775a9..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/blankp.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /blankp from PAM geanh321 **** - PARAMETER (MXGKPV=MXGKGH) - COMMON /VECUTY/ PV(10,MXGKPV) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/consts.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/consts.inc deleted file mode 100644 index 50f156b5ea..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/consts.inc +++ /dev/null @@ -1,9 +0,0 @@ -**** Sequence /consts from PAM geanh321 **** - COMMON/CONSTS/ PI,TWPI,PIBTW,MP,MPI,MMU,MEL,MKCH,MK0,SMP,SMPI, - $ SMU,CT,CTKCH,CTK0, - $ ML0,MSP,MS0,MSM,MX0,MXM,CTL0,CTSP,CTSM,CTX0,CTXM, - $ RMASS(35),RCHARG(35) -C - REAL MP,MPI,MMU,MEL,MKCH,MK0, - * ML0,MSP,MS0,MSM,MX0,MXM -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/coscom.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/coscom.inc deleted file mode 100644 index 3ef1f93bb8..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/coscom.inc +++ /dev/null @@ -1,3 +0,0 @@ -**** Sequence /coscom from PAM geanh321 **** - COMMON/COSCOM/AA,BB,CC,DD,RR -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdat.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdat.inc deleted file mode 100644 index 42fb20d77a..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdat.inc +++ /dev/null @@ -1,1046 +0,0 @@ -**** Sequence /csdat from PAM geanh321 **** -C --- CROSS-SECTION DATA BY "PCSDAT" 01-FEB-1989 --- -C - DATA PLAB / - $ 0.00000E+00, 0.10000 , 0.15000 , 0.20000 , 0.25000 , - $ 0.30000 , 0.35000 , 0.40000 , 0.45000 , 0.50000 , - $ 0.55000 , 0.60000 , 0.65000 , 0.70000 , 0.75000 , - $ 0.80000 , 0.85000 , 0.90000 , 0.95000 , 1.0000 , - $ 1.1000 , 1.2000 , 1.3000 , 1.4000 , 1.5000 , - $ 1.6000 , 1.8000 , 2.0000 , 2.2000 , 2.4000 , - $ 2.6000 , 2.8000 , 3.0000 , 4.0000 , 5.0000 , - $ 6.0000 , 8.0000 , 10.000 , 20.000 , 100.00 , - $ 1000.0 / - DATA (CSEL( 1,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 2,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 3,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 4,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 5,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 6,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 7,J),J=1,41) / - $ 0.00000E+00, 6.0000 , 20.000 , 71.000 , 155.00 , - $ 195.00 , 130.00 , 78.000 , 60.000 , 32.000 , - $ 23.500 , 18.500 , 15.000 , 12.500 , 10.000 , - $ 9.1000 , 8.6000 , 8.8000 , 9.5000 , 10.600 , - $ 13.000 , 15.500 , 17.100 , 17.200 , 16.200 , - $ 15.000 , 12.300 , 10.200 , 9.0000 , 8.0000 , - $ 7.3000 , 6.8000 , 6.5000 , 5.8000 , 5.4000 , - $ 5.2000 , 5.0000 , 4.9000 , 3.8000 , 3.2000 , - $ 3.5000 / - DATA (CSEL( 8,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL( 9,J),J=1,41) / - $ 0.00000E+00, 1.0000 , 3.0000 , 8.0000 , 18.000 , - $ 25.000 , 27.500 , 12.300 , 10.600 , 11.000 , - $ 12.500 , 14.500 , 17.000 , 19.400 , 19.800 , - $ 16.800 , 14.000 , 14.800 , 20.000 , 26.100 , - $ 19.500 , 15.000 , 12.800 , 11.500 , 10.500 , - $ 9.8000 , 8.8000 , 8.2000 , 7.8000 , 7.5000 , - $ 7.2000 , 7.0000 , 6.8000 , 6.1000 , 5.7000 , - $ 5.4000 , 4.9000 , 4.6000 , 4.0000 , 3.3000 , - $ 3.5000 / - DATA (CSEL(10,J),J=1,41) / - $ 10.000 , 11.200 , 11.300 , 11.400 , 11.500 , - $ 11.600 , 11.800 , 12.000 , 12.100 , 12.200 , - $ 12.300 , 12.400 , 12.500 , 12.500 , 12.500 , - $ 12.400 , 12.300 , 12.200 , 12.000 , 11.800 , - $ 11.200 , 11.500 , 9.9000 , 9.4000 , 8.8000 , - $ 8.4000 , 7.5000 , 6.9000 , 6.3000 , 5.9000 , - $ 5.5000 , 5.2000 , 5.0000 , 4.0000 , 3.5000 , - $ 3.3000 , 3.1000 , 3.1000 , 3.0000 , 2.5000 , - $ 3.0000 / - DATA (CSEL(11,J),J=1,41) / - $ 10.000 , 11.200 , 11.300 , 11.400 , 11.500 , - $ 11.600 , 11.800 , 12.000 , 12.100 , 12.200 , - $ 12.300 , 12.400 , 12.500 , 12.500 , 12.500 , - $ 12.400 , 12.300 , 12.200 , 12.000 , 11.800 , - $ 11.200 , 11.500 , 9.9000 , 9.4000 , 8.8000 , - $ 8.4000 , 7.5000 , 6.9000 , 6.3000 , 5.9000 , - $ 5.5000 , 5.2000 , 5.0000 , 4.0000 , 3.5000 , - $ 3.3000 , 3.1000 , 3.1000 , 3.0000 , 2.5000 , - $ 3.0000 / - DATA (CSEL(12,J),J=1,41) / - $ 160.83 , 82.800 , 58.575 , 43.683 , 34.792 , - $ 28.650 , 24.367 , 20.917 , 18.192 , 16.300 , - $ 14.608 , 13.017 , 12.250 , 11.700 , 12.017 , - $ 14.075 , 15.842 , 16.433 , 16.042 , 15.008 , - $ 12.575 , 10.708 , 9.2000 , 8.0167 , 7.2833 , - $ 7.0750 , 6.6333 , 6.1250 , 5.6583 , 5.2750 , - $ 4.9333 , 4.6250 , 4.4583 , 3.7333 , 3.3833 , - $ 3.1833 , 2.9833 , 2.7500 , 2.3667 , 2.2000 , - $ 2.6000 / - DATA (CSEL(13,J),J=1,41) / - $ 300.00 , 140.00 , 97.000 , 70.000 , 55.000 , - $ 45.000 , 37.000 , 31.000 , 26.000 , 23.000 , - $ 20.000 , 17.000 , 15.500 , 14.500 , 14.700 , - $ 18.500 , 22.000 , 23.000 , 22.500 , 20.700 , - $ 16.500 , 14.000 , 11.500 , 9.6000 , 8.6000 , - $ 8.5000 , 8.3000 , 7.6000 , 7.0000 , 6.4000 , - $ 5.9000 , 5.5000 , 5.3000 , 4.4000 , 4.1000 , - $ 3.9000 , 3.7000 , 3.3000 , 2.6000 , 2.5000 , - $ 3.0000 / - DATA (CSEL(14,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 20.000 , 20.500 , 21.000 , 22.000 , - $ 23.000 , 24.000 , 24.000 , 24.400 , 24.500 , - $ 25.000 , 25.500 , 26.000 , 26.500 , 27.000 , - $ 27.000 , 26.000 , 23.000 , 21.500 , 20.000 , - $ 19.000 , 18.000 , 17.000 , 13.000 , 11.500 , - $ 10.300 , 9.4000 , 9.0000 , 8.8000 , 7.0000 , - $ 7.5000 / - DATA (CSEL(15,J),J=1,41) / - $ 200.00 , 163.00 , 141.00 , 120.00 , 111.00 , - $ 99.500 , 92.500 , 86.500 , 82.000 , 78.000 , - $ 74.000 , 71.000 , 67.500 , 65.000 , 62.500 , - $ 59.700 , 58.100 , 56.300 , 54.700 , 52.700 , - $ 50.000 , 48.400 , 47.000 , 46.000 , 45.200 , - $ 42.800 , 39.200 , 36.300 , 32.800 , 30.400 , - $ 28.100 , 26.300 , 24.500 , 19.250 , 16.840 , - $ 14.600 , 12.340 , 11.210 , 8.8500 , 7.5000 , - $ 7.5000 / - DATA (CSEL(16,J),J=1,41) / - $ 4200.0 , 440.00 , 420.00 , 400.00 , 230.00 , - $ 160.00 , 105.00 , 80.000 , 62.000 , 50.000 , - $ 45.000 , 41.000 , 38.000 , 36.000 , 35.000 , - $ 34.000 , 33.000 , 32.000 , 31.500 , 31.000 , - $ 30.500 , 30.000 , 29.500 , 29.000 , 28.500 , - $ 28.000 , 26.000 , 23.000 , 21.500 , 20.000 , - $ 19.000 , 18.000 , 17.000 , 13.000 , 11.500 , - $ 10.300 , 9.4000 , 9.0000 , 8.8000 , 7.0000 , - $ 7.5000 / - DATA (CSEL(17,J),J=1,41) / - $ 185.88 , 133.23 , 119.37 , 102.86 , 93.102 , - $ 82.752 , 76.205 , 71.008 , 67.366 , 64.096 , - $ 60.891 , 58.501 , 55.735 , 53.773 , 51.839 , - $ 49.671 , 48.485 , 47.045 , 45.803 , 44.306 , - $ 42.623 , 41.786 , 41.115 , 40.630 , 40.129 , - $ 38.242 , 35.233 , 32.662 , 29.639 , 27.573 , - $ 25.536 , 23.948 , 22.356 , 17.723 , 15.614 , - $ 13.653 , 11.675 , 10.653 , 8.6198 , 7.4464 , - $ 7.4821 / - DATA (CSEL(18,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 , - $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 , - $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 , - $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 , - $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 , - $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 , - $ 6.1145 / - DATA (CSEL(19,J),J=1,41) / - $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 , - $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 , - $ 34.674 , 33.105 , 31.712 , 30.685 , 29.613 , - $ 28.602 , 28.336 , 28.075 , 27.786 , 27.215 , - $ 26.380 , 26.146 , 25.108 , 24.783 , 24.360 , - $ 23.219 , 21.431 , 20.095 , 18.382 , 17.267 , - $ 16.100 , 15.175 , 14.271 , 11.573 , 10.305 , - $ 9.1471 , 8.0149 , 7.4349 , 6.2499 , 5.8928 , - $ 6.0774 / - DATA (CSEL(20,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 , - $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 , - $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 , - $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 , - $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 , - $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 , - $ 6.1145 / - DATA (CSEL(21,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL(22,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 19.067 , 19.333 , 19.500 , 19.833 , - $ 20.567 , 21.800 , 22.900 , 23.869 , 23.809 , - $ 22.161 , 21.488 , 19.732 , 19.433 , 19.345 , - $ 19.029 , 18.121 , 16.280 , 15.258 , 14.280 , - $ 13.644 , 12.963 , 12.316 , 9.5333 , 8.4333 , - $ 7.5728 , 6.9696 , 6.7518 , 6.6175 , 5.6000 , - $ 6.1145 / - DATA (CSEL(23,J),J=1,41) / - $ 185.88 , 133.23 , 119.37 , 102.86 , 93.102 , - $ 82.752 , 76.205 , 71.008 , 67.366 , 64.096 , - $ 60.891 , 58.104 , 55.241 , 53.140 , 50.934 , - $ 48.660 , 47.566 , 46.585 , 45.581 , 44.003 , - $ 41.134 , 39.374 , 36.878 , 35.523 , 34.503 , - $ 32.334 , 29.365 , 27.370 , 24.705 , 22.921 , - $ 21.229 , 19.879 , 18.559 , 14.625 , 12.758 , - $ 11.041 , 9.3440 , 8.5484 , 6.7104 , 6.0000 , - $ 6.1131 / - DATA (CSEL(24,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL(25,J),J=1,41) / - $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 , - $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 , - $ 34.674 , 33.105 , 31.712 , 30.685 , 29.613 , - $ 28.602 , 28.336 , 28.075 , 27.786 , 27.215 , - $ 26.380 , 26.146 , 25.108 , 24.783 , 24.360 , - $ 23.219 , 21.431 , 20.095 , 18.382 , 17.267 , - $ 16.100 , 15.175 , 14.271 , 11.573 , 10.305 , - $ 9.1471 , 8.0149 , 7.4349 , 6.2499 , 5.8928 , - $ 6.0774 / - DATA (CSEL(26,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 , - $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 , - $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 , - $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 , - $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 , - $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 , - $ 4.7289 / - DATA (CSEL(27,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 , - $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 , - $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 , - $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 , - $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 , - $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 , - $ 4.7289 / - DATA (CSEL(28,J),J=1,41) / - $ 157.65 , 73.701 , 76.096 , 68.571 , 57.305 , - $ 49.257 , 43.616 , 40.024 , 38.098 , 36.287 , - $ 34.674 , 32.708 , 31.218 , 30.052 , 28.707 , - $ 27.591 , 27.417 , 27.615 , 27.564 , 26.913 , - $ 24.891 , 23.734 , 20.871 , 19.677 , 18.734 , - $ 17.311 , 15.563 , 14.803 , 13.448 , 12.615 , - $ 11.794 , 11.106 , 10.474 , 8.4745 , 7.4498 , - $ 6.5350 , 5.6835 , 5.3300 , 4.3406 , 4.4464 , - $ 4.7083 / - DATA (CSEL(29,J),J=1,41) / - $ 143.53 , 43.935 , 54.462 , 51.429 , 39.407 , - $ 32.510 , 27.321 , 24.532 , 23.465 , 22.383 , - $ 21.566 , 20.209 , 19.453 , 18.825 , 18.046 , - $ 17.562 , 17.802 , 18.360 , 18.667 , 18.519 , - $ 17.514 , 17.120 , 14.985 , 14.306 , 13.663 , - $ 12.753 , 11.596 , 11.165 , 10.287 , 9.7882 , - $ 9.2294 , 8.7539 , 8.3300 , 6.9480 , 6.2234 , - $ 5.5881 , 5.0189 , 4.7733 , 4.1104 , 4.3929 , - $ 4.6905 / - DATA (CSEL(30,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL(31,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL(32,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSEL(33,J),J=1,41) / - $ 1100.0 , 115.00 , 105.00 , 100.00 , 56.000 , - $ 40.000 , 27.000 , 22.000 , 21.000 , 20.000 , - $ 20.000 , 18.133 , 18.167 , 18.000 , 17.667 , - $ 18.133 , 19.600 , 21.800 , 23.338 , 23.118 , - $ 19.323 , 17.476 , 13.464 , 12.367 , 11.691 , - $ 11.057 , 10.242 , 9.5593 , 9.0151 , 8.5591 , - $ 8.2884 , 7.9253 , 7.6311 , 6.0667 , 5.3667 , - $ 4.8456 , 4.5392 , 4.5036 , 4.4351 , 4.2000 , - $ 4.7289 / - DATA (CSEL(34,J),J=1,41) / - $ 143.53 , 43.935 , 54.462 , 51.429 , 39.407 , - $ 32.510 , 27.321 , 24.532 , 23.465 , 22.383 , - $ 21.566 , 20.209 , 19.453 , 18.825 , 18.046 , - $ 17.562 , 17.802 , 18.360 , 18.667 , 18.519 , - $ 17.514 , 17.120 , 14.985 , 14.306 , 13.663 , - $ 12.753 , 11.596 , 11.165 , 10.287 , 9.7882 , - $ 9.2294 , 8.7539 , 8.3300 , 6.9480 , 6.2234 , - $ 5.5881 , 5.0189 , 4.7733 , 4.1104 , 4.3929 , - $ 4.6905 / - DATA (CSEL(35,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 1,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 2,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 3,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 4,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 5,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 6,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 7,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.50000 , 1.2000 , 1.7000 , - $ 2.2500 , 3.0000 , 3.6000 , 4.5000 , 5.4000 , - $ 6.3000 , 8.6000 , 9.0000 , 10.000 , 11.500 , - $ 14.000 , 17.000 , 19.500 , 22.000 , 24.000 , - $ 21.500 , 18.500 , 19.000 , 20.500 , 22.200 , - $ 23.000 , 23.300 , 23.000 , 21.000 , 20.500 , - $ 20.200 , 20.100 , 20.000 , 20.000 , 20.000 , - $ 21.000 / - DATA (CSIN( 8,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN( 9,J),J=1,41) / - $ 0.00000E+00, 3.0000 , 9.2000 , 20.500 , 36.500 , - $ 45.000 , 28.000 , 19.500 , 15.500 , 14.200 , - $ 15.500 , 17.500 , 20.000 , 23.000 , 26.000 , - $ 20.000 , 23.000 , 26.500 , 32.000 , 35.000 , - $ 28.500 , 22.000 , 22.500 , 23.500 , 24.000 , - $ 24.500 , 26.000 , 27.500 , 27.500 , 27.000 , - $ 26.500 , 25.500 , 25.000 , 23.000 , 22.500 , - $ 22.200 , 22.000 , 22.000 , 21.200 , 20.700 , - $ 21.000 / - DATA (CSIN(10,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.50000 , 1.5000 , 2.7000 , 3.8000 , 4.8000 , - $ 6.5000 , 7.6000 , 8.4000 , 9.0000 , 9.4000 , - $ 9.8000 , 10.500 , 11.000 , 11.500 , 11.800 , - $ 12.200 , 12.400 , 12.600 , 13.200 , 13.500 , - $ 13.700 , 14.000 , 14.200 , 14.500 , 16.400 , - $ 17.000 / - DATA (CSIN(11,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.50000 , 1.5000 , 2.7000 , 3.8000 , 4.8000 , - $ 6.5000 , 7.6000 , 8.4000 , 9.0000 , 9.4000 , - $ 9.8000 , 10.500 , 11.000 , 11.500 , 11.800 , - $ 12.200 , 12.400 , 12.600 , 13.200 , 13.500 , - $ 13.700 , 14.000 , 14.200 , 14.500 , 16.400 , - $ 17.000 / - DATA (CSIN(12,J),J=1,41) / - $ 266.67 , 133.33 , 83.333 , 57.083 , 44.500 , - $ 33.250 , 24.583 , 20.833 , 18.333 , 16.083 , - $ 15.625 , 15.083 , 14.833 , 15.083 , 15.833 , - $ 17.042 , 18.958 , 20.758 , 22.533 , 22.825 , - $ 21.250 , 18.567 , 17.767 , 18.100 , 19.933 , - $ 20.783 , 21.225 , 21.000 , 20.558 , 20.258 , - $ 20.017 , 19.767 , 19.600 , 19.183 , 18.850 , - $ 18.575 , 18.350 , 18.175 , 17.808 , 17.558 , - $ 19.250 / - DATA (CSIN(13,J),J=1,41) / - $ 400.00 , 200.00 , 120.00 , 81.000 , 62.000 , - $ 47.000 , 35.000 , 28.000 , 24.000 , 21.000 , - $ 19.500 , 19.000 , 18.800 , 19.000 , 20.000 , - $ 21.000 , 23.000 , 25.000 , 27.000 , 27.500 , - $ 25.500 , 22.000 , 20.800 , 21.000 , 23.000 , - $ 24.000 , 24.000 , 23.800 , 23.000 , 22.500 , - $ 22.000 , 21.600 , 21.400 , 21.000 , 20.500 , - $ 20.200 , 19.800 , 19.500 , 18.600 , 17.500 , - $ 20.000 / - DATA (CSIN(14,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000 , 1.5000 , - $ 7.0000 , 12.000 , 17.000 , 19.500 , 20.500 , - $ 22.000 , 23.500 , 24.800 , 25.800 , 26.500 , - $ 27.000 , 27.500 , 28.000 , 30.000 , 31.000 , - $ 32.000 , 32.500 , 32.500 , 33.000 , 33.500 , - $ 34.000 / - DATA (CSIN(15,J),J=1,41) / - $ 1500.0 , 1160.0 , 310.00 , 230.00 , 178.00 , - $ 153.00 , 134.00 , 124.00 , 113.00 , 106.00 , - $ 101.00 , 96.000 , 92.000 , 89.000 , 87.000 , - $ 84.000 , 81.000 , 78.500 , 76.500 , 75.000 , - $ 72.000 , 70.000 , 68.000 , 64.500 , 63.000 , - $ 62.000 , 61.000 , 59.500 , 58.500 , 56.500 , - $ 56.500 , 56.000 , 55.500 , 52.000 , 50.000 , - $ 48.000 , 45.000 , 44.000 , 39.200 , 34.500 , - $ 34.500 / - DATA (CSIN(16,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.10000 , 1.5000 , - $ 7.0000 , 12.000 , 17.000 , 19.500 , 20.500 , - $ 22.000 , 23.500 , 24.800 , 25.800 , 26.500 , - $ 27.000 , 27.500 , 28.000 , 30.000 , 31.000 , - $ 32.000 , 32.500 , 32.500 , 33.000 , 33.500 , - $ 34.000 / - DATA (CSIN(17,J),J=1,41) / - $ 1394.1 , 948.17 , 262.43 , 197.14 , 149.30 , - $ 127.25 , 110.39 , 101.79 , 92.834 , 87.104 , - $ 83.109 , 79.099 , 75.965 , 73.627 , 72.161 , - $ 69.889 , 67.595 , 65.595 , 64.057 , 63.054 , - $ 61.377 , 60.434 , 59.485 , 56.970 , 55.931 , - $ 55.398 , 54.827 , 53.538 , 52.861 , 51.247 , - $ 51.344 , 50.992 , 50.644 , 47.876 , 46.358 , - $ 44.887 , 42.577 , 41.815 , 38.180 , 34.254 , - $ 34.418 / - DATA (CSIN(18,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 , - $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 , - $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 , - $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 , - $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 , - $ 27.719 / - DATA (CSIN(19,J),J=1,41) / - $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 , - $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 , - $ 47.326 , 44.762 , 43.222 , 42.015 , 41.221 , - $ 40.244 , 39.504 , 39.145 , 38.860 , 38.731 , - $ 37.987 , 37.814 , 36.326 , 34.750 , 33.953 , - $ 33.635 , 33.349 , 32.938 , 32.785 , 32.092 , - $ 32.373 , 32.312 , 32.329 , 31.261 , 30.597 , - $ 30.073 , 29.228 , 29.182 , 27.683 , 27.107 , - $ 27.956 / - DATA (CSIN(20,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 , - $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 , - $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 , - $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 , - $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 , - $ 27.719 / - DATA (CSIN(21,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN(22,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97815E-01, 1.4577 , - $ 6.2052 , 10.112 , 12.902 , 14.300 , 14.688 , - $ 15.505 , 16.379 , 17.554 , 18.309 , 18.920 , - $ 19.389 , 19.804 , 20.284 , 22.000 , 22.733 , - $ 23.527 , 24.097 , 24.382 , 24.816 , 26.800 , - $ 27.719 / - DATA (CSIN(23,J),J=1,41) / - $ 1394.1 , 948.17 , 262.43 , 197.14 , 149.30 , - $ 127.25 , 110.39 , 101.79 , 92.834 , 87.104 , - $ 83.109 , 78.563 , 75.292 , 72.760 , 70.900 , - $ 68.467 , 66.314 , 64.955 , 63.746 , 62.623 , - $ 59.233 , 56.946 , 53.355 , 49.810 , 48.090 , - $ 46.839 , 45.695 , 44.863 , 44.062 , 42.599 , - $ 42.684 , 42.328 , 42.041 , 39.508 , 37.880 , - $ 36.299 , 34.075 , 33.553 , 29.723 , 27.600 , - $ 28.120 / - DATA (CSIN(24,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN(25,J),J=1,41) / - $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 , - $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 , - $ 47.326 , 44.762 , 43.222 , 42.015 , 41.221 , - $ 40.244 , 39.504 , 39.145 , 38.860 , 38.731 , - $ 37.987 , 37.814 , 36.326 , 34.750 , 33.953 , - $ 33.635 , 33.349 , 32.938 , 32.785 , 32.092 , - $ 32.373 , 32.312 , 32.329 , 31.261 , 30.597 , - $ 30.073 , 29.228 , 29.182 , 27.683 , 27.107 , - $ 27.956 / - DATA (CSIN(26,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 , - $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 , - $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 , - $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 , - $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 , - $ 21.438 / - DATA (CSIN(27,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 , - $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 , - $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 , - $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 , - $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 , - $ 21.438 / - DATA (CSIN(28,J),J=1,41) / - $ 1182.4 , 524.50 , 167.30 , 131.43 , 91.895 , - $ 75.743 , 63.184 , 57.376 , 52.502 , 49.313 , - $ 47.326 , 44.225 , 42.549 , 41.148 , 39.960 , - $ 38.822 , 38.223 , 38.505 , 38.549 , 38.301 , - $ 35.843 , 34.326 , 30.196 , 27.590 , 26.112 , - $ 25.076 , 24.217 , 24.264 , 23.985 , 23.445 , - $ 23.713 , 23.647 , 23.726 , 22.892 , 22.119 , - $ 21.485 , 20.726 , 20.921 , 19.226 , 20.454 , - $ 21.658 / - DATA (CSIN(29,J),J=1,41) / - $ 1076.5 , 312.66 , 119.74 , 98.571 , 63.193 , - $ 49.990 , 39.579 , 35.168 , 32.335 , 30.417 , - $ 29.434 , 27.325 , 26.514 , 25.775 , 25.120 , - $ 24.711 , 24.818 , 25.600 , 26.106 , 26.355 , - $ 25.220 , 24.760 , 21.681 , 20.060 , 19.044 , - $ 18.474 , 18.044 , 18.301 , 18.347 , 18.192 , - $ 18.557 , 18.639 , 18.870 , 18.769 , 18.478 , - $ 18.372 , 18.302 , 18.735 , 18.206 , 20.207 , - $ 21.576 / - DATA (CSIN(30,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN(31,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN(32,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSIN(33,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.95639E-01, 1.4154 , - $ 5.4104 , 8.2240 , 8.8031 , 9.1000 , 8.8761 , - $ 9.0095 , 9.2576 , 10.307 , 10.818 , 11.341 , - $ 11.778 , 12.108 , 12.569 , 14.000 , 14.467 , - $ 15.054 , 15.694 , 16.263 , 16.632 , 20.100 , - $ 21.438 / - DATA (CSIN(34,J),J=1,41) / - $ 1076.5 , 312.66 , 119.74 , 98.571 , 63.193 , - $ 49.990 , 39.579 , 35.168 , 32.335 , 30.417 , - $ 29.434 , 27.325 , 26.514 , 25.775 , 25.120 , - $ 24.711 , 24.818 , 25.600 , 26.106 , 26.355 , - $ 25.220 , 24.760 , 21.681 , 20.060 , 19.044 , - $ 18.474 , 18.044 , 18.301 , 18.347 , 18.192 , - $ 18.557 , 18.639 , 18.870 , 18.769 , 18.478 , - $ 18.372 , 18.302 , 18.735 , 18.206 , 20.207 , - $ 21.576 / - DATA (CSIN(35,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSPIEL( 1,J),J=1,41) / - $ 0.00000E+00, 350.00 , 580.00 , 600.00 , 550.00 , - $ 450.00 , 410.00 , 370.00 , 340.00 , 230.00 , - $ 220.00 , 205.00 , 180.00 , 155.00 , 145.00 , - $ 140.00 , 160.00 , 195.00 , 235.00 , 250.00 , - $ 270.00 , 280.00 , 300.00 , 300.00 , 290.00 , - $ 285.00 , 265.00 , 240.00 , 230.00 , 222.00 , - $ 204.00 , 196.00 , 190.00 , 170.00 , 170.00 , - $ 160.00 , 150.00 , 140.00 , 120.00 , 80.000 , - $ 80.000 / - DATA (CSPIEL( 2,J),J=1,41) / - $ 0.00000E+00, 700.00 , 1000.0 , 1200.0 , 1300.0 , - $ 1300.0 , 1250.0 , 1250.0 , 1100.0 , 1000.0 , - $ 940.00 , 740.00 , 700.00 , 670.00 , 660.00 , - $ 670.00 , 680.00 , 700.00 , 735.00 , 800.00 , - $ 810.00 , 820.00 , 820.00 , 810.00 , 800.00 , - $ 800.00 , 700.00 , 600.00 , 500.00 , 470.00 , - $ 440.00 , 410.00 , 380.00 , 330.00 , 330.00 , - $ 330.00 , 330.00 , 330.00 , 285.00 , 240.00 , - $ 240.00 / - DATA (CSPIEL( 3,J),J=1,41) / - $ 0.00000E+00, 1700.0 , 2200.0 , 2200.0 , 1800.0 , - $ 1300.0 , 1200.0 , 900.00 , 900.00 , 1000.0 , - $ 1100.0 , 1300.0 , 1400.0 , 1420.0 , 1490.0 , - $ 1560.0 , 1580.0 , 1690.0 , 1795.0 , 2000.0 , - $ 2070.0 , 2140.0 , 2050.0 , 2010.0 , 1970.0 , - $ 1880.0 , 1690.0 , 1500.0 , 1420.0 , 1390.0 , - $ 1350.0 , 1360.0 , 1370.0 , 1280.0 , 1290.0 , - $ 1295.0 , 1250.0 , 1200.0 , 1050.0 , 900.00 , - $ 900.00 / - DATA (CSPIIN( 1,J),J=1,41) / - $ 0.00000E+00, 200.00 , 320.00 , 500.00 , 600.00 , - $ 600.00 , 590.00 , 530.00 , 510.00 , 470.00 , - $ 430.00 , 425.00 , 420.00 , 425.00 , 425.00 , - $ 430.00 , 430.00 , 435.00 , 435.00 , 440.00 , - $ 430.00 , 430.00 , 420.00 , 420.00 , 420.00 , - $ 415.00 , 415.00 , 410.00 , 410.00 , 408.00 , - $ 406.00 , 404.00 , 400.00 , 380.00 , 340.00 , - $ 340.00 , 340.00 , 340.00 , 340.00 , 340.00 , - $ 340.00 / - DATA (CSPIIN( 2,J),J=1,41) / - $ 0.00000E+00, 400.00 , 800.00 , 1000.0 , 1100.0 , - $ 1200.0 , 1150.0 , 1050.0 , 1000.0 , 900.00 , - $ 860.00 , 860.00 , 850.00 , 850.00 , 840.00 , - $ 830.00 , 820.00 , 810.00 , 805.00 , 800.00 , - $ 800.00 , 800.00 , 800.00 , 800.00 , 800.00 , - $ 800.00 , 800.00 , 800.00 , 800.00 , 780.00 , - $ 760.00 , 740.00 , 720.00 , 720.00 , 700.00 , - $ 690.00 , 680.00 , 670.00 , 665.00 , 660.00 , - $ 660.00 / - DATA (CSPIIN( 3,J),J=1,41) / - $ 0.00000E+00, 1000.0 , 1900.0 , 2600.0 , 2900.0 , - $ 3000.0 , 2800.0 , 2600.0 , 2500.0 , 2300.0 , - $ 2200.0 , 2000.0 , 1900.0 , 1880.0 , 1860.0 , - $ 1840.0 , 1820.0 , 1810.0 , 1805.0 , 1800.0 , - $ 1780.0 , 1760.0 , 1750.0 , 1740.0 , 1730.0 , - $ 1720.0 , 1710.0 , 1700.0 , 1680.0 , 1660.0 , - $ 1650.0 , 1640.0 , 1630.0 , 1620.0 , 1610.0 , - $ 1605.0 , 1600.0 , 1600.0 , 1550.0 , 1500.0 , - $ 1500.0 / - DATA (CSPNEL( 1,J),J=1,41) / - $ 2100.0 , 1800.0 , 1500.0 , 1050.0 , 900.00 , - $ 950.00 , 800.00 , 650.00 , 570.00 , 390.00 , - $ 300.00 , 240.00 , 230.00 , 230.00 , 220.00 , - $ 220.00 , 225.00 , 225.00 , 240.00 , 240.00 , - $ 290.00 , 330.00 , 335.00 , 350.00 , 355.00 , - $ 370.00 , 350.00 , 330.00 , 310.00 , 290.00 , - $ 270.00 , 265.00 , 260.00 , 230.00 , 210.00 , - $ 210.00 , 200.00 , 200.00 , 190.00 , 180.00 , - $ 180.00 / - DATA (CSPNEL( 2,J),J=1,41) / - $ 3800.0 , 2900.0 , 1850.0 , 1550.0 , 1450.0 , - $ 1520.0 , 1460.0 , 1300.0 , 1140.0 , 880.00 , - $ 700.00 , 620.00 , 540.00 , 560.00 , 460.00 , - $ 460.00 , 470.00 , 470.00 , 480.00 , 480.00 , - $ 580.00 , 600.00 , 610.00 , 620.00 , 620.00 , - $ 620.00 , 590.00 , 580.00 , 460.00 , 440.00 , - $ 420.00 , 400.00 , 480.00 , 430.00 , 380.00 , - $ 380.00 , 380.00 , 380.00 , 380.00 , 380.00 , - $ 380.00 / - DATA (CSPNEL( 3,J),J=1,41) / - $ 7000.0 , 6000.0 , 4500.0 , 3350.0 , 2700.0 , - $ 3000.0 , 3550.0 , 3970.0 , 3280.0 , 2490.0 , - $ 2100.0 , 1510.0 , 1440.0 , 1370.0 , 1370.0 , - $ 1370.0 , 1400.0 , 1400.0 , 1420.0 , 1420.0 , - $ 1440.0 , 1460.0 , 1460.0 , 1450.0 , 1450.0 , - $ 1470.0 , 1400.0 , 1400.0 , 1380.0 , 1370.0 , - $ 1360.0 , 1350.0 , 1340.0 , 1330.0 , 1320.0 , - $ 1310.0 , 1305.0 , 1300.0 , 1300.0 , 1300.0 , - $ 1300.0 / - DATA (CSPNIN( 1,J),J=1,41) / - $ 0.00000E+00, 200.00 , 400.00 , 800.00 , 800.00 , - $ 550.00 , 500.00 , 450.00 , 430.00 , 410.00 , - $ 400.00 , 390.00 , 380.00 , 370.00 , 370.00 , - $ 370.00 , 365.00 , 365.00 , 360.00 , 360.00 , - $ 360.00 , 360.00 , 365.00 , 370.00 , 375.00 , - $ 380.00 , 400.00 , 410.00 , 420.00 , 430.00 , - $ 440.00 , 440.00 , 440.00 , 440.00 , 440.00 , - $ 440.00 , 440.00 , 440.00 , 440.00 , 440.00 , - $ 440.00 / - DATA (CSPNIN( 2,J),J=1,41) / - $ 0.00000E+00, 400.00 , 950.00 , 1050.0 , 1050.0 , - $ 980.00 , 940.00 , 900.00 , 860.00 , 820.00 , - $ 800.00 , 780.00 , 760.00 , 740.00 , 740.00 , - $ 740.00 , 730.00 , 730.00 , 720.00 , 720.00 , - $ 720.00 , 720.00 , 730.00 , 740.00 , 750.00 , - $ 760.00 , 800.00 , 820.00 , 820.00 , 820.00 , - $ 820.00 , 820.00 , 820.00 , 820.00 , 820.00 , - $ 820.00 , 820.00 , 820.00 , 820.00 , 820.00 , - $ 820.00 / - DATA (CSPNIN( 3,J),J=1,41) / - $ 0.00000E+00, 0.00000E+00, 500.00 , 1450.0 , 1700.0 , - $ 1800.0 , 1750.0 , 1730.0 , 1720.0 , 1710.0 , - $ 1700.0 , 1690.0 , 1660.0 , 1630.0 , 1630.0 , - $ 1630.0 , 1600.0 , 1600.0 , 1580.0 , 1580.0 , - $ 1580.0 , 1580.0 , 1600.0 , 1630.0 , 1650.0 , - $ 1670.0 , 1760.0 , 1800.0 , 1800.0 , 1800.0 , - $ 1800.0 , 1800.0 , 1800.0 , 1800.0 , 1800.0 , - $ 1800.0 , 1800.0 , 1800.0 , 1800.0 , 1800.0 , - $ 1800.0 / - DATA ELAB / - $ 0.10000E-03, 0.20000E-03, 0.30000E-03, 0.40000E-03, 0.50000E-03, - $ 0.70000E-03, 0.10000E-02, 0.20000E-02, 0.30000E-02, 0.40000E-02, - $ 0.50000E-02, 0.70000E-02, 0.10000E-01, 0.15000E-01, 0.20000E-01, - $ 0.25000E-01, 0.32700E-01/ - DATA CNLWAT / - $ 1.0000 , 16.000 , 27.000 , 56.000 , 59.000 , - $ 64.000 , 91.000 , 112.00 , 119.00 , 127.00 , - $ 137.00 , 181.00 , 207.00 , 209.00 , 238.00 / - DATA (CNLWEL( 1,J),J=1,17) / - $ 6000.0 , 5500.0 , 5200.0 , 4900.0 , 4800.0 , - $ 4400.0 , 4000.0 , 2900.0 , 2200.0 , 1800.0 , - $ 1400.0 , 1100.0 , 900.00 , 700.00 , 600.00 , - $ 560.00 , 520.00 / - DATA (CNLWEL( 2,J),J=1,17) / - $ 5400.0 , 5050.0 , 4800.0 , 4600.0 , 4399.0 , - $ 4090.0 , 3700.0 , 2600.0 , 1950.0 , 1600.0 , - $ 1300.0 , 900.00 , 700.00 , 800.00 , 1050.0 , - $ 1250.0 , 1320.0 / - DATA (CNLWEL( 3,J),J=1,17) / - $ 5500.0 , 5150.0 , 4900.0 , 4699.0 , 4490.0 , - $ 4150.0 , 3750.0 , 2790.0 , 2100.0 , 1650.0 , - $ 1300.0 , 950.00 , 800.00 , 860.00 , 1000.0 , - $ 1090.0 , 1080.0 / - DATA (CNLWEL( 4,J),J=1,17) / - $ 5499.0 , 4970.0 , 4450.0 , 4080.0 , 3750.0 , - $ 3380.0 , 2900.0 , 2400.0 , 2380.0 , 2350.0 , - $ 2300.0 , 2100.0 , 1720.0 , 1370.0 , 1200.0 , - $ 1060.0 , 870.00 / - DATA (CNLWEL( 5,J),J=1,17) / - $ 5399.0 , 4710.0 , 4180.0 , 3760.0 , 3460.0 , - $ 3150.0 , 2730.0 , 2270.0 , 1850.0 , 1850.0 , - $ 2130.0 , 2330.0 , 2120.0 , 1640.0 , 1310.0 , - $ 1100.0 , 1050.0 / - DATA (CNLWEL( 6,J),J=1,17) / - $ 5099.0 , 4405.0 , 3825.0 , 3455.0 , 3125.0 , - $ 2695.0 , 2350.0 , 1850.0 , 1580.0 , 1820.0 , - $ 2050.0 , 2210.0 , 2000.0 , 1590.0 , 1310.0 , - $ 1120.0 , 1040.0 / - DATA (CNLWEL( 7,J),J=1,17) / - $ 6290.0 , 5960.0 , 5640.0 , 5370.0 , 5150.0 , - $ 4800.0 , 4250.0 , 3150.0 , 2470.0 , 2100.0 , - $ 2230.0 , 2420.0 , 2450.0 , 2050.0 , 1760.0 , - $ 1550.0 , 1330.0 / - DATA (CNLWEL( 8,J),J=1,17) / - $ 6885.0 , 6650.0 , 6350.0 , 6150.0 , 6000.0 , - $ 5700.0 , 5360.0 , 4250.0 , 2800.0 , 1870.0 , - $ 1810.0 , 1820.0 , 2170.0 , 2450.0 , 2150.0 , - $ 1700.0 , 1390.0 / - DATA (CNLWEL( 9,J),J=1,17) / - $ 6600.0 , 6500.0 , 6400.0 , 6249.0 , 6190.0 , - $ 5950.0 , 5520.0 , 4250.0 , 2750.0 , 1900.0 , - $ 1850.0 , 1950.0 , 2340.0 , 2800.0 , 2540.0 , - $ 2100.0 , 1760.0 / - DATA (CNLWEL(10,J),J=1,17) / - $ 7400.0 , 7200.0 , 6999.0 , 6840.0 , 6655.0 , - $ 6320.0 , 5820.0 , 4400.0 , 2850.0 , 2000.0 , - $ 1800.0 , 1800.0 , 2150.0 , 2600.0 , 2350.0 , - $ 1950.0 , 2100.0 / - DATA (CNLWEL(11,J),J=1,17) / - $ 7900.0 , 7700.0 , 7499.0 , 7390.0 , 7202.0 , - $ 6810.0 , 6360.0 , 4920.0 , 3450.0 , 2600.0 , - $ 2200.0 , 1950.0 , 2300.0 , 2800.0 , 2650.0 , - $ 2250.0 , 2050.0 / - DATA (CNLWEL(12,J),J=1,17) / - $ 7900.0 , 7750.0 , 7699.0 , 7590.0 , 7450.0 , - $ 7200.0 , 6850.0 , 5650.0 , 4400.0 , 3700.0 , - $ 3400.0 , 2800.0 , 2700.0 , 3100.0 , 3250.0 , - $ 3100.0 , 2750.0 / - DATA (CNLWEL(13,J),J=1,17) / - $ 6100.0 , 5950.0 , 5750.0 , 5599.0 , 5440.0 , - $ 5200.0 , 4800.0 , 4300.0 , 5800.0 , 5750.0 , - $ 4800.0 , 3420.0 , 2650.0 , 3200.0 , 3650.0 , - $ 3500.0 , 2980.0 / - DATA (CNLWEL(14,J),J=1,17) / - $ 6100.0 , 5950.0 , 5750.0 , 5599.0 , 5440.0 , - $ 5200.0 , 4800.0 , 4300.0 , 5800.0 , 5750.0 , - $ 4800.0 , 3420.0 , 2650.0 , 3200.0 , 3650.0 , - $ 3500.0 , 2980.0 / - DATA (CNLWEL(15,J),J=1,17) / - $ 6600.0 , 6350.0 , 6100.0 , 5899.0 , 5690.0 , - $ 5300.0 , 4850.0 , 4450.0 , 5650.0 , 5700.0 , - $ 4950.0 , 3850.0 , 3050.0 , 3050.0 , 3460.0 , - $ 3650.0 , 3340.0 / - DATA (CNLWIN( 1,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00/ - DATA (CNLWIN( 2,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , - $ 10.000 , 50.000 , 100.00 , 200.00 , 300.00 , - $ 400.00 , 600.00 , 700.00 , 750.00 , 700.00 , - $ 700.00 , 680.00 / - DATA (CNLWIN( 3,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , - $ 50.000 , 100.00 , 260.00 , 450.00 , 600.00 , - $ 700.00 , 800.00 , 900.00 , 940.00 , 900.00 , - $ 860.00 , 820.00 / - DATA (CNLWIN( 4,J),J=1,17) / - $ 1.0000 , 80.000 , 200.00 , 320.00 , 400.00 , - $ 520.00 , 700.00 , 1000.0 , 1120.0 , 1200.0 , - $ 1200.0 , 1200.0 , 1180.0 , 1130.0 , 1100.0 , - $ 1090.0 , 1080.0 / - DATA (CNLWIN( 5,J),J=1,17) / - $ 1.0000 , 90.000 , 220.00 , 340.00 , 420.00 , - $ 550.00 , 720.00 , 1080.0 , 1300.0 , 1400.0 , - $ 1420.0 , 1420.0 , 1380.0 , 1260.0 , 1190.0 , - $ 1150.0 , 1100.0 / - DATA (CNLWIN( 6,J),J=1,17) / - $ 1.0000 , 95.000 , 225.00 , 345.00 , 425.00 , - $ 555.00 , 750.00 , 1150.0 , 1500.0 , 1680.0 , - $ 1700.0 , 1690.0 , 1550.0 , 1360.0 , 1240.0 , - $ 1180.0 , 1120.0 / - DATA (CNLWIN( 7,J),J=1,17) / - $ 10.000 , 140.00 , 260.00 , 380.00 , 450.00 , - $ 600.00 , 750.00 , 1200.0 , 1580.0 , 1800.0 , - $ 1820.0 , 1830.0 , 1800.0 , 1750.0 , 1690.0 , - $ 1650.0 , 1620.0 / - DATA (CNLWIN( 8,J),J=1,17) / - $ 15.000 , 150.00 , 300.00 , 400.00 , 500.00 , - $ 650.00 , 840.00 , 1500.0 , 2100.0 , 2130.0 , - $ 2140.0 , 2130.0 , 2080.0 , 2000.0 , 1950.0 , - $ 1900.0 , 1860.0 / - DATA (CNLWIN( 9,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , - $ 150.00 , 380.00 , 1000.0 , 1650.0 , 2100.0 , - $ 2100.0 , 2100.0 , 2060.0 , 1950.0 , 1860.0 , - $ 1800.0 , 1740.0 / - DATA (CNLWIN(10,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 45.000 , - $ 180.00 , 380.00 , 1050.0 , 1900.0 , 2300.0 , - $ 2300.0 , 2200.0 , 2150.0 , 2000.0 , 1900.0 , - $ 1800.0 , 1750.0 / - DATA (CNLWIN(11,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 48.000 , - $ 190.00 , 390.00 , 1080.0 , 2000.0 , 2400.0 , - $ 2400.0 , 2300.0 , 2200.0 , 2100.0 , 1950.0 , - $ 1850.0 , 1800.0 / - DATA (CNLWIN(12,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , 50.000 , - $ 200.00 , 400.00 , 1100.0 , 2100.0 , 2500.0 , - $ 2500.0 , 2450.0 , 2300.0 , 2100.0 , 2000.0 , - $ 1900.0 , 1850.0 / - DATA (CNLWIN(13,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , - $ 100.00 , 350.00 , 900.00 , 1400.0 , 2000.0 , - $ 2300.0 , 2380.0 , 2400.0 , 2300.0 , 2250.0 , - $ 2200.0 , 2120.0 / - DATA (CNLWIN(14,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , - $ 100.00 , 350.00 , 900.00 , 1400.0 , 2000.0 , - $ 2300.0 , 2380.0 , 2400.0 , 2300.0 , 2250.0 , - $ 2200.0 , 2120.0 / - DATA (CNLWIN(15,J),J=1,17) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 1.0000 , 10.000 , - $ 100.00 , 400.00 , 950.00 , 1600.0 , 2200.0 , - $ 2550.0 , 2750.0 , 2700.0 , 2600.0 , 2540.0 , - $ 2450.0 , 2360.0 / - DATA (CSCAP(J),J=1,50) / - $ 6.0000 , 5.7000 , 5.5000 , 5.3000 , 5.2000 , - $ 5.1000 , 5.0000 , 4.9000 , 4.8000 , 4.8000 , - $ 4.8000 , 4.8000 , 4.8000 , 4.8000 , 4.8000 , - $ 4.8000 , 4.9000 , 5.0000 , 5.2000 , 5.5000 , - $ 6.0000 , 6.7000 , 7.5000 , 8.5000 , 10.000 , - $ 12.000 , 14.500 , 19.000 , 26.500 , 40.000 , - $ 75.000 , 120.00 , 180.00 , 260.00 , 360.00 , - $ 330.00 , 60.000 , 7.0000 , 9.5000 , 20.000 , - $ 75.000 , 140.00 , 250.00 , 360.00 , 480.00 , - $ 580.00 , 590.00 , 500.00 , 300.00 , 100.00 / - DATA (CSCAP(J),J=51,100) / - $ 200.00 , 300.00 , 400.00 , 470.00 , 500.00 , - $ 430.00 , 100.00 , 20.000 , 22.000 , 40.000 , - $ 560.00 , 950.00 , 1000.0 , 1000.0 , 1000.0 , - $ 990.00 , 920.00 , 860.00 , 790.00 , 740.00 , - $ 650.00 , 600.00 , 540.00 , 470.00 , 440.00 , - $ 390.00 , 360.00 , 340.00 , 320.00 , 310.00 , - $ 280.00 , 2.0000 , 2.5000 , 6.0000 , 13.000 , - $ 38.000 , 65.000 , 140.00 , 280.00 , 300.00 , - $ 430.00 , 580.00 , 650.00 , 800.00 , 920.00 , - $ 1100.0 , 1250.0 , 1400.0 , 1550.0 , 1700.0 / - DATA EKFISS / - $ 0.10000E-03, 0.20000E-03, 0.30000E-03, 0.50000E-03, 0.70000E-03, - $ 0.10000E-02, 0.15000E-02, 0.20000E-02, 0.30000E-02, 0.50000E-02, - $ 0.70000E-02, 0.10000E-01, 0.15000E-01, 0.20000E-01, 0.50000E-01, - $ 0.10000 , 0.20000 , 0.30000 , 0.40000 , 0.50000 , - $ 1000.0 / - DATA (CSFISS( 1,J),J=1,21) / - $ 2600.0 , 2300.0 , 2300.0 , 2100.0 , 2000.0 , - $ 1950.0 , 1930.0 , 1900.0 , 1800.0 , 1600.0 , - $ 2100.0 , 2300.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSFISS( 2,J),J=1,21) / - $ 1850.0 , 1400.0 , 1300.0 , 1150.0 , 1100.0 , - $ 1200.0 , 1250.0 , 1300.0 , 1250.0 , 1150.0 , - $ 1600.0 , 1900.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSFISS( 3,J),J=1,21) / - $ 1700.0 , 1650.0 , 1650.0 , 1700.0 , 1700.0 , - $ 1800.0 , 1900.0 , 2000.0 , 1950.0 , 1800.0 , - $ 2150.0 , 2450.0 , 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00/ - DATA (CSFISS( 4,J),J=1,21) / - $ 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - $ 0.00000E+00, 250.00 , 550.00 , 550.00 , 550.00 , - $ 550.00 , 550.00 , 1000.0 , 1400.0 , 1600.0 , - $ 1500.0 , 1400.0 , 1300.0 , 1200.0 , 1100.0 , - $ 1000.0 / -C --- END OF CROSS SECTION DATA STATEMENTS --- -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdim.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdim.inc deleted file mode 100644 index 883289c0cb..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/csdim.inc +++ /dev/null @@ -1,7 +0,0 @@ -**** Sequence /csdim from PAM geanh321 **** -C --- DIMENSION STATEMENTS FOR CROSS SECTION DATA --- - DIMENSION PLAB(41),CSEL(35,41),CSIN(35,41),CSPIEL(3,41), - $ CSPIIN(3,41),CSPNEL(3,41),CSPNIN(3,41), - $ ELAB(17),CNLWAT(15),CNLWEL(15,17),CNLWIN(15,17), - $ CSCAP(100),EKFISS(21),CSFISS(4,21) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/curpar.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/curpar.inc deleted file mode 100644 index 90bb4b6704..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/curpar.inc +++ /dev/null @@ -1,7 +0,0 @@ -**** Sequence /curpar from PAM geanh321 **** - PARAMETER (MXGKCU=MXGKGH) - COMMON/CURPAR/WEIGHT(10),DDELTN,IFILE,IRUN,NEVT,NEVENT,SHFLAG, - * ITHST,ITTOT,ITLST,IFRND,TOFCUT,CMOM(5),CENG(5), - * RS,S,ENP(10),NP,NM,NN,NR,NO,NZ,IPA(MXGKCU), - * ATNO2,ZNO2 -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/defcom.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/defcom.inc deleted file mode 100644 index 9058987090..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/defcom.inc +++ /dev/null @@ -1,11 +0,0 @@ -**** Sequence /defcom from PAM geanh321 **** -#include "mxgkgh.inc" -#include "consts.inc" -#include "curpar.inc" -#include "result.inc" -#include "mat.inc" -#include "event.inc" -#include "prntfl.inc" -#include "errcom.inc" -#include "blank.inc" -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/errcom.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/errcom.inc deleted file mode 100644 index 07869a9af3..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/errcom.inc +++ /dev/null @@ -1,3 +0,0 @@ -**** Sequence /errcom from PAM geanh321 **** - COMMON/ERRCOM/ IER(100) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/event.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/event.inc deleted file mode 100644 index 50c422dddd..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/event.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /event from PAM geanh321 **** - PARAMETER (MXEVEN=12*MXGKGH) - COMMON/EVENT / NSIZE,NCUR,NEXT,NTOT,EVE(MXEVEN) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/genio.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/genio.inc deleted file mode 100644 index 959c569420..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/genio.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /genio from PAM geanh321 **** - COMMON/GENIN /TECM,AMASS(18),NPG,KGENEV - COMMON/GENOUT/PCM(5,18),WGT -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/kginit.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/kginit.inc deleted file mode 100644 index 08b146b57d..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/kginit.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /kginit from PAM geanh321 **** -C --- INITIALIZATION FLAGS FOR VARIOUS GHEISHA ROUTINES --- - COMMON /KGINIT/ KGINIT(50) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/limits.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/limits.inc deleted file mode 100644 index d748c8f7d6..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/limits.inc +++ /dev/null @@ -1,5 +0,0 @@ -**** Sequence limits from PAM geanh321 **** -C --- BOUNDARY LIMITS FOR ARGUMENTS OF INTRINSIC FUNCTIONS --- -C --- XL DENOTES LOWER BOUND WHEREAS XU DENOTES UPPER BOUND --- - COMMON /LIMITS/ EXPXL,EXPXU -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/masses.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/masses.inc deleted file mode 100644 index a5cd8557b8..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/masses.inc +++ /dev/null @@ -1,31 +0,0 @@ - - real *4 mgam/0.0/ - real *4 mnu/0.0/ - real *4 mw/80.8/ - real *4 mz/92.9/ - real *4 mmu/0.10565932/ - real *4 mtau/1.7770/ - real *4 me/0.0005110034/ - real *4 mpich/0.1395673/ - real *4 mpi0/0.1349630/ - real *4 meta/0.5488/ - real *4 mkch/0.493667/ - real *4 mphi/1.020/ - real *4 mk0/0.49767/ - real *4 mdch/1.8694/ - real *4 md0/1.8647/ - real *4 mdstr/2.0101/ - real *4 mf/1.971/ - real *4 mbch/5.276/ - real *4 mb0/5.276/ - real *4 mbs/5.6/ - real *4 mbc/6.0/ - real *4 mp/0.9382796/ - real *4 mn/0.9395731/ - real *4 mlda/1.1156/ - real *4 mspls/1.18936/ - real *4 ms0/1.19246/ - real *4 msmns/1.19734/ - real *4 mpsi/3.0960/ - - diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/mat.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/mat.inc deleted file mode 100644 index 2588c115d5..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/mat.inc +++ /dev/null @@ -1,8 +0,0 @@ -**** Sequence /mat from PAM geanh321 **** - COMMON/MAT / LMAT, - * DEN(21),RADLTH(21),ATNO(21),ZNO(21),ABSL(21), - * CDEN(21),MDEN(21),X0DEN(21),X1DEN(21),RION(21), - * MATID(21),MATID1(21,24),PARMAT(21,10), - * IFRAT,IFRAC(21),FRAC1(21,10),DEN1(21,10), - * ATNO1(21,10),ZNO1(21,10) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/mxgkgh.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/mxgkgh.inc deleted file mode 100644 index 5a40643e4e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/mxgkgh.inc +++ /dev/null @@ -1,2 +0,0 @@ -**** Sequence mxgkgh from PAM geanh321 **** - PARAMETER (MXGKGH=100) diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/nucio.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/nucio.inc deleted file mode 100644 index 4dcad1e697..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/nucio.inc +++ /dev/null @@ -1,7 +0,0 @@ -**** Sequence /nucio from PAM geanh321 **** - COMMON/NUCIN /TECM,AMASS(18),NPG,KGENEV - COMMON/NUCOUT/PCM(5,18),WGT -#if ! _SINGLE_ -#include "nuciod.inc" -#endif -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/nuciod.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/nuciod.inc deleted file mode 100644 index cea8422f8e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/nuciod.inc +++ /dev/null @@ -1,3 +0,0 @@ -**** Sequence nuciod from PAM geanh321 **** - DOUBLE PRECISION TECM,AMASS,PCM,WGT -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodat.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodat.inc deleted file mode 100644 index 1a7f0a43d6..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodat.inc +++ /dev/null @@ -1,20 +0,0 @@ -**** Sequence pcodat from PAM geanh321 **** -C --- DATA STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS --- -C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT CODE I --- -C --- IKPART(I)=GEANT CODE CORRESPONDING TO GHEISHA CODE I --- -C - DATA KIPART/ - $ 1, 3, 4, 2, 5, 6, 8, 7, - $ 9, 12, 10, 13, 16, 14, 15, 11, - $ 35, 18, 20, 21, 22, 26, 27, 33, - $ 17, 19, 23, 24, 25, 28, 29, 34, - $ 35, 35, 35, 35, 35, 35, 35, 35, - $ 35, 35, 35, 35, 30, 31, 32, 35/ -C - DATA IKPART/ - $ 1, 4, 2, 3, 5, 6, 8, 7, - $ 9, 11, 16, 10, 12, 14, 15, 13, - $ 25, 18, 26, 19, 20, 21, 27, 28, - $ 29, 22, 23, 30, 31, 45, 46, 47, - $ 24, 32, 48/ -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodim.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodim.inc deleted file mode 100644 index 8e74d986ed..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/pcodim.inc +++ /dev/null @@ -1,7 +0,0 @@ -**** Sequence pcodim from PAM geanh321 **** -C --- DIMENSION STMTS. FOR GEANT/GHEISHA PARTICLE CODE CONVERSIONS --- -C --- KIPART(I)=GHEISHA CODE CORRESPONDING TO GEANT CODE I --- -C --- IKPART(I)=GEANT CODE CORRESPONDING TO GHEISHA CODE I --- -C - DIMENSION KIPART(48),IKPART(35) -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/prntfl.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/prntfl.inc deleted file mode 100644 index ae0c8b87e4..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/prntfl.inc +++ /dev/null @@ -1,4 +0,0 @@ -**** Sequence /prntfl from PAM geanh321 **** - COMMON/PRNTFL/INBCD,NEWBCD,INBIN,NEWBIN,NPEVT,NEVTP,LPRT,NPRT(10) - LOGICAL LPRT,NPRT -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/result.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/result.inc deleted file mode 100644 index cc76a48fee..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/result.inc +++ /dev/null @@ -1,8 +0,0 @@ -**** Sequence /result from PAM geanh321 **** - COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ, - * USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,IPART,IND, - * LCALO,ICEL,SINL,COSL,SINP,COSP, - * XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD, - * XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT - REAL NCH,INTCT -C diff --git a/src/programs/Simulation/HDGeant/gelhad/ghcdes/uanal.inc b/src/programs/Simulation/HDGeant/gelhad/ghcdes/uanal.inc deleted file mode 100644 index 378f79fcf1..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghcdes/uanal.inc +++ /dev/null @@ -1,16 +0,0 @@ - common/mode/mode - character *80 mode -c mode=string describing decay mode ... same as *.newdat filename -c - common/upid/probmin,qtof,qdedx,qcrid - real *4 probmin - logical qtof,qdedx,qcrid -c probmin=min probability of good pid -c qtof=use tof ? -c qdedx=use dedx ? -c qcrid=use crid ? -c - common/cuts/dmk0 - real *4 dmk0 -c dmk0=k0 mass cut -c diff --git a/src/programs/Simulation/HDGeant/gelhad/gheishp.F b/src/programs/Simulation/HDGeant/gelhad/gheishp.F deleted file mode 100644 index 1dff744b9f..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gheishp.F +++ /dev/null @@ -1,770 +0,0 @@ - subroutine gheishp - x(ipart,pvec,mprod,nprod,iprod,tprod,pprod) -c -c |gheisha| includes -#include "gelhad/ghcdes/mxgkgh.inc" -C -C |geant| commons -#include "geant321/gcbank.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gccuts.inc" -#include "geant321/gcflag.inc" -#include "geant321/gcking.inc" -#include "geant321/gcmate.inc" -#include "geant321/gcphys.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcunit.inc" -#include "geant321/gsecti.inc" -C -C /gheisha/ commons -#include "gelhad/ghcdes/blankp.inc" -#include "gelhad/ghcdes/consts.inc" -#include "gelhad/ghcdes/event.inc" - integer *4 nprod,mprod,code,stop - integer *4 iprod(mprod) - real *4 pprod(3,mprod) - real *4 tprod(mprod) - integer *4 ipart - real *4 pvec(3) - character *(*) todo - real *4 arg - real *4 value - integer *4 ivalue - equivalence (value,ivalue) -c - integer *4 intforce/0/ -c -c *** main steering for hadron shower development *** -c *** nve 15-jun-1988 cern geneva *** -c -c called by : guhadr (user routine) -c origin : f.carminati, h.fesefeldt -c routines : calim 16-sep-1987 -c setres 19-aug-1985 -c intact 06-oct-1987 - integer *4 ind -c -c -c -c -c -c --- "nevent" changed to "kevent" in common /curpar/ due to clash --- -c --- with variable "nevent" in geant common --- -c - parameter (mxgkcu=mxgkgh) - common /curpar /weight(10),ddeltn,ifile,irun,nevt,kevent,shflag, - $ ithst,ittot,itlst,ifrnd,tofcut,cmom(5),ceng(5), - $ rs,s,enp(10),np,nm,nn,nr,no,nz,ipa(mxgkcu), - $ atno2,zno2 -c -c ipart->kpart because of name conflict with /geant321/ -c - common /result/ xend,yend,zend,rca,rce,amas,nch,tof,px,py,pz, - $ userw,intct,p,en,ek,amasq,deltn,itk,ntk,kpart,ind, - $ lcalo,icel,sinl,cosl,sinp,cosp, - $ xold,yold,zold,pold,pxold,pyold,pzold, - $ xscat,yscat,zscat,pscat,pxscat,pyscat,pzscat - real nch,intct -c -c --- "absl(21)" changed to "abslth(21)" in common /mat/ due to clash --- -c --- with variable "absl" in geant common --- -c - common /mat/ lmat, - $ den(21),radlth(21),atno(21),zno(21),abslth(21), - $ cden(21),mden(21),x0den(21),x1den(21),rion(21), - $ matid(21),matid1(21,24),parmat(21,10), - $ ifrat,ifrac(21),frac1(21,10),den1(21,10), - $ atno1(21,10),zno1(21,10) -c - dimension ipelos(35) - save ideol -c -c --- random number array -- - dimension rndm(1) -c -c --- dimension stmts. for geant321/gheisha particle code conversions --- -c --- kipart(i)=gheisha code corresponding to geant code i --- -c --- ikpart(i)=geant code corresponding to gheisha code i --- -c - integer kipart(48),ikpart(35) -c -c --- data stmts. for geant321/gheisha particle code conversions --- -c --- kipart(i)=gheisha code corresponding to geant code i --- -c --- ikpart(i)=geant code corresponding to gheisha code i --- -c - data kipart/ - $ 1, 3, 4, 2, 5, 6, 8, 7, - $ 9, 12, 10, 13, 16, 14, 15, 11, - $ 35, 18, 20, 21, 22, 26, 27, 33, - $ 17, 19, 23, 24, 25, 28, 29, 34, - $ 35, 35, 35, 35, 35, 35, 35, 35, - $ 35, 35, 35, 35, 30, 31, 32, 35/ -c - data ikpart/ - $ 1, 4, 2, 3, 5, 6, 8, 7, - $ 9, 11, 16, 10, 12, 14, 15, 13, - $ 25, 18, 26, 19, 20, 21, 27, 28, - $ 29, 22, 23, 30, 31, 45, 46, 47, - $ 24, 32, 48/ -c -c -c --- denote stable particles according to gheisha code --- -c --- stable : gamma, neutrino, electron, proton and heavy fragments --- -c --- when stopping these particles only loose their kinetic energy --- - data ipelos/ - $ 1, 1, 0, 1, 0, 0, 0, 0, - $ 0, 0, 0, 0, 0, 1, 0, 0, - $ 0, 0, 0, 0, 0, 0, 0, 0, - $ 0, 0, 0, 0, 0, 1, 1, 1, - $ 0, 0, 1/ -c -c --- lowerbound of kinetic energy bin in n cross-section tables --- - data teklow /0.0001/ -c -c --- kinetic energy to switch from "casn" to "gnslwd" for n cascade --- - data swtekn /0.05/ -c - data ideol/0/ -c -c --- set the interaction mechanism to "hadr" --- -c -c --- init output --- - stop=0 - code=0 - nprod=0 - destep=0.0 -c -c -c 9004 continue - kpart=kipart(ipart) - kkpart=kpart -c -c --- transport the track number to gheisha and initialise some numbers - ntk=0 - intct=0.0 - next=1 - ntot=0 - int=0 - tof=0.0 -c -c --- fill result common for this track with geant values --- -c --- calim code --- - xend=0.0 - yend=0.0 - zend=0.0 - amas=rmass(kpart) - nch=rcharg(kpart) - charge=rcharg(kpart) - p=sqrt(pvec(1)**2+pvec(2)**2+pvec(3)**2) - if(p.lt.1.0e-10) then - px=0.0 - py=0.0 - pz=0.0 - stop=1 - else - px=pvec(1)/p - py=pvec(2)/p - pz=pvec(3)/p - endif !p.lt.1.0e-10) -c --- setres code --- - amasq=amas*amas - en=sqrt(amasq+p*p) - ek=abs(en-abs(amas)) - enold=en -c -c - sinl=0.0 - cosl=1.0 - sinp=0.0 - cosp=1.0 -c - if (abs(p) .le. 1.0e-10) go to 1 - sinl=pz - cosl=sqrt(abs(1.0-sinl**2)) -c - 1 continue - call grndm(rndm,1) - phi=rndm(1)*twpi - if ((px .eq. 0.0) .and. (py .eq. 0.0)) goto 3 - if (abs(px) .lt. 1.e-10) goto 2 - phi=atan2(py,px) - goto 3 -c - 2 continue - if (py .gt. 0.0) phi=pi/2.0 - if (py .le. 0.0) phi=3.0*pi/2.0 -c - 3 continue - sinp=sin(phi) - cosp=cos(phi) -c -c --- set gheisha index for the current medium always to 1 --- - ind=1 -c -c --- transfer global material constants for current medium --- -c --- detailed data for compounds is obtained via routine compo --- - atno(ind+1)=a - zno(ind+1)=z - den(ind+1)=dens - radlth(ind+1)=radl - abslth(ind+1)=absl -c -c --- setup parmat for physics steering --- - parmat(ind+1,5)=0.0 - parmat(ind+1,8)=ipfis - parmat(ind+1,9)=0.0 - parmat(ind+1,10)=0.0 - if(jtm.gt.0) then !in some media ? - jtmn=lq(jtm) - if(jtmn.ge.1) parmat(ind+1,5)=q(jtmn+26) - endif !jtm.gt.0 -c -c --- check for stopping track --- - if(stop.ne.0) then - call ghstopp(ipart,code,stop) - if(code.eq.5) go to 9999 - if(ihadr.ne.2) go to 40 - if(ipelos(kpart).eq.0) then - destep=destep+en !unstable deposit all energy - else - destep=destep+ek !stable deposit kin energy only - endif !ipelos(kpart).eq.0 - go to 9999 - endif !stop.ne.0 - stop=0 -c -c --- indicate light (<= pi) and heavy particles (historically) --- -c --- calim code --- - j=2 - test=rmass(7)-0.001 - if (abs(amas) .lt. test) j=1 -c -c *** division into various interaction channels denoted by "int" *** -c the convention for "int" is the following -c -c int = -1 reaction cross sections not yet tabulated/programmed -c = 0 no interaction -c = 1 eleastic scattering -c = 2 inelastic scattering -c = 3 nuclear fission with ineleastic scattering -c = 4 neutron capture -c -c --- intact code --- - kk=int_intrinsic(abs(q(jma+11))) !number of material components - alam1=0.0 - call grndm(rndm,1) - rat=rndm(1)*alam - atno2=a - zno2 =z -c - do 6 k=1,kk - if (kk .le. 0) go to 6 -c - if (kk .eq. 1) go to 7 - atno2=q(jmixt+k) - zno2=q(jmixt+kk+k) -c - 7 continue -c -c force selected interaction type - if(intforce.ne.0) then - int=intforce - go to 8 - endif !intforce -c -c --- try for elastic scattering --- - int=1 - code=13 - alam1=alam1+aiel(k) - if (rat .lt. alam1) go to 8 -c -c --- try for inelastic scattering --- - int=2 - code=20 - alam1=alam1+aiin(k) - if (rat .lt. alam1) go to 8 -c -c --- try for nuclear fission with inelastic scattering --- - int=3 - code=15 - alam1=alam1+aifi(k) - if (rat .lt. alam1) go to 8 -c -c --- try for neutron capture --- - int=4 - code=18 - alam1=alam1+aica(k) - if (rat .lt. alam1) go to 8 -c - 6 continue -c --- no reaction selected ==> elastic scattering --- - int=1 - code=13 -c -c *** take action according to selected reaction channel *** -c --- following code is a translation of "calim" into geant jargon --- -c - 8 continue -c -c --- in case of no interaction or unknown cross sections ==> done --- - if (int .le. 0) go to 40 -c -c --- in case of non-elastic scattering and no generation of sec. --- -c --- particles deposit total particle energy and return --- - if ((int .eq. 1) .or. (ihadr .ne. 2)) go to 9 - stop=2 - destep=destep+en - go to 9999 -c - 9 continue - if (int .ne. 4) go to 10 -c -c --- neutron capture --- - stop=1 - call captur(nopt) - go to 40 -c - 10 continue - if (int .ne. 3) go to 11 -c --- nuclear fission --- - stop=1 - tkin=fissio(ek) - int=0 - go to 40 -c -11 continue -c -c --- elastic and inelastic scattering --- - pv(1,mxgkpv)=p*px - pv(2,mxgkpv)=p*py - pv(3,mxgkpv)=p*pz - pv(4,mxgkpv)=en - pv(5,mxgkpv)=amas - pv(6,mxgkpv)=nch - pv(7,mxgkpv)=tof - pv(8,mxgkpv)=kpart - pv(9,mxgkpv)=0. - pv(10,mxgkpv)=userw -c -c --- additional parameters to simulate fermi motion and evaporation --- - do 111 jenp=1,10 - enp(jenp)=0.0 -111 continue - enp(5)=ek - enp(6)=en - enp(7)=p -c - if (int .ne. 1) go to 12 -c -c *** elastic scattering processes *** -c -c --- only nuclear interactions for heavy fragments --- - if ((kpart .ge. 30) .and. (kpart .le. 32)) go to 35 -c -c --- normal elastic scattering for light media --- - if (atno2 .lt. 1.5) go to 35 -c -c --- coherent elastic scattering for heavy media --- - call coscat - go to 40 -c -c *** non-elastic scattering processes *** - 12 continue -c -c --- only nuclear interactions for heavy fragments --- - if ((kpart .ge. 30) .and. (kpart .le. 32)) go to 35 -c -c *** use sometimes nuclear reaction routine "nucrec" for low energy *** -c *** proton and neutron scattering *** - call grndm(rndm,1) - test1=rndm(1) - test2=4.5*(ek-0.01) - if ((kpart .eq. 14) .and. (test1 .gt. test2)) go to 85 - if ((kpart .eq. 16) .and. (test1 .gt. test2)) go to 86 -c -c *** fermi motion and evaporation *** - tkin=cinema(ek) - pv(9,mxgkpv)=tkin - enp(5)=ek+tkin -c --- check for lowerbound of ekin in cross-section tables --- - if (enp(5) .le. teklow) enp(5)=teklow - enp(6)=enp(5)+abs(amas) - enp(7)=(enp(6)-amas)*(enp(6)+amas) - enp(7)=sqrt(abs(enp(7))) - tkin=fermi(enp(5)) - enp(5)=enp(5)+tkin -c --- check for lowerbound of ekin in cross-section tables --- - if (enp(5) .le. teklow) enp(5)=teklow - enp(6)=enp(5)+abs(amas) - enp(7)=(enp(6)-amas)*(enp(6)+amas) - enp(7)=sqrt(abs(enp(7))) - tkin=exnu(enp(5)) - enp(5)=enp(5)-tkin -c --- check for lowerbound of ekin in cross-section tables --- - if (enp(5) .le. teklow) enp(5)=teklow - enp(6)=enp(5)+abs(amas) - enp(7)=(enp(6)-amas)*(enp(6)+amas) - enp(7)=sqrt(abs(enp(7))) -c -c *** in case of energy above cut-off let the particle cascade *** - test=abs(charge) - if ((test .gt. 1.0e-10) .and. (enp(5) .gt. cuthad)) go to 35 - if ((test .le. 1.0e-10) .and. (enp(5) .gt. cutneu)) go to 35 -c -c --- second chance for anti-baryons due to possible annihilation --- - if ((amas .ge. 0.0) .or. (kpart .le. 14)) go to 13 - anni=1.3*p - if (anni .gt. 0.4) anni=0.4 - call grndm(rndm,1) - test=rndm(1) - if (test .gt. anni) go to 35 -c -c *** particle with energy below cut-off *** -c --- ==> only nuclear evaporation and quasi-elastic scattering --- - 13 continue -c - stop=3 -c -c - if ((kpart .ne. 14) .and. (kpart .ne. 16)) go to 14 - if (kpart .eq. 16) go to 86 -c -c --- slow proton --- - 85 continue - call nucrec(nopt,2) -c - if (nopt .ne. 0) go to 50 -c - call coscat - go to 40 -c -c --- slow neutron --- - 86 continue - nucflg=0 - call gnslwd(nucflg,int,nfl,teklow) - if (nucflg .ne. 0) go to 50 - go to 40 -c -c --- other slow particles --- - 14 continue - ipa(1)=kpart -c --- decide for proton or neutron target --- - ipa(2)=16 - call grndm(rndm,1) - test1=rndm(1) - test2=zno2/atno2 - if (test1 .lt. test2) ipa(2)=14 - avern=0.0 - nfl=1 - if (ipa(2) .eq. 16) nfl=2 - ippp=kpart - call twob(ippp,nfl,avern) - goto 40 -c -c --- initialisation of cascade quantities --- - 35 continue -c -c *** cascade generation *** -c --- calculate final state multiplicity and longitudinal and --- -c --- transverse momentum distributions --- -c -c --- fixed particle type to steer the cascade --- - kkpart=kpart -c -c --- no cascade for leptons --- - if (kkpart .le. 6) go to 9999 -c -c *** what to do with "new particles" for gheisha ?????? *** -c --- return for the time being --- - if (kkpart .ge. 35) go to 9999 -c -c --- cascade of heavy fragments - if ((kkpart .ge. 30) .and. (kkpart .le. 32)) go to 390 -c -c --- initialize the ipa array --- - call vzero(ipa(1),100) -c -c --- cascade of omega - and omega - bar --- - if (kkpart .eq. 33) go to 330 - if (kkpart .eq. 34) go to 331 -c - nvepar=kkpart-17 - if (nvepar .le. 0) go to 15 - go to (318,319,320,321,322,323,324,325,326,327,328,329),nvepar -c - 15 continue - nvepar=kkpart-6 - go to (307,308,309,310,311,312,313,314,315,316,317,318),nvepar -c -c --- pi+ cascade --- - 307 continue -c call caspip(j,int,nfl) - call caspip(int,nfl) - go to 40 -c -c --- pi0 ==> no cascade --- - 308 continue - go to 40 -c -c --- pi- cascade --- - 309 continue -c call caspim(j,int,nfl) - call caspim(int,nfl) - go to 40 -c -c --- k+ cascade --- - 310 continue - call caskp(j,int,nfl) - go to 40 -c -c --- k0 cascade --- - 311 continue - call cask0(j,int,nfl) - go to 40 -c -c --- k0 bar cascade --- - 312 continue - call cask0b(j,int,nfl) - go to 40 -c -c --- k- cascade --- - 313 continue - call caskm(j,int,nfl) - go to 40 -c -c --- proton cascade --- - 314 continue - call casp(j,int,nfl) - go to 40 -c -c --- proton bar cascade --- - 315 continue -c if (nprt(9)) print 2013 -c 2013 format(' *gheish* routine caspb will be called') - call caspb(j,int,nfl) - go to 40 -c -c --- neutron cascade --- - 316 continue - nucflg=0 - if (ek .gt. swtekn) call casn(j,int,nfl) - if (ek .le. swtekn) call gnslwd(nucflg,int,nfl,teklow) - if (nucflg .ne. 0) go to 50 - go to 40 -c -c --- neutron bar cascade --- - 317 continue - call casnb(j,int,nfl) - go to 40 -c -c --- lambda cascade --- - 318 continue - call casl0(j,int,nfl) - go to 40 -c -c --- lambda bar cascade --- - 319 continue -c if (nprt(9)) print 2018 -c 2018 format(' *gheish* routine casal0 will be called') - call casal0(j,int,nfl) - go to 40 -c -c --- sigma + cascade --- - 320 continue - call cassp(j,int,nfl) - go to 40 -c -c --- sigma 0 ==> no cascade --- - 321 continue - go to 40 -c -c --- sigma - cascade --- - 322 continue - call cassm(j,int,nfl) - go to 40 -c -c --- sigma + bar cascade --- - 323 continue - call casasp(j,int,nfl) - go to 40 -c -c --- sigma 0 bar ==> no cascade --- - 324 continue - go to 40 -c -c --- sigma - bar cascade --- - 325 continue - call casasm(j,int,nfl) - go to 40 -c -c --- xi 0 cascade --- - 326 continue - call casx0(j,int,nfl) - go to 40 -c -c --- xi - cascade --- - 327 continue - call casxm(j,int,nfl) - go to 40 -c -c --- xi 0 bar cascade --- - 328 continue - call casax0(j,int,nfl) - go to 40 -c -c --- xi - bar cascade --- - 329 continue -c if (nprt(9)) print 2026 -c 2026 format(' *gheish* routine casaxm will be called') - call casaxm(j,int,nfl) - go to 40 -c -c --- omega - cascade --- - 330 continue -c if (nprt(9)) print 2027 -c 2027 format(' *gheish* routine casom will be called') - call casom(j,int,nfl) - go to 40 -c -c --- omega - bar cascade --- - 331 continue -c if (nprt(9)) print 2028 -c 2028 format(' *gheish* routine casaom will be called') - call casaom(j,int,nfl) - go to 40 -c -c --- heavy fragment cascade --- - 390 continue - nucflg=0 - call casfrg(nucflg,int,nfl) - if (nucflg .ne. 0) go to 50 -c -c *** check whether there are new particles generated *** - 40 continue - if ((ntot .ne. 0) .or. (kkpart .ne. kpart)) go to 50 - nprod=1 - iprod(1)=ikpart(kpart) - pprod(1,1)=px*p - pprod(2,1)=py*p - pprod(3,1)=pz*p - tprod(1)=tprod(1)+tof*0.5e-10 - edep=abs(enold-en) - if(stop.eq.0) destep=destep+edep - go to 9999 -c -c *** current particle is not the same as in the beginning or/and *** -c *** one or more secondaries have been generated *** - 50 continue -c - nvedum=kipart(ipart) -c -c --- initial particle type has been changed ==> put new type on --- -c --- the geant temporary stack --- -c -c --- chose beteen ks/kl - if(kpart.eq.11.or.kpart.eq.12) then - kpart=1 - call grndm(rndm,1) - if(rndm(1).gt.0.5) kpart=12 - endif !kpart.eq.11.or.kpart.eq.12 -c -c -c --- put particle on the stack --- - nprod=1 - iprod(1)=ikpart(kpart) - pprod(1,1)=px*p - pprod(2,1)=py*p - pprod(3,1)=pz*p - tprod(1)=tprod(1)+tof*0.5e-10 -c -c -c *** check whether secondaries have been generated and copy them *** -c *** also on the geant stack *** -c 60 continue -c -c --- all quantities are taken from the gheisha stack where the --- -c --- convention is the following --- -c -c eve(index+ 1)= x -c eve(index+ 2)= y -c eve(index+ 3)= z -c eve(index+ 4)= ncal -c eve(index+ 5)= ncell -c eve(index+ 6)= mass -c eve(index+ 7)= charge -c eve(index+ 8)= tof -c eve(index+ 9)= px -c eve(index+10)= py -c eve(index+11)= pz -c eve(index+12)= type -c - if (ntot .le. 0) go to 9999 -c -c --- one or more secondaries have been generated --- - do 61 l=1,ntot - index=(l-1)*12 - jnd=int_intrinsic(eve(index+12)) -c -c --- make choice between k0 long / k0 short --- - if ((jnd .ne. 11) .and. (jnd .ne. 12)) go to 63 - call grndm(rndm,1) - jnd=int_intrinsic(11.5+rndm(1)) -c -c --- forget about neutrinos --- - 63 continue - if (jnd .eq. 2) go to 61 -c -c --- swith to geant quantities --- - ity=ikpart(jnd) - plx=eve(index+9) - ply=eve(index+10) - plz=eve(index+11) -c -c -c --- add particle to the stack if stack not yet full --- - fail=1301 - if (nprod.ge.mprod) go to 1313 - nprod=nprod+1 - iprod(nprod)=ity - pprod(1,nprod)=plx - pprod(2,nprod)=ply - pprod(3,nprod)=plz - tprod(nprod)=tprod(nprod)+eve(index+8)*0.5e-10 -c -c - 61 continue -c - 9999 continue - return -c -1313 continue - write(6,*) 'fail=',fail,' in |gheish|' - if(fail.eq.1301) then - write(6,*) 'produced particle array overflowed' - write(6,*) 'results will be truncated' - endif !fail.eq.1301 - return -c - entry gheiset(todo,arg) - value=arg - if(todo.eq.'ihadr') then - ihadr=ivalue - else if (todo.eq.'ipfis') then - ipfis=ivalue - else if(todo.eq.'cuthad') then - cuthad=value - else if(todo.eq.'cutneu') then - cutneu=value - else if(todo.eq.'intforce') then - intforce=ivalue - endif !todo.eq.'ihadr' - end -c -c The standard Fortran intrinsic "int" was hidden by the author's choice -c of "int" as the name of a variable in the above code. -c Define its surrogate here. -c - integer function int_intrinsic(realarg) - int_intrinsic = int(realarg) - end diff --git a/src/programs/Simulation/HDGeant/gelhad/ghstopp.F b/src/programs/Simulation/HDGeant/gelhad/ghstopp.F deleted file mode 100644 index 897b7b8e6e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/ghstopp.F +++ /dev/null @@ -1,119 +0,0 @@ - - SUBROUTINE GHSTOPP(IPART,CODE,ISTOP) - IMPLICIT NONE -C -C DECLARATIONS WHEN SWITCH TO IMPLICIT NONE -C - REAL*4 XEND,YEND,ZEND,RCA,RCE,AMAS - REAL*4 TOF,PX,PY,PZ,USERW,P,EN,EK,AMASQ,DELTN - INTEGER*4 ITK,NTK,KPART,IND,LCALO,ICEL - REAL*4 SINL,COSL,SINP,COSP,XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD - REAL*4 XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT,EDEP - REAL*4 GETOT,GEKIN - INTEGER*4 NOPT -C - INTEGER *4 CODE,ISTOP,IPART -C -C *** HANDLING OF STOPPING PARTICLES *** -C *** NVE 18-MAY-1988 CERN GENEVA *** -C -C CALLED BY : GHEISH -C ORIGIN : H.FESEFELDT (ROUTINE CALIM 16-SEP-1987) -C -C -C -C -C -C --- "IPART" CHANGED TO "KPART" IN COMMON /RESULT/ DUE TO CLASH --- -C --- WITH VARIABLE "IPART" IN GEANT COMMON --- -C - COMMON/RESULT/XEND,YEND,ZEND,RCA,RCE,AMAS,NCH,TOF,PX,PY,PZ, - $ USERW,INTCT,P,EN,EK,AMASQ,DELTN,ITK,NTK,KPART,IND, - $ LCALO,ICEL,SINL,COSL,SINP,COSP, - $ XOLD,YOLD,ZOLD,POLD,PXOLD,PYOLD,PZOLD, - $ XSCAT,YSCAT,ZSCAT,PSCAT,PXSCAT,PYSCAT,PZSCAT - REAL NCH,INTCT -C -C -C --- IN CASE OF ENERGY DEPOSITION ALL THE EKIN WILL BE DEPOSITED --- - EDEP=EK -C -C --- UPDATE MOMENTUM VECTOR AND ENERGIES FOR STOPPING PARTICLE --- - P=0.0 - PX=0.0 - PY=0.0 - PZ=0.0 - EN=ABS(AMAS) - EK=0.0 - GETOT=EN - GEKIN=EK - ISTOP=2 -C -C -C *** SELECT PROCESS FOR CURRENT PARTICLE *** -C -C --- SKIP EXOTIC PARTICLES --- - IF (IPART .GE. 48) GO TO 9999 -C -C --- LOOK FOR PARTICLES WITH SPECIAL TREATMENT --- - IF (IPART .EQ. 9) GO TO 90 - IF (IPART .EQ. 12) GO TO 120 - IF (IPART .EQ. 13) GO TO 130 - IF (IPART .EQ. 15) GO TO 150 - IF (IPART .EQ. 25) GO TO 250 -C -C --- ONLY DEPOSIT ALL KINETIC ENERGY FOR P AND HEAVY FRAGMENTS --- - IF (IPART .EQ. 14) GO TO 140 - IF (IPART .GE. 45) GO TO 140 -C -C --- LET ALL OTHER PARTICLES DECAY --- -COFF CALL GDECAY !Leave this to Gismo - CODE=5 - ISTOP=1 - GO TO 9999 -C -C --- PI- ABSORBED BY NUCLEUS --- - 90 CONTINUE - CALL PIMABS(NOPT) - CODE=16 - ISTOP=1 - GO TO 9999 -C -C --- K- ABSORBED BY NUCLEUS --- - 120 CONTINUE - CALL KMABS(NOPT) - CODE=16 - ISTOP=1 - GO TO 9999 -C -C --- NEUTRON CAPTURED BY NUCLEUS --- - 130 CONTINUE - IF (EDEP .GE. 1.E-9) GO TO 9999 - CALL CAPTUR(NOPT) - CODE=18 - ISTOP=1 - GO TO 9999 -C -C --- ANTI-PROTON ==> ANNIHILATION --- - 150 CONTINUE - CALL PBANH(NOPT) - CODE=17 - ISTOP=1 - GO TO 9999 -C -C --- ANTI-NEUTRON ==> ANNIHILATION --- - 250 CONTINUE - CALL NBANH(NOPT) - CODE=17 - ISTOP=1 - GO TO 9999 -C -C --- P OR HEAVY FRAGMENT ==> ONLY DEPOSIT KINETIC ENERGY --- - 140 CONTINUE - CODE=19 - ISTOP=2 -C - 9999 CONTINUE -C - RETURN - END diff --git a/src/programs/Simulation/HDGeant/gelhad/gmmate.F b/src/programs/Simulation/HDGeant/gelhad/gmmate.F deleted file mode 100644 index 38c6722e18..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gmmate.F +++ /dev/null @@ -1,14 +0,0 @@ - subroutine gmmate(mass) -c -c /geant321/ commons -c - implicit none -#include "geant321/gcmate.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcbank.inc" -c - real *4 mass,anumber - anumber=abs(q(jma+6)) - mass=anumber*0.939 - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gnbase/Flags.h b/src/programs/Simulation/HDGeant/gelhad/gnbase/Flags.h deleted file mode 100644 index 79c2bf88e7..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gnbase/Flags.h +++ /dev/null @@ -1,22 +0,0 @@ -#undef _FLUKA_ -#undef _GCALOR_ -#undef _GWEED_ -#undef _XTRA_ -#undef _DIOD_ - -#define _SINGLE_ 1 - -#define _BPIP_ 1 -#define _DCHN_ 1 -#define _DIRC_ 1 -#define _EMCA_ 1 -#define _MUON_ 1 -#define _SSVD_ 1 -#define _GELH_ 1 -#define _DIOD_ 1 - -#undef _TPCF_ -#undef _STCD_ -#undef _COMI_ -#undef _MSOB_ -#undef _TROL_ diff --git a/src/programs/Simulation/HDGeant/gelhad/gnbase/gelhad_db.inc b/src/programs/Simulation/HDGeant/gelhad/gnbase/gelhad_db.inc deleted file mode 100644 index 85121621d2..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gnbase/gelhad_db.inc +++ /dev/null @@ -1,11 +0,0 @@ -***** structure gelhad ***** - integer jphadr_gelhad ! Run: (0=default) - real ecut_gelhad ! Energy below which no interactions take place - real scale_gelhad ! Cross section scale factor (1.0=nominal) - integer mode_gelhad ! GPHAD Model control: (4=default) - real ethresh_gelhad ! GPHAD Effective pion threshold for mode=4. -* - common /gelhad_pc/ - + jphadr_gelhad,ecut_gelhad,scale_gelhad,mode_gelhad, - + ethresh_gelhad -* diff --git a/src/programs/Simulation/HDGeant/gelhad/gpgheip.F b/src/programs/Simulation/HDGeant/gelhad/gpgheip.F deleted file mode 100644 index 83948b492e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gpgheip.F +++ /dev/null @@ -1,60 +0,0 @@ - - subroutine gpgheip(idvec,ppvec,kinergy) -c -c *** compute distance to next hadronic interaction point *** -c *** this routine is an interface to gheisha8 *** -c *** nve 06-apr-1988 cern geneva *** -c -c called by : guphad (user routine) -c origin : f.carminati -c -#include "geant321/gcflag.inc" -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcmate.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcjloc.inc" -c --- gheisha commons --- -#include "gelhad/ghcdes/prntfl.inc" - real *4 ppvec,kinergy - integer *4 idvec -c -c --- initialize relevant gheisha variables at first pass --- - if (ifinit(4) .eq. 0) call gheini -c - if (z .lt. 1.0) go to 1000 -c - kk=INT(abs(q(jma+11))) - if (kk .gt. 1) go to 10 -c - sig=ghesig(ppvec,kinergy,a,a,z,1.0,1,dens,0.0,idvec) - go to 20 -c - 10 continue - qcor=0.0 - if(jtm.gt.0) then - lnve=lq(jtm) - if (lnve .gt. 0) qcor=q(lnve+26) - endif - sig=ghesig(ppvec,kinergy,a,q(jmixt+1),q(jmixt+kk+1), - $ q(jmixt+2*kk+1),kk,dens,qcor,idvec) -c - 20 continue - if (sig .le. 0.0) go to 1000 - shadr=zintha/sig - if (nprt(9)) print 2000,kk,sig,shadr - 2000 format(' *gpghei* kk,sig,shadr = ',i3,1x,2(g12.5,1x)) - go to 9999 -c -c --- ensure no interaction in current medium --- -c - 1000 continue - shadr=big - if (nprt(9)) print 2001,kk,sig,shadr - 2001 format(' *gpghei* === no interaction in current medium ==='/ - $ ' kk,sig,shadr = ',i3,1x,2(g12.5,1x)) -c - 9999 continue - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gphad.F b/src/programs/Simulation/HDGeant/gelhad/gphad.F deleted file mode 100644 index 09d1326b84..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gphad.F +++ /dev/null @@ -1,574 +0,0 @@ -c Tue Oct 11 11:32:47 PDT 1994 -c user special version of /gheish/ ... /gheishp/ to -c avoid interfering with particle types -c -c Mon Oct 3 16:35:06 PDT 1994 -c /geant321/ version of /gelhad/. A. Snyder -c -c Mon Dec 11 15:52:37 PST 1995 -c add flag to indicate |gphad| has been invoked - -c Fri Jan 19 16:37:11 PST 1996 -c Add count of interactions per event -c Set the name of the mechanism (only have a list of 30 to choose between) -c F. Kral -c -c Mon Mar 3 10:07:47 PST 1997 -c Add momentum conserving models 5, 6 and 7 -c A. Snyder -c -c Mon Mar 17 10:57:46 PST 1997 -c Add vector dominance model 8 -c A. Snyder -c -c Wed Apr 9 10:27:54 PDT 1997 -c add quasi-deutron model 9 -c A. Snyder -c -c Fri Mar 12 15:31:37 PST 1999 -c Fix A=0 problem by not letting mixtures that contain hydrogen interact -c - -c - subroutine gphad(mode,ethresh) - implicit none - save -c -c /geant321/ commons -c -#include "geant321/gcmate.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcunit.inc" -#include "gelhad/gelhadused.inc" -c -c declarations when switch to implicit none -c - real ethresh - integer i - logical ok - logical goth -C -c -c /gelhad/ variables - integer *4 mode !/gelhad/ model - integer *4 fail !failure code - logical interact/.true./ - integer *4 alias !gamma's alias - real *4 temp(10) !work space - real *4 mpi !pi mass when needed - real *4 ppipl(3) !pi plus 3-mom - real *4 mompl !momenutum - real *4 kinpl !kinetic energy - integer *4 ipiplus !geant code - real *4 ppimn(3) !pi minus 3-mom - real *4 mommn !mometum - real *4 kinmn !kinetic energy - integer *4 ipimins !geant code - real *4 piplint/0.5/ !pi plus interaction prob. - real *4 pimnint/0.5/ !pi minus interaction prob. - integer *4 iprot !proton code - integer *4 ineut !neutron code - real *4 mn !neutron mass - real *4 mp !proton mass - real *4 pn(3) !mom neutron from quasi deutron decay - real *4 pp(3) !mom proton from quasi deutron decay - real *4 ed !quasi-deuteron energy - real *4 pd !quasi-deuteron momentum - real *4 momn !mom neut - real *4 momp !mom prot - real *4 kinn !kinetic energy neut - real *4 kinp !kinetic energy prot - real *4 pnint/0.5/ !neutron interaction prob. - real *4 ppint/0.5/ !proton interaction prob. - real *4 kinergy !kinetic energy - real *4 test !accept/reject test number - integer *4 ntemp !words used in work space - character *20 name - integer *4 type - real *4 mass,qchrg,lifetime !particle properties - real *4 mtarget !target mass - real *4 mrecoil !recoil mass - real *4 precoil !lab momentum of recoil nucleon -c - integer *4 mprod - parameter (mprod=100) - integer *4 nprod - integer *4 iprod(mprod) - real *4 tprod(mprod) - real *4 pprod(3,mprod) -c - integer *4 ncall/0/ -c - ncall=ncall+1 -c -c set mechanism - KCASE = NAMEC(12) ! Hadronic mechanism (generic name) -c - fail=1301 - gelhadused=.true. - ngelhperev=ngelhperev + 1 - nprod=0 - if(.not.interact) return !off ? - call gelrndmset(1) !set to use |geant| random numbers -c - if(mode.eq.0) go to 1 - if(mode.eq.2) go to 2 - if(mode.eq.4) then - if(getot.lt.ethresh) go to 1 - test=(1.0-ethresh/getot)**0.5 - call grndm(temp,1) - if(temp(1).gt.test) go to 1 - go to 2 - endif !mode.eq.4 - if(mode.eq.5) go to 5 - if(mode.eq.6) go to 6 - if(mode.eq.7) then - if(getot.lt.ethresh) go to 5 - test=(1.0-ethresh/getot)**0.5 - call grndm(temp,1) - if(temp(1).gt.test) go to 5 - go to 6 - endif - if(mode.eq.8) go to 8 - if(mode.eq.9) go to 9 - if(mode.eq.10) then - if(getot.lt.ethresh) go to 9 - test=(1.0-ethresh/getot)**0.5 - call grndm(temp,1) - if(temp(1).gt.test) go to 9 - go to 8 - endif - go to 1313 -c -1 continue !g->N model -c -c select proton or neutron - call grndm(temp(1),1) - alias=13 !neutron - if(temp(1).gt.(a-z)/a) alias=14 !proton - ntemp=10 - call gfpart(alias,name,type,mass,qchrg,lifetime,temp,ntemp) -c -c conserve energy and charge and all /gheish/ - kinergy=getot - getot=getot+mass - temp(7)=sqrt(getot**2-mass**2) - call gelpcalc(temp(7),vect(4),temp) - call gamate(1.0,1.0,goth) - if(goth) then -* call gelfill(alias,vect,mprod,nprod,iprod,tprod,pprod) - call gelfill(alias,temp,mprod,nprod,iprod,tprod,pprod) - go to 99 - endif -c - call grmate(1.0,qchrg) !remove nuc - call gpgheip(alias,temp(7),kinergy) - call gheishp(alias,temp,mprod,nprod,iprod,tprod,pprod) - call grmate(-1.0,-qchrg) !put nuc back -c -c - go to 99 -c -2 continue !g->pi model -c -c pick pi+ or pi0 - call grndm(temp(1),1) - alias=8 !pi+ - if(temp(1).gt.z/a) alias=9 !pi- - ntemp=10 - call gfpart(alias,name,type,mass,qchrg,lifetime,temp,ntemp) -c -c -c conserve energy and charge and call /gheish/ - temp(1)=getot-mass - if(temp(1).lt.0.0) return !below threshold ? - kinergy=temp(1) - temp(7)=sqrt(getot**2-mass**2) - call caspimset('SET:NFLFORCE',1) - call caspipset('SET:NFLFORCE',2) - temp(7)=sqrt(getot**2-mass**2) - call gelpcalc(temp(7),vect(4),temp) - call grmate(0.0,qchrg) - call gpgheip(alias,temp(7),kinergy) - call gheishp(alias,temp,mprod,nprod,iprod,tprod,pprod) - call grmate(0.0,-qchrg) - call caspimset('SET:NFLFORCE',0) - call caspipset('SET:NFLFORCE',0) -c - go to 99 -c - 5 continue !g->N model with energy and momentum conservation -c -c select proton or neutron - call grndm(temp(1),1) - alias=13 !neutron - if(temp(1).gt.(a-z)/a) alias=14 !proton - ntemp=10 - call gfpart(alias,name,type,mass,qchrg,lifetime,temp,ntemp) -c -c conserve energy and charge and all /gheish/ - call gmmate(mtarget) - - call gamate(1.0,1.0,goth) - if(goth) then -* call gelfill(alias,vect,mprod,nprod,iprod,tprod,pprod) - call gelpcalc(vect(7),vect(4),temp) - call gelfill(alias,temp,mprod,nprod,iprod,tprod,pprod) - go to 99 - endif - - call grmate(1.0,qchrg) !remove nuc - call gmmate(mrecoil) - call recoilframe(getot,mass,mtarget,mrecoil,temp(7),precoil,ok) - if(.not.ok) go to 99 - kinergy=sqrt(temp(7)**2+mass**2)-mass - call gelpcalc(temp(7),vect(4),temp) - call gpgheip(alias,temp(7),kinergy) - call gheishp(alias,temp,mprod,nprod,iprod,tprod,pprod) - call labframe(vect(4),mrecoil,precoil,nprod,pprod,iprod) - call grmate(-1.0,-qchrg) !put nuc back -c - go to 99 -c -c - -c - 6 continue !g->pi model with energy and momentum conservation -c -c pick pi+ or pi0 - call grndm(temp(1),1) - alias=8 !pi+ - if(temp(1).gt.z/a) alias=9 !pi- - ntemp=10 - call gfpart(alias,name,type,mass,qchrg,lifetime,temp,ntemp) -c -c -c conserve energy and charge and call /gheish/ - temp(1)=getot-mass - if(temp(1).lt.0.0) return !below threshold ? - call caspimset('SET:NFLFORCE',1) - call caspipset('SET:NFLFORCE',2) - call gmmate(mtarget) - call grmate(0.0,qchrg) - call gmmate(mrecoil) - call recoilframe(getot,mass,mtarget,mrecoil,temp(7),precoil,ok) - if(.not.ok) go to 99 - call gelpcalc(temp(7),vect(4),temp) - kinergy=sqrt(temp(7)**2+mass**2)-mass - call gpgheip(alias,temp(7),kinergy) - call gheishp(alias,temp,mprod,nprod,iprod,tprod,pprod) - call labframe(vect(4),mrecoil,precoil,nprod,pprod,iprod) - call grmate(0.0,-qchrg) - call caspimset('SET:NFLFORCE',0) - call caspipset('SET:NFLFORCE',0) -c - go to 99 -c - 8 continue !vector dominance -c -c g->rho .. vector dominance model - ipiplus=8 - ipimins=9 - call gfpart(ipiplus,name,type,mpi,qchrg,lifetime,temp,ntemp) - temp(1)=getot-2.0*mpi - if(temp(1).lt.0.0) return !below threshold ? - call gelrhom(getot,mpi,mass) - call gmmate(mtarget) - mrecoil=mtarget - call recoilframe(getot,mass,mtarget,mrecoil,temp(7),precoil,ok) - if(.not.ok) go to 99 - call gelpcalc(temp(7),vect(4),temp) - call gelrhodk(temp,mass,mpi,ppipl,ppimn) - call grndm(temp(1),3) - if(temp(1).lt.0.5) then - if(temp(1).lt.piplint) then !pi+ interacts - mompl=sqrt(ppipl(1)**2+ppipl(2)**2+ppipl(3)**2) - kinpl=sqrt(mompl**2+mpi**2)-mpi - call gpgheip(ipiplus,mompl,kinpl) - call gheishp(ipiplus,ppipl,mprod,nprod,iprod,tprod,pprod) - else - call gelfill(ipiplus,ppipl,mprod,nprod,iprod,tprod,pprod) - endif !(temp(1).lt.piplint) - call gelfill(ipimins,ppimn,mprod,nprod,iprod,tprod,pprod) - else - if(temp(2).lt.pimnint) then !pi- interacts - mommn=sqrt(ppimn(1)**2+ppimn(2)**2+ppimn(3)**2) - kinmn=sqrt(mommn**2+mpi**2)-mpi - i=nprod+1 - ntemp=0 - call gpgheip(ipimins,mommn,kinmn) - call gheishp - . (ipimins,ppimn,mprod,ntemp,iprod(i),tprod(i),pprod(1,i)) - nprod=nprod+ntemp - else - call gelfill(ipimins,ppimn,mprod,nprod,iprod,tprod,pprod) - endif !(temp(2).lt.pimnint) - call gelfill(ipiplus,ppipl,mprod,nprod,iprod,tprod,pprod) - endif !temp(3).lt.0.5 - call labframe(vect(4),mrecoil,precoil,nprod,pprod,iprod) -c - go to 99 -c - 9 continue !quasi-deutron model; g->D -c - iprot=14 - ineut=13 - ntemp=10 - call gfpart(ineut,name,type,mn,qchrg,lifetime,temp,ntemp) - call gfpart(iprot,name,type,mp,qchrg,lifetime,temp,ntemp) - ed=mp+mn+getot - pd=getot - mass=sqrt(ed**2-pd**2) -c - call gmmate(mtarget) - - call gamate(1.0,2.0,goth) - if(goth) then -* call gelfill(iprot,vect,mprod,nprod,iprod,tprod,pprod) -* call gelfill(ineut,vect,mprod,nprod,iprod,tprod,pprod) - call gelpcalc(vect(7),vect(4),temp) - call gelfill(iprot,temp,mprod,nprod,iprod,tprod,pprod) - call gelfill(ineut,temp,mprod,nprod,iprod,tprod,pprod) - go to 99 - endif - - call grmate(2.0,1.0) !remove a deutron from target material - call gmmate(mrecoil) -c - call gelpcalc(pd,vect(4),temp) - call geldeutdk(temp,mass,mn,mp,pn,pp) -c - call grndm(temp,3) - if(temp(3).lt.0.5) then - if(temp(1).lt.pnint) then !neutron interacts - momn=sqrt(pn(1)**2+pn(2)**2+pn(3)**2) - kinn=sqrt(momn**2+mn**2)-mn - call gpgheip(ineut,momn,kinn) - call gheishp - . (ineut,pn,mprod,nprod,iprod,tprod,pprod) - else -c call call gelfill(ineut,pn,mprod,nprod,iprod,tprod,pprod) - call gelfill(ineut,pn,mprod,nprod,iprod,tprod,pprod) - endif -c call call gelfill(iprot,pp,mprod,nprod,iprod,tprod,pprod) - call gelfill(iprot,pp,mprod,nprod,iprod,tprod,pprod) - else - if(temp(2).lt.ppint) then !proton interacts - momp=sqrt(pp(1)**2+pp(2)**2+pp(3)**2) - kinp=sqrt(momp**2+mp**2)-mp - i=nprod+1 - ntemp=0 - call gheishp - . (iprot,pp,mprod,ntemp,iprod(i),tprod(i),pprod(1,i)) - nprod=nprod+ntemp - else - call gelfill(iprot,pp,mprod,nprod,iprod,tprod,pprod) - endif - call gelfill(ineut,pn,mprod,nprod,iprod,tprod,pprod) - endif !temp(3).lt.0.5 - call grmate(-2.0,-1.0) !put target material back to normal -c - go to 99 -c -1313 continue - write(chmail,*) 'fail=',fail,'in /gelhad/' - return -c -99 continue -c -c copy to /gckine/ stack - do 1000 i=1,nprod - ngkine=ngkine+1 - gkin(1,ngkine)=pprod(1,i) - gkin(2,ngkine)=pprod(2,i) - gkin(3,ngkine)=pprod(3,i) - gkin(5,ngkine)=iprod(i) - tofd(ngkine)=tofg+tprod(i) - ntemp=10 - call gfpart(iprod(i),name,type,mass,qchrg,lifetime,temp,ntemp) - temp(1)=mass**2+pprod(1,i)**2+pprod(2,i)**2+pprod(3,i)**2 - gkin(4,ngkine)=sqrt(temp(1)) - gpos(1,ngkine)=vect(1) - gpos(2,ngkine)=vect(2) - gpos(3,ngkine)=vect(3) -1000 continue -c - istop=1 !end the gamma - return -c - end -c - subroutine gelfill(ipart,pmom,mp,np,id,t,p) - implicit none - integer *4 ipart - real *4 pmom(3) - integer *4 mp - integer *4 np - integer *4 id(mp) - real *4 t(mp) - real *4 p(3,mp) -c - if(np.lt.mp) then - np=np+1 - id(np)=ipart - p(1,np)=pmom(1) - p(2,np)=pmom(2) - p(3,np)=pmom(3) - t(np)=0.0 - else -c - write(6,*) - . 'gelfill: |prod| array full; particle list truncated' -c - endif -c - return - end -c - subroutine gelpcalc(mom,u,p) - implicit none - real *4 mom !momentum - real *4 u(3) !unit vector - real *4 p(3) !momentum vector - p(1)=u(1)*mom - p(2)=u(2)*mom - p(3)=u(3)*mom - return - end -c - subroutine geldeutdk(pd,md,mn,mp,pn,pp) - implicit none - real *4 md,mn,mp - real *4 pd(3),pn(3),pp(3) - real *4 kd(5),kn(5),kp(5) -c -c ang distribution parms - real *4 a/1.0/ - real *4 b/-1.0/ -c - kd(1)=pd(1) - kd(2)=pd(2) - kd(3)=pd(3) - kd(4)=sqrt(kd(1)**2+kd(2)**2+kd(3)**2+md**2) - kd(5)=md - kn(5)=mn - kp(5)=mp - call geltwobdo('set:a',a) - call geltwobdo('set:b',b) - call geltwob(kd,kn,kp) - pn(1)=kn(1) - pn(2)=kn(2) - pn(3)=kn(3) - pp(1)=kp(1) - pp(2)=kp(2) - pp(3)=kp(3) -c - return - end -c - subroutine gelrhodk(prho,mrho,mpi,ppl,pmn) - implicit none - real *4 prho(3) !rho mom vec - real *4 mrho !rho mass - real *4 mpi !pi mass - real *4 ppl(3) !pi+ mom vec - real *4 pmn(3) !pi- mom vec -c -c ang distribution parms - real *4 a/1.0/ - real *4 b/-1.0/ - real *4 krho(5),kpipl(5),kpimn(5) - krho(1)=prho(1) - krho(2)=prho(2) - krho(3)=prho(3) - krho(4)=sqrt(krho(1)**2+krho(2)**2+krho(3)**2+mrho**2) - krho(5)=mrho - kpipl(5)=mpi - kpimn(5)=mpi - call geltwobdo('set:a',a) - call geltwobdo('set:b',b) - call geltwob(krho,kpipl,kpimn) - ppl(1)=kpipl(1) - ppl(2)=kpipl(2) - ppl(3)=kpipl(3) - pmn(1)=kpimn(1) - pmn(2)=kpimn(2) - pmn(3)=kpimn(3) - return - end -c - subroutine gelrhom(energy,mpi,mrho) - implicit none - real *4 energy !available energy - real *4 mpi !pi mass - real *4 mrho !rho mass picked - real *4 gamma/0.1512/ !width of rho - real *4 mrho0/0.7699/ !central mass value - real *4 temp(2),max,test - call gelbw(mrho0,mrho0,gamma,max) - if(energy.lt.mrho0) call gelbw(energy,mrho0,gamma,max) - 1000 continue - call gelrndm(temp,2) - mrho=2.0*mpi+(energy-2.0*mpi)*temp(1) - call gelbw(mrho,mrho0,gamma,test) - test=test/max - if(temp(2).lt.test) go to 1099 - go to 1000 - 1099 continue - return - end -c - subroutine gelbw(e,e0,width,value) - implicit none - real *4 e,e0,width,value - real *4 widthsq,de,desq - integer *4 mode/0/ - character *(*) command - integer *4 val - de=e-e0 - if(mode.eq.0) then - widthsq=width**2 - desq=de**2 - value=widthsq/(desq+widthsq/4.0) - else - write(6,*) 'gelpw: undefined BW model=',mode - endif !mode.eq.0 - return -c - entry gelbwset(command,val) - if(command.eq.'set:mode') then - mode=val - endif - return -c - end -c - subroutine gelrndm(a,n) !select random generator - implicit none - save - real *4 a(*) !array of random numbers - integer *4 n !number of random numbers wanted - integer *4 mode/1/ !=1=>use |grndm| 2=>use |begran| - real *4 begran !|beget| random number generator - integer *4 newmode !new mode to be set - integer *4 i !dummy index - if(mode.eq.1) then - call grndm(a,n) - else if(mode.eq.2) then - do 1000 i=1,n - a(i)=begran() - 1000 continue - else - write(6,*) 'gelrndm: mode=',mode,' undefined mode' - endif !mode.eq.1 - return -c - entry gelrndmset(newmode) - mode=newmode - return -c - end diff --git a/src/programs/Simulation/HDGeant/gelhad/gpsig.F b/src/programs/Simulation/HDGeant/gelhad/gpsig.F deleted file mode 100644 index 8b3f2e9878..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gpsig.F +++ /dev/null @@ -1,51 +0,0 @@ -c Mon Oct 3 16:35:06 PDT 1994 -c routine to compute photo-production xsection. A. Snyder -c Tue Nov 28 10:10:58 PST 1995 -c modified to use improved xsection routine |sigmag.F| -c Wed Jan 24 16:34:07 PST 1996 -c modified to handle 0 xsections. A. Snyder -c - subroutine gpsig(sigma) - implicit none -c -c /geant321/ commons -#include "geant321/gcbank.inc" -#include "geant321/gcmate.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gctrak.inc" -C -c /gelsig/ variables - real *4 sigma - real *4 temp !working space - integer *4 nmix !number of components in current material - real *4 amix !A of mixture component - real *4 zmix !Z of mixture component - real *4 wmix !weight of mixture component - integer *4 i !dummy index -c - nmix=INT(abs(q(jma+11))) - if(nmix.eq.1) then !not a mixture ? -c - call sigmag(a,z,getot,sigma) - if(sigma.eq.0.0) return - sigma=sigma*1000.0 !mb->mub - sigma=sigma*6.022e-07*dens/a !convert to cm**-1 -c - else !a mixture -c - sigma=0.0 - do 1000 i=1,nmix !loop over components of mixture - amix=q(jmixt+i) - zmix=q(jmixt+1*nmix+i) - call sigmag(amix,zmix,getot,temp) - temp=temp*1000.0 !mb->mub - wmix=q(jmixt+2*nmix+i) - sigma=sigma+temp*wmix -1000 continue - if(sigma.eq.0.0) return - sigma=sigma*6.022e-07*dens/a !convert to cm**-1 -c - endif !nmix.eq.1 -c - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/grmate.F b/src/programs/Simulation/HDGeant/gelhad/grmate.F deleted file mode 100644 index 98ec88e83e..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/grmate.F +++ /dev/null @@ -1,41 +0,0 @@ -c Tue Oct 4 10:35:00 PDT 1994 -c subtract /da/ and /dz/ from /a/ and /a/ for material /material/ -c A. Snyder -c - subroutine grmate(da,dz) -c -c /geant321/ commons -c - implicit none -#include "geant321/gcmate.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcbank.inc" -C -C -c -c /grmate/ variables -c - real *4 da !amount to reduce /a/ - real *4 dz !amount to reduce /z/ - integer *4 nmix !number of mixtures - integer *4 i !loop index -c - q(jma+6)=q(jma+6)-da*sign(1.0,q(jma+6)) - q(jma+7)=q(jma+7)-dz*sign(1.0,q(jma+7)) - a=abs(q(jma+6)) - z=abs(q(jma+7)) -c - nmix=INT(abs(q(jma+11))) - if(nmix.le.1) return !pure ? - do 1000 i=1,nmix - q(jmixt+i)=q(jmixt+i)-da*sign(1.0,q(jmixt+i)) - q(jmixt+nmix+i)=q(jmixt+nmix+i)-dz*sign(1.0,q(jmixt+nmix+i)) -1000 continue -c - return - end - - - - - diff --git a/src/programs/Simulation/HDGeant/gelhad/gtgama.F b/src/programs/Simulation/HDGeant/gelhad/gtgama.F deleted file mode 100644 index 5175496b43..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/gtgama.F +++ /dev/null @@ -1,485 +0,0 @@ -c mon oct 3 16:35:06 pdt 1994 -c version implementing hadronic interactions via |gelhad|. -c a. snyder -c -c Mon Oct 30 17:38:39 PST 1995 -c modifications of my version of |gtgama| for use as -c "stanadard" part of |bbsim|. Note: i've not started from -c the geant version 3.21 code, but i've looked carefully and -c the code i use seems identical apart from the |gelhad| -c hooks. -c A. Snyder -c -c Thu Jan 18 11:23:06 PST 1996 -c - Change from FFREAD based to dbin based control. -c Any FFREAD values get overwritten by dbin if bbgeom_read is called. -c Thus overwriting dbin data is now the default operation in bbsim. -c Add verify step to print values (leave behind a check on common blocks). -c - Change to implicit none found some mis-spellings and a bug with epcut. -c Art Snyder fixed the bugs (|epcut| and |one| not being defined) by -c looking at geant321.car version. -c F. Kral -c -c Fri Jan 19 17:08:03 PST 1996 -c - Change to process/mechanism name LMECGELH which is not taken by others. -c F. Kral -c -c Wed Jan 24 16:34:07 PST 1996 -c - Change to protect against interaction in vaccuum -c A. Snyder -c -*cmz : 05/08/94 13.55.57 by unknown -*-- author :a - subroutine gtgama -c. -c. ****************************************************************** -c. * * -c. * photon track. computes step size and propagates particle * -c. * through step. * -c. * * -c. * ==>called by : gtrack * -c. * authors r.brun, f.bruyant l.urban ******** * -c. * * -c. ****************************************************************** -c. - implicit none -#include "gelhad/gelhadused.inc" -#include "gnbase/gelhad_db.inc" -#include "geant321/gcbank.inc" -#include "geant321/gccuts.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctmed.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gctrak.inc" -#if _debug_ -#include "geant321/gcunit.inc" -#endif - real epsmac -#if ! _singl_ -c double precison - parameter (epsmac=1.e-6) - double precision one,xcoef1,xcoef2,xcoef3,zero - parameter (one=1.0D0,zero=0.0D0) -#endif -#if _singl_ -c single precision - parameter (epsmac=1.e-11) - real *4 one,xcoef1,xcoef2,xcoef3,zero - parameter (one=1.0,zero=0.0) -#endif - real *4 epcut - parameter (epcut=1.022e-3) - -c -c hadronic interaction variables - defaults here apply when -c call to |gtgamaff| entry is not activivated. Note that -c since |jphadr| default is 0, it is not possible to enable -c |gelhad| unless |_GELH_| flag has been defined in |Flags.h|. -c -c Kral - do not set default values here since expected to crash on AIX. -c - still can relatively safely assume that jphadr wakes up equal to 0. - integer *4 jphadr !hadronic interaction on/off switch -c !any non-zero turns it one; - real *4 ecutphadr !min energy for hadronic interactions - real *4 scale !scale factor for xsections - integer *4 mode_gphad !mode for /gphad/ - real *4 ethresh_gphad !ethresh for /gphad/ -c integer *4 jphadr/0/ !hadronic interaction on/off switch -cc !any non-zero turns it one; -c real *4 ecutphadr/0.500/ !min energy for hadronic interactions -c real *4 scale/1.0/ !scale factor for xsections -c integer *4 mode_gphad/4/ !mode for /gphad/ -c real *4 ethresh_gphad/0.150/ !ethresh for /gphad/ -c real *4 sigma !inverse interaction lengths (cm**-1) -c real *4 stephadr !step to next hadronic interaction - real *4 sigma !inverse interaction lengths (cm**-1) - real *4 stephadr !step to next hadronic interaction -c -c force order of parameters for /ffkey/ - integer *4 iparameters(5) -C you cannot mix SAVE and COMMON for iparameters - rgj 96/1/28 -C save iparameters - equivalence(iparameters(1),jphadr) - equivalence(iparameters(2),ecutphadr) - equivalence(iparameters(3),scale) - equivalence(iparameters(4),mode_gphad) - equivalence(iparameters(5),ethresh_gphad) -c -c backwards compatibility -- ffread to dbin - equivalence (iparameters(1),jphadr_gelhad) -c - real *4 temp(10) !work space -c -c setup for command - integer *4 idumm - integer *4 ival - real *4 fval - equivalence(ival,fval) - character *(*) action -c -c declarations needed after switched to implicit none -c - integer iproc - real gekrt1 - integer ist - integer jst - integer i - real vectmp - integer i1 - real stopmx -c -c first call -c -c logical epcutfirst/.true./ -c save epcutfirst -c -c for gtgamavrfydeb -c - logical vrfyprint/.true./ - save vrfyprint - logical vrfyinit/.false./ - save vrfyinit -c. -c. ------------------------------------------------------------------ -* -* -* -* *** particle below energy threshold ? short circuit -* -* - if (gekin.le.cutgam) goto 998 -* -* *** update local pointers if medium has changed -* - if(iupd.eq.0)then - iupd = 1 - jphot = lq(jma-6) - jcomp = lq(jma-8) - jpair = lq(jma-10) - jpfis = lq(jma-12) - jrayl = lq(jma-13) - endif -* -* *** compute current step size -* - iproc = 103 - step = stemax - gekrt1 = 1 .-gekrat -* -* ** step limitation due to pair production ? -* -* -c if (epcutfirst) then -c epcutfirst = .false. -c write (6, *) 'GTGAMA: epcut = ', epcut -c endif - if (getot.gt.epcut) then - if (ipair.gt.0) then - steppa = gekrt1*q(jpair+iekbin) +gekrat*q(jpair+iekbin+1) - spair = steppa*zintpa - if (spair.lt.step) then - step = spair - iproc = 6 - endif - endif - endif -* -* ** step limitation due to compton scattering ? -* - if (icomp.gt.0) then - stepco = gekrt1*q(jcomp+iekbin) +gekrat*q(jcomp+iekbin+1) - scomp = stepco*zintco - if (scomp.lt.step) then - step = scomp - iproc = 7 - endif - endif -* -* ** step limitation due to photo-electric effect ? -* - if (gekin.lt.0.4) then - if (iphot.gt.0) then - stepph = gekrt1*q(jphot+iekbin) +gekrat*q(jphot+iekbin+1) - sphot = stepph*zintph - if (sphot.lt.step) then - step = sphot - iproc = 8 - endif - endif - endif -* -* ** step limitation due to photo-fission ? -* - if (jpfis.gt.0) then - steppf = gekrt1*q(jpfis+iekbin) +gekrat*q(jpfis+iekbin+1) - spfis = steppf*zintpf - if (spfis.lt.step) then - step = spfis - iproc = 23 - endif - endif -* -* ** step limitation due to hadronic interactions ? -* -* THIS IS GELHAD STUFF - if (jphadr.gt.0) then - if(getot.ge.ecutphadr) then !enough energy to bother with ? - call gpsig(sigma) - if(sigma.gt.0.0) then !not in vaccuum ? - sigma=sigma*scale - call grndm(temp,1) - stephadr=-alog(temp(1))/sigma - if(stephadr.lt.step) then - step=stephadr - iproc=lmecgelh - endif !stephadr.lt.step - endif !sigma.gt.0.0 - endif !getot.gt.ecutphadr - endif !jphadr.gt.0 -* -* ** step limitation due to rayleigh scattering ? -* - if (irayl.gt.0) then - if (gekin.lt.0.01) then - stepra = gekrt1*q(jrayl+iekbin) +gekrat*q(jrayl+iekbin+1) - srayl = stepra*zintra - if (srayl.lt.step) then - step = srayl - iproc = 25 - endif - endif - endif -* - if (step.lt.0.) step = 0. -* -* ** step limitation due to geometry ? -* - if (step.ge.safety) then - call gtnext - if (ignext.ne.0) then - step = snext + prec - inwvol= 2 - iproc = 0 - nmec = 1 - lmec(1)=1 - endif -* -* update safety in stack companions, if any - if (iq(jstak+3).ne.0) then - do 10 ist = iq(jstak+3),iq(jstak+1) - jst = jstak +3 +(ist-1)*nwstak - q(jst+11) = safety - 10 continue - iq(jstak+3) = 0 - endif -* - else - iq(jstak+3) = 0 - endif -* -* *** linear transport -* - if (inwvol.eq.2) then - do 20 i = 1,3 - vectmp = vect(i) +step*vect(i+3) - if(vectmp.eq.vect(i)) then -* -* *** correct for machine precision -* - if(vect(i+3).ne.0.) then - vectmp = vect(i)+abs(vect(i))*sign(1.,vect(i+3))* - + epsmac - if(nmec.gt.0) then - if(lmec(nmec).eq.104) nmec=nmec-1 - endif - nmec=nmec+1 - lmec(nmec)=104 -#if _debug_ - write(chmail, 10000) - call gmail(0,0) - write(chmail, 10100) gekin, numed, step, snext - call gmail(0,0) -10000 format(' boundary correction in GTGAMA: ', - + ' GEKIN NUMED STEP SNEXT') -10100 format(31x,e10.3,1x,i10,1x,e10.3,1x,e10.3,1x) -#endif - endif - endif - vect(i) = vectmp - 20 continue - else - do 30 i = 1,3 - vect(i) = vect(i) +step*vect(i+3) - 30 continue - endif -* - sleng = sleng +step -* -* *** update time of flight -* - tofg = REAL(tofg +step/clight) -* -* *** update interaction probabilities -* - if (getot.gt.epcut) then - if (ipair.gt.0) zintpa = zintpa -step/steppa - endif - if (icomp.gt.0) zintco = zintco -step/stepco - if (gekin.lt.0.4) then - if (iphot.gt.0) zintph = zintph -step/stepph - endif - if (jpfis.gt.0) zintpf = zintpf -step/steppf - if (irayl.gt.0) then - if (gekin.lt.0.01) zintra = zintra -step/stepra - endif -* - if (iproc.eq.0) go to 999 - nmec = 1 - lmec(1) = iproc -* -* ** pair production ? -* - if (iproc.eq.6) then - call gpairg -* -* ** compton scattering ? -* - else if (iproc.eq.7) then - call gcomp -* -* ** photo-electric effect ? -* - else if (iproc.eq.8) then -* calculate range of the photoelectron ( with kin. energy ephot) -* - if(gekin.le.0.001) then - jcoef = lq(jma-17) - if(gekrat.lt.0.7) then - i1 = max(iekbin-1,1) - else - i1 = min(iekbin,nekbin-1) - endif - i1 = 3*(i1-1)+1 - xcoef1 = q(jcoef+i1) - xcoef2 = q(jcoef+i1+1) - xcoef3 = q(jcoef+i1+2) - if(xcoef1.ne.0.) then - stopmx = REAL(-xcoef2+sign(one,xcoef1)*sqrt(xcoef2**2 - + - (xcoef3-gekin/xcoef1))) - else - stopmx = REAL(- (xcoef3-gekin)/xcoef2) - endif -* -* do not call gphot if this (overestimated) range is smaller -* than safety -* - if (stopmx.le.safety) goto 998 - endif - - call gphot -* -* ** rayleigh effect ? -* - else if (iproc.eq.25) then - call grayl -* -* ** photo-fission ? -* - else if (iproc.eq.23) then - call gpfis -* -* ** electro-production ? -* -* AGAIN THIS IS GELHAD STUFF - else if(iproc.eq.lmecgelh) then - call gphad(mode_gphad,ethresh_gphad) -* - endif -* - goto 999 -998 destep = gekin - gekin = 0. - getot = 0. - vect(7)= 0. - istop = 2 - nmec = 1 - lmec(1)= 30 -999 continue - return -c - entry gtgamaff !read parameters from cards -c - call ffkey('GELH',iparameters,5,'MIXED') -c -c set defaults - jphadr=0 - ecutphadr=0.500 ! original version had this mis-spelled - scale=1.0 - mode_gphad=4 - ethresh_gphad=0.150 -c -c also start things off with use flag set false. - gelhadused=.false. -c - return -c - entry gtgamac(action,idumm) !control programs behavior -c - if(len(action).le.4) return - if(action(1:3).eq.'put') then - ival=idumm - endif !action(1:3).eq.'put' - if(action.eq.'get:jphadr') then - ival=jphadr - else if(action.eq.'put:jphadr') then - jphadr=ival - else if(action.eq.'get:ecutphadr') then - fval=ecutphadr - else if(action.eq.'put:ecutphadr') then - ecutphadr=fval ! original version had this mis-spelled - else if(action.eq.'get:scale') then - fval=scale - else if(action.eq.'put:scale') then - scale=fval - else if(action.eq.'get:mode_gphad') then - ival=mode_gphad - else if(action.eq.'put:mode_gphad') then - mode_gphad=ival - else if(action.eq.'get:ethresh_gphad') then - fval=ethresh_gphad - else if(action.eq.'put:ethresh_gphad') then - ethresh_gphad=fval - endif !action.eq.'get:jphadr' - if(action(1:3).eq.'get') then - idumm=ival - endif !action(1:3).eq.'get' - - -c - return -c - entry gtgamavrfydeb ! verify parameters from database/ffread cards -c -c Kral 1/18/95 - Use this when the db common block is NOT used (old way). -c - if (.not. vrfyprint) return - if (.not. vrfyinit) then - vrfyinit = .true. - if (jphadr .ne. 0) then - write (6, *) - write (6, *) 'GELHAD parameter verification in gtgamavrfydeb' - write (6, *) ' jphadr = ', jphadr - write (6, *) ' ecut = ', ecutphadr - write (6, *) ' scale = ', scale - write (6, *) ' mode = ', mode_gphad - write (6, *) ' ethresh = ', ethresh_gphad - write (6, *) - endif - - endif -c - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/labframe.F b/src/programs/Simulation/HDGeant/gelhad/labframe.F deleted file mode 100644 index 7e4c93b5fb..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/labframe.F +++ /dev/null @@ -1,31 +0,0 @@ -!Tue Mar 4 11:21:49 PST 1997 - A. Snyder -!Boost produced particles from recoil frame pack to lab - subroutine labframe(u,mrecoil,precoil,np,p,id) - implicit none - real *4 mrecoil,precoil,erecoil - integer *4 np,id(*),i - real *4 p(3,*),e,pznew,u(3),pz - real *4 gamma,beta -c - character *20 name - real *4 temp(10) - integer *4 ntemp,type - real *4 mass,charge,lifetime -c - erecoil=sqrt(precoil**2+mrecoil**2) - beta=precoil/erecoil - gamma=erecoil/mrecoil -c - do i=1,np - call gfpart(id(i),name,type,mass,charge,lifetime,temp,ntemp) - pz=u(1)*p(1,i)+u(2)*p(2,i)+u(3)*p(3,i) - e=sqrt(p(1,i)**2+p(2,i)**2+p(3,i)**2+mass**2) - pznew=gamma*(pz+beta*e) - p(1,i)=p(1,i)+(pznew-pz)*u(1) - p(2,i)=p(2,i)+(pznew-pz)*u(2) - p(3,i)=p(3,i)+(pznew-pz)*u(3) - enddo -c - return - end - diff --git a/src/programs/Simulation/HDGeant/gelhad/recoilframe.F b/src/programs/Simulation/HDGeant/gelhad/recoilframe.F deleted file mode 100644 index 2d0e50c419..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/recoilframe.F +++ /dev/null @@ -1,45 +0,0 @@ -!Mon Mar 3 10:07:47 PST 1997 -!Find momentum of stand-in particle in target rest from -!A. Snyder -! - subroutine recoilframe - .(egamma,mstandin,mtarget,mrecoil,pstandin,precoil,ok) - implicit none - real *4 egamma !energy of input gamma - real *4 mstandin !mass of stand-in particle - real *4 mtarget !mass of target - real *4 pstandin !momentum of stand-in in recoil rest frame - real *4 mrecoil !mass of recoil fragment - real *4 precoil !momentum of recoil in lab -c - real *4 mall,eall,pall,ercm,prcm,escm,pscm,beta,gamma - logical ok -c - ok=.false. !assume the worst -c -c cm system - eall=egamma+mtarget - pall=egamma - if(eall.lt.pall) return - mall=sqrt(eall**2-pall**2) -c -c do recoil - ercm=(mall**2+mrecoil**2-mstandin**2)/(2.0*mall) - if(ercm.lt.mrecoil) return - prcm=sqrt(ercm**2-mrecoil**2) - beta=pall/eall - gamma=eall/mall - precoil=gamma*(-prcm+beta*ercm) -c -c do projectile - escm=(mall**2+mstandin**2-mrecoil**2)/(2.0*mall) - if(escm.lt.mstandin) return - pscm=sqrt(escm**2-mstandin**2) - beta=-prcm/ercm - gamma=ercm/mrecoil - pstandin=gamma*(pscm-beta*escm) -c - ok=.true. !success -c - return - end diff --git a/src/programs/Simulation/HDGeant/gelhad/sigmag.F b/src/programs/Simulation/HDGeant/gelhad/sigmag.F deleted file mode 100644 index fc4d7c13e9..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/sigmag.F +++ /dev/null @@ -1,98 +0,0 @@ - subroutine sigmag(a,z,egamma,sigma) -******************************************************** -* Routine to compute gN xsections -* Bothers nobody else -* Author: A. Snyder -* version 1.00 - Wed Nov 22 17:57:32 PST 1995 -* version 1.01 - Wed Jan 24 16:34:07 PST 1996 -* modified to give 0 xsection for A<1 (vaccuum) -******************************************************* - implicit none -* -* input: - real *4 a !atomic number (number of n+p) - real *4 z !number of ps - real *4 egamma !photon energy (gev) -* -* output: - real *4 sigma !cross-section in mb -* -* internal: - real *4 l !levinger factor -* - sigma=0.0 - if(a.lt.0.99) return !no material - sigma=0.2 !a fixed but fairly meaning less value - if(egamma.lt.0.050) return - if(egamma.lt.0.2) then !quasi-deutron region - call sigmatf(egamma,sigma) !thorlacius&fearing - l=7 - if(a.lt.4) l=a - sigma=sigma*l*(a-z)*z/a - return - else - call sigmapdg(egamma,sigma) - sigma=0.5*sigma*a - endif !(egamma.lt.0.2) -* - return - end -* - subroutine sigmatf(e,sigma) !thorlacius&fearing parameterization - real *4 e,sigma - real *4 fourpi/12.566371/ - real *4 c1/261.0/ - real *4 c2/-110.0/ - real *4 c3/24.6/ - real *4 c4/-17.1/ - real *4 c5/5.76/ - real *4 c6/-2.05/ - real *4 c7/0.267/ - real *4 c8/113.0/ - sigma=c1*exp(c2*e)+c3*exp(c4*e)+(c5+c6*e)/(1.0+c8*(e-c7)**2) - sigma=sigma*fourpi/1000.0 !4pi and ->mb - return - end -* - subroutine sigmapdg(eg,sigma) !D2 xsections from pdg - real *4 eg,sigma - real *4 e(14) /.20,.238,.258,.316,.341,.419,.543,.570,.706,.940 - >,.975,1.11,1.22,17.5/ - real *4 s(14)/0.24,0.40,0.82,0.90,0.90,0.56,0.35,0.4,0.5,0.34 - >,0.35,0.33,0.29,0.2/ - real *4 le(14) !log table energy - integer *4 i,up,lo - logical init/.false./ - - save init,le -* - if(.not.init) then - do 10 i=1,14 - le(i)=alog(e(i)) - 10 continue - init=.true. - endif !.not.init -* -* handle off table - sigma=0.0 - if(eg.lt.e(1)) return - sigma=s(14) - if(eg.gt.e(14)) return -* -* look up position in table - do 1000 i=2,14 - if(eg.gt.e(i)) go to 1000 - up=i - goto 1099 - 1000 continue - 1099 continue -* -* interpolate between values in table - lo=up-1 - sigma=s(lo)+(s(up)-s(lo))*(alog(eg)-le(lo))/(le(up)-le(lo)) -* - return - end - - - diff --git a/src/programs/Simulation/HDGeant/gelhad/sigmagamma.F b/src/programs/Simulation/HDGeant/gelhad/sigmagamma.F deleted file mode 100644 index 6539653257..0000000000 --- a/src/programs/Simulation/HDGeant/gelhad/sigmagamma.F +++ /dev/null @@ -1,49 +0,0 @@ - real function sigmagamma(e) - implicit none - real *4 e - integer *4 mode/0/ !mode=0=>homemade based on pdb -c - real *4 elo,ehi,sigmalo,sigmahi,lelo,lehi,le - integer *4 i -c - real *4 sigmatable(8),etable(8) - data sigmatable/120.0,522.0,522.0,209.0,266.0,152.0,143.0,122.0/ - data etable/0.2,0.3,0.35,0.475,0.7,1.5,2.0,10./ -c - logical init/.false./ -c - if(.not.init) then - write(6,*) 'mode=',mode,'in /sigmagamma/' - init=.true. - endif !.not.init -c - sigmagamma=0 - if(mode.eq.0) then !homebrew? -c - sigmagamma=sigmatable(1) - if(e.lt.etable(1)) return !off bottom ? - sigmagamma=sigmatable(8) - if(e.gt.etable(8)) return !off top -c -c find bin - do 1000 i=1,7 - if(e.ge.etable(i).and.e.lt.etable(i+1)) then - elo=etable(i) - ehi=etable(i+1) - sigmalo=sigmatable(i) - sigmahi=sigmatable(i+1) - go to 1099 - endif !e.ge.etable(i).and.e.lt.etable(i+1) -1000 continue -1099 continue -c -c interpolate - lelo=alog(elo) - lehi=alog(ehi) - le=alog(e) - sigmagamma=sigmalo+(le-lelo)*(sigmahi-sigmalo)/(lehi-lelo) -c - endif !mode.eq.0 -c - return - end diff --git a/src/programs/Simulation/HDGeant/ggclos.F b/src/programs/Simulation/HDGeant/ggclos.F deleted file mode 100644 index 0dd805e9f0..0000000000 --- a/src/programs/Simulation/HDGeant/ggclos.F +++ /dev/null @@ -1,918 +0,0 @@ -*------------------------------------------------------------------- -* fixes by rtj: This is mostly just an annotation of prior existing -* code so that I can understand better what it is -* doing. There was just one minor tweak to the logic -* of virtual divisions for the special case of phi -* divisions of mothers with child volumes that span -* phi=0, where the decision of who gets included in -* phi divisions around phi=0 was faulty. I also added -* a compile-time switch DEBUG_PRINT to enable print -* statements, which were commented out in the original -* code. Other non-debug code that was commented out -* is protected by the DISABLED_CODE switch. -*------------------------------------------------------------------- -* -* $Id: ggclos.F,v 1.2 1997/11/14 17:44:00 mclareni Exp $ -* -* $Log: ggclos.F,v $ -* Revision 1.2 1997/11/14 17:44:00 mclareni -* Make sure the maximum angle is greater than the minimun -* -* Revision 1.1.1.1 1995/10/24 10:20:10 cernlib -* Geant -* -* -#define DEBUG_PRINT 0 - -#include "geant321/pilot.h" -#if !defined(CERNLIB_OLD) -*CMZ : 3.21/04 13/12/94 15.29.27 by S.Giani -*-- Author : - SUBROUTINE GGCLOS -C. -C. ****************************************************************** -C. * * -C. * Closes off the geometry setting. * -C. * Initializes the search list for the contents of each * -C. * volume following the order they have been positioned, and * -C. * inserting the content '0' when a call to GSNEXT (-1) has * -C. * been required by the user. * -C. * Performs the development of the JVOLUM structure for all * -C. * volumes with variable parameters, by calling GGDVLP. * -C. * Interprets the user calls to GSORD, through GGORD. * -C. * Computes and stores in a bank (next to JVOLUM mother bank) * -C. * the number of levels in the geometrical tree and the * -C. * maximum number of contents per level, by calling GGNLEV. * -C. * Sets status bit for CONCAVE volumes, through GGCAVE. * -C. * Completes the JSET structure with the list of volume names * -C. * which identify uniquely a given physical detector, the * -C. * list of bit numbers to pack the corresponding volume copy * -C. * numbers, and the generic path(s) in the JVOLUM tree, * -C. * through the routine GHCLOS. * -C. * * -C. * Called by : * -C. * Authors : R.Brun, F.Bruyant, S.Giani ********* * -C. * * -C. * Modified by S.Giani for automatic initialization of the new * -C. * tracking based on virtual divisions (1993). * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcflag.inc" -#include "geant321/gclist.inc" -#include "geant321/gcnum.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcopti.inc" -#include "geant321/gchvir.inc" - CHARACTER*4 NAME - LOGICAL BTEST -C. -C. ------------------------------------------------------------------ - dimension dx(3),tmpmax(7),ndivto(7),qualit(7),ivoaxi(7) - data jfirst/0/ - save jfirst - COMMON /QUEST/ IQUEST(100) - COMMON/GCDINA/jphi2,jclow,jchig,jbuff -* -* *** Stop the run in case of serious anomaly during initialization -* - IF (IEORUN.NE.0) THEN - WRITE (CHMAIL, 1001) - CALL GMAIL (0, 0) - STOP - ENDIF -* - IF (NVOLUM.LE.0) THEN - WRITE (CHMAIL, 1002) NVOLUM - CALL GMAIL (0, 0) - GO TO 999 - ENDIF -* - NPUSH = NVOLUM -IQ(JVOLUM-2) - CALL MZPUSH (IXCONS, JVOLUM, NPUSH, NPUSH,'I') -* -* *** Loop over volumes, create default JNear banks as relevant, -* and release unused bank space -* - IDO = 0 - DO 80 IVO = 1,NVOLUM - JVO = LQ(JVOLUM-IVO) -* -* *** Check if Tracking medium has been defined -* - NMED=INT(Q(JVO+4)) - IF(NMED.LE.0.OR.NMED.GT.IQ(JTMED-2))THEN - WRITE(CHMAIL,1003)IQ(JVOLUM+IVO) - CALL GMAIL (0, 0) - ELSE - IF(LQ(JTMED-NMED).EQ.0)THEN - WRITE(CHMAIL,1003)IQ(JVOLUM+IVO) - CALL GMAIL (0, 0) - ENDIF - ENDIF - IF (BTEST(IQ(JVO),0)) GO TO 80 - IDO = 1 - IQ(JVO) = IBSET(IQ(JVO),0) - NINL = IQ(JVO-2) - NIN = INT(Q(JVO+3)) - NUSED = IABS(NIN) - IF (NIN.GT.0) THEN -* reserve enough additional space for sorted volumes - IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN - NUSED=NUSED+1 - ELSE - NUSED=NUSED+2 - ENDIF - ENDIF -* - NPUSH = NUSED -NINL - DO 90 IN=NINL,NUSED+1,-1 - JIN = LQ(JVO-IN) - IF(JIN.GT.0) THEN - CALL MZDROP(IXCONS,JIN,'L') - ENDIF - 90 CONTINUE - CALL MZPUSH (IXCONS, JVO, NPUSH, 0, 'I') - IF (NIN.LE.0) GO TO 80 -* - IF(BTEST(IQ(JVO),3)) THEN - IZERO=1 - ELSE - IZERO=0 - ENDIF - NEL = NIN +IZERO - JN = LQ(JVO-NIN-1) - IF(JN.EQ.0) THEN - CALL MZBOOK (IXCONS,JN,JVO,-NIN-1,'VONE',0,0,NEL+1,2,0) - ENDIF - IQ(JN-5) = IVO - IQ(JN+1) = NEL - JN = JN +1 - DO 29 I = 1,NIN - IQ(JN+IZERO+I) = I - 29 CONTINUE - IF (IZERO.NE.0) IQ(JN+1) = 0 -* - 80 CONTINUE -* - IF (IDO.NE.0) THEN -* -* *** Perform development of JVOLUM structure where necessary -* - CALL GGDVLP -* -* *** Fill GSORD ordering banks if required -* -* Modified by S.Egli to allow GGORDQ to find the optimum sorting for -* all volumes -* - IF(IOPTIM.GE.1)THEN - WRITE(6,'(A)')' GGCLOS: Start automatic volume ordering:' - ENDIF - DO 91 IVO = 1,NVOLUM - JVO = LQ(JVOLUM-IVO) - NIN = INT(Q(JVO+3)) - ISEARC=INT(Q(JVO+1)) - IF(ISEARC.GT.0) GO TO 91 -* check if sorting not possible or not wanted - IF(NIN.LE.1.OR.NIN.GT.500.OR.IOPTIM.LT.0)THEN - Q(JVO+1)=0. - IF(NIN.GT.500.AND.IOPTIM.GE.1)THEN - CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4) - WRITE (CHMAIL,1004) NAME,NIN - CALL GMAIL (0, 0) - ENDIF - ELSEIF(IOPTIM.EQ.0)THEN - IF(ISEARC.LT.0)CALL GGORD (IVO) - ELSEIF(IOPTIM.EQ.1)THEN - IF(ISEARC.EQ.0) THEN - CALL GGORDQ(IVO) - ELSE - CALL GGORD (IVO) - END IF - ELSE - CALL GGORDQ(IVO) - ENDIF - 91 CONTINUE -* -* *** Set status bit for concave volumes -* - CALL GGCAVE -* -* *** Compute maximum number of levels and of contents per level -* - CALL GGNLEV -* - ENDIF -* -******************************************************************************** -* -c Initialize zebra banks for virtual division tables -c GCHVIR - JVIRT table -c GCDINA - work space? - - if(jfirst.eq.0)then - jfirst=1 - call mzlink(ixcons,'/GCHVIR/',jvirt,jvdiv,jcont) - call mzlink(ixstor,'/GCDINA/',jphi2,jbuff,jphi2) - endif - jflag=0 - nwjvdi=0 - jphi2=0 - jclow=0 - jchig=0 - jbuff=0 - if(jvirt.ne.0)call mzdrop(ixcons,jvirt,' ') - nwjvir=5*nvolum+20 - call mzneed(ixcons,nwjvir,'G') - if(iquest(11).lt.0)then - print *,'No space for jvirt bank' - else - call mzbook(ixcons,jvirt,jvirt,1,'VIRT',nvolum,nvolum, - + 4*nvolum+20,0,0) - endif - -c Initialize coordinate variables for geometry analysis - - dx(1)=0. - dx(2)=0. - dx(3)=0. - ndivst=0 - ndioff=0 - ninmax=0 - -c Scan the entire geometry tree for volumes with contents - - do 101 ivo=1,nvolum - jvo=lq(jvolum-ivo) - call uhtoc(iq(jvolum+ivo),4,NAME,4) -#if DEBUG_PRINT - print *,'VOLUME ',NAME - print *,' ' -#endif - nin=INT(q(jvo+3)) - isearc=INT(q(jvo+1)) -#if DEBUG_PRINT - if(nin.eq.0)then - print *,'No daughters.' - elseif(nin.lt.0)then - print *,'Divided volume.' - elseif(nin.le.1)then - print *,'Only 1 daughter.' - endif -#endif - 1 continue - - if(nin.gt.1)then - -c Focus on volumes with placed daughters - - if(jflag.eq.0)then - if(iswit(9).eq.12345)then - print *,'VOLUME ',NAME - print *,' ' - endif - endif - if(jflag.eq.1)then - -c Coming here with jflag=1 means that we have completed -c a pass through all of the possible subdivision axes, -c and the best choice for iaxis is saved in itmpq, so -c set the range of axes of interest to just that one. - - q(jvirt+4*(ivo-1)+1)=itmpq - iaxlo=itmpq - iaxhi=itmpq - else - -c Coming here with jflag=0 means that we have not yet -c completed a pass through all of the possible subdivision -c axes, so set the range of axes of interest to all. - - iaxlo=1 - iaxhi=7 - endif - -c Make sure there is enough work space in the ixstor -c zebra store to hold the arrays for this analysis scan. - - if(nin.gt.ninmax)then - if(jphi2.ne.0)call mzdrop(ixstor,jphi2,' ') - if(jclow.ne.0)call mzdrop(ixstor,jclow,' ') - if(jchig.ne.0)call mzdrop(ixstor,jchig,' ') - call mzbook(ixstor,jphi2,jphi2,2,'PHI2',0,0, - + nin+20,2,-1) - call mzbook(ixstor,jclow,jclow,2,'CLOW',0,0, - + nin+20,3,-1) - call mzbook(ixstor,jchig,jchig,2,'CHIG',0,0, - + nin+20,3,-1) - if(jflag.eq.1)then - if(jbuff.ne.0)call mzdrop(ixstor,jbuff,' ') - call mzbook(ixstor,jbuff,jbuff,2,'BUFF',0,0, - + nin+20,2,-1) - endif - endif - -c Scan over all of the axes of interest, looking for the -c one that provides the best partition of the daughters. - - do 110 iaxis=iaxlo,iaxhi - myphif=0 -#if DEBUG_PRINT - print *,'Quality search for axis ',iaxis -#endif - ish=INT(q(jvo+2)) - -c Case of cartesian axis, look for full extent of the mother -c volume and return limits in clmoth,chmoth (cm). - - if(iaxis.le.3)then - call gvdcar(iaxis,ish,0,q(jvo+7),clmoth,chmoth,ierr) - if(ierr.eq.1.or.(chmoth.le.clmoth))then -#if DEBUG_PRINT - print *,'Not convenient: abandoned!',iaxis - print *,' ' -#endif - qualit(iaxis)=10000 - goto 110 - endif - -c Case of radial coordinate, either cylindrical (iaxis=4) -c or spherical (iaxis=5) -- which gets immediately vetoed! - - elseif(iaxis.le.5)then - call gvdrad(iaxis,ish,0,dx,q(jvo+7),clmoth,chmoth,ierr) - if(iaxis.eq.5)ierr=1 - if(ierr.eq.1.or.(chmoth.le.clmoth))then -#if DEBUG_PRINT - print *,'Not convenient: abandoned!',iaxis - print *,' ' -#endif - qualit(iaxis)=10000 - goto 110 - endif - -c Case of cylindrical phi coordinate: give special attention -c to the ranges in phi, and veto the axis if -c a) the extents of the mother are unknown, or -c b) the phi range of the mother is greater than 360 deg, or -c c) the upper phi limit of the mother exceeds 360 deg. -c If the space between the limits is 360 then the exact values -c of the limits are meaningless, and myphif=1 is set to indicate -c full azimuthal coverage. - - elseif(iaxis.eq.6)then - call gvdphi(ish,0,dx,q(jvo+7),clmoth,chmoth,ierr) - if(ierr.eq.1.or.(chmoth.le.clmoth))then -#if DEBUG_PRINT - print *,'Not convenient: abandoned!',iaxis - print *,' ' -#endif - qualit(iaxis)=10000 - goto 110 - elseif((chmoth-clmoth).gt.360..or.chmoth.gt.360)then - print *,'(chmoth-clmoth).gt.360.or.chmoth.gt.360' - elseif((chmoth-clmoth).eq.360.)then - myphif=1 - endif - -c Case of the polar angle in spherical coordinates. This one -c is a dummy, because it gets immediately vetoed! - - elseif(iaxis.eq.7)then - call gvdthe(ish,0,dx,q(jvo+7),clmoth,chmoth,ierr) - ierr=1 - if(ierr.eq.1.or.(chmoth.le.clmoth))then -#if DEBUG_PRINT - print *,'Not convenient: abandoned!',iaxis - print *,' ' -#endif - qualit(iaxis)=10000 - goto 110 - endif - endif - -c If this is the final pass through here for this volume, -c record the mother volume limits in the JVIRT table. - - if(jflag.eq.1)then - q(jvirt+4*(ivo-1)+3)=clmoth - q(jvirt+4*(ivo-1)+4)=chmoth - endif - -c Prepare for the scan through the daughter volumes, -c storing the thickness of the mother along the virtual division -c axis in thimot, and the running minimum thickness of the daughters -c will be saved in thimin. - - thimot=abs(chmoth-clmoth) - thimin=100000. - -c For each volume ivo, and each axis iaxis, now we can through -c each daughter volume identified by child index "in". - - do 102 in=1,nin - iq(jphi2+in)=0 - jin=lq(jvo-in) - -c Find the limits along this axis for this child. If there -c is an error, set the limits to those of the mother. - - call gvdlim(jvo,in,iaxis,clow,chigh,ierr) - if(ierr.eq.1.or.(chigh.le.clow))then -#if DEBUG_PRINT - if(ierr.eq.0)print *,'Error in gvdlim: corrected',iaxis -#endif - clow=clmoth - chigh=chmoth - -c Special treatment for mothers being subdivided in phi, -c whose extent is the full 360 degrees. -c a) if chigh != 360 : -c *) map clow into range [0.,360.) -c *) map chigh into range [0.,360.) -c b) else if chigh == 360 : -c *) let clow := abs(clow) -c *) map clow into range [0.,360.) -c *) let chigh := 360. -c This transformation can lead to the situation where -c clow > chigh, and if so, exchange clow <=> chigh and -c set a flag in the JPHI2 table to indicate that the -c complement of the phi range [clow,chigh] is selected. -c -c NOTE BY RTJ: -c Logically, this treatment seems valid. The case of -c clow < 0 and chigh = 360 does not result in anything -c that resembles the original interval, but these limits -c are illegal because they span more than 360 deg, so the -c results are unpredictable. - - elseif(myphif.eq.1)then - clowm=clow - chighm=chigh - sg=sign(1.0,clow) - clow=mod(abs(clow),360.0) - if(chigh.ne.360.0)then - if(sg.le.0.0)clow=360.-clow - sg=sign(1.0,chigh) - chigh=mod(abs(chigh),360.0) - if(sg.le.0.0)chigh=360.-chigh - endif - if(chigh.lt.clow)then - chightf = clow - clow = chigh - chigh = chightf - iq(jphi2+in)=1 - endif - -c Special treatment for mothers being subdivided in phi, -c whose extent is less than the full 360 degrees. If the -c low phi limit of the child protrudes further than 0.01 deg -c below the low phi limit of the mother, or the high phi -c limit of the child extends beyond 0.01 deg past the high -c phi limit of the mother, this requires special treatment. -c case a) mother clow < 0 but child clow > 0 -c This means that the mother phi range has been set up -c to wrap around and include phi=0, and often in this -c case it happens that child chigh > mother chigh -c without any geometry violation. The solution is to -c map the child range back by 360 degrees to fit inside -c the range over which the mother is defined. After that, -c if the protrusion of the child beyond the limits of the -c mother (tolerance 0.01 deg) still persists, truncate the -c phi limits of the child at the corresponding limit of -c the mother. -c case b) mother chigh > 0 but child chigh < 0 -c This means that the mother phi range has been set -c to wrap around and include phi=0, and often in this -c case it happens that child clow < mother clow -c without any geometry violation. The solution is to -c map the child range forward by 360 degrees to fit inside -c the range over which the mother is defined. After that, -c if the protrusion of the child beyond the limits of the -c mother (tolerance 0.01 deg) still persists, truncate the -c phi limits of the child at the corresponding limit of -c the mother. -c If the above process results in a child phi range that is -c of zero or negative width, an inconsistency in the original -c geometry description is suspected. This situation is not -c flagged with any error message here, but the range of the -c child volume is set to the full phi range of the mother. - - elseif(iaxis.eq.6.and.myphif.eq.0)then - if((chigh-chmoth).gt..01.or.(clmoth-clow).gt..01)then - if(clmoth.lt.0..and.clow.gt.0.)then - clow=clow-360. - chigh=chigh-360. - if((chigh-chmoth).gt..01)then - chigh=chmoth - if(chigh.le.clow)clow=clmoth - elseif((clmoth-clow).gt..01)then - clow=clmoth - if(clow.ge.chigh)chigh=chmoth - endif - elseif(chigh.lt.0..and.chmoth.gt.0.)then - clow=clow+360. - chigh=chigh+360. - if((chigh-chmoth).gt..01)then - chigh=chmoth - if(chigh.le.clow)clow=clmoth - elseif((clmoth-clow).gt..01)then - clow=clmoth - if(clow.ge.chigh)chigh=chmoth - endif - endif - endif - endif - -c This section applies to any virtual division axis. If the child -c limits extend out past the limits of the mother then a geometry -c violation has occurred. Truncate the child range at the limits -c of the mother, and if this results in the child having zero or -c negative extent, set the bounds of the child to the full range of -c the mother. -c -c NOTE BY RTJ: -c The algorithms used in the gvd*() functions to obtain the limits of -c elementary shapes along arbitrary axes employ approximations in some -c cases that are conservative. That is, the limits are sometimes a bit -c larger than the actual extent of the object. This is fine for the -c purposes of virtual divisions, but results in occasional false reports -c of daughters protruding outside their mothers. Take this warning with -c a grain of salt, particularly if the overlap is small compared to the -c child volume size scale. - - if((chigh-chmoth).gt..01)then -#if DEBUG_PRINT - print *,'iaxis =',iaxis,'protruding daughter, high end' - print *,'myphif =',myphif,'myphi2 =',iq(jphi2+in) - print *,'mother limits: ',clmoth,chmoth - print *,'daughter limits: ',clow,chigh - print 5980, iq(jvolum+ivo),iq(jvolum+int(q(jin+2))),in - 5980 format('mother is ',a4,', child is ',a4,i6) -#endif - chigh=chmoth - if(chigh.le.clow)clow=clmoth - elseif((clmoth-clow).gt..01)then -#if DEBUG_PRINT - print *,'iaxis =',iaxis,'protruding daughter, low end' - print *,'myphif =',myphif,'myphi2 =',iq(jphi2+in) - print *,'mother limits: ',clmoth,chmoth - print *,'daughter limits: ',clow,chigh - print 5980, iq(jvolum+ivo),iq(jvolum+int(q(jin+2))),in -#endif - clow=clmoth - if(clow.ge.chigh)chigh=chmoth - endif - -c Save the limits of this child in the JVIRT table. - - q(jclow+in)=clow - q(jchig+in)=chigh - -c Determine the thickness of this child along the division axis, -c and keep the minimum value for this mother in thimin. - - if(iq(jphi2+in).eq.0)then - tmpthi=abs(chigh-clow) - else - tmpthi=abs(chighm-clowm) - endif - if(thimin.gt.tmpthi)thimin=tmpthi - 102 continue - -c Loop over child index "in" terminates here. -c Check that the minimum child thickness along this axis -c is not significantly greater than the thickness of the -c mother. If so, this is weird, because it should never -c happen, given all the truncation that occurred above. - - if((thimin-thimot).gt.1)then -#if DEBUG_PRINT - print *,'thimin.gt.thimot',thimin-thimot,'iax=',iaxis -#endif - qualit(iaxis)=10000 - goto 110 - endif - -c Apply an arbitrary cutoff on the minimum child thickness, then -c adopt an initial guess for the thickness of the virtual divisions -c that is half the minimum, and set the number of divisions accordingly. - - if(thimin.lt.0.04)thimin=0.04 - tmpndi=2.*thimot/thimin - nditmp=INT(tmpndi+1) -#if DEBUG_PRINT - print *,nditmp,' divisions to partition ',nin,' daughters.' -#endif -#if DISABLED_CODE - if(nditmp.lt.nin)then - nditmp=nin - print *,'Number of divisions corrected to be = ',nin - endif -#endif - -c Apply a maximum of 1000 divisions, prevent excessive memory -c consumption - -#if DEBUG_PRINT - if(nditmp.gt.1000.)print *,'1000 divisions are enough.' -#endif - ndivto(iaxis)=min(nditmp,1000) - -c If this is the final pass through the iaxis loop then record -c the outcome of this analysis in the JVIRT table for this mother. - - if(jflag.eq.1)then - q(jvirt+4*(ivo-1)+2)=ndivto(iaxis) - jvdiv=lq(jvirt-ivo) - if(jvdiv.ne.0)call mzdrop(ixcons,jvdiv,' ') - nwvili=ndivto(iaxis)+ivoaxi(itmpq)+11 - nwjvdi=nwjvdi+nwvili - call mzneed(ixcons,nwvili,'G') - if(iquest(11).lt.0)then - print *,'No space for jvdiv bank',ivo - else - call mzbook(ixcons,jvdiv,jvirt,-ivo,'VLIST',0,0, - + nwvili,2,0) - endif - endif - -c Set up to loop over the slices and compute statistics -c on the occupation of children throughout the mother. - - thisli=thimot/ndivto(iaxis) - clslic=clmoth - chslic=clmoth+thisli - avelis=0. - aveave=0. - avesta=0. - ii=0 - tmpmax(iaxis)=0. - import=0 - if(jflag.eq.1)ioff=ndivto(iaxis) - -c Loop over all virtual divisions of this mother "i". - - do 103 i=1,ndivto(iaxis) - j=1 - -c For each slice, loop over all children of this mother -c and count (in j) the number that belong to this slice. -c If we are on the last pass for this mother volume, save -c the index of this child in the virtual divisions table -c list for this slice. - - do 104 in=1,nin - -c Ordinary case of a child volume whose limits are simply -c ordered without any complications from wrap-around phi. - - if(iq(jphi2+in).eq.0)then - if(q(jchig+in).ge.clslic.and. - + q(jclow+in).le.chslic)then - j=j+1 - if(jflag.eq.1)then - iq(jbuff+j)=in - endif - endif - -c Special case of phi axis subdivisions of the mother where -c the child wraps around through phi=0, as indicated by the -c phi2 flag. -c -c NOTE BY RTJ: -c From what I can see, this logic is faulty. A child with its -c phi2 flag set can have phi bounds which are ordered thus: -c -c child_clow < division_clow < division_chigh < child_chigh -c -c and yet not belong to the virtual division. This is because -c the virtual division [clow,chigh] lies entirely within the -c child range (clow,chigh), but this excludes the child volume -c since phi2 is set. See two lines below for my fix to the logic. - - else -c if(q(jchig+in).ge.clslic.or. -c + q(jclow+in).le.chslic)then - if (q(jclow+in).ge.clslic.or. - + q(jchig+in).le.chslic) then - j=j+1 - if(jflag.eq.1)then - iq(jbuff+j)=in - endif - endif - endif - 104 continue - -c End of loop over child volumes that belong to this slice -c If this is the final pass for this volume, gather all of -c the information about virtual divisions of this mother, -c and save it in the virtual divisions bank. - - inbuf1=j-1 - if(jflag.eq.1)then - if(i.gt.1.and.iq(jbuff+1).eq.(j-1))then - if(j-1.eq.0)then - import=1 - elseif(j-1.eq.1)then - if(iq(jbuff+2).eq.iq(jvdiv+ioff-nposti+2))then - import=1 - else - import=0 - endif - else - import=1 - do 234 ijk=2,nposti-2 - do 432 kji=2,nposti-2 - if(iq(jbuff+ijk).eq.iq(jvdiv+ioff-nposti+kji))then - goto 234 - endif - 432 continue - import=0 - goto 235 - 234 continue - 235 continue - endif - if(import.eq.1)then - iq(jvdiv+ioff-nposti+nposti)=i - iq(jvdiv+i)=ioff-nposti - goto 145 - endif - else - import=0 - endif - iq(jbuff+1)=j-1 - nposti=j+2 - iq(jbuff+j+1)=i - iq(jbuff+j+2)=i - iq(jvdiv+i)=ioff - do 144 m=1,nposti - iq(jvdiv+ioff+m)=iq(jbuff+m) - 144 continue - ioff=ioff+nposti - else - aveinc=j+2 - avesta=avesta+aveinc - endif - 145 continue - if(inbuf1.gt.tmpmax(iaxis))then - tmpmax(iaxis)=inbuf1 - endif - if(inbuf1.ne.0.)ii=ii+1 - avelis=avelis+inbuf1 - -c Advance to the next slice of the mother and continue - - clslic=chslic - chslic=clslic+thisli - 103 continue - -c End of loop over virtual divisions of this mother - - if(jflag.eq.1)then - ndioff=ndioff+ioff - if(iswit(9).eq.12345)then - print *,'words booked =',nwvili,'; words used =',ioff - print *,' ' - endif -#if DISABLED_CODE - mymyof=0 - do 2 mm=1,ndivto(iaxis) - myoff=iq(jvdiv+mm) - if(myoff.ne.mymyof)then - if(iq(jvdiv+myoff+1).eq.0)then - print *,'Lower div =',iq(jvdiv+myoff+2) - print *,'Upper div =',iq(jvdiv+myoff+3) - elseif(iq(jvdiv+myoff+1).eq.1)then - print *,'Lower div =',iq(jvdiv+myoff+3) - print *,'Upper div =',iq(jvdiv+myoff+4) - endif - endif - mymyof=iq(jvdiv+mm) - 2 continue -#endif - endif - if(ii.eq.0)then - print *,iaxis,'=iax: not filled divisions: error!' - print *,' ' - aveave=10000 - avelis=10000 - goto 105 - endif - if(jflag.eq.0)then - ivoaxi(iaxis)=INT(avesta) - endif - aveave=avelis/ndivto(iaxis) - avelis=avelis/ii - 105 continue - qualit(iaxis)=avelis -#if DEBUG_PRINT - print *,'Max n. of objects per div = ',tmpmax(iaxis) - print *,'Aver. n. of obj. per not-empty div = ',avelis - print *,'Average n. of objects per div = ',aveave - print *,' ' -#endif - 110 continue - if(jflag.eq.0)then - tmpq=10000 - tmpm=10000 - itmpq=0 - itmpm=0 - do 111 iaxis=1,7 - if(qualit(iaxis).lt.tmpq)then - tmpq=qualit(iaxis) - itmpq=iaxis - endif - if(tmpmax(iaxis).lt.tmpm)then - tmpqm=tmpmax(iaxis) - itmpm=iaxis - endif - 111 continue - if(iswit(9).eq.12345)then - print *,'nin=',nin,' iax=',itmpq,' ndiv=',ndivto(itmpq) - print *,'Max n. of objects per div = ',tmpmax(itmpq) - print *,'Average n. of objects per div = ',tmpq - endif -#if DISABLED_CODE - if(isearc.lt.0)then - jsb=lq(lq(jvo-nin-1)) - iaxor=q(jsb+1) - ndivor=q(jsb+2)-1 - jsco=lq(jvo-nin-2) - tmpqor=0. - tmpmor=0. - do 133 idivor=1,ndivor - if(iq(jsco+idivor).gt.tmpmor)tmpmor=iq(jsco+idivor) - tmpqor=tmpqor+iq(jsco+idivor) - 133 continue - tmpqor=tmpqor/ndivor - print *,'Gsord: iax=',iaxor,' ndiv=',ndivor - print *,'Gsord: Max n. of obj. per div = ',tmpmor - print *,'Gsord: Aver. n. of obj. per div = ',tmpqor - endif -#endif - ndivst=INT(ndivst+(ndivto(itmpq)+ndivto(itmpq)*(3.+tmpq)+10.)) - jflag=1 - goto 1 - else - jflag=0 -#if DEBUG_PRINT - print *,'nin=',nin,' iax=',q(jvirt+4*(ivo-1)+1),' ndiv=', - +q(jvirt+4*(ivo-1)+2) - ittmp=0 - iind=q(jvirt+4*(ivo-1)+2) - do 155 n=1,iind - jvdiv1=lq(jvirt-ivo) - iofset=iq(jvdiv1+n) - nnobj=iq(jvdiv1+iofset+1) - if(nnobj.gt.ittmp)ittmp=nnobj - 155 continue - print *,'Max n. of objects per div = ',ittmp - print *,' ' - print *,' ' -#endif - endif - endif - if(nin.gt.ninmax)ninmax=nin - 101 continue - nwtota=INT(ndivst+nvolum*5+10.) - if(iswit(9).eq.12345)then - print *,'Computed number of words foreseen = ',nwtota - endif - nwreal=nwjvir+nwjvdi - if(iswit(9).eq.12345)then - print *,'Computed number of words booked = ',nwreal - endif - nwneed=nwjvir+ndioff - if(iswit(9).eq.12345)then - print *,'Computed number of words needed = ',nwneed - endif - if(jphi2.ne.0)call mzdrop(ixstor,jphi2,' ') - if(jclow.ne.0)call mzdrop(ixstor,jclow,' ') - if(jchig.ne.0)call mzdrop(ixstor,jchig,' ') - if(jbuff.ne.0)call mzdrop(ixstor,jbuff,' ') -* -******************************************************************************** -* -* *** Scan the volume structure to retrieve the path through -* the physical tree for all sensitive detectors -* - CALL GHCLOS -* -* *** Books STAT banks if data card STAT is submitted -* - IF (NSTAT.GT.0) CALL GBSTAT -* - CALL MZGARB (IXCONS, 0) -* - 1001 FORMAT (' Severe diagnostic in initialization phase. STOP') - 1002 FORMAT (' GGCLOS : NVOLUM =',I5,' *****') - 1003 FORMAT (' Illegal tracking medium number in volume : ',A4) - 1004 FORMAT (' GGORDQ : Volume ',A4,' has more than 500 (', - + I3,') daughters ; volume sorting not possible !') -* END GGCLOS - 999 END - -#endif diff --git a/src/programs/Simulation/HDGeant/gid_map.cc b/src/programs/Simulation/HDGeant/gid_map.cc deleted file mode 100644 index a02748119f..0000000000 --- a/src/programs/Simulation/HDGeant/gid_map.cc +++ /dev/null @@ -1,37 +0,0 @@ -#include -#include - -extern "C" { -#include "gid_map.h" -} - -static std::map gid2id; - -extern "C" { - - int gidGetId(int gid) { - int id = gid2id[gid]; - if (id == 0) { - id = -1; - gid2id[gid] = id; - } - return id; - } - - void gidSet(int gid, int id) { - gid2id[gid] = id; - return; - } - - void gidClear() { - gid2id.clear(); - return; - } - - void gidclear_() { - gidClear(); - return; - } - -} - diff --git a/src/programs/Simulation/HDGeant/gid_map.h b/src/programs/Simulation/HDGeant/gid_map.h deleted file mode 100644 index caa0d87d56..0000000000 --- a/src/programs/Simulation/HDGeant/gid_map.h +++ /dev/null @@ -1,3 +0,0 @@ - int gidGetId(int gid); - void gidSet(int gid, int id); - void gidClear(); diff --git a/src/programs/Simulation/HDGeant/gltrac.F b/src/programs/Simulation/HDGeant/gltrac.F deleted file mode 100644 index 5314f227ce..0000000000 --- a/src/programs/Simulation/HDGeant/gltrac.F +++ /dev/null @@ -1,259 +0,0 @@ -* -* $Id: gltrac.F,v 1.1 2006/04/15 04:38:38 jonesrt Exp $ -* -* $Log: gltrac.F,v $ -* Revision 1.1 2006/04/15 04:38:38 jonesrt -* gltrac.F, gsstak.F -* - replacements for geant321 library functions that enable stacking of -* secondaries with repeat counts and saving of ISTORY on the stack, -* both for the purposes of enabling cascaded simulations. [rtj] -* gustep.F -* - new code to support electron beam dump simulations with a two-level -* cascade to enhance the statistics of dump-related backgrounds. [rtj] -* taggerCoords2.xls -* - updates to the dimensions of the building and electron beam dump. [rtj] -* hdds/Spectrometer.xml, hdds/TaggerArea.xml -* - new geometry description including the electron beam dump attached -* by a corridor to the tagger building. [rtj] -* hdds/Makefile hdds/ElectronDump.xml -* - added new document to describe the electron beam dump geometry [rtj] -* gxtwist, gxtwist++, hdgeant [deleted] -* - binary files removed from repository [rtj] -* -* Revision 1.1.1.1 1995/10/24 10:21:41 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 13/12/94 15.36.22 by S.Giani -*-- Author : - SUBROUTINE GLTRAC -C. -C. ****************************************************************** -C. * * -C. * SUBR. GLTRAC * -C. * * -C. * Extracts next track from stack JSTAK and prepares commons * -C. * /GCTRAK/, /GCKINE/ and /GCVOLU/ * -C. * * -C. * Called by : GTREVE * -C. * Authors : R.Brun, F.Bruyant * -C. * * -C. ****************************************************************** -C. -#define USE_UPWGHT_AS_REPEAT_COUNT 1 -* -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gcnum.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcvolu.inc" - DIMENSION RNDM(5) -#if !defined(CERNLIB_SINGLE) - DOUBLE PRECISION P2,GETOTD,GEKIND - DOUBLE PRECISION PXD,PYD,PZD,ONE,HNORM,DAMASS,PP -#endif - PARAMETER (ONE=1) -C. -C. ------------------------------------------------------------------ -*** Restore USE_UPWGHT_AS_REPEAT_COUNT November 18 2006 -*** I added a reset ISTORY=3 to the top of gukine() and turned the -*** USE_UPWGHT_AS_REPEAT_COUNT back on. Notice to other users: if you -*** turn this off, you will get hundreds of truth tags per event. -*** richard.t.jones@uconn.edu -*** -*** Disabled use of UPWGHT November 6,2006 -*** I have commented out the #define of USE_UPWGHT_AS_REPEAT_COUNT -*** above because there appears to be a problem with it turned on. -*** The symptom is that after the first dozen events or so, every -*** single call to hitUpstreamEMveto(...) passes ISTORY=3 thereby -*** disabling the UPVTruthShowers in the output. Disabling the -*** UPWGHT feature results in consistent generation of UPVTruthShowers. -*** I will leave it to Richard to track down the true source of -*** the problem so that use of UPWGHT can be re-enabled. -*** David Lawrence - -*** Modification introduced March 26, 2006 -*** There is a "user word" UPWGHT that is associated with each particle -*** on the temporary stack. In the standard usage this word is a priority -*** that is used to select the order in which particles are tracked, in -*** conjunction with the SORD control card. In this modification I change -*** the meaning of UPWGHT to represent a repeat count for the stacked -*** particle. That is, each time a particle is retrieved from the stack -*** its value of UPWGHT on the stack is decremented and it is removed from -*** the stack only when its UPWGHT reaches zero. This behaviour is useful -*** in implementing an importance sampling scheme. Note that the default -*** value of UPWGHT is 1 so this modification has no effect unless user -*** code in gustep() or elsewhere overwrites its value. The SORD card -*** will have no effect if USE_UPWGHT_AS_REPEAT_COUNT is in effect. -*** richard.t.jones@uconn.edu - -* -* *** Extract next track from stack JSTAK -* -#ifndef USE_UPWGHT_AS_REPEAT_COUNT - IF(ISTORD.EQ.1) THEN -* -* *** User ordering of tracks if requested - CALL GSTORD - ENDIF -#endif - ISTAK = IQ(JSTAK+1) - IQ(JSTAK+1) = ISTAK -1 - JST = JSTAK +NWSTAK*IQ(JSTAK+1) +3 -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - IF (Q(JST+12).GT.1) THEN - IQ(JSTAK+1) = ISTAK - ENDIF -#endif - ITRA = IQ(JST+1) - IF (ITRA.LT.0) THEN - ITRA = -ITRA - ELSE -* -* This is a new track. We set to zero the stack number and -* update the vertex number - ISTAK = 0 - JK=LQ(JKINE-ITRA) - IVERT=INT(Q(JK+6)) - ENDIF - IPART = IQ(JST+2) - DO 60 I = 1,3 - VERT(I) = Q(JST+3+I) - PVERT(I) = Q(JST+6+I) - 60 CONTINUE - TOFG = Q(JST+10) - SAFETY = Q(JST+11) - UPWGHT = Q(JST+12) -#ifdef USE_UPWGHT_AS_REPEAT_COUNT -* print *, 'pop stacked track',istak,', copy',int(Q(JST+12)), -* + ', generation',IQ(JST+3) - Q(JST+12) = Q(JST+12)-1 - UPWGHT = 1 -#endif -* -* *** Prepare tracking parameters -* - VECT(1) = VERT(1) - VECT(2) = VERT(2) - VECT(3) = VERT(3) - PXD = PVERT(1) - PYD = PVERT(2) - PZD = PVERT(3) - P2 = PXD**2+PYD**2+PZD**2 - IF(P2.GT.0.) THEN - PP = SQRT(P2) - HNORM = ONE/PP - VECT(4) = REAL(PVERT(1)*HNORM) - VECT(5) = REAL(PVERT(2)*HNORM) - VECT(6) = REAL(PVERT(3)*HNORM) - VECT(7) = REAL(PP) - ELSE - VECT(4) = 0. - VECT(5) = 0. - VECT(6) = 1. - VECT(7) = 0. - ENDIF -* -* ** Reload Particle characteristics, if needed -* - IF (IPART.NE.IPAOLD) THEN - JPA = LQ(JPART-IPART) - DO 90 I = 1,5 - NAPART(I) = IQ(JPA+I) - 90 CONTINUE - ITRTYP = INT(Q(JPA+6)) - AMASS = Q(JPA+7) - CHARGE = Q(JPA+8) - TLIFE = Q(JPA+9) - IUPD = 0 - IPAOLD = IPART - ENDIF -* - DAMASS = AMASS - GETOTD = SQRT(P2+DAMASS**2) - GEKIND = GETOTD - DAMASS - GETOT = REAL(GETOTD) - GEKIN = REAL(GEKIND) -* - IF (ITRTYP.EQ.7) THEN -* -* *** Cerenkov photon. Retrieve polarisation - JPO = LQ(JSTAK-1)+(ISTAK-1)*3 - POLAR(1) = Q(JPO+1) - POLAR(2) = Q(JPO+2) - POLAR(3) = Q(JPO+3) - ELSE - CALL GEKBIN - ENDIF -* - SLENG = 0. - NSTEP = 0 - NTMSTO = NTMSTO +1 - NTMULT = NTMSTO -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - ISTORY = IQ(JST+3) -#else - ISTORY = 0 -#endif -* -* ** Initialize interaction probabilities -* - IF (ITRTYP.EQ.1) THEN -* Gammas - CALL GRNDM(RNDM,5) - ZINTPA = -LOG(RNDM(1)) - ZINTCO = -LOG(RNDM(2)) - ZINTPH = -LOG(RNDM(3)) - ZINTPF = -LOG(RNDM(4)) - ZINTRA = -LOG(RNDM(5)) - ELSE IF (ITRTYP.EQ.2) THEN -* Electrons - CALL GRNDM(RNDM,3) - ZINTBR = -LOG(RNDM(1)) - ZINTDR = -LOG(RNDM(2)) - ZINTAN = -LOG(RNDM(3)) - ELSE IF (ITRTYP.EQ.3) THEN -* Neutral hadrons - CALL GRNDM(RNDM,2) - SUMLIF = REAL(-CLIGHT*TLIFE*LOG(RNDM(1))) - ZINTHA = -LOG(RNDM(2)) - ELSE IF (ITRTYP.EQ.4) THEN -* Charged hadrons - CALL GRNDM(RNDM,3) - SUMLIF = REAL(-CLIGHT*TLIFE*LOG(RNDM(1))) - ZINTHA = -LOG(RNDM(2)) - ZINTDR = -LOG(RNDM(3)) - ELSE IF (ITRTYP.EQ.5) THEN -* Muons - CALL GRNDM(RNDM,5) - SUMLIF = REAL(-CLIGHT*TLIFE*LOG(RNDM(1))) - ZINTBR = -LOG(RNDM(2)) - ZINTPA = -LOG(RNDM(3)) - ZINTDR = -LOG(RNDM(4)) - ZINTMU = -LOG(RNDM(5)) - ELSE IF (ITRTYP.EQ.7) THEN -* Cerenkov photons - CALL GRNDM(RNDM,1) - ZINTLA = -LOG(RNDM(1)) - ELSE IF (ITRTYP.EQ.8) THEN -* Ions - CALL GRNDM(RNDM,2) - ZINTHA = -LOG(RNDM(1)) - ZINTDR = -LOG(RNDM(2)) - ENDIF -* -* * Prepare common /GCVOLU/ and structure JGPAR, if needed -* - IF (NJTMAX.LE.0) THEN - IF (GONLY(NLEVEL).EQ.0.) NLEVEL=0 - CALL GMEDIA (VECT, NUMED) - ENDIF - INFROM = 0 -* END GLTRAC - END - diff --git a/src/programs/Simulation/HDGeant/goptimize.F b/src/programs/Simulation/HDGeant/goptimize.F deleted file mode 100644 index 94bb26c874..0000000000 --- a/src/programs/Simulation/HDGeant/goptimize.F +++ /dev/null @@ -1,27 +0,0 @@ -* -* Goptimize - do any Geant3 geometry/tracking optimizations -* -* The actual definitions of the materials, tracking media and volume -* tree are found in the file hddsGeant3.f which is generated automatically -* from the HDDS xml geometry database by the translator hdds-geant. -* -* NOTE: It is tempting to put Geant geometry and tracking optimization -* commands into hddsGeant3.f at the point where the geometry is -* being defined. DO NOT DO THAT. Put them here in this file. -* -* This routine is part of the HDGeant simulation package -* -* Author: Richard Jones -* University of Connecticut -* July 5, 2001 -*------------------------------------ - - subroutine Goptimize - -c User optimizations go here -c such as: gsnext, gunear, gsord, -c tracking medium parameter modifications, -c graphical attributes of volumes, -c etc... - - end diff --git a/src/programs/Simulation/HDGeant/gpairg.F b/src/programs/Simulation/HDGeant/gpairg.F deleted file mode 100644 index c1e3498110..0000000000 --- a/src/programs/Simulation/HDGeant/gpairg.F +++ /dev/null @@ -1,310 +0,0 @@ -*---------------------------------------------------------------- -* Modified by R.T. Jones, C.S. Gauthier to include Bethe-Heitler -* muon-pair production by photons, weighted by (emmu/emass)**2 -* for purposes of photon beam collimator simulation. -* -* Chris.S.Gauthier@uconn.edu -* Richard.T.Jones@uconn.edu -* Hall D Collaboration -* June 25, 2002 -*---------------------------------------------------------------- -* -* $Id$ -* -* $Log$ -* Revision 1.2 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.1 2002/06/28 19:01:03 jonesrt -* Major revision 1.1 -Richard Jones, Chris Gauthier, University of Connecticut -* -* 1. Added hadronic interactions for photons with the Gelhad package -* http://www.slac.stanford.edu/BFROOT/www/Computing/Offline/Simulation/gelhad.html -* Routines affected are: -* - uginit.F : added new card GELH to set up gelhad parameters and -* call to gelh_vrfy() to print out their values. -* - uglast.F : added call to gelh_last() to print out summary info. -* - gtgama.F : Gelhad replacement for standard Geant routine that adds -* simulation of hadronic photoproduction processes. -* - gelhad/ : contains a number of new functions (Fortran) and includes -* to support the hadronic photoproduction simulation. -* -* 2. Added muon-pair production by stealing every (Melectron/Mmuon)**2 pair -* production events and trying to convert to muon pairs. The deficit in -* e+/e- events resulting from this theft is negligible. The angular -* distribution of muon pairs is generated using the general Geant method -* in gpairg.F with the electron mass replaced by the muon mass. -* Routines affected are: -* - gpairg.F : added a switch to replace e+/e- with mu+/mu- in a small -* fraction of the pair-production vertices. -* -* Revision 1.5 1998/02/09 15:59:47 japost -* Fixed a problem on AIX 4 xlf, caused by max(double,float). -* -* Revision 1.4 1998/02/06 16:46:57 japost -* Fix a wrong parenthesis. -* -* Revision 1.3 1998/02/06 16:22:24 japost -* Protected a square root from a negative argument. -* This root was added there in previous changes, and not deleted from its -* old position. In its old position it was protected from being negative, but in -* its new position it was not. -* -* Deleted the same square root from its old position, as it was redundant. -* -* Revision 1.2 1996/03/13 12:03:24 ravndal -* Tranverse momentum conservation -* -* Revision 1.1.1.1 1995/10/24 10:21:28 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 21/02/95 11.53.59 by S.Giani -*-- Author : -#if defined(CERNLIB_HPUX) -$OPTIMIZE OFF -#endif - SUBROUTINE GPAIRG -C. -C. ****************************************************************** -C. * * -C. * Simulates e+e- pair production by photons. * -C. * * -C. * The secondary electron energies are sampled using the * -C. * Coulomb corrected BETHE-HEITLER cross-sections.For this the * -C. * modified version of the random number techniques of * -C. * BUTCHER and MESSEL (NUCL.PHYS,20(1960),15) are employed. * -C. * * -C. * NOTE : * -C. * (1) Effects due to the breakdown of the BORN approximation at * -C. * low energies are ignored. * -C. * (2) The differential cross-section implicitly takes account * -C. * of pair production in both nuclear and atomic electron * -C. * fields. However, triplet production is not generated. * -C. * * -C. * ==>Called by : GTGAMA * -C. * Authors G.Patrick, L.Urban ********* * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gconsp.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcking.inc" -#include "geant321/gcphys.inc" -#include "geant321/gccuts.inc" - - DIMENSION NTYPEL(2) - DIMENSION RNDM(2) - LOGICAL ROTATE - PARAMETER (ONE=1,ONETHR=ONE/3,EMAS2=REAL(2*EMASS)) -c -c Here we take over the standard Geant3 e+e- pair production cross section -c as a good approximation to the total l+l- lepton pair production cross -c section. The only change is to convert a fraction (emmu/emass)**2 from -c electron to muon pairs, if allowed by energy conservation. -c - real xsratio - parameter (xsratio=REAL((emass/emmu)**2)) - real mlepton - integer lepton - call grndm(rndm,1) - if (rndm(1).lt.xsratio) then - lepton = 5 - mlepton = REAL(EMMU) - else - lepton = 2 - mlepton = REAL(EMASS) - endif -C. -C. ------------------------------------------------------------------ -C. -C If not enough energy : no pair production -C - EGAM = VECT(7) - IF (EGAM.LT.mlepton*2) GO TO 999 -C - KCASE = NAMEC(6) - IF(IPAIR.NE.1) THEN - ISTOP = 2 - NGKINE = 0 - DESTEP = DESTEP + EGAM - VECT(7)= 0. - GEKIN = 0. - GETOT = 0. - GO TO 999 - ENDIF -C -C For low energy photons approximate the electron energy by -C sampling from a uniform distribution in the interval -C EMASS -> EGAM/2. -C - IF (EGAM.LE.mlepton*4)THEN - CALL GRNDM(RNDM,1) - EEL1 = mlepton + (RNDM(1)*(0.5*EGAM - mlepton)) - X=EEL1/EGAM - GO TO 20 - ENDIF -C - Z3=Q(JPROB+2) - F=8.*Q(JPROB+3) - IF(EGAM.GT.mlepton*10) F=F+8.*Q(JPROB+4) - X0=mlepton/EGAM - DX=0.5-X0 - DMIN=544.*X0/Z3 - DMIN2=DMIN*DMIN - IF(DMIN.LE.1.)THEN - F10=42.392-7.796*DMIN+1.961*DMIN2-F - F20=41.405-5.828*DMIN+0.8945*DMIN2-F - ELSE - F10=42.24-8.368*LOG(DMIN+0.952)-F - F20=F10 - ENDIF -C -C Calculate limit for screening variable,DELTA, to ensure -C that screening rejection functions always remain -C positive. -C - DMAX=EXP((42.24-F)/8.368)-0.952 -C -C Differential cross-section factors which form -C the coefficients of the screening functions. -C - DSIG1=DX*DX*F10/3. - DSIG2=0.5*F20 - BPAR = DSIG1 / (DSIG1 + DSIG2) -C -C Decide which screening rejection function to use and -C sample the electron/photon fractional energy BR. -C - 10 CALL GRNDM(RNDM,2) - IF(RNDM(1).LT.BPAR)THEN - X=0.5-DX*RNDM(2)**ONETHR - IREJ=1 - ELSE - X=X0+DX*RNDM(2) - IREJ = 2 - ENDIF -C -C Calculate DELTA ensuring positivity. -C - D=0.25*DMIN/(X*(1.-X)) - IF(D.GE.DMAX) GOTO 10 - D2=D*D -C -C Calculate F1 and F2 functions using approximations. -C F10 and F20 are the F1 and F2 functions calculated for the -C DELTA=DELTA minimum. -C - IF(D.LE.1.)THEN - F1=42.392-7.796*D+1.961*D2-F - F2=41.405-5.828*D+0.8945*D2-F - ELSE - F1=42.24-8.368*LOG(D+0.952)-F - F2=F1 - ENDIF - IF(IREJ.NE.2)THEN - SCREJ=F1/F10 - ELSE - SCREJ=F2/F20 - ENDIF -C -C Accept or reject on basis of random variate. -C - CALL GRNDM(RNDM,1) - IF(RNDM(1).GT.SCREJ) GOTO 10 - EEL1=X*EGAM -C -C Successful sampling of first electron energy. -C -C Select charges randomly. -C - 20 NTYPEL(1) = lepton - CALL GRNDM(RNDM,2) - IF (RNDM(1).GT.0.5) NTYPEL(1) = lepton+1 - NTYPEL(2) = 2*lepton+1 - NTYPEL(1) -C -C Generate electron decay angles with respect to a Z-axis -C defined along the parent photon. -C PHI is generated isotropically and THETA is assigned -C a universal angular distribution -C - EMASS1 = mlepton - THETA = GBTETH(EEL1, EMASS1, X)*mlepton/EEL1 - SINTH = SIN(THETA) - COSTH = COS(THETA) - PHI = REAL(TWOPI*RNDM(2)) - COSPHI = COS(PHI) - SINPHI = SIN(PHI) - -C -C Rotate tracks into GEANT system -C - CALL GFANG(VECT(4),COSAL,SINAL,COSBT,SINBT,ROTATE) -C -C Polar co-ordinates to momentum components. -C - NGKINE = 0 - TEL1 = EEL1 - mlepton - PEL1 = SQRT(MAX((EEL1+REAL(mlepton))*TEL1,0.)) - IF(TEL1.GT.CUTELE) THEN - NGKINE = NGKINE + 1 - GKIN(1,NGKINE) = PEL1 * SINTH * COSPHI - GKIN(2,NGKINE) = PEL1 * SINTH * SINPHI - GKIN(3,NGKINE) = PEL1 * COSTH - GKIN(4,NGKINE) = EEL1 - GKIN(5,NGKINE) = NTYPEL(1) - TOFD(NGKINE)=0. - GPOS(1,NGKINE) = VECT(1) - GPOS(2,NGKINE) = VECT(2) - GPOS(3,NGKINE) = VECT(3) - IF(ROTATE) - + CALL GDROT(GKIN(1,NGKINE),COSAL,SINAL,COSBT,SINBT) - ELSE - DESTEP = DESTEP + TEL1 - IF(NTYPEL(1).EQ.2) CALL GANNI2 - ENDIF -C -C Momentum vector of second electron. Recoil momentum of -C target nucleus/electron ignored. -C - EEL2=EGAM-EEL1 - TEL2=EEL2-mlepton - IF(TEL2.GT.CUTELE) THEN - PEL2 = SQRT((EEL2+mlepton)*TEL2) - NGKINE = NGKINE + 1 - SINTH=SINTH*PEL1/PEL2 - COSTH=SQRT(MAX(0.,1.-SINTH**2)) - GKIN(1,NGKINE)=-PEL2*SINTH*COSPHI - GKIN(2,NGKINE)=-PEL2*SINTH*SINPHI - GKIN(3,NGKINE)=PEL2*COSTH - GKIN(4,NGKINE)=EEL2 - GKIN(5,NGKINE) = NTYPEL(2) - TOFD(NGKINE)=0. - GPOS(1,NGKINE) = VECT(1) - GPOS(2,NGKINE) = VECT(2) - GPOS(3,NGKINE) = VECT(3) - IF(ROTATE) - + CALL GDROT(GKIN(1,NGKINE),COSAL,SINAL,COSBT,SINBT) - ELSE - DESTEP = DESTEP + TEL2 - IF(NTYPEL(2).EQ.2) CALL GANNI2 - ENDIF - ISTOP = 1 - IF(NGKINE.EQ.0) ISTOP = 2 - 999 END -#if defined(CERNLIB_HPUX) -$OPTIMIZE ON -#endif diff --git a/src/programs/Simulation/HDGeant/gpp/gpp.C b/src/programs/Simulation/HDGeant/gpp/gpp.C deleted file mode 100644 index 5cea61b95e..0000000000 --- a/src/programs/Simulation/HDGeant/gpp/gpp.C +++ /dev/null @@ -1,523 +0,0 @@ -/* - * gpp: GEANT preprocessor for MCFAST database files - * - * Summary: - * MCFAST is a MonteCarlo event generator used by American HEP laboratories. - * GEANT is a MonteCarlo event generator from CERN used by HEP worldwide. - * The purpose of gpp is to input a geometry database file (db) in MCFAST - * format and generate the equivalent Fortran code for GEANT. It has been - * tested and used with GEANT v3.21. - * - * Author: Richard Jones - * Institution: University of Connecticut - * Language: ANSI C++ - * Original: v 1.0, Jan. 12 1999 - * Updated: - * - * Comments: - * > Richard Jones, July 5 2001 - * This package has been superseded by the hdds-geant translator - * that interfaces Geant3 to the HDDS xml geometry database. - */ - -#include -#include -#include - -#define _REENTRANT 1 -#include - -ifstream fdbase; -ifstream fsource; -ofstream fdest; - -int thisLine; -char thisFile[100]; -char sourceFile[] = "mcgeom.f"; - -class TemplateItem; -class TemplateList; - -class TemplateAtom { -friend class TemplateItem; -private: - TemplateAtom *fNext; -public: - char *fType; - char *fName; - TemplateAtom(); - TemplateAtom(char *type, char *name); - ~TemplateAtom(); - TemplateAtom *Next() { return fNext; } -}; - -class TemplateItem { -friend class TemplateList; -private: - TemplateAtom *firstAtom; - TemplateItem *fNext; -public: - char *fName; - char *fNumber; - TemplateItem(); - TemplateItem(char *name, char *number); - ~TemplateItem(); - void Append(TemplateAtom *atom); - void Delete(char *name); - TemplateAtom *Find(char *name); - TemplateAtom *First() { return firstAtom; } - TemplateItem *Next() { return fNext; } -}; - -class TemplateList { -private: - TemplateItem *firstItem; -public: - TemplateList(); - ~TemplateList(); - void Append(TemplateItem *item); - void Delete(char *name); - TemplateItem *Find(char *name); - TemplateItem *First() { return firstItem; } -}; - -TemplateList table; - - -TemplateAtom::TemplateAtom() -{ - fType = fName = 0; - fNext = 0; -} - -TemplateAtom::TemplateAtom(char *type, char *name) -{ - fType = new char[strlen(type)+1]; - strcpy(fType,type); - fName = new char[strlen(name)+1]; - strcpy(fName,name); - fNext = 0; -} - -TemplateAtom::~TemplateAtom() -{ - if (fNext) delete fNext; - if (fType) delete []fType; - if (fName) delete []fName; - fType = fName = 0; - fNext = 0; -} - -TemplateItem::TemplateItem() -{ - fName = fNumber = 0; - firstAtom = 0; - fNext = 0; -} - -TemplateItem::TemplateItem(char *name, char *number) -{ - fName = new char[strlen(name)+1]; - strcpy(fName,name); - fNumber = new char[strlen(number)+1]; - strcpy(fNumber,number); - firstAtom = 0; - fNext = 0; -} - -TemplateItem::~TemplateItem() -{ - if (firstAtom) delete firstAtom; - if (fNext) delete fNext; - if (fName) delete []fName; - if (fNumber) delete []fNumber; - fName = fNumber = 0; - firstAtom = 0; - fNext = 0; -} - -void TemplateItem::Append(TemplateAtom *atom) -{ - TemplateAtom *p=firstAtom; - if (p == NULL) { - firstAtom = atom; - return; - } - while (p->fNext != NULL) { - p = p->fNext; - } - p->fNext = atom; -} - -void TemplateItem::Delete(char *name) -{ - TemplateAtom **p = &firstAtom; - while (*p != NULL) { - if (strcasecmp((*p)->fName,name) == 0) break; - p = &(*p)->fNext; - } - if (*p) { - TemplateAtom *old = *p; - *p = (*p)->fNext; - old->fNext = 0; - delete old; - } -} - -TemplateAtom *TemplateItem::Find(char *name) -{ - TemplateAtom *p=firstAtom; - while (p != NULL) { - if (strcasecmp(p->fName,name) == 0) break; - p = p->fNext; - } - return p; -} - -TemplateList::TemplateList() -{ - firstItem = 0; -} - -TemplateList::~TemplateList() -{ - if (firstItem) delete firstItem; -} - -void TemplateList::Append(TemplateItem *item) -{ - TemplateItem *p=firstItem; - if (p == NULL) { - firstItem = item; - return; - } - while (p->fNext != NULL) { - p = p->fNext; - } - p->fNext = item; -} - -void TemplateList::Delete(char *name) -{ - TemplateItem **p = &firstItem; - while (*p != NULL) { - if (strcasecmp((*p)->fName,name) == 0) break; - p = &(*p)->fNext; - } - if (*p) { - TemplateItem *old = *p; - *p = (*p)->fNext; - old->fNext = 0; - delete old; - } -} - -TemplateItem *TemplateList::Find(char *name) -{ - TemplateItem *p=firstItem; - while (p != NULL) { - if (strcasecmp(p->fName,name) == 0) break; - p = p->fNext; - } - return p; -} - -int preProcessFile(ifstream &fin); -int preProcessLine(char *line, ifstream &fin); - -int preProcessFile(ifstream &fin) -{ - char line[250]; - char token[250]; - while (!fin.eof()) { - fin.getline(line,250), ++thisLine; - strcpy(token,line); - strtok(token," "); - if (strcasecmp(token,"end") == 0) break; - preProcessLine(line,fin); - } - return 0; -} - -int preProcessLine(char *line, ifstream &fin) -{ - if ((strlen(line) == 0) || (line[0] == '!')) return 0; - - char* key=strtok(line," "); - if (strcasecmp(key,"database") == 0) { - char *fout=strtok(NULL," "); - strcat(fout,".f"); - fdest.open(fout); - if (!fdest) { - cerr << "gpp error: unable to open output file "; - cerr << fout << endl; - cerr << "bombing out in line " << thisLine; - cerr << " of file " << thisFile << endl; - exit(1); - } - fdest << " " << "program " << strtok(fout,".") << endl; - fdest << " " << "call makeGeometry" << endl; - return 0; - } - - else if (!fdest) { - return 0; - } - - else if (strcasecmp(key,"include") == 0) { - char thisFilePushed[100]; - strncpy(thisFilePushed,thisFile,100); - int thisLinePushed=thisLine; - strncpy(thisFile,strtok(NULL," "),100), thisLine = 0; - ifstream includeFile(thisFile); - preProcessFile(includeFile); - includeFile.close(); - strncpy(thisFile,thisFilePushed,100); - thisLine = thisLinePushed; - } - - else if (strcasecmp(key,"template") == 0) { - char *name=strtok(NULL," ()"); - char *number=strtok(NULL," ()"); - TemplateItem *item = new TemplateItem(name,number); - table.Append(item); - fdest << " " << "end" << endl << endl; - fdest << " " << "subroutine " << name << "Def" << endl; - while (!fin.eof()) { - fin.getline(line,250), ++thisLine; - if ((strlen(line) > 0) && (line[0] != '!')) { - char *type=strtok(line," "); - char *name=strtok(NULL," "); - if (strcasecmp(type,"end") == 0) break; - TemplateAtom *atom = new TemplateAtom(type,name); - item->Append(atom); - } - } - TemplateAtom *a=item->First(); - while (a) { - if (strcasecmp(a->fType,"int") == 0) - fdest << " " << "integer " << a->fName << endl; - else if (strcasecmp(a->fType,"real") == 0) - fdest << " " << "real " << a->fName << endl; - else if (strcasecmp(a->fType,"char") == 0) - fdest << " " << "character*40 " << a->fName << endl; - else if (strcasecmp(a->fType,"material") == 0) - fdest << " " << "character*40 " << a->fName << endl; - a = a->Next(); - } - a = item->First(); - fdest << " " << "common /" << item->fName << "/"; - int col=15+strlen(item->fName); - int needsComma=0; - while (a) { - char vname[100]; - strncpy(vname,a->fName,100); - strtok(vname," ()"); - if ((strcasecmp(a->fType,"int") == 0) || - (strcasecmp(a->fType,"real") == 0) || - (strcasecmp(a->fType,"char") == 0) || - (strcasecmp(a->fType,"material") == 0)) { - if (needsComma++) fdest << ","; - col += strlen(vname)+1; - if (col > 71) { - fdest << endl; - fdest << " + "; - col = strlen(vname)+7; - } - fdest << vname; - } - a = a->Next(); - } - fdest << endl; - } - - else if (strcasecmp(key,"make") == 0) { - char *name = strtok(NULL," "); - TemplateItem *item=table.Find(name); - if (item == NULL) { - cerr << "gpp error: keyword " << name << " not defined!" << endl; - cerr << "bombing out in line " << thisLine; - cerr << " of file " << thisFile << endl; - exit(1); - } - TemplateAtom *a=item->First(); - while (a != NULL) { - char vname[100]; - strncpy(vname,a->fName,100); - char *lasts[100]; - char *numb=strtok_r(vname," ()",lasts); - numb = strtok_r(NULL," ()",lasts); - int nvalu=1; - if (numb) sscanf(numb,"%d",&nvalu); - if ((strcasecmp(a->fType,"child") == 0) || - (strcasecmp(a->fType,"parent") == 0)) nvalu = 0; - for (int i=1; i<=nvalu; i++) { - char *valu=strtok(NULL," "); - if (valu == NULL) { - // cerr << "gpp warning: missing argument"; - // cerr << " in line " << thisLine; - // cerr << " in file " << thisFile << endl; - break; - } - fdest << " " << vname; - if (numb) fdest << "(" << i << ")"; - fdest << " ="; - if (valu[0] == '"') { - while (valu[strlen(valu)-1] != '"') { - fdest << " " << valu; - valu = strtok(NULL," "); - if (valu == NULL) { - cerr << "gpp error: quoted argument unterminated!"; - cerr << endl; - cerr << "bombing out in line " << thisLine; - cerr << " of file " << thisFile << endl; - exit(1); - } - } - } - fdest << " " << valu << endl; - } - a = a->Next(); - } - fdest << " " << "call make" << name << endl; - } - - else { - cerr << "gpp error: keyword " << key << " not valid!" << endl; - cerr << "bombing out in line " << thisFile << endl; - cerr << " of file " << thisFile; - exit(1); - } -} - -void pruneTemplates() -{ - fsource.open(sourceFile); - if (!fsource) { - cerr << "gpp error: unable to open input source file "; - cerr << sourceFile << endl; - exit(1); - } - char line[250]; - char token[250]; - TemplateItem *item = 0; - while (!fsource.eof()) { - fsource.getline(line,250); - strcpy(token,line); - strtok(token," "); - if (strcasecmp(token," subroutine") == 0) { - item = table.Find(strtok(NULL," ")+4); - } - else if (strcasecmp(token," character*40") == 0) { - if (item) { - item->Delete(strtok(NULL," ")); - } - } - else if (strcasecmp(token," real") == 0) { - if (item) { - item->Delete(strtok(NULL," ")); - } - } - else if (strcasecmp(token," integer") == 0) { - if (item) { - item->Delete(strtok(NULL," ")); - } - } - else if (strcasecmp(token," call") == 0) { - char *maker = strtok(NULL," "); - maker[strlen(maker)-3] = 0; - item = table.Find(maker); - if (item) { - TemplateAtom *atom = item->First(); - while (atom != NULL) { - if ((strcasecmp(atom->fType,"child") != 0) && - (strcasecmp(atom->fType,"parent") != 0)) break; - atom = atom->Next(); - } - if (atom == 0) { - table.Delete(item->fName); - } - } - } - else if (strcasecmp(line," end") == 0) { - item = 0; - } - } - fsource.close(); -} - -void postProcessFile() -{ - TemplateItem *item=table.First(); - while (item) { - cerr << ">> Make function for object " << item->fName; - cerr << " not found, dummy subroutine inserted." << endl; - fdest << " " << "end" << endl << endl; - fdest << " " << "subroutine make" << item->fName << endl; - TemplateAtom *a=item->First(); - while (a) { - if (strcasecmp(a->fType,"int") == 0) - fdest << " " << "integer " << a->fName << endl; - else if (strcasecmp(a->fType,"real") == 0) - fdest << " " << "real " << a->fName << endl; - else if (strcasecmp(a->fType,"char") == 0) - fdest << " " << "character*40 " << a->fName << endl; - else if (strcasecmp(a->fType,"material") == 0) - fdest << " " << "character*40 " << a->fName << endl; - a = a->Next(); - } - a = item->First(); - fdest << " " << "common /" << item->fName << "/"; - int col=15+strlen(item->fName); - int needsComma=0; - while (a) { - char vname[100]; - strncpy(vname,a->fName,100); - strtok(vname," ()"); - if ((strcasecmp(a->fType,"int") == 0) || - (strcasecmp(a->fType,"real") == 0) || - (strcasecmp(a->fType,"char") == 0) || - (strcasecmp(a->fType,"material") == 0)) { - if (needsComma++) fdest << ","; - col += strlen(vname)+1; - if (col > 71) { - fdest << endl; - fdest << " + "; - col = strlen(vname)+7; - } - fdest << vname; - } - a = a->Next(); - } - fdest << endl << endl; - fdest << "CC---> add the appropriate GEANT calls here" << endl << endl; - item = item->Next(); - } - fdest << " " << "end" << endl << endl; - fdest << " " << "subroutine makeGeometry" << endl; - item=table.First(); - while (item) { - fdest << " " << "call " << item->fName << "Def" << endl; - item = item->Next(); - } - fdest << " " << "end" << endl; -} - -int main(int argc, char** argv) -{ - for (int arg=1; arg add the appropriate GEANT calls here - - end - - subroutine makeAbsorberBox - character*40 name - character*40 shape - integer type - real xlimit(2) - real ylimit(2) - real xlimit_gap(2) - real ylimit_gap(2) - real z0 - real zlen - character*40 material - common /AbsorberBox/name,shape,type,xlimit,ylimit,xlimit_gap, - + ylimit_gap,z0,zlen,material - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeGeometry - call EMCalDef - call AbsorberBoxDef - end diff --git a/src/programs/Simulation/HDGeant/gpp/mcgeom.f b/src/programs/Simulation/HDGeant/gpp/mcgeom.f deleted file mode 100644 index 5b6e3bd5f6..0000000000 --- a/src/programs/Simulation/HDGeant/gpp/mcgeom.f +++ /dev/null @@ -1,983 +0,0 @@ -* mcgeom.f - materials and geometry definition for Geant simulator -* -* Updates: -* March 14, 2001 original version -rtj -* -* The routines in this file perform the mapping from MCFast detector -* objects to Geant. The match is not perfect, and some decisions have -* to be made in this file about what Geant wants to see. All information -* from the mcfast .db files are made available here, and one can use or -* not use it, as appropriate. To replace the MCFast description with -* your own, you should comment - -* The only check made by gpp during the -* conversion from mcfast is that the parameter list from the mcfast db -* matches the one in the common blocks below. If not, it complains and -* quits. Otherwise it assumes that the subroutine below is correct and -* will use it. If it encounters a detector type in the db that is not -* defined below it includes a stub (dummy) subroutine in its output file -* mcfast.f and warns you that the new volume type is not yet functional. -* That way, things will still compile and run, but the new volume will not -* appear to Geant until some work is done. The dummy subroutine had to be -* cut out of the mcfast.f file, pasted into this file and the appropriate -* snippet of Geant code filled in to define the new detector element. - - - subroutine makedetector - character*40 name - character*40 geom_id - common /detector/name,geom_id - -* makedetector - declare the root volume HALL for Geant's geometry tree - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu - imate = 100 - itmed = 1 - natmed = "atmosphere" - nmat = 15 ! air - isvol = 0 - ifield = 0 - fieldm = 0 - tmaxfd = 0 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - chname = "HALL" - chshap = "BOX " - nmed = itmed - par(1) = 10000 - par(2) = 10000 - par(3) = 10000 - npar = 3 - call GSVOLU(chname,chshap,nmed,par,npar) - origin(1) = 0 - origin(2) = 0 - origin(3) = 0 - KGauss = 0 - end - - subroutine makeMaterial - character*40 name - real a - real z - real density - real radlen - real abslen - real collen - real dedx - common /Material/name,a,z,density,radlen,abslen,collen,dedx - -* makeMaterial - declare a new material to Geant - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf - if (lenocc(name).gt.20) then - write(6,*) "makeMaterial warning: material name '", - + name(1:lenocc(name)), - + "' longer than the Geant limit of 20 chars" - endif - imate = imate+1 - chnama = name - aa(1) = a - zz(1) = z - dens = density - radl = radlen - absl = abslen - vbuf(1) = collen - vbuf(2) = dedx - nvbuf = 2 - call GSMATE(imate,chnama,a,z,density,radlen,abslen,vbuf,nvbuf) - end - - subroutine makeMixture - character*40 name - integer nmat - character*40 matnames(5) - real prop(5) - common /Mixture/name,nmat,matnames,prop - -* makeMixture - declare a new material as a mixture of known materials -* Here I assume that the prop() above specifies mixtures in terms -* of the proportion by weight, otherwise I don't know how to get -* the density of the mixture for the general case. - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf - real specvol - character*20 matname - integer m,im - specvol = 0 - do m=1,nmat - matname = matnames(m) - do im=101,imate - call GFMATE(im,chnama,aa(m),zz(m),dens,radl,absl,vbuf,nvbuf) - if (matname.eq.chnama) goto 2 - end do - write(6,*) "makeMixture error: undefined material ", - + matname(1:lenocc(matname))," in mixture!" - STOP - 2 continue - specvol = specvol + prop(m)/dens - end do - imate = imate+1 - if (lenocc(name).gt.20) then - write(6,*) "makeMixture warning: material name '", - + name(1:lenocc(name)), - + "' longer than the Geant limit of 20 chars" - endif - chnama = name - dens = 1/specvol - call GSMIXT(imate,chnama,aa,zz,dens,nmat) - end - - subroutine makeBPipe - character*40 name - real rmin - real rmax - real z0 - real zlen - character*40 mat_fill - real bndrthk(4) - character*40 matrbnd(4) - common /BPipe/name,rmin,rmax,z0,zlen,mat_fill,bndrthk,matrbnd - -* makeBPipe - defines the beam pipe running through the apparatus - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - do i=1,4 - itmed = itmed+1 - natmed = "pipe-"//matrbnd(i) - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (matrbnd(i).eq.chnama) goto 2 - end do - write(6,*) "makeBPipe error: undefined material ", - + matrbnd(i)(1:lenocc(matrbnd(i)))," in BPipe!" - STOP - 2 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - enddo - itmed = itmed+1 - natmed = "pipe-"//mat_fill - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (mat_fill.eq.chnama) goto 4 - end do - write(6,*) "makeBPipe error: undefined material ", - + mat_fill(1:lenocc(mat_fill))," in BPipe!" - STOP - 4 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - if (lenocc(name).gt.4) then - write(6,*) "makeBPipe warning: volume '", - + name(1:lenocc(name)), - + "' longer than the Geant limit of 4 chars" - endif - chname = name - chshap = "TUBE" - par(1) = rmin - par(2) = rmax - par(3) = zlen/2 - npar = 3 - nmed = itmed - call GSVOLU(chname,chshap,nmed,par,npar) - nr = 1 - chmoth = "HALL" - xc = -origin(1) - yc = -origin(2) - zc = z0+par(3)-origin(3) - irot = 1 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - chmoth = chname - if (bndrthk(1).gt.0) then - nmed = itmed-4 - write(chname,"(a1,i3.3)") "B",nmed - chshap = "TUBE" - par(1) = rmin - par(2) = rmin+bndrthk(1) - call GSVOLU(chname,chshap,nmed,par,npar) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (bndrthk(2).gt.0) then - nmed = itmed-3 - write(chname,"(a1,i3.3)") "B",nmed - chshap = "TUBE" - par(1) = rmax-bndrthk(2) - par(2) = rmax - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = 0 - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (bndrthk(3).gt.0) then - nmed = itmed-2 - write(chname,"(a1,i3.3)") "B",nmed - par(1) = rmin - par(2) = rmax - par(3) = bndrthk(3)/2 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (bndrthk(4).gt.0) then - nmed = itmed-1 - write(chname,"(a1,i3.3)") "B",nmed - par(1) = rmin - par(2) = rmax - par(3) = bndrthk(4)/2 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+zlen-par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - end - - subroutine makeSolenoid - character*40 name - real bfield - real rmin - real rmax - real z0 - real zlen - character*40 mat_fill - real thick_boun(4) - character*40 mat_boun(4) - common /Solenoid/name,bfield,rmin,rmax,z0,zlen,mat_fill, - + thick_boun,mat_boun - -* makeSolenoid - define the solenoidal magnet to Geant - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - do i=1,4 - itmed = itmed+1 - natmed = "soln-"//mat_boun(i) - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (mat_boun(i).eq.chnama) goto 2 - end do - write(6,*) "makeSolenoid error: undefined material ", - + mat_boun(i)(1:lenocc(mat_boun(i)))," in Solenoid!" - STOP - 2 continue - isvol = 0 - ifield = 3 - fieldm = bfield*10 - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - enddo - itmed = itmed+1 - natmed = "soln-"//mat_fill - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (mat_fill.eq.chnama) goto 4 - end do - write(6,*) "makeSolenoid error: undefined material ", - + mat_fill(1:lenocc(mat_fill))," in Solenoid!" - STOP - 4 continue - isvol = 0 - ifield = 3 - fieldm = bfield*10 - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - if (lenocc(name).gt.4) then - write(6,*) "makeSolenoid warning: volume name '", - + name(1:lenocc(name)), - + "' longer than the Geant limit of 4 chars" - endif - chname = name - chshap = "TUBE" - par(1) = rmin - par(2) = rmax - par(3) = zlen/2 - npar = 3 - nmed = itmed - call GSVOLU(chname,chshap,nmed,par,npar) - nr = 1 - chmoth = "HALL" - xc = -origin(1) - yc = -origin(2) - zc = z0+par(3)-origin(3) - irot = 1 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - chmoth = chname - if (thick_boun(1).gt.0) then - nmed = itmed-4 - write(chname,"(a1,i3.3)") "S",nmed - par(2) = rmin - par(2) = rmin+thick_boun(1) - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = 0 - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(2).gt.0) then - nmed = itmed-3 - write(chname,"(a1,i3.3)") "S",nmed - par(1) = rmax-thick_boun(2) - par(2) = rmax - nmed = itmed-3 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = 0 - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(3).gt.0) then - nmed = itmed-2 - write(chname,"(a1,i3.3)") "S",nmed - par(1) = rmin - par(2) = rmax - par(3) = thick_boun(3)/2 - nmed = itmed-2 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(4).gt.0) then - nmed = itmed-1 - write(chname,"(a1,i3.3)") "S",nmed - par(1) = rmin - par(2) = rmax - par(3) = thick_boun(4)/2 - nmed = itmed-1 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+zlen-par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - origin(1) = 0 - origin(2) = 0 - origin(3) = z0+zlen/2 - KGauss = fieldm - end - - subroutine makeDrift - integer num - character*40 name - integer num_anode - integer num_cathode - real rmin - real rmax - real z0 - real zlen - character*40 material - real thick_boun(4) - character*40 mat_boun(4) - common /Drift/num,name,num_anode,num_cathode,rmin,rmax,z0,zlen, - + material,thick_boun,mat_boun - -* makeDrift - declare a new cylindrical drift chamber - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - do i=1,4 - itmed = itmed+1 - natmed = "drift-"//mat_boun(i) - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (mat_boun(i).eq.chnama) goto 2 - end do - write(6,*) "makeDrift error: undefined material ", - + mat_boun(i)(1:lenocc(mat_boun(i)))," in Drift!" - STOP - 2 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - enddo - itmed = itmed+1 - natmed = "drift-"//material - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (material.eq.chnama) goto 4 - end do - write(6,*) "makeDrift error: undefined material ", - + material(1:lenocc(material))," in Drift!" - STOP - 4 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - write(chname,"(A2,i2.2)") "DC",num - chshap = "TUBE" - par(1) = rmin - par(2) = rmax - par(3) = zlen/2 - npar = 3 - nmed = itmed - call GSVOLU(chname,chshap,nmed,par,npar) - call GSATT(chname,"NODE",float(nmed)) - nr = 1 - chmoth = "HALL" - xc = -origin(1) - yc = -origin(2) - zc = z0+par(3)-origin(3) - irot = 1 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - chmoth = chname - if (thick_boun(1).gt.0) then - nmed = itmed-4 - write(chname,"(a1,i3.3)") "D",nmed - par(1) = rmin - par(2) = rmin+thick_boun(1) - call GSVOLU(chname,chshap,nmed,par,npar) - par(2) = rmax - xc = 0 - yc = 0 - zc = 0 - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(2).gt.0) then - nmed = itmed-3 - write(chname,"(a1,i3.3)") "D",nmed - par(1) = rmax-thick_boun(2) - par(2) = rmax - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = 0 - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(3).gt.0) then - nmed = itmed-2 - write(chname,"(a1,i3.3)") "D",nmed - par(1) = rmin - par(2) = rmax - par(3) = thick_boun(3)/2 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - if (thick_boun(4).gt.0) then - nmed = itmed-1 - write(chname,"(a1,i3.3)") "D",nmed - par(1) = rmin - par(2) = rmax - par(3) = thick_boun(4)/2 - call GSVOLU(chname,chshap,nmed,par,npar) - xc = 0 - yc = 0 - zc = z0+zlen-par(3) - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - endif - end - - subroutine makeLayerDRFAno - integer det - integer lyr - real radius - real zlen - real cell_height - integer nwires - integer ID_readout - integer ID_cathode - real phi0 - real stereo_tau - real stereo_offset - real eff_hit - real eff_dedx - real siga - real sigb - real sigc - common /LayerDRFAno/det,lyr,radius,zlen,cell_height,nwires, - + ID_readout,ID_cathode,phi0,stereo_tau,stereo_offset,eff_hit, - + eff_dedx,siga,sigb,sigc - -* makeLayerDRFAno - declare an anode layer for cylindrical drift chamber - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - write(chmoth,"(a2,i2.2)") "DC",det - call GFATT(chmoth,"NODE",float(nmed)) - write(chname,"(a1,i3.3)") "A",det*10+lyr - chshap = "TUBE" - par(1) = radius-cell_height/2 - par(2) = radius+cell_height/2 - par(3) = zlen/2 - npar = 3 - call GSVOLU(chname,chshap,nmed,par,npar) - nr = 1 - xc = 0 - yc = 0 - zc = 0 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - chmoth = chname - write(chname,"(a1,i3.3)") "L",det*10+lyr - call GSDVN2(chname,chmoth,nwires,2,phi0,nmed) - end - - subroutine makeOffsetDRFAno - integer det - integer lyr - real cell_offset - real sag - real offset(3) - real dircos(3) - common /OffsetDRFAno/det,lyr,cell_offset,sag,offset,dircos - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeLayerDRFCatho - integer det - integer lyr - real delta_r - real zlen - integer nstrips - integer n_phi_segm - integer ID_anode - integer cell_offset - real eff_hit - real resa - real resb - real resc - common /LayerDRFCatho/det,lyr,delta_r,zlen,nstrips,n_phi_segm, - + ID_anode,cell_offset,eff_hit,resa,resb,resc - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeAbsorber - character*40 name - character*40 shape - integer type - real rmin(2) - real rmax(2) - real z0 - real zlen - character*40 material - common /Absorber/name,shape,type,rmin,rmax,z0,zlen,material - -* makeAbsorber - declare a region containing passive material - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - itmed = itmed+1 - natmed = material - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (natmed.eq.chnama) goto 2 - end do - write(6,*) "makeAbsorber error: undefined material ", - + natmed(1:lenocc(natmed))," in Absorber!" - STOP - 2 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - nmed = itmed - if (lenocc(name).gt.4) then - write(6,*) "makeAbsorber warning: volume name '", - + name(1:lenocc(name)), - + "' longer than the Geant limit of 4 chars" - endif - chname = name - chshap = shape - par(1) = rmin(1) - par(2) = rmax(1) - par(3) = zlen/2 - npar = 3 - call GSVOLU(chname,chshap,nmed,par,npar) - nr = 1 - chmoth = "LASS" - xc = -origin(1) - yc = -origin(2) - zc = z0+par(3)-origin(3) - irot = 1 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - end - - subroutine makeSiDisk - integer num - character*40 name - integer nlyr - real zpos - common /SiDisk/num,name,nlyr,zpos - -* makeSiDisk - declare a new disk-shaped detector (not necessarily silicon) - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - write(chname,"(a3,i1)") "FDC",num - chshap = "TUBE" - npar = 0 - nmed = 1 ! atmosphere - call GSVOLU(chname,chshap,nmed,par,npar) - call GSATT(chname,"NODE",zpos) - end - - subroutine makeLayerSiDi - integer det - integer lyr - character*40 mat - integer nwed - real z_local - real thick - real rmin - real rmax - real phi(2) - real dphi - integer type - common /LayerSiDi/det,lyr,mat,nwed,z_local,thick,rmin,rmax,phi, - + dphi,type - -* makeLayerSiDi - declare a layer for disk-shaped volume (not only silicon) - - real origin(3),KGauss - common /environ/origin,KGauss -common arguments for calls to gsmate - integer imate - character*20 chnama - real aa(99),zz(99),dens,radl,absl,vbuf(99),nvbuf - common /cgsmate/ imate,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf -common arguments for calls to gstmed - integer itmed,nmat,isvol,ifield,nwbuf - real fieldm,tmaxfd,stemax,deemax,epsil,stmin,ubuf(99) - character*20 natmed - common /cgstmed/itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf -common arguments for calls to gsvolu - character*4 chname,chshap - integer nmed,npar,ivolu - real par(12) - common /cgsvolu/chname,chshap,nmed,par,npar,ivolu -common arguments for calls to gspos - integer nr,irot - character*4 chmoth,chonly - real xc,yc,zc - common /cgspos/nr,chmoth,xc,yc,zc,irot,chonly - write(chmoth,"(a3,i1)") "FDC",det - call GFATT(chmoth,"NODE",zc) - if (zc.ne.999.99) then - call GSATT(chmoth,"NODE",999.99) - nr = 1 - xc = -origin(1) - yc = -origin(2) - zc = zc-origin(3) - irot = 1 - chonly = "ONLY" - npar = 3 - call GSPOSP(chmoth,nr,"LASS",xc,yc,zc,irot,chonly,par,npar) - endif - itmed = itmed+1 - natmed = "sidi-"//mat - do nmat=101,imate - call GFMATE(nmat,chnama,aa,zz,dens,radl,absl,vbuf,nvbuf) - if (mat.eq.chnama) goto 2 - end do - write(6,*) "makeLayerSiDi error: undefined material ", - + mat(1:lenocc(natmed))," in LayerSiDi!" - STOP - 2 continue - isvol = 0 - ifield = 3 - fieldm = KGauss - tmaxfd = 10 - stemax = 0 - deemax = 0 - epsil = 1e-3 - stmin = 0 - nwbuf = 0 - call GSTMED(itmed,natmed,nmat,isvol,ifield,fieldm,tmaxfd,stemax, - + deemax,epsil,stmin,ubuf,nwbuf) - write(chname,"(a1,i3.3)") "P",det*10+lyr - chshap = "TUBE" - par(1) = rmin - par(2) = rmax - par(3) = thick/2 - npar = 3 - nmed = itmed - call GSVOLU(chname,chshap,nmed,par,npar) - nr = 1 - xc = 0 - yc = 0 - zc = z_local - irot = 1 - chonly = "ONLY" - call GSPOS(chname,nr,chmoth,xc,yc,zc,irot,chonly) - chmoth = chname - write(chname,"(a1,i3.3)") "W",nmed - step = (phi(2)-phi(1))/nwed *180/3.1416 - phi0 = dphi *180/3.1416 - call GSDVT2(chname,chmoth,step,phi0,nmed,0) - end - - subroutine makeWedge - character*40 speci - integer det - integer lyr - integer nwed - integer nstrip - real c0_r - real c0_phi - real pitch - real stereo - real eff_hit - real siga - real sigb - real sigc - common /Wedge/speci,det,lyr,nwed,nstrip,c0_r,c0_phi,pitch,stereo, - + eff_hit,siga,sigb,sigc - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeHitsOnTrack - integer all - integer z - integer svx - common /HitsOnTrack/all,z,svx - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeBeamVrtx - real xyz(3) - real sig(3) - common /BeamVrtx/xyz,sig - -CC---> add the appropriate GEANT calls here - - end - - subroutine makeGeometry - call detectorDef - call MaterialDef - call MixtureDef - call SolenoidDef - call BPipeDef - call DriftDef - call LayerDRFAnoDef - call OffsetDRFAnoDef - call LayerDRFCathoDef - call AbsorberDef - call SiDiskDef - call LayerSiDiDef - call WedgeDef - call HitsOnTrackDef - call BeamVrtxDef - end diff --git a/src/programs/Simulation/HDGeant/gsrotm.F_obsolete b/src/programs/Simulation/HDGeant/gsrotm.F_obsolete deleted file mode 100644 index 0a7b7a410c..0000000000 --- a/src/programs/Simulation/HDGeant/gsrotm.F_obsolete +++ /dev/null @@ -1,231 +0,0 @@ -* -* $Id: gsrotm.F 9065 2012-04-26 12:37:45Z staylor $ -* -* $Log$ -* Revision 1.4 2005/08/25 12:22:05 davidl -* Commented out lines 113-115 since they also can never be reached, leading to compiler warnings from solaris compiler -* -* Revision 1.3 2005/08/05 18:46:22 davidl -* Commented out lines 97-109 since they can never be reached. This was indicated by the SunOS compiler -* -* Revision 1.2 2001/11/12 23:02:44 brash -* Found a small bug in my original modification to this routine, which -* exists only here for the alpha BTW. The bug was that I was checking for small -* values of rotation matrix elements, to avoid fpe's, and I should have been -* checking for small ABSOLUTE values, since of course the matrix elements can -* be negative. -* -* Revision 1.1 2001/10/04 06:20:57 brash -* This routine is part of the cern library, but suffered arithmetic errors on the alpha. I changed this file to trap these situations. EJB -* -* Revision 1.1.1.1 1995/10/24 10:20:56 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 02/07/94 18.24.47 by S.Giani -*-- Author : - SUBROUTINE GSROTM(NMAT,THETA1,PHI1,THETA2,PHI2,THETA3,PHI3) -C. -C. ****************************************************************** -C. * * -C. * STORE ROTATION MATRICES * -C. * * -C. * ==>Called by : * -C. * Author R.Brun ********* * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcunit.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcnum.inc" - DIMENSION ANGLES(6),IP(3) - SAVE SINMIN -#if defined(CERNLIB_SINGLE) - DIMENSION ROTMAT(9) - PARAMETER (ONE=1.0,ZERO=0.0) - DATA SINMIN/1.00E-5/ -#endif -#if !defined(CERNLIB_SINGLE) - DOUBLE PRECISION ROTMAT(9),ONE,ZERO -c DOUBLE PRECISION PROD1,PROD2,PROD3,HMOD,SINMIN - DOUBLE PRECISION PROD1,HMOD,SINMIN - PARAMETER (ONE=1.D0,ZERO=0.D0) - DATA SINMIN/1.00D-5/ -#endif -C. -C. ------------------------------------------------------------------ -C. - IF(NMAT.LE.0)GO TO 999 - IF(JROTM.LE.0)CALL MZBOOK(IXCONS,JROTM,JROTM,1,'ROTM',NROTM,NROTM, - +0,3,0) - IF(NMAT.GT.IQ(JROTM-2)) THEN - NPUSH=NMAT-IQ(JROTM-2)+50 - CALL MZPUSH(IXCONS,JROTM,NPUSH,0,'I') - NROTM=IQ(JROTM-2) - JR1=0 - ELSE - JR1=LQ(JROTM-NMAT) - IF(JR1.GT.0)THEN - WRITE(CHMAIL,1000) - CALL GMAIL(1,0) - CALL GPROTM(NMAT) - CALL MZDROP(IXCONS,LQ(JROTM-NMAT),' ') - ENDIF - ENDIF - CALL MZBOOK(IXCONS,JR,JROTM,-NMAT,'ROTM',0,0,16,3,0) -C - Q(JR + 11) = THETA1 - Q(JR + 12) = PHI1 - Q(JR + 13) = THETA2 - Q(JR + 14) = PHI2 - Q(JR + 15) = THETA3 - Q(JR + 16) = PHI3 -C - DO 10 N = 1,3 - THERAD = Q(JR+ 9+2*N)*DEGRAD - PHIRAD = Q(JR+10+2*N)*DEGRAD - SINTHE = SIN(THERAD) - Q(JR+3*N-2) = SINTHE * COS(PHIRAD) - Q(JR+3*N-1) = SINTHE * SIN(PHIRAD) - Q(JR+3*N ) = COS(THERAD) - if(abs(Q(JR+3*N-2)).le.1.0E-10) Q(JR+3*N-2)=0.0 - if(abs(Q(JR+3*N-1)).le.1.0E-10) Q(JR+3*N-1)=0.0 - if(abs(Q(JR+3*N )).le.1.0E-10) Q(JR+3*N )=0.0 - CALL VUNIT (Q(JR+3*N-2),Q(JR+3*N-2),3) - 10 CONTINUE -C. -C.--- Test orthonormality - DO 20 J=1,9 - ROTMAT(J)=Q(JR+J) - 20 CONTINUE - goto 110 -c PROD2=ZERO -C. -C. X - Y -c PROD1= -c +ROTMAT(1)*ROTMAT(4)+ROTMAT(2)*ROTMAT(5)+ROTMAT(3)*ROTMAT(6) -c IF(ABS(PROD1).GT.SINMIN) GO TO 30 -C. -C. X - Z -c PROD2= -c +ROTMAT(1)*ROTMAT(7)+ROTMAT(2)*ROTMAT(8)+ROTMAT(3)*ROTMAT(9) -c IF(ABS(PROD2).GT.SINMIN) GO TO 30 -C. -C. Y - Z -C PROD3= -C +ROTMAT(7)*ROTMAT(4)+ROTMAT(8)*ROTMAT(5)+ROTMAT(9)*ROTMAT(6) -C IF(ABS(PROD3).LE.SINMIN) GO TO 110 -c 30 CONTINUE -C. -C.--- Orthonormalization needed -C. -C. Assume X correct - HMOD=ZERO - DO 40 J=4,6 - ROTMAT(J)=ROTMAT(J)-ROTMAT(J-3)*PROD1 - HMOD=HMOD+ROTMAT(J)*ROTMAT(J) - 40 CONTINUE - HMOD=ONE/SQRT(HMOD) - DO 50 J=4,6 - ROTMAT(J)=ROTMAT(J)*HMOD - 50 CONTINUE -C. -C. Y done, do Z -C. -* IF(PROD2.EQ.ZERO) THEN -* PROD2= -* + ROTMAT(1)*ROTMAT(7)+ROTMAT(2)*ROTMAT(8)+ROTMAT(3)*ROTMAT(9) -* ENDIF -* PROD3= -* +ROTMAT(4)*ROTMAT(7)+ROTMAT(5)*ROTMAT(8)+ROTMAT(6)*ROTMAT(9) -* HMOD = ZERO -* DO 60 J=1,3 -* ROTMAT(J+6)=ROTMAT(J+6)-ROTMAT(J+3)*PROD3-ROTMAT(J)*PROD2 -* HMOD = HMOD+ROTMAT(J)*ROTMAT(J) -* 60 CONTINUE -* == AV == - ROTMAT(7) = ROTMAT(2)*ROTMAT(6) - ROTMAT(3)*ROTMAT(5) - ROTMAT(8) = ROTMAT(3)*ROTMAT(4) - ROTMAT(1)*ROTMAT(6) - ROTMAT(9) = ROTMAT(1)*ROTMAT(5) - ROTMAT(2)*ROTMAT(4) - HMOD = ZERO + ROTMAT(7)*ROTMAT(7) + ROTMAT(8)*ROTMAT(8) - & + ROTMAT(9)*ROTMAT(9) -* == AV == -C -C EJB - Added the following traps for HMOD, to solve arithmetic -C problems on the alpha. -C - if(hmod.lt.0) then - write(*,*)'WARNING !!!!!!!! HMOD < 0, taking abs. value' - hmod=abs(hmod) - endif - if(hmod.eq.0) then - write(*,*)'WARNING !!!!!!!! HMOD = 0, making it 1.0' - hmod=1.0 - endif -C -C - HMOD = ONE/SQRT(HMOD) - DO 70 J=7,9 - ROTMAT(J) = ROTMAT(J)*HMOD - 70 CONTINUE -C. -C. Put back the matrix in place - DO 80 J=1,9 - Q(JR+J)=ROTMAT(J) - 80 CONTINUE -C. -C. Now recompute the angles - DO 90 J=1,3 - ANGLES(J*2-1) = ACOS(MAX(-ONE,MIN(ONE,ROTMAT(J*3))))*RADDEG - ANGLES(J*2) = ZERO - IF(ROTMAT(J*3-1).NE.ZERO) THEN - ANGLES(J*2) = ATAN2(ROTMAT(J*3-1),ROTMAT(J*3-2))*RADDEG - IF(ANGLES(2*J).LT.0.0) ANGLES(2*J) = ANGLES(2*J)+360.0 - ENDIF - 90 CONTINUE - WRITE(CHMAIL,2000) NMAT - CALL GMAIL(1,2) - WRITE(CHMAIL,2001) (Q(JR+10+J),J=1,6) - CALL GMAIL(0,0) - WRITE(CHMAIL,2002) ANGLES - CALL GMAIL(0,1) -C. -C. Put back the angles in place - DO 100 J=1,6 - Q(JR+10+J) = ANGLES(J) - 100 CONTINUE -C. -C.--- Orthonormalization ended - 110 CONTINUE -C - DO 130 J = 1,3 - IP(J) = 3 - JJR=JR+J*3-3 -C - DO 120 I = 1,3 - IF(ABS(Q(JJR+I)).LT.0.99999) GO TO 120 -C - IP(J) = I + 3 - IF(Q(JJR+I).GE.0.) GO TO 130 -C - IP(J) = 3 - I - GO TO 130 -C - 120 CONTINUE - 130 CONTINUE -C - Q(JR + 10) = IP(1) + 10* IP(2) + 100* IP(3) -C - IF(JR1.GT.0) THEN - CALL GPROTM(-NMAT) - ENDIF -C -1000 FORMAT(' *** GSROTM ***: Warning, rotation matrix redefinition:') -2000 FORMAT(' *** GSROTM ***: ', - + 'Parameters of matrix no. ',I4,' changed:') -2001 FORMAT(' Old values: ',6(F14.7,3X)) -2002 FORMAT(' New values: ',6(F14.7,3X)) - 999 RETURN - END diff --git a/src/programs/Simulation/HDGeant/gsstak.F b/src/programs/Simulation/HDGeant/gsstak.F deleted file mode 100644 index 4c5418b6f9..0000000000 --- a/src/programs/Simulation/HDGeant/gsstak.F +++ /dev/null @@ -1,140 +0,0 @@ -* -* $Id: gsstak.F,v 1.1 2006/04/15 04:38:38 jonesrt Exp $ -* -* $Log: gsstak.F,v $ -* Revision 1.1 2006/04/15 04:38:38 jonesrt -* gltrac.F, gsstak.F -* - replacements for geant321 library functions that enable stacking of -* secondaries with repeat counts and saving of ISTORY on the stack, -* both for the purposes of enabling cascaded simulations. [rtj] -* gustep.F -* - new code to support electron beam dump simulations with a two-level -* cascade to enhance the statistics of dump-related backgrounds. [rtj] -* taggerCoords2.xls -* - updates to the dimensions of the building and electron beam dump. [rtj] -* hdds/Spectrometer.xml, hdds/TaggerArea.xml -* - new geometry description including the electron beam dump attached -* by a corridor to the tagger building. [rtj] -* hdds/Makefile hdds/ElectronDump.xml -* - added new document to describe the electron beam dump geometry [rtj] -* gxtwist, gxtwist++, hdgeant [deleted] -* - binary files removed from repository [rtj] -* -* Revision 1.1.1.1 1995/10/24 10:21:43 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.23 by S.Giani -*-- Author : - SUBROUTINE GSSTAK (IFLAG) -C. -C. ****************************************************************** -C. * * -C. * SUBR. GSSTAK (IFLAG) * -C. * * -C. * Stores in auxiliary stack JSTAK the particle currently * -C. * described in common /GCKINE/. * -C. * * -C. * On request, creates also an entry in structure JKINE : * -C. * IFLAG = * -C. * 0 : No entry in JKINE structure required (user) * -C. * 1 : New entry in JVERTX / JKINE structures required (user) * -C. * <0 : New entry in JKINE structure at vertex -IFLAG (user) * -C. * 2 : Entry in JKINE structure exists already (from GTREVE) * -C. * * -C. * Called by : GSKING, GTREVE * -C. * Author : S.Banerjee, F.Bruyant * -C. * * -C. ****************************************************************** -C. -#define USE_UPWGHT_AS_REPEAT_COUNT 1 -* -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcmzfo.inc" -#include "geant321/gcnum.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctrak.inc" -#if defined(CERNLIB_USRJMP) -#include "geant321/gcjump.inc" -#endif -* - COMMON/VTXKIN/NVTX,ITR - DIMENSION UBUF(1) - DATA UBUF/0./ -C. -C. ------------------------------------------------------------------ -* - IF (IPART.LE.0.OR.IPART.GT.NPART) THEN - PRINT *, ' GSSTAK - Unknown particle code, skip track ', IPART - GO TO 999 - ENDIF -* -* *** Give control to user for track selection -* -#if !defined(CERNLIB_USRJMP) - CALL GUSKIP(ISKIP) -#endif -#if defined(CERNLIB_USRJMP) - CALL JUMPT1(JUSKIP,ISKIP) -#endif - IF (ISKIP.NE.0) GO TO 999 -* -* *** Check if an entry in JKINE structure is required -* - IF (IFLAG.EQ.1) THEN - CALL GSVERT (VERT, ITRA, 0, UBUF, 0, NVTX) - CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR) - ELSE IF (IFLAG.LT.0) THEN - NVTX = -IFLAG - CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR) - ELSE - IF (IFLAG.EQ.0) THEN -* Store -ITRA in stack for a track without entry in JKINE - ITR = -ITRA - ELSE - ITR = ITRA - ENDIF - ENDIF -* -* *** Store information in stack -* - IF (JSTAK.EQ.0) THEN - NDBOOK = NTSTKP*NWSTAK +3 - NDPUSH = NTSTKS*NWSTAK - CALL MZBOOK (IXCONS,JSTAK,JSTAK,1,'STAK', 0,0,NDBOOK, IOSTAK,3) - IQ(JSTAK+2) = NTSTKP - ELSE IF (IQ(JSTAK+1).EQ.IQ(JSTAK+2)) THEN - CALL MZPUSH (IXCONS, JSTAK, 0, NDPUSH, 'I') - IQ(JSTAK+2) = IQ(JSTAK+2) +NTSTKS - ENDIF -* - JST = JSTAK +IQ(JSTAK+1)*NWSTAK +3 - IQ(JSTAK+1) = IQ(JSTAK+1) +1 - IF (IQ(JSTAK+3).EQ.0) IQ(JSTAK+3) = IQ(JSTAK+1) - IF (IQ(JSTAK+1).GT.NSTMAX) NSTMAX = IQ(JSTAK+1) -* - IQ(JST+1) = ITR - IQ(JST+2) = IPART -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - IQ(JST+3) = ISTORY -#else - IQ(JST+3) = 0 -#endif - DO 90 I = 1,3 - Q(JST+3+I) = VERT(I) - Q(JST+6+I) = PVERT(I) - 90 CONTINUE - Q(JST+10) = TOFG - Q(JST+11) = SAFETY - Q(JST+12) = UPWGHT -* -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - NALIVE = INT(NALIVE + UPWGHT) -#else - NALIVE = NALIVE +1 -#endif -* END GSSTAK - 999 END diff --git a/src/programs/Simulation/HDGeant/gthion.F b/src/programs/Simulation/HDGeant/gthion.F deleted file mode 100644 index 8d8b009893..0000000000 --- a/src/programs/Simulation/HDGeant/gthion.F +++ /dev/null @@ -1,564 +0,0 @@ -*---------------------------------------------------------------------- -* fix by rtj: If material is vacuum then it might be defined with -* atomic number A=0. Introduce a fix to prevent divide -* by zero, and set atomic number to that of hydrogen in -* the case where one finds A=0, because vacuum is defined -* by density=0, not by A=0. -*---------------------------------------------------------------------- - -#include "geant321/pilot.h" -*CMZ : 3.21/02 03/07/94 17.58.49 by S.Giani -*-- Author : - SUBROUTINE GTHION -C. -C. ****************************************************************** -C. * * -C. * Heavy ion type track. Computes step size and propagates * -C. * particle through step. * -C. * * -C. * The ionisation energy loss is calculated here (mean + * -C. * fluctuations) * -C. * The fluctuations are the same for ILOSS=1,2,3 and * -C. * there is no fluctuation for ILOSS=4. * -C. * * -C. * ==>Called by : GTRACK * -C. * Authors R.Brun, F.Bruyant, M.Maire, L.Urban *** * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gccuts.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gcmate.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcunit.inc" -#if defined(CERNLIB_USRJMP) -#include "geant321/gcjump.inc" -#endif - -#if !defined(CERNLIB_OLD) -#include "geant321/gcvolu.inc" -#include "geant321/gcvdma.inc" -#endif -#if !defined(CERNLIB_SINGLE) - PARAMETER (EPSMAC=1.E-6) - DOUBLE PRECISION GKR,DEMEAN,STOPP,STOPMX,STOPRG,STOPC,EKIPR - DOUBLE PRECISION ONE,XCOEF1,XCOEF2,XCOEF3,YCOEF1,YCOEF2,YCOEF3 -#endif -#if defined(CERNLIB_SINGLE) - PARAMETER (EPSMAC=1.E-11) -#endif - PARAMETER (THRESH=0.7,ONE=1) - PARAMETER (TWOTHR=REAL(2*ONE/3),AMU=0.9314943) - PARAMETER (DME=7.84572E-8,CNORM=2.5) - REAL VNEXT(6) - DIMENSION RNDM(2) - SAVE RMASS,CUTPRO,IKCUT,STOPC,FACFLU,CHAR23 -C. -C. ------------------------------------------------------------------ -* -* *** Particle below energy threshold ? short circuit -* - IF (GEKIN.LE.CUTHAD) GO TO 100 -* -* *** Update local pointers if medium has changed -* - IF (IUPD.EQ.0) THEN - IUPD = 1 - JLOSS = LQ(JMA-3) - JRANG = LQ(JMA-16) + NEK1 - JCOEF = LQ(JMA-18) + 3*NEK1 - RMASS = REAL(PMASS/AMASS) - CUTPRO = MAX(CUTHAD*RMASS,ELOW(1)) - IKCUT = INT(GEKA*LOG10(CUTPRO) + GEKB) - GKR = (CUTPRO - ELOW(IKCUT))/(ELOW(IKCUT+1) - ELOW(IKCUT)) - STOPC = (1.-GKR)*Q(JRANG+IKCUT) + GKR*Q(JRANG+IKCUT+1) - if(a.eq.0) a=1.007970 - FACFLU = DME*(Z*DENS/A) - CHAR23 = REAL(ONE/CHARGE**TWOTHR) - IF(IMCKOV.EQ.1) THEN - JTCKOV = LQ(JTM-3) - JABSCO = LQ(JTCKOV-1) - JEFFIC = LQ(JTCKOV-2) - JINDEX = LQ(JTCKOV-3) - JCURIN = LQ(JTCKOV-4) - NPCKOV = INT(Q(JTCKOV+1)) - ENDIF - ENDIF -* -* *** Compute energy dependent parameters -* - GAMASS=GETOT+AMASS - BET2=GEKIN*GAMASS/(GETOT*GETOT) - BET=SQRT(BET2) - W1=1.034-0.1777*EXP(-0.08114*CHARGE) - W2=BET*CHAR23 - W3=121.4139*W2+0.0378*SIN(190.7165*W2) - CHARG1=CHARGE*(1.-W1*EXP(-W3)) -* -* the effective charge CHARG1 -* can be negative only for very low energy and -* for CHARGE > 20 ( very low energy : T/A < 20 keV/nucleon) -* in this case short circuit -* - IF(CHARG1.LT.0.) GOTO 100 - CHARG2=CHARG1**2 -* - OMCMOL=Q(JPROB+21)*CHARG2 - CHCMOL=Q(JPROB+25)*ABS(CHARG1) - IF(FIELDM.NE.0.) THEN - CFLD=REAL(3333.*DEGRAD*TMAXFD/ABS(FIELDM*CHARG1)) - ELSE - CFLD=BIG - ENDIF -* -* *** Compute current step size -* - STEP = STEMAX - IPROC = 103 - GEKRT1 = 1. -GEKRAT -* -* ** Step limitation due to hadron interaction ? -* - IF (IHADR.GT.0) THEN -#if !defined(CERNLIB_USRJMP) - CALL GUPHAD -#endif -#if defined(CERNLIB_USRJMP) - CALL JUMPT0(JUPHAD) -#endif - IF (SHADR.LT.STEP) THEN - IF (SHADR.LE.0.) SHADR = PREC - STEP = SHADR - IPROC = 12 - ENDIF - ENDIF -* -* ** Step limitation due to delta-ray production ? -* (Cannot be tabulated easily because dependent on AMASS) -* - IF (IDRAY.GT.0) THEN - STEPDR = BIG - IF (GEKIN.GT.DCUTM) THEN - TMAX = REAL(EMASS*GEKIN*GAMASS/(0.5*AMASS*AMASS+EMASS*GETOT)) - IF (TMAX.GT.DCUTM) THEN - Y = DCUTM/TMAX - SIG = (1.-Y+BET2*Y*LOG(Y))/DCUTM -* extra term for spin 1/2 - IF (AMASS.GT.0.9) SIG=SIG+0.5*(TMAX-DCUTM)/(GETOT*GETOT) - SIG = REAL(SIG*Q(JPROB+17)*CHARG2*EMASS/BET2) -* - IF (SIG.GT.0.) THEN - STEPDR = 1./SIG - SDRAY = STEPDR*ZINTDR - IF (SDRAY.LE.STEP) THEN - STEP = SDRAY - IPROC = 10 - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF -* - IF (STEP.LE.0.) THEN - STEP = 0. - GO TO 110 - ENDIF -* -* ** Step limitation due to energy loss (stopping range) ? -* - IF (ILOSL.GT.0) THEN - IF(GEKRAT.LT.THRESH) THEN - I1 = MAX(IEKBIN-1,1) - ELSE - I1 = MIN(IEKBIN,NEKBIN-1) - ENDIF - I1 = 3*(I1-1)+1 - XCOEF1 = Q(JCOEF+I1) - XCOEF2 = Q(JCOEF+I1+1) - XCOEF3 = Q(JCOEF+I1+2) - IF(XCOEF1.NE.0) THEN - STOPP = -XCOEF2+SIGN(ONE,XCOEF1)* SQRT(XCOEF2 - + **2 -(XCOEF3-GEKIN*RMASS/XCOEF1)) - ELSE - STOPP = - (XCOEF3-GEKIN*RMASS)/XCOEF2 - ENDIF - STOPMX = (STOPP - STOPC)/(RMASS*CHARG2) - IF (STOPMX.LT.MIN(STEP,STMIN)) THEN - STEP = REAL(STOPMX) - IPROC = 0 - IF(STEP.LE.0.)THEN - GO TO 100 - ENDIF - GO TO 10 - ENDIF - EKF = (1. - DEEMAX)*GEKIN*RMASS - IF (EKF.LT.ELOW(1)) THEN - EKF = ELOW(1) - ELSEIF (EKF.GE.ELOW(NEK1)) THEN - EKF = ELOW(NEK1)*0.99 - ENDIF - IKF=INT(GEKA*LOG10(EKF)+GEKB) - GKR=(EKF-ELOW(IKF))/(ELOW(IKF+1)-ELOW(IKF)) - IF(GKR.LT.THRESH) THEN - IK1 = MAX(IKF-1,1) - ELSE - IK1 = MIN(IKF,NEKBIN-1) - ENDIF - IK1 = 3*(IK1-1)+1 - YCOEF1=Q(JCOEF+IK1) - YCOEF2=Q(JCOEF+IK1+1) - YCOEF3=Q(JCOEF+IK1+2) - IF(YCOEF1.NE.0.) THEN - SLOSP = REAL(-YCOEF2+SIGN(ONE,YCOEF1)*SQRT(YCOEF2**2- (YCOEF3- - + EKF/YCOEF1))) - ELSE - SLOSP = REAL(- (YCOEF3-EKF)/YCOEF2) - ENDIF - SLOSP = REAL(STOPP - SLOSP) - SLOSS = MAX(STMIN, SLOSP/(RMASS*CHARG2) ) - IF (SLOSS.LT.STEP) THEN - STEP = SLOSS - IPROC = 0 - ENDIF - ENDIF -* -* ** Step limitation due to energy loss in magnetic field ? -* - IF (IFIELD.NE.0) THEN - SFIELD = CFLD*VECT(7) - SFIELD=MAX(SFIELD, STMIN) - IF (SFIELD.LT.STEP) THEN - STEP = SFIELD - IPROC = 0 - ENDIF - ENDIF -* -* ** Step limitation due to multiple scattering ? -* - IF (IMULL.GT.0) THEN - SMULS=MIN(2232.*RADL*((VECT(7)**2)/(GETOT*CHARG1))**2,10.*RADL) - SMULS = MAX(STMIN, SMULS ) - IF (SMULS.LT.STEP) THEN - STEP = SMULS - IPROC = 0 - ENDIF - ENDIF -* - 10 CONTINUE -* -* ** Step limitation due to Cerenkov production ? -* - IF (IMCKOV.GT.0) THEN - CALL GNCKOV - STCKOV = MXPHOT/MAX(3.*DNDL,1E-10) - SMULS = MAX(STMIN, STCKOV) - IF (SMULS.LT.STEP) THEN - STEP = STCKOV - IPROC = 0 - ENDIF - ENDIF -* -* ** Step limitation due to geometry ? -* - IF (STEP.GE.0.95*SAFETY) THEN - CALL GTNEXT - IF (IGNEXT.NE.0) THEN - STEP = SNEXT + PREC - IPROC = 0 - ENDIF -* -* Update SAFETY in stack companions, if any - IF (IQ(JSTAK+3).NE.0) THEN - DO 20 IST = IQ(JSTAK+3),IQ(JSTAK+1) - JST = JSTAK + 3 + (IST-1)*NWSTAK - Q(JST+11) = SAFETY - 20 CONTINUE - IQ(JSTAK+3) = 0 - ENDIF - ELSE - IQ(JSTAK+3) = 0 - ENDIF -* -* *** Linear transport when no field or very short step -* - IF (IFIELD.EQ.0.OR.STEP.LE.PREC) THEN -* - IF (IGNEXT.NE.0) THEN - DO 30 I = 1,3 - VECTMP = VECT(I) +STEP*VECT(I+3) - IF(VECTMP.EQ.VECT(I)) THEN -* -* *** Correct for machine precision -* - IF(VECT(I+3).NE.0.) THEN - VECTMP = - + VECT(I)+ABS(VECT(I))*SIGN(1.,VECT(I+3))*EPSMAC - IF(NMEC.GT.0) THEN - IF(LMEC(NMEC).EQ.104) NMEC=NMEC-1 - ENDIF - NMEC=NMEC+1 - LMEC(NMEC)=104 -#if defined(CERNLIB_DEBUG) - WRITE(CHMAIL, 10000) - CALL GMAIL(0,0) - WRITE(CHMAIL, 10100) GEKIN, NUMED, STEP, SNEXT - CALL GMAIL(0,0) -10000 FORMAT(' Boundary correction in GTHION: ', - + ' GEKIN NUMED STEP SNEXT') -10100 FORMAT(31X,E10.3,1X,I10,1X,E10.3,1X,E10.3,1X) -#endif - ENDIF - ENDIF - VECT(I) = VECTMP - 30 CONTINUE - INWVOL = 2 - NMEC = NMEC +1 - LMEC(NMEC) = 1 - ELSE - DO 40 I = 1,3 - VECT(I) = VECT(I) +STEP*VECT(I+3) - 40 CONTINUE - ENDIF - ELSE -* -* *** otherwise, swim particle in magnetic field -* - NMEC = NMEC +1 - LMEC(NMEC) = 4 -* -#if !defined(CERNLIB_USRJMP) - 50 CALL GUSWIM (CHARG1, STEP, VECT, VOUT) -#endif -#if defined(CERNLIB_USRJMP) - 50 CALL JUMPT4(JUSWIM, CHARG1, STEP, VECT, VOUT) -#endif -* -* ** When near to boundary, take proper action (cut-step,crossing...) -* - IF(STEP.GE.SAFETY)THEN - INEAR = 0 - IF (IGNEXT.NE.0) THEN - DO 60 I = 1,3 - VNEXT(I+3) = VECT(I+3) - VNEXT(I) = VECT(I) +SNEXT*VECT(I+3) - 60 CONTINUE - DO I=1,3 - IF ((VOUT(I)-VNEXT(I)).GT.EPSIL) GOTO 70 - ENDDO - INWVOL = 2 - NMEC = NMEC +1 - LMEC(NMEC) = 1 - GOTO 80 - 70 CONTINUE - INEAR = 1 - ENDIF -#if !defined(CERNLIB_OLD) - if(mycoun.gt.1.and.nfmany.gt.0.and.step.ge.safety)then - nlevel=manyle(nfmany) - do 99 i=1,nlevel - names(i)=manyna(nfmany,i) - number(i)=manynu(nfmany,i) - 99 continue - call glvolu(nlevel,names,number,ier) - if(ier.ne.0)print *,'Fatal error in GLVOLU' - ingoto=0 - endif -#endif -* - CALL GINVOL (VOUT, ISAME) - IF (ISAME.EQ.0)THEN - IF ((INEAR.NE.0).OR.(STEP.LT.EPSIL)) THEN - INWVOL = 2 - NMEC = NMEC +1 - LMEC(NMEC) = 1 - ELSE -* Cut step - STEP = 0.5*STEP - IF (LMEC(NMEC).NE.24) THEN - NMEC = NMEC +1 - LMEC(NMEC) = 24 - ENDIF - GO TO 50 - ENDIF - ENDIF - ENDIF -* - 80 CONTINUE - DO 90 I = 1,6 - VECT(I) = VOUT(I) - 90 CONTINUE -* - ENDIF -* -* *** Correct the step due to multiple scattering - IF (IMULL.NE.0) THEN - STMULS = STEP - CORR=0.0001*CHARG2*(STEP/RADL)*(GETOT/(VECT(7)*VECT(7)))**2 - IF (CORR.GT.0.25) CORR = 0.25 - STEP = (1.+CORR)*STEP - ENDIF -* - SLENG = SLENG + STEP -* -* *** Generate Cherenkov photons if required -* - IF(IMCKOV.EQ.1) THEN - CALL GGCKOV - NMEC=NMEC+1 - LMEC(NMEC)=105 - ENDIF -* -* *** apply energy loss : find the kinetic energy corresponding -* to the new stopping range = stopmx - step -* - IF (ILOSL.NE.0) THEN - NMEC = NMEC +1 - LMEC(NMEC) = 3 - STOPRG = STOPP - STEP*RMASS*CHARG2 - IF (STOPRG.LE.STOPC) THEN - STEP = REAL(STOPMX) - GO TO 100 - ENDIF - IF(XCOEF1.NE.0.) THEN - EKIPR = XCOEF1*(XCOEF3+STOPRG*(2.*XCOEF2+STOPRG)) - ELSE - EKIPR = XCOEF2*STOPRG+XCOEF3 - ENDIF - DEMEAN=GEKIN - EKIPR/RMASS - IF(DEMEAN.LE.5.*GEKIN*EPSMAC) THEN - DEMEAN=(GEKRT1*Q(JLOSS+IEKBIN)+GEKRAT*Q(JLOSS+IEKBIN+1)) - + *STEP*CHARG2 - ENDIF -* -* fluctuations : differ from that of 'ordinary' hadrons -* - IF (ILOSS.EQ.4.OR.IEKBIN.LE.IKCUT+1) THEN - DESTEP = REAL(DEMEAN) - ELSE -* -* Charge exchange fluctuations + Gaussian 'Landau' fluctuations -* (it is the same for ILOSS=1,2,3 !) -* - SIGMA2=CNORM*CHARG1*(1.-CHARG1/CHARGE) - SIGMA2=MAX(SIGMA2,0.) - TA = RMASS*GEKIN - TAM=TA/AMU - SIGMA2=SIGMA2+2.+TAM*(2.+TAM) -* - SIGMA2=FACFLU*CHARG2*STEP*SIGMA2 - IF(SIGMA2.GT.0.0) THEN - SIGMA=SQRT(SIGMA2) - ELSE - SIGMA= 0.0 - END IF -* -* Check if we are in 'Gaussian' regime ... -* - CAPPA=REAL((1.+TAM)/(TAM*(2.+TAM)*EMASS)) - CAPPA=0.5*CAPPA**2*FACFLU*CHARG2*STEP -* -* ... if not , correct SIGMA ! - - IF( (CAPPA.LT.10.) .AND. (CAPPA.GT.0.0) ) THEN - SIGMA=SIGMA/(0.97+0.03*SQRT(10./CAPPA)) - ENDIF -* - CALL GRNDM(RNDM,2) - DEFLUC=REAL(SIGMA*SIN(TWOPI*RNDM(1))*SQRT(-2.*LOG(RNDM(2)))) - DESTEP=REAL(DEMEAN+DEFLUC) - ENDIF -* -* protection against negative destep -* - IF(DESTEP.LT.0.) DESTEP=REAL(DEMEAN) -* IF (DESTEP.LT.0.) DESTEP = 0. - GEKINT = GEKIN -DESTEP - IF (GEKINT.LE.(1.01*CUTHAD)) GO TO 100 - DESTEL = DESTEP - GEKIN = GEKINT - GETOT = GEKIN +AMASS - VECT(7)= SQRT((GETOT+AMASS)*GEKIN) - CALL GEKBIN - ENDIF -* -* *** Apply multiple scattering. -* - IF (IMULL.NE.0) THEN - NMEC = NMEC +1 - LMEC(NMEC) = 2 -* check charge dependence ...........!!!!!!! (later..) - CALL GMULTS - ENDIF -* -* *** Update time of flight -* - SUMLIF = SUMLIF -STEP*AMASS/VECT(7) - TOFG = REAL(TOFG +STEP*GETOT/(VECT(7)*CLIGHT)) - IF (TOFG.GE.TOFMAX) THEN - ISTOP = 4 - NMEC = NMEC +1 - LMEC(NMEC) = 22 - GO TO 999 - ENDIF -* -* *** Update interaction probabilities -* - IF (IHADR.GT.0) ZINTHA = ZINTHA*(1.-STEP/SHADR) - IF (IDRAY.GT.0) ZINTDR = ZINTDR -STEP/STEPDR -* - GO TO 110 -* -* ** Special treatment for overstopped tracks -* - 100 DESTEP = GEKIN - DESTEL = DESTEP - GEKIN = 0. - GETOT = AMASS - VECT(7)= 0. - INWVOL = 0 - ISTOP = 2 - NMEC = NMEC + 1 - LMEC(NMEC) = 30 - IF (IHADR.EQ.0) GO TO 999 - IPROC = 12 -* -* *** apply slected process if any -* - 110 IF (IPROC.EQ.0) GO TO 999 - NMEC = NMEC +1 - LMEC(NMEC) = IPROC -* -* ** Hadron interaction ? -* - IF (IPROC.EQ.12) THEN -#if !defined(CERNLIB_USRJMP) - CALL GUHADR -#endif -#if defined(CERNLIB_USRJMP) - CALL JUMPT0(JUHADR) -#endif -* * Check time cut-off for decays at rest - IF (LMEC(NMEC).EQ.5) THEN - TOFG = REAL(TOFG +SUMLIF/CLIGHT) - SUMLIF = 0. - IF (TOFG.GE.TOFMAX) THEN - NGKINE = 0 - ISTOP = 4 - LMEC(NMEC) = 22 - ENDIF - ENDIF -* -* ** Delta-ray ? -* - ELSE IF (IPROC.EQ.10) THEN - CALL GDRAY - ENDIF - 999 END diff --git a/src/programs/Simulation/HDGeant/gtnext.F b/src/programs/Simulation/HDGeant/gtnext.F deleted file mode 100644 index 3377fabcb6..0000000000 --- a/src/programs/Simulation/HDGeant/gtnext.F +++ /dev/null @@ -1,1001 +0,0 @@ -*--------------------------------------------------------------- -* fixes by rtj: Sometimes due to floating point rounding error, -* a point that is logically supposed to be outside -* a volume is found inside by GINME. Formerly -* that situation was not correctly handled, so I -* added explicit code to detect when it happens -* and set flags indicating that the point lies on -* the boundary of the target volume. -*--------------------------------------------------------------- -* -* $Id: gtnext.F,v 1.1.1.1 1995/10/24 10:21:44 cernlib Exp $ -* -* $Log: gtnext.F,v $ -* Revision 1.1.1.1 1995/10/24 10:21:44 cernlib -* Geant -* -* -#include "geant321/pilot.h" -#if !defined(CERNLIB_OLD) -*CMZ : 3.21/04 21/03/95 16.13.08 by S.Giani -*-- Author : - SUBROUTINE GTNEXT -C. -C. ****************************************************************** -C. * * -C. * SUBR. GTNEXT * -C. * * -C. * Computes SAFETY and, only when new SAFETY is smaller than * -C. * STEP, computes SNEXT. * -C. * STEP has to be preset to BIG or to physical step size * -C. * * -C. * Called by : GTELEC, GTGAMA, GTHADR, GTMUON, GTNEUT, GTNINO * -C. * * -C. * Author : S.Giani (1993) * -C. * * -C. * This routine is now based on the new 'virtual divisions' * -C. * algorithm to speed up the tracking. * -C. * The tracking for MANY volumes is not anymore based on a step * -C. * search: it is now based on a search through the list of * -C. * 'possible overlapping volumes' built by GTMEDI. * -C. * Boolean operations and divisions along arbitrary axis are * -C. * now supported. * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcflag.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gcshno.inc" -#if defined(CERNLIB_USRJMP) -#include "geant321/gcjump.inc" -#endif -#include "geant321/gchvir.inc" -#include "geant321/gcvdma.inc" - DIMENSION NUMTMP(15),NAMTMP(15) -C. - PARAMETER (BIG1=REAL(0.9*BIG)) -C. - CHARACTER*4 NAME - dimension iarrin(500),cxm(3),xxm(6) - REAL X0(6), XC(6), XT(6) - INTEGER IDTYP(3,12) - LOGICAL BTEST -C. - DATA IDTYP / 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 0, 1, 2, 3, 1, - + 2, 3, 1, 2, 3, 1, 2, 3, 1, 2, 4, 3, 1, 1, 1, - + 2, 3, 1, 2, 3, 1/ -C. -C. ------------------------------------------------------------------ -* -* * *** Transform current point and direction into local reference system -* - mycoun=0 - myinfr=0 - newfl=0 - manyfl=0 - tsafet=big - tsnext=big -401 IF (GRMAT(10,NLEVEL).EQ.0.) THEN - XC(1) = VECT(1) - GTRAN(1,NLEVEL) - XC(2) = VECT(2) - GTRAN(2,NLEVEL) - XC(3) = VECT(3) - GTRAN(3,NLEVEL) - XC(4) = VECT(4) - XC(5) = VECT(5) - XC(6) = VECT(6) - ELSE -C***** Code Expanded From Routine: GTRNSF -C -* - XL1 = VECT(1) - GTRAN(1,NLEVEL) - XL2 = VECT(2) - GTRAN(2,NLEVEL) - XL3 = VECT(3) - GTRAN(3,NLEVEL) - XC(1) = XL1*GRMAT(1,NLEVEL) + XL2*GRMAT(2,NLEVEL) + XL3* - 1 GRMAT(3,NLEVEL) - XC(2) = XL1*GRMAT(4,NLEVEL) + XL2*GRMAT(5,NLEVEL) + XL3* - 1 GRMAT(6,NLEVEL) - XC(3) = XL1*GRMAT(7,NLEVEL) + XL2*GRMAT(8,NLEVEL) + XL3* - 1 GRMAT(9,NLEVEL) -* -C***** End of Code Expanded From Routine: GTRNSF -C***** Code Expanded From Routine: GROT -C - XC(4) = VECT(4)*GRMAT(1,NLEVEL) + VECT(5)*GRMAT(2,NLEVEL) + - 1 VECT(6)*GRMAT(3,NLEVEL) - XC(5) = VECT(4)*GRMAT(4,NLEVEL) + VECT(5)*GRMAT(5,NLEVEL) + - 1 VECT(6)*GRMAT(6,NLEVEL) - XC(6) = VECT(4)*GRMAT(7,NLEVEL) + VECT(5)*GRMAT(8,NLEVEL) + - 1 VECT(6)*GRMAT(9,NLEVEL) -* -C***** End of Code Expanded From Routine: GROT - ENDIF -* -* *** Compute distance to boundaries -* - SNEXT = STEP - SAFETY = BIG - INGOTO = 0 - JVO = LQ(JVOLUM-LVOLUM(NLEVEL)) - ISH = INT(Q(JVO+2)) - IF (Q(JVO+3).EQ.0.) GO TO 300 - if(raytra.eq.1..and.imyse.eq.1)then - CALL UHTOC(NAMES(NLEVEL),4,NAME,4) - CALL GFIND(NAME,'SEEN',ISSEEN) - if(isseen.eq.-2.or.isseen.eq.-1)goto 300 - endif - NIN = INT(Q(JVO+3)) - IF (NIN.LT.0) GO TO 200 -* -* *** Case with contents positioned -* - sneold=SNEXT - nnn=0 - nflag=0 - mmm=0 - snxtot=0. - 111 if(nin.gt.1)then - if(nnn.gt.0)goto 112 - clmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+3) - chmoth=q(jvirt+4*(LVOLUM(NLEVEL)-1)+4) - ndivto=INT(q(jvirt+4*(LVOLUM(NLEVEL)-1)+2)) - iaxis =INT(q(jvirt+4*(LVOLUM(NLEVEL)-1)+1)) - if(iaxis.eq.4)then - do 1 i=1,6 - xxm(i)=xc(i) - 1 continue - endif - divthi=(chmoth-clmoth)/ndivto - if(iaxis.le.3)then - cx=xc(iaxis) - if(xc(iaxis+3).ge.0.)then - inc=1 - else - inc=-1 - endif - xvdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1 - ivdiv=INT(xvdiv) - if((xvdiv-ivdiv).lt.0.0001.and.inc.eq.-1)ivdiv=ivdiv-1 - if(ivdiv.lt.1)then - ivdiv=1 - elseif(ivdiv.gt.ndivto)then - ivdiv=ndivto - endif - else - call gfcoor(xc,iaxis,cx) - if(iaxis.eq.4)then - dr= xc(1)*xc(4)+xc(2)*xc(5) -* if(dr.eq.0.)print *,'dr.eq.0.' - if(dr.ge.0.)then - inc=1 - else - inc=-1 - endif - elseif(iaxis.eq.6)then - if((cx-clmoth).lt.-1.)then - cx=cx+360. - elseif((cx-chmoth).gt.1.)then - cx=cx-360. - endif - if(cx.gt.chmoth)then - cx=chmoth - elseif(cx.lt.clmoth)then - cx=clmoth - endif - dfi=xc(1)*xc(5)-xc(2)*xc(4) - if(dfi.ge.0)then - inc=1 - else - inc=-1 - endif - endif - xvdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1 - ivdiv=INT(xvdiv) - if((xvdiv-ivdiv).lt.0.0001.and.inc.eq.-1)ivdiv=ivdiv-1 - if(ivdiv.lt.1)then - ivdiv=1 - elseif(ivdiv.gt.ndivto)then - ivdiv=ndivto - endif - endif - jvdiv=lq(jvirt-LVOLUM(NLEVEL)) - 112 iofset=iq(jvdiv+ivdiv) - jcont2=jvdiv+iofset+1 - ncont=iq(jcont2) - if(ncont.eq.0)then - idmi=iq(jcont2+1) - idma=iq(jcont2+2) - llflag=0 - elseif(ncont.eq.1)then - idmi=iq(jcont2+2) - idma=iq(jcont2+3) - in=iq(jcont2+1) - else - idmi=iq(jcont2+ncont+1) - idma=iq(jcont2+ncont+2) - iii=1 - in=iq(jcont2+iii) - endif - if(nnn.eq.0)then - cxold=cx - if(inc.gt.0)then - cmin=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - if(iaxis.ne.6)then - safety=min(safety,(cxold-cmin)) - else - safefi=min(90.,(cxold-cmin)) - saferr=sqrt(xc(1)**2+xc(2)**2) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - else - cmax=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - if(iaxis.ne.6)then - safety=min(safety,(cmax-cxold)) - else - safefi=min(90.,(cmax-cxold)) - saferr=sqrt(xc(1)**2+xc(2)**2) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - endif - endif - if(ncont.eq.0)goto 181 - elseif(nin.eq.1)then - in=1 - endif -* - 150 if(nin.gt.1.and.ncont.gt.1)then - in=iq(jcont2+iii) - endif - if(nin.gt.0)then -* if(infrom.gt.0.and.myinfr.eq.0.and.newfl.eq.0)then -* if(in.eq.infrom)goto 171 -* endif - jin=lq(jvo-in) - if(.NOT.BTEST(iq(jin),4))then - else - goto 171 - endif - endif - if(nin.gt.1)then - llflag=0 - if(mmm.le.500)then - do 151 ll=1,mmm - if(iarrin(ll).eq.in)then - llflag=1 - goto 171 - endif - 151 continue - endif - if(llflag.eq.0)then - mmm=mmm+1 - if(mmm.le.500)then - iarrin(mmm)=in - endif - endif - endif - IF (IN.LT.0) GO TO 300 - JIN = LQ(JVO-IN) - IVOT = INT(Q(JIN+2)) - JVOT = LQ(JVOLUM-IVOT) - IROTT = INT(Q(JIN+4)) -* - IF (BTEST(IQ(JVOT),1)) THEN -* (case with JVOLUM structure locally developed) - JPAR = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL)))) - DO 169 ILEV = NLDEV(NLEVEL), NLEVEL - IF (IQ(JPAR+1).EQ.0) THEN - IF (ILEV.EQ.NLEVEL) THEN - JPAR = LQ(JPAR-IN) - ELSE - JPAR = LQ(JPAR-LINDEX(ILEV+1)) - ENDIF - IF (JPAR.EQ.0) GO TO 170 - ELSE IF (IQ(JPAR-3).GT.1) THEN - JPAR = LQ(JPAR-LINDEX(ILEV+1)) - ELSE - JPAR = LQ(JPAR-1) - ENDIF - 169 CONTINUE - JPAR = JPAR + 5 - NPAR = IQ(JPAR) - GO TO 179 - ENDIF -* (normal case) - 170 NPAR = INT(Q(JVOT+5)) - IF (NPAR.EQ.0) THEN - JPAR = JIN +9 - NPAR = INT(Q(JPAR)) - ELSE - JPAR = JVOT +6 - ENDIF - 179 if((nin.eq.1).or.(nin.gt.1.and.llflag.eq.0))then -* -* * Compute distance to boundary of current content -* -C***** Code Expanded From Routine: GITRAN -c 180 IF (IROTT .EQ. 0) THEN - IF (IROTT .EQ. 0) THEN - XT(1) = XC(1) - Q(5+JIN) - XT(2) = XC(2) - Q(6+JIN) - XT(3) = XC(3) - Q(7+JIN) -* - XT(4) = XC(4) - XT(5) = XC(5) - XT(6) = XC(6) -* - ELSE - XL1 = XC(1) - Q(5+JIN) - XL2 = XC(2) - Q(6+JIN) - XL3 = XC(3) - Q(7+JIN) - JR = LQ(JROTM-IROTT) - XT(1) = XL1*Q(JR+1) + XL2*Q(JR+2) + XL3*Q(JR+3) - XT(2) = XL1*Q(JR+4) + XL2*Q(JR+5) + XL3*Q(JR+6) - XT(3) = XL1*Q(JR+7) + XL2*Q(JR+8) + XL3*Q(JR+9) -* -C***** End of Code Expanded From Routine: GITRAN -C***** Code Expanded From Routine: GRMTD - XT(4)=XC(4)*Q(JR+1)+XC(5)*Q(JR+2)+XC(6)*Q(JR+3) - XT(5)=XC(4)*Q(JR+4)+XC(5)*Q(JR+5)+XC(6)*Q(JR+6) - XT(6)=XC(4)*Q(JR+7)+XC(5)*Q(JR+8)+XC(6)*Q(JR+9) -* -C***** End of Code Expanded From Routine: GRMTD - ENDIF -* - IACT = 1 - ISHT = INT(Q(JVOT+2)) - call ginme(xt,q(jvot+2),q(jpar+1),iyes) - if (iyes.ne.0) then -c print *, 'inside when assumed outside, rounding error!' - snxt = 0 - safe = 0 - else IF (ISHT.LT.5) THEN - IF (ISHT.EQ.1) THEN - CALL GNOBOX (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.2) THEN - CALL GNOTRA(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.3) THEN - CALL GNOTRA(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE) - ELSE - CALL GNOTRP (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ENDIF - ELSE IF (ISHT.LE.10) THEN - IF (ISHT.EQ.5) THEN - CALL GNOTUB(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.6) THEN - CALL GNOTUB(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.7) THEN - CALL GNOCON(XT,Q(JPAR+1),IACT,1,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.8) THEN - CALL GNOCON(XT,Q(JPAR+1),IACT,2,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.9) THEN - CALL GNOSPH (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE - CALL GNOPAR (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ENDIF - ELSE IF (ISHT.EQ.11) THEN - CALL GNOPGO (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.12) THEN - CALL GNOPCO (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.13) THEN - CALL GNOELT (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.14) THEN - CALL GNOHYP (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE IF (ISHT.EQ.28) THEN - CALL GSNGTR (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE,0) - ELSE IF (ISHT.EQ.NSCTUB) THEN - CALL GNOCTU (XT,Q(JPAR+1),IACT,SNEXT,SNXT,SAFE) - ELSE - PRINT *, ' GTNEXT : No code for shape ', ISHT - STOP - ENDIF -* - safe=max(safe,0.) - if(snxt.le.-prec)snxt=big1 - snxt=max(snxt,0.) - IF (SAFE.LT.SAFETY) SAFETY = SAFE - IF (SNXT.LE.MIN(SNEXT,BIG1)) THEN - INGOTO = IN - SNEXT = SNXT - IGNEXT = 1 - LQ(JGPAR-NLEVEL-1) = JPAR - IQ(JGPAR+NLEVEL+1) = NPAR - ENDIF - endif - 171 if(nin.eq.1)then - goto 300 - elseif(nin.ge.1.and.ncont.gt.1)then - iii=iii+1 - if(iii.le.ncont)goto 150 - endif -* -* * Compute distance to boundary of current volume -* - 181 if(nnn.eq.0)then - JPAR = LQ(JGPAR-NLEVEL) - IACT = 2 - ISH = INT(Q(JVO+2)) - call ginme(xc,q(jvo+2),q(jpar+1),iyes) - if (iyes.eq.0) then -c print *, 'outside when assumed in, rounding error!' - snxt = 0 - safe = 0 - else IF (ISH.LT.5) THEN - IF (ISH.EQ.1) THEN - CALL GNBOX (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.2) THEN - CALL GNTRAP (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE) - ELSE IF (ISH.EQ.3) THEN - CALL GNTRAP (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE) - ELSE - CALL GNTRP (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISH.LE.10) THEN - IF (ISH.EQ.5) THEN - CALL GNTUBE (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE) - ELSE IF (ISH.EQ.6) THEN - CALL GNTUBE (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE) - ELSE IF (ISH.EQ.7) THEN - CALL GNCONE (XC, Q(JPAR+1),IACT,1, SNEXT,SNXT,SAFE) - ELSE IF (ISH.EQ.8) THEN - CALL GNCONE (XC, Q(JPAR+1),IACT,2, SNEXT,SNXT,SAFE) - ELSE IF (ISH.EQ.9) THEN - CALL GNSPHR (XC, Q(JPAR+1),IACT, SNEXT, SNXT, SAFE) - ELSE - CALL GNPARA (XC, Q(JPAR+1),IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISH.EQ.12) THEN - CALL GNPCON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.11) THEN - CALL GNPGON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.13) THEN - CALL GNELTU (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.14) THEN - CALL GNHYPE (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.28) THEN - CALL GSNGTR (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,1) - ELSE IF (ISH.EQ.NSCTUB) THEN - CALL GNCTUB (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE - PRINT *, ' GTNEXT : No code for shape ', ISH - STOP - ENDIF -* - safe=max(safe,0.) - if(snxt.le.-prec)snxt=big1 - snxt=max(snxt,0.) - IF (SAFE.LT.SAFETY) SAFETY = SAFE - IF (SNXT.LE.MIN(SNEXT,BIG1)) THEN - SNEXT = SNXT - IGNEXT = 1 - INGOTO = 0 - ENDIF - endif - if(iaxis.eq.4)then - if(idma.eq.ndivto.and.inc.gt.0)goto 400 - cxm(1)=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - if(idmi.eq.idma)then - cxm(2)=cxm(1)+divthi - else - cxm(2)=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - endif - cxm(3)=20000. - call gntube(xxm,cxm,3,1,SNEXT,snxnew,safe) - if(snxnew.lt.0.)snxnew=big1 - snxnew=snxnew+.004 - snxtot=snxtot+snxnew - if(snxtot.lt.SNEXT)then - xxm(1)=xxm(1)+snxnew*xxm(4) - xxm(2)=xxm(2)+snxnew*xxm(5) - xxm(3)=xxm(3)+snxnew*xxm(6) - call gfcoor(xxm,iaxis,cxnew) - xevdiv=((cxnew-clmoth)*ndivto/(chmoth-clmoth))+1 - ivdiv=INT(xevdiv) - dr= xxm(1)*xxm(4)+xxm(2)*xxm(5) -* if(dr.eq.0.)print *,'dr.eq.0.' - if(dr.ge.0.)then - inc=1 - else - inc=-1 - endif - if((xevdiv-ivdiv).lt.0.0001.and.inc.eq.-1)ivdiv=ivdiv-1 - if(ivdiv.lt.1)then - ivdiv=1 - elseif(ivdiv.gt.ndivto)then - ivdiv=ndivto - endif - nnn=nnn+1 - goto 111 - else - if(inc.gt.0)then - cmax=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - safety=min(safety,(cmax-cxold)) - else - cmin=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - safety=min(safety,(cxold-cmin)) - endif - goto 400 - endif - endif - if(nnn.ne.0.and.SNEXT.eq.sneold)goto 199 - x0(1) = xc(1) + SNEXT*xc(4) - x0(2) = xc(2) + SNEXT*xc(5) - x0(3) = xc(3) + SNEXT*xc(6) - x0(4) = xc(4) - x0(5) = xc(5) - x0(6) = xc(6) - if(iaxis.le.3)then - cx=x0(iaxis) - xevdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1 - ievdiv=INT(xevdiv) - if((xevdiv-ievdiv).lt.0.0001.and.inc.eq.-1)ievdiv=ievdiv-1 - if(ievdiv.lt.1)then - ievdiv=1 - elseif(ievdiv.gt.ndivto)then - ievdiv=ndivto - endif - else - call gfcoor(x0,iaxis,cx) - if(iaxis.eq.6)then - if((cx-clmoth).lt.-1.)then - cx=cx+360. - elseif((cx-chmoth).gt.1.)then - cx=cx-360. - endif - if(cx.gt.chmoth)then - cx=chmoth - elseif(cx.lt.clmoth)then - cx=clmoth - endif - endif - xevdiv=((cx-clmoth)*ndivto/(chmoth-clmoth))+1 - ievdiv=INT(xevdiv) - if((xevdiv-ievdiv).lt.0.0001.and.inc.eq.-1)ievdiv=ievdiv-1 - if(ievdiv.lt.1)then - ievdiv=1 - elseif(ievdiv.gt.ndivto)then - ievdiv=ndivto - endif - endif - 199 if(ievdiv.ge.idmi.and.ievdiv.le.idma)then - if(inc.gt.0)then - cmax=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - if(iaxis.ne.6)then - safety=min(safety,(cmax-cxold)) - else - safefi=min(90.,(cmax-cxold)) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - else - cmin=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - if(iaxis.ne.6)then - safety=min(safety,(cxold-cmin)) - else - safefi=min(90.,(cxold-cmin)) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - endif - goto 400 - endif - if(iaxis.eq.6.or.iaxis.le.3)then - if(ievdiv.lt.idmi.and.inc.gt.0)then - if(nnn.eq.0.and.iaxis.eq.6 - + .and.(chmoth-clmoth).eq.360.)nflag=1 - if(nflag.eq.0)then -* print *,'ievdiv=',ievdiv,' ;idmi=',idmi,' inc.gt.0' -* print *,isht,'=isht; ',iaxis,'=iaxis; ',ish,'=ish;' - if(iaxis.le.3)then - cmax=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - safety=min(safety,abs(cmax-cxold)) - elseif(iaxis.eq.6)then - cmax=(clmoth+(idma-1)*(chmoth-clmoth)/ndivto)+divthi - safefi=min(90.,(cmax-cxold)) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - goto 400 - endif - elseif(ievdiv.gt.idma.and.inc.lt.0)then - if(nnn.eq.0.and.iaxis.eq.6 - + .and.(chmoth-clmoth).eq.360.)nflag=1 - if(nflag.eq.0)then -* print *,'ievdiv=',ievdiv,' ;idma=',idma,' inc.lt.0' -* print *,isht,'=isht; ',iaxis,'=iaxis; ',ish,'=ish;' - if(iaxis.le.3)then - cmin=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - safety=min(safety,abs(cxold-cmin)) - elseif(iaxis.eq.6)then - cmin=clmoth+(idmi-1)*(chmoth-clmoth)/ndivto - safefi=min(90.,(cxold-cmin)) - safe22=saferr*sin(safefi) - safety=min(safety,safe22) - endif - goto 400 - endif - endif - endif - nnn=nnn+1 - sneold=SNEXT - if(inc.gt.0)then - if(iaxis.eq.6)then - if(idma.eq.ndivto.and.(chmoth-clmoth).eq.360.)then - ivdiv=1 - else - ivdiv=idma+1 - endif - else - ivdiv=idma+1 - endif - else - if(iaxis.eq.6)then - if(idmi.eq.1.and.(chmoth-clmoth).eq.360.)then - ivdiv=ndivto - else - ivdiv=idmi-1 - endif - else - ivdiv=idmi-1 - endif - endif - goto 111 -* -* *** Case of volume incompletely divided -* - 200 JDIV = LQ(JVO-1) - IAXIS = INT(Q(JDIV+1)) - IVOT = INT(Q(JDIV+2)) - JVOT = LQ(JVOLUM-IVOT) - ISHT = INT(Q(JVOT+2)) -* -* ** Get the division parameters -* - IF (NLEVEL.LT.NLDEV(NLEVEL)) THEN - JPARM = 0 - ELSE -* (case with JVOLUM structure locally developed) - JPARM = LQ(LQ(JVOLUM-LVOLUM(NLDEV(NLEVEL)))) - IF (NLEVEL.EQ.NLDEV(NLEVEL)) GO TO 215 - DO 210 ILEV = NLDEV(NLEVEL), NLEVEL-1 - IF (IQ(JPARM+1).EQ.0) THEN - JPARM = LQ(JPARM-LINDEX(ILEV+1)) - IF (JPARM.EQ.0) GO TO 215 - ELSE IF (IQ(JPARM-3).GT.1) THEN - JPARM = LQ(JPARM-LINDEX(ILEV+1)) - ELSE - JPARM = LQ(JPARM-1) - ENDIF - IF (ILEV.EQ.NLEVEL-1) THEN - NDIV = IQ(JPARM+1) - ORIG = Q(JPARM+2) - SDIV = Q(JPARM+3) - ENDIF - 210 CONTINUE - GO TO 220 - ENDIF -* (normal case) - 215 NDIV = INT(Q(JDIV+3)) - ORIG = Q(JDIV+4) - SDIV = Q(JDIV+5) -* -* ** Look at the first and the last divisions only -* - 220 IDT = IDTYP(IAXIS, ISH) - IF (IDT.EQ.1) THEN - IN2 = 0 - IF (XC(IAXIS).LT.ORIG) THEN - IN = 1 - ELSE - IN = NDIV - ENDIF - ELSE IF (IDT.EQ.2) THEN - R = XC(1)**2 + XC(2)**2 - IF (ISH.EQ.9) R = R + XC(3)**2 - R = SQRT(R) - IN2 = 0 - IF (ISH.EQ.5.OR.ISH.EQ.6.OR.ISH.EQ.9) THEN - IF (R.LT.ORIG) THEN - IN = 1 - ELSE - IN = NDIV - ENDIF - ELSE -** PRINT *, ' GTNEXT : Partially divided ',ISH,IAXIS - IN = 1 - IF (NDIV.GT.1) IN2 = NDIV - ENDIF - ELSE IF (IDT.EQ.4) THEN - IN2 = 0 - RXY = XC(1)**2 + XC(2)**2 - RXY = SQRT(RXY) - IF (XC(3).NE.0.0) THEN - THET = REAL(RADDEG * ATAN (RXY/XC(3))) - IF (THET.LT.0.0) THET = THET + 180.0 - ELSE - THET = 90. - ENDIF - IF (THET.LE.ORIG) THEN - IN = 1 - ELSE - IN = NDIV - ENDIF - ELSE - IN2 = 0 - IF (ISH.EQ.5.OR.ISH.EQ.7) THEN - IN = 1 - IF (NDIV.GT.1) IN2 = NDIV - ELSE - IF (XC(1).NE.0.0.OR.XC(2).NE.0.0) THEN - PHI = REAL(RADDEG * ATAN2 (XC(2), XC(1))) - ELSE - PHI = 0.0 - ENDIF - IF (ISH.EQ.6.OR.ISH.EQ.8) THEN - IF (PHI.LT.ORIG) THEN - IN = 1 - ELSE - IN = NDIV - ENDIF - ELSE - IN = 1 - IF (NDIV.GT.1) IN2 = NDIV - ENDIF - ENDIF - ENDIF -* - 225 IF (IDT.EQ.1) THEN - X0(1) = 0.0 - X0(2) = 0.0 - X0(3) = 0.0 - X0(IAXIS) = ORIG + (IN - 0.5) * SDIV - IF (ISH.EQ.4.OR.(ISH.EQ.10.AND.IAXIS.NE.1)) THEN - CALL GCENT (IAXIS, X0) - ENDIF - XT(1) = XC(1) - X0(1) - XT(2) = XC(2) - X0(2) - XT(3) = XC(3) - X0(3) - XT(4) = XC(4) - XT(5) = XC(5) - XT(6) = XC(6) - ELSE IF (IDT.EQ.3) THEN - PH0 = REAL(DEGRAD * (ORIG + (IN - 0.5) * SDIV)) - CPHR = COS(PH0) - SPHR = SIN(PH0) - XT(1) = XC(1)*CPHR + XC(2)*SPHR - XT(2) = XC(2)*CPHR - XC(1)*SPHR - XT(3) = XC(3) - XT(4) = XC(4)*CPHR + XC(5)*SPHR - XT(5) = XC(5)*CPHR - XC(4)*SPHR - XT(6) = XC(6) - ELSE - DO 234 I = 1, 6, 2 - XT(I) = XC(I) - XT(I+1) = XC(I+1) - 234 CONTINUE - ENDIF -* - IF (JPARM.NE.0) THEN - IF (IQ(JPARM-3).GT.1) THEN - JPAR = LQ(JPARM-IN) - ELSE - JPAR = LQ(JPARM-1) - ENDIF - JPAR = JPAR + 5 - ELSE - JPAR = JVOT + 6 - ENDIF -* - IACT = 1 - call ginme(xt,q(jvot+2),q(jpar+1),iyes) - if (iyes.ne.0) then -c print *, 'inside when assumed out, rounding error!' - snxt = 0 - safe = 0 - else IF (ISHT.LT.5) THEN - IF (ISHT.EQ.1) THEN - CALL GNOBOX (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.2) THEN - CALL GNOTRA (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.3) THEN - CALL GNOTRA (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE - CALL GNOTRP (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISHT.LE.10) THEN - IF (ISHT.EQ.5) THEN - CALL GNOTUB (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.6) THEN - CALL GNOTUB (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.7) THEN - CALL GNOCON (XT, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.8) THEN - CALL GNOCON (XT, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.9) THEN - CALL GNOSPH (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE - CALL GNOPAR (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISHT.EQ.11) THEN - CALL GNOPGO (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.12) THEN - CALL GNOPCO (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.13) THEN - CALL GNOELT (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISHT.EQ.28) THEN - CALL GSNGTR (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,0) - ELSE IF (ISHT.EQ.NSCTUB) THEN - CALL GNOCTU (XT, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE - PRINT *, ' GTNEXT : No code for shape ', ISHT - STOP - ENDIF -* - safe=max(safe,0.) - if(snxt.le.-prec)snxt=big1 - snxt=max(snxt,0.) - IF (SAFE.LT.SAFETY) SAFETY = SAFE - IF (SNXT.LE.MIN(SNEXT,BIG1)) THEN - SNEXT = SNXT - IGNEXT = 1 - if(raytra.eq.1.)ingoto=-1 - ENDIF -* - IF (IN2.NE.0) THEN - IF (IN2.NE.IN) THEN - IN = IN2 - GO TO 225 - ENDIF - ENDIF -* (later, this section only for concave volumes if INGOTO >0 - 300 IACT = 1 - IF (IGNEXT.NE.0) THEN - IF (.NOT.BTEST(IQ(JVO),2)) IACT = 0 - ENDIF - if(nin.eq.1.and.ignext.ne.0)then - if(q(jin+8).eq.0.)iact=1 - endif - JPAR = LQ(JGPAR-NLEVEL) - call ginme(xc,q(jvo+2),q(jpar+1),iyes) - if (iyes.eq.0) then -c print *, 'outside when assumed inside, rounding error!' - snxt = 0 - safe = 0 - else IF (ISH.LT.5) THEN - IF (ISH.EQ.1) THEN - CALL GNBOX (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE ) - ELSE IF (ISH.EQ.2) THEN - CALL GNTRAP (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.3) THEN - CALL GNTRAP (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE - CALL GNTRP (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISH.LE.10) THEN - IF (ISH.EQ.5) THEN - CALL GNTUBE (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.6) THEN - CALL GNTUBE (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.7) THEN - CALL GNCONE (XC, Q(JPAR+1), IACT, 1, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.8) THEN - CALL GNCONE (XC, Q(JPAR+1), IACT, 2, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.9) THEN - CALL GNSPHR (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE - CALL GNPARA (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ENDIF - ELSE IF (ISH.EQ.12) THEN - CALL GNPCON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.11) THEN - CALL GNPGON (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.13) THEN - CALL GNELTU (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.14) THEN - CALL GNHYPE (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE IF (ISH.EQ.28) THEN - CALL GSNGTR (XC,Q(JPAR+1), IACT, SNEXT, SNXT, SAFE,1) - ELSE IF (ISH.EQ.NSCTUB) THEN - CALL GNCTUB (XC, Q(JPAR+1), IACT, SNEXT, SNXT, SAFE) - ELSE - PRINT *, ' GTNEXT : No code for shape ', ISH - STOP - ENDIF -* - safe=max(safe,0.) - if(snxt.le.-prec)snxt=big1 - snxt=max(snxt,0.) - IF (SAFE.LT.SAFETY) SAFETY = SAFE - IF (SNXT.LE.MIN(SNEXT,BIG1)) THEN - SNEXT = SNXT - IGNEXT = 1 - INGOTO = 0 - ENDIF -* - 400 if(iswit(9).eq.123456789.and.Q(JVO+3).gt.1.)then - print *,'n. of checked objects = ',mmm - endif - if(myinfr.gt.0)then - jin=lq(jvo-myinfr) - iq(jin)=ibclr(iq(jin),4) - myinfr=0 - endif - if(gonly(nlevel).eq.0..or.nvmany.ne.0) THEN - if(safety.lt.tsafet)tsafet=safety - if(snext.lt.tsnext)then - mycoun=mycoun+1 - tsnext=snext - tignex=ignext - tingot=ingoto - call gscvol - if(ingoto.gt.0)then - iq(jgpar2+nlevel+1)=iq(jgpar+nlevel+1) - lq(jgpar2-nlevel-1)=lq(jgpar-nlevel-1) - endif - endif - if(gonly(nlevel).eq.0.)then - 404 continue - if(gonly(nlevel-1).eq.0..or.newfl.eq.0)then - if(gonly(nlevel-1).ne.0.)newfl=1 - nlevel=nlevel-1 - jvo=lq(jvolum-lvolum(nlevel)) - nin=INT(q(jvo+3)) - if(nin.lt.0)goto 404 - myinfr=lindex(nlevel+1) - jin=lq(jvo-myinfr) - iq(jin)=ibset(iq(jin),4) - ignext=0 - goto 401 - endif - endif - 403 continue - if(manyfl.lt.nvmany)then - manyfl=manyfl+1 - if(manyfl.eq.nfmany)goto 403 - levtmp=manyle(manyfl) - do 402 i=1,levtmp - namtmp(i)=manyna(manyfl,i) - numtmp(i)=manynu(manyfl,i) - 402 continue - call glvolu(levtmp,namtmp,numtmp,ier) - if(ier.ne.0)print *,'Fatal error in GLVOLU' - ignext=0 - goto 401 - endif - if(tsafet.le.safety)safety=tsafet - if(tsnext.le.snext)then - snext=tsnext - ignext=INT(tignex) - ingoto=INT(tingot) - call gfcvol - nlevin=nlevel - if(ingoto.gt.0)then - iq(jgpar+nlevel+1)=iq(jgpar2+nlevel+1) - lq(jgpar-nlevel-1)=lq(jgpar2-nlevel-1) - endif - endif - endif -* -* *** Attempt to rescue negative SNXT due to rounding errors -* -c 900 IF (SNXT.EQ.BIG1) THEN - IF (SNXT.EQ.BIG1) THEN -CCC debug - IF (ISWIT(9).EQ.123456789) THEN - PRINT *,' GTNEXT : SNEXT,SAFETY,INGOTO=',SNEXT,SAFETY,INGOTO - CALL GPCXYZ - ENDIF -CCC - SAFETY = 0. - SNEXT = 0. - IGNEXT = 1 - INGOTO = 0 - ENDIF - IF(JGSTAT.NE.0) CALL GFSTAT(3) -* END GTNEXT - END -#endif diff --git a/src/programs/Simulation/HDGeant/guhadr.F b/src/programs/Simulation/HDGeant/guhadr.F deleted file mode 100644 index a6278952be..0000000000 --- a/src/programs/Simulation/HDGeant/guhadr.F +++ /dev/null @@ -1,133 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.2 2001/07/15 07:31:36 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:46 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:46 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/03 07/10/94 18.41.50 by S.Giani -*-- Author : - SUBROUTINE GUHADR -C. -C. ****************************************************************** -C. * * -C. * User routine to generate one hadronic interaction * -C. * * -C. * ==>Called by : GTHADR,GTNEUT * -C. * * -C. ****************************************************************** -C. -*======================================================================* -* * -* An interface with a part of the FLUKA shower code is available in * -* GEANT 3.21. The following conditions and warnings must be taken * -* into account when using the FLUKA routines. * -* * -*======================================================================* -*======================================================================* -* * -* FFFF L U U K K AA * -* F L U U K K A A * -* FFF L U U KK AAAA * -* F L U U K K A A * -* F LLLL UU K K A A * -* * -* (C) Copyright of the authors * -* * -* A. Fasso'*, A. Ferrari#, J. Ranft$, P.R. Sala# * -* * -* *: CERN, #: INFN -Milan, $: CERN/Frascati * -* * -* (e-mail: FERRARIA@CERNVM.CERN.CH) * -* * -*======================================================================* -* * -* - All the rights concerning FLUKA or parts of it are only of the * -* authors and are independent from those of the GEANT code * -* * -* - FLUKA [1-6] is a standalone code capable of simulating the inter-* -* action and transport of all components of EM and hadronic cas- * -* cades up to several TeV. However, only cross sections and * -* models for hadronic elastic and inelastic interactions (end 1992 * -* status) are included in this GEANT version. * -* * -* - The most recent FLUKA model [4,6] for nucleon and pion interac- * -* tions in the intermediate energy range is not fully implemented * -* in GEANT. Only a simplified version, limited to p and n below * -* 250 MeV, is available in GEANT 3.21. A coarser model is used for * -* other projectiles in this energy range. However the implemented * -* parts should be adequate for most detector simulations and sim- * -* ilar applications for which GEANT is generally used. Their accu- * -* racy could be insufficient for some nuclear physics studies or * -* demanding simulations at low energies, where the more sophistic- * -* ated models [4,6] could be required. * -* * -* - The performances of GEANT-FLUKA are therefore not representative * -* of those of FLUKA standalone and should be referenced as such * -* rather than simply GEANT or FLUKA. * -* * -* - The authors reserve the right of publishing about the physical * -* models developed for FLUKA. Running the FLUKA routines in isol- * -* ation for benchmarks (or equivalent use) is not permitted, * -* except after consultations or in collaboration with the authors. * -* * -* - The FLUKA routines are supposed to be included and used in * -* GEANT only. Any other use must be authorized by the authors. * -* * -* - References: at least reference [5] should be always quoted when * -* reporting results obtained with GEANT-FLUKA * -* * -* [1] A. Fasso', A. Ferrari, J. Ranft, P. R. Sala, G. R. Stevenson and * -* J. M. Zazula, "FLUKA92", presented at the workshop on "Simulat- * -* ing Accelerator Radiation Environment", SARE, Santa Fe, 11-15 * -* january (1993), Proceedings in press. * -* * -* [2] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, Proc. MC93 Int. Conf. * -* on Monte-Carlo Simulation in High-Energy and Nuclear Physics, * -* Tallahassee, Florida, 22-26 february (1993), World Scientific, * -* p. 88 (1994). * -* * -* [3] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, ibidem, p. 100 (1994) * -* * -* [4] A. Ferrari and P.R. Sala, ibidem, p. 277 (1994). * -* * -* [5] A. Fasso', A. Ferrari, J. Ranft and P.R. Sala, "FLUKA: present * -* status and future developments", presented at the IV Int. Conf. * -* on Calorimetry in High Energy Physics, La Biodola (Elba), * -* September 19-25 1993, Proceedings in press. * -* * -* [6] A. Fasso', A. Ferrari, J. Ranft, and P.R. Sala, "FLUKA: Perf- * -* ormances and Applications in the Intermediate Energy Range", * -* presented at the "Specialists' Meeting on Shielding Aspects of * -* Accelerators, Targets & Irradiation Facilities", Arlington, * -* April 28-29 1994, Proceedings in press. * -* * -*======================================================================* -C -#include "geant321/gcphys.inc" -C. -C. ------------------------------------------------------------------ -C. -C GHEISHA only if IHADR<3 (default) -C FLUKA (with GHEISHA for neutrons below 20MeV) if IHADR=3 -C FLUKA (with MICAP for neutrons below 20MEV) if IHADR>3 -C - IF (IHADR.LT.3) THEN - CALL GHEISH - ELSE IF (IHADR.EQ.3) THEN - CALL FLUFIN - ELSE - CALL GFMFIN - ENDIF - END diff --git a/src/programs/Simulation/HDGeant/gukine.F b/src/programs/Simulation/HDGeant/gukine.F deleted file mode 100644 index 72e3a85976..0000000000 --- a/src/programs/Simulation/HDGeant/gukine.F +++ /dev/null @@ -1,340 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.14 2004/12/08 14:43:24 davidl -* Change argument 4 of second call to GSVERT from 0 to 0.0 to avoid compiler warnings -* -* Revision 1.13 2003/12/10 15:32:57 jonesrt -* -control.in : never mind [rtj] -* -gukine.F : fixed a bug in the setting of polarization ppol used -* for polarization studies of the coherent bremsstrahlung source [rtj] -* -gustep.F : changed background studies facility to split data across -* separate ntuples, one for each virtual detector [rtj] -* -hit*.F : modified behaviour from "quit" to "truncate" in the case where -* the number of hits exceeds the maximum allowed for that counter [rtj] -* -* Revision 1.12 2003/07/28 15:42:58 jonesrt -* - gukine.F - added photon polarization as an additional attached info to -* vertex [rtj] -* -* Revision 1.11 2003/07/28 15:31:33 jonesrt -* - gukine.F - added conditional BEAM_BOX_SIZE to enable simulations with -* artificial electron beam motion superimposed on coherent bremsstrahlung [rtj] -* -* Revision 1.10 2003/01/02 23:49:33 jonesrt -* - included updates in gustep.F with conditional code for background -* studies, by R. Jones and C. Gauthier [rtj] -* - moved the beam origin a meter upstream in gukine.F to make room for -* additional shielding in the collimator cave [rtj] -* -* Revision 1.9 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.8 2001/12/18 20:32:12 jonesrt -* I added the track="int" information to the output event, at the request of -* Dave Doughty. Track numbers are assigned by Geant in the order of declaration, -* which is just the order they appear in the Reaction section, so it is not too -* difficult to figure out which track goes with which final-state product. -* However there is presently no internal identifier in the Reaction section that -* matches up to the track number. Even calling it a track is a bit of a stretch -* because it is assigned to neutrals as well as charged particles. But that is -* the Geant nomenclature and it is simple to decode. -* I also added some comments to the control cards file control.in that might -* make it easier for a newbie to run his own simulations. -* -rtj- -* -* Revision 1.7 2001/10/30 11:52:36 jonesrt -* - fixed bug in gukine.F in coherent beam simulation -* where variable spot was in meters but treated as if it were cm -rtj- -* -* Revision 1.6 2001/10/29 17:39:23 jonesrt -* - added mc truth info to output event for internal track/photon generators -* - added special code for background studies, selected by the conditional -* #define BACKGROUND_STUDIES (in gustep.F) -* - added conditional code to disable normal event output for bg studies, using -* #define DISABLE_OUTPUT (in guout.F) -* Both of the above defines are disabled in the distribution code by default. -* -rtj- -* -* Revision 1.5 2001/08/02 03:08:05 jonesrt -* Now the BEAM data card is supported, with correct generation of -* coherent bremsstrahlung radiation. -rtj -* -* Revision 1.4 2001/07/27 21:04:09 jonesrt -* With this release, HDGeant version 1.0 is now in beta. -rtj -* -* Revision 1.3 2001/07/24 05:37:16 jonesrt -* First working prototype of hits package -rtj -* -* Revision 1.2 2001/07/15 07:31:37 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:46 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* - -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUKINE -* -************************************************************************ -* * -* Generates Kinematics for primary tracks * -* * -************************************************************************ -* -#include "geant321/gcunit.inc" -#include "geant321/gcflag.inc" -#include "geant321/gckine.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcscan.inc" -#include "geant321/gcomis.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcnum.inc" -#include "hdtrackparams.inc" -#include "controlparams.inc" -#include "backgrounds.inc" -#include "cobrems.inc" -* - DIMENSION VERTEX(4),PLAB(5) - DIMENSION RNDM(20) - - real tgen, tgend - real unif01(100) - integer i,j - character*20 pname - integer nubuf - real ubuf(99) - real pmin, pmax, thetamin, thetamax - real vertex_r, vertex_phi - - real beam_period_ns - data beam_period_ns/0/ - if (beam_period_ns.eq.0) then - beam_period_ns = get_beam_period() - endif - -* -* ----------------------------------------------------------------- -* - UPWGHT = 1 - ISTORY = 0 - - ev = event_count - do i=1,10 - ev = ev/10. - if (ev.lt.10) goto 2 - enddo - 2 if (int(ev).eq.ev) then - write(LOUT,*) event_count," events simulated" - endif - event_count = event_count + 1 - -* Get the current values of the random number seeds. Do this -* here so we can overwrite them in the first "if" block below -* for the case when we find seeds in the generated events file. -* Not all generated events files will contain seeds so we want -* to record the seed values as they are (i.e. specified in control.in) -* If one of the built-in generators is used, the seed values -* will also come from control.in. In all cases, the seeds that are actually -* used are stored in the file via the storeseeds call at the end -* of this subroutine. -* - call GRNDMQ(iseed1,iseed2,0,'G') - -* -* -* Try input from MonteCarlo generator first -* - if (get_next_evt.eq.1) then - itry = nextInput() - else - itry = 0 - get_next_evt=1 - endif - if (itry .eq. 0) then - itry = loadInput(override_run_number,IDRUN) - do while (itry .ne. 0) - itry = nextInput() - if (itry .eq. 0) then - itry = loadInput(override_run_number,IDRUN) - else - ieorun = 1 - ieotri = 1 - return - endif - enddo -* -* Check for random number seeds in the input file. If they are -* there, then the values of iseed1 and iseed2 will be overwritten -* by this call. If they are not there, then they will be untouched -* by the call. -* - call getseeds(iseed1, iseed2) - call GRNDMQ(iseed1,iseed2,0,'S') - -* -* Try to read the beam photon energy from the input MC record. -* - PLAB(4) = get_beam_momentum(0) - if (PLAB(4) .gt. 0) then - call GFVERT(1,VERT,NTBEAM,NTTARG,TOFG,ubuf,nubuf) - PLAB(1) = get_beam_momentum(1) - PLAB(2) = get_beam_momentum(2) - PLAB(3) = get_beam_momentum(3) - else -* -* Fake a tagger hit of the correct energy by adding up the energy -* of all generated tracks minus the rest mass of the (assumed -* proton) target, and assigning it to the trigger time. -* - PLAB(1) = 0 - PLAB(2) = 0 - PLAB(3) = 0 - PLAB(4) = REAL(-PMASS) - do nt=1,NTRACK - call GFKINE(nt,VERT,PVERT,IPART,IVERT,ubuf,nubuf) - call GFPART(IPART,pname,ITRTYP,AMASS,CHARGE,TLIFE, - + ubuf,nubuf) - PLAB(1) = PLAB(1) + PVERT(1) - PLAB(2) = PLAB(2) + PVERT(2) - PLAB(3) = PLAB(3) + PVERT(3) - PLAB(4) = PLAB(4) + - + sqrt(AMASS**2+PVERT(1)**2+PVERT(2)**2+PVERT(3)**2) - enddo - endif - PLAB(5) = PLAB(4) - VERTEX(1) = VERT(1) - VERTEX(2) = VERT(2) - VERTEX(3) = VERT(3) - VERTEX(4) = TOFG - call hitTagger(VERTEX,VERTEX,PLAB,PLAB,0.,0,0,0) - - if (bgrate.gt.0) then -* -* Superimpose background in the form of coherent bremsstrahlung -* beam photons sent down the photon beam line. They are generated -* with a random time distribution over the duration of the gate -* to simulate the actual conditions of a bremsstrahlung beam. -* - ngen=0 - tgen=bggate(1) - do i=1,99999 - call grndm(unif01,100) - do j=1,100 - tgen=tgen-log(unif01(j))/bgrate - if (tgen.gt.bggate(2)) goto 10 - tgend=beam_period_ns*floor(tgen/beam_period_ns+0.5) - call beamgen(tgend + 1e-3) - ngen=ngen+1 - enddo - enddo - 10 continue -c print *, ngen,' background photons generated this event' - endif - elseif (itry .ne. 9) then - ieorun = 1 - ieotri = 1 - return -* -* Try coherent bremsstrahlung beam generation next -* - elseif (E.gt.0) then - call beamgen(0.) - call storeInput(IDRUN,IDEVT,1); -* -* If all else fails, do automatic single-track generation -* - else - CALL GRNDM(RNDM,3) - vertex_r=RNDM(1)*tgtwidth(1) - vertex_phi=RNDM(2)*6.28319 - TOFG=0 - VERTEX(1)=VSCAN(1)+vertex_r*cos(vertex_phi) - VERTEX(2)=VSCAN(2)+vertex_r*sin(vertex_phi) - VERTEX(3)=VSCAN(3)+((RNDM(3)-0.5)*tgtwidth(2)) - IF (IKINE.GT.100) THEN - IK=IKINE-100 - CALL GRNDM(RNDM,3) -* -* If the PLOG(TLOG) card is non-zero in control.in, then -* distribute evenly in the log of total momentum(theta). -* Otherwise, distribute evenly in total momentum(theta). -* 3/17/2009 DL -* - IF (plog_particle_gun.EQ.0) THEN - PABS=PKINE(1)+PKINE(4)*(RNDM(1)-0.5) - ELSE - pmin=PKINE(1)-0.5*PKINE(4) - pmax=PKINE(1)+0.5*PKINE(4) - IF (pmin.LE.0) THEN - pmin=0.100 - ENDIF - PABS=pmin*(pmax/pmin)**RNDM(1) - ENDIF - IF (tlog_particle_gun.EQ.0) THEN - THETA=REAL((PKINE(2)+PKINE(5)*(RNDM(2)-0.5))*DEGRAD) - ELSE - thetamin=PKINE(2)-0.5*PKINE(5) - thetamax=PKINE(2)+0.5*PKINE(5) - IF (thetamin.LE.0) THEN - thetamin=0.9 - ENDIF - THETA=REAL(thetamin*(thetamax/thetamin)**RNDM(2)*DEGRAD) - ENDIF - PHI=REAL((PKINE(3)+PKINE(6)*(RNDM(3)-0.5))*DEGRAD) - ELSE - IK=IKINE - CALL GRNDM(RNDM,2) - PABS=PKINE(1) - THETA=REAL(PI*RNDM(1)) - PHI=REAL(TWOPI*RNDM(2)) - ENDIF - PLAB(1) = PABS*SIN(THETA)*COS(PHI) - PLAB(2) = PABS*SIN(THETA)*SIN(PHI) - PLAB(3) = PABS*COS(THETA) - - CALL GSVERT(VERTEX,0,0,0.0,0,NVERT) - CALL GSKINE(PLAB,IK,NVERT,0,0,NT) - - call storeInput(IDRUN,IDEVT,NT); - - endif -* -* Kinematic debug (controled by ISWIT(1)) -* - IF(IDEBUG.EQ.1.AND.ISWIT(1).EQ.1) THEN - CALL GPRINT('VERT',0) - CALL GPRINT('KINE',0) - ENDIF -* -* If storing particle trajectories, clear the buffers - if (storetraj.ne.0) then - call cleartrajectories() - endif - -* Store the random number seeds used for this event in the -* output file. The values for the seeds are determined -* above since the coherent bremstrahlung generator uses the -* random number generator. -* - call storeseeds(iseed1, iseed2) - - END diff --git a/src/programs/Simulation/HDGeant/guout.F b/src/programs/Simulation/HDGeant/guout.F deleted file mode 100644 index ed54a10433..0000000000 --- a/src/programs/Simulation/HDGeant/guout.F +++ /dev/null @@ -1,97 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.5 2004/05/18 12:58:54 jonesrt -* Makefile -* - created a section at the top for global defines that are used to -* build custom versions of the simulation [rtj] -* hddm_s.c, hddm_s.h -* - default i/o library modules (generated by hddm package) [rtj] -* hddsGeant3.F -* - default geometry module (generated by hdds package) [rtj] -* hitStart.c -* - changes to accomodate new vertex counter cylinder+plane structure [rtj] -* guout.F, gustep.F -* - defines for custom builds moved from sources to Makefile -* gustep.F -* - new conditional WERNERS_VTX_NTUPLE sections added for background -* studies in the region of the vertex counter [rtj] -* -* Revision 1.4 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.3 2001/10/29 17:39:23 jonesrt -* - added mc truth info to output event for internal track/photon generators -* - added special code for background studies, selected by the conditional -* #define BACKGROUND_STUDIES (in gustep.F) -* - added conditional code to disable normal event output for bg studies, using -* #define DISABLE_OUTPUT (in guout.F) -* Both of the above defines are disabled in the distribution code by default. -* -rtj- -* -* Revision 1.2 2001/07/24 05:37:16 jonesrt -* First working prototype of hits package -rtj -* -* Revision 1.1 2001/07/10 18:05:46 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUOUT -* -C. ****************************************************************** -C. * * -C. * User routine called at the end of each event. * -C. * * -C. ****************************************************************** -C. -C. -#include "geant321/gcomis.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcflag.inc" -#include "controlparams.inc" -C. ------------------------------------------------------------------ -C. - integer iskip - integer iseen - call gelh_outp(iskip) - iseen = loadOutput(IDRUN) - -C #define WRITE_ONLY_IF_SOMETHING_WAS_SEEN 1 -C #if WRITE_ONLY_IF_SOMETHING_WAS_SEEN -C if (iseen.gt.0) then -C #else -C if (iseen.ge.0) then -C #endif -C call flushOutput() -C endif - - - if(writenohits.ne.0) then - if (iseen.ge.0) call flushOutput() - else - if (iseen.gt.0) call flushOutput() - endif - -C FDPREE() should only be called if FLUKA is being used - if (IHADR.ge.3) call fdpree() - - call gidClear() - - END diff --git a/src/programs/Simulation/HDGeant/guphad.F b/src/programs/Simulation/HDGeant/guphad.F deleted file mode 100644 index d4516012ba..0000000000 --- a/src/programs/Simulation/HDGeant/guphad.F +++ /dev/null @@ -1,133 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.2 2001/07/15 07:31:37 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:47 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:46 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/03 07/10/94 18.38.33 by S.Giani -*-- Author : - SUBROUTINE GUPHAD -C. -C. ****************************************************************** -C. * * -C. * User routine to compute Hadron. inter. probabilities * -C. * * -C. * ==>Called by : GTHADR,GTNEUT * -C. * * -C. ****************************************************************** -C. -*======================================================================* -* * -* An interface with a part of the FLUKA shower code is available in * -* GEANT 3.21. The following conditions and warnings must be taken * -* into account when using the FLUKA routines. * -* * -*======================================================================* -*======================================================================* -* * -* FFFF L U U K K AA * -* F L U U K K A A * -* FFF L U U KK AAAA * -* F L U U K K A A * -* F LLLL UU K K A A * -* * -* (C) Copyright of the authors * -* * -* A. Fasso'*, A. Ferrari#, J. Ranft$, P.R. Sala# * -* * -* *: CERN, #: INFN -Milan, $: CERN/Frascati * -* * -* (e-mail: FERRARIA@CERNVM.CERN.CH) * -* * -*======================================================================* -* * -* - All the rights concerning FLUKA or parts of it are only of the * -* authors and are independent from those of the GEANT code * -* * -* - FLUKA [1-6] is a standalone code capable of simulating the inter-* -* action and transport of all components of EM and hadronic cas- * -* cades up to several TeV. However, only cross sections and * -* models for hadronic elastic and inelastic interactions (end 1992 * -* status) are included in this GEANT version. * -* * -* - The most recent FLUKA model [4,6] for nucleon and pion interac- * -* tions in the intermediate energy range is not fully implemented * -* in GEANT. Only a simplified version, limited to p and n below * -* 250 MeV, is available in GEANT 3.21. A coarser model is used for * -* other projectiles in this energy range. However the implemented * -* parts should be adequate for most detector simulations and sim- * -* ilar applications for which GEANT is generally used. Their accu- * -* racy could be insufficient for some nuclear physics studies or * -* demanding simulations at low energies, where the more sophistic- * -* ated models [4,6] could be required. * -* * -* - The performances of GEANT-FLUKA are therefore not representative * -* of those of FLUKA standalone and should be referenced as such * -* rather than simply GEANT or FLUKA. * -* * -* - The authors reserve the right of publishing about the physical * -* models developed for FLUKA. Running the FLUKA routines in isol- * -* ation for benchmarks (or equivalent use) is not permitted, * -* except after consultations or in collaboration with the authors. * -* * -* - The FLUKA routines are supposed to be included and used in * -* GEANT only. Any other use must be authorized by the authors. * -* * -* - References: at least reference [5] should be always quoted when * -* reporting results obtained with GEANT-FLUKA * -* * -* [1] A. Fasso', A. Ferrari, J. Ranft, P. R. Sala, G. R. Stevenson and * -* J. M. Zazula, "FLUKA92", presented at the workshop on "Simulat- * -* ing Accelerator Radiation Environment", SARE, Santa Fe, 11-15 * -* january (1993), Proceedings in press. * -* * -* [2] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, Proc. MC93 Int. Conf. * -* on Monte-Carlo Simulation in High-Energy and Nuclear Physics, * -* Tallahassee, Florida, 22-26 february (1993), World Scientific, * -* p. 88 (1994). * -* * -* [3] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, ibidem, p. 100 (1994) * -* * -* [4] A. Ferrari and P.R. Sala, ibidem, p. 277 (1994). * -* * -* [5] A. Fasso', A. Ferrari, J. Ranft and P.R. Sala, "FLUKA: present * -* status and future developments", presented at the IV Int. Conf. * -* on Calorimetry in High Energy Physics, La Biodola (Elba), * -* September 19-25 1993, Proceedings in press. * -* * -* [6] A. Fasso', A. Ferrari, J. Ranft, and P.R. Sala, "FLUKA: Perf- * -* ormances and Applications in the Intermediate Energy Range", * -* presented at the "Specialists' Meeting on Shielding Aspects of * -* Accelerators, Targets & Irradiation Facilities", Arlington, * -* April 28-29 1994, Proceedings in press. * -* * -*======================================================================* -C -#include "geant321/gcphys.inc" -C. -C. ------------------------------------------------------------------ -C. -C GPGHEI for GHEISHA -C FLDIST for FLUKA (with GHEISHA for neutrons below 20MeV) -C GFMDIS for FLUKA (with MICAP for neutrons below 20MeV) -C - IF (IHADR.LT.3) THEN - CALL GPGHEI - ELSE IF (IHADR.EQ.3) THEN - CALL FLDIST - ELSE - CALL GFMDIS - ENDIF - END diff --git a/src/programs/Simulation/HDGeant/gustep.F b/src/programs/Simulation/HDGeant/gustep.F deleted file mode 100644 index 71d3b9fd16..0000000000 --- a/src/programs/Simulation/HDGeant/gustep.F +++ /dev/null @@ -1,951 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.22 2005/12/27 01:14:28 jonesrt -* gustep.F -* - removed FDC cathode strips from the list of sensitive volumes where -* hits can occur -- the cathode strips themselves are not sensitive, -* they just pick up signals from the anode wires, as in the statement -* no anode hit => no cathode hit! -* --rtj-- -* -* Revision 1.21 2005/12/12 15:38:46 jonesrt -* hitutil.F -* - removed from top-level, moved into new subdir hitutil [rtj] -* hitBCal.c -* - increased the segmentation of the BCal readout [rtj] -* cdcdump.c -* - added a check for the existence of certain groups [rtj] -* gustep.F -* - added dispatch for additional BCal readout sections [rtj] -* Makefile.orig -* - removed compilation of hitutil.F, added libhitutil.a linkage [rtj] -* -* Revision 1.20 2005/06/22 15:32:16 zisis -* -* First draft of this routine to work with the new BCAL geometry and hits. CX. -* -* Revision 1.19 2005/04/26 14:51:52 ostrov -* Addition of UPV -* -* Revision 1.19 2005/03/20 ao -* hitUPV.c -* Makefile.orig -* gustep.F -* - support for hits in UPV -* -* Revision 1.18 2005/01/29 19:25:28 jonesrt -* hitLGD.c -* - renamed to hitFCal.c [rtj] -* Makefile.orig -* - modified to reflect the name change for hitLGD.c [rtj] -* control.in -* - it seems that I always have touched this file at some point! [rtj] -* gustep.F -* - added argument ISTAK to argument list for hitXXX functions, so that -* they can determine whether a given track is the primary or not [rtj] -* - some of the names of volumes have been changed in the recent geometry -* update, reflect that fact in the Makefile [rtj] -* hddm_s.c, hddm_s.h -* - updated from hddm (you should generate these using hddm-c and then -* copy them over from hddm to this folder) [rtj] -* hddsGeant3.F -* - updated from hdds (you should generate this using hdds-geant and -* then copy it over from hdds to this folder) [rtj] -* uginit.F -* - added a line to switch HBOOK from //LUN3 (closed after return from -* GRFILE) back to the geant.hbook output file on unit 50 [rtj] -* hddmInput.c -* - modified to store the actual coordinates of the event vertex in the -* Monte Carlo section of the output record, in case that the vertex -* was generated by the simulator instead of the generator [rtj] -* hitXXX.c -* - modified to accommodate an extra tag primary="boolean" on all of -* the cheat tags, to tell whether the hit was produced by one of the -* original primaries, or by a secondary produced by one of them. -* - hitFTOF.c modified to accommodate two layers instead of one [rtj] -* - hitStart.c modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - added a cheat tag to the Cerenkov readout [rtj] -* - all cheat tags have been modified to report all three coordinates -* (in the global reference system) instead of only two [rtj] -* -* Revision 1.17 2005/01/21 09:34:05 davidl -* If ff card NOSECONDARIES set, then don't push any secondaries onto the stack -* -* Revision 1.16 2004/06/17 18:32:55 davidl -* Fixed typo that caused comment to be misleading -* -* Revision 1.15 2004/06/07 19:05:53 jonesrt -* Makefile, gustep.F -* - added option CERENKOV_PID_NTUPLE to save information from a bg -* simulation to an ntuple stored in geant.hbook [rjt,rem] -* -* Revision 1.14 2004/05/18 12:58:54 jonesrt -* Makefile -* - created a section at the top for global defines that are used to -* build custom versions of the simulation [rtj] -* hddm_s.c, hddm_s.h -* - default i/o library modules (generated by hddm package) [rtj] -* hddsGeant3.F -* - default geometry module (generated by hdds package) [rtj] -* hitStart.c -* - changes to accomodate new vertex counter cylinder+plane structure [rtj] -* guout.F, gustep.F -* - defines for custom builds moved from sources to Makefile -* gustep.F -* - new conditional WERNERS_VTX_NTUPLE sections added for background -* studies in the region of the vertex counter [rtj] -* -* Revision 1.13 2004/01/14 16:34:48 brash -* Fixed bug in gustep.F regarding placement of certain assignment statements with -* respect to certain #ifdef statements. Should work now with BACKGROUND_* defines -* turned either on or off. (EJB) -* -* Revision 1.12 2004/01/14 16:28:10 brash -* Updates in order to analyze different readout modules of the barrel calorimeter. (EJB) -* -* Revision 1.11 2003/12/10 15:32:57 jonesrt -* -control.in : never mind [rtj] -* -gukine.F : fixed a bug in the setting of polarization ppol used -* for polarization studies of the coherent bremsstrahlung source [rtj] -* -gustep.F : changed background studies facility to split data across -* separate ntuples, one for each virtual detector [rtj] -* -hit*.F : modified behaviour from "quit" to "truncate" in the case where -* the number of hits exceeds the maximum allowed for that counter [rtj] -* -* Revision 1.10 2003/01/08 19:17:34 jonesrt -* - gustep.F : added collection of information in a backgrounds ntuple - rtj -* - gufld.F : enabled magnetic field in sweep magnets, was off before - rtj -* -* Revision 1.9 2003/01/02 23:49:33 jonesrt -* - included updates in gustep.F with conditional code for background -* studies, by R. Jones and C. Gauthier [rtj] -* - moved the beam origin a meter upstream in gukine.F to make room for -* additional shielding in the collimator cave [rtj] -* -* Revision 1.8 2001/12/19 02:34:55 jonesrt -* Fixed the names of sensitive volumes in the save-hits section of gustep.F, -* also added support for the r="float" parameter of in hitCDC.c. -* -rtj- -* -* Revision 1.7 2001/10/29 17:39:23 jonesrt -* - added mc truth info to output event for internal track/photon generators -* - added special code for background studies, selected by the conditional -* #define BACKGROUND_STUDIES (in gustep.F) -* - added conditional code to disable normal event output for bg studies, using -* #define DISABLE_OUTPUT (in guout.F) -* Both of the above defines are disabled in the distribution code by default. -* -rtj- -* -* Revision 1.6 2001/07/27 21:04:09 jonesrt -* With this release, HDGeant version 1.0 is now in beta. -rtj -* -* Revision 1.5 2001/07/24 05:37:16 jonesrt -* First working prototype of hits package -rtj -* -* Revision 1.4 2001/07/19 23:25:49 jonesrt -* numerous new files as I develop the prototype hits libraries -rtj -* -* Revision 1.3 2001/07/17 22:38:40 jonesrt -* Adding hits registry in gustep -rtj -* -* Revision 1.2 2001/07/15 07:31:37 jonesrt -* HDGeant now supports kinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:47 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" - -c#define BACKGROUND_PROFILING 1 - -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUSTEP -* -************************************************************************ -* * -* User routine called at the end of each tracking step * -* MEC is the mechanism origin of the step * -* INWVOL is different from 0 when the track has reached * -* a volume boundary * -* ISTOP is different from 0 if the track has stopped * -* * -************************************************************************ -* -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gcomis.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcflag.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcbank.inc" -#include "geant321/gcmate.inc" -#include "hdtrackparams.inc" -#include "controlparams.inc" -* -* ----------------------------------------------------------------- -* - -#define TOP_CERENKOV_EFFICIENCY 1.0 - - real xin(4), xout(4) - real pin(5), pout(5) - real dEsum - data xin,xout/8*0/ - data pin,pout/10*0/ - data dEsum/0/ - - integer area - character*4 cnames(15) - equivalence (NAMES(1),cnames(1)) - real rnd(100) - - integer*4 cint - character*4 cchar - equivalence(cint,cchar) - -c define "title" only under special circumstances, done to supress -c warnings -- MMI - -#ifdef HISTOGRAM_MATERIAL_SEEN_BY_FIRST_TRACK - character*250 title -#else -#ifdef BACKGROUND_PROFILING - character*250 title -#endif -#endif - -#ifdef BACKGROUND_STUDIES - integer type - real xv(4),Etot - common /bgNtuple/type,xv,Etot - character*80 bgntdef - parameter (bgntdef='type:I,xv(4):R,Etot:R') - integer bgnt - parameter (bgnt=10) -#endif - -#ifdef BACKGROUND_PROFILING - integer det - real vertx(3),tofgx,ubuf(99),xint(3,999) - integer ntbeamx,nttargx,nubuf,mint - save ubuf,xint,det,mint - integer iorder(999) - save iorder -#endif - -#ifdef ACTIVE_COLLIMATOR_SIMS - integer evno - real vertx1(3),tofgx1 - integer ntbeamx1,nttargx1,nubuf1 - real qsum(8),qsumb(8),qsump(8),ubuf1(99) - common /hdacol/evno,Egam,qsum,qsumb,qsump,ubuf1 - save /hdacol/ - character*100 ntacoldef - parameter (ntacoldef='ev:I,Egam:R,qsum(8):R,qsumb(8):R,' - + //'qsump(8):R,ppol:R,offset(2):R') - integer ntacol - parameter (ntacol=25) -#endif - -#if defined WERNERS_VTX_NTUPLE - integer evno,part,vid - real xvtx(3),xdet(3),pdet(3) - common /wernerNtuple/evno,xvtx,xdet,pdet,part,vid - save /wernerNtuple/ - character*80 ntwernerdef - parameter (ntwernerdef='ev:I,xv(3):R,xt(3):R,p(3):R,part:I,vid:I') - integer ntwerner - parameter (ntwerner=10) -#elif defined CERENKOV_PID_NTUPLE - integer evno,part - real xvtx(3),xdet(3),pdet(3) - common /ckovNtuple/evno,xvtx,xdet,pdet,part - save /ckovNtuple/ - character*80 ntckovdef - parameter (ntckovdef='ev:I,xv(3):R,xt(3):R,p(3):R,part:I,vid:I') - integer ntckov - parameter (ntckov=10) -#elif defined FCAL_SPLASH_NTUPLE - integer evno,part - real xconv(6),pconv - integer nfcal - real xfcal(999),yfcal(999),Efcal(999) - common /fsplNtuple/evno,part,xconv,pconv,nfcal,xfcal,yfcal,Efcal - save /fsplNtuple/ - character*160 ntfspldef - parameter (ntfspldef='ev:I,part:I,xconv(6):R,pconv:R,' - + //'nfcal[0,999]:I,xfcal(nfcal):R,yfcal(nfcal):R,Efcal(nfcal):R') - integer ntfspl - parameter (ntfspl=10) - integer getrow_wrapper,getcolumn_wrapper - external getrow_wrapper,getcolumn_wrapper -#elif defined FCAL_SHOWER_PROFILE_NTUPLE -c -c NTUPLE CONTENTS: -c evno: event number -c part: initial particle type -c xinit(3): initial particle location -c pinit(3): initial particle momentum -c xstop(3): location where initial particle stops -c ndiv: number of fcal divisions in the following arrays... -c xdiv(ndiv): array of x positions -c ydiv(ndiv): array of y positions -c zdiv(ndiv): array of z positions -c ediv(ndiv): array of energy depositions at the above positions -c -#define NXDIVISIONS 400 -#define NYDIVISIONS 400 -#define NZDIVISIONS 60 -#define XDIVISIONSIZE 1.0 -#define YDIVISIONSIZE 1.0 -#define ZDIVISIONSIZE 1.0 -#define XDIVISIONSTART -200.0 -#define YDIVISIONSTART -200.0 -#define ZDIVISIONSTART 620.0 -#define MINIMUMENERGYPERDIVISION 1.0e-3 -c - real edivisions(NXDIVISIONS,NYDIVISIONS,NZDIVISIONS) - save edivisions - integer ixdivision, iydivision, izdivision - integer evno,part - real xstop(3),xinit(3),pinit(3) - integer ndiv - real xdiv(10000),ydiv(10000),zdiv(10000),ediv(10000) - common /fspNtuple/evno,part,xinit,pinit,xstop, - + ndiv,xdiv,ydiv,zdiv,ediv - save /fspNtuple/ - character*160 ntfspdef - parameter (ntfspdef='evno:I,part:I,xinit(3):R,pinit(3):R,' - + //'xstop(3):R,ndiv[0,10000]:I,xdiv(ndiv):R,ydiv(ndiv):R,' - + //'zdiv(ndiv):R,ediv(ndiv):R') - integer ntfsp - parameter (ntfsp=10) -c -#elif defined BCAL_RESOLUTION_NTUPLE - integer evno - real pphot(4),dE,xdep(3) - common /bcalresnt/evno,pphot,dE,xdep - save /bcalresnt/ - character*80 ntbcaldef - parameter (ntbcaldef='evno:I,pphot(4):R,dE:R,xdep(3):R') - integer ntbcal - parameter (ntbcal=33) -#endif - - logical hexist - external hexist - - character*4 chcase - integer mechanism - equivalence(chcase,mechanism) - - integer enterbcal - save enterbcal - - if (genbeam_precol.ne.0) then - ! call storeBeam(vect, tofg) - writenohits = 1 - ISTOP = 99 - return - else if (genbeam_postcol.ne.0) then - if (vect(3).gt.-1520) then - ! call storeBeam(vect, tofg) - writenohits = 1 - ISTOP = 99 - else - writenohits = 0 - endif - endif - -#ifdef BACKGROUND_PROFILING -******************************************************************************** -* The following defines an ntuple containing information on particle type -* energy, position, polarization, and at what virtual detector the -* particle passes through. the last column entry is defined by a integer -* 'det' whose value is the number of the detector the particle passes -* through. The xint(icomp,iint) array records the vertex history of the -* interaction sequence leading to the detected particle, iint=1...mint. -******************************************************************************** - -********** assignment of the value of 'det' to a particle ****************** - - if (cnames(nlevel).eq.'DET1') then - det = 1 - elseif (cnames(nlevel).eq.'DET2') then - det = 2 - elseif (cnames(nlevel).eq.'DET3') then - det = 3 - elseif (cnames(nlevel).eq.'DET4') then - det = 4 - elseif (cnames(nlevel).eq.'DET5') then - det = 5 - elseif (cnames(nlevel).eq.'DET6') then - det = 6 - elseif (cnames(nlevel).eq.'DET7') then - det = 7 - elseif (cnames(nlevel).eq.'PTAR') then - det = 8 - elseif (cnames(nlevel).eq.'LIH2') then - det = 9 - else - det = 0 - endif - -********************** Defintion of ntuple **************************** - - if (inwvol.eq.1.and.det.ge.1 -c + .and.((ipart.eq.2).or.(ipart.eq.3)) -c + .and.(vect(1)**2+vect(2)**2).gt.25.0) then - + ) then - call gfvert(1,vertx,ntbeamx,nttargx,tofgx,ubuf,nubuf) - if (.not.hexist(9+det)) then - write(title,"('hits in virtual detector',i3)") det - call hbnt(9+det,title,' ') - call hbname(9+det,'hits',gekin,'totE:r') - call hbname(9+det,'hits',vect,'x(7):r') - call hbname(9+det,'hits',ubuf,'ppol:r') - call hbname(9+det,'hits',ubuf(2),'xspot(2):r') - call hbname(9+det,'hits',ipart,'ptype:i') - call hbname(9+det,'hits',det,'det:i') - call hbname(9+det,'hits',mint,'mint[0,999]:i') - call hbname(9+det,'hits',xint,'xint(3,mint):r') - endif - call hfnt(9+det) - endif - if (nstep.eq.0) then - if (istak.eq.0) then - mint = 0 - else - do while (mint.gt.0.and.iorder(mint).gt.istak) - mint = mint-1 - enddo - if (mint.lt.999) then - mint = mint+1 - iorder(mint) = istak - xint(1,mint) = vect(1) - xint(2,mint) = vect(2) - xint(3,mint) = vect(3) - endif - endif - endif - -******************************************************************************** -#endif - - -* Stop beam photons which are initially generated outside the 12.4 cm -* radius beam pipe at the entrance to the collimator cave - - IF(vect(3).eq.-2200.) THEN - ph_radius = sqrt(vect(1)*vect(1)+vect(2)*vect(2)) - IF(ph_radius.ge.12.4) THEN - ISTOP = 97 - ENDIF - ENDIF - - - -* Stop wimpy charged particles that are taking forever to range out - - if ((NSTEP.ge.99999).and.(CHARGE.ne.0).or. - + (ILOSS.eq.0).and.(GEKIN.lt.1e-3)) then - DESTEP = GEKIN - ISTOP = 98 - NMEC = NMEC+1 - LMEC(NMEC) = 30 - endif - - -* Record particles entering BCAL so the sampling fluctuations -* can be applied based on the incident particle's parameters -* Note that the first 6 layers the BCAL leadScint volume have -* names starting with 'BM0'. Particles entering through one -* of the outer layers will not have the proper parameters recorded. -* What's more, if the names of the volumes change, then this will -* break! 7/5/2012 DL -* change this to enterting BM00 from - - if ((cnames(NLEVEL)(1:4).eq.'BCL0') .and. (INWVOL.eq.2) ) then - enterbcal = 1 - endif - -* if ((cnames(NLEVEL)(1:3).eq.'BM0') .and. INWVOL.eq.1 ) then - if ((cnames(NLEVEL)(1:4).eq.'BM01') .and. (enterbcal .eq. 1) - > .and. INWVOL.eq.1 ) then - call recordbcalentry(LMEC(NMEC),ITRA,ISTAK,IPART,VECT,GETOT) - enterbcal = 0 - endif - - -* For explicit Cerenkov generation, apply an inefficiency factor - - if (NGPHOT.gt.100) then - call GRANOR(rnd(1),rnd(2)) - sigma = sqrt(NGPHOT * (TOP_CERENKOV_EFFICIENCY - + * (1 - TOP_CERENKOV_EFFICIENCY))) - NGPHOT = INT(TOP_CERENKOV_EFFICIENCY*NGPHOT + rnd(1)*sigma + 0.5) - call GSKPHO(0) - elseif (NGPHOT.gt.0) then - call GRNDM(rnd,NGPHOT) - do i=1,NGPHOT - if (rnd(i).le.TOP_CERENKOV_EFFICIENCY) then - call GSKPHO(i) - endif - enddo - endif - -#ifdef ACTIVE_COLLIMATOR_SIMS - if (IDEVT.ne.evno) then - if (event_count.eq.1) then - call hbnt(ntacol,'active collimator ntuple, all events',' ') - call hbname(ntacol,'charge',evno,ntacoldef) - call hbnt(ntacol+1,'active collimator ntuple, charged events', - + ' ') - call hbname(ntacol+1,'charge',evno,ntacoldef) - else - call hfnt(ntacol) - if (qsum(1).ne.0 .or. qsum(2).ne.0 .or. - + qsum(3).ne.0 .or. qsum(4).ne.0 .or. - + qsum(5).ne.0 .or. qsum(6).ne.0 .or. - + qsum(7).ne.0 .or. qsum(8).ne.0 .or. - + qsumb(1).ne.0 .or. qsumb(2).ne.0 .or. - + qsumb(3).ne.0 .or. qsumb(4).ne.0 .or. - + qsumb(5).ne.0 .or. qsumb(6).ne.0 .or. - + qsumb(7).ne.0 .or. qsumb(8).ne.0 .or. - + qsump(1).ne.0 .or. qsump(2).ne.0 .or. - + qsump(3).ne.0 .or. qsump(4).ne.0 .or. - + qsump(5).ne.0 .or. qsump(6).ne.0 .or. - + qsump(7).ne.0 .or. qsump(8).ne.0) then - call hfnt(ntacol+1) - endif - endif - evno = IDEVT - Egam = GETOT - do i=1,8 - qsum(i) = 0 - qsumb(i) = 0 - qsump(i) = 0 - enddo - call gfvert(1,vertx1,ntbeamx1,nttargx1,tofgx1,ubuf1,nubuf1) - endif - if (cnames(NLEVEL).eq.'PCTT' .or. - + cnames(NLEVEL).eq.'PCPB') then - ISTOP = 3 - NMEC = NMEC+1 - LMEC(NMEC) = 30 - elseif (NLEVEL.ge.7.and.cnames(7).eq.'ACWI') then - if (INWVOL.eq.2) then - qsum(NUMBER(7)) = qsum(NUMBER(7))-CHARGE - if (cnames(NLEVEL).eq.'ACBI') then -c print *, '*-* leaving ACBI' - qsumb(NUMBER(7)) = qsumb(NUMBER(7))-CHARGE - elseif (cnames(NLEVEL).eq.'PIN1') then -c print *, '*-* leaving ACWI/PIN1' - qsump(NUMBER(7)) = qsump(NUMBER(7))-CHARGE - else -c print *, '*-* leaving ACWI' - endif - elseif ((INWVOL.eq.1).and.(NSTEP.gt.0)) then - qsum(NUMBER(7)) = qsum(NUMBER(7))+CHARGE - if (cnames(NLEVEL).eq.'ACBI') then -c print *, '*-* entering ACBI' - qsumb(NUMBER(7)) = qsumb(NUMBER(7))+CHARGE - elseif (cnames(NLEVEL).eq.'PIN1') then -c print *, '*-* entering ACWI/PIN1' - qsump(NUMBER(7)) = qsump(NUMBER(7))+CHARGE - else -c print *, '*-* entering ACWI' - endif - endif - elseif (NLEVEL.ge.7.and.cnames(7).eq.'ACWO') then - if (INWVOL.eq.2) then - qsum(NUMBER(7)+4) = qsum(NUMBER(7)+4)-CHARGE - if (cnames(NLEVEL).eq.'ACBO') then -c print *, '*-* leaving ACBO' - qsumb(NUMBER(7)+4) = qsumb(NUMBER(7)+4)-CHARGE - elseif (cnames(NLEVEL).eq.'PIN1') then -c print *, '*-* leaving ACWO/PIN1' - qsump(NUMBER(7)+4) = qsump(NUMBER(7)+4)-CHARGE - else -c print *, '*-* leaving ACWO' - endif - elseif ((INWVOL.eq.1).and.(NSTEP.gt.0)) then - qsum(NUMBER(7)+4) = qsum(NUMBER(7)+4)+CHARGE - if (cnames(NLEVEL).eq.'ACBO') then -c print *, '*-* entering ACBO' - qsumb(NUMBER(7)+4) = qsumb(NUMBER(7)+4)+CHARGE - elseif (cnames(NLEVEL).eq.'PIN1') then -c print *, '*-* entering ACWO/PIN1' - qsump(NUMBER(7)+4) = qsump(NUMBER(7)+4)+CHARGE - else -c print *, '*-* entering ACWO' - endif - endif - endif -#endif - -#ifdef BACKGROUND_STUDIES - if (.not.HEXIST(bgnt)) then - call HBNT(bgnt,'background particles','') - call HBNAME(bgnt,'tracks',type,bgntdef) - endif - if (INWVOL.eq.1) then - z = VECT(3) - r = sqrt(VECT(1)**2 + VECT(2)**2) - if (cnames(NLEVEL).eq.'PCTT' .or. - + cnames(NLEVEL).eq.'PCPB') then - ISTOP = 3 - NMEC = NMEC+1 - LMEC(NMEC) = 30 - elseif ((cnames(NLEVEL).eq.'UWIT' .and. abs(z-0.02).lt.0.1) - + .or. (cnames(NLEVEL).eq.'VRTX' .and. abs(r-4.95).lt.0.1) - + .or. (cnames(NLEVEL).eq.'CDCI' .and. abs(r-15.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'DC12' .and. abs(r-37.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'CDCO' .and. abs(r-59.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'BCAL' .and. abs(r-65.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'FDC ' .and. abs(z-224.).lt.1.0) - + .or. (cnames(NLEVEL).eq.'CERE' .and. abs(z-410.).lt.1.0) - + .or. (cnames(NLEVEL).eq.'FCAL' .and. abs(z-575.).lt.1.0)) - + then - xv(1) = VECT(1) - xv(2) = VECT(2) - xv(3) = VECT(3) - xv(4) = r - type = IPART - Etot = GETOT - call HFNT(bgnt) - endif - endif -#endif - -#if defined WERNERS_VTX_NTUPLE - if (.not.HEXIST(ntwerner)) then - call HBNT(ntwerner,'vertex counter hits','') - call HBNAME(ntwerner,'hits',evno,ntwernerdef) - endif - if (NSTEP.eq.0) then - xvtx(1) = vect(1) - xvtx(2) = vect(2) - xvtx(3) = vect(3) - elseif (INWVOL.eq.1) then - if (cnames(NLEVEL).eq.'STRC') then - vid = 1 - elseif (cnames(NLEVEL).eq.'STRP') then - vid = 2 - else - vid = 0 - endif - if (vid.gt.0) then - xdet(1) = VECT(1) - xdet(2) = VECT(2) - xdet(3) = VECT(3) - pdet(1) = VECT(4)*VECT(7) - pdet(2) = VECT(5)*VECT(7) - pdet(3) = VECT(6)*VECT(7) - part = IPART - evno = IDEVT - call HFNT(ntwerner) - endif - endif -#elif defined CERENKOV_PID_NTUPLE - if (.not.HEXIST(ntckov)) then - call HBNT(ntckov,'cerenkov counter hits','') - call HBNAME(ntckov,'hits',evno,ntckovdef) - endif - if (NSTEP.eq.0) then - xvtx(1) = vect(1) - xvtx(2) = vect(2) - xvtx(3) = vect(3) - elseif (INWVOL.eq.1) then - if (cnames(NLEVEL).eq.'CGAS') then - xdet(1) = VECT(1) - xdet(2) = VECT(2) - xdet(3) = VECT(3) - pdet(1) = VECT(4)*VECT(7) - pdet(2) = VECT(5)*VECT(7) - pdet(3) = VECT(6)*VECT(7) - part = IPART - evno = IDEVT - call HFNT(ntckov) - endif - endif -#elif defined FCAL_SPLASH_NTUPLE - if (.not.HEXIST(ntfspl)) then - call HBNT(ntfspl,'FCal splash hits','') - call HBNAME(ntfspl,'hits',evno,ntfspldef) - endif - if (ISTAK.eq.0.and.NSTEP.eq.0) then - part = IPART - evno = IDEVT - nfcal = 0 - elseif (ISTAK.eq.0.and.ISTOP.ne.0) then - xconv(1) = vect(1) - xconv(2) = vect(2) - xconv(3) = vect(3) - xconv(4) = vect(4) - xconv(5) = vect(5) - xconv(6) = vect(6) - pconv = vect(7) - elseif (cnames(NLEVEL).eq.'LGBL'.and.DESTEP.gt.1e-3) then - row = getrow_wrapper() - col = getcolumn_wrapper() - do i=1,nfcal - if (col.eq.xfcal(i).and.row.eq.yfcal(i)) then - goto 810 - endif - enddo - nfcal = nfcal+1 - i = nfcal - xfcal(i) = col - yfcal(i) = row - Efcal(i) = 0 - 810 continue - Efcal(i) = Efcal(i)+DESTEP - endif - if (ISTOP.ne.0.and.IQ(JSTAK+1).eq.0) then - call HFNT(ntfspl) - endif -#elif defined FCAL_SHOWER_PROFILE_NTUPLE -c -c create ntuple -c - if (.not.HEXIST(ntfsp)) then - call HBNT(ntfsp,'FCal shower profile','') - call HBNAME(ntfsp,'hits',evno,ntfspdef) - endif -c -c get information about primary and -c reset division variables -c - if (ISTAK.eq.0.and.NSTEP.eq.0) then - evno = IDEVT - part = IPART - ndiv = 0 - do ix = 1, NXDIVISIONS - do iy = 1, NYDIVISIONS - do iz = 1, NZDIVISIONS - edivisions(ix,iy,iz) = 0.0 - enddo - enddo - enddo - xinit(1) = vect(1) - xinit(2) = vect(2) - xinit(3) = vect(3) - pinit(1) = vect(4)*vect(7) - pinit(2) = vect(5)*vect(7) - pinit(3) = vect(6)*vect(7) -c -c find the location where the primary stops -c - elseif (ISTAK.eq.0.and.ISTOP.ne.0) then - xstop(1) = vect(1) - xstop(2) = vect(2) - xstop(3) = vect(3) -c -c record energy depositions in fcal divisions -c - elseif (cnames(NLEVEL).eq.'LGBL'.and.DESTEP.gt.0.0) then - ixdivision = int((vect(1)-XDIVISIONSTART)/XDIVISIONSIZE) + 1 - iydivision = int((vect(2)-YDIVISIONSTART)/YDIVISIONSIZE) + 1 - izdivision = int((vect(3)-ZDIVISIONSTART)/ZDIVISIONSIZE) + 1 - if ((ixdivision.ge.1).and.(ixdivision.le.NXDIVISIONS).and. - + (iydivision.ge.1).and.(iydivision.le.NYDIVISIONS).and. - + (izdivision.ge.1).and.(izdivision.le.NZDIVISIONS)) then - edivisions(ixdivision,iydivision,izdivision) = - + edivisions(ixdivision,iydivision,izdivision) + DESTEP - endif - endif -c -c rearrange division information and record ntuples -c - if (ISTOP.ne.0.and.IQ(JSTAK+1).eq.0) then - do ix = 1, NXDIVISIONS - do iy = 1, NYDIVISIONS - do iz = 1, NZDIVISIONS - if (edivisions(ix,iy,iz).ge.MINIMUMENERGYPERDIVISION) then - if (ndiv.lt.10000) then - ndiv = ndiv + 1 - xdiv(ndiv) = ix*XDIVISIONSIZE + XDIVISIONSTART - + - XDIVISIONSIZE/2.0 - ydiv(ndiv) = iy*YDIVISIONSIZE + YDIVISIONSTART - + - YDIVISIONSIZE/2.0 - zdiv(ndiv) = iz*ZDIVISIONSIZE + ZDIVISIONSTART - + - ZDIVISIONSIZE/2.0 - ediv(ndiv) = edivisions(ix,iy,iz) - endif - endif - enddo - enddo - enddo - call HFNT(ntfsp) - endif -c -c -#elif defined FCAL_RADIATION_HISTOGRAMS -c -c book histograms -c - if (.not.HEXIST(1000)) then - call HBOOK2(1000,'rad',240,-120.,120.,240,-120.,120.,0) - do iz = 1, 60 - call HBOOK2(1620+iz-1,'rad',240,-120.,120.,240,-120.,120.,0) - enddo - endif -c -c record energy depositions -c - if (cnames(NLEVEL).eq.'LGBL'.and.DESTEP.gt.0.0) then - call HFILL(1000, vect(1),vect(2),DESTEP) - call HFILL(1000+int(vect(3)),vect(1),vect(2),DESTEP) - endif -c -c -#elif defined BCAL_RESOLUTION_NTUPLE - if (.not.HEXIST(ntbcal)) then - call HBNT(ntbcal,'BCal shower energy deposition','') - call HBNAME(ntbcal,'deposits',evno,ntbcaldef) - endif - if (ITRA.eq.1.and.ISTAK.eq.0.and.NSTEP.eq.0) then - evno=IDEVT - pphot(1) = VECT(4)*VECT(7) - pphot(2) = VECT(5)*VECT(7) - pphot(3) = VECT(6)*VECT(7) - pphot(4) = VECT(7) - elseif (DESTEP.gt.0.and. - + NLEVEL.gt.6.and.cnames(6).eq.'BCAM') then - dE=DESTEP - xdep(1)=vect(1) - xdep(2)=vect(2) - xdep(3)=vect(3) - call HFNT(ntbcal) - endif -#endif - -* Optionally store particle trajectory - if (storetraj.ne.0) then - if (storetraj.eq.1.or.storetraj.eq.2.or. - + (storetraj.eq.4.and.ISTAK.ne.0)) then - call addtrajectorypoint(VECT,TOFG,DESTEP,GEKIN,ITRA,ISTAK - + ,IPART, RADL, SLENG, NMEC, LMEC, storetraj) - else - call addtrajectorypoint(VECT,TOFG,DESTEP,GEKIN,ITRA,ISTAK - + ,IPART, RADL, STEP, NMEC, LMEC, storetraj) - endif - endif - - -c #ifndef TRACK_SHOWERS_IN_COLLIMATOR - if(showersincol.eq.0) then - if ((cnames(NLEVEL).eq.'INSU').or. - + (cnames(NLEVEL).eq.'PCTT').or. - + (cnames(NLEVEL).eq.'PCPB')) then - ISTOP = 3 - NMEC = NMEC+1 - LMEC(NMEC) = 30 - endif - endif -* #endif - - -#ifdef HISTOGRAM_MATERIAL_SEEN_BY_FIRST_TRACK - if (ITRA.eq.1.and.ISTAK.eq.0) then - if (NSTEP.eq.0) then - title = 'material in g/cm2 seen by first track' - call HBOOK1(IDEVT,title,1000,0.,200.,0) - title = 'radiation lengths seen by first track' - call HBOOK1(IDEVT+1000000,title,700,0.,700.,0) - endif - call HFILL(IDEVT,SLENG,0.,STEP*DENS) - call HFILL(IDEVT+1000000,VECT(3),0.,STEP/RADL) - endif -#endif - -* Register hits in sensitive detectors here - - if (ISVOL.ne.0.or.ISTOP.ne.0.or.INWVOL.ge.2) then - call savehits - endif - -* Stamp truth shower info at the entrance to the calorimeters. -* This is already done within the active volume of the calorimeters -* in savehits below, but the case of the BCAL is special because it -* has a big block of aluminum in front of the active volume in which -* more than half of the incident gammas convert and start to shower, -* fragmenting the bcalTruthShower information into a gazillion bits. -* Catching the gamma when it enters the outer BCAL aluminum shell -* makes the bcalTruthShower information much more useful for -* developers of shower reconstruction algorithms. - - if (INWVOL.eq.1.and.ISTORY.eq.0) then - if (cnames(nlevel).eq.'BCAL'.or.cnames(nlevel).eq.'BCAM') then - xin(1) = VECT(1) - xin(2) = VECT(2) - xin(3) = VECT(3) - xin(4) = TOFG - pin(1) = VECT(4) - pin(2) = VECT(5) - pin(3) = VECT(6) - pin(4) = GETOT - pin(5) = VECT(7) - dEsum = 0 - call hitBarrelEMcal(xin,xout,pin,pout,dEsum, - > ITRA,ISTAK,ISTORY,IPART) - ISTORY = 1 ! this particle has entered the BCal (inherited trait) - endif - endif - -* Set flag to indicate we are in a special area (eg. CAVE, BCAL, FCAL) -* where explicit identification of secondaries needs to be limited. - - area = 0 - do i=1,NLEVEL - if (cnames(i).eq.'BCAL'.or.cnames(i).eq.'GCAL') then - area = 1 - else if (cnames(i).eq.'FCAL'.or.cnames(i).eq.'CCAL') then - area = 2 - else if (cnames(i).eq.'CAVE'.or.cnames(i).eq.'UPV ') then - area = 3 - endif - enddo - -* Place any secondaries generated during this step onto the stack - - if (nosecondaries.eq.0) then - do i=1,NGKINE -c make primary except if in calorimeter volume and not hadronic -c interaction, or except if produced in cave upstream of Hall D - iflgk(i) = 1 - cint = KCASE - if ((area.ne.0.or.ISTORY.ne.0).and.cchar.ne.'HADR') then - iflgk(i) = 0 - endif - call GSKING(i) - enddo - endif - -* check if particle did decay in which case save vertex and particles - - if (ISTOP .eq. 1) then - mechanism = KCASE - if ((NGKINE>0) .and. (chcase.eq.'DCAY')) then - if (area.eq.0.and.ISTORY.eq.0) then - call savenewvertex(KCASE,NGKINE,GKIN,VECT, - + TOFG,iflgk,IPART,ITRA,ISTAK) - endif - endif - endif - - CALL GDEBUG - - END diff --git a/src/programs/Simulation/HDGeant/gustep.F_review2008 b/src/programs/Simulation/HDGeant/gustep.F_review2008 deleted file mode 100644 index ca7f9e0dd7..0000000000 --- a/src/programs/Simulation/HDGeant/gustep.F_review2008 +++ /dev/null @@ -1,585 +0,0 @@ -* -* $Id: gustep.F 4225 2008-09-17 22:27:02Z jonesrt $ -* -* $Log$ -* Revision 1.23 2008/12/16 19:36:04 somov -* gustep.F_review2008 -* - Stop beam photons which are initially generated -* outside the 12.4 cm radius beam pipe at the entrance -* to the collimator cave. -* - The primary collimator volume COL1 was replaced by -* volumes PCTT, PCTB, and PCSD (these volumes are used -* if one wants to stop showers in the 1st collimator). -* -* Revision 1.22 2005/12/27 01:14:28 jonesrt -* gustep.F -* - removed FDC cathode strips from the list of sensitive volumes where -* hits can occur -- the cathode strips themselves are not sensitive, -* they just pick up signals from the anode wires, as in the statement -* no anode hit => no cathode hit! -* --rtj-- -* -* -* Revision 1.21 2005/12/12 15:38:46 jonesrt -* hitutil.F -* - removed from top-level, moved into new subdir hitutil [rtj] -* hitBCal.c -* - increased the segmentation of the BCal readout [rtj] -* cdcdump.c -* - added a check for the existence of certain groups [rtj] -* gustep.F -* - added dispatch for additional BCal readout sections [rtj] -* Makefile.orig -* - removed compilation of hitutil.F, added libhitutil.a linkage [rtj] -* -* Revision 1.20 2005/06/22 15:32:16 zisis -* -* First draft of this routine to work with the new BCAL geometry and hits. CX. -* -* Revision 1.19 2005/04/26 14:51:52 ostrov -* Addition of UPV -* -* Revision 1.19 2005/03/20 ao -* hitUPV.c -* Makefile.orig -* gustep.F -* - support for hits in UPV -* -* Revision 1.18 2005/01/29 19:25:28 jonesrt -* hitLGD.c -* - renamed to hitFCal.c [rtj] -* Makefile.orig -* - modified to reflect the name change for hitLGD.c [rtj] -* control.in -* - it seems that I always have touched this file at some point! [rtj] -* gustep.F -* - added argument ISTAK to argument list for hitXXX functions, so that -* they can determine whether a given track is the primary or not [rtj] -* - some of the names of volumes have been changed in the recent geometry -* update, reflect that fact in the Makefile [rtj] -* hddm_s.c, hddm_s.h -* - updated from hddm (you should generate these using hddm-c and then -* copy them over from hddm to this folder) [rtj] -* hddsGeant3.F -* - updated from hdds (you should generate this using hdds-geant and -* then copy it over from hdds to this folder) [rtj] -* uginit.F -* - added a line to switch HBOOK from //LUN3 (closed after return from -* GRFILE) back to the geant.hbook output file on unit 50 [rtj] -* hddmInput.c -* - modified to store the actual coordinates of the event vertex in the -* Monte Carlo section of the output record, in case that the vertex -* was generated by the simulator instead of the generator [rtj] -* hitXXX.c -* - modified to accommodate an extra tag primary="boolean" on all of -* the cheat tags, to tell whether the hit was produced by one of the -* original primaries, or by a secondary produced by one of them. -* - hitFTOF.c modified to accommodate two layers instead of one [rtj] -* - hitStart.c modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - added a cheat tag to the Cerenkov readout [rtj] -* - all cheat tags have been modified to report all three coordinates -* (in the global reference system) instead of only two [rtj] -* -* Revision 1.17 2005/01/21 09:34:05 davidl -* If ff card NOSECONDARIES set, then don't push any secondaries onto the stack -* -* Revision 1.16 2004/06/17 18:32:55 davidl -* Fixed typo that caused comment to be misleading -* -* Revision 1.15 2004/06/07 19:05:53 jonesrt -* Makefile, gustep.F -* - added option CERENKOV_PID_NTUPLE to save information from a bg -* simulation to an ntuple stored in geant.hbook [rjt,rem] -* -* Revision 1.14 2004/05/18 12:58:54 jonesrt -* Makefile -* - created a section at the top for global defines that are used to -* build custom versions of the simulation [rtj] -* hddm_s.c, hddm_s.h -* - default i/o library modules (generated by hddm package) [rtj] -* hddsGeant3.F -* - default geometry module (generated by hdds package) [rtj] -* hitStart.c -* - changes to accomodate new vertex counter cylinder+plane structure [rtj] -* guout.F, gustep.F -* - defines for custom builds moved from sources to Makefile -* gustep.F -* - new conditional WERNERS_VTX_NTUPLE sections added for background -* studies in the region of the vertex counter [rtj] -* -* Revision 1.13 2004/01/14 16:34:48 brash -* Fixed bug in gustep.F regarding placement of certain assignment statements with -* respect to certain #ifdef statements. Should work now with BACKGROUND_* defines -* turned either on or off. (EJB) -* -* Revision 1.12 2004/01/14 16:28:10 brash -* Updates in order to analyze different readout modules of the barrel calorimeter. (EJB) -* -* Revision 1.11 2003/12/10 15:32:57 jonesrt -* -control.in : never mind [rtj] -* -gukine.F : fixed a bug in the setting of polarization ppol used -* for polarization studies of the coherent bremsstrahlung source [rtj] -* -gustep.F : changed background studies facility to split data across -* separate ntuples, one for each virtual detector [rtj] -* -hit*.F : modified behaviour from "quit" to "truncate" in the case where -* the number of hits exceeds the maximum allowed for that counter [rtj] -* -* Revision 1.10 2003/01/08 19:17:34 jonesrt -* - gustep.F : added collection of information in a backgrounds ntuple - rtj -* - gufld.F : enabled magnetic field in sweep magnets, was off before - rtj -* -* Revision 1.9 2003/01/02 23:49:33 jonesrt -* - included updates in gustep.F with conditional code for background -* studies, by R. Jones and C. Gauthier [rtj] -* - moved the beam origin a meter upstream in gukine.F to make room for -* additional shielding in the collimator cave [rtj] -* -* Revision 1.8 2001/12/19 02:34:55 jonesrt -* Fixed the names of sensitive volumes in the save-hits section of gustep.F, -* also added support for the r="float" parameter of in hitCDC.c. -* -rtj- -* -* Revision 1.7 2001/10/29 17:39:23 jonesrt -* - added mc truth info to output event for internal track/photon generators -* - added special code for background studies, selected by the conditional -* #define BACKGROUND_STUDIES (in gustep.F) -* - added conditional code to disable normal event output for bg studies, using -* #define DISABLE_OUTPUT (in guout.F) -* Both of the above defines are disabled in the distribution code by default. -* -rtj- -* -* Revision 1.6 2001/07/27 21:04:09 jonesrt -* With this release, HDGeant version 1.0 is now in beta. -rtj -* -* Revision 1.5 2001/07/24 05:37:16 jonesrt -* First working prototype of hits package -rtj -* -* Revision 1.4 2001/07/19 23:25:49 jonesrt -* numerous new files as I develop the prototype hits libraries -rtj -* -* Revision 1.3 2001/07/17 22:38:40 jonesrt -* Adding hits registry in gustep -rtj -* -* Revision 1.2 2001/07/15 07:31:37 jonesrt -* HDGeant now supports kinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:47 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUSTEP -* -************************************************************************ -* * -* User routine called at the end of each tracking step * -* MEC is the mechanism origin of the step * -* INWVOL is different from 0 when the track has reached * -* a volume boundary * -* ISTOP is different from 0 if the track has stopped * -* * -************************************************************************ -* -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gcomis.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcflag.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcbank.inc" -#include "geant321/gcmate.inc" -#include "hdtrackparams.inc" -* -* ----------------------------------------------------------------- -* - -#define TOP_CERENKOV_EFFICIENCY 0.25 - - character*80 title - character*4 cnames(15) - equivalence (NAMES(1),cnames(1)) - real rnd(100) - -#ifdef BACKGROUND_STUDIES - integer type - real xv(4),Etot - common /bgNtuple/type,xv,Etot - character*80 bgntdef - parameter (bgntdef='type:I,xv(4):R,Etot:R') - integer bgnt - parameter (bgnt=10) -#endif - -#ifdef BACKGROUND_PROFILING - integer det - real vertx(3),tofgx,ubuf(99),xint(3,999) - integer ntbeamx,nttargx,nubuf,mint - save ubuf,xint,det,mint - integer iorder(999) - save iorder -#endif - -#if defined WERNERS_VTX_NTUPLE - integer evno,part,vid - real xvtx(3),xdet(3),pdet(3) - common /wernerNtuple/evno,xvtx,xdet,pdet,part,vid - save /wernerNtuple/ - character*80 ntwernerdef - parameter (ntwernerdef='ev:I,xv(3):R,xt(3):R,p(3):R,part:I,vid:I') - integer ntwerner - parameter (ntwerner=10) -#elif defined CERENKOV_PID_NTUPLE - integer evno,part - real xvtx(3),xdet(3),pdet(3) - common /ckovNtuple/evno,xvtx,xdet,pdet,part - save /ckovNtuple/ - character*80 ntckovdef - parameter (ntckovdef='ev:I,xv(3):R,xt(3):R,p(3):R,part:I,vid:I') - integer ntckov - parameter (ntckov=10) -#elif defined FCAL_SPLASH_NTUPLE - integer evno,part - real xconv(6),pconv - integer nfcal - real xfcal(999),yfcal(999),Efcal(999) - common /fsplNtuple/evno,part,xconv,pconv,nfcal,xfcal,yfcal,Efcal - save /fsplNtuple/ - character*160 ntfspldef - parameter (ntfspldef='ev:I,part:I,xconv(6):R,pconv:R,' - + //'nfcal[0,999]:I,xfcal(nfcal):R,yfcal(nfcal):R,Efcal(nfcal):R') - integer ntfspl - parameter (ntfspl=10) - integer getrow,getcolumn - external getrow,getcolumn -#elif defined BCAL_RESOLUTION_NTUPLE - integer evno - real pphot(4),dE,xdep(3) - common /bcalresnt/evno,pphot,dE,xdep - save /bcalresnt/ - character*80 ntbcaldef - parameter (ntbcaldef='evno:I,pphot(4):R,dE:R,xdep(3):R') - integer ntbcal - parameter (ntbcal=33) -#endif - - logical hexist - external hexist - - real ph_radius - - -#ifdef BACKGROUND_PROFILING -******************************************************************************** -* The following defines an ntuple containing information on particle type -* energy, position, polarization, and at what virtual detector the -* particle passes through. the last colume entry is defined by a integer -* 'det' whose value is the number of the detector the particle passes -* through. The xint(icomp,iint) array records the vertex history of the -* interaction sequence leading to the detected particle, iint=1...mint. -******************************************************************************** - -********** assignment of the value of 'det' to a particle ****************** - - if (cnames(nlevel).eq.'DET1') then - det = 1 - elseif (cnames(nlevel).eq.'DET2') then - det = 2 - elseif (cnames(nlevel).eq.'DET3') then - det = 3 - elseif (cnames(nlevel).eq.'DET4') then - det = 4 - elseif (cnames(nlevel).eq.'DET5') then - det = 5 - elseif (cnames(nlevel).eq.'DET6') then - det = 6 - elseif (cnames(nlevel).eq.'DET7') then - det = 7 - elseif (cnames(nlevel).eq.'CONV') then - det = 8 - else - det = 0 - endif - -********************** Defintion of ntuple **************************** - - if (inwvol.eq.1.and.det.gt.1 -c + .and.((ipart.eq.2).or.(ipart.eq.3)) -c + .and.(vect(1)**2+vect(2)**2).gt.25.0) then - + ) then - call gfvert(1,vertx,ntbeamx,nttargx,tofgx,ubuf,nubuf) - if (.not.hexist(9+det)) then - write(title,"('hits in virtual detector',i3)") det - call hbnt(9+det,title,' ') - call hbname(9+det,'hits',gekin,'totE:r') - call hbname(9+det,'hits',vect,'x(7):r') - call hbname(9+det,'hits',ubuf,'ppol:r') - call hbname(9+det,'hits',ipart,'ptype:i') - call hbname(9+det,'hits',det,'det:i') - call hbname(9+det,'hits',mint,'mint[0,999]:i') - call hbname(9+det,'hits',xint,'xint(3,mint):r') - endif - call hfnt(9+det) - endif - if (nstep.eq.0) then - if (istak.eq.0) then - mint = 0 - else - do while (mint.gt.0.and.iorder(mint).gt.istak) - mint = mint-1 - enddo - if (mint.lt.999) then - mint = mint+1 - iorder(mint) = istak - xint(1,mint) = vect(1) - xint(2,mint) = vect(2) - xint(3,mint) = vect(3) - endif - endif - endif - -******************************************************************************** -#endif - - CALL GDEBUG - -* Register hits in sensitive detectors here - - if (ISVOL.ne.0) then - call savehits - endif - - -* Stop beam photons which are initially generated outside the 12.4 cm -* radius beam pipe at the entrance to the collimator cave - - IF(vect(3).eq.-2200.) THEN - ph_radius = sqrt(vect(1)*vect(1)+vect(2)*vect(2)) - IF(ph_radius.ge.12.4) THEN - ISTOP = 1 - ENDIF - ENDIF - - - - - -* Place any secondaries generated during this step onto the stack - - if (nosecondaries.eq.0) then - do i=1,NGKINE - itypa = GKIN(5,i) - if (itypa.ne.4) call GSKING(i) - enddo - endif - -* For explicit Cerenkov generation, apply an inefficiency factor - - if (NGPHOT.gt.100) then - call GRANOR(rnd(1),rnd(2)) - sigma = sqrt(NGPHOT * (TOP_CERENKOV_EFFICIENCY - + * (1 - TOP_CERENKOV_EFFICIENCY))) - NGPHOT = TOP_CERENKOV_EFFICIENCY*NGPHOT + rnd(1)*sigma + 0.5 - call GSKPHO(0) - elseif (NGPHOT.gt.0) then - call GRNDM(rnd,NGPHOT) - do i=1,NGPHOT - if (rnd(i).le.TOP_CERENKOV_EFFICIENCY) then - call GSKPHO(i) - endif - enddo - endif - -* Stop wimpy charged particles that are taking forever to range out - - if ((NSTEP.ge.9999).and.(CHARGE.ne.0).or. - + (ILOSS.eq.0).and.(GEKIN.lt.1e-3)) then - DESTEP = GEKIN - ISTOP = 1 - endif - -#ifdef BACKGROUND_STUDIES - if (.not.HEXIST(bgnt)) then - call HBNT(bgnt,'background particles','') - call HBNAME(bgnt,'tracks',type,bgntdef) - endif - if (INWVOL.eq.1) then - z = VECT(3) - r = sqrt(VECT(1)**2 + VECT(2)**2) - if ((cnames(NLEVEL).eq.'PCTT').or. - + (cnames(NLEVEL).eq.'PCTB').or. - + (cnames(NLEVEL).eq.'PCSD')) then - ISTOP = 1 - return - elseif ((cnames(NLEVEL).eq.'UWIT' .and. abs(z-0.02).lt.0.1) - + .or. (cnames(NLEVEL).eq.'VRTX' .and. abs(r-4.95).lt.0.1) - + .or. (cnames(NLEVEL).eq.'CDCI' .and. abs(r-15.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'DC12' .and. abs(r-37.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'CDCO' .and. abs(r-59.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'BCAL' .and. abs(r-65.0).lt.0.1) - + .or. (cnames(NLEVEL).eq.'FDC ' .and. abs(z-224.).lt.1.0) - + .or. (cnames(NLEVEL).eq.'CERE' .and. abs(z-410.).lt.1.0) - + .or. (cnames(NLEVEL).eq.'FCAL' .and. abs(z-575.).lt.1.0)) - + then - xv(1) = VECT(1) - xv(2) = VECT(2) - xv(3) = VECT(3) - xv(4) = r - type = IPART - Etot = GETOT - call HFNT(bgnt) - endif - endif -#endif - -#if defined WERNERS_VTX_NTUPLE - if (.not.HEXIST(ntwerner)) then - call HBNT(ntwerner,'vertex counter hits','') - call HBNAME(ntwerner,'hits',evno,ntwernerdef) - endif - if (NSTEP.eq.0) then - xvtx(1) = vect(1) - xvtx(2) = vect(2) - xvtx(3) = vect(3) - elseif (INWVOL.eq.1) then - if (cnames(NLEVEL).eq.'STRC') then - vid = 1 - elseif (cnames(NLEVEL).eq.'STRP') then - vid = 2 - else - vid = 0 - endif - if (vid.gt.0) then - xdet(1) = VECT(1) - xdet(2) = VECT(2) - xdet(3) = VECT(3) - pdet(1) = VECT(4)*VECT(7) - pdet(2) = VECT(5)*VECT(7) - pdet(3) = VECT(6)*VECT(7) - part = IPART - evno = IDEVT - call HFNT(ntwerner) - endif - endif -#elif defined CERENKOV_PID_NTUPLE - if (.not.HEXIST(ntckov)) then - call HBNT(ntckov,'cerenkov counter hits','') - call HBNAME(ntckov,'hits',evno,ntckovdef) - endif - if (NSTEP.eq.0) then - xvtx(1) = vect(1) - xvtx(2) = vect(2) - xvtx(3) = vect(3) - elseif (INWVOL.eq.1) then - if (cnames(NLEVEL).eq.'CGAS') then - xdet(1) = VECT(1) - xdet(2) = VECT(2) - xdet(3) = VECT(3) - pdet(1) = VECT(4)*VECT(7) - pdet(2) = VECT(5)*VECT(7) - pdet(3) = VECT(6)*VECT(7) - part = IPART - evno = IDEVT - call HFNT(ntckov) - endif - endif -#elif defined FCAL_SPLASH_NTUPLE - if (.not.HEXIST(ntfspl)) then - call HBNT(ntfspl,'FCal splash hits','') - call HBNAME(ntfspl,'hits',evno,ntfspldef) - endif - if (ISTAK.eq.0.and.NSTEP.eq.0) then - part = IPART - evno = IDEVT - nfcal = 0 - elseif (ISTAK.eq.0.and.ISTOP.ne.0) then - xconv(1) = vect(1) - xconv(2) = vect(2) - xconv(3) = vect(3) - xconv(4) = vect(4) - xconv(5) = vect(5) - xconv(6) = vect(6) - pconv = vect(7) - elseif (cnames(NLEVEL).eq.'LGBL'.and.DESTEP.gt.1e-3) then - row = getrow() - col = getcolumn() - do i=1,nfcal - if (col.eq.xfcal(i).and.row.eq.yfcal(i)) then - goto 810 - endif - enddo - nfcal = nfcal+1 - i = nfcal - xfcal(i) = col - yfcal(i) = row - Efcal(i) = 0 - 810 continue - Efcal(i) = Efcal(i)+DESTEP - endif - if (ISTOP.ne.0.and.IQ(JSTAK+1).eq.0) then - call HFNT(ntfspl) - endif -#elif defined BCAL_RESOLUTION_NTUPLE - if (.not.HEXIST(ntbcal)) then - call HBNT(ntbcal,'BCal shower energy deposition','') - call HBNAME(ntbcal,'deposits',evno,ntbcaldef) - endif - if (ITRA.eq.1.and.ISTAK.eq.0.and.NSTEP.eq.0) then - evno=IDEVT - pphot(1) = VECT(4)*VECT(7) - pphot(2) = VECT(5)*VECT(7) - pphot(3) = VECT(6)*VECT(7) - pphot(4) = VECT(7) - elseif (DESTEP.gt.0.and. - + NLEVEL.gt.6.and.cnames(6).eq.'BCAM') then - dE=DESTEP - xdep(1)=vect(1) - xdep(2)=vect(2) - xdep(3)=vect(3) - call HFNT(ntbcal) - endif -#endif - -* Optionally store particle trajectory - if (storetraj.ne.0) then - call addtrajectorypoint(VECT,TOFG,DESTEP,GETOT,ITRA,ISTAK - + ,IPART, RADL, STEP, NMEC, LMEC, storetraj) - endif - -#ifndef TRACK_SHOWERS_IN_COLLIMATOR - - if ((cnames(NLEVEL).eq.'INSU').or. - + (cnames(NLEVEL).eq.'PCTT').or. - + (cnames(NLEVEL).eq.'PCTB').or. - + (cnames(NLEVEL).eq.'PCSD')) then - ISTOP=1 - endif - if (cnames(NLEVEL).eq.'OCOL') then - ISTOP=1 - endif - -#endif - - -#ifdef HISTOGRAM_MATERIAL_SEEN_BY_FIRST_TRACK - if (ITRA.eq.1.and.ISTAK.eq.0) then - if (NSTEP.eq.0) then - title = 'material in g/cm2 seen by first track' - call HBOOK1(IDEVT,title,1000,0.,200.,0) - title = 'radiation lengths seen by first track' - call HBOOK1(IDEVT+1000000,title,700,0.,700.,0) - endif - call HFILL(IDEVT,SLENG,0.,STEP*DENS) - call HFILL(IDEVT+1000000,VECT(3),0.,STEP/RADL) - endif -#endif - - END diff --git a/src/programs/Simulation/HDGeant/guxcs.F b/src/programs/Simulation/HDGeant/guxcs.F deleted file mode 100644 index 851a11db72..0000000000 --- a/src/programs/Simulation/HDGeant/guxcs.F +++ /dev/null @@ -1,26 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2001/07/10 18:05:48 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:47 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 06/12/94 16.09.54 by S.Ravndal -*-- Author : S.Ravndal 06/12/94 - SUBROUTINE GUXCS -* -* User routine to declare addresses of FORTRAN routines -* and COMMONs which may be invoked from COMIS routines. -* Called by GXCS -* -#include "geant321/gcomis.inc" -* -c DIMENSION P(1) -* -* - END diff --git a/src/programs/Simulation/HDGeant/gvdcar.F b/src/programs/Simulation/HDGeant/gvdcar.F deleted file mode 100644 index b4a6347e8f..0000000000 --- a/src/programs/Simulation/HDGeant/gvdcar.F +++ /dev/null @@ -1,420 +0,0 @@ -*------------------------------------------------------------------------ -* fixes by rtj: The computation of the cartesian bounds of a volume with -* cylindrical symmetry (eg. TUBE, CONE, PGON, PCON, CTUB) -* was faulty in the original geant321 library source file, -* in the case where the symmetry axis was close to aligned -* with the z axis, and the cartesian bounds were asked for -* along the x or y direction. If the direction cosine of -* the placed volume's cylindrical axis was greater than -* 0.99 then it was treated as if it were exactly aligned, -* with direction cosine 1. This is very bad in the case -* of a long skinny tube, like a stereo layer drift tube in -* a drift chamber, because the transverse extent of the -* tube is much greater than its diameter when it is -* rotated away from 0 degrees. I changed the cutoff in -* the axis direction cosine from 0.99 to 0.999999 to -* reduce the impact of this approximation, but it should -* be kept in mind that tubes with extremely large aspect -* ratios greater than a million-to-one (might happen for -* very long thin wires) might still be underestimated if -* their stereo angle is on the order of a milliradian. -*------------------------------------------------------------------------ -* -* $Id: gvdcar.F,v 1.1.1.1 1995/10/24 10:20:56 cernlib Exp $ -* -* $Log: gvdcar.F,v $ -* Revision 1.1.1.1 1995/10/24 10:20:56 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/03 10/10/94 20.01.58 by S.Giani -*-- Author : - SUBROUTINE GVDCAR(IAXIS,ISH,IROT,PARS,CL,CH,IERR) -C. -C. ***************************************************************** -C. * * -C. * ROUTINE TO FIND THE LIMITS ALONG AXIS IAXIS IN CARTESIAN * -C. * COORDINATES FOR VOLUME OF SHAPE ISH ROTATED BY THE * -C. * ROTATION MATRIX IROT. THE SHAPE HAS NPAR PARAMETERS IN * -C. * THE ARRAY PARS. THE LOWER LIMIT IS RETURNED IN CL, THE * -C. * HIGHER IN CH. IF THE CALCULATION CANNOT BE MADE IERR IS * -C. * SET TO 1 OTHERWISE IT IS SET TO 0. * -C. * * -C. * ==>Called by : GVDLIM * -C. * Author S.Giani ******** * -C. * * -C. ***************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcshno.inc" - DIMENSION PARS(50),X(3),XT(3) -C. -C. --------------------------------------------------- -C. - IERR=1 - IF (ISH.GT.4.AND.ISH.NE.10.AND.ISH.NE.28) GO TO 40 -C -C CUBOIDS, TRAPEZOIDS, PARALLELEPIPEDS. -C -C - IERR=0 - CL=0 - CH=0 -C - DO 30 IP=1,8 -C -C THIS IS A LOOP OVER THE 8 CORNERS. -C FIRST FIND THE LOCAL COORDINATES. -C - IF(ISH.EQ.28) THEN -C -C General twisted trapezoid. -C - IL=(IP+1)/2 - I0=IL*4+11 - IS=(IP-IL*2)*2+1 - X(3)=PARS(1)*IS - X(1)=PARS(I0)+PARS(I0+2)*X(3) - X(2)=PARS(I0+1)+PARS(I0+3)*X(3) - GO TO 20 -C - ENDIF -C - IP3=ISH+2 - IF(ISH.EQ.10) IP3=3 - IF(ISH.EQ.4) IP3=1 - X(3)=PARS(IP3) - IF(IP.LE.4) X(3)=-X(3) - IP2=3 - IF(ISH.GT.2.AND.X(3).GT.0.0) IP2=4 - IF(ISH.EQ.1.OR.ISH.EQ.10) IP2=2 - IF(ISH.EQ.4) IP2=4 - IF(ISH.EQ.4.AND.X(3).GT.0.0) IP2=8 - X(2)=PARS(IP2) - IF(MOD(IP+3,4).LT.2) X(2)=-X(2) - IP1=1 - IF(ISH.NE.1.AND.ISH.NE.10.AND.X(3).GT.0.0) IP1=2 - IF(ISH.EQ.4) IP1=5 - IF(ISH.EQ.4.AND.X(3).GT.0.0) IP1=IP1+4 - IF(ISH.EQ.4.AND.X(2).GT.0.0) IP1=IP1+1 - X(1)=PARS(IP1) - IF(MOD(IP,2).EQ.1) X(1)=-X(1) -C - IF(ISH.NE.10) GO TO 10 - X(1)=X(1)+X(2)*PARS(4)+X(3)*PARS(5) - X(2)=X(2)+X(3)*PARS(6) - 10 CONTINUE -C - IF(ISH.NE.4) GO TO 20 - IP4=7 - IF(X(3).GT.0.0) IP4=11 - X(1)=X(1)+X(2)*PARS(IP4)+X(3)*PARS(2) - X(2)=X(2)+X(3)*PARS(3) - 20 CONTINUE -C -C ROTATE. -C - JROT=LQ(JROTM-IROT) - XT(1)=X(1) - XT(2)=X(2) - XT(3)=X(3) - IF(IROT.NE.0) CALL GINROT(X,Q(JROT+1),XT) -C -C UPDATE LIMITS IF NECESSARY. -C - IF(XT(IAXIS).LT.CL) CL=XT(IAXIS) - IF(XT(IAXIS).GT.CH) CH=XT(IAXIS) -C - 30 CONTINUE -C - GO TO 999 -C - 40 CONTINUE - IF(ISH.EQ.9) GO TO 90 -C -C TUBES , CONES, POLYGONS, POLYCONES. -C AND CUT TUBES. -C - MYFLAG=0 - IF((ISH.EQ.11.OR.ISH.EQ.12).AND.(IAXIS.LT.3))THEN - MYFLAG=1 - ENDIF - X(1)=0.0 - X(2)=0.0 - X(3)=1.0 - JROT=LQ(JROTM-IROT) - XT(1)=X(1) - XT(2)=X(2) - XT(3)=X(3) - IF(IROT.NE.0) CALL GINROT(X,Q(JROT+1),XT) -C -C XT IS Z AXIS ROTATED. -C - IF(MYFLAG.EQ.0)THEN -c fixes by RTJ: -c IF(ABS(XT(IAXIS)).LT.0.99) GO TO 50 - if(abs(xt(iaxis)).lt.0.999999) go to 50 - ELSE -c IF(ABS(XT(3)).LT.0.99) GO TO 50 - if(abs(xt(3)).lt.0.999999) go to 50 -c end of fixes by RTJ: - ENDIF - IF(ISH.EQ.11)GO TO 45 - IF(ISH.EQ.12)GO TO 46 -C -C PARALLEL. -C - IP=3 - IF(ISH.GT.6.AND.ISH.NE.NSCTUB.AND.ISH.NE.13.AND.ISH.NE.14) IP=1 - CL=-PARS(IP) - CH=PARS(IP) - IERR=0 -C - GO TO 999 - 45 IF(MYFLAG.EQ.0)THEN - NZLAST=INT(PARS(4)) - IZLAST=2+3*NZLAST - CL=PARS(5) - GO TO 49 - ELSEIF(MYFLAG.EQ.1)THEN - NZLAST=INT(PARS(4)) - IZLAST=2+3*NZLAST - TMPRAD=0. - DO 145 I=7,IZLAST+2,3 - IF(PARS(I).GT.TMPRAD)TMPRAD=PARS(I) - 145 CONTINUE - PHIMIN=PARS(1) - PHIMAX=PHIMIN+PARS(2) - AANG=ABS(PHIMAX-PHIMIN) - NANG=INT(PARS(3)) - AATMAX=NANG*360./AANG - LATMAX=INT(AATMAX) - ALA=AATMAX-LATMAX - IF(ALA.GT..5)LATMAX=LATMAX+1 - AFINV=REAL(1./COS(PI/LATMAX)) - FINV=ABS(AFINV) - R=TMPRAD*FINV - CL=-R - CH= R - IERR=0 - GOTO 999 - ENDIF -C - 46 IF(MYFLAG.EQ.0)THEN - NZLAST=INT(PARS(3)) - IZLAST=1+3*NZLAST - CL=PARS(4) - ELSEIF(MYFLAG.EQ.1)THEN - NZLAST=INT(PARS(3)) - IZLAST=1+3*NZLAST - TMPRAD=0. - DO 146 I=6,IZLAST+2,3 - IF(PARS(I).GT.TMPRAD)TMPRAD=PARS(I) - 146 CONTINUE - CL=-TMPRAD - CH= TMPRAD - IERR=0 - GOTO 999 - ENDIF -C - 49 CH=PARS(IZLAST) - IF ( ABS(XT(IAXIS)-X(IAXIS)) .GT.1.) THEN - TEMP = CL - CL = -CH - CH = -TEMP - ENDIF - IERR=0 - GO TO 999 -C - 50 CONTINUE -** - IF(ISH.EQ.13) THEN - CL=-PARS(IAXIS) - CH=PARS(IAXIS) - IERR=0 - GOTO 999 - ENDIF -** - IF(ISH.EQ.14) THEN -C for hyperboloid, use escribed cylinder - CH = REAL(SQRT(PARS(2)**2+(PARS(3)*TAN(PARS(4)*DEGRAD))**2)) - CL = -CH - IERR=0 - GOTO 999 - ENDIF -** - IF(ISH.GT.10.AND.ISH.NE.NSCTUB)GO TO 999 - IF(ABS(XT(IAXIS)).GT.0.01) GO TO 70 -C -C Z AXIS PERPENDICULAR TO IAXIS. ASSUME COMPLETE TUBE OR -C CONE (I.E. IGNORE PHI SEGMENTATION). -C - IF(ISH.GT.6.AND.ISH.NE.NSCTUB) GO TO 60 -C - CL=-PARS(2) - CH=PARS(2) - IERR=0 - IF(ISH.EQ.6)THEN - RMIN=PARS(1) - RMAX=PARS(2) - IF(IROT.NE.0)THEN - IF(Q(JROT+15).EQ.0.)THEN - PHI1=REAL((PARS(4)+Q(JROT+12))*DEGRAD) - PHI2=REAL((PARS(5)+Q(JROT+12))*DEGRAD) - ELSEIF(Q(JROT+15).EQ.180.)THEN - PHI1=REAL((PARS(4)+Q(JROT+12)-(PARS(5)-PARS(4)))*DEGRAD) - PHI2=REAL((PARS(5)+Q(JROT+12)-(PARS(5)-PARS(4)))*DEGRAD) - ELSE - GOTO 999 - ENDIF - ELSE - PHI1=REAL(PARS(4)*DEGRAD) - PHI2=REAL(PARS(5)*DEGRAD) - ENDIF - IF(IAXIS.EQ.1)THEN - IF(PHI1.GE.0..AND.PHI2.LE.PI)THEN - XMIN1=RMIN*COS(PHI2) - XMIN2=RMAX*COS(PHI2) - CL=MIN(XMIN1,XMIN2) - XMAX1=RMIN*COS(PHI1) - XMAX2=RMAX*COS(PHI1) - CH=MAX(XMAX1,XMAX2) - ELSEIF(PHI1.GE.PI.AND.PHI2.LE.TWOPI.OR. - + PHI1.GE.-PI.AND.PHI2.LE.0.)THEN - XMIN1=RMIN*COS(PHI1) - XMIN2=RMAX*COS(PHI1) - CL=MIN(XMIN1,XMIN2) - XMAX1=RMIN*COS(PHI2) - XMAX2=RMAX*COS(PHI2) - CH=MAX(XMAX1,XMAX2) - ELSEIF(PHI1.LT.0..AND.PHI2.GT.0..AND. - + (PHI2-PHI1).LE.PI)THEN - XMIN1=RMIN*COS(PHI2) - XMIN2=RMIN*COS(PHI1) - CL1=MIN(XMIN1,XMIN2) - XMIN3=RMAX*COS(PHI2) - XMIN4=RMAX*COS(PHI1) - CL2=MIN(XMIN3,XMIN4) - CL=MIN(CL1,CL2) - CH=RMAX - ELSEIF(PHI1.LT.PI.AND.PHI2.GT.PI.AND. - + (PHI2-PHI1).LE.PI)THEN - CL=-RMAX - XMAX1=RMIN*COS(PHI2) - XMAX2=RMIN*COS(PHI1) - CH1=MAX(XMAX1,XMAX2) - XMAX3=RMAX*COS(PHI2) - XMAX4=RMAX*COS(PHI1) - CH2=MAX(XMAX3,XMAX4) - CH=MAX(CH1,CH2) - ENDIF - ELSEIF(IAXIS.EQ.2)THEN - IF(PHI1.GE.(-PI*.5).AND.PHI2.LE.(PI*.5))THEN - YMIN1=RMIN*SIN(PHI1) - YMIN2=RMAX*SIN(PHI1) - CL=MIN(YMIN1,YMIN2) - YMAX1=RMIN*SIN(PHI2) - YMAX2=RMAX*SIN(PHI2) - CH=MAX(YMAX1,YMAX2) - ELSEIF(PHI1.GE.(PI*.5).AND.PHI2.LE.(PI*3*.5))THEN - YMIN1=RMIN*SIN(PHI2) - YMIN2=RMAX*SIN(PHI2) - CL=MIN(YMIN1,YMIN2) - YMAX1=RMIN*SIN(PHI1) - YMAX2=RMAX*SIN(PHI1) - CH=MAX(YMAX1,YMAX2) - ELSEIF(PHI1.LT.(PI*.5).AND.PHI2.GT.(PI*.5).AND. - + (PHI2-PHI1).LE.PI)THEN - YMIN1=RMIN*SIN(PHI2) - YMIN2=RMIN*SIN(PHI1) - CL1=MIN(YMIN1,YMIN2) - YMIN3=RMAX*SIN(PHI2) - YMIN4=RMAX*SIN(PHI1) - CL2=MIN(YMIN3,YMIN4) - CL=MIN(CL1,CL2) - CH=RMAX - ELSEIF(((PHI1.LT.(PI*3*.5).AND.PHI2.GT.(PI*3*.5)).OR. - + (PHI1.LT.-(PI*.5).AND.PHI2.GT.-(PI*.5))) - + .AND.(PHI2-PHI1).LE.PI)THEN - CL=-RMAX - YMAX1=RMIN*SIN(PHI2) - YMAX2=RMIN*SIN(PHI1) - CH1=MAX(YMAX1,YMAX2) - YMAX3=RMAX*SIN(PHI2) - YMAX4=RMAX*SIN(PHI1) - CH2=MAX(YMAX3,YMAX4) - CH=MAX(CH1,CH2) - ENDIF - ENDIF - ENDIF -C - GO TO 999 -C - 60 CONTINUE -C - RM=PARS(3) - IF(PARS(5).GT.PARS(3)) RM=PARS(5) -C - CL=-RM - CH=RM - IERR=0 -C - GO TO 999 -C - 70 CONTINUE -C -C ARBITRARY ROTATION. -C - DZ=PARS(3) - RM=PARS(2) - IF(ISH.EQ.13) THEN -** -** approxime to a cylinder whit radius -** equal to the ellipse major axis -** - IF(PARS(1).GT.RM) RM=PARS(1) - GOTO 80 - ENDIF -** - IF(ISH.EQ.14) THEN - RM = REAL(SQRT(PARS(2)**2+(PARS(3)*TAN(PARS(4)*DEGRAD))**2)) - GO TO 80 - ENDIF -* - IF(ISH.EQ.NSCTUB) THEN - S1 = (1.0-PARS(8))*(1.0+PARS(8)) - IF( S1 .GT. 0.0) S1 = SQRT(S1) - S2 = (1.0-PARS(11))*(1.0+PARS(11)) - IF( S2 .GT. 0.0) S2 = SQRT(S2) - IF( S2 .GT. S1 ) S1 = S2 - DZ = DZ+RM*S1 - ENDIF - IF(ISH.LE.6) GO TO 80 -C - DZ=PARS(1) - RM=PARS(3) - IF(PARS(5).GT.RM) RM=PARS(5) -C - 80 CONTINUE -C - COST=ABS(XT(IAXIS)) - SINT=(1+COST)*(1-COST) - IF(SINT.GT.0.0) SINT=SQRT(SINT) -C - CH=COST*DZ+SINT*RM - CL=-CH - IERR=0 -C - GO TO 999 - 90 CONTINUE -C -C SPHERE - ASSUME COMPLETE SPHERE, TAKE OUTER RADIUS. -C - IERR=0 - CL=-PARS(2) - CH=PARS(2) -C - 999 CONTINUE - END diff --git a/src/programs/Simulation/HDGeant/gxcs.F b/src/programs/Simulation/HDGeant/gxcs.F deleted file mode 100644 index fef02c39c8..0000000000 --- a/src/programs/Simulation/HDGeant/gxcs.F +++ /dev/null @@ -1,123 +0,0 @@ -#define CERNLIB_COMIS true -* -* June 12, 2000 -rtj -* Modified calls to csext so that arg1 (string) is not too long -* -* $Id$ -* -* $Log$ -* Revision 1.1 2001/07/08 06:24:33 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.3 2001/03/07 00:42:19 radphi -* Changes made by jonesrt@zeus -* several geometry fixes, LGD gain improvement -rtj -* -* Revision 1.2 1998/07/02 03:55:41 radphi -* Changes made by kurylov@jlabs4 -* Small improvements to geometry, corrections to materials, hits definitions -AAK -* -* Revision 1.1.1.1 1995/10/24 10:21:49 cernlib -* Geant -* -* -#include "geant321/pilot.h" -#if defined(CERNLIB_COMIS) -*CMZ : 20/06/95 09.32.44 by S.Ravndal -*-- Author : - SUBROUTINE GXCS -C. -C. ****************************************************************** -C. * * -C. * To initialize the COMIS package * -C. * To declare addresses of FORTRAN routines and COMMONs * -C. * which may be invoked from COMIS routines * -C. * (one can call CSOMAP instead) * -C. * * -C. ****************************************************************** -#include "geant321/gcbank.inc" -#include "geant321/gcmate.inc" -#include "geant321/gctmed.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gcflag.inc" -#include "geant321/gctrak.inc" -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gccuts.inc" -#include "geant321/gclist.inc" -#include "geant321/gcnum.inc" -#include "geant321/gconst.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcdraw.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gcomis.inc" -#include "geant321/gcsets.inc" - - DIMENSION P(1) -* - EXTERNAL GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS - EXTERNAL GSVERT,GSKINE,GSKING,GOPEN,GFIN,GCLOSE - EXTERNAL GFOUT - EXTERNAL GMATE,GSMATE,GSMIXT,GSTMED,GSTPAR,GPART,GPHYSI - EXTERNAL GFMATE,GPIONS - EXTERNAL GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP - EXTERNAL GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM - EXTERNAL GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT - EXTERNAL GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG - EXTERNAL GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD - EXTERNAL GDOPEN,GDCLOS,GDRAW,GDRAWC,GDSCAL,GDMAN,GDCOL - EXTERNAL GDELET,GDAXIS,GDRAWT - EXTERNAL GSCANK,GSCANU,GSCANO - EXTERNAL UGLAST -* -C. -C. ------------------------------------------------------------------ -C. - CALL PAWCS -* - CALL CSCOM('GCLINK,GCBANK,GCCUTS,GCFLAG,GCKINE,GCLIST#' - +, JDIGI,NZEBRA,CUTGAM,IDEBUG,IKINE,NHSTA,P,P,P,P) - CALL CSCOM('GCMATE,GCNUM,GCONST,GCPHYS,GCTMED,GCTRAK#' - +, NMAT,NMATE,PI,IPAIR,NUMED,VECT,P,P,P,P) - CALL CSCOM('GCUNIT,GCVOLU,GCDRAW,GCKING,GCMULO#',LIN,NLEVEL,NUMNOD - +, KCASE,SINMUL,P,P,P,P,P) -* - CALL CSEXT('GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS#' - +, GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS,P,P,P,P) - CALL CSEXT( - +'GSVERT,GSKINE,GSKING,GFIN,GOPEN,GCLOSE,GFOUT#', - + GSVERT,GSKINE,GSKING,GFIN,GOPEN,GCLOSE,GFOUT, - + P,P,P) - CALL CSEXT('GMATE,GSMATE,GFMATE,GSMIXT,GSTMED,GSTPAR,GPART#' - +, GMATE,GSMATE,GFMATE,GSMIXT,GSTMED,GSTPAR,GPART,P,P,P) - CALL CSEXT('GPIONS,GPHYSI#' - +, GPIONS,GPHYSI,P,P,P,P,P,P,P,P) - CALL CSEXT('GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP#' - +, GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP,P,P,P,P,P) - CALL CSEXT('GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM#' - +, GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM - +, P,P,P) - CALL CSEXT('GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT#' - +, GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT,P,P,P,P) - CALL CSEXT('GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG#' - +, GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG,P,P,P,P) - CALL CSEXT('GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD#' - +, GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD - +, P,P,P) - CALL CSEXT('GDOPEN,GDCLOS,GDELET,GDRAW,GDRAWC,GDAXIS,GDSCAL#' - +, GDOPEN,GDCLOS,GDELET,GDRAW,GDRAWC,GDAXIS,GDSCAL - +, P,P,P) - CALL CSEXT('GDMAN,GDCOL#' - +, GDMAN,GDCOL,P,P,P,P,P,P,P,P) - CALL CSEXT('GDRAWT#',GDRAWT,P,P,P,P,P,P,P,P,P) - CALL CSEXT('GSCANK,GSCANU,GSCANO,GBRSGE#',GSCANK,GSCANU,GSCANO, - + GBRSGE,P,P,P,P,P,P) - CALL CSEXT('UGLAST#',UGLAST,P,P - +, P,P,P,P,P,P,P) -* - CALL GUXCS -* - END - -#endif diff --git a/src/programs/Simulation/HDGeant/gxint.F b/src/programs/Simulation/HDGeant/gxint.F deleted file mode 100644 index 597f955a37..0000000000 --- a/src/programs/Simulation/HDGeant/gxint.F +++ /dev/null @@ -1,72 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.2 2004/03/15 16:32:27 jonesrt -* -gxint.F : increased the size of the pawc area to accomodate larger -* 2d histograms (without ZFATAL crashes) [rtj] -* -hitCDC.c : enclosed the sections relevant to barrel cathode strips in a -* conditional CATHODE_STRIPS_IN_CDC after they were removed from -* the CDC geometry definition by C. Meyer [rtj] -* -* Revision 1.1 2001/07/08 06:24:34 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.2 1997/01/07 10:25:42 cernlib -* Remove #ifdef CERNLIB_MAIN; this shall be done via Imakefile. -* -* Revision 1.1.1.1 1995/10/24 10:21:50 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.33 by S.Giani -*-- Author : - SUBROUTINE GXINT -* -* GEANT main program. To link with the MOTIF user interface -* the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas -* the routine GPAW(NWGEAN,NWPAW) gives access to the basic -* graphics version. -* -#if !defined(CERNLIB_IBM) - PARAMETER (NWGEAN=5000000,NWPAW=5000000) -#endif -#if defined(CERNLIB_IBM) - PARAMETER (NWGEAN=1000000,NWPAW=500000) -#endif - COMMON/GCBANK/GEANT(NWGEAN) - COMMON/PAWC/PAW(NWPAW) -#if defined(CERNLIB_HPUX) - ON REAL UNDERFLOW IGNORE -#endif -* -#if defined(CERNLIB_IBM) - CALL INITC - CALL ERRSET(151,999,-1) -#endif -#if (defined(CERNLIB_MOTIF))&&(!defined(CERNLIB_IBM)) - CALL GPAWPP(NWGEAN,NWPAW) -#endif -#if !defined(CERNLIB_MOTIF)||defined(CERNLIB_IBM) - CALL GPAW(NWGEAN,NWPAW) -#endif -* - END - SUBROUTINE QNEXT - END -#if !defined(CERNLIB_CZ) - SUBROUTINE CZOPEN - END - SUBROUTINE CZTCP - END - SUBROUTINE CZCLOS - END - SUBROUTINE CZPUTA - END -#endif -#if defined(CERNLIB_IBM) - FUNCTION IOSCLR() - IOSCLR=0 - END -#endif diff --git a/src/programs/Simulation/HDGeant/gxphys.F b/src/programs/Simulation/HDGeant/gxphys.F deleted file mode 100644 index 48fa74d181..0000000000 --- a/src/programs/Simulation/HDGeant/gxphys.F +++ /dev/null @@ -1,193 +0,0 @@ -* -* Jan 17, 2001 -rtj -* Fixed a typo in the setting of the flag ITCKOV (was ICKOV) -* -* $Id$ -* -* $Log$ -* Revision 1.1 2001/07/08 06:24:34 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.1 2001/06/25 14:05:32 radphi -* Changes made by jonesrt@hector -* added gxphys.F to the regular distribution -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:50 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 12/06/95 15.03.22 by S.Ravndal -*-- Author : - SUBROUTINE GXPHYS -C. -C. ****************************************************************** -C. * * -C. * Physics parameters control commands * -C. * * -C. * Author: R.Brun ********** * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcphys.inc" -#include "geant321/gccuts.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcunit.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gctmed.inc" - DIMENSION UCUTS(10),ULCUTS(10) - EQUIVALENCE(UCUTS(1),CUTGAM) - DIMENSION MECA(5,13) - EQUIVALENCE (MECA(1,1),IPAIR) - CHARACTER*6 CUTNAM(10) - CHARACTER*4 CEN(10) - CHARACTER*32 CHPATL - CHARACTER*(*) CHNUMB - PARAMETER (CHNUMB='1234567890') - DATA CUTNAM/'CUTGAM','CUTELE','CUTNEU','CUTHAD','CUTMUO', - + 'BCUTE' ,'BCUTM' ,'DCUTE' ,'DCUTM' ,'PPCUTM'/ -C. -C. ------------------------------------------------------------------ -C. - CALL KUPATL(CHPATL,NPAR) -* - IF(CHPATL.EQ.'ANNI')THEN - CALL KUGETI(IANNI) -* - ELSEIF(CHPATL.EQ.'AUTO')THEN - CALL KUGETI(IGAUTO) -* - ELSEIF(CHPATL.EQ.'BREM')THEN - CALL KUGETI(IBREM) -* - ELSEIF(CHPATL.EQ.'CKOV')THEN - CALL KUGETI(ITCKOV) -* - ELSEIF(CHPATL.EQ.'COMP')THEN - CALL KUGETI(ICOMP) -* - ELSEIF(CHPATL.EQ.'DCAY')THEN - CALL KUGETI(IDCAY) -* - ELSEIF(CHPATL.EQ.'DRAY')THEN - CALL KUGETI(IDRAY) -* - ELSEIF(CHPATL.EQ.'ERAN')THEN - CALL KUGETR(EKMIN) - CALL KUGETR(EKMAX) - CALL KUGETI(NEKBIN) - NEKBIN=MIN(NEKBIN,199) -* - ELSEIF(CHPATL.EQ.'HADR')THEN - CALL KUGETI(IHADR) -* - ELSEIF(CHPATL.EQ.'LABS')THEN - CALL KUGETI(ILABS) -* - ELSEIF(CHPATL.EQ.'LOSS')THEN - CALL KUGETI(ILOSS) - IF(ILOSS.EQ.2.OR.ILOSS.EQ.0)THEN - IDRAY=0 - ELSE - IDRAY=1 - ENDIF -* - ELSEIF(CHPATL.EQ.'MULS')THEN - CALL KUGETI(IMULS) -* - ELSEIF(CHPATL.EQ.'MUNU')THEN - CALL KUGETI(IMUNU) -* - ELSEIF(CHPATL.EQ.'PAIR')THEN - CALL KUGETI(IPAIR) -* - ELSEIF(CHPATL.EQ.'PFIS')THEN - CALL KUGETI(IPFIS) -* - ELSEIF(CHPATL.EQ.'PHOT')THEN - CALL KUGETI(IPHOT) -* - ELSEIF(CHPATL.EQ.'RAYL')THEN - CALL KUGETI(IRAYL) -* - ELSEIF(CHPATL.EQ.'STRA')THEN - CALL KUGETI(ISTRA) -* - ELSEIF(CHPATL.EQ.'SYNC')THEN - CALL KUGETI(ISYNC) -* - ELSEIF(CHPATL.EQ.'CUTS')THEN - IF(NPAR.LE.0)THEN - WRITE(LOUT,10000) -10000 FORMAT(/,' Current PHYSICS parameters:',/) - DO 10 I=1,10 - CALL GEVKEV(UCUTS(I),ULCUTS(I),CEN(I)) - WRITE(LOUT,10100)CUTNAM(I),ULCUTS(I),CEN(I) -10100 FORMAT(5X,A,' = ',F7.2,1X,A) - 10 CONTINUE - GO TO 999 - ENDIF - CALL KUGETR(CUTGAM) - CALL KUGETR(CUTELE) - CALL KUGETR(CUTHAD) - CALL KUGETR(CUTNEU) - CALL KUGETR(CUTMUO) - CALL KUGETR(BCUTE) - CALL KUGETR(BCUTM) - CALL KUGETR(DCUTE) - CALL KUGETR(DCUTM) - CALL KUGETR(PPCUTM) - CALL KUGETR(TOFMAX) - CALL KUGETR(GCUTS(1)) - IF(BCUTE.LE.0.)BCUTE=CUTGAM - IF(BCUTM.LE.0.)BCUTM=CUTGAM - IF(DCUTE.LE.0.)DCUTE=CUTELE - IF(DCUTM.LE.0.)DCUTM=CUTELE - IF(PPCUTM.LT.4.*EMASS)PPCUTM=REAL(4.*EMASS) -* - ELSEIF(CHPATL.EQ.'DRPRT')THEN - CALL KUGETI(IPART) - CALL KUGETI(IMATE) - CALL KUGETR(STEP) - CALL KUGETI(NPOINT) - CALL GDRPRT(IPART,IMATE,STEP,NPOINT) -* - ELSEIF(CHPATL.EQ.'PHYSI')THEN - IF(JTMED.GT.0)THEN - DO 30 I=1,IQ(JTMED-2) - JTM=LQ(JTMED-I) - IF(JTM.LE.0)GO TO 30 - IF(IQ(JTM-2).EQ.0)THEN - CALL MZPUSH(IXCONS,JTM,10,0,'I') - GO TO 30 - ENDIF - DO 20 J=1,10 - JTMI=LQ(JTM-J) - IF(JTMI.GT.0)THEN - CALL MZDROP(IXCONS,JTMI,' ') - ENDIF - 20 CONTINUE - 30 CONTINUE - CALL UCOPY(CUTGAM,Q(JTMED+1),10) - DO 40 I=1,13 - Q(JTMED+10+I)=MECA(1,I) - 40 CONTINUE - ENDIF - IF(JMATE.LE.0)GO TO 999 - DO 60 I=1,IQ(JMATE-2) - JMA=LQ(JMATE-I) - IF(JMA.LE.0)GO TO 60 - DO 50 J=1,IQ(JMA-2) - IF(J.EQ.4.OR.J.EQ.5)GO TO 60 - JM=LQ(JMA-J) - IF(JM.LE.0)GO TO 50 - CALL MZDROP(IXCONS,JM,'L') - 50 CONTINUE - 60 CONTINUE - CALL MZGARB (IXCONS, 0) - CALL GPHYSI - ENDIF -* - 999 END diff --git a/src/programs/Simulation/HDGeant/hddmInput.c b/src/programs/Simulation/HDGeant/hddmInput.c deleted file mode 100644 index 778030e0f5..0000000000 --- a/src/programs/Simulation/HDGeant/hddmInput.c +++ /dev/null @@ -1,577 +0,0 @@ -/* - * hddmInput - functions to handle Monte Carlo generator input to HDGeant - * through the standard hddm i/o mechanism. - * - * Interface: - * openInput(filename) - open input stream to file - * skipInput(count) - skip next events on open input file - * nextInput() - advance to next event on open input stream - * loadInput() - push current input event to Geant kine structures - * storeInput() - pop current input event from Geant kine structures - * closeInput() - close currently open input stream - * - * Richard Jones - * University of Connecticut - * July 13, 2001 - * - * Usage Notes: - * 1) Most Monte Carlo generators do not care where the vertex is placed - * inside the target, and specify only the final-state particles' - * momenta. In this case the vertex position has to be randomized by - * the simulation within the beam/target overlap volume. If the vertex - * position from the generator is (0,0,0) then the simulation vertex is - * generated uniformly inside the cylinder specified by TARGET_LENGTH, - * BEAM_DIAMETER, and TARGET_CENTER defined below. - * 2) The start time for the event in HDGeant is defined to be the - * instant the beam photon passes through the midplane of the target, - * or would have passed through the midplane if it had gotten that far. - * - * Revision history: - * - * > Aug 17, 2007 - David Lawrence - * Fill in id, parentid, pdgtype, and mech fields of reactions objects in HDDM. - * Mostly zeros, but it makes it clear the fields are invalid and allows - * cleaner printing. - * - * > Nov 17, 2006 - Richard Jones - * Added code to load_event that sets the Geant tofg parameter so - * that the start time of the event conforms to note (2) above. - * - * > Apr 10, 2006 - David Lawrence - * Added comments to explain a little what each of these routines is - * doing. No functional changes. - * - * > Dec 15, 2004 - Richard Jones - * Changed former behaviour of simulation to overwrite the vertex - * coordinates from the input record, if the simulation decides to - * override the input values. At present this happens whenever the - * input record specifies 0,0,0 for the vertex, but in the future it - * may be decided to let the simulator determine the vertex position - * in other cases. Since it is not part of the simulation proper, the - * decision was made to store this information in the reaction tag. - */ - -#define TARGET_LENGTH 29.9746 -#define BEAM_DIAMETER 0.5 -#define TARGET_CENTER 65 - - -#include -#include -#include - -#include -#include - -#include "gid_map.h" - -void seteventid_(int *runNo, int *eventNo); - -float settofg_(float origin[3], float *time0); - -s_iostream_t* thisInputStream = 0; -s_HDDM_t* thisInputEvent = 0; - -float beam_momentum[4]; -float target_momentum[4]; - -float get_beam_momentum_(const int *comp) { - return beam_momentum[*comp]; -} - -float get_target_momentum_(const int *comp) { - return target_momentum[*comp]; -} - -int extractRunNumber(int *runNo) { - thisInputEvent = read_s_HDDM(thisInputStream); - return *runNo = thisInputEvent->physicsEvents->in[0].runNo; -} - - - -/*------------------------- - * openInput - *------------------------- - */ -int openInput (char* filename) -{ - /* Open HDDM file for reading in "thrown" particle kinematics */ - thisInputStream = open_s_HDDM(filename); - return (thisInputStream == 0); -} - -/*------------------------- - * skipInput - *------------------------- - */ -int skipInput (int count) -{ - return count - skip_s_HDDM(thisInputStream,count); -} - -/*------------------------- - * nextInput - *------------------------- - */ -int nextInput () -{ - /* Read in the next HDDM event. This only reads it into the - * HDDM buffer "thisInputEvent" and does not yet define the - * particles to GEANT. See loadInput for that. - */ - if (thisInputStream == 0) - { - return 9; /* input stream was never opened */ - } - else if (thisInputEvent) - { - flush_s_HDDM(thisInputEvent, 0); - } - thisInputEvent = read_s_HDDM(thisInputStream); - return (thisInputEvent == 0); -} - -/*------------------------- - * loadInput - *------------------------- - */ -int loadInput (int override_run_number, int myInputRunNo) -{ - /* Extracts the "thrown" particle 4-vectors and types from the - * current HDDM buffer "thisInputEvent" and creates a vertex for - * them (gsvert) and defines the GEANT (gskine) for tracking. - */ - s_Reactions_t* reacts; - int reactCount, ir; - int runNo = (override_run_number>0)?(myInputRunNo):thisInputEvent->physicsEvents->in[0].runNo; - int eventNo = thisInputEvent->physicsEvents->in[0].eventNo; - seteventid_(&runNo,&eventNo); - reacts = thisInputEvent ->physicsEvents->in[0].reactions; - if (reacts == 0) - return 1; - reactCount = reacts->mult; - for (ir = 0; ir < reactCount; ir++) - { - s_Reaction_t* react = &reacts->in[ir]; - s_Beam_t* beam = react->beam; - s_Target_t* target = react->target; - s_Vertices_t* verts = react->vertices; - int vertCount = verts->mult; - s_Vertex_t* vert; - float zero = 0; - float v0[4]; - int iv; - - if (vertCount == 0) - { - continue; - } - - vert = &verts->in[0]; - v0[0] = vert->origin->vx; - v0[1] = vert->origin->vy; - v0[2] = vert->origin->vz; - v0[3] = vert->origin->t; - if ((v0[0] == 0) && (v0[1] == 0) && (v0[2] == 0)) - { - v0[0] = 1; - v0[1] = 1; - v0[2] = TARGET_CENTER; - while (v0[0]*v0[0] + v0[1]*v0[1] > 0.25) - { - int len = 3; - grndm_(v0,&len); - v0[0] -= 0.5; - v0[1] -= 0.5; - v0[2] -= 0.5; - } - v0[0] *= BEAM_DIAMETER; - v0[1] *= BEAM_DIAMETER; - v0[2] *= TARGET_LENGTH; - v0[2] += TARGET_CENTER; - v0[3] = (v0[3] == 0)? settofg_(v0,&zero) * 1e9 : 0; - } - else - { - v0[3] = (v0[3] == 0)? settofg_(v0,&zero) * 1e9 : 0; - v0[0] = 0; - v0[1] = 0; - v0[2] = 0; - } - - if (beam != NULL && beam != (s_Beam_t*)&hddm_s_nullTarget) - { - beam_momentum[0] = beam->momentum->E; - beam_momentum[1] = beam->momentum->px; - beam_momentum[2] = beam->momentum->py; - beam_momentum[3] = beam->momentum->pz; - } - else - { - beam_momentum[0] = 0; - beam_momentum[1] = 0; - beam_momentum[2] = 0; - beam_momentum[3] = 0; - } - - if (target != NULL && target != (s_Target_t*)&hddm_s_nullTarget) - { - target_momentum[0] = target->momentum->E; - target_momentum[1] = target->momentum->px; - target_momentum[2] = target->momentum->py; - target_momentum[3] = target->momentum->pz; - } - else - { - target_momentum[0] = 0; - target_momentum[1] = 0; - target_momentum[2] = 0; - target_momentum[3] = 0; - } - - for (iv = 0; iv < vertCount; iv++) - { - int ntbeam = 0; - int nttarg = 0; - int nubuf = 0; - float ubuf; - int nvtx; - float v[4]; - s_Products_t* prods; - int prodCount, ip; - vert = &verts->in[iv]; - v[0] = vert->origin->vx += v0[0]; - v[1] = vert->origin->vy += v0[1]; - v[2] = vert->origin->vz += v0[2]; - v[3] = vert->origin->t += v0[3]; - settofg_(v, &v[3]); - gsvert_(v, &ntbeam, &nttarg, &ubuf, &nubuf, &nvtx); - prods = vert->products; - prodCount = prods->mult; - for (ip = 0; ip < prodCount; ip++) - { - int ntrk; - float p[3]; - Particle_t kind; - s_Product_t* prod = &prods->in[ip]; - kind = prod->type; - - /* Don't tell geant to track particles that are intermediary types */ - if (kind <= 0) - continue; - - p[0] = prod->momentum->px; - p[1] = prod->momentum->py; - p[2] = prod->momentum->pz; - if (prod->decayVertex == 0) - { - gskine_(p, &kind, &nvtx, &ubuf, &nubuf, &ntrk); - gidSet(ntrk, ip + 1); - } - } - } - } - return 0; -} - -/*------------------------- - * storeInput - *------------------------- - */ -int storeInput (int runNo, int eventNo, int ntracks) -{ - /* This is called by the built-in generators (coherent brem. and - * single track) in order to store the "thrown" particle parameters - * in the output HDDM file. What this actually does is free the - * input buffer "thisInputEvent" if it exists and creates a new - * one. When an external generator is used, the thisInputEvent - * buffer is kept unmodified and this routine is never called. - */ - s_PhysicsEvents_t* pes; - s_Reactions_t* rs; - s_Vertices_t* vs; - s_Origin_t* or; - s_Products_t* ps; - int nvtx, ntbeam, nttarg, itra, nubuf; - float vert[3], plab[3], tofg, ubuf[10]; - Particle_t kind; - - if (thisInputEvent) - { - flush_s_HDDM(thisInputEvent, 0); - } - thisInputEvent = make_s_HDDM(); - thisInputEvent->physicsEvents = pes = make_s_PhysicsEvents(1); - pes->in[0].reactions = rs = make_s_Reactions(1); - pes->mult = 1; - rs->mult = 1; - rs->in[0].vertices = vs = make_s_Vertices(99); - /*printf("Make 99 Vertices!!!!!!!\n");*/ - vs->mult = 0; - for (itra = 1; itra <= ntracks; itra++) - { - char chnpar[99]; - int itrtyp; - float amass,charge,tlife; - gfkine_(&itra,vert,plab,&kind,&nvtx,ubuf,&nubuf); - gfpart_(&kind,chnpar,&itrtyp,&amass,&charge,&tlife,ubuf,&nubuf); - if (nvtx < 1) - { - return 1; - } - else - { - vs->mult = (nvtx < vs->mult)? vs->mult : nvtx; - } - gfvert_(&nvtx,vert,&ntbeam,&nttarg,&tofg,ubuf,&nubuf); - or = vs->in[nvtx-1].origin; - ps = vs->in[nvtx-1].products; - if (or == HDDM_NULL) - { - or = make_s_Origin(); - vs->in[nvtx-1].origin = or; - or->vx = vert[0]; - or->vy = vert[1]; - or->vz = vert[2]; - or->t = tofg * 1e9; - } - if (ps == HDDM_NULL) - { - ps = make_s_Products(ntracks); - vs->in[nvtx-1].products = ps; - ps->mult = 0; - } - ps->in[ps->mult].type = kind; - ps->in[ps->mult].pdgtype = 0; /* don't bother with the PDG type here */ - ps->in[ps->mult].id = itra; /* unique value for this particle within the event */ - gidSet(itra, itra); /* assume same value for geant id */ - ps->in[ps->mult].parentid = 0;/* All internally generated particles have no parent */ - ps->in[ps->mult].mech = 0; /* maybe this should be set to something? */ - ps->in[ps->mult].momentum = make_s_Momentum(); - ps->in[ps->mult].momentum->px = plab[0]; - ps->in[ps->mult].momentum->py = plab[1]; - ps->in[ps->mult].momentum->pz = plab[2]; - ps->in[ps->mult].momentum->E = sqrt(plab[0]*plab[0]+plab[1]*plab[1] - +plab[2]*plab[2]+amass*amass); - ps->mult++; - } - pes->in[0].runNo = runNo; - pes->in[0].eventNo = eventNo; - return 0; -} - -/*------------------------- - * storeBeam - *------------------------- - */ -int storeBeam (float vect[7], float t0) -{ - /* This is called from gukine in the case where the user wants to - * halt simulation and save the present (single) track in the - * Monte Carlo reactions header, perhaps for simulation later. - * The original vertex information is moved into the beam tag - * and then overwritten with the state of the current track. - * This function assumes that storeInput has already been called - * at least once for this event. - */ - - s_PhysicsEvents_t* pes; - s_Reactions_t* rs; - s_Beam_t* bs; - s_Vertices_t* vs; - s_Origin_t* or; - s_Products_t* ps; - int nvtx, ntbeam, nttarg, itra, nubuf; - float vert[3], plab[3], tofg, ubuf[10]; - Particle_t kind; - int ilast; - - pes = thisInputEvent->physicsEvents; - if (pes == 0 || pes == HDDM_NULL || pes->mult == 0) - return 0; - rs = pes->in[0].reactions; - if (rs == 0 || rs == HDDM_NULL || rs->mult == 0) - return 0; - vs = rs->in[0].vertices; - if (vs == 0 || vs == HDDM_NULL || vs->mult == 0) - return 0; - ps = vs->in[0].products; - if (ps == 0 || ps == HDDM_NULL || ps->mult == 0) - return 0; - bs = rs->in[0].beam; - if (bs == HDDM_NULL) - bs = make_s_Beam(); - ilast = ps->mult - 1; - bs->type = ps->in[ilast].type; - if (bs->momentum != HDDM_NULL) - FREE(bs->momentum); - bs->momentum = ps->in[ilast].momentum; - ps->in[ilast].momentum = HDDM_NULL; - if (bs->polarization != HDDM_NULL) - FREE(bs->polarization); - bs->polarization = ps->in[ilast].polarization; - ps->in[ilast].polarization = HDDM_NULL; - if (bs->properties != HDDM_NULL) - FREE(bs->properties); - bs->properties = ps->in[ilast].properties; - ps->in[ilast].properties = HDDM_NULL; - rs->in[0].beam = bs; - for (itra = 1; itra <= 1; itra++) { - char chnpar[99]; - int itrtyp; - float amass,charge,tlife; - gfkine_(&itra,vert,plab,&kind,&nvtx,ubuf,&nubuf); - gfpart_(&kind,chnpar,&itrtyp,&amass,&charge,&tlife,ubuf,&nubuf); - gfvert_(&nvtx,vert,&ntbeam,&nttarg,&tofg,ubuf,&nubuf); - or = vs->in[0].origin; - if (or == HDDM_NULL) { - vs->in[0].origin = or = make_s_Origin(); - } - or->vx = vect[0]; - or->vy = vect[1]; - or->vz = vect[2]; - or->t = t0 * 1e9; - ps->in[ilast].type = kind; - ps->in[ilast].pdgtype = 22; /* assume a beam photon */ - ps->in[ilast].id = itra; - ps->in[ilast].parentid = 0; - ps->in[ilast].mech = 0; - ps->in[ilast].momentum = make_s_Momentum(); - ps->in[ilast].momentum->px = vect[6] * vect[3]; - ps->in[ilast].momentum->py = vect[6] * vect[4]; - ps->in[ilast].momentum->pz = vect[6] * vect[5]; - ps->in[ilast].momentum->E = vect[6]; - } - return 1; -} - -/*------------------------- - * getseeds_ - *------------------------- - */ -int getseeds_(int *iseed1, int *iseed2) -{ - /* This checks to see if thisInputStream already - contains random number seeds for this event. If - it does, then those values are copied into the - iseed1 and iseed2 variables. If not, then the - contents of iseed1 and iseed2 are left unchanged. - */ - if (thisInputEvent == NULL) - return 0; - if (thisInputEvent->physicsEvents == NULL) - return 0; - if (thisInputEvent->physicsEvents->mult < 1) - return 0; - s_PhysicsEvent_t *pe = &thisInputEvent->physicsEvents->in[0]; - if (pe->reactions == NULL) - return 0; - if (pe->reactions->mult < 1) - return 0; - s_Random_t *rnd = pe->reactions->in[0].random; - if (rnd == NULL || rnd == HDDM_NULL) { - /* No seeds stored in event. Return */ - return 0; - } - else { - /* Seeds found in event, copy them back to caller for use */ - *iseed1 = rnd->seed1; - *iseed2 = rnd->seed2; - return 1; - } -} - -/*------------------------- - * storeseeds_ - *------------------------- - */ -int storeseeds_(int *iseed1, int *iseed2) -{ - /* This copies the given seed values into - thisInputStream, overwriting any values that - already exist there. - */ - if (thisInputEvent == NULL) - return 0; - if (thisInputEvent->physicsEvents == NULL) - return 0; - if (thisInputEvent->physicsEvents->mult < 1) - return 0; - s_PhysicsEvent_t *pe = &thisInputEvent->physicsEvents->in[0]; - if (pe->reactions == NULL) - return 0; - if (pe->reactions->mult < 1) - return 0; - s_Random_t *rnd = pe->reactions->in[0].random; - if (rnd == NULL || rnd == HDDM_NULL) { - /* No seeds stored in event. Add them */ - rnd = pe->reactions->in[0].random = make_s_Random(); - rnd->seed3 = 709975946 + pe->eventNo; - rnd->seed4 = 912931182 + pe->eventNo; - } - - rnd->seed1 = *iseed1; - rnd->seed2 = *iseed2; - - return 0; -} - -/*------------------------- - * closeInput - *------------------------- - */ -int closeInput () -{ - /* Close the HDDM input file */ - if (thisInputStream) - { - close_s_HDDM(thisInputStream); - thisInputStream = 0; - } - return 0; -} - - -/* entry points from Fortran */ - -int openinput_ (char* filename) -{ - int retcode = openInput(strtok(filename," ")); - return retcode; -} - -int skipinput_ (int* count) -{ - return skipInput(*count); -} - -int nextinput_ () -{ - return nextInput(); -} - -int loadinput_ (int *override_run_number,int *myInputRunNo) -{ - return loadInput(*override_run_number,*myInputRunNo); -} - -int storeinput_ (int* runNo, int* eventNo, int* ntracks) -{ - return storeInput(*runNo,*eventNo,*ntracks); -} - -int storebeam_ (float* vect, float* t) -{ - float t0 = *t; - return storeBeam(vect, t0); -} - -int closeinput_ () -{ - return closeInput(); -} - -int extractrunnumber_(int *runNo){ - return extractRunNumber(runNo); -} diff --git a/src/programs/Simulation/HDGeant/hddmOutput.c b/src/programs/Simulation/HDGeant/hddmOutput.c deleted file mode 100644 index 09a0a92f2a..0000000000 --- a/src/programs/Simulation/HDGeant/hddmOutput.c +++ /dev/null @@ -1,182 +0,0 @@ -/* - * hddmOutput - functions to handle output of simulation results from HDGeant - * through the standard hddm i/o mechanism. - * - * Interface: - * openOutput(filename) - open output stream to file - * loadOutput() - load output event from hit structures - * flushOutput() - flush current event structure to output stream - * closeOutput() - close currently open output stream - * - * Richard Jones - * University of Connecticut - * July 13, 2001 - */ - -#include -#include -#include - -#include -#include - -#include "memcheck.h" - -extern const char* GetMD5Geom(void); - -s_iostream_t* thisOutputStream = 0; -s_HDDM_t* thisOutputEvent = 0; -extern s_HDDM_t* thisInputEvent; - -static unsigned int Nevents = 0; - -int openOutput (char* filename) -{ - set_s_HDDM_buffersize(25000000); - set_s_HDDM_stringsize(25000000); - thisOutputStream = init_s_HDDM(filename); - return (thisOutputStream == 0); -} - -int flushOutput () -{ - if (thisOutputEvent != 0) - { - if (flush_s_HDDM(thisOutputEvent, thisOutputStream) != 0) { - fprintf(stderr,"Fatal error in flushOutput:"); - fprintf(stderr," write failed to hddm output file.\n"); - exit(7); - } - thisOutputEvent = 0; - } - checkpoint(); - return 0; -} - -int closeOutput () -{ - if (thisOutputStream) - { - close_s_HDDM(thisOutputStream); - thisOutputStream = 0; - } - return 0; -} - -int loadOutput (int runNo) -{ - int packages_hit=0; - s_HitView_t *hitView; - - Nevents++; - - if (thisOutputEvent) - { - flush_s_HDDM(thisOutputEvent, 0); - } - - thisOutputEvent = thisInputEvent; - thisInputEvent = 0; - if (thisOutputEvent == 0) - { - static int eventNo = 0; - thisOutputEvent = make_s_HDDM(); - thisOutputEvent->physicsEvents = make_s_PhysicsEvents(1); - thisOutputEvent->physicsEvents->mult = 1; - thisOutputEvent->physicsEvents->in[0].eventNo = ++eventNo; - } - thisOutputEvent->physicsEvents->in[0].runNo=runNo; - if (Nevents == 1) { - if (thisOutputEvent->geometry == HDDM_NULL) { - thisOutputEvent->geometry = make_s_Geometry(); - } - thisOutputEvent->geometry->md5simulation = strdup(GetMD5Geom()); - thisOutputEvent->geometry->md5smear = strdup(""); - thisOutputEvent->geometry->md5reconstruction = strdup(""); - } - - if (thisOutputEvent->physicsEvents->in[0].hitView == HDDM_NULL) - { - thisOutputEvent->physicsEvents->in[0].hitView = make_s_HitView(); - } - - hitView = thisOutputEvent->physicsEvents->in[0].hitView; - if ((hitView->centralDC = pickCentralDC()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->forwardDC = pickForwardDC()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->startCntr = pickStartCntr()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->barrelEMcal = pickBarrelEMcal()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->Cerenkov = pickCerenkov()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->DIRC = pickDirc()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->forwardTOF = pickForwardTOF()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->forwardEMcal = pickForwardEMcal()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->ComptonEMcal = pickComptonEMcal()) != HDDM_NULL) { - ++packages_hit; - } -#ifdef TESTING_CAL_CONTAINMENT - if ((hitView->gapEMcal = pickGapEMcal()) != HDDM_NULL) { - ++packages_hit; - } -#endif - if ((hitView->upstreamEMveto = pickUpstreamEMveto()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->tagger = pickTagger()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->pairSpectrometerFine = pickPs()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->pairSpectrometerCoarse = pickPsc()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->tripletPolarimeter = pickTpol()) != HDDM_NULL) { - ++packages_hit; - } - if ((hitView->mcTrajectory = pickMCTrajectory()) != HDDM_NULL) { - ++packages_hit; - } - if (packages_hit == 0) { - thisOutputEvent->physicsEvents->in[0].hitView = HDDM_NULL; - FREE(hitView); - } - return packages_hit; -} - -/* entry points from Fortran */ - -int openoutput_ (char* filename) -{ - int retcode = openOutput(strtok(filename," ")); - return retcode; -} - -int flushoutput_ () -{ - return flushOutput(); -} - -int loadoutput_ (int *runNo) -{ - return loadOutput(*runNo); -} - -int closeoutput_ () -{ - return closeOutput(); -} diff --git a/src/programs/Simulation/HDGeant/hddmOutput.h b/src/programs/Simulation/HDGeant/hddmOutput.h deleted file mode 100644 index 9cf5ce29dd..0000000000 --- a/src/programs/Simulation/HDGeant/hddmOutput.h +++ /dev/null @@ -1,15 +0,0 @@ -s_CentralDC_t* pickCentralDC (void); -s_ForwardDC_t* pickForwardDC (void); -s_StartCntr_t* pickStartCntr (void); -s_BarrelEMcal_t* pickBarrelEMcal (void); -s_Cerenkov_t* pickCerenkov (void); -s_DIRC_t* pickDirc (void); -s_ForwardTOF_t* pickForwardTOF (void); -s_ForwardEMcal_t* pickForwardEMcal (void); -s_ComptonEMcal_t* pickComptonEMcal (void); -s_UpstreamEMveto_t* pickUpstreamEMveto (void); -s_Tagger_t* pickTagger (void); -s_PairSpectrometerFine_t *pickPs(void); -s_PairSpectrometerCoarse_t *pickPsc(void); -s_TripletPolarimeter_t *pickTpol(void); -s_McTrajectory_t* pickMCTrajectory (void); diff --git a/src/programs/Simulation/HDGeant/hdgeant++.cc b/src/programs/Simulation/HDGeant/hdgeant++.cc deleted file mode 100644 index c5e75a44c6..0000000000 --- a/src/programs/Simulation/HDGeant/hdgeant++.cc +++ /dev/null @@ -1,112 +0,0 @@ - -#include -#include - -#include -#include -using namespace std; - -#include - - -// These are defined in copytoplusplus.cc -extern string INFILE; -extern string OUTFILE; -extern bool POSTSMEAR; -extern string MCSMEAROPTS; -extern bool DELETEUNSMEARED; - -// Defined in calibDB.cc -extern string HDDS_XML; - -// Declare routines callable from FORTRAN -extern "C" int gxint_(void); -extern "C" void init_runtime_xml_(void); // defined in dl_routines.cc -extern "C" const char* GetMD5Geom(void); // defined in calibDB.cc - -void Usage(void); - -// Get access to FORTRAN common block with some control flags -#include "controlparams.h" - -//------------------ -// main -//------------------ -int main(int narg, char *argv[]) -{ - // This is needed so calibDB.cc can use it to get the - // JCalibration object pointer. We want this to be done - // in the same way as all other sim-recon software - DApplication *dapp = new DApplication(narg, argv); - dapp->Init(); - - // Set some defaults. Note that most defaults related to the - // simulation are set in uginit.F - controlparams_.runtime_geom = 0; - - // Parse command line parameters - bool print_xml_md5_checksum = false; - for(int i=1; i -#include - -#include -#include -using namespace std; - -#include - - -// These are defined in copytoplusplus.cc -extern string INFILE; -extern string OUTFILE; -extern bool POSTSMEAR; -extern string MCSMEAROPTS; -extern bool DELETEUNSMEARED; - -// Defined in calibDB.cc -extern string HDDS_XML; - -// Declare routines callable from FORTRAN -extern "C" int hdgeant_(void); // define in hdgeant_f.F -extern "C" void init_runtime_xml_(void); // defined in dl_routines.cc -extern "C" const char* GetMD5Geom(void); // defined in calibDB.cc - -void Usage(void); - -// Get access to FORTRAN common block with some control flags -#include "controlparams.h" - -//------------------ -// main -//------------------ -int main(int narg, char *argv[]) -{ - // This is needed so calibDB.cc can use it to get the - // JCalibration object pointer. We want this to be done - // in the same way as all other sim-recon software - DApplication *dapp = new DApplication(narg, argv); - dapp->Init(); - - // Set some defaults. Note that most defaults related to the - // simulation are set in uginit.F - controlparams_.runtime_geom = 0; - - // Parse command line parameters - bool print_xml_md5_checksum = false; - for(int i=1; i -#include -#include - -#include -#include -#include -using namespace std; - -extern "C" { -#include -#include -#include -#include - -#include "calibDB.h" -} - -#include - -// The time histogram write-out algorithms have been removed. -// We now are working only with the cell truth hits method. -#define WRITE_OUT_BCAL_CELL_TRUTH_HITS 1 - -static float THRESH_MEV = 1.; -static float TWO_HIT_RESOL = 50.; -static int MAX_HITS = 100; - -binTree_t* barrelEMcalTree = 0; -static int cellCount = 0; -static int showerCount = 0; -static int initialized = 0; - -// The following will be changed in initializeBarrelEMcal -static double ATTEN_LENGTH = 300.0; -static double C_EFFECTIVE = 16.75; -static double SiPM_tbin_width = 0.100; -static double atten_full_length = exp(-390.0/ATTEN_LENGTH); -static double THRESH_ATTENUATED_GEV = (THRESH_MEV/1000.0)*atten_full_length; - -extern s_HDDM_t* thisInputEvent; - -// Prevent name mangling so these routines keep their -// C-style names in the object -extern "C"{ - void recordbcalentry_(int *mech, int *itra, int *istak, - int *ipart, float *vect, float *getot); - void hitBarrelEMcal (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart); - void hitbarrelemcal_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart); - s_BarrelEMcal_t* pickBarrelEMcal(); -} - -//.......................... -// bcal_index is a utility class that encapsulates the -// module, layer, sector, and end in a single object that -// can be used as a key to index an STL map. -//.......................... -class bcal_index{ - public: - enum EndType{ - kUp, - kDown - }; - - bcal_index(unsigned int module, - unsigned int layer, - unsigned int sector, - unsigned int incident_id, - EndType end) - : module(module), - layer(layer), - sector(sector), - incident_id(incident_id), - end(end) - {} - - unsigned int module; - unsigned int layer; - unsigned int sector; - unsigned int incident_id; - EndType end; - - bool operator<(const bcal_index &idx) const{ - if (module < idx.module) - return true; - if (module > idx.module) - return false; - if (layer < idx.layer) - return true; - if (layer > idx.layer) - return false; - if (sector < idx.sector) - return true; - if (sector > idx.sector) - return false; - if (incident_id < idx.incident_id) - return true; - if (incident_id > idx.incident_id) - return false; - if ((end == kUp) && (idx.end == kDown)) - return true; - return false; - } - - // For debugging - string ToString(void) const { - stringstream ss; - ss << "module:" << module << " layer:" << layer - << " sector:" << sector << " incident_id:" << incident_id; - return ss.str(); - } -}; - -// The IncidentParticle_t class is used to hold information on -// a single particle entering the BCAL. This is used when timing -// spectra are written out so that sampling fluctuations (and -// any other smearing that depends on incident particle parameters) -// may be done. A list of up to MAX_INCIDENT_PARTICLES is kept -// in the BCAL_INCIDENT_PARTICLES vector. All particles in the -// vector are written to the output file with an id that is also -// written with each SiPM spectrum. -class IncidentParticle_t{ - public: - IncidentParticle_t(const float *v, const float getot, - int ptype, int track) - : x(v[0]), y(v[1]), z(v[2]), - px(v[3]*v[6]),py(v[4]*v[6]),pz(v[5]*v[6]), - E(getot),ptype(ptype),track(track) - {} - float x,y,z; - float px, py, pz; - float E; - int ptype, track; - float dPhi(const IncidentParticle_t &pos) - { - float a=(pos.x*x + pos.y*y)/sqrt((x*x + y*y) * - (pos.x*pos.x + pos.y*pos.y)); - return (a < 1.0)? fabs(acos(a)) : 0.0; - } - float dZ(const IncidentParticle_t &pos) - { - return fabs(pos.z-z); - } -}; - -#define MAX_INCIDENT_PARTICLES 100 -vector BCAL_INCIDENT_PARTICLES; -int BCAL_INCIDENT_PARTICLE_COUNT = 0; -vector INCIDENT_ID; // holds map of tracks to incident particle id -bool SHOWED_INCIDENT_PARTICLE_LONG_WARNING = false; -bool SHOWED_INCIDENT_PARTICLE_SHORT_WARNING = false; - -//---------------------- -// initializeBarrelEMcal -//---------------------- -void initializeBarrelEMcal(void) -{ - mystr_t strings[50]; - float values[50]; - int nvalues = 50; - - // Get parameters from BCAL/bcal_parms - int status = GetConstants("BCAL/bcal_parms", &nvalues, values, strings); - if (!status) { - int ncounter = 0; - for (int i=0; i < (int)nvalues; i++) { - if (! strcmp(strings[i].str,"BCAL_THRESH_MEV")) { - THRESH_MEV = values[i]; - ncounter++; - } - if (! strcmp(strings[i].str,"BCAL_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (! strcmp(strings[i].str,"BCAL_MAX_HITS")) { - MAX_HITS = (int)values[i]; - ncounter++; - } - } - if (ncounter == 3){ - printf("BCAL/bcal_parms: ALL parameters loaded from Data Base\n"); - } - else if (ncounter < 3) { - printf("BCAL/bcal_parms: NOT ALL necessary parameters found in " - "Data Base %d out of 3\n",ncounter); - } - else { - printf("BCAL/bcal_parms: SOME parameters found more than once" - " in Data Base\n"); - } - } - - // Get parameters from BCAL/mc_parms - nvalues = 50; - status = GetConstants("BCAL/mc_parms", &nvalues, values, strings); - if (! status) { - int ncounter = 0; - for (int i=0; i < (int)nvalues;i ++){ - if (! strcmp(strings[i].str,"ATTEN_LENGTH")) { - ATTEN_LENGTH = values[i]; - ncounter++; - } - if (! strcmp(strings[i].str,"C_EFFECTIVE")) { - C_EFFECTIVE = values[i]; - ncounter++; - } - if (! strcmp(strings[i].str,"SiPM_tbin_width")) { - SiPM_tbin_width = values[i]; - ncounter++; - } - } - if (ncounter == 3){ - printf("BCAL/mc_parms: ALL parameters loaded from Data Base\n"); - } - else if (ncounter < 3) { - printf("BCAL/mc_parms: NOT ALL necessary parameters found in " - "Data Base %d out of 3\n",ncounter); - } - else { - printf("BCAL/mc_parms: SOME parameters found more than once " - "in Data Base\n"); - } - } - - // Factors to apply effective threshold on attenuated signal. - atten_full_length = exp(-390.0/ATTEN_LENGTH); - THRESH_ATTENUATED_GEV = (THRESH_MEV/1000.0)*atten_full_length; - - initialized = 1; -} - -//---------------------- -// recordbcalentry -//---------------------- -void recordbcalentry_(int *mech, int *itra, int*istak, int *ipart, float *vect, float *getot) -{ -#if WRITE_OUT_BCAL_CELL_TRUTH_HITS - // This gets called from gustep whenever a particle is - // "entering" one of the inner 6 BCAL layers (volumes whose name - // starts with "BM0".) Its purpose is to record the parameters - // for all particles entering the BCAL so they can be used in - // mcsmear to apply the appropriate sampling fluctuations. - // - // A complication occurs in that particles created in the BCAL - // will also be flagged as "entering" it. So, we check to see if - // the particle of the current step is close to one already - // recorded and if so, assume it is part of the same shower so - // don't record it again. Low energy particles are also igonored. - - IncidentParticle_t mypart(vect, *getot, *ipart, *itra); - - bool add_to_list = true; - float dPhi, dZ; - for (unsigned int i=0; i < BCAL_INCIDENT_PARTICLES.size(); i++) { - - // Only keep photons and betas - //if (*ipart > 3) add_to_list = false; - - dPhi = 1000.0*mypart.dPhi(BCAL_INCIDENT_PARTICLES[i]); - dZ = mypart.dZ(BCAL_INCIDENT_PARTICLES[i]); - // if this is within 200 mrad and 30cm of a previously recorded - // particle entering BCAL, assume it is part of the same shower - // Also, ignore particles with less than 10MeV total energy. - if (dPhi < 200.0 && dZ < 30.0) { - add_to_list = false; - - // If this particle has larger total energy than the one - // already recorded, then replace it with this one. This - // would be for the case when a shower sprays from something - // like the FDC frame so many particles enter the same area - // but are too close together to be considered separate showers. - if (mypart.E > BCAL_INCIDENT_PARTICLES[i].E) { - BCAL_INCIDENT_PARTICLES[i] = mypart; - } - } - if (*getot < 0.100) - add_to_list = false; - if (! add_to_list) - break; - } - if (add_to_list) { - BCAL_INCIDENT_PARTICLE_COUNT++; -//_DBG_ << "*itra = " << *itra << " dPhi=" << dPhi << " dZ=" << dZ << endl; - if (BCAL_INCIDENT_PARTICLES.size()>=MAX_INCIDENT_PARTICLES) { - if (! SHOWED_INCIDENT_PARTICLE_LONG_WARNING) { - cerr << endl; - cerr << "WARNING: The BCAL records information about certain" - << endl; - cerr << "particles entering it so that information can be used" - << endl; - cerr << "later in mcsmear to properly smear the signals. For" - << endl; - cerr << "this event, more than the maximum number of incident" - << endl; - cerr << "particles has occurred (" << MAX_INCIDENT_PARTICLES - << ") so the list is" << endl; - cerr << "being truncated to the first " << MAX_INCIDENT_PARTICLES - << "." << endl; - cerr << "All of the signal in the BCAL is still being recorded," - << endl; - cerr << "but the smearing may be off by a few percent for this" - << endl; - cerr << "event. It is probably nothing to worry about. This long" - << endl; - cerr << "message will only appear once and the following line just" - << endl; - cerr << "once per event whenever this occurs." - << endl << endl; - SHOWED_INCIDENT_PARTICLE_LONG_WARNING = true; - } - if (! SHOWED_INCIDENT_PARTICLE_SHORT_WARNING){ - cerr << __FILE__ << ":" << __LINE__ - << " too many particles entering BCAL! " - << "Some information will be lost." - << endl; - SHOWED_INCIDENT_PARTICLE_SHORT_WARNING = true; - } - } - else { - BCAL_INCIDENT_PARTICLES.push_back(mypart); - } - } -#endif -} - -//---------------------- -// find_incident_id -// -// Find the entry in BCAL_INCIDENT_PARTICLES that is physically -// closest to the given location -//---------------------- -unsigned int find_incident_id(float *x) -{ - // This should probably use the distance to the line - // projected by the incident particle, but that would - // be computationally expensive for something that is - // called for every step in the BCAL shower development. - // - // Even better, one could search through the particle - // stack tracing the ancestory until a track number - // associated with an incident particle is found. That - // too would be expensive. - - unsigned int closest_id=0; - float closest_dist2 = 1.0E6; - for (unsigned int i=0; i 1.0) { - t = xin[3] * 1e9; - } - - int itrack = (stack == 0)? gidGetId(track) : -1; - - /* post the hit to the truth tree */ - - if ((history == 0) && (pin[3] > THRESH_MEV/1e3)) { - s_BcalTruthShowers_t* showers; - float r = sqrt(xin[0]*xin[0]+xin[1]*xin[1]); - float phi = atan2(xin[1],xin[0]); - int mark = (1<<30) + showerCount; - void** twig = getTwig(&barrelEMcalTree, mark); - if (*twig == 0) - { - s_BarrelEMcal_t* bcal = make_s_BarrelEMcal(); - *twig = bcal; - bcal->bcalTruthShowers = showers = make_s_BcalTruthShowers(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - showers->in[0].primary = (track <= a && stack == 0); - showers->in[0].track = track; - showers->in[0].z = xin[2]; - showers->in[0].r = r; - showers->in[0].phi = phi; - showers->in[0].t = xin[3]*1e9; - showers->in[0].px = pin[0]*pin[4]; - showers->in[0].py = pin[1]*pin[4]; - showers->in[0].pz = pin[2]*pin[4]; - showers->in[0].E = pin[3]; - showers->in[0].ptype = ipart; - showers->in[0].trackID = make_s_TrackID(); - showers->in[0].trackID->itrack = itrack; - showers->mult = 1; - showerCount++; - } - } - -#if WRITE_OUT_BCAL_CELL_TRUTH_HITS - // ...................................................... - // This section, contains the original - // mechanism that recorded an energy weighted time average for each - // cell. Full timing spectra for each hit has been removed. - - /* post the hit to the hits tree, mark sector as hit */ - - if (dEsum > 0) - { - // Guarantee a value exists at INCIDENT_ID[track] - if (track >= (int)INCIDENT_ID.size()) - INCIDENT_ID.resize(track+1, 0); - int incident_idhit = INCIDENT_ID[track]; - if (incident_idhit == 0) - incident_idhit = INCIDENT_ID[track] = find_incident_id(x); - - int nshot; - s_BcalTruthHits_t* hits; - int sector = getsector_wrapper_(); - int layer = getlayer_wrapper_(); - int module = getmodule_wrapper_(); - float zLocal = xlocal[2]; - int mark = (module<<16)+ (layer<<9) + sector; - - void** twig = getTwig(&barrelEMcalTree, mark); - if (*twig == 0) - { - s_BarrelEMcal_t* bcal = make_s_BarrelEMcal(); - *twig = bcal; - s_BcalCells_t* cells = make_s_BcalCells(1); - cells->mult = 1; - cells->in[0].module = module; - cells->in[0].layer = layer; - cells->in[0].sector = sector; - cells->in[0].bcalTruthHits = hits = make_s_BcalTruthHits(MAX_HITS); - bcal->bcalCells = cells; - cellCount++; - } - else - { - s_BarrelEMcal_t* bcal = (s_BarrelEMcal_t*)*twig; - hits = bcal->bcalCells->in[0].bcalTruthHits; - } - - for (nshot = 0; nshot < (int)hits->mult; nshot++) - { - if (fabs(hits->in[nshot].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nshot < (int)hits->mult/* && incident_idhit == hits->in[nshot].incident_id*/) /* merge with former hit */ - { // Merging hits based on incident ID is causing issues later (we lose hits and energy). This may be implemented later. - hits->in[nshot].t = - (hits->in[nshot].t * hits->in[nshot].E + t * dEsum) - / (hits->in[nshot].E + dEsum); - hits->in[nshot].zLocal = - (hits->in[nshot].zLocal * hits->in[nshot].E + zLocal * dEsum) - / (hits->in[nshot].E + dEsum); - hits->in[nshot].E += dEsum; - } - else if (nshot < MAX_HITS) /* create new hit */ - { - hits->in[nshot].t = t; - hits->in[nshot].E = dEsum; - hits->in[nshot].zLocal = zLocal; - hits->in[nshot].incident_id = incident_idhit; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitBarrelEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - } - // ...................................................... -#endif // WRITE_OUT_BCAL_CELL_TRUTH_HITS - -} - -//---------------------- -// hitbarrelemcal_ -// -// entry point from fortran -//---------------------- -void hitbarrelemcal_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitBarrelEMcal(xin,xout,pin,pout,*dEsum,*track,*stack,*history, *ipart); -} - - -//---------------------- -// pickBarrelEMcal -// -// pick and package the hits for shipping -//---------------------- -s_BarrelEMcal_t* pickBarrelEMcal () -{ - s_BarrelEMcal_t* box; // pointer to structure we're copying into - s_BarrelEMcal_t* item; // temporary pointer to structure we're copying from -#if TESTING_CAL_CONTAINMENT - double Etotal = 0; -#endif - - // Return quickly if nothing in BCAL - if (cellCount == 0 && showerCount == 0) - { - return (s_BarrelEMcal_t*)HDDM_NULL; - } - - // Create HDDM structures to hang on output tree - box = make_s_BarrelEMcal(); - box->bcalCells = make_s_BcalCells(cellCount); - box->bcalTruthShowers = make_s_BcalTruthShowers(showerCount); - - // Loop over items stored in barrelEMcalTree. This includes - // bcalCells items and bcalTruthShowers. - while ( (item = (s_BarrelEMcal_t*) pickTwig(&barrelEMcalTree)) ) - { - -#if WRITE_OUT_BCAL_CELL_TRUTH_HITS - s_BcalCells_t* cells = item->bcalCells; - int cell; - for (cell=0; cell < (int)cells->mult; ++cell) - { - int m = box->bcalCells->mult; - int mok = 0; - - s_BcalTruthHits_t* hits = cells->in[cell].bcalTruthHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < (int)hits->mult; i++) - { - if (hits->in[i].E > THRESH_MEV/1e3) - { -#if TESTING_CAL_CONTAINMENT - Etotal += hits->in[i].E; -#endif - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - ++mok; - } - } - if (hits != HDDM_NULL) - { - hits->mult = iok; - if (iok == 0) - { - cells->in[cell].bcalTruthHits = (s_BcalTruthHits_t*)HDDM_NULL; - FREE(hits); - } - } - - if (mok) - { - box->bcalCells->in[m] = cells->in[cell]; - box->bcalCells->mult++; - } - } - if (cells != HDDM_NULL) - { - FREE(cells); - } - // ...................................................... -#endif //WRITE_OUT_BCAL_CELL_TRUTH_HITS - - // bcalTruthShowers - s_BcalTruthShowers_t* showers = item->bcalTruthShowers; - int shower; - for (shower=0; shower < (int)showers->mult; ++shower) - { - int m = box->bcalTruthShowers->mult++; - box->bcalTruthShowers->in[m] = showers->in[shower]; - } - if (showers != HDDM_NULL) - { - FREE(showers); - } - - FREE(item); - } - - // Reset counters for next event - cellCount = showerCount = 0; - - // Check if event is empty (after having applied thresholds above) - // and remove branches that contain no data. - if ((box->bcalCells != HDDM_NULL) && - (box->bcalCells->mult == 0)) - { - FREE(box->bcalCells); - box->bcalCells = (s_BcalCells_t*)HDDM_NULL; - } - else { - int icell; - for (icell=0; icell < (int)box->bcalCells->mult; ++icell) { - if ((box->bcalCells->in[icell].bcalSiPMSpectrums != HDDM_NULL) && - (box->bcalCells->in[icell].bcalSiPMSpectrums->mult == 0)) - { - FREE(box->bcalCells->in[icell].bcalSiPMSpectrums); - box->bcalCells->in[icell].bcalSiPMSpectrums = - (s_BcalSiPMSpectrums_t*)HDDM_NULL; - } - } - } - if ((box->bcalTruthShowers != HDDM_NULL) && - (box->bcalTruthShowers->mult == 0)) - { - FREE(box->bcalTruthShowers); - box->bcalTruthShowers = (s_BcalTruthShowers_t*)HDDM_NULL; - } - if ((box->bcalCells->mult == 0) && - (box->bcalTruthIncidentParticles->mult == 0) && - (box->bcalTruthShowers->mult == 0)) - { - FREE(box); - box = (s_BarrelEMcal_t*)HDDM_NULL; - } -#if TESTING_CAL_CONTAINMENT - printf("BCal energy sum: %f\n",Etotal); -#endif - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitCCal.c b/src/programs/Simulation/HDGeant/hitCCal.c deleted file mode 100644 index b079aee037..0000000000 --- a/src/programs/Simulation/HDGeant/hitCCal.c +++ /dev/null @@ -1,261 +0,0 @@ -/* - * hitCCal - registers hits for Compton calorimeter - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - */ - -#include -#include -#include - - -#include -#include -#include -#include - -extern s_HDDM_t* thisInputEvent; - -#define ATTEN_LENGTH 60. //effective attenuation length in PbWO -#define C_EFFECTIVE 13. //effective speed of light in PbWO -#define WIDTH_OF_BLOCK 2. //cm -#define LENGTH_OF_BLOCK 18. //cm -#define TWO_HIT_RESOL 75. //ns -#define MAX_HITS 100 -#define THRESH_MEV 20. -#define CENTRAL_ROW 8 -#define CENTRAL_COLUMN 8 - - -binTree_t* ComptonCalTree = 0; -static int blockCount = 0; -static int showerCount = 0; - - -/* register hits during tracking (from gustep) */ - -void hitComptonEMcal (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float xccal[3]; - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xccal,"CCAL"); - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if ((history == 0) && (pin[3] > THRESH_MEV/1e3)) - { - s_CcalTruthShowers_t* showers; - int mark = (1<<30) + showerCount; - void** twig = getTwig(&ComptonCalTree, mark); - if (*twig == 0) - { - s_ComptonEMcal_t* cal = *twig = make_s_ComptonEMcal(); - cal->ccalTruthShowers = showers = make_s_CcalTruthShowers(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - showers->in[0].primary = (track <= a && stack == 0); - showers->in[0].track = track; - showers->in[0].t = xin[3]*1e9; - showers->in[0].x = xin[0]; - showers->in[0].y = xin[1]; - showers->in[0].z = xin[2]; - showers->in[0].px = pin[0]*pin[4]; - showers->in[0].py = pin[1]*pin[4]; - showers->in[0].pz = pin[2]*pin[4]; - showers->in[0].E = pin[3]; - showers->in[0].ptype = ipart; - showers->in[0].trackID = make_s_TrackID(); - showers->in[0].trackID->itrack = itrack; - showers->mult = 1; - showerCount++; - } - } - - /* post the hit to the hits tree, mark block as hit */ - - if (dEsum > 0) - { - int nhit; - s_CcalTruthHits_t* hits; - int row = getrow_wrapper_(); - int column = getcolumn_wrapper_(); - - float dist = 0.5*LENGTH_OF_BLOCK-xccal[2]; - float dEcorr = dEsum * exp(-dist/ATTEN_LENGTH); - float tcorr = t + dist/C_EFFECTIVE; - int mark = ((row+1)<<16) + (column+1); - void** twig = getTwig(&ComptonCalTree, mark); - if (*twig == 0) - { - s_ComptonEMcal_t* cal = *twig = make_s_ComptonEMcal(); - s_CcalBlocks_t* blocks = make_s_CcalBlocks(1); - blocks->mult = 1; - blocks->in[0].row = row; - blocks->in[0].column = column; - blocks->in[0].ccalTruthHits = hits = make_s_CcalTruthHits(MAX_HITS); - cal->ccalBlocks = blocks; - blockCount++; - } - else - { - s_ComptonEMcal_t* cal = *twig; - hits = cal->ccalBlocks->in[0].ccalTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - tcorr) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - /* unclear if the intent here was to add dEcorr to hits->in[nhit].E */ - /* in the numerator as well as denominator. This caused a compiler */ - /* warning so I chose for it not to. (I'm pretty sure that's right) */ - /* 10/28/2015 DL */ - /* - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tcorr*dEcorr) - / (hits->in[nhit].E += dEcorr); - */ - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tcorr*dEcorr) - / (hits->in[nhit].E + dEcorr); - hits->in[nhit].E += dEcorr; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = tcorr; - hits->in[nhit].E = dEcorr; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitComptonEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitcomptonemcal_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitComptonEMcal(xin,xout,pin,pout,*dEsum,*track,*stack,*history, *ipart); -} - - -/* pick and package the hits for shipping */ - -s_ComptonEMcal_t* pickComptonEMcal () -{ - s_ComptonEMcal_t* box; - s_ComptonEMcal_t* item; - - if ((blockCount == 0) && (showerCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_ComptonEMcal(); - box->ccalBlocks = make_s_CcalBlocks(blockCount); - box->ccalTruthShowers = make_s_CcalTruthShowers(showerCount); - while ((item = (s_ComptonEMcal_t*) pickTwig(&ComptonCalTree))) - { - s_CcalBlocks_t* blocks = item->ccalBlocks; - int block; - s_CcalTruthShowers_t* showers = item->ccalTruthShowers; - int shower; - for (block=0; block < blocks->mult; ++block) - { - s_CcalTruthHits_t* hits = blocks->in[block].ccalTruthHits; - - if (hits) - { - int m = box->ccalBlocks->mult; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].E > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->ccalBlocks->in[m] = blocks->in[block]; - box->ccalBlocks->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - - for (shower=0; shower < showers->mult; ++shower) - { - int m = box->ccalTruthShowers->mult++; - box->ccalTruthShowers->in[m] = showers->in[shower]; - } - if (blocks != HDDM_NULL) - { - FREE(blocks); - } - if (showers != HDDM_NULL) - { - FREE(showers); - } - FREE(item); - } - - blockCount = showerCount = 0; - - if ((box->ccalBlocks != HDDM_NULL) && - (box->ccalBlocks->mult == 0)) - { - FREE(box->ccalBlocks); - box->ccalBlocks = HDDM_NULL; - } - if ((box->ccalTruthShowers != HDDM_NULL) && - (box->ccalTruthShowers->mult == 0)) - { - FREE(box->ccalTruthShowers); - box->ccalTruthShowers = HDDM_NULL; - } - if ((box->ccalBlocks->mult == 0) && - (box->ccalTruthShowers->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitCDC.c b/src/programs/Simulation/HDGeant/hitCDC.c deleted file mode 100644 index 5067d5e389..0000000000 --- a/src/programs/Simulation/HDGeant/hitCDC.c +++ /dev/null @@ -1,705 +0,0 @@ -/* - * hitCDC - registers hits for Central Drift Chamber - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function call hitCentralDC - */ - -#include -#include -#include - -#include -#include -#include -#include - -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; - -typedef struct { - int writeenohits; - int showersincol; - int driftclusters; -} controlparams_t; - -extern controlparams_t controlparams_; - -void gpoiss_(float*,int*,const int*); // avoid solaris compiler warnings - -// Drift speed 2.2cm/us is appropriate for a 90/10 Argon/Methane mixture -static float DRIFT_SPEED = 0.0055; -static float TWO_HIT_RESOL = 25.; -static int MAX_HITS = 1000; -static float THRESH_KEV = 1.; -static float THRESH_MV = 1.; -static float STRAW_RADIUS = 0.776; -static float CDC_TIME_WINDOW = 1000.0; //time window for accepting CDC hits, ns -static float ELECTRON_CHARGE = 1.6022e-4; /* fC */ -static float GAS_GAIN = 1e5; - -binTree_t* centralDCTree = 0; -static int strawCount = 0; -static int pointCount = 0; -static int stripCount = 0; -static int initialized = 0; -static float cdc_drift_time[78]; -static float cdc_drift_distance[78]; -static float BSCALE_PAR1=0.; -static float BSCALE_PAR2=0.; - -int itrack; - -/* void GetDOCA(int ipart, float x[3], float p[5], float doca[3]); disabled 6/24/2009 */ - -typedef int (*compfn)(const void*, const void*); -extern void polint(float *xa, float *ya,int n,float x, float *y,float *dy); - -// Sort function for sorting clusters -int cdc_cluster_sort(const void *a,const void *b) { - const s_CdcStrawTruthHit_t *ca=a; - const s_CdcStrawTruthHit_t *cb=b; - if (ca->t < cb->t) - return -1; - else if (ca->t > cb->t) - return 1; - else - return 0; -} - -// Simulation of the ASIC response to a pulse due to a cluster -double asic_response(double t) { - double func=0; - double par[11]={-0.01986,0.01802,-0.001097,10.3,11.72,-0.03701,35.84, - 15.93,0.006141,80.95,24.77}; - if (t < par[3]) { - func=par[0]*t+par[1]*t*t+par[2]*t*t*t; - } - else { - func+=(par[0]*par[3]+par[1]*par[3]*par[3]+par[2]*par[3]*par[3]*par[3]) - *exp(-(t-par[3])*(t-par[3])/(par[4]*par[4])); - func+=par[5]*exp(-(t-par[6])*(t-par[6])/(par[7]*par[7])); - func+=par[8]*exp(-(t-par[9])*(t-par[9])/(par[10]*par[10])); - } - return func; -} - -// Simulation of signal on a wire -double cdc_wire_signal(double t,s_CdcStrawTruthHits_t* chits) { - int m; - double asic_gain=0.5; // mV/fC - double func=0; - for (m=0; m < chits->mult; m++) { - if (t > chits->in[m].t) { - double my_time=t-chits->in[m].t; - func+=asic_gain*chits->in[m].q*asic_response(my_time); - } - } - return func; -} - -void AddCDCCluster(s_CdcStrawTruthHits_t* hits, int ipart, int track, int n_p, - float t, float xyzcluster[3]) -{ - // measured charge - float q=0.; - - // drift radius - float dradius=sqrt(xyzcluster[0]*xyzcluster[0]+xyzcluster[1]*xyzcluster[1]); - - // Find the drift time for this cluster. Drift time depends on B: - // (dependence derived from Garfield calculations) - float B[3],Bmag,x[3]; - transformCoord(xyzcluster,"local",x,"global"); - gufld_db_(x,B); - Bmag=sqrt(B[0]*B[0]+B[1]*B[1]+B[2]*B[2]); - float d2=dradius*dradius; - float d3=dradius*d2; - int i=(int)(dradius/0.01); - float my_t,my_t_err; - // Check for closeness to boundaries of the drift table - if (i>=75){ - // Do a crude linear extrapolation - my_t=cdc_drift_time[75]+((cdc_drift_time[77]-cdc_drift_time[75])/0.02) - *(dradius-cdc_drift_distance[75]); - } - else{ - int index; - if (i<1) index=0; - else index=i-1; - // Interpolate over the drift table to find an approximation for the drift - // time - polint(&cdc_drift_distance[index],&cdc_drift_time[index],4,dradius,&my_t, - &my_t_err); - } - float tdrift=my_t/(BSCALE_PAR1+BSCALE_PAR2*Bmag); - - //Longitudinal diffusion - int two=2; - float rndno[2]; - grndm_(rndno,&two); - float rho = sqrt(-2*log(rndno[0])); - float phi = rndno[1]*2*M_PI; - float dt=(7.515*dradius-2.139*d2+12.63*d3)*rho*cos(phi); - tdrift+=dt; - - // Prevent unphysical times (drift electrons arriving at wire before particle - // passes the doca to the wire) - double v_max=0.08; // guess for now based on Garfield, near wire - double tmin=dradius/v_max; - if (tdrift < tmin) { - tdrift=tmin; - } - float total_time=t+tdrift; - - // Skip cluster if the time would go beyond readout window - if (total_time > CDC_TIME_WINDOW) - return; - - // Average number of secondary ion pairs for 50/50 Ar/CO2 mixture - float n_s_per_p=1.94; - if (controlparams_.driftclusters == 0) { - /* Total number of ion pairs. On average for each primary ion - pair produced there are n_s secondary ion pairs produced. The - probability distribution is a compound poisson distribution - that requires generating two Poisson variables. - */ - int n_s,one=1; - float n_s_mean = ((float)n_p)*n_s_per_p; - gpoiss_(&n_s_mean,&n_s,&one); - int n_t = n_s+n_p; - q = ((float)n_t)*GAS_GAIN*ELECTRON_CHARGE; - } - else { - // Distribute the number of secondary ionizations for this primary - // ionization according to a Poisson distribution with mean n_s_over_p. - // For simplicity we assume these secondary electrons and the primary - // electron stay together as a cluster. - int n_s, one=1; - gpoiss_(&n_s_per_p,&n_s,&one); - // Energy deposition, equivalent to anode charge, in units of fC - q = GAS_GAIN*ELECTRON_CHARGE*(float)(1+n_s); - } - - // Add the hit info - int nhit; - for (nhit = 0; nhit < hits->mult; nhit++) { - if (fabs(hits->in[nhit].t - total_time) < TWO_HIT_RESOL) { - break; - } - } - if (nhit < hits->mult) { /* merge with former hit */ - /* Use the time from the earlier hit but add the charge*/ - hits->in[nhit].q += q; - if (hits->in[nhit].t > total_time) { - hits->in[nhit].t = total_time; - hits->in[nhit].d = dradius; - hits->in[nhit].itrack = itrack; - hits->in[nhit].ptype = ipart; - } - - /* hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].q + tdrift * dEsum) / - (hits->in[nhit].q += dEsum); - */ - } - else if (nhit < MAX_HITS) { /* create new hit */ - hits->in[nhit].t = total_time; - hits->in[nhit].q = q; - hits->in[nhit].d = dradius; - hits->in[nhit].itrack = itrack; - hits->in[nhit].ptype = ipart; - - hits->mult++; - } - else { - fprintf(stderr,"HDGeant error in hitCentralDC: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } -} - -/* register hits during tracking (from gustep) */ - -void hitCentralDC (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart ) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - float xinlocal[3]; - float xoutlocal[3]; - float dradius,drin,drout; - float trackdir[3]; - float alpha; - - if (!initialized) { - mystr_t strings[50]; - float values[50]; - int nvalues = 50; - int status = GetConstants("CDC/cdc_parms", &nvalues, values, strings); - - if (!status) { - int ncounter = 0; - int i; - for ( i=0;i<(int)nvalues;i++) { - //printf("%d %s \n",i,strings[i].str); - if (!strcmp(strings[i].str,"CDC_DRIFT_SPEED")) { - DRIFT_SPEED = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"CDC_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"CDC_MAX_HITS")) { - MAX_HITS = (int)values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"CDC_THRESH_KEV")) { - THRESH_KEV = values[i]; - ncounter++; - } - } - if (ncounter==4) { - printf("CDC: ALL parameters loaded from Data Base\n"); - } else if (ncounter<5) { - printf("CDC: NOT ALL necessary parameters found in Data Base %d out of 5\n",ncounter); - } else { - printf("CDC: SOME parameters found more than once in Data Base\n"); - } - } - // - // Get drift table and scale factors from the database - // - // First check for non-zero field in the magnet bore - float x[3]={0.,0.,65}; - float B[3]; - gufld_db_(x,B); - if (fabs(B[2])>1e-3){ - nvalues=78; - status=GetColumn("CDC/cdc_drift_table",&nvalues,cdc_drift_time,"t"); - if (status != 0) { - printf("CDC: cdc_drift_time table corrupted in database!\n"); - } - int k; - for (k=0;k 1.0) - t = xin[3] * 1e9; - - drin = sqrt(xinlocal[0]*xinlocal[0] + xinlocal[1]*xinlocal[1]); - drout = sqrt(xoutlocal[0]*xoutlocal[0] + xoutlocal[1]*xoutlocal[1]); - - trackdir[0] =-xinlocal[0] + xoutlocal[0]; - trackdir[1] =-xinlocal[1] + xoutlocal[1]; - trackdir[2] =-xinlocal[2] + xoutlocal[2]; - alpha=-(xinlocal[0]*trackdir[0]+xinlocal[1]*trackdir[1]) - /(trackdir[0]*trackdir[0]+trackdir[1]*trackdir[1]); - alpha = (alpha < 0)? 0 : (alpha > 1)? 1 : alpha; - xlocal[0]=xinlocal[0]+trackdir[0]*alpha; - xlocal[1]=xinlocal[1]+trackdir[1]*alpha; - xlocal[2]=xinlocal[2]+trackdir[2]*alpha; - - // Deal with tracks exiting the ends of the straws - if (fabs(xlocal[2]) >= 75.45) { - float sign = (xoutlocal[2] > 0)? 1. : -1.; - int ring = getring_wrapper_(); - if (ring <= 4 || (ring >= 13 && ring <= 16) || ring >= 25) { - alpha=(sign*75.45-xinlocal[2])/trackdir[2]; - xlocal[0]=xinlocal[0]+trackdir[0]*alpha; - xlocal[1]=xinlocal[1]+trackdir[1]*alpha; - xlocal[2]=sign*75.45; - } - else if (fabs(xlocal[2]) >= 75.575) { - alpha=(sign*75.575-xinlocal[2])/trackdir[2]; - xlocal[0]=xinlocal[0]+trackdir[0]*alpha; - xlocal[1]=xinlocal[1]+trackdir[1]*alpha; - xlocal[2]=sign*75.575; - } - } - - /* This will get called when the particle actually passes through - * the wire volume itself. For these cases, we should set the - * location of the hit to be the point on the wire itself. Do - * determine if this is what is happening, we check drout to - * see if it is very close to the wire and drin to see if it is - * close to the tube. - * - * For the other case, when drin is close to the wire, we assume - * it is because it is emerging from the wire volume and - * automatically ignore those hits by returning immediately. - */ - if (drin < 0.0050) - return; /* entering straw within 50 microns of wire. ignore */ - - if ((drin > (STRAW_RADIUS-0.0200) && drout<0.0050) || - (drin < 0.274 && drin > 0.234 && drout<0.0050)) - { - /* Either we entered within 200 microns of the straw tube and left - * within 50 microns of the wire or we entered the stub region near the - * donuts at either end of the straw (the inner radius of the feedthrough - * region is 0.254 cm) and passed near the wire. Assume the track passed - * through the wire volume. - */ - - x[0] = xout[0]; - x[1] = xout[1]; - x[2] = xout[2]; - t = xout[3] * 1e9; - xlocal[0] = xoutlocal[0]; - xlocal[1] = xoutlocal[1]; - xlocal[2] = xoutlocal[2]; - - /* For dx, we will just assume it is twice the distance from - * the straw to wire. - */ - dx[0] *= 2.0; - dx[1] *= 2.0; - dx[2] *= 2.0; - - /* We will approximate the energy loss in the straw to be twice the - energy loss in the first half of the straw */ - dEsum *= 2.0; - } - - /* Distance of hit from center of wire */ - dradius = sqrt(xlocal[0]*xlocal[0] + xlocal[1]*xlocal[1]); - - /* Calculate dE/dx */ - - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - /* post the hit to the truth tree */ - - itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(¢ralDCTree, mark); - if (*twig == 0) - { - s_CentralDC_t* cdc = *twig = make_s_CentralDC(); - s_CdcTruthPoints_t* points = make_s_CdcTruthPoints(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].t = t; - points->in[0].z = x[2]; - points->in[0].r = sqrt(x[0]*x[0] + x[1]*x[1]); - points->in[0].phi = atan2(x[1],x[0]); - points->in[0].dradius = dradius; - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - cdc->cdcTruthPoints = points; - pointCount++; - } - } - - /* post the hit to the hits tree, mark sector as hit */ - - if (dEsum > 0) - { - s_CdcStrawTruthHits_t* hits; - - int layer = getlayer_wrapper_(); - int ring = getring_wrapper_(); - int sector = getsector_wrapper_(); - - if (layer == 0) /* in a straw */ - { - int mark = (ring<<20) + sector; - void** twig = getTwig(¢ralDCTree, mark); - - if (*twig == 0) - { - s_CentralDC_t* cdc = *twig = make_s_CentralDC(); - s_CdcStraws_t* straws = make_s_CdcStraws(1); - straws->mult = 1; - straws->in[0].ring = ring; - straws->in[0].straw = sector; - straws->in[0].cdcStrawTruthHits = hits = make_s_CdcStrawTruthHits(MAX_HITS); - cdc->cdcStraws = straws; - strawCount++; - } - else - { - s_CentralDC_t* cdc = (s_CentralDC_t*) *twig; - hits = cdc->cdcStraws->in[0].cdcStrawTruthHits; - } - - - /* Simulate number of primary ion pairs*/ - /* The total number of ion pairs depends on the energy deposition - and the effective average energy to produce a pair, w_eff. - On average for each primary ion pair produced there are n_s_per_p - secondary ion pairs produced. - */ - int one=1; - // Average number of secondary ion pairs for 50/50 Ar/CO2 mixture - float n_s_per_p=1.94; - //Average energy needed to produce an ion pair for 50/50 mixture - float w_eff=29.5e-9; // GeV - // Average number of primary ion pairs - float n_p_mean = dEsum/w_eff/(1.+n_s_per_p); - int n_p; // number of primary ion pairs - gpoiss_(&n_p_mean,&n_p,&one); - - if (controlparams_.driftclusters==0) { - AddCDCCluster(hits,ipart,track,n_p,t,xlocal); - } - else { - // Loop over the number of primary ion pairs - int n; - for (n=0; n < n_p; n++) { - // Generate a cluster at a random position along the path within - // the straw - int one=2; - float rndno[1]; - grndm_(rndno,&one); - xlocal[0]=xinlocal[0]+trackdir[0]*rndno[0]; - xlocal[1]=xinlocal[1]+trackdir[1]*rndno[0]; - xlocal[2]=xinlocal[2]+trackdir[2]*rndno[0]; - AddCDCCluster(hits,ipart,track,n_p,t,xlocal); - } - } - } - } -} - -/* entry points from fortran */ - -void hitcentraldc_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitCentralDC(xin,xout,pin,pout,*dEsum,*track,*stack,*history, *ipart); -} - - -/* pick and package the hits for shipping */ - -s_CentralDC_t* pickCentralDC () -{ - s_CentralDC_t* box; - s_CentralDC_t* item; - - if ((strawCount == 0) && (stripCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_CentralDC(); - box->cdcStraws = make_s_CdcStraws(strawCount); - box->cdcTruthPoints = make_s_CdcTruthPoints(pointCount); - - while ((item = (s_CentralDC_t*) pickTwig(¢ralDCTree))) - { - s_CdcStraws_t* straws = item->cdcStraws; - int straw; - - s_CdcTruthPoints_t* points = item->cdcTruthPoints; - int point; - for (straw=0; straw < straws->mult; ++straw) - { - int m = box->cdcStraws->mult; - - s_CdcStrawTruthHits_t* hits = straws->in[straw].cdcStrawTruthHits; - - // Sort the clusters by time - qsort(hits->in,hits->mult,sizeof(s_CdcStrawTruthHit_t),(compfn)cdc_cluster_sort); - - /* compress out the hits below threshold */ - int i,iok=0; - - if (controlparams_.driftclusters == 0) - { - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].q >0.) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - } - else { - - // Temporary histogram in 1 ns bins to store waveform data - int num_samples=(int)CDC_TIME_WINDOW; - float *samples=(float *)malloc(num_samples*sizeof(float)); - for (i=0;i THRESH_MV) { - if (returned_to_baseline == 0) { - hits->in[iok].itrack = hits->in[0].itrack; - hits->in[iok].ptype = hits->in[0].ptype; - hits->in[iok].t=(float) i; - returned_to_baseline = 1; - iok++; - } - q += (float)FADC_BIN_SIZE*samples[i]; - } - if (returned_to_baseline && (samples[i] < THRESH_MV)) { - returned_to_baseline = 0; - if (iok > 0 && q > 0.) { - hits->in[iok-1].q=q; - q=0.; - } - //break; - } - } - if (q > 0) { - hits->in[iok-1].q = q; - } - free(samples); - } - - if (iok) - { - hits->mult = iok; - box->cdcStraws->in[m] = straws->in[straw]; - box->cdcStraws->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (straws != HDDM_NULL) - { - FREE(straws); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->cdcTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->cdcTruthPoints->in[m-1].track == track && - fabs(box->cdcTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->cdcTruthPoints->in[m] = points->in[point]; - box->cdcTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - strawCount = stripCount = pointCount = 0; - - if ((box->cdcStraws != HDDM_NULL) && - (box->cdcStraws->mult == 0)) - { - FREE(box->cdcStraws); - box->cdcStraws = HDDM_NULL; - } - if ((box->cdcTruthPoints != HDDM_NULL) && - (box->cdcTruthPoints->mult == 0)) - { - FREE(box->cdcTruthPoints); - box->cdcTruthPoints = HDDM_NULL; - } - if ((box->cdcStraws->mult == 0) && - (box->cdcTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitCerenkov.c b/src/programs/Simulation/HDGeant/hitCerenkov.c deleted file mode 100644 index e5c31945f0..0000000000 --- a/src/programs/Simulation/HDGeant/hitCerenkov.c +++ /dev/null @@ -1,242 +0,0 @@ -/* - * hitCerenkov - registers hits for Cerenkov counter - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitCerenkov - * - * Oct 12 2012, yqiang, removed changes made in revision 9720 - */ - -#include -#include -#include - -#include -#include -#include -#include - -extern s_HDDM_t* thisInputEvent; - -#define TWO_HIT_RESOL 50. -#define MAX_HITS 100 -#define THRESH_PE 2 -#define OPTICAL_PHOTON 50 - -binTree_t* cerenkovTree = 0; -static int sectionCount = 0; -static int pointCount = 0; - - -/* register truth points during tracking (from gustep) */ - -void hitCerenkov (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - //float x[3], t; - - //x[0] = (xin[0] + xout[0])/2; - //x[1] = (xin[1] + xout[1])/2; - //x[2] = (xin[2] + xout[2])/2; - float t = (xin[3] + xout[3])/2 * 1e9; - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if ((history == 0) && (dEsum > 0)) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(&cerenkovTree, mark); - if (*twig == 0) - { - s_Cerenkov_t* cere = *twig = make_s_Cerenkov(); - s_CereTruthPoints_t* points = make_s_CereTruthPoints(1); - cere->cereTruthPoints = points; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].x = xin[0]; - points->in[0].y = xin[1]; - points->in[0].z = xin[2]; - points->in[0].t = xin[3]*1e9; - points->in[0].px = pin[4]*pin[0]; - points->in[0].py = pin[4]*pin[1]; - points->in[0].pz = pin[4]*pin[2]; - points->in[0].E = pin[3]; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark sector as hit */ - - if (dEsum < 0) /* indicates a detector Cerenkov photon */ - { - int nshot; - s_CereHits_t* hits; - int sector = getsector_wrapper_(); - float pe = 1; - int mark = sector; - void** twig = getTwig(&cerenkovTree, mark); - if (*twig == 0) - { - s_Cerenkov_t* cere = *twig = make_s_Cerenkov(); - s_CereSections_t* sections = make_s_CereSections(1); - sections->mult = 1; - sections->in[0].sector = sector; - sections->in[0].cereHits = hits = make_s_CereHits(MAX_HITS); - cere->cereSections = sections; - sectionCount++; - } - else - { - s_Cerenkov_t* cere = *twig; - hits = cere->cereSections->in[0].cereHits; - } - - for (nshot = 0; nshot < hits->mult; nshot++) - { - if (fabs(hits->in[nshot].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nshot < hits->mult) /* merge with former hit */ - { - hits->in[nshot].t = (hits->in[nshot].t * hits->in[nshot].pe + t*pe) - / (hits->in[nshot].pe + pe); - hits->in[nshot].pe += pe; - } - else if (nshot < MAX_HITS) /* create new shot */ - { - hits->in[nshot].t = t; - hits->in[nshot].pe = pe; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitCerenkov: "); - fprintf(stderr,"max shot count %d exceeded, truncating!\n",MAX_HITS); - } - } -} - -/* entry points from fortran */ - -void hitcerenkov_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitCerenkov(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_Cerenkov_t* pickCerenkov () -{ - s_Cerenkov_t* box; - s_Cerenkov_t* item; - - if ((sectionCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_Cerenkov(); - box->cereSections = make_s_CereSections(sectionCount); - box->cereTruthPoints = make_s_CereTruthPoints(pointCount); - while ((item = pickTwig(&cerenkovTree))) - { - s_CereSections_t* sections = item->cereSections; - int section; - s_CereTruthPoints_t* points = item->cereTruthPoints; - int point; - - for (section=0; section < sections->mult; ++section) - { - s_CereHits_t* hits = sections->in[section].cereHits; - - /* compress out the hits below threshold */ - int iok,i; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].pe > THRESH_PE) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - int m = box->cereSections->mult++; - box->cereSections->in[m] = sections->in[section]; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (sections != HDDM_NULL) - { - FREE(sections); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->cereTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->cereTruthPoints->in[m-1].track == track && - fabs(box->cereTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->cereTruthPoints->in[m] = points->in[point]; - box->cereTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - sectionCount = pointCount = 0; - - if ((box->cereSections != HDDM_NULL) && - (box->cereSections->mult == 0)) - { - FREE(box->cereSections); - box->cereSections = HDDM_NULL; - } - if ((box->cereTruthPoints != HDDM_NULL) && - (box->cereTruthPoints->mult == 0)) - { - FREE(box->cereTruthPoints); - box->cereTruthPoints = HDDM_NULL; - } - if ((box->cereSections->mult == 0) && - (box->cereTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitDIRC.c b/src/programs/Simulation/HDGeant/hitDIRC.c deleted file mode 100644 index 7d75b5e3fe..0000000000 --- a/src/programs/Simulation/HDGeant/hitDIRC.c +++ /dev/null @@ -1,150 +0,0 @@ -/* - * hitDIRC.c - * - * Created on: Oct 11, 2012 - * Author: yqiang - * Modified on June 22, 2015: changed RICH -> DIRC and remove CERE - * Author: jrsteven - */ - -#include -#include -#include - -#include -#include -#include -#include - -extern s_HDDM_t* thisInputEvent; - -binTree_t* dircTree = 0; -static int dircCount = 0; -static int dircpointCount = 0; - -/* register truth points during tracking (from gustep) */ -void hitDIRC(float xin[4], float xout[4], float pin[5], float pout[5], - float dEsum, int track, int stack, int history, int ipart) { - - int itrack = (stack == 0)? gidGetId(track) : -1; - - // post to truth tree - if ((history == 0) && (dEsum > 0)) { - int mark = (1 << 25) + dircpointCount; - void** twig = getTwig(&dircTree, mark); - if (*twig == 0) { - s_DIRC_t* dirc = *twig = make_s_DIRC(); - s_DircTruthPoints_t* points = make_s_DircTruthPoints(1); - dirc->dircTruthPoints = points; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].x = xin[0]; - points->in[0].y = xin[1]; - points->in[0].z = xin[2]; - points->in[0].t = xin[3] * 1e9; - points->in[0].px = pin[4] * pin[0]; - points->in[0].py = pin[4] * pin[1]; - points->in[0].pz = pin[4] * pin[2]; - points->in[0].E = pin[3]; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - dircpointCount++; - } - } - - // post dirc hit - if (dEsum < 0) { - int mark = (1 << 20) + dircCount; - void** twig = getTwig(&dircTree, mark); - if (*twig == 0) { - s_DIRC_t* dirc = *twig = make_s_DIRC(); - s_DircTruthHits_t* dircHits = make_s_DircTruthHits(1); - dirc->dircTruthHits = dircHits; - dircHits->in[0].x = xin[0]; - dircHits->in[0].y = xin[1]; - dircHits->in[0].z = xin[2]; - dircHits->in[0].t = xin[3] * 1e9; - dircHits->in[0].E = pin[3]; - dircHits->mult = 1; - dircCount++; - } - } - -} - -/* entry points from fortran */ -void hitdirc_(float* xin, float* xout, float* pin, float* pout, - float* dEsum, int* track, int* stack, int* history, int* ipart) { - hitDIRC(xin, xout, pin, pout, *dEsum, *track, *stack, *history, *ipart); -} - -/* pick and package the hits for shipping */ - -s_DIRC_t* pickDirc() { - s_DIRC_t* box; - s_DIRC_t* item; - - if ((dircCount == 0) && (dircpointCount == 0)) { - return HDDM_NULL ; - } - - box = make_s_DIRC(); - // create DIRC hits - box->dircTruthHits = make_s_DircTruthHits(dircCount); - box->dircTruthPoints = make_s_DircTruthPoints(dircpointCount); - - while ((item = pickTwig(&dircTree))) { - - // pack DIRC hits - s_DircTruthHits_t* dirchits = item->dircTruthHits; - int dirchit; - for (dirchit = 0; dirchit < dirchits->mult; ++dirchit) { - int m = box->dircTruthHits->mult++; - box->dircTruthHits->in[m] = dirchits->in[dirchit]; - } - if (dirchits != HDDM_NULL) { - FREE(dirchits); - } - // pack DIRC Truth points - s_DircTruthPoints_t* dircpoints = item->dircTruthPoints; - int dircpoint; - for (dircpoint = 0; dircpoint < dircpoints->mult; ++dircpoint) { - int track = dircpoints->in[dircpoint].track; - double t = dircpoints->in[dircpoint].t; - int m = box->dircTruthPoints->mult; - if (dircpoints->in[dircpoint].trackID->itrack < 0 || - (m > 0 && box->dircTruthPoints->in[m-1].track == track && - fabs(box->dircTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(dircpoints->in[dircpoint].trackID); - continue; - } - box->dircTruthPoints->in[m] = dircpoints->in[dircpoint]; - box->dircTruthPoints->mult++; - } - if (dircpoints != HDDM_NULL) { - FREE(dircpoints); - } - FREE(item); - } - - // clear DIRC hits and truth - dircCount = dircpointCount = 0; - if ((box->dircTruthHits != HDDM_NULL ) && (box->dircTruthHits->mult == 0)) { - FREE(box->dircTruthHits); - box->dircTruthHits = HDDM_NULL; - } - if ((box->dircTruthPoints != HDDM_NULL ) - && (box->dircTruthPoints->mult == 0)) { - FREE(box->dircTruthPoints); - box->dircTruthPoints = HDDM_NULL; - } - if ((box->dircTruthHits->mult == 0) && (box->dircTruthPoints->mult == 0)) { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitFCal.c b/src/programs/Simulation/HDGeant/hitFCal.c deleted file mode 100644 index f0ef3d07fa..0000000000 --- a/src/programs/Simulation/HDGeant/hitFCal.c +++ /dev/null @@ -1,467 +0,0 @@ -/* - * hitFCal - registers hits for forward calorimeter - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitForwardEMcal - * - * 3/23/2012 B. Schaefer - * Removed radiation hard insert functionality - * - * 9/12/2017 R.T. Jones - * Added readout of energy deposited in light guides - */ - -#include -#include -#include - - -#include -#include -#include -#include - -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; - - -static float ATTEN_LENGTH = 100.; -static float C_EFFECTIVE = 15.; // cm/ns -static float WIDTH_OF_BLOCK = 4.; //cm -static float LENGTH_OF_BLOCK = 45.; //cm -static float TWO_HIT_RESOL = 75.; // ns -static int FCAL_MAX_HITS = 100; // maximum hits per block -static float THRESH_MEV = 5.; -static float ACTIVE_RADIUS = 120.; -static int CENTRAL_ROW = 29; -static int CENTRAL_COLUMN = 29; - -// Comment by RTJ: -// This particular constant "MAX_HITS" is a private constant -// that I use for preallocating arrays needed to hold hits. -// It is NOT a tunable simulation parameter. DO NOT MODIFY! -#define MAX_HITS 100 - -binTree_t* forwardEMcalTree = 0; -static int blockCount = 0; -static int showerCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ - -void hitForwardEMcal (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart, - int lgflag) -{ - float x[3], t; - float xfcal[3]; - - if (!initialized){ - - mystr_t strings[50]; - float values[50]; - int nvalues = 50; - int status = GetConstants("FCAL/fcal_parms", &nvalues, values, strings); - - if (!status) { - - int ncounter = 0; - int i; - for ( i=0;i<(int)nvalues;i++){ - //printf("%d %s \n",i,strings[i].str); - if (!strcmp(strings[i].str,"FCAL_ATTEN_LENGTH")) { - ATTEN_LENGTH = values[i]; - ncounter++; - } - - if (!strcmp(strings[i].str,"FCAL_C_EFFECTIVE")) { - C_EFFECTIVE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_WIDTH_OF_BLOCK")) { - WIDTH_OF_BLOCK = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_LENGTH_OF_BLOCK")) { - LENGTH_OF_BLOCK = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_MAX_HITS")) { - FCAL_MAX_HITS = (int)values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_THRESH_MEV")) { - THRESH_MEV = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_ACTIVE_RADIUS")) { - ACTIVE_RADIUS = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_CENTRAL_ROW")) { - CENTRAL_ROW = (int)values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FCAL_CENTRAL_COLUMN")) { - CENTRAL_COLUMN = (int)values[i]; - ncounter++; - } - } - const int nparams=10; - if (ncounter==nparams){ - printf("FCAL: ALL parameters loaded from Data Base\n"); - } else if (ncountermult = 1; - blocks->in[0].row = row; - blocks->in[0].column = column; - blocks->in[0].fcalTruthHits = hits = make_s_FcalTruthHits(MAX_HITS); - cal->fcalBlocks = blocks; - blockCount++; - } - else - { - s_ForwardEMcal_t* cal = *twig; - hits = cal->fcalBlocks->in[0].fcalTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - int lghit; - s_FcalTruthLightGuides_t *lghits; - lghits = hits->in[nhit].fcalTruthLightGuides; - if (lghits == HDDM_NULL) { - hits->in[nhit].fcalTruthLightGuides = lghits = - make_s_FcalTruthLightGuides(MAX_HITS); - lghits->in[0].dE = dEsum; - lghits->in[0].t = t; - lghits->mult = 1; - } - else { - for (lghit = 0; lghit < lghits->mult; lghit++) - { - if (fabs(lghits->in[lghit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (lghit < lghits->mult) - { - lghits->in[lghit].t = - (lghits->in[lghit].t * lghits->in[lghit].dE + t*dEsum) - / (lghits->in[lghit].dE + dEsum); - lghits->in[lghit].dE += dEsum; - } - else if (lghit < MAX_HITS) /* create new hit */ - { - lghits->in[lghit].dE = dEsum; - lghits->in[lghit].t = t; - lghits->mult += 1; - } - else - { - fprintf(stderr,"HDGeant error in hitforwardEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } - } - else if (nhit < MAX_HITS) /* create a new hit */ - { - s_FcalTruthLightGuides_t *lghits; - hits->in[nhit].fcalTruthLightGuides = lghits = - make_s_FcalTruthLightGuides(MAX_HITS); - lghits->in[0].dE = dEsum; - lghits->in[0].t = t; - lghits->mult = 1; - hits->in[nhit].t = t; - hits->in[nhit].E = 0; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitforwardEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - - return; - } - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if ((history == 0) && (pin[3] > THRESH_MEV/1e3)) - { - s_FcalTruthShowers_t* showers; - int mark = (1<<30) + showerCount; - void** twig = getTwig(&forwardEMcalTree, mark); - if (*twig == 0) - { - s_ForwardEMcal_t* cal = *twig = make_s_ForwardEMcal(); - cal->fcalTruthShowers = showers = make_s_FcalTruthShowers(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - showers->in[0].primary = (track <= a && stack == 0); - showers->in[0].track = track; - showers->in[0].t = xin[3]*1e9; - showers->in[0].x = xin[0]; - showers->in[0].y = xin[1]; - showers->in[0].z = xin[2]; - showers->in[0].px = pin[0]*pin[4]; - showers->in[0].py = pin[1]*pin[4]; - showers->in[0].pz = pin[2]*pin[4]; - showers->in[0].E = pin[3]; - showers->in[0].ptype = ipart; - showers->in[0].trackID = make_s_TrackID(); - showers->in[0].trackID->itrack = itrack; - showers->mult = 1; - showerCount++; - } - } - - /* post the hit to the hits tree, mark block as hit */ - - if (dEsum > 0) - { - int nhit; - s_FcalTruthHits_t* hits; - int row = getrow_wrapper_(); - int column = getcolumn_wrapper_(); - - float dist = 0.5*LENGTH_OF_BLOCK-xfcal[2]; - float dEcorr = dEsum * exp(-dist/ATTEN_LENGTH); - - // Place holder for the MIP correction function. Currently apply - // simple correction - - if (ipart == 1 || ipart == 2 || ipart == 3) { - dEcorr *= 0.976; - } - else { - double beta = pin[5] / pin[4]; - if (beta > 0.6) - dEcorr *= 1.35; - else - dEcorr = 0; - } - - float tcorr = t + dist/C_EFFECTIVE; - int mark = ((row+1)<<16) + (column+1); - void** twig = getTwig(&forwardEMcalTree, mark); - if (*twig == 0) - { - s_ForwardEMcal_t* cal = *twig = make_s_ForwardEMcal(); - s_FcalBlocks_t* blocks = make_s_FcalBlocks(1); - blocks->mult = 1; - blocks->in[0].row = row; - blocks->in[0].column = column; - blocks->in[0].fcalTruthHits = hits = make_s_FcalTruthHits(MAX_HITS); - cal->fcalBlocks = blocks; - blockCount++; - } - else - { - s_ForwardEMcal_t* cal = *twig; - hits = cal->fcalBlocks->in[0].fcalTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - tcorr) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tcorr*dEcorr) - / (hits->in[nhit].E + dEcorr); - hits->in[nhit].E += dEcorr; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = tcorr; - hits->in[nhit].E = dEcorr; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitforwardEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitforwardemcal_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart, - int* lgflag) -{ - hitForwardEMcal(xin,xout,pin,pout,*dEsum,*track,*stack,*history, - *ipart,*lgflag); -} - - -/* pick and package the hits for shipping */ - -s_ForwardEMcal_t* pickForwardEMcal () -{ - s_ForwardEMcal_t* box; - s_ForwardEMcal_t* item; - -#if TESTING_CAL_CONTAINMENT - double Etotal = 0; -#endif - if ((blockCount == 0) && (showerCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_ForwardEMcal(); - box->fcalBlocks = make_s_FcalBlocks(blockCount); - box->fcalTruthShowers = make_s_FcalTruthShowers(showerCount); - while ((item = (s_ForwardEMcal_t*) pickTwig(&forwardEMcalTree))) - { - s_FcalBlocks_t* blocks = item->fcalBlocks; - int block; - s_FcalTruthShowers_t* showers = item->fcalTruthShowers; - int shower; - for (block=0; block < blocks->mult; ++block) - { - int row = blocks->in[block].row; - int column = blocks->in[block].column; - float y0 = (row - CENTRAL_ROW)*WIDTH_OF_BLOCK; - float x0 = (column - CENTRAL_COLUMN)*WIDTH_OF_BLOCK; - float dist = sqrt(x0*x0+y0*y0); - - s_FcalTruthHits_t* hits = blocks->in[block].fcalTruthHits; - - /* compress out the hits outside the active region */ - if (dist < ACTIVE_RADIUS) - { - int m = box->fcalBlocks->mult; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].E > THRESH_MEV/1e3) - { -#if TESTING_CAL_CONTAINMENT - Etotal += hits->in[i].E; -#endif - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->fcalBlocks->in[m] = blocks->in[block]; - box->fcalBlocks->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - - for (shower=0; shower < showers->mult; ++shower) - { - int m = box->fcalTruthShowers->mult++; - box->fcalTruthShowers->in[m] = showers->in[shower]; - } - if (blocks != HDDM_NULL) - { - FREE(blocks); - } - if (showers != HDDM_NULL) - { - FREE(showers); - } - FREE(item); - } - - blockCount = showerCount = 0; - - if ((box->fcalBlocks != HDDM_NULL) && - (box->fcalBlocks->mult == 0)) - { - FREE(box->fcalBlocks); - box->fcalBlocks = HDDM_NULL; - } - if ((box->fcalTruthShowers != HDDM_NULL) && - (box->fcalTruthShowers->mult == 0)) - { - FREE(box->fcalTruthShowers); - box->fcalTruthShowers = HDDM_NULL; - } - if ((box->fcalBlocks->mult == 0) && - (box->fcalTruthShowers->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } -#if TESTING_CAL_CONTAINMENT - printf("FCal energy sum: %f\n",Etotal/0.614); -#endif - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitFDC.c b/src/programs/Simulation/HDGeant/hitFDC.c deleted file mode 100644 index f81330abbd..0000000000 --- a/src/programs/Simulation/HDGeant/hitFDC.c +++ /dev/null @@ -1,1183 +0,0 @@ -/* - * hitFDC - registers hits for forward drift chambers - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitForwardDC - */ - -#include -#include -#include - -#include -#include -#include -#include - -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; -extern double asic_response(double t); -extern double Ei(double x); - -typedef struct{ - int writeenohits; - int showersincol; - int driftclusters; -}controlparams_t; - -extern controlparams_t controlparams_; - -int itrack; - -const float wire_dead_zone_radius[4]={3.0,3.0,3.9,3.9}; -const float strip_dead_zone_radius[4]={1.3,1.3,1.3,1.3}; - -#define CATHODE_ROT_ANGLE 1.309 // 75 degrees - -// Drift speed 2.2cm/us is appropriate for a 90/10 Argon/Methane mixture -static float DRIFT_SPEED =.0055; -static float ACTIVE_AREA_OUTER_RADIUS =48.5; -static float ANODE_CATHODE_SPACING =0.5; -static float TWO_HIT_RESOL =25.; -static int WIRES_PER_PLANE =96; -static float WIRE_SPACING =1.0; -static float U_OF_WIRE_ZERO =0;//(-((WIRES_PER_PLANE-1.)*WIRE_SPACING)/2) -static float STRIPS_PER_PLANE =192; -static float STRIP_SPACING =0.5; -static float U_OF_STRIP_ZERO =0;// (-((STRIPS_PER_PLANE-1.)*STRIP_SPACING)/2) -static float STRIP_GAP =0.1; -static int FDC_MAX_HITS =1000; -static float K2 =1.15; -static float STRIP_NODES = 3; -static float THRESH_KEV =1. ; -static float THRESH_ANODE = 1.; -static float THRESH_STRIPS =5. ; /* pC */ -static float ELECTRON_CHARGE =1.6022e-4; /* fC */ -static float DIFFUSION_COEFF = 1.1e-6; // cm^2/s --> 200 microns at 1 cm -static float FDC_TIME_WINDOW = 1000.0; //time window for accepting FDC hits, ns -static float GAS_GAIN = 8e4; - -// Note by RTJ: -// This constant "MAX_HITS" is a convenience constant -// that I introduced to help with preallocating arrays -// to hold hits. It is NOT a tunable simulation parameter. -// DO NOT MODIFY IT. -#define MAX_HITS 1000 - -#if 0 -static float wire_dx_offset[2304]; -static float wire_dz_offset[2304]; -#endif - -binTree_t* forwardDCTree = 0; -static int stripCount = 0; -static int wireCount = 0; -static int pointCount = 0; -static int initializedx=0; - -void gpoiss_(float*,int*,const int*); // avoid solaris compiler warnings -void rnorml_(float*,int*); - -typedef int (*compfn)(const void*, const void*); - -// Sort functions for sorting clusters -int fdc_anode_cluster_sort(const void *a,const void *b){ - const s_FdcAnodeTruthHit_t *ca=a; - const s_FdcAnodeTruthHit_t *cb=b; - if (ca->tt) return -1; - else if (ca->t>cb->t) return 1; - else return 0; -} -int fdc_cathode_cluster_sort(const void *a,const void *b){ - const s_FdcCathodeTruthHit_t *ca=a; - const s_FdcCathodeTruthHit_t *cb=b; - if (ca->tt) return -1; - else if (ca->t>cb->t) return 1; - else return 0; -} - - - -// Locate a position in array xx given x -void locate(float *xx,int n,float x,int *j){ - int ju,jm,jl; - int ascnd; - - jl=-1; - ju=n; - ascnd=(xx[n-1]>=xx[0]); - while(ju-jl>1){ - jm=(ju+jl)>>1; - if ((x>=xx[jm])==ascnd) - jl=jm; - else - ju=jm; - } - if (x==xx[0]) *j=0; - else if (x==xx[n-1]) *j=n-2; - else *j=jl; -} - -// Polynomial interpolation on a grid. -// Adapted from Numerical Recipes in C (2nd Edition), pp. 121-122. -void polint(float *xa, float *ya,int n,float x, float *y,float *dy){ - int i,m,ns=0; - float den,dif,dift,ho,hp,w; - - float *c=(float *)calloc(n,sizeof(float)); - float *d=(float *)calloc(n,sizeof(float)); - - dif=fabs(x-xa[0]); - for (i=0;imult;m++){ - if (t>ahits->in[m].t){ - double my_time=t-ahits->in[m].t; - func+=asic_gain*ahits->in[m].dE*asic_response(my_time); - } - } - return func; -} - -// Simulation of signal on a cathode strip (ASIC output) -double cathode_signal(double t,s_FdcCathodeTruthHits_t* chits){ - int m; - double asic_gain=2.3; - double func=0; - for (m=0;mmult;m++){ - if (t>chits->in[m].t){ - double my_time=t-chits->in[m].t; - func+=asic_gain*chits->in[m].q*asic_response(my_time); - } - } - return func; -} - -// Generate hits in two cathode planes flanking the wire plane -void AddFDCCathodeHits(int PackNo,float xwire,float avalanche_y,float tdrift, - int n_p,int track,int ipart,int chamber,int module, - int layer, int global_wire_number){ - - s_FdcCathodeTruthHits_t* chits; - - // Anode charge - float q_anode; - int n_t; - // Average number of secondary ion pairs for 40/60 Ar/CO2 mixture - float n_s_per_p=1.89; - if (controlparams_.driftclusters==0){ - /* Total number of ion pairs. On average for each primary ion - pair produced there are n_s secondary ion pairs produced. The - probability distribution is a compound poisson distribution - that requires generating two Poisson variables. - */ - int n_s,one=1; - float n_s_mean = ((float)n_p)*n_s_per_p; - gpoiss_(&n_s_mean,&n_s,&one); - n_t = n_s+n_p; - q_anode=((float)n_t)*GAS_GAIN*ELECTRON_CHARGE; - } - else{ - // Distribute the number of secondary ionizations for this primary - // ionization according to a Poisson distribution with mean n_s_over_p. - // For simplicity we assume these secondary electrons and the primary - // electron stay together as a cluster. - int n_s; - int one=1; - gpoiss_(&n_s_per_p,&n_s,&one); - // Anode charge in units of fC - n_t=1+n_s; - q_anode=GAS_GAIN*ELECTRON_CHARGE*((float)n_t); - } - - /* Mock-up of cathode strip charge distribution */ - int plane, node; - for (plane=1; plane<4; plane+=2){ - float theta = (plane == 1)? M_PI-CATHODE_ROT_ANGLE: CATHODE_ROT_ANGLE; - float cathode_u =-xwire*cos(theta)-avalanche_y*sin(theta); - int strip1 = ceil((cathode_u-U_OF_STRIP_ZERO)/STRIP_SPACING +0.5); - float cathode_u1 = (strip1-1)*STRIP_SPACING + U_OF_STRIP_ZERO; - float delta = cathode_u-cathode_u1; - float half_gap=ANODE_CATHODE_SPACING; - -#if 0 - half_gap+=(plane==1)?+wire_dz_offset[global_wire_number]: - -wire_dz_offset[global_wire_number]; -#endif - - for (node=-STRIP_NODES; node<=STRIP_NODES; node++){ - /* Induce charge on the strips according to the Mathieson - function tuned to results from FDC prototype - */ - float lambda1=(((float)node-0.5)*STRIP_SPACING+STRIP_GAP/2. - -delta)/half_gap; - float lambda2=(((float)node+0.5)*STRIP_SPACING-STRIP_GAP/2. - -delta)/half_gap; - float factor=0.25*M_PI*K2; - float q = 0.25*q_anode*(tanh(factor*lambda2)-tanh(factor*lambda1)); - - int strip = strip1+node; - /* Throw away hits on strips falling within a certain dead-zone - radius */ - float strip_outer_u=cathode_u1 - +(STRIP_SPACING+STRIP_GAP/2.)*(int)node; - float cathode_v=-xwire*sin(theta)+avalanche_y*cos(theta); - float check_radius=sqrt(strip_outer_u*strip_outer_u - +cathode_v*cathode_v); - - if ((strip > 0) - && (check_radius>strip_dead_zone_radius[PackNo]) - && (strip <= STRIPS_PER_PLANE)){ - int mark = (chamber<<20) + (plane<<10) + strip; - void** cathodeTwig = getTwig(&forwardDCTree, mark); - if (*cathodeTwig == 0){ - s_ForwardDC_t* fdc = *cathodeTwig = make_s_ForwardDC(); - s_FdcChambers_t* chambers = make_s_FdcChambers(1); - s_FdcCathodeStrips_t* strips = make_s_FdcCathodeStrips(1); - strips->mult = 1; - strips->in[0].plane = plane; - strips->in[0].strip = strip; - strips->in[0].fdcCathodeTruthHits = chits - = make_s_FdcCathodeTruthHits(MAX_HITS); - chambers->mult = 1; - chambers->in[0].module = module; - chambers->in[0].layer = layer; - chambers->in[0].fdcCathodeStrips = strips; - fdc->fdcChambers = chambers; - stripCount++; - } - else{ - s_ForwardDC_t* fdc = *cathodeTwig; - chits = fdc->fdcChambers->in[0].fdcCathodeStrips - ->in[0].fdcCathodeTruthHits; - } - - int nhit; - for (nhit = 0; nhit < chits->mult; nhit++){ - // To cut down on the number of output clusters, combine - // those that would be indistiguishable in time given the - // expected timing resolution - if (fabs(chits->in[nhit].t - tdrift) mult) /* merge with former hit */ - { - /* Use the time from the earlier hit but add the charge */ - chits->in[nhit].q += q; - if(chits->in[nhit].t>tdrift){ - chits->in[nhit].t = tdrift; - chits->in[nhit].itrack = itrack; - chits->in[nhit].ptype = ipart; - } - } - else if (nhit < MAX_HITS){ /* create new hit */ - chits->in[nhit].t = tdrift; - chits->in[nhit].q = q; - chits->in[nhit].itrack = itrack; - chits->in[nhit].ptype = ipart; - chits->mult++; - } - else{ - fprintf(stderr,"HDGeant error in hitForwardDC: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n", MAX_HITS); - } - - } - } // loop over cathode strips - } // loop over cathode views -} - - -// Add wire information -int AddFDCAnodeHit(s_FdcAnodeTruthHits_t* ahits,int layer,int ipart,int track, - float xwire,float xyz[3],float dE,float t,float *tdrift){ - - // Generate 2 random numbers from a Gaussian distribution - // - float rndno[2]; - int two=2; - - // Only and always use the built-in Geant random generator, - // otherwise debugging is a problem because sequences are not - // reproducible from a given pair of random seeds. [rtj] - - /* rnorml_(rndno,&two); */ { - float rho,phi1; - grndm_(rndno,&two); - rho = sqrt(-2*log(rndno[0])); - phi1 = rndno[1]*2*M_PI; - rndno[0] = rho*cos(phi1); - rndno[1] = rho*sin(phi1); - } - - // Get the magnetic field at this cluster position - float x[3],B[3]; - transformCoord(xyz,"local",x,"global"); - gufld_db_(x,B); - - // Find the angle between the wire direction and the direction of the - // magnetic field in the x-y plane - float wire_dir[2]; - float wire_theta=1.0472*(float)((layer%3)-1); - float phi=0.;; - float Br=sqrt(B[0]*B[0]+B[1]*B[1]); - float Bmag=sqrt(B[2]*B[2]+Br*Br); - - wire_dir[0]=sin(wire_theta); - wire_dir[1]=cos(wire_theta); - if (Br>0.) phi= acos((B[0]*wire_dir[0]+B[1]*wire_dir[1])/Br); - - // useful combinations of dx and dz - float dx=xyz[0]-xwire; - float dx2=dx*dx; - float dx4=dx2*dx2; - float dz2=xyz[2]*xyz[2]; - float dz4=dz2*dz2; - - // Next compute the avalanche position along wire. - // Correct avalanche position with deflection along wire due to - // Lorentz force. - xyz[1]+=( -0.125*B[2]*(1.-0.048*Br) )*dx - +(-0.18-0.0129*(B[2]))*(Br*cos(phi))*xyz[2] - +( -0.000176 )*dx*dx2/(dz2+0.001); - // Add transverse diffusion - xyz[1]+=(( 0.01 )*pow(dx2+dz2,0.125)+( 0.0061 )*dx2)*rndno[0]; - - // Do not use this cluster if the Lorentz force would deflect - // the electrons outside the active region of the detector - if (sqrt(xyz[1]*xyz[1]+xwire*xwire)>ACTIVE_AREA_OUTER_RADIUS) - return 0; - - // Model the drift time and longitudinal diffusion as a function of - // position of the cluster within the cell - float tdrift_unsmeared=1086.0*(1.+0.039*Bmag)*dx2+( 1068.0 )*dz2 - +dx4*(( -2.675 )/(dz2+0.001)+( 2.4e4 )*dz2); - float dt=(( 39.44 )*dx4/(0.5-dz2)+( 56.0 )*dz4/(0.5-dx2) - +( 0.01566 )*dx4/(dz4+0.002)/(0.251-dx2))*rndno[1]; - - // Minimum drift time for docas near wire (very crude approximation) - double v_max=0.08; // guess for now based on Garfield, near wire - double dradius=sqrt(dx2+dz2); - double tmin=dradius/v_max; - double tdrift_smeared=tdrift_unsmeared+dt; - if (tdrift_smeared FDC_TIME_WINDOW ) return 0; - - int nhit; - - // Record the anode hit - for (nhit = 0; nhit < ahits->mult; nhit++) - { - if (fabs(ahits->in[nhit].t - *tdrift) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < ahits->mult) /* merge with former hit */ - { - /* use the time from the earlier hit but add the energy */ - ahits->in[nhit].dE += dE; - if(ahits->in[nhit].t>*tdrift){ - ahits->in[nhit].t = *tdrift; - ahits->in[nhit].t_unsmeared=tdrift_unsmeared; - ahits->in[nhit].d = sqrt(dx2+dz2); - - ahits->in[nhit].itrack = itrack; - ahits->in[nhit].ptype = ipart; - } - -#ifdef FDC_AVERAGE_TIME_FOR_MERGED_HITS - /* This old treatment tried to average the lead-edge - * times of merged hits. It has been disabled, in favor - * of just keeping the time of the first hit recorded. - */ - ahits->in[nhit].t = - (ahits->in[nhit].t * ahits->in[nhit].dE + tdrift * dE) - / (ahits->in[nhit].dE += dE); -#endif - - } - else if (nhit < MAX_HITS) /* create new hit */ - { - ahits->in[nhit].t = *tdrift; - ahits->in[nhit].t_unsmeared=tdrift_unsmeared; - ahits->in[nhit].dE = dE; - ahits->in[nhit].d = sqrt(dx2+dz2); - ahits->in[nhit].itrack = itrack; - ahits->in[nhit].ptype = ipart; - ahits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitForwardDC: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - - return 1; -} - -/* register hits during tracking (from gustep) */ - -void hitForwardDC (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - float xinlocal[3]; - float xoutlocal[3]; - float dradius=0; - float alpha,sinalpha,cosalpha; - - if (!initializedx){ - mystr_t strings[250]; - float values[250]; - int nvalues = 250; - - // Get parameters related to the geometry and the signals - int status = GetConstants("FDC/fdc_parms", &nvalues,values,strings); - if (!status) { - int ncounter = 0; - int i; - for ( i=0;i<(int)nvalues;i++){ - //printf("%d %s %f\n",i,strings[i].str,values[i]); - if (!strcmp(strings[i].str,"FDC_DRIFT_SPEED")) { - DRIFT_SPEED = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_ACTIVE_AREA_OUTER_RADIUS")) { - ACTIVE_AREA_OUTER_RADIUS = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_ANODE_CATHODE_SPACING")) { - ANODE_CATHODE_SPACING = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_WIRES_PER_PLANE")) { - WIRES_PER_PLANE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_WIRE_SPACING")) { - WIRE_SPACING = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_STRIPS_PER_PLANE")) { - STRIPS_PER_PLANE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_STRIP_SPACING")) { - STRIP_SPACING = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_STRIP_GAP")) { - STRIP_GAP = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_MAX_HITS")) { - FDC_MAX_HITS = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_K2")) { - K2 = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_STRIP_NODES")) { - STRIP_NODES = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_THRESH_KEV")) { - THRESH_KEV = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_THRESH_STRIPS")) { - THRESH_STRIPS = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_ELECTRON_CHARGE")) { - ELECTRON_CHARGE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"FDC_DIFFUSION_COEFF")) { - DIFFUSION_COEFF = values[i]; - ncounter++; - } - } - U_OF_WIRE_ZERO = (-((WIRES_PER_PLANE-1.)*WIRE_SPACING)/2); - U_OF_STRIP_ZERO = (-((STRIPS_PER_PLANE-1.)*STRIP_SPACING)/2); - - if (ncounter==16){ - printf("FDC: ALL parameters loaded from Data Base\n"); - } else if (ncounter<16){ - printf("FDC: NOT ALL necessary parameters found in Data Base %d out of 16\n",ncounter); - } else { - printf("FDC: SOME parameters found more than once in Data Base\n"); - } -#if 0 - { - int num_values=2304*2; - float my_values[2304*2]; - mystr_t my_strings[2304*2]; - status=GetArrayConstants("FDC/fdc_wire_offsets",&num_values, - my_values,my_strings); - if (!status){ - int i; - for (i=0;iWIRES_PER_PLANE && wire2==WIRES_PER_PLANE) || - (wire2>WIRES_PER_PLANE && wire1==WIRES_PER_PLANE)) - wire1=wire2=WIRES_PER_PLANE; - if ((wire1==0 && wire2 == 1) || (wire1==1 && wire2== 0)){ - wire1=wire2=1; - } - // Make sure at least one wire number is valid - if (wire1>WIRES_PER_PLANE&&wire2>WIRES_PER_PLANE) return; - if (wire1==0 && wire2==0) return; - - if (wire1>WIRES_PER_PLANE) wire1=wire2; - else if (wire2>WIRES_PER_PLANE) wire2=wire1; - if (wire1==0) wire1=wire2; - else if (wire2==0) wire2=wire1; - - dwire = (wire1 < wire2)? 1 : -1; - alpha = atan2(xoutlocal[0]-xinlocal[0],xoutlocal[2]-xinlocal[2]); - sinalpha=sin(alpha); - cosalpha=cos(alpha); - xlocal[0] = (xinlocal[0] + xoutlocal[0])/2; - xlocal[1] = (xinlocal[1] + xoutlocal[1])/2; - xlocal[2] = (xinlocal[2] + xoutlocal[2])/2; - - wire = ceil((xlocal[0] - U_OF_WIRE_ZERO)/WIRE_SPACING +0.5); - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - dx[0] = xin[0] - xout[0]; - dx[1] = xin[1] - xout[1]; - dx[2] = xin[2] - xout[2]; - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - /* Make a fuzzy boundary around the forward dead region - * by killing any track segment whose midpoint is within the boundary */ - - if (sqrt(xlocal[0]*xlocal[0]+xlocal[1]*xlocal[1]) - < wire_dead_zone_radius[PackNo]) - { - return; - } - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<16) + (chamber<<20) + pointCount; - void** twig = getTwig(&forwardDCTree, mark); - if (*twig == 0) - { - s_ForwardDC_t* fdc = *twig = make_s_ForwardDC(); - s_FdcChambers_t* chambers = make_s_FdcChambers(1); - s_FdcTruthPoints_t* points = make_s_FdcTruthPoints(1); - float xwire = U_OF_WIRE_ZERO + (wire-1)*WIRE_SPACING; - float u[2]; - u[0] = xinlocal[2]; - u[1] = xinlocal[0]-xwire; - dradius = fabs(u[1]*cosalpha-u[0]*sinalpha); - points->mult = 1; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].x = x[0]; - points->in[0].y = x[1]; - points->in[0].z = x[2]; - points->in[0].t = t; - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].dradius = dradius; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - chambers->mult = 1; - chambers->in[0].module = module; - chambers->in[0].layer = layer; - chambers->in[0].fdcTruthPoints = points; - fdc->fdcChambers = chambers; - pointCount++; - } - } - - /* post the hit to the hits tree, mark cell as hit */ - - if (dEsum > 0) - { - float sign=1.; // for dealing with the y-position for tracks crossing two cells - - for (wire=wire1; wire-dwire != wire2; wire+=dwire) - { - float dE; - float x0[3],x1[3]; - float xwire = U_OF_WIRE_ZERO + (wire-1)*WIRE_SPACING; - int global_wire_number=96*glayer+wire-1; - -#if 0 - xwire+=wire_dx_offset[global_wire_number]; -#endif - - if (wire1==wire2){ - dE=dEsum; - x0[0] = xinlocal[0]; - x0[1] = xinlocal[1]; - x0[2] = xinlocal[2]; - x1[0] = xoutlocal[0]; - x1[1] = xoutlocal[1]; - x1[2] = xoutlocal[2]; - } - else{ - x0[0] = xwire-0.5*dwire*WIRE_SPACING; - x0[1] = xinlocal[1] + (x0[0]-xinlocal[0]+1e-20)* - (xoutlocal[1]-xinlocal[1])/(xoutlocal[0]-xinlocal[0]+1e-20); - x0[2] = xinlocal[2] + (x0[0]-xinlocal[0]+1e-20)* - (xoutlocal[2]-xinlocal[2])/(xoutlocal[0]-xinlocal[0]+1e-20); - if (fabs(x0[2]-xoutlocal[2]) > fabs(xinlocal[2]-xoutlocal[2])) - { - x0[0] = xinlocal[0]; - x0[1] = xinlocal[1]; - x0[2] = xinlocal[2]; - } - x1[0] = xwire+0.5*dwire*WIRE_SPACING; - x1[1] = xinlocal[1] + (x1[0]-xinlocal[0]+1e-20)* - (xoutlocal[1]-xinlocal[1])/(xoutlocal[0]-xinlocal[0]+1e-20); - x1[2] = xinlocal[2] + (x1[0]-xinlocal[0]+1e-20)* - (xoutlocal[2]-xinlocal[2])/(xoutlocal[0]-xinlocal[0]+1e-20); - if (fabs(x1[2]-xinlocal[2]) > fabs(xoutlocal[2]-xinlocal[2])) - { - x1[0] = xoutlocal[0]; - x1[1] = xoutlocal[1]; - x1[2] = xoutlocal[2]; - } - dE = dEsum*(x1[2]-x0[2])/(xoutlocal[2]-xinlocal[2]); - } - - if (dE > 0){ - s_FdcAnodeTruthHits_t* ahits; - - // Create (or grab) an entry in the tree for the anode wire - int mark = (chamber<<20) + (2<<10) + wire; - void** twig = getTwig(&forwardDCTree, mark); - - if (*twig == 0) - { - s_ForwardDC_t* fdc = *twig = make_s_ForwardDC(); - s_FdcChambers_t* chambers = make_s_FdcChambers(1); - s_FdcAnodeWires_t* wires = make_s_FdcAnodeWires(1); - wires->mult = 1; - wires->in[0].wire = wire; - wires->in[0].fdcAnodeTruthHits = ahits = make_s_FdcAnodeTruthHits(MAX_HITS); - chambers->mult = 1; - chambers->in[0].module = module; - chambers->in[0].layer = layer; - chambers->in[0].fdcAnodeWires = wires; - fdc->fdcChambers = chambers; - wireCount++; - } - else - { - s_ForwardDC_t* fdc = *twig; - ahits = fdc->fdcChambers->in[0].fdcAnodeWires->in[0].fdcAnodeTruthHits; - } - - int two=2; - - // Find the number of primary ion pairs: - /* The total number of ion pairs depends on the energy deposition - and the effective average energy to produce a pair, w_eff. - On average for each primary ion pair produced there are n_s_per_p - secondary ion pairs produced. - */ - int one=1; - // Average number of secondary ion pairs for 40/60 Ar/CO2 mixture - float n_s_per_p=1.89; - //Average energy needed to produce an ion pair for 50/50 mixture - float w_eff=30.2e-9; // GeV - // Average number of primary ion pairs - float n_p_mean = dE/w_eff/(1.+n_s_per_p); - int n_p; // number of primary ion pairs - gpoiss_(&n_p_mean,&n_p,&one); - - // Drift time - float tdrift=0; - - if (controlparams_.driftclusters==0){ - float zrange=x1[2]-x0[2]; - float tany=(x1[1]-x0[1])/zrange; - float tanx=(x1[0]-x0[0])/zrange; - float dz=ANODE_CATHODE_SPACING-dradius*sign*sinalpha; -#if 0 - dz+=wire_dz_offset[global_wire_number]; -#endif - xlocal[0]=x0[0]+tanx*dz; - if (fabs(xlocal[0]-xwire)>0.5){ - xlocal[0]=x1[0]; - xlocal[1]=x1[1]; - xlocal[2]=x1[2]; - } - else{ - xlocal[1]=x0[1]+tany*dz; - xlocal[2]=x0[2]+dz; - } - - /* If the cluster position is within the wire-deadened region of the - detector, skip this cluster - */ - if (sqrt(xlocal[0]*xlocal[0]+xlocal[1]*xlocal[1]) - >=wire_dead_zone_radius[PackNo]){ - if (AddFDCAnodeHit(ahits,layer,ipart,track,xwire,xlocal,dE,t, - &tdrift)){ - AddFDCCathodeHits(PackNo,xwire,xlocal[1],tdrift,n_p,track,ipart, - chamber,module,layer,global_wire_number); - } - - } - } - else{ - // Loop over the number of primary ion pairs - int n; - for (n=0;n=wire_dead_zone_radius[PackNo]){ - if (AddFDCAnodeHit(ahits,layer,ipart,track,xwire,xlocal,dE,t, - &tdrift)){ - AddFDCCathodeHits(PackNo,xwire,xlocal[1],tdrift,n_p,track,ipart, - chamber,module,layer,global_wire_number); - } - } - - } // loop over primary ion pairs - } - } // Check for non-zero energy - - sign*=-1; // for dealing with the y-position for tracks crossing two cells - } // loop over wires - } // Check that total energy deposition is not zero -} - -/* entry points from fortran */ - -void hitforwarddc_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitForwardDC(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_ForwardDC_t* pickForwardDC () -{ - s_ForwardDC_t* box; - s_ForwardDC_t* item; - - if ((stripCount == 0) && (wireCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_ForwardDC(); - box->fdcChambers = make_s_FdcChambers(32); - box->fdcChambers->mult = 0; - while ((item = (s_ForwardDC_t*) pickTwig(&forwardDCTree))) - { - s_FdcChambers_t* chambers = item->fdcChambers; - int module = chambers->in[0].module; - int layer = chambers->in[0].layer; - int m = box->fdcChambers->mult; - - /* compress out the hits below threshold */ - s_FdcAnodeWires_t* wires = chambers->in[0].fdcAnodeWires; - int wire; - s_FdcCathodeStrips_t* strips = chambers->in[0].fdcCathodeStrips; - int strip; - s_FdcTruthPoints_t* points = chambers->in[0].fdcTruthPoints; - int point; - int mok=0; - for (wire=0; wire < wires->mult; wire++) - { - s_FdcAnodeTruthHits_t* ahits = wires->in[wire].fdcAnodeTruthHits; - - // Sort the clusters by time - qsort(ahits->in,ahits->mult,sizeof(s_FdcAnodeTruthHit_t), - (compfn)fdc_anode_cluster_sort); - - int i,iok=0; - - if (controlparams_.driftclusters==0){ - for (iok=i=0; i < ahits->mult; i++) - { - if (ahits->in[i].dE > THRESH_KEV/1e6) - { - if (iok < i) - { - ahits->in[iok] = ahits->in[i]; - } - ++iok; - ++mok; - } - } - } - else{ // Simulate clusters within the cell - - // printf("-------------\n"); - - - // Temporary histogram in 1 ns bins to store waveform data - int num_samples=(int)FDC_TIME_WINDOW; - float *samples=(float *)malloc(num_samples*sizeof(float)); - for (i=0;i THRESH_ANODE){ - if (returned_to_baseline==0){ - ahits->in[iok].itrack = ahits->in[0].itrack; - ahits->in[iok].ptype = ahits->in[0].ptype; - - // Do an interpolation to find the time at which the threshold - // was crossed. - float t_array[4]; - int k; - float my_t,my_terr; - for (k=0;k<4;k++) t_array[k]=i-1+k; - polint(&samples[i-1],t_array,4,THRESH_ANODE,&my_t,&my_terr); - ahits->in[iok].t=my_t; - - returned_to_baseline=1; - iok++; - mok++; - } - q+=samples[i]; - } - if (returned_to_baseline - && (samples[i] <= THRESH_ANODE)){ - returned_to_baseline=0; - } - } - free(samples); - } // Simulation of clusters within cell - - if (iok) - { - ahits->mult = iok; - } - else if (ahits != HDDM_NULL) - { - FREE(ahits); - } - } - if ((wires != HDDM_NULL) && (mok == 0)) - { - FREE(wires); - wires = HDDM_NULL; - } - - - mok = 0; - for (strip=0; strip < strips->mult; strip++) - { - s_FdcCathodeTruthHits_t* chits = strips->in[strip].fdcCathodeTruthHits; - - // Sort the clusters by time - qsort(chits->in,chits->mult,sizeof(s_FdcCathodeTruthHit_t), - (compfn)fdc_cathode_cluster_sort); - - int i,iok=0; - - if (controlparams_.driftclusters==0){ - for (iok=i=0; i < chits->mult; i++) - { - if (chits->in[i].q > 0.) - { - if (iok < i) - { - chits->in[iok] = chits->in[i]; - } - ++iok; - ++mok; - } - } - - } - else{ - - // Temporary histogram in 1 ns bins to store waveform data - int num_samples=(int)(FDC_TIME_WINDOW); - float *samples=(float *)malloc(num_samples*sizeof(float)); - for (i=0;i THRESH_STRIPS){ - if (threshold_toggle==0){ - chits->in[iok].itrack = chits->in[0].itrack; - chits->in[iok].ptype = chits->in[0].ptype; - chits->in[iok].t=(float) i; - //chits->in[iok].q=samples[i]; - istart=(i > 0)? i-1 : 0; - threshold_toggle=1; - //iok++; - //mok++; - } - } - if (threshold_toggle && - (samples[i] <= THRESH_STRIPS)){ - int j; - // Find the first peak - for (j=istart+1;jsamples[j-1] && samples[j]>samples[j+1]){ - chits->in[iok].q=samples[j]; - break; - } - } - threshold_toggle=0; - iok++; - mok++; - //break; - } - } - i=num_samples-1; - if (samples[i] > THRESH_STRIPS&&threshold_toggle){ - int j; - for (j=istart+1;jsamples[j-1] && samples[j]>samples[j+1]){ - chits->in[iok].q=samples[j]; - break; - } - } - } - - free(samples); - }// Simulate clusters within cell - - if (iok) - { - chits->mult = iok; - //chits->mult=1; - } - else if (chits != HDDM_NULL) - { - FREE(chits); - } - - } - if ((strips != HDDM_NULL) && (mok == 0)) - { - FREE(strips); - strips = HDDM_NULL; - } - - if ((wires != HDDM_NULL) || - (strips != HDDM_NULL) || - (points != HDDM_NULL)) - { - if ((m == 0) || (module > box->fdcChambers->in[m-1].module) - || (layer > box->fdcChambers->in[m-1].layer)) - { - box->fdcChambers->in[m] = chambers->in[0]; - - box->fdcChambers->in[m].fdcCathodeStrips = - make_s_FdcCathodeStrips(stripCount); - box->fdcChambers->in[m].fdcAnodeWires = - make_s_FdcAnodeWires(wireCount); - box->fdcChambers->in[m].fdcTruthPoints = - make_s_FdcTruthPoints(pointCount); - box->fdcChambers->mult++; - } - else - { - m--; - } - for (strip=0; strip < strips->mult; ++strip) - { - int mm = box->fdcChambers->in[m].fdcCathodeStrips->mult++; - box->fdcChambers->in[m].fdcCathodeStrips->in[mm] = strips->in[strip]; - } - if (strips != HDDM_NULL) - { - FREE(strips); - } - for (wire=0; wire < wires->mult; ++wire) - { - int mm = box->fdcChambers->in[m].fdcAnodeWires->mult++; - box->fdcChambers->in[m].fdcAnodeWires->in[mm] = wires->in[wire]; - } - if (wires != HDDM_NULL) - { - FREE(wires); - } - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int mm = box->fdcChambers->in[m].fdcTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->fdcChambers->in[m].fdcTruthPoints - ->in[mm-1].track == track && - fabs(box->fdcChambers->in[m].fdcTruthPoints - ->in[mm-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->fdcChambers->in[m].fdcTruthPoints->in[mm] = points->in[point]; - box->fdcChambers->in[m].fdcTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - } - FREE(chambers); - FREE(item); - } - - stripCount = wireCount = pointCount = 0; - - if ((box->fdcChambers != HDDM_NULL) && - (box->fdcChambers->mult == 0)) - { - FREE(box->fdcChambers); - box->fdcChambers = HDDM_NULL; - } - if (box->fdcChambers->mult == 0) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitFTOF.c b/src/programs/Simulation/HDGeant/hitFTOF.c deleted file mode 100644 index 009c402b7e..0000000000 --- a/src/programs/Simulation/HDGeant/hitFTOF.c +++ /dev/null @@ -1,572 +0,0 @@ -/* - * hitFTOF - registers hits for forward Time-Of-Flight - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: -B. Zihlmann June 19. 2007 - * add hit position to north and south hit structure - * set THRESH_MEV to zero to NOT concatenate hits. - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitforwardTOF - * - * Programmer's Notes: - * ------------------- - * 1) In applying the attenuation to light propagating down to both ends - * of the counters, there has to be some point where the attenuation - * factor is 1. I chose it to be the midplane, so that in the middle - * of the counter both ends see the unattenuated dE values. Closer to - * either end, that end has a larger dE value and the opposite end a - * lower dE value than the actual deposition. - * 2) In applying the propagation delay to light propagating down to the - * ends of the counters, there has to be some point where the timing - * offset is 0. I chose it to be the midplane, so that for hits in - * the middle of the counter the t values measure time-of-flight from - * the t=0 of the event. For hits closer to one end, that end sees - * a t value smaller than its true time-of-flight, and the other end - * sees a value correspondingly larger. The average is the true tof. - */ - -#include -#include -#include - -#include -#include -#include -#include - -#include "calibDB.h" - -extern s_HDDM_t* thisInputEvent; - -// plastic scintillator specific constants -static float ATTEN_LENGTH = 150; -static float C_EFFECTIVE = 15.0; -static float BAR_LENGTH = 252.0; // length of the bar - -// kinematic constants -static float TWO_HIT_RESOL = 25.;// separation time between two different hits - -static float THRESH_MEV = 0.; // do not throw away any hits, one can do that later - -// maximum particle tracks per counter -static int TOF_MAX_HITS = 25; // was 100 changed to 25 - -// maximum MC hits per paddle -static int TOF_MAX_PAD_HITS = 25; - -// Note by RTJ: -// This constant "MAX_HITS" is a convenience constant -// that I introduced to help with preallocating arrays -// to hold hits. It is NOT a tunable simulation parameter. -// Do NOT MODIFY, either its name or its role in the code! -#define MAX_HITS 1000 - - -// top level pointer of FTOF hit tree -binTree_t* forwardTOFTree = 0; - -static int counterCount = 0; -static int pointCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ -// track is ITRA from GEANT -// stack is ISTAK from GEANT -// history is ISTORY from GEANT User flag for current track history (reset to 0 in GLTRAC) - -void hitForwardTOF (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) { - float x[3], t; - // float dx[3]; - //float dr; - // float dEdx; commented out to avoid compiler warnings 4/26/2015 DL - float xlocal[3]; - float xftof[3]; - float zeroHat[] = {0,0,0}; - - if (!initialized) { - - - mystr_t strings[50]; - float values[50]; - int nvalues = 50; - int status = GetConstants("TOF/tof_parms", &nvalues, values, strings); - - if (!status) { - - int ncounter = 0; - int i; - for ( i=0;i<(int)nvalues;i++){ - //printf("%d %s \n",i,strings[i].str); - if (!strcmp(strings[i].str,"TOF_ATTEN_LENGTH")) { - ATTEN_LENGTH = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_C_EFFECTIVE")) { - C_EFFECTIVE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_PADDLE_LENGTH")) { - BAR_LENGTH = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_THRESH_MEV")) { - THRESH_MEV = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_MAX_HITS")){ - TOF_MAX_HITS = (int)values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"TOF_MAX_PAD_HITS")) { - TOF_MAX_PAD_HITS = (int)values[i]; - ncounter++; - } - } - if (ncounter==7){ - printf("TOF: ALL parameters loaded from Data Base\n"); - } else if (ncounter<7){ - printf("TOF: NOT ALL necessary parameters found in Data Base %d out of 7\n",ncounter); - } else { - printf("TOF: SOME parameters found more than once in Data Base\n"); - } - - } - initialized = 1; - - } - - int itrack = (stack == 0)? gidGetId(track) : -1; - - - - // getplane is coded in - // src/programs/Simulation/HDGeant/hddsGeant3.F - // this file is automatically generated from the geometry file - // written in xml format - // NOTE: there are three files hddsGeant3.F with the same name in - // the source code tree namely - // 1) src/programs/Utilities/geantbfield2root/hddsGeant3.F - // 2) src/programs/Simulation/HDGeant/hddsGeant3.F - // 3) src/programs/Simulation/hdds/hddsGeant3.F - // - // while 2) and 3) are identical 1) is a part of 2) and 3) - int plane = getplane_wrapper_(); - - // calculate mean location of track and mean time in [ns] units - // the units of xin xout and x are in [cm] - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - - // tranform the the global x coordinate into the local coordinate of the top_volume FTOF - // defined in the geometry file src/programs/Simulation/hdds/ForwardTOF_HDDS.xml - // the function transform Coord is defined in src/programs/Simulation/HDGeant/hitutil/hitutil.F - transformCoord(x,"global",xlocal,"FTOF"); - transformCoord(zeroHat,"local",xftof,"FTOF"); - - /* post the hit to the truth tree */ - // in other words: store the GENERATED track information - - if ((history == 0) && (plane == 0)) { - - // save all tracks from particles that hit the first plane of FTOF - // save the generated "true" values - - int mark = (1<<30) + pointCount; - - // getTwig is defined in src/programs/Simulation/HDGeant/bintree.c - // the two arguments are a pointer to a pointer and an integer - - void** twig = getTwig(&forwardTOFTree, mark); - if (*twig == 0) { - // make_s_ForwardTOF is defined in src/programs/Analysis/hddm/hddm_s.h - // and coded in src/programs/Analysis/hddm/hddm_s.c - // the same holds for make_s_FtofTruthPoints - - // make_s_ForwardTOF returns pointer to structure s_ForwardTOF generated memory - // tof->ftofCoutners and tof-> ftofTruthPoints are initialized already - - s_ForwardTOF_t* tof = *twig = make_s_ForwardTOF(); - s_FtofTruthPoints_t* points = make_s_FtofTruthPoints(1); - tof->ftofTruthPoints = points; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].x = x[0]; - points->in[0].y = x[1]; - points->in[0].z = x[2]; - points->in[0].t = t; - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark slab as hit */ - // in other words now store the simulated detector response - if (dEsum > 0) { - int nhit; - s_FtofTruthHits_t* hits; - s_FtofTruthExtras_t* extras; - - // getrow and getcolumn are both coded in hddsGeant3.F - // see above for function getplane() - - int row = getrow_wrapper_(); - int column = getcolumn_wrapper_(); - - // distance of hit from PMT north w.r.t. center and similar for PMT south - // this means positive x points north. to get a right handed system y must - // point vertically up as z is the beam axis. - // plane==0 horizontal plane, plane==1 vertical plane - // float dist = xlocal[0]; - - float dist = x[1]; // do not use local coordinate for x and y - if (plane==1) - dist = x[0]; - float dxnorth = BAR_LENGTH/2.-dist; - float dxsouth = BAR_LENGTH/2.+dist; - - // calculate time at the PMT "normalized" to the center, so a hit in the - // center will have time "t" at both PMTs - // the speed of signal travel is C_EFFECTIVE - // propagte time to the end of the bar - // column = 0 is a full paddle column ==1,2 is a half paddle - - float tnorth = t + dxnorth/C_EFFECTIVE; - float tsouth = t + dxsouth/C_EFFECTIVE; - - // calculate energy seen by PM for this track step using attenuation factor - float dEnorth = dEsum * exp(-dxnorth/ATTEN_LENGTH); - float dEsouth = dEsum * exp(-dxsouth/ATTEN_LENGTH); - - if (plane==0) { - if (column==1) { - tnorth=0.; - dEnorth=0.; - } - else if (column==2) { - tsouth=0.; - dEsouth=0.; - } - } - else { - if (column==2) { - tnorth=0.; - dEnorth=0.; - } - else if (column==1) { - tsouth=0.; - dEsouth=0.; - } - } - - - int padl = row; - if (row>44) - padl = row-23; - - //int mark = (plane<<20) + (row<<10) + column; - int mark = (plane<<20) + (padl<<10);// + column; - void** twig = getTwig(&forwardTOFTree, mark); - - if (*twig == 0) { // this paddle has not been hit yet by any particle track - // get space and store it - - s_ForwardTOF_t* tof = *twig = make_s_ForwardTOF(); - s_FtofCounters_t* counters = make_s_FtofCounters(1); - counters->mult = 1; - counters->in[0].plane = plane; - //counters->in[0].bar = row; - counters->in[0].bar = padl; - hits = HDDM_NULL; - - // get space for the left/top or right/down PMT data for a total - // of MAX_HITS possible hits in a single paddle - // Note: column=0 means paddle read out on both ends, - // column=1 means single-ended readout to north end - // column=2 means single-ended readout to south end - - if (column == 0 || column == 1 || column == 2) { - counters->in[0].ftofTruthHits = hits = make_s_FtofTruthHits(MAX_HITS); - } - tof->ftofCounters = counters; - counterCount++; - - } else { - - // this paddle is already registered (was hit before) - // get the hit list back - s_ForwardTOF_t* tof = *twig; - hits = tof->ftofCounters->in[0].ftofTruthHits; - } - - if (hits != HDDM_NULL && dEnorth > 0) { - - // loop over hits in this PM to find correct time slot, north end - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (hits->in[nhit].end == 0 && - fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - - // this hit is within the time frame of a previous hit - // combine the times of this weighted by the energy of the hit - - if (nhit < hits->mult) { /* merge with former hit */ - float dEnew=hits->in[nhit].dE + dEnorth; - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + tnorth * dEnorth) /dEnew; - hits->in[nhit].dE=dEnew; - - // now add MC tracking information - // first get MC pointer of this paddle - - extras = hits->in[nhit].ftofTruthExtras; - unsigned int nMChit = extras->mult; - if (nMChit < MAX_HITS) { - extras->in[nMChit].x = x[0]; - extras->in[nMChit].y = x[1]; - extras->in[nMChit].z = x[2]; - extras->in[nMChit].E = pin[3]; - extras->in[nMChit].px = pin[0]*pin[4]; - extras->in[nMChit].py = pin[1]*pin[4]; - extras->in[nMChit].pz = pin[2]*pin[4]; - extras->in[nMChit].ptype = ipart; - extras->in[nMChit].itrack = itrack; - extras->in[nMChit].dist = dist; - extras->mult++; - } - - } else if (nhit < MAX_HITS) { // hit in new time window - hits->in[nhit].t = tnorth; - hits->in[nhit].dE = dEnorth; - hits->in[nhit].end = 0; - hits->mult++; - - // create memory for MC track hit information - hits->in[nhit].ftofTruthExtras = - extras = make_s_FtofTruthExtras(MAX_HITS); - - extras->in[0].x = x[0]; - extras->in[0].y = x[1]; - extras->in[0].z = x[2]; - extras->in[0].E = pin[3]; - extras->in[0].px = pin[0]*pin[4]; - extras->in[0].py = pin[1]*pin[4]; - extras->in[0].pz = pin[2]*pin[4]; - extras->in[0].ptype = ipart; - extras->in[0].itrack = itrack; - extras->in[0].dist = dist; - extras->mult = 1; - } else { - fprintf(stderr,"HDGeant error in hitForwardTOF (file hitFTOF.c): "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - } - - if (hits != HDDM_NULL && dEsouth > 0) { - - // loop over hits in this PM to find correct time slot, south end - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (hits->in[nhit].end == 1 && - fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - - // this hit is within the time frame of a previous hit - // combine the times of this weighted by the energy of the hit - - if (nhit < hits->mult) { /* merge with former hit */ - float dEnew=hits->in[nhit].dE + dEsouth; - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + tsouth * dEsouth) / dEnew; - hits->in[nhit].dE=dEnew; - extras = hits->in[nhit].ftofTruthExtras; - - // now add MC tracking information - unsigned int nMChit = extras->mult; - if (nMChit < MAX_HITS) { - extras->in[nMChit].x = x[0]; - extras->in[nMChit].y = x[1]; - extras->in[nMChit].z = x[2]; - extras->in[nMChit].E = pin[3]; - extras->in[nMChit].px = pin[0]*pin[4]; - extras->in[nMChit].py = pin[1]*pin[4]; - extras->in[nMChit].pz = pin[2]*pin[4]; - extras->in[nMChit].ptype = ipart; - extras->in[nMChit].itrack = itrack; - extras->in[nMChit].dist = dist; - extras->mult++; - } - - } else if (nhit < MAX_HITS) { // hit in new time window - hits->in[nhit].t = tsouth; - hits->in[nhit].dE = dEsouth; - hits->in[nhit].end = 1; - hits->mult++; - - // create memory space for MC track hit information - hits->in[nhit].ftofTruthExtras = - extras = make_s_FtofTruthExtras(MAX_HITS); - extras->in[0].x = x[0]; - extras->in[0].y = x[1]; - extras->in[0].z = x[2]; - extras->in[0].E = pin[3]; - extras->in[0].px = pin[0]*pin[4]; - extras->in[0].py = pin[1]*pin[4]; - extras->in[0].pz = pin[2]*pin[4]; - extras->in[0].ptype = ipart; - extras->in[0].itrack = itrack; - extras->in[0].dist = dist; - extras->mult = 1; - } else { - fprintf(stderr,"HDGeant error in hitForwardTOF (file hitFTOF.c): "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - } - } -} - -/* entry point from fortran */ - -void hitforwardtof_ (float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitForwardTOF(xin,xout,pin,pout,*dEsum,*track,*stack,*history, *ipart); -} - - -/* pick and package the hits for shipping */ -// this function is called by loadoutput() (coded in hddmOutput.c) -// which in turn is called by GUOUT at the end of each event - -s_ForwardTOF_t* pickForwardTOF () -{ - s_ForwardTOF_t* box; - s_ForwardTOF_t* item; - - if ((counterCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_ForwardTOF(); - box->ftofCounters = make_s_FtofCounters(counterCount); - box->ftofTruthPoints = make_s_FtofTruthPoints(pointCount); - - while ((item = (s_ForwardTOF_t*) pickTwig(&forwardTOFTree))) { - s_FtofCounters_t* counters = item->ftofCounters; - int counter; - s_FtofTruthPoints_t* points = item->ftofTruthPoints; - int point; - - for (counter=0; counter < counters->mult; ++counter) { - s_FtofTruthHits_t* hits = counters->in[counter].ftofTruthHits; - - /* compress out the hits below threshold */ - // cut off parameter is THRESH_MEV - int iok,i; - int mok=0; - // loop over all hits in a counter for the left/up PMT - for (iok=i=0; i < hits->mult; i++) { - - // check threshold - if (hits->in[i].dE > THRESH_MEV/1e3) { - - if (iok < i) { - hits->in[iok] = hits->in[i]; - } - ++mok; - ++iok; - } - } - - if (iok) { - hits->mult = iok; - } else if (hits != HDDM_NULL){ // no hits left over for this PMT - counters->in[counter].ftofHits = HDDM_NULL; - FREE(hits); - } - - if (mok){ // total number of time independent FTOF hits in this counter - int m = box->ftofCounters->mult++; - // add the hit list of this counter to the list - box->ftofCounters->in[m] = counters->in[counter]; - } - } // end of loop over all counters - - if (counters != HDDM_NULL) { - FREE(counters); - } - - // keep also the MC generated primary track particles - for (point=0; point < points->mult; ++point) { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->ftofTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->ftofTruthPoints->in[m-1].track == track && - fabs(box->ftofTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->ftofTruthPoints->in[m] = points->in[point]; - box->ftofTruthPoints->mult++; - } - if (points != HDDM_NULL) { - FREE(points); - } - FREE(item); - } - - // reset the counters - counterCount = pointCount = 0; - - // free the hit list memory used by this event - if ((box->ftofCounters != HDDM_NULL) && - (box->ftofCounters->mult == 0)) { - FREE(box->ftofCounters); - box->ftofCounters = HDDM_NULL; - } - if ((box->ftofTruthPoints != HDDM_NULL) && - (box->ftofTruthPoints->mult == 0)) { - FREE(box->ftofTruthPoints); - box->ftofTruthPoints = HDDM_NULL; - } - if ((box->ftofCounters->mult == 0) && - (box->ftofTruthPoints->mult == 0)) { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitGCal.c b/src/programs/Simulation/HDGeant/hitGCal.c deleted file mode 100644 index 3c322fb03e..0000000000 --- a/src/programs/Simulation/HDGeant/hitGCal.c +++ /dev/null @@ -1,257 +0,0 @@ -/* - * hitGCal - registers hits for gap calorimeter - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitGapEMcal - */ - -#include -#include -#include - -#include -#include -#include -#include - -extern s_HDDM_t* thisInputEvent; - -//#define ATTEN_LENGTH 100. -#define ATTEN_LENGTH 1e6 -#define C_EFFECTIVE 15. -#define WIDTH_OF_BLOCK 4. -#define LENGTH_OF_BLOCK 45. -#define TWO_HIT_RESOL 75. -#define MAX_HITS 100 -#define THRESH_MEV 30. -#define ACTIVE_RADIUS 120.e6 -#define CENTRAL_ROW 29 -#define CENTRAL_COLUMN 29 - - -binTree_t* gapEMcalTree = 0; -static int cellCount = 0; -static int showerCount = 0; - - -/* register hits during tracking (from gustep) */ - -void hitGapEMcal (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - //float x[3], t; - float xgcal[3]; - float zeroHat[] = {0,0,0}; - - //x[0] = (xin[0] + xout[0])/2; - //x[1] = (xin[1] + xout[1])/2; - //x[2] = (xin[2] + xout[2])/2; - float t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(zeroHat,"local",xgcal,"gCAL"); - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if ((history == 0) && (pin[3] > THRESH_MEV/1e3)) - { - s_GcalTruthShowers_t* showers; - float r = sqrt(xin[0]*xin[0]+xin[1]*xin[1]); - float phi = atan2(xin[1],xin[0]); - int mark = (1<<30) + showerCount; - void** twig = getTwig(&gapEMcalTree, mark); - if (*twig == 0) - { - s_GapEMcal_t* cal = *twig = make_s_GapEMcal(); - cal->gcalTruthShowers = showers = make_s_GcalTruthShowers(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - showers->in[0].primary = (track <= a && stack == 0); - showers->in[0].track = track; - showers->in[0].z = xin[2]; - showers->in[0].r = r; - showers->in[0].phi = phi; - showers->in[0].t = xin[3]*1e9; - showers->in[0].px = pin[0]*pin[4]; - showers->in[0].py = pin[1]*pin[4]; - showers->in[0].pz = pin[2]*pin[4]; - showers->in[0].E = pin[3]; - showers->in[0].ptype = ipart; - showers->in[0].trackID = make_s_TrackID(); - showers->in[0].trackID->itrack = itrack; - showers->mult = 1; - showerCount++; - } - } - - /* post the hit to the hits tree, mark block as hit */ - - if (dEsum > 0) - { - int nhit; - s_GcalHits_t* hits; - int module = getmodule_wrapper_(); - float dist = LENGTH_OF_BLOCK-xgcal[2]; - float dEcorr = dEsum * exp(-dist/ATTEN_LENGTH); - float tcorr = t + dist/C_EFFECTIVE; - int mark = ((module+1)<<16); - void** twig = getTwig(&gapEMcalTree, mark); - if (*twig == 0) - { - s_GapEMcal_t* cal = *twig = make_s_GapEMcal(); - s_GcalCells_t* cells = make_s_GcalCells(1); - cells->mult = 1; - cells->in[0].module = module; - cells->in[0].gcalHits = hits = make_s_GcalHits(MAX_HITS); - cal->gcalCells = cells; - cellCount++; - } - else - { - s_GapEMcal_t* cal = *twig; - hits = cal->gcalCells->in[0].gcalHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - tcorr) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tcorr*dEcorr) - / (hits->in[nhit].E + dEcorr); - hits->in[nhit].E += dEcorr; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = tcorr; - hits->in[nhit].E = dEcorr; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitgapEMcal: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitgapemcal_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitGapEMcal(xin,xout,pin,pout,*dEsum,*track,*stack,*history, *ipart); -} - - -/* pick and package the hits for shipping */ - -s_GapEMcal_t* pickGapEMcal () -{ - s_GapEMcal_t* box; - s_GapEMcal_t* item; - -#if TESTING_CAL_CONTAINMENT - double Etotal = 0; -#endif - if ((cellCount == 0) && (showerCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_GapEMcal(); - box->gcalCells = make_s_GcalCells(cellCount); - box->gcalTruthShowers = make_s_GcalTruthShowers(showerCount); - while ((item = (s_GapEMcal_t*) pickTwig(&gapEMcalTree))) - { - s_GcalCells_t* cells = item->gcalCells; - int cell; - s_GcalTruthShowers_t* showers = item->gcalTruthShowers; - int shower; - for (cell=0; cell < cells->mult; ++cell) - { - int m = box->gcalCells->mult; - - s_GcalHits_t* hits = cells->in[cell].gcalHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].E > THRESH_MEV/1e3) - { -#if TESTING_CAL_CONTAINMENT - Etotal += hits->in[i].E; -#endif - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->gcalCells->in[m] = cells->in[cell]; - box->gcalCells->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - - for (shower=0; shower < showers->mult; ++shower) - { - int m = box->gcalTruthShowers->mult++; - box->gcalTruthShowers->in[m] = showers->in[shower]; - } - if (cells != HDDM_NULL) - { - FREE(cells); - } - if (showers != HDDM_NULL) - { - FREE(showers); - } - FREE(item); - } - - cellCount = showerCount = 0; - - if ((box->gcalCells != HDDM_NULL) && - (box->gcalCells->mult == 0)) - { - FREE(box->gcalCells); - box->gcalCells = HDDM_NULL; - } - if ((box->gcalTruthShowers != HDDM_NULL) && - (box->gcalTruthShowers->mult == 0)) - { - FREE(box->gcalTruthShowers); - box->gcalTruthShowers = HDDM_NULL; - } - if ((box->gcalCells->mult == 0) && - (box->gcalTruthShowers->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } -#if TESTING_CAL_CONTAINMENT - printf("GCal energy sum: %f\n",Etotal); -#endif - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitPS.c b/src/programs/Simulation/HDGeant/hitPS.c deleted file mode 100644 index 8573fd99c6..0000000000 --- a/src/programs/Simulation/HDGeant/hitPS.c +++ /dev/null @@ -1,280 +0,0 @@ -/* - * hitPS - registers hits for Pair Spectrometer - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Simon Taylor, Oct 16, 2014 - * - */ - -#include -#include -#include - -#include -#include -#include -#include -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; - -//static float ATTEN_LENGTH = 150.; -//static float C_EFFECTIVE = 15.; -static float TWO_HIT_RESOL = 25.; -static float THRESH_MEV = 0.010; - -// the fine PS has two arms (north/south) of 145 columns each -#define NUM_COLUMN_PER_ARM 145 - -// Comment by RTJ: -// When I introduced the convenience constant MAX_HITS, -// I never intended it to be a tunable simulation parameter. -// Do not use it as such. Do NOT MODIFY it, or the way -// it functions in the algorithm. If you want to truncate -// the hit list, do it in mcsmear. -#define MAX_HITS 100 - -binTree_t* psTree = 0; -static int tileCount = 0; -static int pointCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ - -void hitPS(float xin[4], float xout[4],float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - - if (!initialized) { - // Get calibration constants ... - - initialized = 1; - } - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xlocal,"local"); - dx[0] = xin[0] - xout[0]; - dx[1] = xin[1] - xout[1]; - dx[2] = xin[2] - xout[2]; - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(&psTree, mark); - if (*twig == 0) - { - s_PairSpectrometerFine_t* ps = *twig = make_s_PairSpectrometerFine(); - s_PsTruthPoints_t* points = make_s_PsTruthPoints(1); - ps->psTruthPoints = points; - int column = getcolumn_wrapper_(); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].t = t; - points->in[0].z = x[2]; - points->in[0].x = x[0]; - points->in[0].y = x[1]; - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - // the fine PS has two arms: North/South (0/1) - points->in[0].arm = (column - 1) / NUM_COLUMN_PER_ARM; - points->in[0].column = (column - 1) % NUM_COLUMN_PER_ARM + 1; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark column as hit */ - if (dEsum > 0) - { - int nhit; - s_PsTruthHits_t* hits; - int column = getcolumn_wrapper_(); - int mark = column; - void** twig = getTwig(&psTree, mark); - if (*twig == 0) - { - s_PairSpectrometerFine_t* ps = *twig = make_s_PairSpectrometerFine(); - s_PsTiles_t* tiles = make_s_PsTiles(1); - tiles->mult = 1; - // the fine PS has two arms: North/South (0/1) - tiles->in[0].arm = (column - 1) / NUM_COLUMN_PER_ARM; - tiles->in[0].column = (column - 1) % NUM_COLUMN_PER_ARM + 1; - tiles->in[0].psTruthHits = hits = make_s_PsTruthHits(MAX_HITS); - ps->psTiles = tiles; - tileCount++; - } - else - { - s_PairSpectrometerFine_t* ps = *twig; - hits = ps->psTiles->in[0].psTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + t * dEsum) / - (hits->in[nhit].dE + dEsum); - hits->in[nhit].dE += dEsum; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = t; - hits->in[nhit].dE = dEsum; - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitPS: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitps_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitPS(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_PairSpectrometerFine_t* pickPs () -{ - s_PairSpectrometerFine_t* box; - s_PairSpectrometerFine_t* item; - - if ((tileCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_PairSpectrometerFine(); - box->psTiles = make_s_PsTiles(tileCount); - box->psTruthPoints = make_s_PsTruthPoints(pointCount); - while ((item = (s_PairSpectrometerFine_t*) pickTwig(&psTree))) - { - s_PsTiles_t* tiles = item->psTiles; - int tile; - s_PsTruthPoints_t* points = item->psTruthPoints; - int point; - - for (tile=0; tile < tiles->mult; ++tile) - { - int m = box->psTiles->mult; - - s_PsTruthHits_t* hits = tiles->in[tile].psTruthHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].dE > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->psTiles->in[m] = tiles->in[tile]; - box->psTiles->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (tiles != HDDM_NULL) - { - FREE(tiles); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->psTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->psTruthPoints->in[m-1].track == track && - fabs(box->psTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->psTruthPoints->in[m] = item->psTruthPoints->in[point]; - box->psTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - tileCount = pointCount = 0; - - if ((box->psTiles != HDDM_NULL) && - (box->psTiles->mult == 0)) - { - FREE(box->psTiles); - box->psTiles = HDDM_NULL; - } - if ((box->psTruthPoints != HDDM_NULL) && - (box->psTruthPoints->mult == 0)) - { - FREE(box->psTruthPoints); - box->psTruthPoints = HDDM_NULL; - } - if ((box->psTiles->mult == 0) && - (box->psTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitPSC.c b/src/programs/Simulation/HDGeant/hitPSC.c deleted file mode 100644 index b74706219b..0000000000 --- a/src/programs/Simulation/HDGeant/hitPSC.c +++ /dev/null @@ -1,278 +0,0 @@ -/* - * hitPSC - registers hits for Pair Spectrometer Coarse paddles - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Simon Taylor, Oct 16, 2014 - * - */ - -#include -#include -#include - -#include -#include -#include -#include -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; - -//static float ATTEN_LENGTH = 150.; -//static float C_EFFECTIVE = 15.; -static float TWO_HIT_RESOL = 25.; -static float THRESH_MEV = 0.010; - -// the coarse PS has two arms (north/south) of 8 modules each -#define NUM_MODULES_PER_ARM 8 - -// Comment by RTJ: -// When I introduced the convenience constant MAX_HITS, -// I never intended it to be a tunable simulation parameter. -// Do not use it as such. Do NOT MODIFY it, or the way -// it functions in the algorithm. If you want to truncate -// the hit list, do it in mcsmear. -#define MAX_HITS 100 - -binTree_t* pscTree = 0; -static int paddleCount = 0; -static int pointCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ - -void hitPSC(float xin[4], float xout[4],float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - - if (!initialized) { - // Get calibration constants ... - - initialized = 1; - } - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xlocal,"local"); - dx[0] = xin[0] - xout[0]; - dx[1] = xin[1] - xout[1]; - dx[2] = xin[2] - xout[2]; - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(&pscTree, mark); - if (*twig == 0) - { - s_PairSpectrometerCoarse_t* psc = *twig = make_s_PairSpectrometerCoarse(); - s_PscTruthPoints_t* points = make_s_PscTruthPoints(1); - psc->pscTruthPoints = points; - int module = getmodule_wrapper_(); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].t = t; - points->in[0].z = x[2]; - points->in[0].x = x[0]; - points->in[0].y = x[1]; - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - points->in[0].arm = (module - 1) / NUM_MODULES_PER_ARM; - points->in[0].module = (module - 1) % NUM_MODULES_PER_ARM + 1; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark module as hit */ - if (dEsum > 0) - { - int nhit; - s_PscTruthHits_t* hits; - int module = getmodule_wrapper_(); - int mark = module; - void** twig = getTwig(&pscTree, mark); - if (*twig == 0) - { - s_PairSpectrometerCoarse_t* psc = *twig = make_s_PairSpectrometerCoarse(); - s_PscPaddles_t* paddles = make_s_PscPaddles(1); - paddles->mult = 1; - paddles->in[0].arm = (module - 1) / NUM_MODULES_PER_ARM; - paddles->in[0].module = (module - 1) % NUM_MODULES_PER_ARM + 1; - paddles->in[0].pscTruthHits = hits = make_s_PscTruthHits(MAX_HITS); - psc->pscPaddles = paddles; - paddleCount++; - } - else - { - s_PairSpectrometerCoarse_t* psc = *twig; - hits = psc->pscPaddles->in[0].pscTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + t * dEsum) / - (hits->in[nhit].dE + dEsum); - hits->in[nhit].dE += dEsum; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = t; - hits->in[nhit].dE = dEsum; - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitPSC: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitpsc_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitPSC(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_PairSpectrometerCoarse_t* pickPsc () -{ - s_PairSpectrometerCoarse_t* box; - s_PairSpectrometerCoarse_t* item; - - if ((paddleCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_PairSpectrometerCoarse(); - box->pscPaddles = make_s_PscPaddles(paddleCount); - box->pscTruthPoints = make_s_PscTruthPoints(pointCount); - while ((item = (s_PairSpectrometerCoarse_t*) pickTwig(&pscTree))) - { - s_PscPaddles_t* paddles = item->pscPaddles; - int paddle; - s_PscTruthPoints_t* points = item->pscTruthPoints; - int point; - - for (paddle=0; paddle < paddles->mult; ++paddle) - { - int m = box->pscPaddles->mult; - - s_PscTruthHits_t* hits = paddles->in[paddle].pscTruthHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].dE > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->pscPaddles->in[m] = paddles->in[paddle]; - box->pscPaddles->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (paddles != HDDM_NULL) - { - FREE(paddles); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->pscTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->pscTruthPoints->in[m-1].track == track && - fabs(box->pscTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->pscTruthPoints->in[m] = item->pscTruthPoints->in[point]; - box->pscTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - paddleCount = pointCount = 0; - - if ((box->pscPaddles != HDDM_NULL) && - (box->pscPaddles->mult == 0)) - { - FREE(box->pscPaddles); - box->pscPaddles = HDDM_NULL; - } - if ((box->pscTruthPoints != HDDM_NULL) && - (box->pscTruthPoints->mult == 0)) - { - FREE(box->pscTruthPoints); - box->pscTruthPoints = HDDM_NULL; - } - if ((box->pscPaddles->mult == 0) && - (box->pscTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitStart.c b/src/programs/Simulation/HDGeant/hitStart.c deleted file mode 100644 index 8e4b904f0f..0000000000 --- a/src/programs/Simulation/HDGeant/hitStart.c +++ /dev/null @@ -1,501 +0,0 @@ -/* - * hitStart - registers hits for Start counter - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones July 16, 2001 - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitStartCntr - * changes: Tue Aug 25 17:49:21 EDT 2015 E. Pooser - * 1) Change ANGLE_COR from 1.038 to 1.054 (this corresponds to the - * correct 18.5 deg bend towards the beam line in the nose region) - * 2) Add channel by channel corrections for the propagation time and - * attenuation in which constants were determined from beam data and - * bench data (taken at FIU) respectively - * - * - * Programmer's Notes: - * ------------------- - * 1) In applying the attenuation to light propagating down to the end - * of the counters, there has to be some point where the attenuation - * factor is 1. I chose it to be the midplane, so that in the middle - * of the counters the attenuation factor is 1. - * 2) In applying the propagation delay to light propagating down to the - * end of the counters, there has to be some point where the timing - * offset is 0. I chose it to be the midplane, so that for hits in - * the middle of the counter the t values measure time-of-flight from - * the t=0 of the event. - */ - -#include -#include -#include - -#include -#include -#include -#include -#include "calibDB.h" -extern s_HDDM_t* thisInputEvent; - -static float ATTEN_LENGTH = 150.; -static float C_EFFECTIVE = 15.; -static float TWO_HIT_RESOL = 25.; -static int START_MAX_HITS = 100; -static float THRESH_MEV = 0.150; -static float LIGHT_GUIDE = 0.; -//static float ANGLE_COR = 1.038; -static float ANGLE_COR = 1.054; -static float BENT_REGION = 39.465; -static float STRAIGHT_LENGTH = 39.465; -static float BEND_LENGTH = 3.592375; -static float NOSE_LENGTH = 15.536625; - -static float SC_STRAIGHT_ATTENUATION_A[30], SC_STRAIGHT_ATTENUATION_B[30], SC_STRAIGHT_ATTENUATION_C[30]; -static float SC_BENDNOSE_ATTENUATION_A[30], SC_BENDNOSE_ATTENUATION_B[30], SC_BENDNOSE_ATTENUATION_C[30]; -static float SC_STRAIGHT_PROPAGATION_A[30], SC_STRAIGHT_PROPAGATION_B[30]; -static float SC_BEND_PROPAGATION_A[30], SC_BEND_PROPAGATION_B[30]; -static float SC_NOSE_PROPAGATION_A[30], SC_NOSE_PROPAGATION_B[30]; - -static int NCHANNELS = 30; - -// Comment by RTJ: -// When I introduced the convenience constant MAX_HITS, -// I never intended it to be a tunable simulation parameter. -// Do not use it as such. Do NOT MODIFY it, or the way -// it functions in the algorithm. If you want to truncate -// the hit list, do it in mcsmear. -#define MAX_HITS 100 - -binTree_t* startCntrTree = 0; -static int paddleCount = 0; -static int pointCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ - -void hitStartCntr (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - - if (!initialized) { - - mystr_t strings[50]; - float values[50]; - int nvalues = 50; - int status = GetConstants("START_COUNTER/start_parms", &nvalues, values, strings); - - if (!status) { - int ncounter = 0; - int i; - for ( i=0;i<(int)nvalues;i++){ - //printf("%d %s \n", i, strings[i].str); - if (!strcmp(strings[i].str,"START_ATTEN_LENGTH")) { - ATTEN_LENGTH = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_C_EFFECTIVE")) { - C_EFFECTIVE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_TWO_HIT_RESOL")) { - TWO_HIT_RESOL = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_MAX_HITS")) { - START_MAX_HITS = (int)values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_THRESH_MEV")) { - THRESH_MEV = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_LIGHT_GUIDE")) { - LIGHT_GUIDE = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_ANGLE_COR")) { - ANGLE_COR = values[i]; - ncounter++; - } - if (!strcmp(strings[i].str,"START_BENT_REGION")) { - BENT_REGION = values[i]; - ncounter++; - } - } - if (ncounter==8){ - printf("START: ALL parameters loaded from Data Base\n"); - } else if (ncounter<8){ - printf("START: NOT ALL necessary parameters found in Data Base %d out of 8\n",ncounter); - } else { - printf("START: SOME parameters found more than once in Data Base\n"); - } - } - - // Attenuations correction constants for straight section - int sc_straight_attenuation_a = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_STRAIGHT_ATTENUATION_A, "SC_STRAIGHT_ATTENUATION_A"); - if (sc_straight_attenuation_a) - printf("ERROR LOADING SC_STRAIGHT_ATTENUATION_A from START_COUNTER/attenuation_factor"); - int sc_straight_attenuation_b = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_STRAIGHT_ATTENUATION_B, "SC_STRAIGHT_ATTENUATION_B"); - if (sc_straight_attenuation_b) - printf("ERROR LOADING SC_STRAIGHT_ATTENUATION_B from START_COUNTER/attenuation_factor"); - int sc_straight_attenuation_c = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_STRAIGHT_ATTENUATION_C, "SC_STRAIGHT_ATTENUATION_C"); - if (sc_straight_attenuation_c) - printf("ERROR LOADING SC_STRAIGHT_ATTENUATION_C from START_COUNTER/attenuation_factor"); - - // Attenuation correction constants for bend/nose section - int sc_bendnose_attenuation_a = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_BENDNOSE_ATTENUATION_A, "SC_BENDNOSE_ATTENUATION_A"); - if (sc_bendnose_attenuation_a) - printf("ERROR LOADING SC_BENDNOSE_ATTENUATION_A from START_COUNTER/attenuation_factor"); - int sc_bendnose_attenuation_b = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_BENDNOSE_ATTENUATION_B, "SC_BENDNOSE_ATTENUATION_B"); - if (sc_bendnose_attenuation_b) - printf("ERROR LOADING SC_BENDNOSE_ATTENUATION_B from START_COUNTER/attenuation_factor"); - int sc_bendnose_attenuation_c = GetColumn("START_COUNTER/attenuation_factor", &NCHANNELS, SC_BENDNOSE_ATTENUATION_C, "SC_BENDNOSE_ATTENUATION_C"); - if (sc_bendnose_attenuation_c) - printf("ERROR LOADING SC_BENDNOSE_ATTENUATION_C from START_COUNTER/attenuation_factor"); - - // Propagation time correction constants for straight section - int sc_straight_propagation_a = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_STRAIGHT_PROPAGATION_A, "a"); - if (sc_straight_propagation_a) - printf("ERROR LOADING SC_STRAIGHT_PROPAGATION_A from START_COUNTER/propagation_time_corr"); - int sc_straight_propagation_b = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_STRAIGHT_PROPAGATION_B, "b"); - if (sc_straight_propagation_b) - printf("ERROR LOADING SC_STRAIGHT_PROPAGATION_B from START_COUNTER/propagation_time_corr"); - - // Propagation time correction constants for bend section - int sc_bend_propagation_a = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_BEND_PROPAGATION_A, "c"); - if (sc_bend_propagation_a) - printf("ERROR LOADING SC_BEND_PROPAGATION_A from START_COUNTER/propagation_time_corr"); - int sc_bend_propagation_b = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_BEND_PROPAGATION_B, "d"); - if (sc_bend_propagation_b) - printf("ERROR LOADING SC_BEND_PROPAGATION_B from START_COUNTER/propagation_time_corr"); - - // Propagation time correction constants for nose section - int sc_nose_propagation_a = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_NOSE_PROPAGATION_A, "e"); - if (sc_nose_propagation_a) - printf("ERROR LOADING SC_NOSE_PROPAGATION_A from START_COUNTER/propagation_time_corr"); - int sc_nose_propagation_b = GetColumn("START_COUNTER/propagation_time_corr", &NCHANNELS, SC_NOSE_PROPAGATION_B, "f"); - if (sc_nose_propagation_b) - printf("ERROR LOADING SC_NOSE_PROPAGATION_B from START_COUNTER/propagation_time_corr"); - - initialized = 1; - } - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xlocal,"local"); - dx[0] = xin[0] - xout[0]; - dx[1] = xin[1] - xout[1]; - dx[2] = xin[2] - xout[2]; - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - /* float dbent = 0.0; */ - /* float dpath = 0.0; */ - /* if(xlocal[2] >= BENT_REGION){ */ - /* dbent = ( xlocal[2] - BENT_REGION )*ANGLE_COR; */ - /* dpath = BENT_REGION + dbent; */ - /* } else { */ - /* dpath = xlocal[2]; */ - /* } */ - - /* float dEcorr = dEsum * exp(-dpath/ATTEN_LENGTH); */ - /* float tcorr = t + dpath/C_EFFECTIVE; */ - - - // printf("x_gl, z_gl, x_l, z_l %f %f %f\n", - // xin[0],xin[1],xin[2]); - - // printf("x_gl, z_gl, x_l, z_l %f %f %f %f %f %f %f\n", - // x[0],x[1],x[2], xlocal[0],xlocal[1],xlocal[2],dpath); - - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(&startCntrTree, mark); - if (*twig == 0) - { - s_StartCntr_t* stc = *twig = make_s_StartCntr(); - s_StcTruthPoints_t* points = make_s_StcTruthPoints(1); - stc->stcTruthPoints = points; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].t = t; - points->in[0].z = x[2]; - points->in[0].r = sqrt(x[0]*x[0]+x[1]*x[1]); - points->in[0].phi = atan2(x[1],x[0]); - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - points->in[0].sector = getsector_wrapper_(); - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark sector as hit */ - - // if( (ipart==8) && (x[2]<90.)){ - // printf("x_gl, z_gl, x_l, z_l %f %f %f %f %f %f\n", - // x[0],x[1],x[2], xlocal[0],xlocal[1],xlocal[2]); - // } - - - if (dEsum > 0) - { - int nhit; - s_StcTruthHits_t* hits; - int sector = getsector_wrapper_(); - - // printf("x_gl, z_gl, x_l, z_l %f %f %f %f %f %f\n", - // x[0],x[1],x[2], xlocal[0],xlocal[1],xlocal[2]); - - float dbent = 0.0; - float dpath = 0.0; - if(xlocal[2] >= BENT_REGION){ - dbent = ( xlocal[2] - BENT_REGION )*ANGLE_COR; - dpath = BENT_REGION + dbent; - } else { - dpath = xlocal[2]; - } - - /* float dEcorr = dEsum * exp(-dpath/ATTEN_LENGTH); */ - /* float tcorr = t + dpath/C_EFFECTIVE; */ - - /* printf("\n Sector %d Fired \n t = %.5f \n dEsum = %.5f \n dpath = %.5f \n", */ - /* sector, t, dEsum, dpath); */ - - int sector_index = sector - 1; - float dEcorr = 9.9E+9; - float tcorr = 9.9E+9; - - if (xlocal[2] <= STRAIGHT_LENGTH) - { - dEcorr = dEsum * exp(dpath*SC_STRAIGHT_ATTENUATION_B[sector_index]); - tcorr = t + dpath * SC_STRAIGHT_PROPAGATION_B[sector_index] + SC_STRAIGHT_PROPAGATION_A[sector_index]; - - /* printf("HIT OCCURED IN STRAIGHT SECTION \n"); */ - /* printf("Attenuation Corrections: A = %.5f, B = %.5f, C = %.5f \n", SC_STRAIGHT_ATTENUATION_A[sector_index], SC_STRAIGHT_ATTENUATION_B[sector_index], SC_STRAIGHT_ATTENUATION_C[sector_index]); */ - /* printf("Time Corrections: B = %.5f, A = %.5f \n", SC_STRAIGHT_PROPAGATION_B[sector_index], SC_STRAIGHT_PROPAGATION_A[sector_index]); */ - } - else if (xlocal[2] > STRAIGHT_LENGTH && xlocal[2] <= (STRAIGHT_LENGTH + BEND_LENGTH)) - { - dEcorr = dEsum * ((SC_BENDNOSE_ATTENUATION_A[sector_index] * exp(dpath*SC_BENDNOSE_ATTENUATION_B[sector_index]) + SC_BENDNOSE_ATTENUATION_C[sector_index]) / - SC_STRAIGHT_ATTENUATION_A[sector_index]); - tcorr = t + dpath * SC_BEND_PROPAGATION_B[sector_index] + SC_BEND_PROPAGATION_A[sector_index]; - - /* printf("HIT OCCURED IN BEND SECTION \n"); */ - /* printf("Attenuation Corrections: A = %.5f, B = %.5f, C = %.5f \n", SC_BENDNOSE_ATTENUATION_A[sector_index], SC_BENDNOSE_ATTENUATION_B[sector_index], SC_BENDNOSE_ATTENUATION_C[sector_index]); */ - /* printf("Time Corrections: B = %.5f, A = %.5f \n", SC_BEND_PROPAGATION_B[sector_index], SC_BEND_PROPAGATION_A[sector_index]); */ - } - else if (xlocal[2] > (STRAIGHT_LENGTH + BEND_LENGTH) && xlocal[2] <= (STRAIGHT_LENGTH + BEND_LENGTH + NOSE_LENGTH)) - { - dEcorr = dEsum * ((SC_BENDNOSE_ATTENUATION_A[sector_index] * exp(dpath*SC_BENDNOSE_ATTENUATION_B[sector_index]) + SC_BENDNOSE_ATTENUATION_C[sector_index]) / - SC_STRAIGHT_ATTENUATION_A[sector_index]); - - tcorr = t + dpath * SC_NOSE_PROPAGATION_B[sector_index] + SC_NOSE_PROPAGATION_A[sector_index]; - - /* printf("HIT OCCURED IN NOSE SECTION \n"); */ - /* printf("Attenuation Corrections: A = %.5f, B = %.5f, C = %.5f \n", SC_BENDNOSE_ATTENUATION_A[sector_index], SC_BENDNOSE_ATTENUATION_B[sector_index], SC_BENDNOSE_ATTENUATION_C[sector_index]); */ - /* printf("Time Corrections: B = %.5f, A = %.5f \n", SC_NOSE_PROPAGATION_B[sector_index], SC_NOSE_PROPAGATION_A[sector_index]); */ - } - else return; - - /* printf("tcorr = %.5f \n dEcorr = %.5f \n", tcorr, dEcorr); */ - - // float dpath = xlocal[2]+(10.2-xlocal[0])*0.4; - // float tcorr = t + dpath/C_EFFECTIVE; - // float dEcorr = dEsum * exp(-dpath/ATTEN_LENGTH); - int mark = sector; - void** twig = getTwig(&startCntrTree, mark); - if (*twig == 0) - { - s_StartCntr_t* stc = *twig = make_s_StartCntr(); - s_StcPaddles_t* paddles = make_s_StcPaddles(1); - paddles->mult = 1; - paddles->in[0].sector = sector; - paddles->in[0].stcTruthHits = hits = make_s_StcTruthHits(MAX_HITS); - stc->stcPaddles = paddles; - paddleCount++; - } - else - { - s_StartCntr_t* stc = *twig; - hits = stc->stcPaddles->in[0].stcTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - tcorr) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - if (tcorr < hits->in[nhit].t) - { - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - } - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + tcorr * dEcorr) / - (hits->in[nhit].dE + dEcorr); - hits->in[nhit].dE += dEcorr; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = tcorr ; - hits->in[nhit].dE = dEcorr; - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitStart: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hitstartcntr_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitStartCntr(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_StartCntr_t* pickStartCntr () -{ - s_StartCntr_t* box; - s_StartCntr_t* item; - - if ((paddleCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_StartCntr(); - box->stcPaddles = make_s_StcPaddles(paddleCount); - box->stcTruthPoints = make_s_StcTruthPoints(pointCount); - while ((item = (s_StartCntr_t*) pickTwig(&startCntrTree))) - { - s_StcPaddles_t* paddles = item->stcPaddles; - int paddle; - s_StcTruthPoints_t* points = item->stcTruthPoints; - int point; - - for (paddle=0; paddle < paddles->mult; ++paddle) - { - int m = box->stcPaddles->mult; - - s_StcTruthHits_t* hits = paddles->in[paddle].stcTruthHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].dE > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->stcPaddles->in[m] = paddles->in[paddle]; - box->stcPaddles->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (paddles != HDDM_NULL) - { - FREE(paddles); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->stcTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->stcTruthPoints->in[m-1].track == track && - fabs(box->stcTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->stcTruthPoints->in[m] = item->stcTruthPoints->in[point]; - box->stcTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - paddleCount = pointCount = 0; - - if ((box->stcPaddles != HDDM_NULL) && - (box->stcPaddles->mult == 0)) - { - FREE(box->stcPaddles); - box->stcPaddles = HDDM_NULL; - } - if ((box->stcTruthPoints != HDDM_NULL) && - (box->stcTruthPoints->mult == 0)) - { - FREE(box->stcTruthPoints); - box->stcTruthPoints = HDDM_NULL; - } - if ((box->stcPaddles->mult == 0) && - (box->stcTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitTPOL.c b/src/programs/Simulation/HDGeant/hitTPOL.c deleted file mode 100644 index 23b205e03e..0000000000 --- a/src/programs/Simulation/HDGeant/hitTPOL.c +++ /dev/null @@ -1,276 +0,0 @@ -/* - * hitTPOL - registers hits for triplet polarimeter silicon detector - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones, Jan 14, 2017 - * - */ - -#include -#include -#include - -#include -#include -#include -#include -#include "calibDB.h" - -extern s_HDDM_t* thisInputEvent; - -static float TWO_HIT_RESOL = 1000.; -static float THRESH_MEV = 0.010; - -// Comment by RTJ: -// When I introduced the convenience constant MAX_HITS, -// I never intended it to be a tunable simulation parameter. -// Do not use it as such. Do NOT MODIFY it, or the way -// it functions in the algorithm. If you want to truncate -// the hit list, do it in mcsmear. -#define MAX_HITS 100 - -binTree_t* tpolTree = 0; -static int sectorCount = 0; -static int pointCount = 0; -static int initialized = 0; - - -/* register hits during tracking (from gustep) */ - -void hitTPOL(float xin[4], float xout[4],float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float dx[3], dr; - float dEdx; - float xlocal[3]; - - if (!initialized) { - // Get calibration constants ... - - initialized = 1; - } - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xlocal,"local"); - dx[0] = xin[0] - xout[0]; - dx[1] = xin[1] - xout[1]; - dx[2] = xin[2] - xout[2]; - dr = sqrt(dx[0]*dx[0] + dx[1]*dx[1] + dx[2]*dx[2]); - if (dr > 1e-3) - { - dEdx = dEsum/dr; - } - else - { - dEdx = 0; - } - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if (history == 0) - { - int mark = (1<<30) + pointCount; - void** twig = getTwig(&tpolTree, mark); - if (*twig == 0) - { - s_TripletPolarimeter_t* tpol = *twig = make_s_TripletPolarimeter(); - s_TpolTruthPoints_t* points = make_s_TpolTruthPoints(1); - tpol->tpolTruthPoints = points; - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - points->in[0].primary = (track <= a && stack == 0); - points->in[0].track = track; - points->in[0].t = t; - points->in[0].r = sqrt(x[0]*x[0] + x[1]*x[1]); - points->in[0].phi = atan2(x[1], x[0]); - points->in[0].px = pin[0]*pin[4]; - points->in[0].py = pin[1]*pin[4]; - points->in[0].pz = pin[2]*pin[4]; - points->in[0].E = pin[3]; - points->in[0].dEdx = dEdx; - points->in[0].ptype = ipart; - points->in[0].trackID = make_s_TrackID(); - points->in[0].trackID->itrack = itrack; - points->mult = 1; - pointCount++; - } - } - - /* post the hit to the hits tree, mark module as hit */ - if (dEsum > 0) - { - int nhit; - s_TpolTruthHits_t* hits; - int ringno = 0; //getring_wrapper_(); - int sectno = getsector_wrapper_(); - int mark = sectno; - void** twig = getTwig(&tpolTree, mark); - if (*twig == 0) - { - s_TripletPolarimeter_t* tpol = *twig = make_s_TripletPolarimeter(); - s_TpolSectors_t* sectors = make_s_TpolSectors(1); - sectors->mult = 1; - sectors->in[0].ring = ringno; - sectors->in[0].sector = sectno; - sectors->in[0].tpolTruthHits = hits = make_s_TpolTruthHits(MAX_HITS); - tpol->tpolSectors = sectors; - sectorCount++; - } - else - { - s_TripletPolarimeter_t* tpol = *twig; - hits = tpol->tpolSectors->in[0].tpolTruthHits; - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* merge with former hit */ - { - if (t < hits->in[nhit].t) - { - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - } - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].dE + t * dEsum) / - (hits->in[nhit].dE + dEsum); - hits->in[nhit].dE += dEsum; - } - else if (nhit < MAX_HITS) /* create new hit */ - { - hits->in[nhit].t = t; - hits->in[nhit].dE = dEsum; - hits->in[nhit].ptype = ipart; - hits->in[nhit].itrack = itrack; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitTPOL: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - exit(2); - } - } -} - -/* entry point from fortran */ - -void hittpol_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitTPOL(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - -/* pick and package the hits for shipping */ - -s_TripletPolarimeter_t* pickTpol () -{ - s_TripletPolarimeter_t* box; - s_TripletPolarimeter_t* item; - - if ((sectorCount == 0) && (pointCount == 0)) - { - return HDDM_NULL; - } - - box = make_s_TripletPolarimeter(); - box->tpolSectors = make_s_TpolSectors(sectorCount); - box->tpolTruthPoints = make_s_TpolTruthPoints(pointCount); - while ((item = (s_TripletPolarimeter_t*) pickTwig(&tpolTree))) - { - s_TpolSectors_t* sectors = item->tpolSectors; - int sector; - s_TpolTruthPoints_t* points = item->tpolTruthPoints; - int point; - - for (sector=0; sector < sectors->mult; ++sector) - { - int m = box->tpolSectors->mult; - - s_TpolTruthHits_t* hits = sectors->in[sector].tpolTruthHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].dE > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - box->tpolSectors->in[m] = sectors->in[sector]; - box->tpolSectors->mult++; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (sectors != HDDM_NULL) - { - FREE(sectors); - } - - for (point=0; point < points->mult; ++point) - { - int track = points->in[point].track; - double t = points->in[point].t; - int m = box->tpolTruthPoints->mult; - if (points->in[point].trackID->itrack < 0 || - (m > 0 && box->tpolTruthPoints->in[m-1].track == track && - fabs(box->tpolTruthPoints->in[m-1].t - t) < 0.5)) - { - FREE(points->in[point].trackID); - continue; - } - box->tpolTruthPoints->in[m] = item->tpolTruthPoints->in[point]; - box->tpolTruthPoints->mult++; - } - if (points != HDDM_NULL) - { - FREE(points); - } - FREE(item); - } - - sectorCount = pointCount = 0; - - if ((box->tpolSectors != HDDM_NULL) && - (box->tpolSectors->mult == 0)) - { - FREE(box->tpolSectors); - box->tpolSectors = HDDM_NULL; - } - if ((box->tpolTruthPoints != HDDM_NULL) && - (box->tpolTruthPoints->mult == 0)) - { - FREE(box->tpolTruthPoints); - box->tpolTruthPoints = HDDM_NULL; - } - if ((box->tpolSectors->mult == 0) && - (box->tpolTruthPoints->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitTag.c b/src/programs/Simulation/HDGeant/hitTag.c deleted file mode 100644 index c264833401..0000000000 --- a/src/programs/Simulation/HDGeant/hitTag.c +++ /dev/null @@ -1,458 +0,0 @@ -/* - * hitTag - registers hits for the tagger focal plane counters - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * version 1.0 -Richard Jones November 16, 2006 - * version 2.0 -Richard Jones July 1, 2014 - * - * Programmer's Notes: - * ------------------- - * 1) There is no tagger in the HDGeant simulation so no tagger hits are - * generated during tracking. This hitTagger() function is called at - * event initialization time to register the tagged photon that is - * supposed to have caused the event. - * 2) Only microscope hits are produced in this version. - * 3) In the simulation of physics events (external generator) with - * background enabled, pickTagger() produces a list of tagger hits - * that includes the original photon from the generator plus all - * of the background photons. Note that this includes many photons - * that never reached the GlueX target because they were stopped - * at the collimator. - * - * update July 1, 2014 (version 2.0) - * --------------------------------- - * 1) Read the tagger channel energy bounds from the ccdb instead of - * hard-wiring them here. - * 2) Add hits in both the fixed_array and microscope detectors. - * 3) Fix the bug that forced the E value written into the hits structure - * to always contain the exact simulated beam photon energy, instead - * of the mean value for the hit tagger channel. Now only the mean - * photon energy for the hit channel is recorded. - * 4) The recorded photon energy from the tagger is computed from the - * endpoint energy in the ccdb multiplied by the scaled_energy_range - * array values. - */ - -#include -#include -#include - -#include -#include -#include -#include - -#define MICRO_TWO_HIT_RESOL 25. -#define MICRO_MAX_HITS 5000 -#define FIXED_TWO_HIT_RESOL 25. -#define FIXED_MAX_HITS 5000 -#define C_CM_PER_NS 29.9792458 -#define TAG_T_MIN_NS -200 -#define TAG_T_MAX_NS +200 - -float endpoint_energy_GeV = 0; -float micro_limits_Erange[2]; -float hodo_limits_Erange[2]; -static int micro_nchannels = 102; -float* micro_channel_Erange = 0; -static int hodo_nchannels = 274; -float* hodo_channel_Erange = 0; -binTree_t* microTree = 0; -binTree_t* hodoTree = 0; -static int microCount = 0; -static int hodoCount = 0; -static int printDone = 0; -static float beam_period = -1.0; - -float get_reference_plane_(); - -/* register hits during event initialization (from gukine) */ - -void hitTagger (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history) -{ - - /* read beam_period from calibdb */ - if(beam_period < 0.0) - { - char dbname[] = "/PHOTON_BEAM/RF/beam_period::mc"; - unsigned int ndata = 1; - if (GetCalib(dbname, &ndata, &beam_period)) { - fprintf(stderr,"HDGeant error in hitTagger: %s %s\n", - "failed to read RF period ", - "from calibdb, cannot continue."); - exit (2); - } - } - - int micro_chan; - int hodo_chan; - double Etag = 0; - double E = pin[3]; - float ref_time_z_cm = get_reference_plane_(); - double t = xin[3]*1e9-(xin[2]-ref_time_z_cm)/C_CM_PER_NS; - t = floor(t/beam_period+0.5)*beam_period; - - /* read tagger set endpoint energy from calibdb */ - if (endpoint_energy_GeV == 0) { - char dbname[] = "/PHOTON_BEAM/endpoint_energy"; - unsigned int ndata = 1; - if (GetCalib(dbname, &ndata, &endpoint_energy_GeV)) { - fprintf(stderr,"HDGeant error in hitTagger: %s %s\n", - "failed to read photon beam endpoint energy", - "from calibdb, cannot continue."); - exit (2); - } - } - - /* read microscope channel energy bounds from calibdb */ - if (micro_channel_Erange == 0) { - char dbname[] = "/PHOTON_BEAM/microscope/scaled_energy_range"; - /* table microscope/scaled_energy_range has 3 columns: - * column xlow xhigh - * which are returned in an array like float[3][ncolumns] - */ - int ndata = 3*micro_nchannels; - mystr_t names[ndata]; - micro_channel_Erange = malloc(ndata*sizeof(float)); - if (GetArrayConstants(dbname, &ndata, micro_channel_Erange, names) || - ndata != 3*micro_nchannels) - { - fprintf(stderr,"HDGeant error in hitTagger: %s %s\n", - "failed to read microscope scaled_energy_range table", - "from calibdb, cannot continue."); - exit (2); - } - else { - int i; - micro_limits_Erange[0] = 0; - micro_limits_Erange[1] = 1; - for (i=0; i < micro_nchannels; ++i) { - if (micro_limits_Erange[0] < micro_channel_Erange[3*i+1]) - micro_limits_Erange[0] = micro_channel_Erange[3*i+1]; - if (micro_limits_Erange[1] > micro_channel_Erange[3*i+2]) - micro_limits_Erange[1] = micro_channel_Erange[3*i+2]; - micro_channel_Erange[3*i+1] *= endpoint_energy_GeV; - micro_channel_Erange[3*i+2] *= endpoint_energy_GeV; - } - micro_limits_Erange[0] *= endpoint_energy_GeV; - micro_limits_Erange[1] *= endpoint_energy_GeV; - } - } - - /* read hodoscope channel energy bounds from calibdb */ - if (hodo_channel_Erange == 0) { - char dbname[] = "/PHOTON_BEAM/hodoscope/scaled_energy_range"; - /* table hodoscope/scaled_energy_range has 3 columns: - * counter xlow xhigh - * which are returned in an array like float[3][ncolumns] - */ - int ndata = 3*hodo_nchannels; - mystr_t names[ndata]; - hodo_channel_Erange = malloc(ndata*sizeof(float)); - if (GetArrayConstants(dbname, &ndata, hodo_channel_Erange, names) || - ndata != 3*hodo_nchannels) - { - fprintf(stderr,"HDGeant error in hitTagger: %s %s\n", - "failed to read hodoscope scaled_energy_range table", - "from calibdb, cannot continue."); - exit (2); - } - else { - int i; - hodo_limits_Erange[0] = 0; - hodo_limits_Erange[1] = 1; - for (i=0; i < hodo_nchannels; ++i) { - if (hodo_limits_Erange[0] < hodo_channel_Erange[3*i+1]) - hodo_limits_Erange[0] = hodo_channel_Erange[3*i+1]; - if (hodo_limits_Erange[1] > hodo_channel_Erange[3*i+2]) - hodo_limits_Erange[1] = hodo_channel_Erange[3*i+2]; - hodo_channel_Erange[3*i+1] *= endpoint_energy_GeV; - hodo_channel_Erange[3*i+2] *= endpoint_energy_GeV; - } - hodo_limits_Erange[0] *= endpoint_energy_GeV; - hodo_limits_Erange[1] *= endpoint_energy_GeV; - } - } - - if (printDone == 0) { - fprintf(stderr,"TAGGER: ALL parameters loaded from Data Base\n"); - printDone = 1; - } - - /* look up hit tagger channel, if any */ - hodo_chan = -1; - micro_chan = -1; - if (E < micro_limits_Erange[0] && E > micro_limits_Erange[1]) { - int i; - for (i=0; i < micro_nchannels; ++i) { - if ( E < micro_channel_Erange[3*i+1] && - E > micro_channel_Erange[3*i+2] ) - { - Etag = (micro_channel_Erange[3*i+1] + - micro_channel_Erange[3*i+2]) / 2; - micro_chan = micro_channel_Erange[3*i]; - break; - } - } - } - else if (E < hodo_limits_Erange[0] && E > hodo_limits_Erange[1]) { - int i; - for (i=0; i < hodo_nchannels; ++i) { - if ( E < hodo_channel_Erange[3*i+1] && - E > hodo_channel_Erange[3*i+2] ) - { - Etag = (hodo_channel_Erange[3*i+1] + - hodo_channel_Erange[3*i+2]) / 2; - hodo_chan = hodo_channel_Erange[3*i]; - break; - } - } - } - - /* post the hit to the microscope hits tree, mark channel as hit */ - - if (micro_chan > -1) { - int nhit; - s_TaggerTruthHits_t* hits; - int mark = micro_chan + 1000; - void** twig = getTwig(µTree, mark); - if (*twig == 0) - { - s_Tagger_t* tag = *twig = make_s_Tagger(); - s_MicroChannels_t* channels = make_s_MicroChannels(1); - hits = make_s_TaggerTruthHits(MICRO_MAX_HITS); - hits->mult = 0; - channels->in[0].taggerTruthHits = hits; - channels->in[0].column = micro_chan; - channels->in[0].row = 0; - channels->in[0].E = Etag; - channels->mult = 1; - tag->microChannels = channels; - microCount++; - } - else - { - s_Tagger_t* tag = *twig; - hits = tag->microChannels->in[0].taggerTruthHits; - } - - if (hits != HDDM_NULL) - { - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < MICRO_TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* ignore second hit */ - { - } - else if (nhit < MICRO_MAX_HITS) /* create new hit */ - { - hits->in[nhit].bg = track; - hits->in[nhit].t = t; - hits->in[nhit].E = E; - hits->in[nhit].dE += 3.5e-3; // GeV in SciFi - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitTagger: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n", - MICRO_MAX_HITS); - } - } - } - - /* post the hit to the hodoscope hits tree, mark channel as hit */ - - if (hodo_chan > -1) { - int nhit; - s_TaggerTruthHits_t* hits; - int mark = hodo_chan + 1000; - void** twig = getTwig(&hodoTree, mark); - if (*twig == 0) - { - s_Tagger_t* tag = *twig = make_s_Tagger(); - s_HodoChannels_t* channels = make_s_HodoChannels(1); - hits = make_s_TaggerTruthHits(FIXED_MAX_HITS); - hits->mult = 0; - channels->in[0].taggerTruthHits = hits; - channels->in[0].counterId = hodo_chan; - channels->in[0].E = Etag; - channels->mult = 1; - tag->hodoChannels = channels; - hodoCount++; - } - else - { - s_Tagger_t* tag = *twig; - hits = tag->hodoChannels->in[0].taggerTruthHits; - } - - if (hits != HDDM_NULL) - { - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (fabs(hits->in[nhit].t - t) < FIXED_TWO_HIT_RESOL) - { - break; - } - } - if (nhit < hits->mult) /* ignore second hit */ - { - } - else if (nhit < FIXED_MAX_HITS) /* create new hit */ - { - hits->in[nhit].bg = track; - hits->in[nhit].t = t; - hits->in[nhit].E = E; - hits->in[nhit].dE += 5.5e-4; // GeV in hodo scint. - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitTagger: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n", - FIXED_MAX_HITS); - } - } - } -} - -/* entry point from fortran */ - -void hittagger_ (float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history) -{ - hitTagger(xin,xout,pin,pout,*dEsum,*track,*stack,*history); -} - - -/* pick and package the hits for shipping */ - -s_Tagger_t* pickTagger () -{ - s_Tagger_t* box; - s_Tagger_t* item; - - if (microCount == 0 && hodoCount == 0) - { - return HDDM_NULL; - } - - box = make_s_Tagger(); - - box->microChannels = make_s_MicroChannels(microCount); - while ((item = (s_Tagger_t*) pickTwig(µTree))) - { - s_MicroChannels_t* channels = item->microChannels; - int channel; - for (channel=0; channel < channels->mult; ++channel) - { - s_TaggerTruthHits_t* hits = channels->in[channel].taggerTruthHits; - - /* constraint t values to lie within time range */ - int i; - int iok=0; - for (iok=i=0; i < hits->mult; i++) - { - if ((hits->in[i].t >= TAG_T_MIN_NS) && - (hits->in[i].t <= TAG_T_MAX_NS)) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - int m = box->microChannels->mult++; - box->microChannels->in[m] = channels->in[0]; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (channels != HDDM_NULL) - { - FREE(channels); - } - FREE(item); - } - - box->hodoChannels = make_s_HodoChannels(hodoCount); - while ((item = (s_Tagger_t*) pickTwig(&hodoTree))) - { - s_HodoChannels_t* channels = item->hodoChannels; - int channel; - for (channel=0; channel < channels->mult; ++channel) - { - s_TaggerTruthHits_t* hits = channels->in[channel].taggerTruthHits; - - /* constraint t values to lie within time range */ - int i; - int iok=0; - for (iok=i=0; i < hits->mult; i++) - { - if ((hits->in[i].t >= TAG_T_MIN_NS) && - (hits->in[i].t <= TAG_T_MAX_NS)) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - } - } - if (iok) - { - hits->mult = iok; - int m = box->hodoChannels->mult++; - box->hodoChannels->in[m] = channels->in[0]; - } - else if (hits != HDDM_NULL) - { - FREE(hits); - } - } - if (channels != HDDM_NULL) - { - FREE(channels); - } - FREE(item); - } - - microCount = 0; - hodoCount = 0; - - if ((box->microChannels != HDDM_NULL) && - (box->microChannels->mult == 0)) - { - FREE(box->microChannels); - box->microChannels = HDDM_NULL; - } - if ((box->hodoChannels != HDDM_NULL) && - (box->hodoChannels->mult == 0)) - { - FREE(box->hodoChannels); - box->hodoChannels = HDDM_NULL; - } - if (box->microChannels->mult == 0 && - box->hodoChannels->mult == 0) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitUPV.c b/src/programs/Simulation/HDGeant/hitUPV.c deleted file mode 100644 index 1ca2db566d..0000000000 --- a/src/programs/Simulation/HDGeant/hitUPV.c +++ /dev/null @@ -1,322 +0,0 @@ -/* - * hitUPV - registers hits for UPV - ao - * - * - * This is a part of the hits package for the - * HDGeant simulation program for Hall D. - * - * - * changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann - * add ipart to the function hitUpstreamEMveto - * - * Programmer's Notes: - * ------------------- - * 1) In applying the attenuation to light propagating down to both ends - * of the modules, there has to be some point where the attenuation - * factor is 1. I chose it to be the midplane, so that in the middle - * of the paddle both ends see the unattenuated E values. Closer to - * either end, that end has a larger E value and the opposite end a - * lower E value than the actual deposition. - * 2) In applying the propagation delay to light propagating down to the - * ends of the modules, there has to be some point where the timing - * offset is 0. I chose it to be the midplane, so that for hits in - * the middle of the paddle the t values measure time-of-flight from - * the t=0 of the event. For hits closer to one end, that end sees - * a t value smaller than its true time-of-flight, and the other end - * sees a value correspondingly larger. The average is the true tof. - */ - -#include -#include -#include - -#include -#include -#include -#include - -extern s_HDDM_t* thisInputEvent; - -#define ATTEN_LENGTH 150. -#define C_EFFECTIVE 19. /* This assumes a single linear fiber path */ -#define THRESH_MEV 5. -#define TWO_HIT_RESOL 50. -#define MAX_HITS 100 - -binTree_t* upstreamEMvetoTree = 0; -static int paddleCount = 0; -static int rowCount = 0; -static int showerCount = 0; - - -/* register hits during tracking (from gustep) */ - -void hitUpstreamEMveto (float xin[4], float xout[4], - float pin[5], float pout[5], float dEsum, - int track, int stack, int history, int ipart) -{ - float x[3], t; - float xlocal[3]; - float xupv[3]; - float zeroHat[] = {0,0,0}; - int nhit; - s_UpvHits_t* hits = 0; - - x[0] = (xin[0] + xout[0])/2; - x[1] = (xin[1] + xout[1])/2; - x[2] = (xin[2] + xout[2])/2; - t = (xin[3] + xout[3])/2 * 1e9; - transformCoord(x,"global",xlocal,"UPV"); - transformCoord(zeroHat,"local",xupv,"UPV"); - - int layer = getlayer_wrapper_(); - int row = getrow_wrapper_(); - /* - 'column' is not used in the current code. It distinguishes long - paddles (column=0) from short paddles to the left(column=1) or - right(column=2) of the beam hole. However, we assume that a pair - of short paddles is connected with a lightguide which has the light - propagation properties of a scintillator. In other words, a left and - right pair of short paddles form a long paddle which just happens - to have an insensitive to hits area in the middle but otherwise is identical - to a normal long paddle. If we later change our minds and start treating 3 - types of paddles differently, then 'column' can be made available for use. - */ - //int column = getcolumn_wrapper_(); - - float dxleft = xlocal[0]; - float dxright = -xlocal[0]; - float tleft = t + dxleft/C_EFFECTIVE; - float tright = t + dxright/C_EFFECTIVE; - float dEleft = dEsum * exp(-dxleft/ATTEN_LENGTH); - float dEright = dEsum * exp(-dxright/ATTEN_LENGTH); - - /* post the hit to the truth tree */ - - int itrack = (stack == 0)? gidGetId(track) : -1; - - if ((history == 0) && (pin[3] > THRESH_MEV/1e3)) - { - int mark = (1<<30) + showerCount; - void** twig = getTwig(&upstreamEMvetoTree, mark); - if (*twig == 0) { - s_UpstreamEMveto_t* upv = *twig = make_s_UpstreamEMveto(); - s_UpvTruthShowers_t* showers = make_s_UpvTruthShowers(1); - int a = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices->in[0].products->mult; - showers->in[0].primary = (track <= a && stack == 0); - showers->in[0].track = track; - showers->in[0].x = xin[0]; - showers->in[0].y = xin[1]; - showers->in[0].z = xin[2]; - showers->in[0].t = xin[3]*1e9; - showers->in[0].px = pin[0]*pin[4]; - showers->in[0].py = pin[1]*pin[4]; - showers->in[0].pz = pin[2]*pin[4]; - showers->in[0].E = pin[3]; - showers->in[0].ptype = ipart; - showers->in[0].trackID = make_s_TrackID(); - showers->in[0].trackID->itrack = itrack; - showers->mult = 1; - upv->upvTruthShowers = showers; - showerCount++; - } - } - - /* post the hit to the hits tree, mark upvPaddle as hit */ - - if (dEsum > 0) - { - int mark = (layer<<16) + row; - void** twig = getTwig(&upstreamEMvetoTree, mark); - if (*twig == 0) - { - s_UpstreamEMveto_t* upv = *twig = make_s_UpstreamEMveto(); - s_UpvPaddles_t* paddles = make_s_UpvPaddles(1); - paddles->mult = 1; - paddles->in[0].row = row; - paddles->in[0].layer = layer; - paddles->in[0].upvHits = hits = make_s_UpvHits(MAX_HITS); - upv->upvPaddles = paddles; - paddleCount++; - } - else - { - s_UpstreamEMveto_t* upv = *twig; - hits = upv->upvPaddles->in[0].upvHits; - } - - if (hits != HDDM_NULL) - { - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (hits->in[nhit].end == 0 && - fabs(hits->in[nhit].t - tleft) < TWO_HIT_RESOL) - { - break; - } - } - - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tleft * dEleft) / - (hits->in[nhit].E + dEleft); - hits->in[nhit].E += dEleft; - } - else if (nhit < MAX_HITS) /* create new hit, north end */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tleft * dEleft) / - (hits->in[nhit].E + dEleft); - hits->in[nhit].E += dEleft; - hits->in[nhit].end = 0; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitUpstreamEMveto: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - } - - for (nhit = 0; nhit < hits->mult; nhit++) - { - if (hits->in[nhit].end == 1 && - fabs(hits->in[nhit].t - tright) < TWO_HIT_RESOL) - { - break; - } - } - - if (nhit < hits->mult) /* merge with former hit */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tright * dEright) / - (hits->in[nhit].E + dEright); - hits->in[nhit].E += dEright; - } - else if (nhit < MAX_HITS) /* create new hit, south end */ - { - hits->in[nhit].t = - (hits->in[nhit].t * hits->in[nhit].E + tright * dEright) / - (hits->in[nhit].E + dEright); - hits->in[nhit].E += dEright; - hits->in[nhit].end = 1; - hits->mult++; - } - else - { - fprintf(stderr,"HDGeant error in hitUpstreamEMveto: "); - fprintf(stderr,"max hit count %d exceeded, truncating!\n",MAX_HITS); - } - } -} - -/* entry point from fortran */ - -void hitupstreamemveto_(float* xin, float* xout, - float* pin, float* pout, float* dEsum, - int* track, int* stack, int* history, int* ipart) -{ - hitUpstreamEMveto(xin,xout,pin,pout,*dEsum,*track,*stack,*history,*ipart); -} - - - - -/* pick and package the hits for shipping */ - -s_UpstreamEMveto_t* pickUpstreamEMveto () -{ - s_UpstreamEMveto_t* box; - s_UpstreamEMveto_t* item; - - if ((paddleCount == 0) && (rowCount == 0) && (showerCount == 0)) - return HDDM_NULL; - - box = make_s_UpstreamEMveto(); - box->upvPaddles = make_s_UpvPaddles(paddleCount); - box->upvTruthShowers = make_s_UpvTruthShowers(showerCount); - while ((item = (s_UpstreamEMveto_t*) pickTwig(&upstreamEMvetoTree))) - { - s_UpvPaddles_t* paddles = item->upvPaddles; - int paddle; - s_UpvTruthShowers_t* showers = item->upvTruthShowers; - int shower; - - for (paddle=0; paddle < paddles->mult; ++paddle) - { - int m = box->upvPaddles->mult; - int mok = 0; - - s_UpvHits_t* hits = paddles->in[paddle].upvHits; - - /* compress out the hits below threshold */ - int i,iok; - for (iok=i=0; i < hits->mult; i++) - { - if (hits->in[i].E > THRESH_MEV/1e3) - { - if (iok < i) - { - hits->in[iok] = hits->in[i]; - } - ++iok; - ++mok; - } - } - if (iok) - { - hits->mult = iok; - } - else if (hits != HDDM_NULL) - { - paddles->in[paddle].upvHits = HDDM_NULL; - FREE(hits); - } - - if (mok) - { - box->upvPaddles->in[m] = paddles->in[paddle]; - box->upvPaddles->mult++; - } - } - if (paddles != HDDM_NULL) - { - FREE(paddles); - } - - for (shower=0; shower < showers->mult; ++shower) - { - int m = box->upvTruthShowers->mult++; - box->upvTruthShowers->in[m] = showers->in[shower]; - } - if (showers != HDDM_NULL) - { - FREE(showers); - } - FREE(item); - } - - paddleCount = showerCount = 0; - - if ((box->upvPaddles != HDDM_NULL) && - (box->upvPaddles->mult == 0)) - { - FREE(box->upvPaddles); - box->upvPaddles = HDDM_NULL; - } - if ((box->upvTruthShowers != HDDM_NULL) && - (box->upvTruthShowers->mult == 0)) - { - FREE(box->upvTruthShowers); - box->upvTruthShowers = HDDM_NULL; - } - if ((box->upvPaddles->mult == 0) && - (box->upvTruthShowers->mult == 0)) - { - FREE(box); - box = HDDM_NULL; - } - return box; -} diff --git a/src/programs/Simulation/HDGeant/hitutil/Makefile b/src/programs/Simulation/HDGeant/hitutil/Makefile deleted file mode 100644 index fb97dd7af4..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -PACKAGES := CERNLIB - -FFLAGS += -DCERNLIB_MOTIF -D_GELH_ -DCERNLIB_TYPE -I.. - -include $(HALLD_HOME)/src/BMS/Makefile.lib - diff --git a/src/programs/Simulation/HDGeant/hitutil/Makefile.orig b/src/programs/Simulation/HDGeant/hitutil/Makefile.orig deleted file mode 100644 index e0244bff1e..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/Makefile.orig +++ /dev/null @@ -1,60 +0,0 @@ -BUILDS = $(HALLD_HOME)/src - -OStype = $(shell uname) -ARCHtype = $(shell uname -m) -BINDIR = $(BUILDS)/bin.$(OStype) - -ifeq ($(OStype),Linux) - ifeq ($(ARCHtype),alpha) - CC := gcc - CPP := g++ - F77 := g77 - AR := ar - NETLIB := -lnsl - XLIBS := -L/usr/X11R6/lib -lXpm -lSM -lXm -lXt -lICE -lXext -lX11 -lXp - COPTS = -g - FOPTS = -g -Wno-globals - GLIBS := -L/usr/lib/gcc-lib/alpha-redhat-linux/egcs-2.91.66/ -lg2c - else - CC := gcc - CPP := g++ - F77 := gfortran - AR := ar - NETLIB := -lnsl - XLIBS := -L/usr/X11R6/lib -lXpm -lSM -lXm -lXt -lICE -lXext -lX11 -lXp - COPTS = -g - FOPTS = -g - GLIBS := - endif -endif -ifeq ($(OStype),OSF1) - CC := cc - CPP := g++ - F77 := f77 - AR := ar - NETLIB := - STATIC := - XLIBS := -L/usr/lib -lXm -lSM -lICE -lXt -lX11 -lm -lPW -ldnet_stub - COPTS = -g -D_Tru64 - FOPTS = -g -fpe4 - LOPTS = -g -non_shared -fpe4 - GLIBS := -L/r5da/applications/gcc/lib/gcc-lib/alphaev5-dec-osf4.0f/2.95.3 -lg2c -lgcc -endif - -OBJS = getcell.o getcolumn.o getlayer.o getmodule.o getring.o \ - getplane.o getrow.o getsector.o hitutil.o - -libhitutil.a: $(OBJS) - $(AR) rv $@ $(OBJS) - -.F.o: - $(F77) -c -o $@ $(FOPTS) -I$(CERN_ROOT)/include -I. $< - -.f.o: - $(F77) -c -o $@ $(FOPTS) -I$(CERN_ROOT)/include -I. $< - -.c.o: - $(CC) $(COPTS) -I$(CERN_ROOT)/include -I. -c -o $@ $< - -clean: - rm -f *.o core last.kumac* paw.metafile diff --git a/src/programs/Simulation/HDGeant/hitutil/SConscript b/src/programs/Simulation/HDGeant/hitutil/SConscript deleted file mode 100644 index 2c4d441a54..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/SConscript +++ /dev/null @@ -1,12 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddCERNLIB(env) -sbms.library(env) - - diff --git a/src/programs/Simulation/HDGeant/hitutil/getcell.F b/src/programs/Simulation/HDGeant/hitutil/getcell.F deleted file mode 100644 index 6ed09ae56f..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getcell.F +++ /dev/null @@ -1,6 +0,0 @@ - function getcell() - integer getcell - print *, 'getcell() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getcell = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getcolumn.F b/src/programs/Simulation/HDGeant/hitutil/getcolumn.F deleted file mode 100644 index 68819de173..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getcolumn.F +++ /dev/null @@ -1,6 +0,0 @@ - function getcolumn() - integer getcolumn - print *, 'getcolumn() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getcolumn = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getlayer.F b/src/programs/Simulation/HDGeant/hitutil/getlayer.F deleted file mode 100644 index 5edffdeef0..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getlayer.F +++ /dev/null @@ -1,6 +0,0 @@ - function getlayer() - integer getlayer - print *, 'getlayer() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getlayer = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getmodule.F b/src/programs/Simulation/HDGeant/hitutil/getmodule.F deleted file mode 100644 index f702218cce..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getmodule.F +++ /dev/null @@ -1,6 +0,0 @@ - function getmodule() - integer getmodule - print *, 'getmodule() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getmodule = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getplane.F b/src/programs/Simulation/HDGeant/hitutil/getplane.F deleted file mode 100644 index d3d215ca05..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getplane.F +++ /dev/null @@ -1,6 +0,0 @@ - function getplane() - integer getplane - print *, 'getplane() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getplane = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getring.F b/src/programs/Simulation/HDGeant/hitutil/getring.F deleted file mode 100644 index 399df8a747..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getring.F +++ /dev/null @@ -1,6 +0,0 @@ - function getring() - integer getring - print *, 'getring() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getring = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getrow.F b/src/programs/Simulation/HDGeant/hitutil/getrow.F deleted file mode 100644 index 7abd193dc5..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getrow.F +++ /dev/null @@ -1,6 +0,0 @@ - function getrow() - integer getrow - print *, 'getrow() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getrow = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/getsector.F b/src/programs/Simulation/HDGeant/hitutil/getsector.F deleted file mode 100644 index 5cb26ad7c3..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/getsector.F +++ /dev/null @@ -1,6 +0,0 @@ - function getsector() - integer getsector - print *, 'getsector() - dummy function, ', - + 'should be overloaded in hddsGeant3.F' - getsector = -1 - end diff --git a/src/programs/Simulation/HDGeant/hitutil/hitutil.F b/src/programs/Simulation/HDGeant/hitutil/hitutil.F deleted file mode 100644 index 2775621fa3..0000000000 --- a/src/programs/Simulation/HDGeant/hitutil/hitutil.F +++ /dev/null @@ -1,53 +0,0 @@ - subroutine transformCoord(xin,cin,xout,cout) - real xin(3), xout(3) - character*(*) cin, cout -#include - character*4 cnames(15) - equivalence (cnames(1),NAMES(1)) - integer level,saveLevel - integer levelIn,levelOut - real xglobal(3) -c - if (cin.eq.'global') then - levelIn = 1 - elseif (cin.eq.'local') then - levelIn = NLEVEL - else - do level=1,NLEVEL-1 - if (cin.eq.cnames(level)) goto 10 - enddo - 10 levelIn = level - endif - if (cout.eq.'global') then - levelOut = 1 - elseif (cout.eq.'local') then - levelOut = NLEVEL - else - do level=1,NLEVEL-1 - if (cout.eq.cnames(level)) goto 20 - enddo - 20 levelOut = level - endif - if (levelIn.eq.levelOut) then - xout(1) = xin(1) - xout(2) = xin(2) - xout(3) = xin(3) - elseif (levelIn.eq.1) then - saveLevel = NLEVEL - NLEVEL = levelOut - call gmtod(xin,xout,1) - NLEVEL = saveLevel - elseif (levelOut.eq.1) then - saveLevel = NLEVEL - NLEVEL = levelIn - call gdtom(xin,xout,1) - NLEVEL = saveLevel - else - saveLevel = NLEVEL - NLEVEL = levelIn - call gdtom(xin,xglobal,1) - NLEVEL = levelOut - call gmtod(xglobal,xout,1) - NLEVEL = saveLevel - endif - end diff --git a/src/programs/Simulation/HDGeant/memcheck.c b/src/programs/Simulation/HDGeant/memcheck.c deleted file mode 100644 index 82a3b23029..0000000000 --- a/src/programs/Simulation/HDGeant/memcheck.c +++ /dev/null @@ -1,156 +0,0 @@ -/* - * memcheck - a simple memory management checking tool - * - * Typically the management of a memory structure is restricted to - * a limited segment of code. General malloc/free memory leak - * tools can be found that will trap every call to malloc or free. - * Often it is simpler just to insert some checkpoint calls around - * the relevant calls, and just study the behavior in that region. - * This is the purpose of the memcheck routines. - * - * Richard Jones - July 18, 2000 - * University of Connecticut - * - * - * Instructions: - * ------------- - * 1) After each relevant malloc, insert a call to checkin(pointer) as - * p = malloc(n); // old code - * checkin(p,string); // user string helps trace memory leaks - * or the following more compact form will have the same effect - * p = checkin(malloc(size_t),string); - * - * 2) Before each relevant free, insert a call to checkout(pointer) as - * checkout(p); // new insertion - * free(p); // old code - * - * 3) Any time you think the memory balance should be zero do checkpoint() - * checkpoint(); // look for leaks - * - * - * Programmer's Notes: - * ------------------- - * 1) The "bintree" binary tree package is used to store the allocation - * tables. - */ - -#include -#include -#include -#include - -#include - -typedef struct { - void* addr; - int count; - char* tag; -} memblock_t; - -binTree_t* memcheckTree = 0; -int* addressRef = 0; -int nodeCount = 0; - -void* checkin (void* p, char* tag) -{ - int mark = (int*)p - addressRef; - void** twig = getTwig(&memcheckTree, mark); - if (*twig == 0) - { - memblock_t *blk = *twig = malloc(sizeof(memblock_t)); - if (tag) - { - blk->tag = malloc(strlen(tag)+1); - strcpy(blk->tag,tag); - } - else - { - blk->tag = malloc(7); - strcpy(blk->tag,"(null)"); - } - blk->count = 1; - blk->addr = p; - nodeCount++; - } - else if (((memblock_t*) *twig)->count == 0) - { - memblock_t *blk = *twig; - if (blk->tag) - { - free(blk->tag); - } - if (tag) - { - blk->tag = malloc(strlen(tag)+1); - strcpy(blk->tag,tag); - } - else - { - blk->tag = malloc(7); - strcpy(blk->tag,"(null)"); - } - blk->count = 1; - blk->addr = p; - } - else - { - memblock_t *blk = *twig; - fprintf(stderr,"memcheck report:"); - fprintf(stderr," reallocation of allocated memory block\n"); - fprintf(stderr," original tag was %s\n",blk->tag); - fprintf(stderr," second tag was %s\n",tag); - assert (1 == 0); - } - return p; -} - -void* checkout (void* p) -{ - int mark = (int*)p - addressRef; - void** twig = getTwig(&memcheckTree, mark); - if (*twig == 0) - { - fprintf(stderr,"memcheck report:"); - fprintf(stderr," attempt to free unallocated memory block\n"); -// assert (1 == 0); - } - else if (((memblock_t*) *twig)->count < 1) - { - memblock_t *blk = *twig; - fprintf(stderr,"memcheck report:"); - fprintf(stderr," attempt to refree freed memory block\n"); - fprintf(stderr," tag was %s\n",blk->tag); - assert (1 == 0); - } - else - { - memblock_t *blk = *twig; - blk->count = 0; - } - return p; -} - -void checkpoint () -{ - memblock_t* node; - int abort = 0; - while ((node = pickTwig(&memcheckTree))) - { - if (node->count > 0) - { - fprintf(stderr,"memcheck report:"); - fprintf(stderr," checkpoint found allocated memory block\n"); - fprintf(stderr," tag was %s\n",node->tag); - ++abort; - } - nodeCount--; - free(node->tag); - free(node); - } - if (abort) - { - fprintf(stderr," quitting because of above error%s.\n", - ((abort == 1) ? "" : "s")); - exit(1); - } -} diff --git a/src/programs/Simulation/HDGeant/memcheck.h b/src/programs/Simulation/HDGeant/memcheck.h deleted file mode 100644 index decc2735af..0000000000 --- a/src/programs/Simulation/HDGeant/memcheck.h +++ /dev/null @@ -1,3 +0,0 @@ -void* checkin(void* p, char* tag); -void* checkout(void* p); -void checkpoint(); diff --git a/src/programs/Simulation/HDGeant/mhdgeant b/src/programs/Simulation/HDGeant/mhdgeant deleted file mode 100755 index ead2d4c762..0000000000 --- a/src/programs/Simulation/HDGeant/mhdgeant +++ /dev/null @@ -1,299 +0,0 @@ -#!usr/bin/python - -import os -import sys -import thread -import time - -#command line parameters -run=2 -fileName="control.in" -pram=0 -for arg in sys.argv: - if arg=="-h": - print " -h[help], -r[number of runs], -i[input file] \n\n" - sys.exit() - if arg=="-r": - run=sys.argv[pram+1] - if arg=="-i": - fileName=sys.argv[pram+1] - pram=pram+1 - - -#---------------------------------------------------------- -def fill(): - if not TRIG_flag=="default": - FILE.write("TRIG " + str(TRIG) + "\n") - if not Emax_flag=="default": - if not Emin_flag=="default": - FILE.write("BEAM " + str(Emax) + " " + str(Epeak )+ " " + str(Emin) + "\n") - else: - FILE.write("BEAM " + str(Emax) + " " + str(Epeak ) + "\n") - if not OUTFILE_flag=="default": - FILE.write("OUTFILE " + OUTFILE + "\n") - if not POSTSMEAR_flag=="default": - FILE.write("POSTSMEAR " + str(POSTSMEAR) + "\n") - if not DELETEUNSMEARED_flag=="default": - FILE.write("DELETEUNSMEARED " + str(DELETEUNSMEARED) + "\n") - if not particle_flag=="default": - FILE.write("KINE " + str(particle) + " " + str(momentum) + " " + str(theta) + " " + str(phi) + " " + str(delta_momentum) + " " + str(delta_theta) + " " + str(delta_phi) + "\n") - if not vertex_x_flag=="default": - FILE.write("SCAP " + str(vertex_x) + " " + str(vertex_y) + " " + str(vertex_z) + "\n") - if not fhalo_flag=="default": - FILE.write("HALO " + str(fhalo) + "\n") - if not BGRATE_flag=="default": - FILE.write("BGRATE " + str(BGRATE) + "\n") - if not t1_flag=="default": - FILE.write("BGGATE " + str(t1) + " " + str(t2) + "\n") - if not RNDM1_flag=="default": - FILE.write("RNDM " + str(RNDM1) + " " + str(ID) + "\n") - if not cutgam_flag=="default": - tempString="CUTS " + str(cutgam) + " " + str(cutele) + " " + str(cutneu) + " " + str(cuthad) + " " + str(cutmuo) - if not bcute_flag=="default": - tempString+= " " + str(bcute) - if not bcutm_flag=="default": - tempString+= " " + str(bcutm) - if not dcute_flag=="default": - tempString+= " " + str(dcute) - if not dcutm_flag=="default": - tempString+= " " + str(dcutm) - if not ppcutm_flag=="default": - tempString+= " " + str(ppcutm) - if not tofmax_flag=="default": - tempString+= " " + str(tofmax) - if not gcuts_flag=="default": - tempString+= " " + str(gcuts) - FILE.write(tempString + "\n") - if not SWIT_1_flag=="default": - FILE.write("SWIT " + str(SWIT_1) + " " + str(SWIT_2) + " " + str(SWIT_3) + " " + str(SWIT_4) + " " + str(SWIT_5) + " " + str(SWIT_6) + " " + str(SWIT_7) + " " + str(SWIT_8) + " " + str(SWIT_9) + "\n") - if not on_off_flag=="default": - FILE.write("GELH " + str(on_off) + " " + str(ecut) + " " + str(scale) + " " + str(mode) + " " + str(thresh) + "\n") - if not HADR_flag=="default": - FILE.write("HADR " + str(HADR) + "\n") - if not CKOV_flag=="default": - FILE.write("CKOV " + str(CKOV) + "\n") - if not LABS_flag=="default": - FILE.write("LABS " + str(LABS) + "\n") - if not ABAN_flag=="default": - FILE.write("ABAN " + str(ABAN) + "\n") - if not first_flag=="default": - FILE.write("DEBU " + str(first) + " " + str(last) + " " + str(step) + "\n") - if not NOSECONDARIES_flag=="default": - FILE.write("NOSECONDARIES " + str(NOSECONDARIES) + "\n") - if not TRAJECTORIES_flag=="default": - FILE.write("TRAJECTORIES " + str(TRAJECTORIES) + "\n") - if not SAVEHITS_flag=="default": - FILE.write("SAVEHITS " + str(SAVEHITS) + "\n") - if not SHOWERSINCOL_flag=="default": - FILE.write("SHOWERSINCOL " + str(SHOWERSINCOL) + "\n") - -#------------------------------------------------------------------ - -#functions and variables -def case1(): global TRIG;TRIG=int(temp[1]);global TRIG_flag;TRIG_flag="user"; -def case2(): - global Emax;Emax=float(temp[1]);global Emax_flag;Emax_flag="user" - global Epeak;Epeak=float(temp[2]);global Epeak_flag;Epeak_flag="user" - if (len(temp)>3): global Emin;Emin=float(temp[3]);global Emin_flag;Emin_flag="user" -def case3(): global OUTFILE;OUTFILE=temp[1];global OUTFILE_flag;OUTFILE_flag="user" -def case4(): global POSTSMEAR;POSTSMEAR=int(temp[1]);global POSTSMEAR_flag;POSTSMEAR_flag="user" -def case5(): global DELETEUNSMEARED;DELETEUNSMEARED=int(temp[1]);global DELETEUNSMEARED_flag;DELETEUNSMEARED_flag="user" -def case6(): - global particle;particle=int(temp[1]);global particle_flag;particle_flag="user" - global momentum;momentum=float(temp[2]);global momentum_flag;momentum_flag="user" - global theta;theta=float(temp[3]);global theta_flag;theta_flag="user" - global phi;phi=float(temp[4]);global phi_flag;phi_flag="user" - global delta_momentum;delta_momentum=float(temp[5]);global delta_momentum_flag;delta_momentum_flag="user" - global delta_theta;delta_theta=float(temp[6]);global delta_theta_flag;delta_theta_flag="user" - global delta_phi;delta_phi=float(temp[7]);global delta_phi_flag;delta_phi_flag="user" -def case7(): - global vertex_x;vertex_x=float(temp[1]);global vertex_x_flag;vertex_x_flag="user" - global vertex_y;vertex_y=float(temp[2]);global vertex_y_flag;vertex_y_flag="user" - global vertex_z;vertex_z=float(temp[3]);global vertex_z_flag;vertex_z_flag="user" -def case8(): global fhalo;fhalo=float(temp[1]);global fhalo_flag;fhalo_flag="user" -def case9(): global BGRATE;BGRATE=float(temp[1]);global BGRATE_flag;BGRATE_flag="user" -def case10(): - global t1;t1=float(temp[1]);global t1_flag;t1_flag="user" - global t2;t2=float(temp[2]);global t2_flag;t2_flag="user" -def case11(): - global RNDM1;RNDM1=int(temp[1]);global RNDM1_flag;RNDM1_flag="user" - if (len(temp)>2): global RNDM2;RNDM2=int(temp[2]);global RNDM2_flag;RNDM2_flag="user" -def case12(): - global cutgam;cutgam=float(temp[1]);global cutgam_flag;cutgam_flag="user" - global cutele;cutele=float(temp[2]);global cutele_flag;cutele_flag="user" - global cutneu;cutneu=float(temp[3]);global cutneu_flag;cutneu_flag="user" - global cuthad;cuthad=float(temp[4]);global cuthad_flag;cuthad_flag="user" - global cutmuo;cutmuo=float(temp[5]);global cutmuo_flag;cutmuo_flag="user" - if (len(temp)>6): global bcute;bcute=float(temp[6]);global bcute_flag;bcute_flag="user" - if (len(temp)>7): global bcutm;bcutm=float(temp[7]);global bcutm_flag;bcutm_flag="user" - if (len(temp)>8): global dcute;dcute=float(temp[8]);global dcute_flag;dcute_flag="user" - if (len(temp)>9): global dcutm;dcutm=float(temp[9]);global dcutm_flag;dcutm_flag="user" - if (len(temp)>10): global ppcutm;ppcutm=float(temp[10]);global ppcutm_flag;ppcutm_flag="user" - if (len(temp)>11): global tofmax;tofmax=float(temp[11]);global tofmax_flag;tofmax_flag="user" - if (len(temp)>12): global gcuts;gcuts=float(temp[12]);global gcuts_flag;gcuts_flag="user" -def case13(): - global SWIT_1;SWIT_1=int(temp[1]);global SWIT_1_flag;SWIT_1_flag="user" - global SWIT_2;SWIT_2=int(temp[2]);global SWIT_2_flag;SWIT_2_flag="user" - global SWIT_3;SWIT_3=int(temp[3]);global SWIT_3_flag;SWIT_3_flag="user" - global SWIT_4;SWIT_4=int(temp[4]);global SWIT_4_flag;SWIT_4_flag="user" - global SWIT_5;SWIT_5=int(temp[5]);global SWIT_5_flag;SWIT_5_flag="user" - global SWIT_6;SWIT_6=int(temp[6]);global SWIT_6_flag;SWIT_6_flag="user" - global SWIT_7;SWIT_7=int(temp[7]);global SWIT_7_flag;SWIT_7_flag="user" - global SWIT_8;SWIT_8=int(temp[8]);global SWIT_8_flag;SWIT_8_flag="user" - global SWIT_9;SWIT_9=int(temp[9]);global SWIT_9_flag;SWIT_9_flag="user" -def case14(): - global on_off;on_off=int(temp[1]);global on_off_flag;on_off_flag="user" - global ecut;ecut=float(temp[2]);global ecut_flag;ecut_flag="user" - global scale;scale=float(temp[3]);global scale_flag;scale_flag="user" - global mode;mode=int(temp[4]);global mode_flag;mode_flag="user" - global thresh;thresh=float(temp[5]);global thresh_flag;thresh_flag="user" -def case15(): global HADR;HADR=int(temp[1]);global HADR_flag;HADR_flag="user" -def case16(): global CKOV;CKOV=int(temp[1]);global CKOV_flag;CKOV_flag="user" -def case17(): global LABS;LABS=int(temp[1]);global LABS_flag;LABS_flag="user" -def case18(): global ABAN;ABAN=int(temp[1]);global ABAB_flag;ABAN_flag="user" -def case19(): - global first;first=int(temp[1]);global first_flag;first_flag="user" - global last;last=int(temp[2]);global last_flag;last_flag="user" - global step;step=int(temp[3]);global step_flag;step_flag="user" -def case20(): global NOSECONDARIES;NOSECONDARIES=int(temp[1]);global NOSECONDARIES_flag;NOSECONDARIES_flag="user" -def case21(): global TRAJECTORIES;TRAJECTORIES=int(temp[1]);global TRAJECTORIES_flag;TRAJECTORIES_flag="user" -def case22(): global SAVEHITS;SAVEHITS=int(temp[1]);global SAVEHITS_flag;SAVEHITS_flag="user" -def case23(): global SHOWERSINCOL;SHOWERSINCOL=int(temp[1]);global SHOWERSINCOL_flag;SHOWERSINCOL_flag="user" -def end(): end=0 - -#default values -TRIG=1000; TRIG_flag="default" -Emax=12.; Emax_flag="default" -Epeak=9.; Epeak_flag="default" -Emin=None; Emin_flag="default" -OUTFILE='hdgeant.hddm'; OUTFILE_flag="default" -POSTSMEAR=0; POSTSMEAR_flag="default" -DELETEUNSMEARED=0; DELETEUNSMEARED_flag="default" -particle=101; particle_flag="default" -momentum=9.0; momentum_flag="default" -theta=10.; theta_flag="default" -phi=0.; phi_flag="default" -delta_momentum=0.; delta_momentum_flag="default" -delta_theta=3.; delta_theta_flag="default" -delta_phi=360.; delta_phi_flag="default" -vertex_x=0.; vertex_x_flag="default" -vertex_y=0.; vertex_y_flag="default" -vertex_z=0; vertex_z_flag="default" -fhalo=5e-5; fhalo_flag="default" -BGRATE=1.10; BGRATE_flag="default" -t1=-200.; t1_flag="default" -t2=200.; t2_flag="default" -RNDM1=121; RNDM1_flag="default" -RNDM2=None; RNDM2_flag="default" -cutgam=1e-4; cutgam_flag="default" -cutele=1e-4; cutele_flag="default" -cutneu=1e-3; cutneu_flag="default" -cuthad=1e-3; cuthad_flag="default" -cutmuo=1e-4; cutmuo_flag="default" -bcute=None; bcute_flag="default" -bcutm=None; bcutm_flag="default" -dcute=None; dcute_flag="default" -dcutm=None; dcutm_flag="default" -ppcutm=None; ppcutm_flag="default" -tofmax=None; tofmax_flag="default" -gcuts=None; gcuts_flag="default" -SWIT_1=0; SWIT_1_flag="default" -SWIT_2=0; SWIT_2_flag="default" -SWIT_3=0; SWIT_3_flag="default" -SWIT_4=0; SWIT_4_flag="default" -SWIT_5=0; SWIT_5_flag="default" -SWIT_6=0; SWIT_6_flag="default" -SWIT_7=0; SWIT_7_flag="default" -SWIT_8=0; SWIT_8_flag="default" -SWIT_9=0; SWIT_9_flag="default" -on_off=1; on_off_flag="default" -ecut=0.2; ecut_flag="default" -scale=1.0; scale_flag="default" -mode=4; mode_flag="default" -thresh=0.160; thresh_flag="default" -HADR=1; HADR_flag="default" -CKOV=1; CKOV_flag="default" -LABS=1; LABS_flag="default" -ABAN=1; ABAN_flag="default" -first=1; first_flag="default" -last=10; last_flag="default" -step=1000; step_flag="default" -NOSECONDARIES=0; NOSECONDARIES_flag="default" -TRAJECTORIES=0; TRAJECTORIES_flag="default" -SAVEHITS=0; SAVEHITS_flag="defalut" -SHOWERSINCOL=0; SHOWERSINCOL_flag="default" - -cases = { - "TRIG":case1, - "BEAM":case2, - "OUTFILE":case3, - "POSTSMEAR":case4, - "DELETEUNSMEARED":case5, - "KINE":case6, - "SCAP":case7, - "HALO":case8, - "BGRATE":case9, - "BGGATE":case10, - "RNDM":case11, - "CUTS":case12, - "SWIT":case13, - "GELH":case14, - "HADR":case15, - "CKOV":case16, - "LABS":case17, - "ABAN":case18, - "DEBU":case19, - "NOSECONDARIES":case20, - "TRAJECTORIES":case21, - "SAVEHITS":case22, - "SHOWERSINCOL":case23, - "END":end} -#------------------------------------------------------------ - -#call -def call(): - RUNNER = open("runner.py","w") - RUNNER.write("import os\n") - RUNNER.write("newFile = 'pid'\n") - RUNNER.write("FILE = open(newFile,\"w\")\n") - RUNNER.write("FILE.write(str(os.getpid()))\n") - RUNNER.write("FILE.close()\n") - RUNNER.close() - os.system("python runner.py") - -#------------------------------------------------------------ - -#read in file -for line in open(fileName,'r').readlines(): - if not line[0]=='c': - temp = line.split() - if not len(temp)==0: - cases[temp[0]]() - -#------------------------------------------------------------ - -#write new file -ID=os.getpid() -curdir=os.getcwd() -newdir = curdir + '/new_mhdgeant_' + str(os.getpid()) -if not os.path.isdir(newdir): - os.mkdir(newdir) - os.chdir(newdir) -curdir=os.getcwd() -for i in range(int(run)): - newdir = "%(#)03d" %{"#":(i+1)} - if not os.path.isdir(newdir): - os.mkdir(newdir) - os.chdir(newdir) - newFile = 'control.in' - FILE = open(newFile,"w") - fill() - FILE.close() - child_pid = os.fork() - if child_pid == 0: - call() - sys.exit() - os.chdir(curdir) - ID=ID+1 - - diff --git a/src/programs/Simulation/HDGeant/ray.kumac b/src/programs/Simulation/HDGeant/ray.kumac deleted file mode 100644 index f4d7d688c4..0000000000 --- a/src/programs/Simulation/HDGeant/ray.kumac +++ /dev/null @@ -1,50 +0,0 @@ -MACRO draw vol=hall the=30 phi=20 psi=0 x0=10 y0=10 sx=5 sy=5 gif=halld.gif - pict/create def - draw [vol] [the] [phi] [psi] [x0] [y0] [sx] [sy] - pict/print [gif] 600 600 - pict/delete def -RETURN - -MACRO init prec=0 fill=30 box=5.5 boy=-4 boz=100 - message 'Initialization of Hall D drawing macros' - message 'Below you will be prompted for some input.' - message 'To the first prompt, type HALL' - message 'and to the following three answer 10000.' - next - dopt rayt on - dopt mapp [prec] - dopt proj pers - persp hall 2000 - satt * fill [fill] - dopt user on - satt iyok colo 4 - satt iyup colo 4 - satt iydn colo 4 - satt lgbl colo 3 - satt cdsi colo 5 - satt cdso colo 5 - satt cylw colo 2 - satt vrtx colo 7 - satt fdcc colo 7 - satt fdca colo 6 - satt cere colo 5 - satt bcam colo 3 - satt ftof colo 6 - satt stra colo 6 - satt wall colo 3 - satt iyok lsty 3 - satt iyup lsty 3 - satt iydn lsty 3 - satt lgbl lsty 6 - satt wall lsty 4 - satt ftof lsty 2 - satt fdcc lsty 4 - satt fdca lsty 2 - satt lgbl lsty 4 - satt cere lsty 4 - satt bcam lsty 3 - valcut [box] [boy] [boz] - editv 1 hall - editv 0 - tim -RETURN diff --git a/src/programs/Simulation/HDGeant/savehits.F b/src/programs/Simulation/HDGeant/savehits.F deleted file mode 100644 index e966394395..0000000000 --- a/src/programs/Simulation/HDGeant/savehits.F +++ /dev/null @@ -1,338 +0,0 @@ - subroutine savehits -* -************************************************************************ -* * -* savehits: dispatches to hits registry functions for each detector * -* subsystem in the simulation. * -* * -************************************************************************ -* -* changes: Wed Jun 20 13:19:56 EDT 2007 B. Zihlmann -* add ipart to the function calls hitxxxxxxx() -* -* Oct 11 2012, yqiang, add hits in RICH volume: RAWN RDCD - -#include "geant321/gckine.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcphys.inc" - -#define MAKE_HITS_WHEN_ILOSS_0 1 - - character*4 cnames(15) - equivalence (NAMES(1),cnames(1)) - - integer nlevellast,nameslast,numberlast - common /gcvolulast/nlevellast,nameslast(15),numberlast(15) - character*4 cnameslast(15) - equivalence (nameslast(1),cnameslast(1)) - save /gcvolulast/ - data nlevellast/0/ - - logical hitopen - save hitopen - data hitopen/.false./ - - real xin(4),xout(4),pin(5),pout(5),dEsum - save xin,xout,pin,pout,dEsum - - integer isame - integer level,nlevel_in - -C Reason 1 for being here: entry to a sensitive volume - if (INWVOL.eq.1) then - if (hitopen) then - if (NLEVEL.eq.nlevellast) then - do level=NLEVEL,1,-1 - if (NAMES(level).ne.nameslast(level).or. - + NUMBER(level).ne.numberlast(level)) then - write(6,*) 'Warning in savehits: unsaved hit', - + ' information found from sensitive volume ', - + cnameslast(level),', hit discarded.' - hitopen = .false. - goto 3 - endif - enddo - return - endif - 3 continue - endif - -* Initialize a new hit when a particle enters a sensitive volume, -* unless it is just coming out from an inner daughter volume, -* in which case it should just continue to add to the existing hit. - - if (istop.eq.0) then - do level=1,NLEVEL - nameslast(level) = NAMES(level) - numberlast(level) = NUMBER(level) - enddo - nlevellast = NLEVEL - xin(1) = VECT(1) - xin(2) = VECT(2) - xin(3) = VECT(3) - xin(4) = TOFG - pin(1) = VECT(4) - pin(2) = VECT(5) - pin(3) = VECT(6) - pin(4) = GETOT - pin(5) = VECT(7) - dEsum = 0 - hitopen = .true. - endif - return - -C Reason 2 for being here: stepping inside a sensitive volume - elseif (INWVOL.eq.0) then - dEsum = dEsum + DESTEP - if (ISTOP.eq.0) then - return - endif - xout(1) = VECT(1) - xout(2) = VECT(2) - xout(3) = VECT(3) - xout(4) = TOFG - pout(1) = VECT(4) - pout(2) = VECT(5) - pout(3) = VECT(6) - pout(4) = GETOT - pout(5) = VECT(7) - -C Reason 3 for being here: exiting from *ANY* volume - elseif (ISVOL.eq.1) then - dEsum = dEsum + DESTEP - xout(1) = VECT(1) - xout(2) = VECT(2) - xout(3) = VECT(3) - xout(4) = TOFG - pout(1) = VECT(4) - pout(2) = VECT(5) - pout(3) = VECT(6) - pout(4) = GETOT - pout(5) = VECT(7) - endif - -* At this point, we know that the particle is either leaving the -* current volume or stopping inside it. - -C If no hit is being recorded then nothing to do - if (.not.hitopen) then - return - endif - -* If about to enter a daughter volume then nothing to do - if (INWVOL.eq.2.and.INGOTO.ne.0) then - return - endif - -* Otherwise, we may be exiting a sensitive region or one of its contents; -* if a content then we have no way of knowing whether we are at the same -* time leaving the outer sensitive volume or merely passing through one -* of its interior interfaces. At this point there is no way to find out -* except to do the rather expensive call to GINVOL for the current point. -* To do that we will need to save and restore the geometry state info. - - if (INWVOL.eq.2.and.NLEVEL.gt.nlevellast) then - call GSCVOL - NLEVEL = nlevellast - call GINVOL(VECT,isame) - call GFCVOL - if (isame.ne.0) then - return - endif - endif - -* At this point we back out to the level of the sensitive volume -* to save the hits information, then make sure that the true -* geometry information is restored before we exit. - - do level=nlevellast,1,-1 - if (level.gt.NLEVEL.or. - + NAMES(level).ne.nameslast(level).or. - + NUMBER(level).ne.numberlast(level)) then - write(6,*) 'Warning in savehits: unsaved hit', - + ' information found from sensitive volume ', - + cnameslast(level),', hit discarded.' - hitopen = .false. - return - endif - enddo - nlevel_in = NLEVEL - NLEVEL = nlevellast - -c write(6,*)cnames(NLEVEL) -* At end of track segment in sensitive medium: register hit - if (cnames(NLEVEL)(1:3).eq.'PTS') then ! TPOL silicon detector sectors -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 0.6e-3 ! 600 keV in silicon - endif -#endif - if (dEsum.gt.0) then - call hitTPOL(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL)(1:3).eq.'PSF') then ! Pair spectrometer fine counters -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-3 ! 1 MeV in plastic - endif -#endif - if (dEsum.gt.0) then - call hitPS(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL)(1:3).eq.'PSC') then ! PS coarse counters -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-3 ! 1 MeV in plastic - endif -#endif - if (dEsum.gt.0) then - call hitPSC(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL).eq.'STRC') then ! start counter paddle -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-3 ! 1 MeV in plastic - endif -#endif - if (dEsum.gt.0) then - call hitStartCntr(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif ((cnames(NLEVEL).eq.'STRA').or. ! CDC straight straw - + (cnames(NLEVEL).eq.'STLA').or. ! CDC stereo straw - + (cnames(NLEVEL).eq.'STLB')) then ! CDC close-packed stereo straw -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-5 ! 10 KeV in gas - endif -#endif - if (dEsum.gt.0) then - call hitCentralDC(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL)(1:3).eq.'FDA') then ! FDC anode drift cell -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-5 ! 10 KeV in gas - endif -#endif - if (dEsum.gt.0) then - call hitForwardDC(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL).eq.'CERW') then ! Cerenkov truth - if (dEsum.gt.0) then - call hitCerenkov(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL).eq.'CPPC') then ! Cerenkov counter - if ((dEsum.gt.0).and.(IPART.eq.50)) then - call hitCerenkov(xin,xout,pin,pout,-dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL).eq.'RAWN') then ! DIRC window: truth - if (dEsum.gt.0) then - call hitDirc(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL).eq.'RDCD') then ! DIRC Cathode: counter - if ((dEsum.gt.0).and.(IPART.eq.50)) then - call hitDirc(xin,xout,pin,pout,-dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif ((cnames(NLEVEL).eq.'FTOC').or. ! forward TOF counter - + (cnames(NLEVEL).eq.'FTOX').or. ! forward TOF counter - + (cnames(NLEVEL).eq.'FTOH')) then -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in plastic - endif -#endif - if (dEsum.gt.0) then - call hitForwardTOF(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - endif - elseif (cnames(NLEVEL)(1:2).eq.'BM') then ! BCal segment -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in the calorimeter module - endif -#endif - if ((dEsum.gt.0).or.(ISTORY.ne.1)) then - call hitBarrelEMcal(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - ISTORY = 1 ! this particle has entered the BCal (inherited trait) - endif - elseif (cnames(NLEVEL).eq.'GCAL') then ! GCal segment -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in the calorimeter module - endif -#endif - if ((dEsum.gt.0).or.(ISTORY.ne.1)) then - call hitGapEMcal(xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - ISTORY = 1 ! this particle has entered the GCal (inherited trait) - endif - elseif (cnames(NLEVEL).eq.'LGBL') then ! forward calorimeter -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in the calorimeter block - endif -#endif - if ((dEsum.ne.0).or.(ISTORY.ne.2)) then - call hitForwardEMcal(xin,xout,pin,pout,dEsum,ITRA,ISTAK, - > ISTORY,IPART,0) - ISTORY = 2 ! this particle has entered the FCal (inherited trait) - endif - elseif (cnames(NLEVEL).eq.'LGLG') then ! forward calorimeter light guides - if (dEsum.gt.0) then - call hitForwardEMcal(xin,xout,pin,pout,dEsum,ITRA,ISTAK, - > ISTORY,IPART,1) - endif - elseif (cnames(NLEVEL).eq.'LTBL') then ! Compton calorimeter -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in the calorimeter block - endif -#endif - if ((dEsum.ne.0).or.(ISTORY.ne.2)) then - call hitComptonEMcal - + (xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - ISTORY = 2 ! this particle has entered the CCal (inherited trait) - endif - elseif ((cnames(NLEVEL).eq.'UPVP').or. ! UPV channel - + (cnames(NLEVEL).eq.'UPVC')) then -#ifdef MAKE_HITS_WHEN_ILOSS_0 - if ((ILOSS.eq.0).and.(CHARGE.ne.0)) then - dEsum = 1e-2 ! 10 MeV in the calorimeter paddle - endif -#endif - if ((dEsum.ne.0).or.(ISTORY.ne.3)) then - call hitUpstreamEMveto - + (xin,xout,pin,pout,dEsum,ITRA,ISTAK,ISTORY, - > IPART) - ISTORY = 3 ! this particle has entered the UPV (inherited trait) - endif - endif - -* Mark this hit as closed, so that it does not get registered twice - - hitopen = .false. - -* If this is the end of tracking for this particle, reset the saved state - - if (ISTOP.ne.0) then - nlevellast = 0 - endif - -* Restore the true geometry state and return - - NLEVEL = nlevel_in - END diff --git a/src/programs/Simulation/HDGeant/savenewvertex.c b/src/programs/Simulation/HDGeant/savenewvertex.c deleted file mode 100644 index 79b5c0ce3c..0000000000 --- a/src/programs/Simulation/HDGeant/savenewvertex.c +++ /dev/null @@ -1,116 +0,0 @@ -/* -savenewvertex: particle stoped because it decayed - save the daughter particles and the - decay vertex. - - -*/ - -#include -#include -#include - -#include -#include -#include "gid_map.h" - -extern s_HDDM_t* thisInputEvent; - -int getLastId(); - -void SaveNewVertex(int kcase, int Npart, float *gkin, - float vertex[3], float tofg, int *iflgk, - int ipart, int itra, int istak) { - - - // get pointer to all vertices - s_Vertices_t* verts = thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices; - int VertexCount = verts->mult; - - // create additional space for one more vertex - s_Vertices_t* NewVerts = make_s_Vertices(VertexCount+1); - int i; - for (i=0;iin[i] = verts->in[i]; - } - NewVerts->mult = VertexCount; - thisInputEvent->physicsEvents->in[0].reactions->in[0].vertices = NewVerts; - FREE(verts); - verts = NewVerts; - //verts->in[VertexCount] = make_s_Vertex(); - verts->mult++; - //printf("Number of stored Vertices is now: %d\n",verts->mult); - - // copy in the new vertex coordinates - s_Origin_t* or = make_s_Origin(); - verts->in[VertexCount].origin = or; - or->vx = vertex[0]; - or->vy = vertex[1]; - or->vz = vertex[2]; - or->t = tofg * 1e9; - - int lastId = getLastId(); - - // copy in the new particles at this vertex - s_Products_t* ps = make_s_Products(Npart); - verts->in[VertexCount].products = ps; - ps->mult = Npart; - int thisId = lastId + 1; - for (i = 0;iin[i].momentum = make_s_Momentum(); - ps->in[i].momentum->px = gkin[i*5+0]; - ps->in[i].momentum->py = gkin[i*5+1]; - ps->in[i].momentum->pz = gkin[i*5+2]; - ps->in[i].momentum->E = gkin[i*5+3]; - ps->in[i].type = gkin[i*5+4]; - ps->in[i].pdgtype = PDGtype(gkin[i*5+4]); - ps->in[i].parentid = gidGetId(itra); - ps->in[i].id = thisId; - ps->in[i].mech = kcase; - ps->in[i].decayVertex = VertexCount; - gidSet(iflgk[i], thisId); - thisId++; - } - -} - - - -/* entry point from fortran */ - -void savenewvertex_ (int *kcase, int *N, float* gkin, - float* vertex, float* tofg, int* iflgk, - int* ipart, int* itra, int* istak) { - - SaveNewVertex(*kcase, *N, gkin, vertex, *tofg, iflgk, *ipart, *itra, *istak); - -} - -int getLastId() { - int maxId = 0; - s_Reactions_t* reacts; - int reactCount, ir; - reacts = thisInputEvent ->physicsEvents->in[0].reactions; - reactCount = reacts->mult; - for (ir = 0; ir < reactCount; ir++) { - s_Vertices_t* verts; - int vertCount, iv; - s_Reaction_t* react = &reacts->in[ir]; - verts = react->vertices; - vertCount = verts->mult; - for (iv = 0; iv < vertCount; iv++) { - s_Products_t* prods; - int prodCount, ip; - s_Vertex_t* vert = &verts->in[iv]; - prods = vert->products; - prodCount = prods->mult; - for (ip = 0; ip < prodCount; ip++) { - s_Product_t* prod = &prods->in[ip]; - if (prod->id > maxId) { - maxId = prod->id; - } - } - } - } - return maxId; -} diff --git a/src/programs/Simulation/HDGeant/seteventid.F b/src/programs/Simulation/HDGeant/seteventid.F deleted file mode 100644 index bc116b9ce0..0000000000 --- a/src/programs/Simulation/HDGeant/seteventid.F +++ /dev/null @@ -1,8 +0,0 @@ - subroutine setEventId(runNo,eventNo) - integer runNo,eventNo - -#include "geant321/gcflag.inc" - - IDRUN = runNo - IDEVT = eventNo - end diff --git a/src/programs/Simulation/HDGeant/settofg.F b/src/programs/Simulation/HDGeant/settofg.F deleted file mode 100644 index 29636b9a8e..0000000000 --- a/src/programs/Simulation/HDGeant/settofg.F +++ /dev/null @@ -1,92 +0,0 @@ - function settofg(vertex,time0) - real settofg - real vertex(3) ! cm - real time0 ! ns -* -* Sets the Geant variable TOFG which determines the start time of the -* tracking for subsequent particles placed on the primary stack. The -* start time is determined assuming a beam photon is being generated. -* It is set so that the beam photon will cross the reference plane at -* TOF=time0 if it makes it that far. -* -#include "geant321/gconst.inc" -#include "geant321/gctrak.inc" -#include "controlparams.inc" - - real t0 - real xnormal(2) - real beam_period_ns - real reference_time_plane_z - beam_period_ns = get_beam_period() - reference_time_plane_z = get_reference_plane() - if (time0 .eq. 0) then -c smear the time0 value by the trigger time sigma - call GRANOR(xnormal(1),xnormal(2)) - t0=trigger_time_sigma_ns*xnormal(1) -c discretize the time according to the beam microstructure - t0=beam_period_ns*floor(t0/beam_period_ns+0.5) -c synchronize the time to the accelerator clock, with the phase -c set to zero when the bunch crosses the reference plane - TOFG=t0*1e-9 + (vertex(3)-reference_time_plane_z)/CLIGHT - else - TOFG=time0*1e-9 - endif - settofg=TOFG - end - -* -* Read beam_bucket_period_ns from calibdb -* - function get_beam_period() - real get_beam_period - real beam_bucket_period_ns - common /beam_bucket_saver/beam_bucket_period_ns - data beam_bucket_period_ns/-1./ - character*80 dbpath - integer ndata - integer GetCalib - external GetCalib - if (beam_bucket_period_ns .lt. 0) then - dbpath = "/PHOTON_BEAM/RF/beam_period" - ndata = 1 - if (GetCalib(dbpath, ndata, beam_bucket_period_ns) .ne. 0) then - write (6,*) "HDGeant error in settofg: ", - * "failed to read RF period ", - * "from calibdb, cannot continue." - stop - else - write (6,*) "settofg: beam_bucket_period_ns set to ", - * beam_bucket_period_ns, "ns" - endif - endif - get_beam_period = beam_bucket_period_ns - end - -* -* Read reference_plane_z_cm from calibdb -* - function get_reference_plane() - real get_reference_plane - real reference_plane_z_cm - common /time_reference_plane_z_saver/reference_plane_z_cm - data reference_plane_z_cm/1e30/ - character*80 dbpath - integer ndata - integer GetCalib - external GetCalib - if (reference_plane_z_cm .gt. 1e6) then - dbpath = "/PHOTON_BEAM/RF/reference_plane_z" - ndata = 1 - res = GetCalib(dbpath, ndata, reference_plane_z_cm) - if (res .ne. 0 .or. reference_plane_z_cm .gt. 1e6) then - reference_plane_z_cm = 65. - write (6,*) "HDGeant warning in settofg: ", - * "failed to read RF reference_plane_z ", - * "from calibdb, using default z=65cm." - else - write (6,*) "settofg: RF reference plane set to ", - * reference_plane_z_cm, "cm" - endif - endif - get_reference_plane = reference_plane_z_cm - end diff --git a/src/programs/Simulation/HDGeant/solenoid.map b/src/programs/Simulation/HDGeant/solenoid.map deleted file mode 100644 index 05f2874f81..0000000000 --- a/src/programs/Simulation/HDGeant/solenoid.map +++ /dev/null @@ -1,10291 +0,0 @@ -0 0 -1.1451 -0 0 -1.1795 -0 0 -1.2125 -0 0 -1.2448 -0 0 -1.2761 -0 0 -1.3065 -0 0 -1.3363 -0 0 -1.3650 -0 0 -1.3934 -0 0 -1.4202 -0 0 -1.4470 -0 0 -1.4719 -0 0 -1.4968 -0 0 -1.5201 -0 0 -1.5431 -0 0 -1.5649 -0 0 -1.5860 -0 0 -1.6063 -0 0 -1.6256 -0 0 -1.6445 -0 0 -1.6621 -0 0 -1.6796 -0 0 -1.6957 -0 0 -1.7117 -0 0 -1.7266 -0 0 -1.7412 -0 0 -1.7549 -0 0 -1.7683 -0 0 -1.7810 -0 0 -1.7931 -0 0 -1.8049 -0 0 -1.8160 -0 0 -1.8269 -0 0 -1.8370 -0 0 -1.8471 -0 0 -1.8564 -0 0 -1.8656 -0 0 -1.8742 -0 0 -1.8826 -0 0 -1.8907 -0 0 -1.8984 -0 0 -1.9059 -0 0 -1.9131 -0 0 -1.9201 -0 0 -1.9266 -0 0 -1.9330 -0 0 -1.9391 -0 0 -1.9450 -0 0 -1.9506 -0 0 -1.9559 -0 0 -1.9610 -0 0 -1.9662 -0 0 -1.9708 -0 0 -1.9753 -0 0 -1.9795 -0 0 -1.9834 -0 0 -1.9873 -0 0 -1.9906 -0 0 -1.9939 -0 0 -1.9968 -0 0 -1.9996 -0 0 -2.0022 -0 0 -2.0043 -0 0 -2.0065 -0 0 -2.0083 -0 0 -2.0100 -0 0 -2.0115 -0 0 -2.0128 -0 0 -2.0141 -0 0 -2.0151 -0 0 -2.0161 -0 0 -2.0169 -0 0 -2.0177 -0 0 -2.0184 -0 0 -2.0192 -0 0 -2.0199 -0 0 -2.0206 -0 0 -2.0213 -0 0 -2.0221 -0 0 -2.0229 -0 0 -2.0235 -0 0 -2.0241 -0 0 -2.0248 -0 0 -2.0255 -0 0 -2.0263 -0 0 -2.0271 -0 0 -2.0278 -0 0 -2.0286 -0 0 -2.0294 -0 0 -2.0301 -0 0 -2.0309 -0 0 -2.0316 -0 0 -2.0323 -0 0 -2.0330 -0 0 -2.0335 -0 0 -2.0340 -0 0 -2.0345 -0 0 -2.0348 -0 0 -2.0351 -0 0 -2.0351 -0 0 -2.0351 -0 0 -2.0347 -0 0 -2.0340 -0 0 -2.0333 -0 0 -2.0326 -0 0 -2.0312 -0 0 -2.0295 -0 0 -2.0273 -0 0 -2.0246 -0 0 -2.0214 -0 0 -2.0169 -0 0 -2.0124 -0 0 -2.0064 -0 0 -2.0001 -0 0 -1.9928 -0 0 -1.9841 -0 0 -1.9754 -0 0 -1.9640 -0 0 -1.9526 -0 0 -1.9391 -0 0 -1.9246 -0 0 -1.9092 -0 0 -1.8913 -0 0 -1.8734 -0 0 -1.8525 -0 0 -1.8310 -0 0 -1.8079 -0 0 -1.7828 -0 0 -1.7576 -0 0 -1.7290 -0 0 -1.7004 -0 0 -1.6699 -0 0 -1.6384 -0 0 -1.6060 -0 0 -1.5711 -0 0 -1.5358 -0 0 -1.4990 -0 0 -1.4618 -0 0 -1.4233 -0 0 -1.3845 -0 0 -1.3445 -0 0 -1.3044 -0 0 -1.2635 -0 0 -1.2223 -0 0 -1.1799 -0 0 -1.1380 -0 0 -1.0974 -0 0 -1.0569 -0 0 -1.0163 -0 0 -0.97566 -0 0 -0.93512 -0 0 -0.89589 -0 0 -0.85665 -0 0 -0.81830 -0 0 -0.78103 -0 0 -0.74375 -0 0 -0.70854 -0 0 -0.67369 -0 0 -0.63953 -0 0 -0.60743 -0 0 -0.57534 -0 0 -0.54516 -0 0 -0.51601 -0 0 -0.48702 -0 0 -0.46089 -0 0 -0.43477 -0 0 -0.40999 -0 0 -0.38685 -0 0 -0.36371 -0 0 -0.34268 -0 0 -0.32201 -0 0 -0.30238 -0 0 -0.28589 -0 0 -0.26939 -0 0 -0.25289 -0 0 -0.23717 -0 0 -0.22379 -0 0 -0.21041 -0 0 -0.19703 -0 0 -0.18440 -0 0 -0.17401 -0 0 -0.16363 -0 0 -0.15324 -0 0 -0.14346 -0 0 -0.13549 -0 0 -0.12753 -0 0 -0.11956 -0 0 -0.11207 -0 0 -0.10601 -0 0 -0.99952E-01 -0 0 -0.93891E-01 -0 0 -0.88197E-01 -0 0 -0.83602E-01 -0 0 -0.79007E-01 -0 0 -0.74412E-01 -0 0 -0.70095E-01 -0 0 -0.66610E-01 -0 0 -0.63124E-01 -0 0 -0.59639E-01 -0 0 -0.56362E-01 -0 0 -0.53713E-01 -0 0 -0.51063E-01 -0 0 -0.48413E-01 -0 0 -0.45912E-01 -0 0 -0.43856E-01 -0 0 -0.41800E-01 -0 0 -0.39744E-01 -0 0 -0.37577E-01 -0 0 -0.35076E-01 -0 0 -0.32575E-01 -0 0 -0.30074E-01 -0 0 -0.28152E-01 -0 0 -0.27966E-01 -0 0 -0.27781E-01 -0 0 -0.27595E-01 -0 0 -0.27225E-01 -0 0 -0.26301E-01 -0 0 -0.25377E-01 -0 0 -0.24453E-01 -0 0 -0.23573E-01 -0 0 -0.22826E-01 -0 0 -0.22078E-01 -0 0 -0.21331E-01 -0 0 -0.20625E-01 -0 0 -0.20044E-01 -0 0 -0.19462E-01 -0 0 -0.18881E-01 -0 0 -0.18332E-01 -0 0 -0.17880E-01 -0 0 -0.17429E-01 -0 0 -0.16977E-01 -0 0 -0.16553E-01 -0 0 -0.16210E-01 -0 0 -0.15866E-01 -0 0 -0.15523E-01 -0 0 -0.15202E-01 -0 0 -0.14949E-01 -0 0 -0.14697E-01 -0 0 -0.14444E-01 -0 0 -0.14212E-01 -0 0 -0.14039E-01 -0 0 -0.13866E-01 -0 0 -0.13693E-01 -0 0 -0.13538E-01 -0 0 -0.13436E-01 -0 0 -0.13335E-01 -0 0 -0.13234E-01 -0 0 -0.13149E-01 -0 0 -0.13116E-01 -0 0 -0.13082E-01 -0 0 -0.13049E-01 -0.17562E-01 0 -1.1463 -0.17046E-01 0 -1.1803 -0.16635E-01 0 -1.2131 -0.16271E-01 0 -1.2453 -0.15880E-01 0 -1.2765 -0.15464E-01 0 -1.3070 -0.15038E-01 0 -1.3368 -0.14589E-01 0 -1.3655 -0.14138E-01 0 -1.3939 -0.13670E-01 0 -1.4207 -0.13202E-01 0 -1.4475 -0.12731E-01 0 -1.4724 -0.12259E-01 0 -1.4973 -0.11796E-01 0 -1.5206 -0.11334E-01 0 -1.5436 -0.10884E-01 0 -1.5654 -0.10442E-01 0 -1.5864 -0.10011E-01 0 -1.6067 -0.95949E-02 0 -1.6260 -0.91865E-02 0 -1.6449 -0.88011E-02 0 -1.6625 -0.84176E-02 0 -1.6800 -0.80638E-02 0 -1.6961 -0.77100E-02 0 -1.7121 -0.73838E-02 0 -1.7269 -0.70613E-02 0 -1.7415 -0.67599E-02 0 -1.7552 -0.64674E-02 0 -1.7686 -0.61897E-02 0 -1.7813 -0.59255E-02 0 -1.7934 -0.56703E-02 0 -1.8052 -0.54326E-02 0 -1.8162 -0.51989E-02 0 -1.8271 -0.49859E-02 0 -1.8372 -0.47729E-02 0 -1.8473 -0.45823E-02 0 -1.8566 -0.43922E-02 0 -1.8658 -0.42187E-02 0 -1.8744 -0.40495E-02 0 -1.8828 -0.38916E-02 0 -1.8908 -0.37408E-02 0 -1.8986 -0.35963E-02 0 -1.9061 -0.34604E-02 0 -1.9132 -0.33268E-02 0 -1.9202 -0.32001E-02 0 -1.9268 -0.30774E-02 0 -1.9331 -0.29567E-02 0 -1.9392 -0.28385E-02 0 -1.9451 -0.27214E-02 0 -1.9507 -0.26047E-02 0 -1.9560 -0.24879E-02 0 -1.9612 -0.23711E-02 0 -1.9663 -0.22526E-02 0 -1.9709 -0.21339E-02 0 -1.9754 -0.20143E-02 0 -1.9796 -0.18936E-02 0 -1.9835 -0.17729E-02 0 -1.9874 -0.16525E-02 0 -1.9907 -0.15321E-02 0 -1.9940 -0.14148E-02 0 -1.9969 -0.12991E-02 0 -1.9997 -0.11860E-02 0 -2.0023 -0.10806E-02 0 -2.0044 -0.97524E-03 0 -2.0066 -0.88321E-03 0 -2.0084 -0.79353E-03 0 -2.0101 -0.71281E-03 0 -2.0116 -0.64304E-03 0 -2.0129 -0.57437E-03 0 -2.0142 -0.52648E-03 0 -2.0152 -0.47860E-03 0 -2.0161 -0.44450E-03 0 -2.0170 -0.41783E-03 0 -2.0177 -0.39494E-03 0 -2.0184 -0.38341E-03 0 -2.0192 -0.37898E-03 0 -2.0199 -0.37875E-03 0 -2.0206 -0.38401E-03 0 -2.0212 -0.39306E-03 0 -2.0220 -0.40413E-03 0 -2.0228 -0.41750E-03 0 -2.0234 -0.43087E-03 0 -2.0240 -0.44380E-03 0 -2.0248 -0.45665E-03 0 -2.0255 -0.46758E-03 0 -2.0263 -0.47615E-03 0 -2.0271 -0.48438E-03 0 -2.0278 -0.48620E-03 0 -2.0286 -0.48802E-03 0 -2.0294 -0.48431E-03 0 -2.0301 -0.47762E-03 0 -2.0309 -0.46830E-03 0 -2.0316 -0.45106E-03 0 -2.0323 -0.43383E-03 0 -2.0330 -0.40468E-03 0 -2.0335 -0.37344E-03 0 -2.0341 -0.33324E-03 0 -2.0345 -0.28209E-03 0 -2.0349 -0.22951E-03 0 -2.0352 -0.14963E-03 0 -2.0352 -0.69749E-04 0 -2.0352 --0.36365E-04 0 -2.0348 --0.15661E-03 0 -2.0341 --0.28744E-03 0 -2.0334 --0.45004E-03 0 -2.0328 --0.64203E-03 0 -2.0315 --0.85494E-03 0 -2.0298 --0.11012E-02 0 -2.0275 --0.13845E-02 0 -2.0249 --0.16975E-02 0 -2.0218 --0.20631E-02 0 -2.0173 --0.24287E-02 0 -2.0128 --0.28716E-02 0 -2.0068 --0.33282E-02 0 -2.0006 --0.38258E-02 0 -1.9933 --0.43735E-02 0 -1.9847 --0.49254E-02 0 -1.9760 --0.55573E-02 0 -1.9646 --0.61891E-02 0 -1.9532 --0.68668E-02 0 -1.9398 --0.75692E-02 0 -1.9253 --0.82842E-02 0 -1.9100 --0.90373E-02 0 -1.8921 --0.97904E-02 0 -1.8742 --0.10566E-01 0 -1.8533 --0.11346E-01 0 -1.8318 --0.12125E-01 0 -1.8087 --0.12904E-01 0 -1.7836 --0.13681E-01 0 -1.7584 --0.14431E-01 0 -1.7298 --0.15181E-01 0 -1.7012 --0.15895E-01 0 -1.6707 --0.16588E-01 0 -1.6391 --0.17264E-01 0 -1.6067 --0.17883E-01 0 -1.5718 --0.18482E-01 0 -1.5364 --0.19017E-01 0 -1.4996 --0.19527E-01 0 -1.4624 --0.19964E-01 0 -1.4238 --0.20373E-01 0 -1.3849 --0.20700E-01 0 -1.3449 --0.20998E-01 0 -1.3047 --0.21208E-01 0 -1.2638 --0.21388E-01 0 -1.2225 --0.21476E-01 0 -1.1800 --0.21529E-01 0 -1.1381 --0.21477E-01 0 -1.0974 --0.21425E-01 0 -1.0568 --0.21275E-01 0 -1.0161 --0.21072E-01 0 -0.97544 --0.20862E-01 0 -0.93484 --0.20524E-01 0 -0.89555 --0.20186E-01 0 -0.85626 --0.19798E-01 0 -0.81786 --0.19348E-01 0 -0.78054 --0.18898E-01 0 -0.74323 --0.18376E-01 0 -0.70798 --0.17841E-01 0 -0.67310 --0.17293E-01 0 -0.63891 --0.16702E-01 0 -0.60679 --0.16111E-01 0 -0.57468 --0.15503E-01 0 -0.54449 --0.14885E-01 0 -0.51533 --0.14266E-01 0 -0.48633 --0.13646E-01 0 -0.46021 --0.13025E-01 0 -0.43409 --0.12412E-01 0 -0.40932 --0.11808E-01 0 -0.38619 --0.11205E-01 0 -0.36306 --0.10630E-01 0 -0.34204 --0.10060E-01 0 -0.32139 --0.95038E-02 0 -0.30179 --0.89906E-02 0 -0.28531 --0.84774E-02 0 -0.26883 --0.79642E-02 0 -0.25235 --0.74709E-02 0 -0.23666 --0.70369E-02 0 -0.22330 --0.66029E-02 0 -0.20994 --0.61690E-02 0 -0.19658 --0.57552E-02 0 -0.18397 --0.54022E-02 0 -0.17361 --0.50491E-02 0 -0.16324 --0.46961E-02 0 -0.15288 --0.43617E-02 0 -0.14312 --0.40836E-02 0 -0.13517 --0.38054E-02 0 -0.12723 --0.35273E-02 0 -0.11928 --0.32653E-02 0 -0.11181 --0.30519E-02 0 -0.10577 --0.28384E-02 0 -0.99724E-01 --0.26249E-02 0 -0.93680E-01 --0.24247E-02 0 -0.88001E-01 --0.22641E-02 0 -0.83420E-01 --0.21036E-02 0 -0.78838E-01 --0.19430E-02 0 -0.74256E-01 --0.17928E-02 0 -0.69951E-01 --0.16735E-02 0 -0.66477E-01 --0.15543E-02 0 -0.63002E-01 --0.14350E-02 0 -0.59527E-01 --0.13238E-02 0 -0.56260E-01 --0.12367E-02 0 -0.53616E-01 --0.11497E-02 0 -0.50972E-01 --0.10626E-02 0 -0.48328E-01 --0.98046E-03 0 -0.45835E-01 --0.91312E-03 0 -0.43795E-01 --0.84579E-03 0 -0.41756E-01 --0.77845E-03 0 -0.39716E-01 --0.72269E-03 0 -0.37564E-01 --0.70165E-03 0 -0.35079E-01 --0.68061E-03 0 -0.32593E-01 --0.65956E-03 0 -0.30108E-01 --0.64051E-03 0 -0.28194E-01 --0.62742E-03 0 -0.27996E-01 --0.61433E-03 0 -0.27797E-01 --0.60124E-03 0 -0.27599E-01 --0.58284E-03 0 -0.27217E-01 --0.54848E-03 0 -0.26285E-01 --0.51413E-03 0 -0.25352E-01 --0.47977E-03 0 -0.24420E-01 --0.44801E-03 0 -0.23535E-01 --0.42406E-03 0 -0.22791E-01 --0.40011E-03 0 -0.22047E-01 --0.37616E-03 0 -0.21303E-01 --0.35325E-03 0 -0.20600E-01 --0.33346E-03 0 -0.20019E-01 --0.31368E-03 0 -0.19439E-01 --0.29389E-03 0 -0.18858E-01 --0.27505E-03 0 -0.18310E-01 --0.25903E-03 0 -0.17860E-01 --0.24302E-03 0 -0.17409E-01 --0.22700E-03 0 -0.16959E-01 --0.21164E-03 0 -0.16536E-01 --0.19825E-03 0 -0.16193E-01 --0.18485E-03 0 -0.15850E-01 --0.17145E-03 0 -0.15507E-01 --0.15852E-03 0 -0.15187E-01 --0.14701E-03 0 -0.14935E-01 --0.13550E-03 0 -0.14683E-01 --0.12399E-03 0 -0.14431E-01 --0.11280E-03 0 -0.14199E-01 --0.10257E-03 0 -0.14026E-01 --0.92340E-04 0 -0.13853E-01 --0.82111E-04 0 -0.13681E-01 --0.72083E-04 0 -0.13526E-01 --0.62654E-04 0 -0.13425E-01 --0.53226E-04 0 -0.13324E-01 --0.43797E-04 0 -0.13222E-01 --0.34466E-04 0 -0.13138E-01 --0.25427E-04 0 -0.13105E-01 --0.16388E-04 0 -0.13071E-01 --0.73484E-05 0 -0.13038E-01 -0.35125E-01 0 -1.1475 -0.34092E-01 0 -1.1812 -0.33270E-01 0 -1.2137 -0.32541E-01 0 -1.2458 -0.31760E-01 0 -1.2770 -0.30929E-01 0 -1.3074 -0.30076E-01 0 -1.3373 -0.29179E-01 0 -1.3660 -0.28276E-01 0 -1.3944 -0.27340E-01 0 -1.4212 -0.26405E-01 0 -1.4480 -0.25462E-01 0 -1.4729 -0.24519E-01 0 -1.4978 -0.23591E-01 0 -1.5211 -0.22667E-01 0 -1.5441 -0.21767E-01 0 -1.5659 -0.20883E-01 0 -1.5869 -0.20021E-01 0 -1.6072 -0.19190E-01 0 -1.6265 -0.18373E-01 0 -1.6453 -0.17602E-01 0 -1.6629 -0.16835E-01 0 -1.6804 -0.16128E-01 0 -1.6964 -0.15420E-01 0 -1.7125 -0.14768E-01 0 -1.7273 -0.14123E-01 0 -1.7419 -0.13520E-01 0 -1.7556 -0.12935E-01 0 -1.7689 -0.12379E-01 0 -1.7815 -0.11851E-01 0 -1.7937 -0.11341E-01 0 -1.8054 -0.10865E-01 0 -1.8165 -0.10398E-01 0 -1.8274 -0.99718E-02 0 -1.8374 -0.95459E-02 0 -1.8475 -0.91646E-02 0 -1.8567 -0.87844E-02 0 -1.8660 -0.84375E-02 0 -1.8745 -0.80991E-02 0 -1.8830 -0.77832E-02 0 -1.8910 -0.74815E-02 0 -1.8987 -0.71927E-02 0 -1.9062 -0.69208E-02 0 -1.9134 -0.66535E-02 0 -1.9204 -0.64003E-02 0 -1.9269 -0.61548E-02 0 -1.9332 -0.59135E-02 0 -1.9394 -0.56770E-02 0 -1.9452 -0.54428E-02 0 -1.9508 -0.52093E-02 0 -1.9561 -0.49758E-02 0 -1.9613 -0.47422E-02 0 -1.9664 -0.45053E-02 0 -1.9710 -0.42678E-02 0 -1.9755 -0.40286E-02 0 -1.9797 -0.37871E-02 0 -1.9836 -0.35457E-02 0 -1.9875 -0.33049E-02 0 -1.9908 -0.30642E-02 0 -1.9941 -0.28295E-02 0 -1.9970 -0.25982E-02 0 -1.9998 -0.23721E-02 0 -2.0024 -0.21613E-02 0 -2.0045 -0.19505E-02 0 -2.0067 -0.17664E-02 0 -2.0085 -0.15871E-02 0 -2.0102 -0.14256E-02 0 -2.0117 -0.12861E-02 0 -2.0129 -0.11487E-02 0 -2.0142 -0.10530E-02 0 -2.0152 -0.95720E-03 0 -2.0162 -0.88900E-03 0 -2.0170 -0.83566E-03 0 -2.0177 -0.78988E-03 0 -2.0184 -0.76682E-03 0 -2.0192 -0.75796E-03 0 -2.0199 -0.75751E-03 0 -2.0206 -0.76803E-03 0 -2.0212 -0.78611E-03 0 -2.0220 -0.80825E-03 0 -2.0228 -0.83500E-03 0 -2.0234 -0.86175E-03 0 -2.0240 -0.88760E-03 0 -2.0248 -0.91330E-03 0 -2.0255 -0.93515E-03 0 -2.0263 -0.95229E-03 0 -2.0270 -0.96876E-03 0 -2.0278 -0.97240E-03 0 -2.0286 -0.97604E-03 0 -2.0294 -0.96862E-03 0 -2.0301 -0.95524E-03 0 -2.0309 -0.93659E-03 0 -2.0316 -0.90213E-03 0 -2.0323 -0.86766E-03 0 -2.0330 -0.80937E-03 0 -2.0336 -0.74687E-03 0 -2.0341 -0.66647E-03 0 -2.0346 -0.56418E-03 0 -2.0349 -0.45901E-03 0 -2.0352 -0.29926E-03 0 -2.0353 -0.13950E-03 0 -2.0353 --0.72730E-04 0 -2.0349 --0.31321E-03 0 -2.0342 --0.57488E-03 0 -2.0336 --0.90008E-03 0 -2.0329 --0.12841E-02 0 -2.0317 --0.17099E-02 0 -2.0300 --0.22024E-02 0 -2.0278 --0.27689E-02 0 -2.0253 --0.33951E-02 0 -2.0221 --0.41262E-02 0 -2.0177 --0.48573E-02 0 -2.0132 --0.57432E-02 0 -2.0073 --0.66565E-02 0 -2.0011 --0.76517E-02 0 -1.9939 --0.87470E-02 0 -1.9853 --0.98508E-02 0 -1.9766 --0.11115E-01 0 -1.9653 --0.12378E-01 0 -1.9539 --0.13734E-01 0 -1.9406 --0.15138E-01 0 -1.9261 --0.16568E-01 0 -1.9108 --0.18075E-01 0 -1.8929 --0.19581E-01 0 -1.8750 --0.21132E-01 0 -1.8541 --0.22691E-01 0 -1.8326 --0.24250E-01 0 -1.8096 --0.25808E-01 0 -1.7845 --0.27363E-01 0 -1.7592 --0.28863E-01 0 -1.7306 --0.30363E-01 0 -1.7020 --0.31790E-01 0 -1.6715 --0.33177E-01 0 -1.6399 --0.34527E-01 0 -1.6074 --0.35766E-01 0 -1.5725 --0.36963E-01 0 -1.5370 --0.38033E-01 0 -1.5002 --0.39054E-01 0 -1.4629 --0.39928E-01 0 -1.4243 --0.40746E-01 0 -1.3853 --0.41401E-01 0 -1.3453 --0.41997E-01 0 -1.3050 --0.42416E-01 0 -1.2640 --0.42775E-01 0 -1.2226 --0.42951E-01 0 -1.1801 --0.43057E-01 0 -1.1381 --0.42953E-01 0 -1.0974 --0.42849E-01 0 -1.0567 --0.42549E-01 0 -1.0160 --0.42144E-01 0 -0.97522 --0.41724E-01 0 -0.93456 --0.41049E-01 0 -0.89522 --0.40373E-01 0 -0.85587 --0.39596E-01 0 -0.81742 --0.38696E-01 0 -0.78006 --0.37796E-01 0 -0.74270 --0.36752E-01 0 -0.70742 --0.35683E-01 0 -0.67251 --0.34585E-01 0 -0.63829 --0.33404E-01 0 -0.60616 --0.32223E-01 0 -0.57402 --0.31006E-01 0 -0.54382 --0.29770E-01 0 -0.51466 --0.28533E-01 0 -0.48565 --0.27291E-01 0 -0.45953 --0.26049E-01 0 -0.43341 --0.24823E-01 0 -0.40864 --0.23617E-01 0 -0.38553 --0.22410E-01 0 -0.36241 --0.21260E-01 0 -0.34141 --0.20119E-01 0 -0.32078 --0.19008E-01 0 -0.30119 --0.17981E-01 0 -0.28473 --0.16955E-01 0 -0.26827 --0.15928E-01 0 -0.25182 --0.14942E-01 0 -0.23614 --0.14074E-01 0 -0.22280 --0.13206E-01 0 -0.20947 --0.12338E-01 0 -0.19613 --0.11510E-01 0 -0.18355 --0.10804E-01 0 -0.17320 --0.10098E-01 0 -0.16286 --0.93921E-02 0 -0.15252 --0.87234E-02 0 -0.14278 --0.81672E-02 0 -0.13485 --0.76109E-02 0 -0.12693 --0.70546E-02 0 -0.11900 --0.65307E-02 0 -0.11155 --0.61037E-02 0 -0.10552 --0.56768E-02 0 -0.99496E-01 --0.52499E-02 0 -0.93468E-01 --0.48494E-02 0 -0.87806E-01 --0.45283E-02 0 -0.83237E-01 --0.42072E-02 0 -0.78669E-01 --0.38861E-02 0 -0.74100E-01 --0.35856E-02 0 -0.69808E-01 --0.33471E-02 0 -0.66344E-01 --0.31085E-02 0 -0.62879E-01 --0.28700E-02 0 -0.59415E-01 --0.26476E-02 0 -0.56157E-01 --0.24734E-02 0 -0.53519E-01 --0.22993E-02 0 -0.50881E-01 --0.21252E-02 0 -0.48243E-01 --0.19609E-02 0 -0.45759E-01 --0.18262E-02 0 -0.43735E-01 --0.16916E-02 0 -0.41711E-01 --0.15569E-02 0 -0.39687E-01 --0.14454E-02 0 -0.37552E-01 --0.14033E-02 0 -0.35082E-01 --0.13612E-02 0 -0.32611E-01 --0.13191E-02 0 -0.30141E-01 --0.12810E-02 0 -0.28236E-01 --0.12548E-02 0 -0.28025E-01 --0.12287E-02 0 -0.27814E-01 --0.12025E-02 0 -0.27603E-01 --0.11657E-02 0 -0.27210E-01 --0.10970E-02 0 -0.26269E-01 --0.10283E-02 0 -0.25328E-01 --0.95954E-03 0 -0.24387E-01 --0.89603E-03 0 -0.23496E-01 --0.84812E-03 0 -0.22756E-01 --0.80022E-03 0 -0.22015E-01 --0.75232E-03 0 -0.21275E-01 --0.70650E-03 0 -0.20575E-01 --0.66693E-03 0 -0.19995E-01 --0.62735E-03 0 -0.19415E-01 --0.58778E-03 0 -0.18836E-01 --0.55010E-03 0 -0.18289E-01 --0.51807E-03 0 -0.17839E-01 --0.48604E-03 0 -0.17390E-01 --0.45401E-03 0 -0.16941E-01 --0.42329E-03 0 -0.16518E-01 --0.39649E-03 0 -0.16176E-01 --0.36969E-03 0 -0.15834E-01 --0.34290E-03 0 -0.15492E-01 --0.31704E-03 0 -0.15172E-01 --0.29402E-03 0 -0.14921E-01 --0.27100E-03 0 -0.14669E-01 --0.24797E-03 0 -0.14418E-01 --0.22559E-03 0 -0.14186E-01 --0.20514E-03 0 -0.14013E-01 --0.18468E-03 0 -0.13841E-01 --0.16422E-03 0 -0.13669E-01 --0.14417E-03 0 -0.13514E-01 --0.12531E-03 0 -0.13413E-01 --0.10645E-03 0 -0.13312E-01 --0.87594E-04 0 -0.13211E-01 --0.68932E-04 0 -0.13127E-01 --0.50853E-04 0 -0.13094E-01 --0.32775E-04 0 -0.13060E-01 --0.14697E-04 0 -0.13027E-01 -0.51368E-01 0 -1.1484 -0.50264E-01 0 -1.1822 -0.49186E-01 0 -1.2148 -0.48121E-01 0 -1.2469 -0.46982E-01 0 -1.2781 -0.45773E-01 0 -1.3087 -0.44530E-01 0 -1.3386 -0.43218E-01 0 -1.3673 -0.41896E-01 0 -1.3957 -0.40525E-01 0 -1.4226 -0.39154E-01 0 -1.4494 -0.37772E-01 0 -1.4743 -0.36390E-01 0 -1.4992 -0.35029E-01 0 -1.5225 -0.33674E-01 0 -1.5454 -0.32355E-01 0 -1.5672 -0.31057E-01 0 -1.5882 -0.29793E-01 0 -1.6084 -0.28573E-01 0 -1.6277 -0.27374E-01 0 -1.6465 -0.26242E-01 0 -1.6640 -0.25116E-01 0 -1.6815 -0.24076E-01 0 -1.6975 -0.23036E-01 0 -1.7135 -0.22075E-01 0 -1.7282 -0.21126E-01 0 -1.7428 -0.20237E-01 0 -1.7564 -0.19374E-01 0 -1.7697 -0.18553E-01 0 -1.7824 -0.17772E-01 0 -1.7944 -0.17017E-01 0 -1.8062 -0.16312E-01 0 -1.8172 -0.15619E-01 0 -1.8280 -0.14987E-01 0 -1.8381 -0.14354E-01 0 -1.8481 -0.13786E-01 0 -1.8573 -0.13221E-01 0 -1.8665 -0.12703E-01 0 -1.8751 -0.12199E-01 0 -1.8835 -0.11728E-01 0 -1.8914 -0.11278E-01 0 -1.8991 -0.10847E-01 0 -1.9066 -0.10441E-01 0 -1.9138 -0.10042E-01 0 -1.9208 -0.96635E-02 0 -1.9273 -0.92961E-02 0 -1.9336 -0.89346E-02 0 -1.9397 -0.85798E-02 0 -1.9456 -0.82278E-02 0 -1.9511 -0.78766E-02 0 -1.9565 -0.75243E-02 0 -1.9616 -0.71721E-02 0 -1.9668 -0.68134E-02 0 -1.9714 -0.64537E-02 0 -1.9759 -0.60904E-02 0 -1.9801 -0.57229E-02 0 -1.9840 -0.53553E-02 0 -1.9879 -0.49872E-02 0 -1.9912 -0.46192E-02 0 -1.9945 -0.42597E-02 0 -1.9974 -0.39049E-02 0 -2.0001 -0.35576E-02 0 -2.0027 -0.32332E-02 0 -2.0049 -0.29088E-02 0 -2.0070 -0.26248E-02 0 -2.0088 -0.23479E-02 0 -2.0104 -0.20983E-02 0 -2.0119 -0.18819E-02 0 -2.0132 -0.16690E-02 0 -2.0144 -0.15194E-02 0 -2.0154 -0.13699E-02 0 -2.0163 -0.12624E-02 0 -2.0171 -0.11776E-02 0 -2.0178 -0.11043E-02 0 -2.0185 -0.10655E-02 0 -2.0192 -0.10483E-02 0 -2.0199 -0.10437E-02 0 -2.0206 -0.10557E-02 0 -2.0212 -0.10789E-02 0 -2.0220 -0.11080E-02 0 -2.0228 -0.11438E-02 0 -2.0234 -0.11796E-02 0 -2.0240 -0.12134E-02 0 -2.0247 -0.12470E-02 0 -2.0255 -0.12745E-02 0 -2.0262 -0.12947E-02 0 -2.0270 -0.13139E-02 0 -2.0278 -0.13137E-02 0 -2.0286 -0.13136E-02 0 -2.0294 -0.12973E-02 0 -2.0302 -0.12723E-02 0 -2.0309 -0.12398E-02 0 -2.0317 -0.11847E-02 0 -2.0324 -0.11296E-02 0 -2.0331 -0.10407E-02 0 -2.0337 -0.94590E-03 0 -2.0342 -0.82550E-03 0 -2.0347 -0.67386E-03 0 -2.0351 -0.51806E-03 0 -2.0354 -0.28338E-03 0 -2.0355 -0.48698E-04 0 -2.0356 --0.26270E-03 0 -2.0352 --0.61542E-03 0 -2.0346 --0.99935E-03 0 -2.0340 --0.14769E-02 0 -2.0335 --0.20416E-02 0 -2.0323 --0.26684E-02 0 -2.0307 --0.33944E-02 0 -2.0286 --0.42306E-02 0 -2.0261 --0.51558E-02 0 -2.0231 --0.62377E-02 0 -2.0188 --0.73196E-02 0 -2.0144 --0.86329E-02 0 -2.0086 --0.99871E-02 0 -2.0025 --0.11464E-01 0 -1.9954 --0.13090E-01 0 -1.9869 --0.14729E-01 0 -1.9784 --0.16606E-01 0 -1.9671 --0.18483E-01 0 -1.9559 --0.20496E-01 0 -1.9426 --0.22582E-01 0 -1.9282 --0.24706E-01 0 -1.9130 --0.26941E-01 0 -1.8951 --0.29176E-01 0 -1.8773 --0.31475E-01 0 -1.8564 --0.33785E-01 0 -1.8349 --0.36093E-01 0 -1.8119 --0.38396E-01 0 -1.7867 --0.40695E-01 0 -1.7615 --0.42908E-01 0 -1.7328 --0.45120E-01 0 -1.7041 --0.47220E-01 0 -1.6735 --0.49260E-01 0 -1.6418 --0.51243E-01 0 -1.6093 --0.53059E-01 0 -1.5742 --0.54810E-01 0 -1.5387 --0.56372E-01 0 -1.5017 --0.57860E-01 0 -1.4643 --0.59128E-01 0 -1.4255 --0.60315E-01 0 -1.3863 --0.61257E-01 0 -1.3461 --0.62113E-01 0 -1.3057 --0.62708E-01 0 -1.2645 --0.63214E-01 0 -1.2230 --0.63450E-01 0 -1.1803 --0.63583E-01 0 -1.1381 --0.63408E-01 0 -1.0972 --0.63233E-01 0 -1.0563 --0.62771E-01 0 -1.0154 --0.62154E-01 0 -0.97456 --0.61518E-01 0 -0.93374 --0.60508E-01 0 -0.89426 --0.59499E-01 0 -0.85478 --0.58343E-01 0 -0.81621 --0.57008E-01 0 -0.77874 --0.55673E-01 0 -0.74127 --0.54131E-01 0 -0.70591 --0.52552E-01 0 -0.67092 --0.50934E-01 0 -0.63663 --0.49196E-01 0 -0.60446 --0.47459E-01 0 -0.57228 --0.45672E-01 0 -0.54205 --0.43858E-01 0 -0.51287 --0.42043E-01 0 -0.48385 --0.40225E-01 0 -0.45774 --0.38406E-01 0 -0.43163 --0.36612E-01 0 -0.40688 --0.34848E-01 0 -0.38379 --0.33084E-01 0 -0.36071 --0.31404E-01 0 -0.33975 --0.29739E-01 0 -0.31917 --0.28116E-01 0 -0.29963 --0.26618E-01 0 -0.28322 --0.25120E-01 0 -0.26681 --0.23622E-01 0 -0.25041 --0.22183E-01 0 -0.23478 --0.20916E-01 0 -0.22151 --0.19650E-01 0 -0.20823 --0.18384E-01 0 -0.19495 --0.17177E-01 0 -0.18242 --0.16146E-01 0 -0.17213 --0.15115E-01 0 -0.16185 --0.14084E-01 0 -0.15156 --0.13107E-01 0 -0.14188 --0.12294E-01 0 -0.13400 --0.11481E-01 0 -0.12612 --0.10667E-01 0 -0.11825 --0.99005E-02 0 -0.11085 --0.92745E-02 0 -0.10486 --0.86485E-02 0 -0.98875E-01 --0.80225E-02 0 -0.92890E-01 --0.74348E-02 0 -0.87267E-01 --0.69619E-02 0 -0.82732E-01 --0.64891E-02 0 -0.78198E-01 --0.60163E-02 0 -0.73663E-01 --0.55734E-02 0 -0.69403E-01 --0.52205E-02 0 -0.65965E-01 --0.48675E-02 0 -0.62527E-01 --0.45146E-02 0 -0.59088E-01 --0.41847E-02 0 -0.55855E-01 --0.39236E-02 0 -0.53237E-01 --0.36626E-02 0 -0.50619E-01 --0.34016E-02 0 -0.48001E-01 --0.31569E-02 0 -0.45536E-01 --0.29612E-02 0 -0.43530E-01 --0.27656E-02 0 -0.41523E-01 --0.25700E-02 0 -0.39516E-01 --0.23952E-02 0 -0.37397E-01 --0.22830E-02 0 -0.34940E-01 --0.21708E-02 0 -0.32484E-01 --0.20587E-02 0 -0.30027E-01 --0.19543E-02 0 -0.28133E-01 --0.18734E-02 0 -0.27926E-01 --0.17924E-02 0 -0.27719E-01 --0.17115E-02 0 -0.27511E-01 --0.16282E-02 0 -0.27121E-01 --0.15377E-02 0 -0.26183E-01 --0.14472E-02 0 -0.25245E-01 --0.13567E-02 0 -0.24307E-01 --0.12716E-02 0 -0.23420E-01 --0.12026E-02 0 -0.22683E-01 --0.11336E-02 0 -0.21947E-01 --0.10646E-02 0 -0.21210E-01 --0.99896E-03 0 -0.20514E-01 --0.94325E-03 0 -0.19937E-01 --0.88753E-03 0 -0.19360E-01 --0.83182E-03 0 -0.18784E-01 --0.77869E-03 0 -0.18239E-01 --0.73334E-03 0 -0.17792E-01 --0.68799E-03 0 -0.17345E-01 --0.64264E-03 0 -0.16898E-01 --0.59916E-03 0 -0.16477E-01 --0.56125E-03 0 -0.16137E-01 --0.52335E-03 0 -0.15796E-01 --0.48545E-03 0 -0.15456E-01 --0.44887E-03 0 -0.15138E-01 --0.41629E-03 0 -0.14887E-01 --0.38370E-03 0 -0.14637E-01 --0.35111E-03 0 -0.14386E-01 --0.31943E-03 0 -0.14156E-01 --0.29047E-03 0 -0.13984E-01 --0.26151E-03 0 -0.13812E-01 --0.23255E-03 0 -0.13641E-01 --0.20416E-03 0 -0.13487E-01 --0.17745E-03 0 -0.13386E-01 --0.15075E-03 0 -0.13286E-01 --0.12405E-03 0 -0.13185E-01 --0.97622E-04 0 -0.13101E-01 --0.72020E-04 0 -0.13068E-01 --0.46417E-04 0 -0.13035E-01 --0.20815E-04 0 -0.13002E-01 -0.67611E-01 0 -1.1493 -0.66436E-01 0 -1.1832 -0.65103E-01 0 -1.2158 -0.63700E-01 0 -1.2480 -0.62204E-01 0 -1.2793 -0.60618E-01 0 -1.3099 -0.58985E-01 0 -1.3398 -0.57256E-01 0 -1.3686 -0.55516E-01 0 -1.3971 -0.53710E-01 0 -1.4239 -0.51904E-01 0 -1.4507 -0.50082E-01 0 -1.4757 -0.48261E-01 0 -1.5005 -0.46467E-01 0 -1.5238 -0.44682E-01 0 -1.5467 -0.42942E-01 0 -1.5685 -0.41232E-01 0 -1.5895 -0.39565E-01 0 -1.6097 -0.37956E-01 0 -1.6289 -0.36375E-01 0 -1.6476 -0.34882E-01 0 -1.6652 -0.33397E-01 0 -1.6826 -0.32024E-01 0 -1.6985 -0.30651E-01 0 -1.7145 -0.29383E-01 0 -1.7292 -0.28128E-01 0 -1.7437 -0.26954E-01 0 -1.7573 -0.25813E-01 0 -1.7705 -0.24727E-01 0 -1.7832 -0.23693E-01 0 -1.7952 -0.22693E-01 0 -1.8069 -0.21760E-01 0 -1.8179 -0.20841E-01 0 -1.8287 -0.20001E-01 0 -1.8387 -0.19162E-01 0 -1.8487 -0.18408E-01 0 -1.8579 -0.17657E-01 0 -1.8670 -0.16969E-01 0 -1.8756 -0.16298E-01 0 -1.8839 -0.15672E-01 0 -1.8919 -0.15074E-01 0 -1.8996 -0.14501E-01 0 -1.9070 -0.13961E-01 0 -1.9142 -0.13430E-01 0 -1.9211 -0.12927E-01 0 -1.9276 -0.12437E-01 0 -1.9339 -0.11956E-01 0 -1.9401 -0.11483E-01 0 -1.9459 -0.11013E-01 0 -1.9515 -0.10544E-01 0 -1.9568 -0.10073E-01 0 -1.9620 -0.96020E-02 0 -1.9671 -0.91216E-02 0 -1.9717 -0.86395E-02 0 -1.9762 -0.81522E-02 0 -1.9805 -0.76586E-02 0 -1.9844 -0.71649E-02 0 -1.9882 -0.66695E-02 0 -1.9915 -0.61742E-02 0 -1.9949 -0.56899E-02 0 -1.9978 -0.52115E-02 0 -2.0005 -0.47432E-02 0 -2.0030 -0.43052E-02 0 -2.0052 -0.38672E-02 0 -2.0073 -0.34832E-02 0 -2.0090 -0.31087E-02 0 -2.0107 -0.27709E-02 0 -2.0121 -0.24778E-02 0 -2.0134 -0.21892E-02 0 -2.0146 -0.19859E-02 0 -2.0155 -0.17826E-02 0 -2.0164 -0.16358E-02 0 -2.0172 -0.15195E-02 0 -2.0179 -0.14186E-02 0 -2.0185 -0.13642E-02 0 -2.0193 -0.13385E-02 0 -2.0199 -0.13299E-02 0 -2.0206 -0.13433E-02 0 -2.0212 -0.13716E-02 0 -2.0220 -0.14078E-02 0 -2.0228 -0.14526E-02 0 -2.0234 -0.14974E-02 0 -2.0240 -0.15393E-02 0 -2.0247 -0.15806E-02 0 -2.0254 -0.16139E-02 0 -2.0262 -0.16371E-02 0 -2.0270 -0.16589E-02 0 -2.0278 -0.16551E-02 0 -2.0286 -0.16512E-02 0 -2.0294 -0.16260E-02 0 -2.0302 -0.15894E-02 0 -2.0310 -0.15431E-02 0 -2.0317 -0.14673E-02 0 -2.0324 -0.13916E-02 0 -2.0331 -0.12721E-02 0 -2.0337 -0.11449E-02 0 -2.0343 -0.98453E-03 0 -2.0348 -0.78353E-03 0 -2.0352 -0.57711E-03 0 -2.0356 -0.26751E-03 0 -2.0357 --0.42103E-04 0 -2.0358 --0.45268E-03 0 -2.0355 --0.91762E-03 0 -2.0350 --0.14238E-02 0 -2.0345 --0.20538E-02 0 -2.0340 --0.27992E-02 0 -2.0329 --0.36269E-02 0 -2.0314 --0.45863E-02 0 -2.0294 --0.56922E-02 0 -2.0270 --0.69165E-02 0 -2.0241 --0.83492E-02 0 -2.0199 --0.97819E-02 0 -2.0156 --0.11523E-01 0 -2.0099 --0.13318E-01 0 -2.0040 --0.15276E-01 0 -1.9969 --0.17433E-01 0 -1.9886 --0.19607E-01 0 -1.9801 --0.22097E-01 0 -1.9690 --0.24588E-01 0 -1.9578 --0.27259E-01 0 -1.9446 --0.30027E-01 0 -1.9303 --0.32843E-01 0 -1.9151 --0.35807E-01 0 -1.8973 --0.38771E-01 0 -1.8796 --0.41818E-01 0 -1.8587 --0.44880E-01 0 -1.8372 --0.47935E-01 0 -1.8141 --0.50985E-01 0 -1.7890 --0.54028E-01 0 -1.7637 --0.56953E-01 0 -1.7350 --0.59878E-01 0 -1.7063 --0.62651E-01 0 -1.6756 --0.65343E-01 0 -1.6438 --0.67959E-01 0 -1.6112 --0.70351E-01 0 -1.5760 --0.72658E-01 0 -1.5403 --0.74711E-01 0 -1.5032 --0.76666E-01 0 -1.4656 --0.78328E-01 0 -1.4267 --0.79883E-01 0 -1.3874 --0.81113E-01 0 -1.3470 --0.82229E-01 0 -1.3064 --0.83000E-01 0 -1.2651 --0.83652E-01 0 -1.2234 --0.83948E-01 0 -1.1805 --0.84109E-01 0 -1.1381 --0.83863E-01 0 -1.0970 --0.83616E-01 0 -1.0560 --0.82992E-01 0 -1.0149 --0.82165E-01 0 -0.97389 --0.81312E-01 0 -0.93291 --0.79968E-01 0 -0.89330 --0.78624E-01 0 -0.85369 --0.77089E-01 0 -0.81499 --0.75319E-01 0 -0.77741 --0.73550E-01 0 -0.73984 --0.71510E-01 0 -0.70440 --0.69422E-01 0 -0.66933 --0.67282E-01 0 -0.63498 --0.64988E-01 0 -0.60276 --0.62695E-01 0 -0.57053 --0.60337E-01 0 -0.54028 --0.57946E-01 0 -0.51109 --0.55554E-01 0 -0.48205 --0.53159E-01 0 -0.45595 --0.50764E-01 0 -0.42985 --0.48402E-01 0 -0.40512 --0.46080E-01 0 -0.38206 --0.43759E-01 0 -0.35900 --0.41549E-01 0 -0.33809 --0.39358E-01 0 -0.31755 --0.37223E-01 0 -0.29806 --0.35254E-01 0 -0.28171 --0.33286E-01 0 -0.26535 --0.31317E-01 0 -0.24900 --0.29424E-01 0 -0.23343 --0.27759E-01 0 -0.22021 --0.26095E-01 0 -0.20699 --0.24430E-01 0 -0.19377 --0.22843E-01 0 -0.18129 --0.21487E-01 0 -0.17106 --0.20131E-01 0 -0.16083 --0.18776E-01 0 -0.15060 --0.17491E-01 0 -0.14097 --0.16421E-01 0 -0.13315 --0.15350E-01 0 -0.12532 --0.14280E-01 0 -0.11749 --0.13270E-01 0 -0.11014 --0.12445E-01 0 -0.10420 --0.11620E-01 0 -0.98254E-01 --0.10795E-01 0 -0.92311E-01 --0.10020E-01 0 -0.86728E-01 --0.93956E-02 0 -0.82228E-01 --0.87710E-02 0 -0.77727E-01 --0.81464E-02 0 -0.73226E-01 --0.75612E-02 0 -0.68998E-01 --0.70939E-02 0 -0.65586E-01 --0.66266E-02 0 -0.62174E-01 --0.61592E-02 0 -0.58762E-01 --0.57218E-02 0 -0.55553E-01 --0.53738E-02 0 -0.52955E-01 --0.50259E-02 0 -0.50358E-01 --0.46780E-02 0 -0.47760E-01 --0.43529E-02 0 -0.45314E-01 --0.40962E-02 0 -0.43324E-01 --0.38396E-02 0 -0.41334E-01 --0.35830E-02 0 -0.39344E-01 --0.33450E-02 0 -0.37241E-01 --0.31627E-02 0 -0.34799E-01 --0.29805E-02 0 -0.32356E-01 --0.27982E-02 0 -0.29914E-01 --0.26276E-02 0 -0.28031E-01 --0.24919E-02 0 -0.27827E-01 --0.23562E-02 0 -0.27623E-01 --0.22205E-02 0 -0.27419E-01 --0.20906E-02 0 -0.27033E-01 --0.19784E-02 0 -0.26098E-01 --0.18662E-02 0 -0.25163E-01 --0.17539E-02 0 -0.24228E-01 --0.16472E-02 0 -0.23343E-01 --0.15571E-02 0 -0.22611E-01 --0.14670E-02 0 -0.21878E-01 --0.13770E-02 0 -0.21145E-01 --0.12914E-02 0 -0.20452E-01 --0.12196E-02 0 -0.19879E-01 --0.11477E-02 0 -0.19305E-01 --0.10759E-02 0 -0.18731E-01 --0.10073E-02 0 -0.18190E-01 --0.94862E-03 0 -0.17745E-01 --0.88995E-03 0 -0.17300E-01 --0.83128E-03 0 -0.16855E-01 --0.77503E-03 0 -0.16437E-01 --0.72602E-03 0 -0.16098E-01 --0.67701E-03 0 -0.15759E-01 --0.62800E-03 0 -0.15420E-01 --0.58070E-03 0 -0.15103E-01 --0.53855E-03 0 -0.14854E-01 --0.49640E-03 0 -0.14604E-01 --0.45425E-03 0 -0.14355E-01 --0.41328E-03 0 -0.14125E-01 --0.37581E-03 0 -0.13955E-01 --0.33835E-03 0 -0.13784E-01 --0.30088E-03 0 -0.13613E-01 --0.26415E-03 0 -0.13459E-01 --0.22960E-03 0 -0.13359E-01 --0.19505E-03 0 -0.13259E-01 --0.16050E-03 0 -0.13159E-01 --0.12631E-03 0 -0.13076E-01 --0.93186E-04 0 -0.13043E-01 --0.60060E-04 0 -0.13009E-01 --0.26934E-04 0 -0.12976E-01 -0.84439E-01 0 -1.1506 -0.83016E-01 0 -1.1847 -0.81372E-01 0 -1.2175 -0.79631E-01 0 -1.2498 -0.77759E-01 0 -1.2812 -0.75763E-01 0 -1.3119 -0.73706E-01 0 -1.3419 -0.71528E-01 0 -1.3708 -0.69336E-01 0 -1.3993 -0.67063E-01 0 -1.4262 -0.64790E-01 0 -1.4530 -0.62501E-01 0 -1.4779 -0.60212E-01 0 -1.5028 -0.57962E-01 0 -1.5261 -0.55723E-01 0 -1.5489 -0.53544E-01 0 -1.5706 -0.51403E-01 0 -1.5916 -0.49318E-01 0 -1.6117 -0.47308E-01 0 -1.6309 -0.45334E-01 0 -1.6496 -0.43472E-01 0 -1.6670 -0.41619E-01 0 -1.6843 -0.39908E-01 0 -1.7002 -0.38198E-01 0 -1.7161 -0.36618E-01 0 -1.7307 -0.35056E-01 0 -1.7452 -0.33593E-01 0 -1.7588 -0.32173E-01 0 -1.7719 -0.30821E-01 0 -1.7845 -0.29534E-01 0 -1.7965 -0.28288E-01 0 -1.8081 -0.27125E-01 0 -1.8190 -0.25981E-01 0 -1.8298 -0.24935E-01 0 -1.8398 -0.23890E-01 0 -1.8497 -0.22951E-01 0 -1.8588 -0.22015E-01 0 -1.8679 -0.21160E-01 0 -1.8764 -0.20325E-01 0 -1.8848 -0.19546E-01 0 -1.8927 -0.18802E-01 0 -1.9003 -0.18092E-01 0 -1.9077 -0.17426E-01 0 -1.9148 -0.16772E-01 0 -1.9218 -0.16150E-01 0 -1.9283 -0.15544E-01 0 -1.9345 -0.14947E-01 0 -1.9407 -0.14360E-01 0 -1.9465 -0.13778E-01 0 -1.9521 -0.13195E-01 0 -1.9574 -0.12609E-01 0 -1.9626 -0.12023E-01 0 -1.9677 -0.11423E-01 0 -1.9723 -0.10820E-01 0 -1.9768 -0.10208E-01 0 -1.9811 -0.95872E-02 0 -1.9850 -0.89657E-02 0 -1.9889 -0.83394E-02 0 -1.9922 -0.77131E-02 0 -1.9955 -0.70994E-02 0 -1.9984 -0.64925E-02 0 -2.0011 -0.58983E-02 0 -2.0036 -0.53419E-02 0 -2.0057 -0.47855E-02 0 -2.0078 -0.42981E-02 0 -2.0095 -0.38228E-02 0 -2.0111 -0.33947E-02 0 -2.0125 -0.30243E-02 0 -2.0137 -0.26596E-02 0 -2.0149 -0.24051E-02 0 -2.0158 -0.21505E-02 0 -2.0166 -0.19689E-02 0 -2.0174 -0.18265E-02 0 -2.0180 -0.17041E-02 0 -2.0186 -0.16412E-02 0 -2.0193 -0.16151E-02 0 -2.0199 -0.16105E-02 0 -2.0205 -0.16338E-02 0 -2.0212 -0.16756E-02 0 -2.0219 -0.17269E-02 0 -2.0227 -0.17882E-02 0 -2.0233 -0.18494E-02 0 -2.0239 -0.19054E-02 0 -2.0246 -0.19604E-02 0 -2.0254 -0.20044E-02 0 -2.0262 -0.20348E-02 0 -2.0270 -0.20634E-02 0 -2.0278 -0.20588E-02 0 -2.0286 -0.20542E-02 0 -2.0294 -0.20233E-02 0 -2.0302 -0.19782E-02 0 -2.0310 -0.19214E-02 0 -2.0318 -0.18295E-02 0 -2.0325 -0.17375E-02 0 -2.0333 -0.15940E-02 0 -2.0339 -0.14413E-02 0 -2.0345 -0.12491E-02 0 -2.0351 -0.10086E-02 0 -2.0355 -0.76159E-03 0 -2.0359 -0.38969E-03 0 -2.0361 -0.17786E-04 0 -2.0363 --0.47823E-03 0 -2.0361 --0.10411E-02 0 -2.0356 --0.16552E-02 0 -2.0352 --0.24231E-02 0 -2.0348 --0.33354E-02 0 -2.0338 --0.43511E-02 0 -2.0325 --0.55325E-02 0 -2.0306 --0.68987E-02 0 -2.0285 --0.84147E-02 0 -2.0257 --0.10195E-01 0 -2.0217 --0.11975E-01 0 -2.0176 --0.14146E-01 0 -2.0121 --0.16386E-01 0 -2.0063 --0.18834E-01 0 -1.9995 --0.21535E-01 0 -1.9913 --0.24258E-01 0 -1.9830 --0.27384E-01 0 -1.9721 --0.30511E-01 0 -1.9611 --0.33866E-01 0 -1.9480 --0.37346E-01 0 -1.9338 --0.40888E-01 0 -1.9188 --0.44617E-01 0 -1.9011 --0.48346E-01 0 -1.8833 --0.52181E-01 0 -1.8625 --0.56034E-01 0 -1.8411 --0.59881E-01 0 -1.8180 --0.63719E-01 0 -1.7928 --0.67549E-01 0 -1.7675 --0.71229E-01 0 -1.7387 --0.74910E-01 0 -1.7098 --0.78398E-01 0 -1.6790 --0.81784E-01 0 -1.6471 --0.85075E-01 0 -1.6143 --0.88081E-01 0 -1.5789 --0.90980E-01 0 -1.5430 --0.93560E-01 0 -1.5057 --0.96016E-01 0 -1.4679 --0.98102E-01 0 -1.4287 --0.10005 0 -1.3891 --0.10160 0 -1.3485 --0.10299 0 -1.3076 --0.10396 0 -1.2659 --0.10477 0 -1.2239 --0.10513 0 -1.1807 --0.10533 0 -1.1380 --0.10501 0 -1.0967 --0.10469 0 -1.0554 --0.10389 0 -1.0141 --0.10284 0 -0.97276 --0.10175 0 -0.93152 --0.10005 0 -0.89168 --0.98347E-01 0 -0.85184 --0.96404E-01 0 -0.81294 --0.94167E-01 0 -0.77519 --0.91931E-01 0 -0.73743 --0.89357E-01 0 -0.70186 --0.86723E-01 0 -0.66667 --0.84026E-01 0 -0.63221 --0.81138E-01 0 -0.59991 --0.78251E-01 0 -0.56762 --0.75287E-01 0 -0.53733 --0.72281E-01 0 -0.50811 --0.69276E-01 0 -0.47906 --0.66272E-01 0 -0.45297 --0.63269E-01 0 -0.42689 --0.60309E-01 0 -0.40219 --0.57402E-01 0 -0.37919 --0.54496E-01 0 -0.35618 --0.51733E-01 0 -0.33534 --0.48995E-01 0 -0.31489 --0.46327E-01 0 -0.29548 --0.43870E-01 0 -0.27921 --0.41413E-01 0 -0.26294 --0.38957E-01 0 -0.24667 --0.36596E-01 0 -0.23119 --0.34523E-01 0 -0.21806 --0.32449E-01 0 -0.20494 --0.30376E-01 0 -0.19182 --0.28400E-01 0 -0.17944 --0.26714E-01 0 -0.16930 --0.25029E-01 0 -0.15916 --0.23343E-01 0 -0.14903 --0.21747E-01 0 -0.13949 --0.20417E-01 0 -0.13174 --0.19088E-01 0 -0.12400 --0.17759E-01 0 -0.11626 --0.16506E-01 0 -0.10898 --0.15483E-01 0 -0.10311 --0.14459E-01 0 -0.97234E-01 --0.13436E-01 0 -0.91360E-01 --0.12475E-01 0 -0.85844E-01 --0.11701E-01 0 -0.81399E-01 --0.10927E-01 0 -0.76953E-01 --0.10153E-01 0 -0.72508E-01 --0.94277E-02 0 -0.68332E-01 --0.88485E-02 0 -0.64963E-01 --0.82694E-02 0 -0.61594E-01 --0.76902E-02 0 -0.58225E-01 --0.71480E-02 0 -0.55057E-01 --0.67168E-02 0 -0.52491E-01 --0.62856E-02 0 -0.49926E-01 --0.58543E-02 0 -0.47361E-01 --0.54511E-02 0 -0.44945E-01 --0.51320E-02 0 -0.42980E-01 --0.48128E-02 0 -0.41015E-01 --0.44937E-02 0 -0.39049E-01 --0.41957E-02 0 -0.36970E-01 --0.39614E-02 0 -0.34548E-01 --0.37271E-02 0 -0.32126E-01 --0.34928E-02 0 -0.29704E-01 --0.32732E-02 0 -0.27839E-01 --0.30980E-02 0 -0.27644E-01 --0.29227E-02 0 -0.27449E-01 --0.27474E-02 0 -0.27254E-01 --0.25812E-02 0 -0.26877E-01 --0.24422E-02 0 -0.25950E-01 --0.23032E-02 0 -0.25023E-01 --0.21642E-02 0 -0.24097E-01 --0.20322E-02 0 -0.23220E-01 --0.19213E-02 0 -0.22493E-01 --0.18104E-02 0 -0.21767E-01 --0.16995E-02 0 -0.21041E-01 --0.15941E-02 0 -0.20354E-01 --0.15055E-02 0 -0.19785E-01 --0.14168E-02 0 -0.19216E-01 --0.13282E-02 0 -0.18647E-01 --0.12436E-02 0 -0.18110E-01 --0.11712E-02 0 -0.17669E-01 --0.10989E-02 0 -0.17227E-01 --0.10265E-02 0 -0.16786E-01 --0.95714E-03 0 -0.16371E-01 --0.89665E-03 0 -0.16034E-01 --0.83617E-03 0 -0.15698E-01 --0.77569E-03 0 -0.15361E-01 --0.71732E-03 0 -0.15047E-01 --0.66528E-03 0 -0.14800E-01 --0.61324E-03 0 -0.14552E-01 --0.56120E-03 0 -0.14305E-01 --0.51060E-03 0 -0.14077E-01 --0.46433E-03 0 -0.13907E-01 --0.41805E-03 0 -0.13737E-01 --0.37178E-03 0 -0.13567E-01 --0.32640E-03 0 -0.13415E-01 --0.28371E-03 0 -0.13316E-01 --0.24103E-03 0 -0.13216E-01 --0.19834E-03 0 -0.13117E-01 --0.15610E-03 0 -0.13034E-01 --0.11516E-03 0 -0.13001E-01 --0.74224E-04 0 -0.12968E-01 --0.33288E-04 0 -0.12935E-01 -0.10127 0 -1.1519 -0.99596E-01 0 -1.1862 -0.97642E-01 0 -1.2192 -0.95562E-01 0 -1.2516 -0.93315E-01 0 -1.2831 -0.90908E-01 0 -1.3139 -0.88427E-01 0 -1.3440 -0.85800E-01 0 -1.3729 -0.83156E-01 0 -1.4015 -0.80416E-01 0 -1.4284 -0.77676E-01 0 -1.4553 -0.74920E-01 0 -1.4802 -0.72164E-01 0 -1.5050 -0.69457E-01 0 -1.5283 -0.66764E-01 0 -1.5511 -0.64145E-01 0 -1.5728 -0.61575E-01 0 -1.5937 -0.59072E-01 0 -1.6138 -0.56661E-01 0 -1.6328 -0.54294E-01 0 -1.6515 -0.52062E-01 0 -1.6689 -0.49841E-01 0 -1.6861 -0.47793E-01 0 -1.7019 -0.45744E-01 0 -1.7178 -0.43854E-01 0 -1.7323 -0.41984E-01 0 -1.7467 -0.40233E-01 0 -1.7602 -0.38533E-01 0 -1.7733 -0.36915E-01 0 -1.7858 -0.35374E-01 0 -1.7977 -0.33883E-01 0 -1.8093 -0.32491E-01 0 -1.8202 -0.31121E-01 0 -1.8309 -0.29869E-01 0 -1.8408 -0.28617E-01 0 -1.8507 -0.27494E-01 0 -1.8598 -0.26374E-01 0 -1.8688 -0.25350E-01 0 -1.8773 -0.24352E-01 0 -1.8856 -0.23420E-01 0 -1.8934 -0.22530E-01 0 -1.9010 -0.21683E-01 0 -1.9084 -0.20892E-01 0 -1.9155 -0.20114E-01 0 -1.9224 -0.19373E-01 0 -1.9289 -0.18650E-01 0 -1.9351 -0.17937E-01 0 -1.9413 -0.17237E-01 0 -1.9471 -0.16542E-01 0 -1.9526 -0.15847E-01 0 -1.9580 -0.15146E-01 0 -1.9632 -0.14445E-01 0 -1.9683 -0.13724E-01 0 -1.9729 -0.13000E-01 0 -1.9774 -0.12265E-01 0 -1.9817 -0.11516E-01 0 -1.9856 -0.10767E-01 0 -1.9895 -0.10009E-01 0 -1.9928 -0.92519E-02 0 -1.9961 -0.85089E-02 0 -1.9990 -0.77735E-02 0 -2.0017 -0.70533E-02 0 -2.0042 -0.63785E-02 0 -2.0063 -0.57037E-02 0 -2.0084 -0.51129E-02 0 -2.0100 -0.45369E-02 0 -2.0116 -0.40186E-02 0 -2.0129 -0.35708E-02 0 -2.0141 -0.31300E-02 0 -2.0152 -0.28242E-02 0 -2.0160 -0.25185E-02 0 -2.0169 -0.23020E-02 0 -2.0175 -0.21336E-02 0 -2.0181 -0.19895E-02 0 -2.0187 -0.19182E-02 0 -2.0194 -0.18916E-02 0 -2.0200 -0.18912E-02 0 -2.0205 -0.19244E-02 0 -2.0211 -0.19796E-02 0 -2.0219 -0.20460E-02 0 -2.0226 -0.21237E-02 0 -2.0232 -0.22014E-02 0 -2.0238 -0.22715E-02 0 -2.0246 -0.23402E-02 0 -2.0253 -0.23949E-02 0 -2.0261 -0.24324E-02 0 -2.0270 -0.24679E-02 0 -2.0278 -0.24626E-02 0 -2.0286 -0.24573E-02 0 -2.0294 -0.24206E-02 0 -2.0303 -0.23670E-02 0 -2.0311 -0.22998E-02 0 -2.0319 -0.21916E-02 0 -2.0326 -0.20835E-02 0 -2.0334 -0.19158E-02 0 -2.0340 -0.17377E-02 0 -2.0347 -0.15137E-02 0 -2.0353 -0.12338E-02 0 -2.0358 -0.94606E-03 0 -2.0362 -0.51187E-03 0 -2.0365 -0.77676E-04 0 -2.0367 --0.50378E-03 0 -2.0366 --0.11645E-02 0 -2.0362 --0.18865E-02 0 -2.0359 --0.27924E-02 0 -2.0356 --0.38717E-02 0 -2.0348 --0.50754E-02 0 -2.0336 --0.64787E-02 0 -2.0319 --0.81053E-02 0 -2.0299 --0.99129E-02 0 -2.0273 --0.12040E-01 0 -2.0235 --0.14168E-01 0 -2.0196 --0.16770E-01 0 -2.0143 --0.19455E-01 0 -2.0087 --0.22393E-01 0 -2.0020 --0.25638E-01 0 -1.9941 --0.28909E-01 0 -1.9860 --0.32671E-01 0 -1.9752 --0.36433E-01 0 -1.9644 --0.40474E-01 0 -1.9514 --0.44665E-01 0 -1.9374 --0.48932E-01 0 -1.9224 --0.53426E-01 0 -1.9048 --0.57921E-01 0 -1.8871 --0.62544E-01 0 -1.8663 --0.67189E-01 0 -1.8449 --0.71826E-01 0 -1.8218 --0.76452E-01 0 -1.7966 --0.81070E-01 0 -1.7712 --0.85506E-01 0 -1.7423 --0.89942E-01 0 -1.7134 --0.94146E-01 0 -1.6824 --0.98225E-01 0 -1.6504 --0.10219 0 -1.6174 --0.10581 0 -1.5818 --0.10930 0 -1.5457 --0.11241 0 -1.5082 --0.11537 0 -1.4701 --0.11788 0 -1.4307 --0.12022 0 -1.3908 --0.12208 0 -1.3499 --0.12376 0 -1.3087 --0.12491 0 -1.2668 --0.12588 0 -1.2245 --0.12632 0 -1.1810 --0.12654 0 -1.1380 --0.12615 0 -1.0964 --0.12575 0 -1.0548 --0.12479 0 -1.0132 --0.12351 0 -0.97162 --0.12219 0 -0.93012 --0.12013 0 -0.89006 --0.11807 0 -0.84999 --0.11572 0 -0.81089 --0.11302 0 -0.77296 --0.11031 0 -0.73503 --0.10720 0 -0.69932 --0.10402 0 -0.66401 --0.10077 0 -0.62943 --0.97288E-01 0 -0.59707 --0.93806E-01 0 -0.56470 --0.90236E-01 0 -0.53437 --0.86617E-01 0 -0.50514 --0.82999E-01 0 -0.47606 --0.79386E-01 0 -0.45000 --0.75774E-01 0 -0.42393 --0.72216E-01 0 -0.39927 --0.68725E-01 0 -0.37631 --0.65233E-01 0 -0.35336 --0.61917E-01 0 -0.33260 --0.58631E-01 0 -0.31222 --0.55431E-01 0 -0.29290 --0.52486E-01 0 -0.27671 --0.49541E-01 0 -0.26053 --0.46597E-01 0 -0.24434 --0.43768E-01 0 -0.22895 --0.41286E-01 0 -0.21592 --0.38804E-01 0 -0.20289 --0.36323E-01 0 -0.18987 --0.33957E-01 0 -0.17758 --0.31942E-01 0 -0.16754 --0.29926E-01 0 -0.15749 --0.27911E-01 0 -0.14745 --0.26002E-01 0 -0.13800 --0.24414E-01 0 -0.13034 --0.22826E-01 0 -0.12268 --0.21238E-01 0 -0.11502 --0.19742E-01 0 -0.10782 --0.18520E-01 0 -0.10202 --0.17299E-01 0 -0.96214E-01 --0.16077E-01 0 -0.90410E-01 --0.14930E-01 0 -0.84959E-01 --0.14007E-01 0 -0.80570E-01 --0.13083E-01 0 -0.76180E-01 --0.12160E-01 0 -0.71790E-01 --0.11294E-01 0 -0.67666E-01 --0.10603E-01 0 -0.64340E-01 --0.99122E-02 0 -0.61014E-01 --0.92212E-02 0 -0.57688E-01 --0.85743E-02 0 -0.54560E-01 --0.80598E-02 0 -0.52027E-01 --0.75452E-02 0 -0.49494E-01 --0.70307E-02 0 -0.46961E-01 --0.65493E-02 0 -0.44577E-01 --0.61677E-02 0 -0.42636E-01 --0.57860E-02 0 -0.40695E-01 --0.54043E-02 0 -0.38754E-01 --0.50465E-02 0 -0.36698E-01 --0.47601E-02 0 -0.34297E-01 --0.44737E-02 0 -0.31895E-01 --0.41874E-02 0 -0.29494E-01 --0.39189E-02 0 -0.27646E-01 --0.37040E-02 0 -0.27461E-01 --0.34892E-02 0 -0.27275E-01 --0.32744E-02 0 -0.27089E-01 --0.30718E-02 0 -0.26721E-01 --0.29060E-02 0 -0.25802E-01 --0.27402E-02 0 -0.24884E-01 --0.25744E-02 0 -0.23965E-01 --0.24172E-02 0 -0.23096E-01 --0.22854E-02 0 -0.22376E-01 --0.21537E-02 0 -0.21656E-01 --0.20219E-02 0 -0.20936E-01 --0.18968E-02 0 -0.20255E-01 --0.17913E-02 0 -0.19691E-01 --0.16859E-02 0 -0.19127E-01 --0.15805E-02 0 -0.18563E-01 --0.14799E-02 0 -0.18030E-01 --0.13938E-02 0 -0.17593E-01 --0.13078E-02 0 -0.17155E-01 --0.12218E-02 0 -0.16717E-01 --0.11392E-02 0 -0.16305E-01 --0.10673E-02 0 -0.15971E-01 --0.99534E-03 0 -0.15637E-01 --0.92338E-03 0 -0.15303E-01 --0.85393E-03 0 -0.14991E-01 --0.79200E-03 0 -0.14745E-01 --0.73008E-03 0 -0.14500E-01 --0.66815E-03 0 -0.14254E-01 --0.60793E-03 0 -0.14028E-01 --0.55284E-03 0 -0.13859E-01 --0.49776E-03 0 -0.13690E-01 --0.44267E-03 0 -0.13522E-01 --0.38865E-03 0 -0.13371E-01 --0.33783E-03 0 -0.13272E-01 --0.28701E-03 0 -0.13173E-01 --0.23618E-03 0 -0.13074E-01 --0.18588E-03 0 -0.12992E-01 --0.13713E-03 0 -0.12959E-01 --0.88388E-04 0 -0.12927E-01 --0.39642E-04 0 -0.12894E-01 -0.12259 0 -1.1558 -0.12129 0 -1.1887 -0.11912 0 -1.2214 -0.11658 0 -1.2541 -0.11383 0 -1.2858 -0.11087 0 -1.3167 -0.10782 0 -1.3470 -0.10459 0 -1.3760 -0.10134 0 -1.4046 -0.97972E-01 0 -1.4315 -0.94608E-01 0 -1.4584 -0.91233E-01 0 -1.4833 -0.87857E-01 0 -1.5082 -0.84550E-01 0 -1.5314 -0.81263E-01 0 -1.5541 -0.78071E-01 0 -1.5757 -0.74943E-01 0 -1.5965 -0.71901E-01 0 -1.6166 -0.68976E-01 0 -1.6355 -0.66106E-01 0 -1.6541 -0.63404E-01 0 -1.6714 -0.60716E-01 0 -1.6885 -0.58239E-01 0 -1.7042 -0.55763E-01 0 -1.7200 -0.53476E-01 0 -1.7344 -0.51216E-01 0 -1.7487 -0.49097E-01 0 -1.7621 -0.47038E-01 0 -1.7752 -0.45077E-01 0 -1.7876 -0.43207E-01 0 -1.7994 -0.41396E-01 0 -1.8109 -0.39703E-01 0 -1.8217 -0.38036E-01 0 -1.8323 -0.36511E-01 0 -1.8422 -0.34986E-01 0 -1.8520 -0.33618E-01 0 -1.8610 -0.32254E-01 0 -1.8700 -0.31010E-01 0 -1.8784 -0.29796E-01 0 -1.8866 -0.28665E-01 0 -1.8944 -0.27586E-01 0 -1.9020 -0.26432E-01 0 -1.9091 -0.25176E-01 0 -1.9157 -0.23912E-01 0 -1.9224 -0.22623E-01 0 -1.9295 -0.21682E-01 0 -1.9360 -0.20862E-01 0 -1.9421 -0.20059E-01 0 -1.9479 -0.19261E-01 0 -1.9534 -0.18461E-01 0 -1.9588 -0.17653E-01 0 -1.9640 -0.16844E-01 0 -1.9691 -0.16006E-01 0 -1.9738 -0.15164E-01 0 -1.9783 -0.14305E-01 0 -1.9826 -0.13427E-01 0 -1.9865 -0.12548E-01 0 -1.9904 -0.11654E-01 0 -1.9937 -0.10761E-01 0 -1.9970 -0.98816E-02 0 -1.9999 -0.90103E-02 0 -2.0025 -0.81568E-02 0 -2.0050 -0.73565E-02 0 -2.0071 -0.65561E-02 0 -2.0091 -0.58570E-02 0 -2.0107 -0.51757E-02 0 -2.0122 -0.45647E-02 0 -2.0135 -0.40394E-02 0 -2.0146 -0.35228E-02 0 -2.0156 -0.31710E-02 0 -2.0164 -0.28192E-02 0 -2.0172 -0.25763E-02 0 -2.0178 -0.23921E-02 0 -2.0183 -0.22372E-02 0 -2.0188 -0.21707E-02 0 -2.0194 -0.21580E-02 0 -2.0200 -0.21764E-02 0 -2.0205 -0.22347E-02 0 -2.0211 -0.23184E-02 0 -2.0218 -0.24144E-02 0 -2.0225 -0.25219E-02 0 -2.0231 -0.26294E-02 0 -2.0237 -0.27245E-02 0 -2.0245 -0.28173E-02 0 -2.0253 -0.28919E-02 0 -2.0261 -0.29441E-02 0 -2.0269 -0.29938E-02 0 -2.0278 -0.29934E-02 0 -2.0286 -0.29930E-02 0 -2.0295 -0.29561E-02 0 -2.0303 -0.28996E-02 0 -2.0311 -0.28280E-02 0 -2.0320 -0.27113E-02 0 -2.0327 -0.25945E-02 0 -2.0335 -0.24138E-02 0 -2.0342 -0.22218E-02 0 -2.0349 -0.19798E-02 0 -2.0355 -0.16769E-02 0 -2.0361 -0.13653E-02 0 -2.0366 -0.89002E-03 0 -2.0370 -0.41470E-03 0 -2.0373 --0.22915E-03 0 -2.0373 --0.96375E-03 0 -2.0370 --0.17696E-02 0 -2.0368 --0.27891E-02 0 -2.0368 --0.40123E-02 0 -2.0361 --0.53821E-02 0 -2.0351 --0.69877E-02 0 -2.0336 --0.88587E-02 0 -2.0319 --0.10945E-01 0 -2.0296 --0.13414E-01 0 -2.0260 --0.15882E-01 0 -2.0224 --0.18920E-01 0 -2.0173 --0.22058E-01 0 -2.0120 --0.25498E-01 0 -2.0056 --0.29310E-01 0 -1.9980 --0.33152E-01 0 -1.9901 --0.37587E-01 0 -1.9795 --0.42021E-01 0 -1.9690 --0.46793E-01 0 -1.9562 --0.51747E-01 0 -1.9424 --0.56793E-01 0 -1.9276 --0.62116E-01 0 -1.9101 --0.67439E-01 0 -1.8925 --0.72919E-01 0 -1.8718 --0.78428E-01 0 -1.8504 --0.83930E-01 0 -1.8273 --0.89423E-01 0 -1.8020 --0.94905E-01 0 -1.7766 --0.10018 0 -1.7475 --0.10545 0 -1.7185 --0.11045 0 -1.6873 --0.11530 0 -1.6550 --0.12002 0 -1.6219 --0.12434 0 -1.5860 --0.12850 0 -1.5496 --0.13221 0 -1.5117 --0.13574 0 -1.4733 --0.13874 0 -1.4335 --0.14155 0 -1.3933 --0.14377 0 -1.3520 --0.14579 0 -1.3104 --0.14718 0 -1.2680 --0.14835 0 -1.2253 --0.14887 0 -1.1814 --0.14915 0 -1.1379 --0.14869 0 -1.0959 --0.14822 0 -1.0539 --0.14707 0 -1.0119 --0.14554 0 -0.96998 --0.14397 0 -0.92811 --0.14150 0 -0.88772 --0.13904 0 -0.84734 --0.13622 0 -0.80794 --0.13299 0 -0.76976 --0.12975 0 -0.73158 --0.12604 0 -0.69569 --0.12224 0 -0.66021 --0.11835 0 -0.62548 --0.11420 0 -0.59302 --0.11005 0 -0.56056 --0.10580 0 -0.53018 --0.10149 0 -0.50091 --0.97184E-01 0 -0.47181 --0.92897E-01 0 -0.44578 --0.88609E-01 0 -0.41975 --0.84391E-01 0 -0.39514 --0.80258E-01 0 -0.37226 --0.76124E-01 0 -0.34938 --0.72206E-01 0 -0.32873 --0.68326E-01 0 -0.30848 --0.64549E-01 0 -0.28927 --0.61082E-01 0 -0.27321 --0.57614E-01 0 -0.25715 --0.54146E-01 0 -0.24109 --0.50818E-01 0 -0.22582 --0.47905E-01 0 -0.21293 --0.44993E-01 0 -0.20004 --0.42081E-01 0 -0.18715 --0.39308E-01 0 -0.17500 --0.36951E-01 0 -0.16509 --0.34594E-01 0 -0.15517 --0.32236E-01 0 -0.14526 --0.30006E-01 0 -0.13594 --0.28156E-01 0 -0.12839 --0.26305E-01 0 -0.12085 --0.24455E-01 0 -0.11330 --0.22712E-01 0 -0.10622 --0.21294E-01 0 -0.10051 --0.19875E-01 0 -0.94805E-01 --0.18457E-01 0 -0.89097E-01 --0.17126E-01 0 -0.83738E-01 --0.16057E-01 0 -0.79426E-01 --0.14988E-01 0 -0.75113E-01 --0.13919E-01 0 -0.70800E-01 --0.12918E-01 0 -0.66749E-01 --0.12120E-01 0 -0.63482E-01 --0.11322E-01 0 -0.60215E-01 --0.10525E-01 0 -0.56948E-01 --0.97784E-02 0 -0.53876E-01 --0.91858E-02 0 -0.51387E-01 --0.85931E-02 0 -0.48899E-01 --0.80005E-02 0 -0.46411E-01 --0.74462E-02 0 -0.44068E-01 --0.70067E-02 0 -0.42160E-01 --0.65672E-02 0 -0.40251E-01 --0.61278E-02 0 -0.38343E-01 --0.57212E-02 0 -0.36319E-01 --0.54134E-02 0 -0.33945E-01 --0.51056E-02 0 -0.31571E-01 --0.47978E-02 0 -0.29197E-01 --0.45093E-02 0 -0.27373E-01 --0.42791E-02 0 -0.27201E-01 --0.40488E-02 0 -0.27029E-01 --0.38185E-02 0 -0.26857E-01 --0.35972E-02 0 -0.26502E-01 --0.34027E-02 0 -0.25596E-01 --0.32081E-02 0 -0.24690E-01 --0.30136E-02 0 -0.23784E-01 --0.28292E-02 0 -0.22926E-01 --0.26753E-02 0 -0.22215E-01 --0.25213E-02 0 -0.21503E-01 --0.23674E-02 0 -0.20792E-01 --0.22211E-02 0 -0.20119E-01 --0.20978E-02 0 -0.19562E-01 --0.19746E-02 0 -0.19005E-01 --0.18513E-02 0 -0.18447E-01 --0.17337E-02 0 -0.17921E-01 --0.16331E-02 0 -0.17488E-01 --0.15324E-02 0 -0.17055E-01 --0.14318E-02 0 -0.16622E-01 --0.13352E-02 0 -0.16214E-01 --0.12510E-02 0 -0.15884E-01 --0.11668E-02 0 -0.15553E-01 --0.10825E-02 0 -0.15223E-01 --0.10012E-02 0 -0.14914E-01 --0.92868E-03 0 -0.14671E-01 --0.85613E-03 0 -0.14428E-01 --0.78357E-03 0 -0.14184E-01 --0.71301E-03 0 -0.13960E-01 --0.64843E-03 0 -0.13793E-01 --0.58385E-03 0 -0.13626E-01 --0.51927E-03 0 -0.13459E-01 --0.45594E-03 0 -0.13309E-01 --0.39632E-03 0 -0.13212E-01 --0.33671E-03 0 -0.13114E-01 --0.27710E-03 0 -0.13016E-01 --0.21809E-03 0 -0.12536E-01 --0.16090E-03 0 -0.10909E-01 --0.10371E-03 0 -0.92819E-02 --0.46518E-04 0 -0.76550E-02 -0.14391 0 -1.1596 -0.14298 0 -1.1913 -0.14061 0 -1.2237 -0.13760 0 -1.2566 -0.13434 0 -1.2885 -0.13083 0 -1.3195 -0.12721 0 -1.3499 -0.12337 0 -1.3790 -0.11952 0 -1.4077 -0.11553 0 -1.4347 -0.11154 0 -1.4616 -0.10755 0 -1.4865 -0.10355 0 -1.5113 -0.99644E-01 0 -1.5344 -0.95761E-01 0 -1.5572 -0.91998E-01 0 -1.5787 -0.88312E-01 0 -1.5994 -0.84731E-01 0 -1.6193 -0.81291E-01 0 -1.6382 -0.77917E-01 0 -1.6567 -0.74746E-01 0 -1.6739 -0.71591E-01 0 -1.6909 -0.68686E-01 0 -1.7065 -0.65781E-01 0 -1.7222 -0.63099E-01 0 -1.7365 -0.60448E-01 0 -1.7508 -0.57960E-01 0 -1.7641 -0.55543E-01 0 -1.7770 -0.53239E-01 0 -1.7893 -0.51039E-01 0 -1.8011 -0.48909E-01 0 -1.8125 -0.46914E-01 0 -1.8232 -0.44951E-01 0 -1.8338 -0.43153E-01 0 -1.8436 -0.41355E-01 0 -1.8533 -0.39743E-01 0 -1.8623 -0.38135E-01 0 -1.8712 -0.36669E-01 0 -1.8795 -0.35240E-01 0 -1.8877 -0.33910E-01 0 -1.8954 -0.32643E-01 0 -1.9029 -0.31180E-01 0 -1.9098 -0.29460E-01 0 -1.9159 -0.27711E-01 0 -1.9224 -0.25872E-01 0 -1.9302 -0.24713E-01 0 -1.9368 -0.23787E-01 0 -1.9429 -0.22881E-01 0 -1.9487 -0.21980E-01 0 -1.9542 -0.21076E-01 0 -1.9596 -0.20159E-01 0 -1.9648 -0.19242E-01 0 -1.9700 -0.18288E-01 0 -1.9746 -0.17327E-01 0 -1.9791 -0.16346E-01 0 -1.9834 -0.15338E-01 0 -1.9874 -0.14330E-01 0 -1.9913 -0.13300E-01 0 -1.9946 -0.12269E-01 0 -1.9979 -0.11254E-01 0 -2.0007 -0.10247E-01 0 -2.0034 -0.92602E-02 0 -2.0059 -0.83344E-02 0 -2.0079 -0.74085E-02 0 -2.0099 -0.66011E-02 0 -2.0114 -0.58146E-02 0 -2.0129 -0.51108E-02 0 -2.0141 -0.45081E-02 0 -2.0151 -0.39156E-02 0 -2.0161 -0.35178E-02 0 -2.0168 -0.31200E-02 0 -2.0175 -0.28506E-02 0 -2.0180 -0.26505E-02 0 -2.0184 -0.24850E-02 0 -2.0189 -0.24233E-02 0 -2.0195 -0.24243E-02 0 -2.0200 -0.24617E-02 0 -2.0205 -0.25451E-02 0 -2.0210 -0.26572E-02 0 -2.0217 -0.27828E-02 0 -2.0224 -0.29201E-02 0 -2.0230 -0.30574E-02 0 -2.0236 -0.31774E-02 0 -2.0244 -0.32944E-02 0 -2.0252 -0.33889E-02 0 -2.0260 -0.34558E-02 0 -2.0269 -0.35197E-02 0 -2.0277 -0.35242E-02 0 -2.0286 -0.35287E-02 0 -2.0295 -0.34916E-02 0 -2.0304 -0.34321E-02 0 -2.0312 -0.33562E-02 0 -2.0321 -0.32309E-02 0 -2.0329 -0.31056E-02 0 -2.0337 -0.29117E-02 0 -2.0344 -0.27058E-02 0 -2.0351 -0.24459E-02 0 -2.0358 -0.21200E-02 0 -2.0364 -0.17846E-02 0 -2.0370 -0.12682E-02 0 -2.0374 -0.75173E-03 0 -2.0379 -0.45473E-04 0 -2.0379 --0.76299E-03 0 -2.0378 --0.16526E-02 0 -2.0378 --0.27858E-02 0 -2.0379 --0.41529E-02 0 -2.0374 --0.56887E-02 0 -2.0366 --0.74968E-02 0 -2.0354 --0.96122E-02 0 -2.0338 --0.11978E-01 0 -2.0318 --0.14788E-01 0 -2.0285 --0.17597E-01 0 -2.0251 --0.21070E-01 0 -2.0204 --0.24660E-01 0 -2.0153 --0.28604E-01 0 -2.0092 --0.32982E-01 0 -2.0018 --0.37395E-01 0 -1.9943 --0.42502E-01 0 -1.9839 --0.47610E-01 0 -1.9736 --0.53113E-01 0 -1.9611 --0.58829E-01 0 -1.9474 --0.64654E-01 0 -1.9327 --0.70805E-01 0 -1.9153 --0.76956E-01 0 -1.8979 --0.83295E-01 0 -1.8772 --0.89668E-01 0 -1.8559 --0.96034E-01 0 -1.8328 --0.10239 0 -1.8075 --0.10874 0 -1.7820 --0.11485 0 -1.7528 --0.12096 0 -1.7236 --0.12675 0 -1.6922 --0.13238 0 -1.6597 --0.13786 0 -1.6263 --0.14287 0 -1.5902 --0.14770 0 -1.5535 --0.15201 0 -1.5153 --0.15611 0 -1.4765 --0.15961 0 -1.4363 --0.16288 0 -1.3957 --0.16547 0 -1.3540 --0.16782 0 -1.3120 --0.16944 0 -1.2693 --0.17081 0 -1.2261 --0.17143 0 -1.1817 --0.17176 0 -1.1378 --0.17123 0 -1.0954 --0.17069 0 -1.0530 --0.16935 0 -1.0107 --0.16758 0 -0.96834 --0.16575 0 -0.92609 --0.16288 0 -0.88539 --0.16000 0 -0.84468 --0.15673 0 -0.80500 --0.15296 0 -0.76657 --0.14920 0 -0.72814 --0.14488 0 -0.69206 --0.14046 0 -0.65640 --0.13594 0 -0.62152 --0.13111 0 -0.58897 --0.12629 0 -0.55641 --0.12135 0 -0.52598 --0.11636 0 -0.49669 --0.11137 0 -0.46757 --0.10641 0 -0.44157 --0.10144 0 -0.41557 --0.96566E-01 0 -0.39101 --0.91790E-01 0 -0.36820 --0.87015E-01 0 -0.34540 --0.82495E-01 0 -0.32487 --0.78021E-01 0 -0.30473 --0.73667E-01 0 -0.28564 --0.69677E-01 0 -0.26971 --0.65686E-01 0 -0.25377 --0.61696E-01 0 -0.23783 --0.57868E-01 0 -0.22269 --0.54525E-01 0 -0.20994 --0.51182E-01 0 -0.19718 --0.47840E-01 0 -0.18443 --0.44658E-01 0 -0.17242 --0.41959E-01 0 -0.16264 --0.39261E-01 0 -0.15285 --0.36562E-01 0 -0.14307 --0.34010E-01 0 -0.13388 --0.31897E-01 0 -0.12645 --0.29784E-01 0 -0.11902 --0.27671E-01 0 -0.11159 --0.25683E-01 0 -0.10462 --0.24067E-01 0 -0.99006E-01 --0.22452E-01 0 -0.93395E-01 --0.20837E-01 0 -0.87784E-01 --0.19321E-01 0 -0.82517E-01 --0.18107E-01 0 -0.78281E-01 --0.16892E-01 0 -0.74046E-01 --0.15678E-01 0 -0.69810E-01 --0.14541E-01 0 -0.65831E-01 --0.13637E-01 0 -0.62624E-01 --0.12733E-01 0 -0.59416E-01 --0.11828E-01 0 -0.56208E-01 --0.10982E-01 0 -0.53191E-01 --0.10312E-01 0 -0.50748E-01 --0.96411E-02 0 -0.48304E-01 --0.89704E-02 0 -0.45861E-01 --0.83430E-02 0 -0.43559E-01 --0.78458E-02 0 -0.41684E-01 --0.73485E-02 0 -0.39808E-01 --0.68512E-02 0 -0.37932E-01 --0.63959E-02 0 -0.35939E-01 --0.60667E-02 0 -0.33593E-01 --0.57374E-02 0 -0.31246E-01 --0.54082E-02 0 -0.28900E-01 --0.50998E-02 0 -0.27100E-01 --0.48541E-02 0 -0.26942E-01 --0.46084E-02 0 -0.26784E-01 --0.43627E-02 0 -0.26625E-01 --0.41226E-02 0 -0.26283E-01 --0.38993E-02 0 -0.25389E-01 --0.36760E-02 0 -0.24496E-01 --0.34527E-02 0 -0.23602E-01 --0.32412E-02 0 -0.22756E-01 --0.30651E-02 0 -0.22053E-01 --0.28889E-02 0 -0.21351E-01 --0.27128E-02 0 -0.20648E-01 --0.25454E-02 0 -0.19984E-01 --0.24043E-02 0 -0.19433E-01 --0.22633E-02 0 -0.18882E-01 --0.21222E-02 0 -0.18331E-01 --0.19876E-02 0 -0.17811E-01 --0.18723E-02 0 -0.17383E-01 --0.17571E-02 0 -0.16955E-01 --0.16418E-02 0 -0.16526E-01 --0.15312E-02 0 -0.16124E-01 --0.14347E-02 0 -0.15797E-01 --0.13382E-02 0 -0.15470E-01 --0.12417E-02 0 -0.15143E-01 --0.11485E-02 0 -0.14837E-01 --0.10654E-02 0 -0.14596E-01 --0.98218E-03 0 -0.14356E-01 --0.89900E-03 0 -0.14115E-01 --0.81810E-03 0 -0.13893E-01 --0.74402E-03 0 -0.13727E-01 --0.66995E-03 0 -0.13562E-01 --0.59588E-03 0 -0.13397E-01 --0.52322E-03 0 -0.13248E-01 --0.45482E-03 0 -0.13151E-01 --0.38642E-03 0 -0.13054E-01 --0.31802E-03 0 -0.12957E-01 --0.25031E-03 0 -0.12079E-01 --0.18467E-03 0 -0.88582E-02 --0.11903E-03 0 -0.56370E-02 --0.53395E-04 0 -0.24159E-02 -0.15925 0 -1.1637 -0.15749 0 -1.1945 -0.15457 0 -1.2270 -0.15115 0 -1.2601 -0.14745 0 -1.2923 -0.14347 0 -1.3235 -0.13938 0 -1.3541 -0.13505 0 -1.3832 -0.13070 0 -1.4121 -0.12622 0 -1.4391 -0.12174 0 -1.4660 -0.11728 0 -1.4909 -0.11281 0 -1.5156 -0.10847 0 -1.5387 -0.10415 0 -1.5614 -0.99980E-01 0 -1.5828 -0.95904E-01 0 -1.6034 -0.91953E-01 0 -1.6232 -0.88168E-01 0 -1.6419 -0.84460E-01 0 -1.6602 -0.80985E-01 0 -1.6773 -0.77529E-01 0 -1.6942 -0.74358E-01 0 -1.7097 -0.71186E-01 0 -1.7252 -0.68263E-01 0 -1.7394 -0.65374E-01 0 -1.7535 -0.62666E-01 0 -1.7667 -0.60035E-01 0 -1.7795 -0.57528E-01 0 -1.7917 -0.55135E-01 0 -1.8034 -0.52817E-01 0 -1.8147 -0.50648E-01 0 -1.8253 -0.48512E-01 0 -1.8358 -0.46558E-01 0 -1.8455 -0.44604E-01 0 -1.8551 -0.42855E-01 0 -1.8640 -0.41111E-01 0 -1.8728 -0.39526E-01 0 -1.8810 -0.37983E-01 0 -1.8891 -0.36551E-01 0 -1.8968 -0.35189E-01 0 -1.9042 -0.33733E-01 0 -1.9109 -0.32151E-01 0 -1.9166 -0.30559E-01 0 -1.9229 -0.28940E-01 0 -1.9312 -0.27769E-01 0 -1.9379 -0.26754E-01 0 -1.9439 -0.25761E-01 0 -1.9498 -0.24770E-01 0 -1.9553 -0.23773E-01 0 -1.9606 -0.22755E-01 0 -1.9658 -0.21736E-01 0 -1.9710 -0.20664E-01 0 -1.9757 -0.19583E-01 0 -1.9803 -0.18471E-01 0 -1.9846 -0.17323E-01 0 -1.9886 -0.16172E-01 0 -1.9925 -0.14986E-01 0 -1.9958 -0.13799E-01 0 -1.9991 -0.12624E-01 0 -2.0020 -0.11457E-01 0 -2.0046 -0.10312E-01 0 -2.0070 -0.92352E-02 0 -2.0090 -0.81588E-02 0 -2.0109 -0.72218E-02 0 -2.0124 -0.63093E-02 0 -2.0138 -0.54956E-02 0 -2.0149 -0.48027E-02 0 -2.0158 -0.41221E-02 0 -2.0167 -0.36750E-02 0 -2.0173 -0.32279E-02 0 -2.0178 -0.29346E-02 0 -2.0183 -0.27242E-02 0 -2.0186 -0.25548E-02 0 -2.0190 -0.25088E-02 0 -2.0195 -0.25363E-02 0 -2.0199 -0.26058E-02 0 -2.0204 -0.27280E-02 0 -2.0209 -0.28813E-02 0 -2.0216 -0.30481E-02 0 -2.0223 -0.32241E-02 0 -2.0229 -0.34001E-02 0 -2.0235 -0.35487E-02 0 -2.0243 -0.36924E-02 0 -2.0251 -0.38066E-02 0 -2.0259 -0.38846E-02 0 -2.0268 -0.39589E-02 0 -2.0277 -0.39609E-02 0 -2.0286 -0.39628E-02 0 -2.0295 -0.39182E-02 0 -2.0304 -0.38484E-02 0 -2.0313 -0.37620E-02 0 -2.0322 -0.36257E-02 0 -2.0330 -0.34894E-02 0 -2.0339 -0.32879E-02 0 -2.0346 -0.30749E-02 0 -2.0354 -0.28092E-02 0 -2.0361 -0.24790E-02 0 -2.0368 -0.21390E-02 0 -2.0375 -0.16123E-02 0 -2.0380 -0.10855E-02 0 -2.0385 -0.35409E-03 0 -2.0387 --0.48760E-03 0 -2.0388 --0.14193E-02 0 -2.0389 --0.26208E-02 0 -2.0392 --0.40859E-02 0 -2.0390 --0.57421E-02 0 -2.0385 --0.77083E-02 0 -2.0376 --0.10027E-01 0 -2.0364 --0.12635E-01 0 -2.0347 --0.15755E-01 0 -2.0317 --0.18875E-01 0 -2.0288 --0.22766E-01 0 -2.0244 --0.26793E-01 0 -2.0198 --0.31233E-01 0 -2.0141 --0.36178E-01 0 -2.0071 --0.41166E-01 0 -1.9999 --0.46964E-01 0 -1.9899 --0.52762E-01 0 -1.9799 --0.59022E-01 0 -1.9677 --0.65531E-01 0 -1.9543 --0.72167E-01 0 -1.9399 --0.79182E-01 0 -1.9226 --0.86198E-01 0 -1.9054 --0.93431E-01 0 -1.8847 --0.10070 0 -1.8634 --0.10797 0 -1.8403 --0.11522 0 -1.8149 --0.12247 0 -1.7894 --0.12943 0 -1.7600 --0.13639 0 -1.7306 --0.14300 0 -1.6990 --0.14941 0 -1.6662 --0.15565 0 -1.6325 --0.16135 0 -1.5959 --0.16685 0 -1.5588 --0.17175 0 -1.5202 --0.17642 0 -1.4810 --0.18039 0 -1.4402 --0.18410 0 -1.3991 --0.18704 0 -1.3568 --0.18970 0 -1.3143 --0.19153 0 -1.2709 --0.19308 0 -1.2272 --0.19376 0 -1.1822 --0.19411 0 -1.1377 --0.19346 0 -1.0947 --0.19282 0 -1.0518 --0.19125 0 -1.0089 --0.18919 0 -0.96602 --0.18706 0 -0.92325 --0.18375 0 -0.88209 --0.18043 0 -0.84094 --0.17666 0 -0.80086 --0.17232 0 -0.76209 --0.16799 0 -0.72331 --0.16304 0 -0.68699 --0.15797 0 -0.65110 --0.15280 0 -0.61602 --0.14729 0 -0.58334 --0.14179 0 -0.55067 --0.13617 0 -0.52018 --0.13049 0 -0.49087 --0.12481 0 -0.46173 --0.11919 0 -0.43578 --0.11357 0 -0.40984 --0.10805 0 -0.38536 --0.10266 0 -0.36268 --0.97264E-01 0 -0.33999 --0.92172E-01 0 -0.31962 --0.87134E-01 0 -0.29966 --0.82236E-01 0 -0.28074 --0.77757E-01 0 -0.26498 --0.73279E-01 0 -0.24921 --0.68800E-01 0 -0.23345 --0.64507E-01 0 -0.21849 --0.60768E-01 0 -0.20592 --0.57029E-01 0 -0.19336 --0.53290E-01 0 -0.18080 --0.49733E-01 0 -0.16897 --0.46725E-01 0 -0.15937 --0.43716E-01 0 -0.14976 --0.40707E-01 0 -0.14016 --0.37863E-01 0 -0.13114 --0.35513E-01 0 -0.12387 --0.33164E-01 0 -0.11660 --0.30815E-01 0 -0.10933 --0.28605E-01 0 -0.10250 --0.26813E-01 0 -0.97022E-01 --0.25021E-01 0 -0.91541E-01 --0.23229E-01 0 -0.86060E-01 --0.21548E-01 0 -0.80916E-01 --0.20203E-01 0 -0.76782E-01 --0.18858E-01 0 -0.72649E-01 --0.17512E-01 0 -0.68516E-01 --0.16253E-01 0 -0.64633E-01 --0.15252E-01 0 -0.61503E-01 --0.14250E-01 0 -0.58373E-01 --0.13249E-01 0 -0.55243E-01 --0.12312E-01 0 -0.52300E-01 --0.11569E-01 0 -0.49914E-01 --0.10826E-01 0 -0.47529E-01 --0.10082E-01 0 -0.45143E-01 --0.93869E-02 0 -0.42896E-01 --0.88345E-02 0 -0.41064E-01 --0.82822E-02 0 -0.39231E-01 --0.77298E-02 0 -0.37399E-01 --0.72188E-02 0 -0.35447E-01 --0.68318E-02 0 -0.33137E-01 --0.64448E-02 0 -0.30827E-01 --0.60578E-02 0 -0.28517E-01 --0.56949E-02 0 -0.26749E-01 --0.54043E-02 0 -0.26607E-01 --0.51136E-02 0 -0.26465E-01 --0.48230E-02 0 -0.26324E-01 --0.45435E-02 0 -0.25998E-01 --0.42976E-02 0 -0.25120E-01 --0.40517E-02 0 -0.24241E-01 --0.38058E-02 0 -0.23363E-01 --0.35729E-02 0 -0.22532E-01 --0.33791E-02 0 -0.21841E-01 --0.31853E-02 0 -0.21150E-01 --0.29915E-02 0 -0.20459E-01 --0.28073E-02 0 -0.19806E-01 --0.26521E-02 0 -0.19264E-01 --0.24968E-02 0 -0.18722E-01 --0.23415E-02 0 -0.18179E-01 --0.21933E-02 0 -0.17667E-01 --0.20664E-02 0 -0.17245E-01 --0.19394E-02 0 -0.16823E-01 --0.18124E-02 0 -0.16401E-01 --0.16906E-02 0 -0.16004E-01 --0.15842E-02 0 -0.15682E-01 --0.14778E-02 0 -0.15360E-01 --0.13714E-02 0 -0.15037E-01 --0.12686E-02 0 -0.14736E-01 --0.11768E-02 0 -0.14498E-01 --0.10850E-02 0 -0.14261E-01 --0.99325E-03 0 -0.14023E-01 --0.90395E-03 0 -0.13804E-01 --0.82214E-03 0 -0.13641E-01 --0.74034E-03 0 -0.13477E-01 --0.65853E-03 0 -0.13314E-01 --0.57828E-03 0 -0.13168E-01 --0.50269E-03 0 -0.13072E-01 --0.42711E-03 0 -0.12976E-01 --0.35152E-03 0 -0.12880E-01 --0.27669E-03 0 -0.12008E-01 --0.20414E-03 0 -0.88057E-02 --0.13159E-03 0 -0.56036E-02 --0.59033E-04 0 -0.24016E-02 -0.17460 0 -1.1678 -0.17200 0 -1.1978 -0.16854 0 -1.2302 -0.16471 0 -1.2636 -0.16056 0 -1.2960 -0.15611 0 -1.3275 -0.15155 0 -1.3582 -0.14673 0 -1.3875 -0.14189 0 -1.4165 -0.13692 0 -1.4435 -0.13194 0 -1.4705 -0.12701 0 -1.4953 -0.12208 0 -1.5200 -0.11729 0 -1.5430 -0.11254 0 -1.5655 -0.10796 0 -1.5868 -0.10350 0 -1.6073 -0.99174E-01 0 -1.6270 -0.95045E-01 0 -1.6456 -0.91002E-01 0 -1.6638 -0.87224E-01 0 -1.6807 -0.83467E-01 0 -1.6975 -0.80029E-01 0 -1.7128 -0.76590E-01 0 -1.7282 -0.73427E-01 0 -1.7423 -0.70301E-01 0 -1.7563 -0.67372E-01 0 -1.7693 -0.64528E-01 0 -1.7820 -0.61817E-01 0 -1.7941 -0.59231E-01 0 -1.8057 -0.56726E-01 0 -1.8169 -0.54381E-01 0 -1.8274 -0.52073E-01 0 -1.8378 -0.49963E-01 0 -1.8474 -0.47852E-01 0 -1.8569 -0.45967E-01 0 -1.8657 -0.44087E-01 0 -1.8744 -0.42383E-01 0 -1.8826 -0.40725E-01 0 -1.8906 -0.39191E-01 0 -1.8982 -0.37736E-01 0 -1.9055 -0.36285E-01 0 -1.9120 -0.34841E-01 0 -1.9173 -0.33408E-01 0 -1.9235 -0.32009E-01 0 -1.9322 -0.30825E-01 0 -1.9389 -0.29722E-01 0 -1.9450 -0.28641E-01 0 -1.9508 -0.27561E-01 0 -1.9563 -0.26470E-01 0 -1.9617 -0.25350E-01 0 -1.9669 -0.24231E-01 0 -1.9721 -0.23041E-01 0 -1.9768 -0.21839E-01 0 -1.9814 -0.20597E-01 0 -1.9858 -0.19307E-01 0 -1.9898 -0.18015E-01 0 -1.9937 -0.16671E-01 0 -1.9970 -0.15328E-01 0 -2.0004 -0.13995E-01 0 -2.0032 -0.12666E-01 0 -2.0058 -0.11363E-01 0 -2.0082 -0.10136E-01 0 -2.0101 -0.89091E-02 0 -2.0120 -0.78425E-02 0 -2.0134 -0.68041E-02 0 -2.0147 -0.58805E-02 0 -2.0157 -0.50974E-02 0 -2.0165 -0.43286E-02 0 -2.0173 -0.38322E-02 0 -2.0177 -0.33358E-02 0 -2.0182 -0.30186E-02 0 -2.0185 -0.27978E-02 0 -2.0188 -0.26247E-02 0 -2.0191 -0.25944E-02 0 -2.0195 -0.26482E-02 0 -2.0199 -0.27499E-02 0 -2.0203 -0.29109E-02 0 -2.0207 -0.31055E-02 0 -2.0214 -0.33135E-02 0 -2.0221 -0.35282E-02 0 -2.0227 -0.37428E-02 0 -2.0233 -0.39199E-02 0 -2.0241 -0.40904E-02 0 -2.0249 -0.42242E-02 0 -2.0258 -0.43134E-02 0 -2.0267 -0.43981E-02 0 -2.0277 -0.43975E-02 0 -2.0286 -0.43969E-02 0 -2.0296 -0.43447E-02 0 -2.0305 -0.42646E-02 0 -2.0314 -0.41678E-02 0 -2.0323 -0.40205E-02 0 -2.0332 -0.38733E-02 0 -2.0340 -0.36641E-02 0 -2.0349 -0.34440E-02 0 -2.0357 -0.31724E-02 0 -2.0364 -0.28379E-02 0 -2.0372 -0.24933E-02 0 -2.0379 -0.19563E-02 0 -2.0385 -0.14193E-02 0 -2.0392 -0.66270E-03 0 -2.0395 --0.21221E-03 0 -2.0397 --0.11859E-02 0 -2.0400 --0.24557E-02 0 -2.0406 --0.40188E-02 0 -2.0406 --0.57955E-02 0 -2.0404 --0.79198E-02 0 -2.0398 --0.10442E-01 0 -2.0389 --0.13291E-01 0 -2.0376 --0.16722E-01 0 -2.0350 --0.20153E-01 0 -2.0324 --0.24462E-01 0 -2.0285 --0.28926E-01 0 -2.0243 --0.33862E-01 0 -2.0190 --0.39375E-01 0 -2.0123 --0.44937E-01 0 -2.0055 --0.51425E-01 0 -1.9959 --0.57914E-01 0 -1.9862 --0.64931E-01 0 -1.9743 --0.72233E-01 0 -1.9611 --0.79679E-01 0 -1.9470 --0.87559E-01 0 -1.9299 --0.95439E-01 0 -1.9128 --0.10357 0 -1.8922 --0.11174 0 -1.8710 --0.11990 0 -1.8479 --0.12805 0 -1.8224 --0.13619 0 -1.7968 --0.14401 0 -1.7672 --0.15183 0 -1.7376 --0.15925 0 -1.7057 --0.16644 0 -1.6726 --0.17344 0 -1.6386 --0.17983 0 -1.6017 --0.18600 0 -1.5642 --0.19149 0 -1.5251 --0.19672 0 -1.4854 --0.20117 0 -1.4442 --0.20532 0 -1.4025 --0.20861 0 -1.3597 --0.21158 0 -1.3166 --0.21362 0 -1.2726 --0.21534 0 -1.2283 --0.21608 0 -1.1826 --0.21645 0 -1.1375 --0.21570 0 -1.0940 --0.21495 0 -1.0505 --0.21316 0 -1.0071 --0.21080 0 -0.96370 --0.20838 0 -0.92040 --0.20462 0 -0.87880 --0.20086 0 -0.83721 --0.19658 0 -0.79672 --0.19169 0 -0.75761 --0.18679 0 -0.71849 --0.18120 0 -0.68192 --0.17549 0 -0.64580 --0.16966 0 -0.61052 --0.16347 0 -0.57772 --0.15728 0 -0.54492 --0.15098 0 -0.51438 --0.14462 0 -0.48505 --0.13826 0 -0.45588 --0.13198 0 -0.43000 --0.12569 0 -0.40411 --0.11953 0 -0.37972 --0.11352 0 -0.35715 --0.10751 0 -0.33458 --0.10185 0 -0.31437 --0.96248E-01 0 -0.29458 --0.90805E-01 0 -0.27584 --0.85838E-01 0 -0.26025 --0.80871E-01 0 -0.24466 --0.75904E-01 0 -0.22907 --0.71145E-01 0 -0.21428 --0.67010E-01 0 -0.20191 --0.62875E-01 0 -0.18953 --0.58740E-01 0 -0.17716 --0.54809E-01 0 -0.16552 --0.51490E-01 0 -0.15610 --0.48170E-01 0 -0.14668 --0.44851E-01 0 -0.13725 --0.41715E-01 0 -0.12841 --0.39129E-01 0 -0.12129 --0.36543E-01 0 -0.11418 --0.33958E-01 0 -0.10706 --0.31526E-01 0 -0.10039 --0.29558E-01 0 -0.95039E-01 --0.27589E-01 0 -0.89687E-01 --0.25620E-01 0 -0.84336E-01 --0.23775E-01 0 -0.79314E-01 --0.22299E-01 0 -0.75283E-01 --0.20823E-01 0 -0.71252E-01 --0.19346E-01 0 -0.67221E-01 --0.17965E-01 0 -0.63435E-01 --0.16866E-01 0 -0.60383E-01 --0.15768E-01 0 -0.57331E-01 --0.14670E-01 0 -0.54279E-01 --0.13642E-01 0 -0.51408E-01 --0.12826E-01 0 -0.49081E-01 --0.12010E-01 0 -0.46753E-01 --0.11194E-01 0 -0.44426E-01 --0.10431E-01 0 -0.42233E-01 --0.98233E-02 0 -0.40444E-01 --0.92158E-02 0 -0.38654E-01 --0.86084E-02 0 -0.36865E-01 --0.80417E-02 0 -0.34954E-01 --0.75969E-02 0 -0.32681E-01 --0.71522E-02 0 -0.30407E-01 --0.67075E-02 0 -0.28134E-01 --0.62900E-02 0 -0.26398E-01 --0.59544E-02 0 -0.26272E-01 --0.56188E-02 0 -0.26147E-01 --0.52832E-02 0 -0.26022E-01 --0.49644E-02 0 -0.25713E-01 --0.46959E-02 0 -0.24850E-01 --0.44274E-02 0 -0.23987E-01 --0.41589E-02 0 -0.23125E-01 --0.39046E-02 0 -0.22308E-01 --0.36932E-02 0 -0.21629E-01 --0.34817E-02 0 -0.20950E-01 --0.32702E-02 0 -0.20271E-01 --0.30693E-02 0 -0.19628E-01 --0.28998E-02 0 -0.19095E-01 --0.27303E-02 0 -0.18561E-01 --0.25609E-02 0 -0.18027E-01 --0.23991E-02 0 -0.17523E-01 --0.22604E-02 0 -0.17108E-01 --0.21217E-02 0 -0.16692E-01 --0.19831E-02 0 -0.16276E-01 --0.18500E-02 0 -0.15885E-01 --0.17337E-02 0 -0.15567E-01 --0.16174E-02 0 -0.15250E-01 --0.15011E-02 0 -0.14932E-01 --0.13887E-02 0 -0.14635E-01 --0.12883E-02 0 -0.14400E-01 --0.11879E-02 0 -0.14166E-01 --0.10875E-02 0 -0.13931E-01 --0.98981E-03 0 -0.13715E-01 --0.90027E-03 0 -0.13554E-01 --0.81072E-03 0 -0.13393E-01 --0.72118E-03 0 -0.13231E-01 --0.63333E-03 0 -0.13087E-01 --0.55056E-03 0 -0.12992E-01 --0.46779E-03 0 -0.12898E-01 --0.38502E-03 0 -0.12803E-01 --0.30308E-03 0 -0.11936E-01 --0.22361E-03 0 -0.87533E-02 --0.14414E-03 0 -0.55703E-02 --0.64672E-04 0 -0.23873E-02 -0.19084 0 -1.1717 -0.18749 0 -1.2013 -0.18349 0 -1.2338 -0.17920 0 -1.2675 -0.17457 0 -1.3002 -0.16961 0 -1.3319 -0.16453 0 -1.3628 -0.15917 0 -1.3922 -0.15379 0 -1.4213 -0.14829 0 -1.4483 -0.14279 0 -1.4753 -0.13735 0 -1.5001 -0.13191 0 -1.5248 -0.12665 0 -1.5477 -0.12144 0 -1.5701 -0.11643 0 -1.5913 -0.11155 0 -1.6116 -0.10684 0 -1.6312 -0.10234 0 -1.6496 -0.97950E-01 0 -1.6676 -0.93856E-01 0 -1.6844 -0.89785E-01 0 -1.7010 -0.86069E-01 0 -1.7162 -0.82353E-01 0 -1.7314 -0.78939E-01 0 -1.7454 -0.75565E-01 0 -1.7592 -0.72406E-01 0 -1.7722 -0.69338E-01 0 -1.7847 -0.66414E-01 0 -1.7967 -0.63622E-01 0 -1.8082 -0.60919E-01 0 -1.8193 -0.58387E-01 0 -1.8297 -0.55895E-01 0 -1.8399 -0.53617E-01 0 -1.8494 -0.51339E-01 0 -1.8589 -0.49306E-01 0 -1.8675 -0.47280E-01 0 -1.8762 -0.45449E-01 0 -1.8842 -0.43669E-01 0 -1.8921 -0.42027E-01 0 -1.8996 -0.40474E-01 0 -1.9069 -0.39004E-01 0 -1.9132 -0.37644E-01 0 -1.9182 -0.36312E-01 0 -1.9242 -0.35064E-01 0 -1.9333 -0.33858E-01 0 -1.9401 -0.32675E-01 0 -1.9461 -0.31516E-01 0 -1.9519 -0.30353E-01 0 -1.9574 -0.29176E-01 0 -1.9628 -0.27960E-01 0 -1.9680 -0.26743E-01 0 -1.9733 -0.25438E-01 0 -1.9780 -0.24116E-01 0 -1.9827 -0.22743E-01 0 -1.9871 -0.21309E-01 0 -1.9911 -0.19871E-01 0 -1.9951 -0.18364E-01 0 -1.9984 -0.16857E-01 0 -2.0017 -0.15356E-01 0 -2.0046 -0.13857E-01 0 -2.0071 -0.12387E-01 0 -2.0095 -0.11000E-01 0 -2.0113 -0.96140E-02 0 -2.0132 -0.84105E-02 0 -2.0145 -0.72393E-02 0 -2.0156 -0.62008E-02 0 -2.0166 -0.53245E-02 0 -2.0173 -0.44648E-02 0 -2.0179 -0.39209E-02 0 -2.0183 -0.33770E-02 0 -2.0186 -0.30405E-02 0 -2.0188 -0.28157E-02 0 -2.0190 -0.26456E-02 0 -2.0192 -0.26397E-02 0 -2.0195 -0.27296E-02 0 -2.0198 -0.28734E-02 0 -2.0201 -0.30833E-02 0 -2.0205 -0.33287E-02 0 -2.0212 -0.35869E-02 0 -2.0219 -0.38478E-02 0 -2.0225 -0.41086E-02 0 -2.0231 -0.43190E-02 0 -2.0239 -0.45204E-02 0 -2.0248 -0.46767E-02 0 -2.0257 -0.47778E-02 0 -2.0267 -0.48737E-02 0 -2.0276 -0.48691E-02 0 -2.0286 -0.48645E-02 0 -2.0296 -0.48029E-02 0 -2.0306 -0.47108E-02 0 -2.0315 -0.46021E-02 0 -2.0324 -0.44439E-02 0 -2.0333 -0.42856E-02 0 -2.0342 -0.40720E-02 0 -2.0351 -0.38485E-02 0 -2.0359 -0.35771E-02 0 -2.0367 -0.32471E-02 0 -2.0375 -0.29070E-02 0 -2.0383 -0.23736E-02 0 -2.0391 -0.18402E-02 0 -2.0398 -0.10749E-02 0 -2.0403 -0.18460E-03 0 -2.0407 --0.81281E-03 0 -2.0412 --0.21316E-02 0 -2.0420 --0.37733E-02 0 -2.0423 --0.56516E-02 0 -2.0423 --0.79162E-02 0 -2.0421 --0.10626E-01 0 -2.0416 --0.13703E-01 0 -2.0407 --0.17435E-01 0 -2.0385 --0.21167E-01 0 -2.0363 --0.25892E-01 0 -2.0328 --0.30792E-01 0 -2.0290 --0.36227E-01 0 -2.0242 --0.42317E-01 0 -2.0180 --0.48463E-01 0 -2.0116 --0.55660E-01 0 -2.0023 --0.62858E-01 0 -1.9931 --0.70655E-01 0 -1.9815 --0.78777E-01 0 -1.9686 --0.87062E-01 0 -1.9547 --0.95839E-01 0 -1.9379 --0.10462 0 -1.9210 --0.11367 0 -1.9004 --0.12278 0 -1.8793 --0.13188 0 -1.8561 --0.14096 0 -1.8306 --0.15002 0 -1.8048 --0.15874 0 -1.7750 --0.16745 0 -1.7453 --0.17570 0 -1.7131 --0.18371 0 -1.6797 --0.19150 0 -1.6453 --0.19861 0 -1.6079 --0.20548 0 -1.5700 --0.21158 0 -1.5304 --0.21740 0 -1.4902 --0.22235 0 -1.4484 --0.22697 0 -1.4062 --0.23062 0 -1.3628 --0.23392 0 -1.3190 --0.23618 0 -1.2744 --0.23808 0 -1.2294 --0.23888 0 -1.1831 --0.23927 0 -1.1374 --0.23841 0 -1.0932 --0.23755 0 -1.0491 --0.23552 0 -1.0051 --0.23286 0 -0.96114 --0.23013 0 -0.91727 --0.22589 0 -0.87519 --0.22166 0 -0.83310 --0.21686 0 -0.79219 --0.21136 0 -0.75270 --0.20586 0 -0.71321 --0.19961 0 -0.67638 --0.19322 0 -0.64001 --0.18670 0 -0.60451 --0.17980 0 -0.57159 --0.17290 0 -0.53867 --0.16588 0 -0.50807 --0.15881 0 -0.47872 --0.15174 0 -0.44955 --0.14478 0 -0.42373 --0.13781 0 -0.39791 --0.13099 0 -0.37362 --0.12435 0 -0.35118 --0.11771 0 -0.32874 --0.11146 0 -0.30871 --0.10529 0 -0.28911 --0.99289E-01 0 -0.27056 --0.93828E-01 0 -0.25516 --0.88366E-01 0 -0.23976 --0.82905E-01 0 -0.22436 --0.77676E-01 0 -0.20977 --0.73142E-01 0 -0.19760 --0.68609E-01 0 -0.18543 --0.64076E-01 0 -0.17327 --0.59768E-01 0 -0.16183 --0.56140E-01 0 -0.15260 --0.52511E-01 0 -0.14337 --0.48882E-01 0 -0.13414 --0.45456E-01 0 -0.12548 --0.42636E-01 0 -0.11854 --0.39817E-01 0 -0.11160 --0.36998E-01 0 -0.10465 --0.34348E-01 0 -0.98139E-01 --0.32206E-01 0 -0.92927E-01 --0.30065E-01 0 -0.87715E-01 --0.27923E-01 0 -0.82502E-01 --0.25916E-01 0 -0.77613E-01 --0.24313E-01 0 -0.73691E-01 --0.22709E-01 0 -0.69769E-01 --0.21106E-01 0 -0.65847E-01 --0.19605E-01 0 -0.62163E-01 --0.18413E-01 0 -0.59194E-01 --0.17221E-01 0 -0.56225E-01 --0.16028E-01 0 -0.53256E-01 --0.14913E-01 0 -0.50463E-01 --0.14027E-01 0 -0.48197E-01 --0.13141E-01 0 -0.45931E-01 --0.12255E-01 0 -0.43665E-01 --0.11426E-01 0 -0.41530E-01 --0.10766E-01 0 -0.39786E-01 --0.10105E-01 0 -0.38042E-01 --0.94448E-02 0 -0.36298E-01 --0.88253E-02 0 -0.34432E-01 --0.83282E-02 0 -0.32197E-01 --0.78310E-02 0 -0.29962E-01 --0.73339E-02 0 -0.27727E-01 --0.68669E-02 0 -0.26024E-01 --0.64905E-02 0 -0.25916E-01 --0.61141E-02 0 -0.25809E-01 --0.57377E-02 0 -0.25701E-01 --0.53827E-02 0 -0.25409E-01 --0.50919E-02 0 -0.24563E-01 --0.48011E-02 0 -0.23717E-01 --0.45103E-02 0 -0.22871E-01 --0.42349E-02 0 -0.22070E-01 --0.40060E-02 0 -0.21403E-01 --0.37770E-02 0 -0.20737E-01 --0.35481E-02 0 -0.20070E-01 --0.33305E-02 0 -0.19439E-01 --0.31469E-02 0 -0.18915E-01 --0.29634E-02 0 -0.18390E-01 --0.27798E-02 0 -0.17866E-01 --0.26045E-02 0 -0.17370E-01 --0.24542E-02 0 -0.16961E-01 --0.23039E-02 0 -0.16552E-01 --0.21536E-02 0 -0.16144E-01 --0.20093E-02 0 -0.15759E-01 --0.18831E-02 0 -0.15445E-01 --0.17570E-02 0 -0.15132E-01 --0.16308E-02 0 -0.14819E-01 --0.15089E-02 0 -0.14527E-01 --0.13999E-02 0 -0.14296E-01 --0.12909E-02 0 -0.14064E-01 --0.11819E-02 0 -0.13833E-01 --0.10758E-02 0 -0.13620E-01 --0.97851E-03 0 -0.13461E-01 --0.88123E-03 0 -0.13302E-01 --0.78395E-03 0 -0.13143E-01 --0.68850E-03 0 -0.13001E-01 --0.59854E-03 0 -0.12907E-01 --0.50857E-03 0 -0.12814E-01 --0.41860E-03 0 -0.12721E-01 --0.32953E-03 0 -0.11860E-01 --0.24313E-03 0 -0.86973E-02 --0.15673E-03 0 -0.55346E-02 --0.70326E-04 0 -0.23720E-02 -0.20975 0 -1.1755 -0.20593 0 -1.2055 -0.20138 0 -1.2384 -0.19652 0 -1.2726 -0.19127 0 -1.3056 -0.18567 0 -1.3375 -0.17993 0 -1.3687 -0.17391 0 -1.3982 -0.16787 0 -1.4274 -0.16171 0 -1.4544 -0.15555 0 -1.4814 -0.14950 0 -1.5061 -0.14345 0 -1.5307 -0.13762 0 -1.5535 -0.13186 0 -1.5758 -0.12634 0 -1.5968 -0.12098 0 -1.6169 -0.11581 0 -1.6363 -0.11091 0 -1.6545 -0.10611 0 -1.6723 -0.10167 0 -1.6888 -0.97242E-01 0 -1.7053 -0.93216E-01 0 -1.7203 -0.89190E-01 0 -1.7353 -0.85495E-01 0 -1.7491 -0.81845E-01 0 -1.7628 -0.78424E-01 0 -1.7756 -0.75102E-01 0 -1.7880 -0.71932E-01 0 -1.7999 -0.68902E-01 0 -1.8112 -0.65965E-01 0 -1.8221 -0.63211E-01 0 -1.8324 -0.60500E-01 0 -1.8426 -0.58018E-01 0 -1.8519 -0.55537E-01 0 -1.8612 -0.53327E-01 0 -1.8698 -0.51124E-01 0 -1.8783 -0.49141E-01 0 -1.8862 -0.47215E-01 0 -1.8940 -0.45450E-01 0 -1.9014 -0.43785E-01 0 -1.9085 -0.42219E-01 0 -1.9147 -0.40784E-01 0 -1.9197 -0.39382E-01 0 -1.9256 -0.38079E-01 0 -1.9346 -0.36821E-01 0 -1.9413 -0.35585E-01 0 -1.9473 -0.34372E-01 0 -1.9531 -0.33150E-01 0 -1.9586 -0.31907E-01 0 -1.9641 -0.30609E-01 0 -1.9694 -0.29312E-01 0 -1.9747 -0.27895E-01 0 -1.9795 -0.26456E-01 0 -1.9842 -0.24950E-01 0 -1.9886 -0.23361E-01 0 -1.9927 -0.21767E-01 0 -1.9967 -0.20075E-01 0 -2.0001 -0.18384E-01 0 -2.0034 -0.16690E-01 0 -2.0063 -0.14994E-01 0 -2.0088 -0.13329E-01 0 -2.0112 -0.11756E-01 0 -2.0129 -0.10182E-01 0 -2.0147 -0.88205E-02 0 -2.0158 -0.74959E-02 0 -2.0169 -0.63272E-02 0 -2.0177 -0.53489E-02 0 -2.0182 -0.43902E-02 0 -2.0187 -0.38042E-02 0 -2.0189 -0.32182E-02 0 -2.0191 -0.28763E-02 0 -2.0191 -0.26659E-02 0 -2.0191 -0.25194E-02 0 -2.0192 -0.25644E-02 0 -2.0194 -0.27192E-02 0 -2.0196 -0.29350E-02 0 -2.0199 -0.32240E-02 0 -2.0202 -0.35492E-02 0 -2.0208 -0.38845E-02 0 -2.0215 -0.42142E-02 0 -2.0222 -0.45438E-02 0 -2.0228 -0.48015E-02 0 -2.0237 -0.50465E-02 0 -2.0246 -0.52333E-02 0 -2.0255 -0.53489E-02 0 -2.0266 -0.54582E-02 0 -2.0276 -0.54453E-02 0 -2.0286 -0.54324E-02 0 -2.0297 -0.53565E-02 0 -2.0307 -0.52468E-02 0 -2.0316 -0.51221E-02 0 -2.0326 -0.49528E-02 0 -2.0335 -0.47835E-02 0 -2.0344 -0.45749E-02 0 -2.0353 -0.43593E-02 0 -2.0361 -0.41062E-02 0 -2.0370 -0.38070E-02 0 -2.0379 -0.34984E-02 0 -2.0387 -0.30104E-02 0 -2.0396 -0.25224E-02 0 -2.0404 -0.17978E-02 0 -2.0411 -0.94570E-03 0 -2.0417 --0.20692E-04 0 -2.0424 --0.13300E-02 0 -2.0435 --0.29925E-02 0 -2.0441 --0.49155E-02 0 -2.0445 --0.72671E-02 0 -2.0447 --0.10118E-01 0 -2.0447 --0.13382E-01 0 -2.0443 --0.17386E-01 0 -2.0426 --0.21390E-01 0 -2.0410 --0.26524E-01 0 -2.0380 --0.31857E-01 0 -2.0348 --0.37802E-01 0 -2.0305 --0.44496E-01 0 -2.0249 --0.51252E-01 0 -2.0191 --0.59214E-01 0 -2.0103 --0.67176E-01 0 -2.0015 --0.75826E-01 0 -1.9904 --0.84847E-01 0 -1.9779 --0.94055E-01 0 -1.9644 --0.10383 0 -1.9477 --0.11360 0 -1.9310 --0.12369 0 -1.9106 --0.13383 0 -1.8895 --0.14397 0 -1.8664 --0.15409 0 -1.8407 --0.16419 0 -1.8149 --0.17389 0 -1.7848 --0.18359 0 -1.7548 --0.19278 0 -1.7223 --0.20170 0 -1.6884 --0.21037 0 -1.6536 --0.21829 0 -1.6157 --0.22593 0 -1.5773 --0.23273 0 -1.5370 --0.23921 0 -1.4962 --0.24472 0 -1.4537 --0.24987 0 -1.4108 --0.25394 0 -1.3666 --0.25762 0 -1.3221 --0.26014 0 -1.2767 --0.26224 0 -1.2309 --0.26313 0 -1.1837 --0.26355 0 -1.1371 --0.26256 0 -1.0922 --0.26157 0 -1.0473 --0.25926 0 -1.0026 --0.25625 0 -0.95788 --0.25315 0 -0.91329 --0.24836 0 -0.87060 --0.24358 0 -0.82791 --0.23816 0 -0.78645 --0.23197 0 -0.74651 --0.22578 0 -0.70656 --0.21876 0 -0.66941 --0.21159 0 -0.63276 --0.20429 0 -0.59700 --0.19658 0 -0.56394 --0.18887 0 -0.53088 --0.18106 0 -0.50023 --0.17319 0 -0.47088 --0.16534 0 -0.44171 --0.15763 0 -0.41600 --0.14992 0 -0.39028 --0.14239 0 -0.36612 --0.13507 0 -0.34386 --0.12775 0 -0.32160 --0.12088 0 -0.30181 --0.11410 0 -0.28246 --0.10752 0 -0.26415 --0.10154 0 -0.24899 --0.95570E-01 0 -0.23383 --0.89595E-01 0 -0.21867 --0.83880E-01 0 -0.20432 --0.78942E-01 0 -0.19241 --0.74004E-01 0 -0.18050 --0.69066E-01 0 -0.16859 --0.64379E-01 0 -0.15741 --0.60444E-01 0 -0.14842 --0.56509E-01 0 -0.13943 --0.52573E-01 0 -0.13044 --0.48861E-01 0 -0.12201 --0.45816E-01 0 -0.11527 --0.42772E-01 0 -0.10853 --0.39728E-01 0 -0.10179 --0.36869E-01 0 -0.95477E-01 --0.34565E-01 0 -0.90432E-01 --0.32262E-01 0 -0.85387E-01 --0.29958E-01 0 -0.80342E-01 --0.27801E-01 0 -0.75610E-01 --0.26081E-01 0 -0.71818E-01 --0.24361E-01 0 -0.68026E-01 --0.22641E-01 0 -0.64234E-01 --0.21032E-01 0 -0.60672E-01 --0.19755E-01 0 -0.57801E-01 --0.18478E-01 0 -0.54929E-01 --0.17202E-01 0 -0.52058E-01 --0.16007E-01 0 -0.49356E-01 --0.15059E-01 0 -0.47163E-01 --0.14111E-01 0 -0.44969E-01 --0.13163E-01 0 -0.42775E-01 --0.12276E-01 0 -0.40708E-01 --0.11569E-01 0 -0.39017E-01 --0.10862E-01 0 -0.37325E-01 --0.10155E-01 0 -0.35634E-01 --0.94912E-02 0 -0.33819E-01 --0.89576E-02 0 -0.31628E-01 --0.84241E-02 0 -0.29438E-01 --0.78906E-02 0 -0.27248E-01 --0.73892E-02 0 -0.25583E-01 --0.69844E-02 0 -0.25496E-01 --0.65796E-02 0 -0.25410E-01 --0.61747E-02 0 -0.25323E-01 --0.57931E-02 0 -0.25051E-01 --0.54809E-02 0 -0.24225E-01 --0.51688E-02 0 -0.23399E-01 --0.48566E-02 0 -0.22573E-01 --0.45611E-02 0 -0.21790E-01 --0.43151E-02 0 -0.21138E-01 --0.40692E-02 0 -0.20486E-01 --0.38233E-02 0 -0.19834E-01 --0.35895E-02 0 -0.19217E-01 --0.33922E-02 0 -0.18703E-01 --0.31949E-02 0 -0.18190E-01 --0.29976E-02 0 -0.17676E-01 --0.28091E-02 0 -0.17190E-01 --0.26474E-02 0 -0.16789E-01 --0.24856E-02 0 -0.16388E-01 --0.23238E-02 0 -0.15987E-01 --0.21685E-02 0 -0.15609E-01 --0.20326E-02 0 -0.15302E-01 --0.18966E-02 0 -0.14994E-01 --0.17607E-02 0 -0.14687E-01 --0.16293E-02 0 -0.14399E-01 --0.15118E-02 0 -0.14172E-01 --0.13942E-02 0 -0.13945E-01 --0.12766E-02 0 -0.13718E-01 --0.11622E-02 0 -0.13508E-01 --0.10571E-02 0 -0.13352E-01 --0.95210E-03 0 -0.13195E-01 --0.84708E-03 0 -0.13039E-01 --0.74401E-03 0 -0.12899E-01 --0.64681E-03 0 -0.12807E-01 --0.54961E-03 0 -0.12715E-01 --0.45241E-03 0 -0.12623E-01 --0.35617E-03 0 -0.11769E-01 --0.26279E-03 0 -0.86309E-02 --0.16941E-03 0 -0.54924E-02 --0.76026E-04 0 -0.23539E-02 -0.22866 0 -1.1793 -0.22437 0 -1.2097 -0.21928 0 -1.2430 -0.21383 0 -1.2776 -0.20798 0 -1.3109 -0.20173 0 -1.3431 -0.19534 0 -1.3745 -0.18865 0 -1.4042 -0.18194 0 -1.4335 -0.17512 0 -1.4605 -0.16831 0 -1.4876 -0.16164 0 -1.5122 -0.15498 0 -1.5367 -0.14860 0 -1.5593 -0.14228 0 -1.5814 -0.13626 0 -1.6022 -0.13041 0 -1.6222 -0.12479 0 -1.6413 -0.11947 0 -1.6594 -0.11428 0 -1.6770 -0.10947 0 -1.6933 -0.10470 0 -1.7096 -0.10036 0 -1.7244 -0.96028E-01 0 -1.7392 -0.92052E-01 0 -1.7529 -0.88125E-01 0 -1.7664 -0.84443E-01 0 -1.7790 -0.80866E-01 0 -1.7913 -0.77449E-01 0 -1.8030 -0.74182E-01 0 -1.8142 -0.71012E-01 0 -1.8250 -0.68035E-01 0 -1.8352 -0.65104E-01 0 -1.8452 -0.62420E-01 0 -1.8544 -0.59736E-01 0 -1.8636 -0.57348E-01 0 -1.8720 -0.54968E-01 0 -1.8804 -0.52833E-01 0 -1.8882 -0.50762E-01 0 -1.8958 -0.48872E-01 0 -1.9031 -0.47096E-01 0 -1.9102 -0.45434E-01 0 -1.9163 -0.43924E-01 0 -1.9212 -0.42452E-01 0 -1.9270 -0.41095E-01 0 -1.9359 -0.39784E-01 0 -1.9426 -0.38494E-01 0 -1.9485 -0.37228E-01 0 -1.9543 -0.35947E-01 0 -1.9599 -0.34638E-01 0 -1.9653 -0.33259E-01 0 -1.9707 -0.31880E-01 0 -1.9760 -0.30352E-01 0 -1.9809 -0.28797E-01 0 -1.9857 -0.27157E-01 0 -1.9902 -0.25413E-01 0 -1.9943 -0.23663E-01 0 -1.9984 -0.21787E-01 0 -2.0018 -0.19911E-01 0 -2.0052 -0.18024E-01 0 -2.0080 -0.16131E-01 0 -2.0105 -0.14271E-01 0 -2.0128 -0.12511E-01 0 -2.0145 -0.10751E-01 0 -2.0162 -0.92306E-02 0 -2.0172 -0.77526E-02 0 -2.0181 -0.64536E-02 0 -2.0188 -0.53733E-02 0 -2.0191 -0.43157E-02 0 -2.0195 -0.36875E-02 0 -2.0195 -0.30594E-02 0 -2.0195 -0.27121E-02 0 -2.0194 -0.25162E-02 0 -2.0193 -0.23932E-02 0 -2.0192 -0.24891E-02 0 -2.0193 -0.27088E-02 0 -2.0194 -0.29966E-02 0 -2.0196 -0.33648E-02 0 -2.0199 -0.37697E-02 0 -2.0205 -0.41821E-02 0 -2.0212 -0.45805E-02 0 -2.0218 -0.49790E-02 0 -2.0225 -0.52840E-02 0 -2.0234 -0.55725E-02 0 -2.0244 -0.57898E-02 0 -2.0254 -0.59200E-02 0 -2.0265 -0.60427E-02 0 -2.0275 -0.60215E-02 0 -2.0286 -0.60003E-02 0 -2.0297 -0.59101E-02 0 -2.0307 -0.57827E-02 0 -2.0318 -0.56421E-02 0 -2.0328 -0.54617E-02 0 -2.0337 -0.52813E-02 0 -2.0346 -0.50777E-02 0 -2.0355 -0.48701E-02 0 -2.0364 -0.46352E-02 0 -2.0373 -0.43669E-02 0 -2.0382 -0.40899E-02 0 -2.0391 -0.36473E-02 0 -2.0401 -0.32046E-02 0 -2.0410 -0.25207E-02 0 -2.0419 -0.17068E-02 0 -2.0426 -0.77142E-03 0 -2.0436 --0.52845E-03 0 -2.0450 --0.22116E-02 0 -2.0459 --0.41795E-02 0 -2.0467 --0.66179E-02 0 -2.0473 --0.96091E-02 0 -2.0478 --0.13060E-01 0 -2.0479 --0.17336E-01 0 -2.0467 --0.21612E-01 0 -2.0456 --0.27155E-01 0 -2.0432 --0.32922E-01 0 -2.0406 --0.39377E-01 0 -2.0369 --0.46674E-01 0 -2.0318 --0.54042E-01 0 -2.0265 --0.62769E-01 0 -2.0183 --0.71495E-01 0 -2.0100 --0.80998E-01 0 -1.9992 --0.90917E-01 0 -1.9871 --0.10105 0 -1.9740 --0.11181 0 -1.9576 --0.12258 0 -1.9411 --0.13370 0 -1.9208 --0.14489 0 -1.8998 --0.15606 0 -1.8766 --0.16722 0 -1.8509 --0.17835 0 -1.8249 --0.18905 0 -1.7946 --0.19974 0 -1.7643 --0.20987 0 -1.7314 --0.21969 0 -1.6972 --0.22924 0 -1.6619 --0.23797 0 -1.6235 --0.24638 0 -1.5845 --0.25388 0 -1.5436 --0.26102 0 -1.5022 --0.26709 0 -1.4590 --0.27277 0 -1.4154 --0.27726 0 -1.3704 --0.28132 0 -1.3251 --0.28409 0 -1.2789 --0.28641 0 -1.2323 --0.28738 0 -1.1843 --0.28783 0 -1.1369 --0.28671 0 -1.0912 --0.28559 0 -1.0455 --0.28301 0 -1.0000 --0.27964 0 -0.95462 --0.27617 0 -0.90931 --0.27084 0 -0.86601 --0.26550 0 -0.82271 --0.25947 0 -0.78072 --0.25258 0 -0.74032 --0.24570 0 -0.69992 --0.23791 0 -0.66245 --0.22997 0 -0.62550 --0.22188 0 -0.58949 --0.21336 0 -0.55629 --0.20484 0 -0.52310 --0.19624 0 -0.49240 --0.18758 0 -0.46304 --0.17894 0 -0.43388 --0.17049 0 -0.40827 --0.16203 0 -0.38265 --0.15379 0 -0.35863 --0.14579 0 -0.33654 --0.13779 0 -0.31446 --0.13030 0 -0.29491 --0.12291 0 -0.27580 --0.11575 0 -0.25774 --0.10926 0 -0.24282 --0.10277 0 -0.22790 --0.96285E-01 0 -0.21298 --0.90084E-01 0 -0.19888 --0.84741E-01 0 -0.18722 --0.79399E-01 0 -0.17557 --0.74057E-01 0 -0.16392 --0.68990E-01 0 -0.15299 --0.64748E-01 0 -0.14424 --0.60506E-01 0 -0.13548 --0.56264E-01 0 -0.12673 --0.52266E-01 0 -0.11853 --0.48997E-01 0 -0.11200 --0.45728E-01 0 -0.10547 --0.42458E-01 0 -0.98933E-01 --0.39390E-01 0 -0.92814E-01 --0.36925E-01 0 -0.87936E-01 --0.34459E-01 0 -0.83058E-01 --0.31993E-01 0 -0.78181E-01 --0.29685E-01 0 -0.73607E-01 --0.27849E-01 0 -0.69945E-01 --0.26012E-01 0 -0.66283E-01 --0.24176E-01 0 -0.62621E-01 --0.22458E-01 0 -0.59181E-01 --0.21097E-01 0 -0.56407E-01 --0.19736E-01 0 -0.53634E-01 --0.18375E-01 0 -0.50860E-01 --0.17102E-01 0 -0.48250E-01 --0.16091E-01 0 -0.46128E-01 --0.15081E-01 0 -0.44007E-01 --0.14071E-01 0 -0.41886E-01 --0.13125E-01 0 -0.39885E-01 --0.12372E-01 0 -0.38247E-01 --0.11618E-01 0 -0.36609E-01 --0.10865E-01 0 -0.34971E-01 --0.10157E-01 0 -0.33205E-01 --0.95871E-02 0 -0.31060E-01 --0.90172E-02 0 -0.28914E-01 --0.84472E-02 0 -0.26768E-01 --0.79115E-02 0 -0.25142E-01 --0.74782E-02 0 -0.25076E-01 --0.70450E-02 0 -0.25010E-01 --0.66118E-02 0 -0.24944E-01 --0.62035E-02 0 -0.24693E-01 --0.58700E-02 0 -0.23887E-01 --0.55365E-02 0 -0.23081E-01 --0.52030E-02 0 -0.22275E-01 --0.48872E-02 0 -0.21511E-01 --0.46243E-02 0 -0.20873E-01 --0.43614E-02 0 -0.20236E-01 --0.40985E-02 0 -0.19599E-01 --0.38486E-02 0 -0.18995E-01 --0.36375E-02 0 -0.18492E-01 --0.34264E-02 0 -0.17989E-01 --0.32153E-02 0 -0.17486E-01 --0.30137E-02 0 -0.17010E-01 --0.28405E-02 0 -0.16617E-01 --0.26673E-02 0 -0.16223E-01 --0.24941E-02 0 -0.15830E-01 --0.23277E-02 0 -0.15460E-01 --0.21820E-02 0 -0.15158E-01 --0.20363E-02 0 -0.14856E-01 --0.18906E-02 0 -0.14554E-01 --0.17498E-02 0 -0.14272E-01 --0.16236E-02 0 -0.14049E-01 --0.14975E-02 0 -0.13825E-01 --0.13713E-02 0 -0.13602E-01 --0.12485E-02 0 -0.13396E-01 --0.11357E-02 0 -0.13242E-01 --0.10230E-02 0 -0.13088E-01 --0.91020E-03 0 -0.12935E-01 --0.79951E-03 0 -0.12797E-01 --0.69508E-03 0 -0.12706E-01 --0.59065E-03 0 -0.12616E-01 --0.48622E-03 0 -0.12525E-01 --0.38281E-03 0 -0.11679E-01 --0.28245E-03 0 -0.85646E-02 --0.18209E-03 0 -0.54502E-02 --0.81727E-04 0 -0.23358E-02 -0.24827 0 -1.1837 -0.24343 0 -1.2147 -0.23771 0 -1.2485 -0.23160 0 -1.2835 -0.22505 0 -1.3172 -0.21807 0 -1.3497 -0.21094 0 -1.3814 -0.20349 0 -1.4112 -0.19604 0 -1.4405 -0.18850 0 -1.4676 -0.18097 0 -1.4946 -0.17364 0 -1.5191 -0.16632 0 -1.5435 -0.15934 0 -1.5659 -0.15245 0 -1.5878 -0.14590 0 -1.6084 -0.13957 0 -1.6282 -0.13350 0 -1.6470 -0.12777 0 -1.6648 -0.12218 0 -1.6822 -0.11704 0 -1.6983 -0.11192 0 -1.7143 -0.10730 0 -1.7289 -0.10267 0 -1.7435 -0.98430E-01 0 -1.7570 -0.94242E-01 0 -1.7703 -0.90311E-01 0 -1.7828 -0.86490E-01 0 -1.7949 -0.82834E-01 0 -1.8065 -0.79332E-01 0 -1.8175 -0.75930E-01 0 -1.8282 -0.72728E-01 0 -1.8382 -0.69573E-01 0 -1.8481 -0.66680E-01 0 -1.8572 -0.63787E-01 0 -1.8662 -0.61216E-01 0 -1.8745 -0.58654E-01 0 -1.8827 -0.56367E-01 0 -1.8904 -0.54151E-01 0 -1.8979 -0.52143E-01 0 -1.9050 -0.50266E-01 0 -1.9120 -0.48522E-01 0 -1.9180 -0.46954E-01 0 -1.9227 -0.45432E-01 0 -1.9285 -0.44045E-01 0 -1.9372 -0.42706E-01 0 -1.9439 -0.41391E-01 0 -1.9498 -0.40099E-01 0 -1.9556 -0.38784E-01 0 -1.9612 -0.37431E-01 0 -1.9667 -0.35988E-01 0 -1.9721 -0.34544E-01 0 -1.9775 -0.32910E-01 0 -1.9825 -0.31241E-01 0 -1.9874 -0.29464E-01 0 -1.9919 -0.27554E-01 0 -1.9962 -0.25634E-01 0 -2.0003 -0.23549E-01 0 -2.0038 -0.21464E-01 0 -2.0072 -0.19355E-01 0 -2.0100 -0.17233E-01 0 -2.0125 -0.15146E-01 0 -2.0148 -0.13167E-01 0 -2.0164 -0.11188E-01 0 -2.0179 -0.94829E-02 0 -2.0188 -0.78266E-02 0 -2.0196 -0.63783E-02 0 -2.0201 -0.51844E-02 0 -2.0202 -0.40169E-02 0 -2.0204 -0.33510E-02 0 -2.0202 -0.26851E-02 0 -2.0200 -0.23466E-02 0 -2.0197 -0.21844E-02 0 -2.0194 -0.21065E-02 0 -2.0191 -0.22814E-02 0 -2.0191 -0.25967E-02 0 -2.0191 -0.29881E-02 0 -2.0192 -0.34674E-02 0 -2.0195 -0.39818E-02 0 -2.0200 -0.44985E-02 0 -2.0207 -0.49873E-02 0 -2.0214 -0.54760E-02 0 -2.0221 -0.58394E-02 0 -2.0231 -0.61805E-02 0 -2.0241 -0.64318E-02 0 -2.0252 -0.65730E-02 0 -2.0264 -0.67051E-02 0 -2.0275 -0.66635E-02 0 -2.0287 -0.66218E-02 0 -2.0298 -0.65037E-02 0 -2.0309 -0.63443E-02 0 -2.0319 -0.61747E-02 0 -2.0329 -0.59744E-02 0 -2.0339 -0.57741E-02 0 -2.0348 -0.55775E-02 0 -2.0357 -0.53815E-02 0 -2.0366 -0.51763E-02 0 -2.0375 -0.49597E-02 0 -2.0384 -0.47360E-02 0 -2.0394 -0.43777E-02 0 -2.0405 -0.40193E-02 0 -2.0415 -0.34246E-02 0 -2.0425 -0.27026E-02 0 -2.0435 -0.18536E-02 0 -2.0446 -0.62369E-03 0 -2.0464 --0.10190E-02 0 -2.0477 --0.29711E-02 0 -2.0489 --0.54383E-02 0 -2.0500 --0.85176E-02 0 -2.0510 --0.12108E-01 0 -2.0517 --0.16622E-01 0 -2.0512 --0.21135E-01 0 -2.0507 --0.27074E-01 0 -2.0490 --0.33264E-01 0 -2.0470 --0.40232E-01 0 -2.0440 --0.48152E-01 0 -2.0396 --0.56152E-01 0 -2.0350 --0.65690E-01 0 -2.0273 --0.75229E-01 0 -2.0197 --0.85645E-01 0 -2.0094 --0.96533E-01 0 -1.9978 --0.10766 0 -1.9850 --0.11950 0 -1.9689 --0.13134 0 -1.9527 --0.14359 0 -1.9325 --0.15590 0 -1.9116 --0.16820 0 -1.8884 --0.18048 0 -1.8626 --0.19274 0 -1.8365 --0.20449 0 -1.8058 --0.21625 0 -1.7752 --0.22739 0 -1.7419 --0.23818 0 -1.7072 --0.24868 0 -1.6714 --0.25827 0 -1.6324 --0.26752 0 -1.5928 --0.27576 0 -1.5512 --0.28361 0 -1.5090 --0.29030 0 -1.4651 --0.29655 0 -1.4206 --0.30150 0 -1.3748 --0.30598 0 -1.3286 --0.30904 0 -1.2815 --0.31159 0 -1.2339 --0.31265 0 -1.1849 --0.31313 0 -1.1365 --0.31187 0 -1.0900 --0.31060 0 -1.0434 --0.30771 0 -0.99703 --0.30394 0 -0.95077 --0.30005 0 -0.90463 --0.29409 0 -0.86062 --0.28813 0 -0.81662 --0.28140 0 -0.77400 --0.27374 0 -0.73308 --0.26607 0 -0.69216 --0.25743 0 -0.65434 --0.24862 0 -0.61707 --0.23966 0 -0.58079 --0.23026 0 -0.54746 --0.22087 0 -0.51414 --0.21140 0 -0.48340 --0.20190 0 -0.45407 --0.19241 0 -0.42493 --0.18318 0 -0.39946 --0.17395 0 -0.37399 --0.16496 0 -0.35014 --0.15626 0 -0.32827 --0.14755 0 -0.30640 --0.13944 0 -0.28714 --0.13143 0 -0.26833 --0.12367 0 -0.25056 --0.11667 0 -0.23592 --0.10966 0 -0.22127 --0.10266 0 -0.20663 --0.95966E-01 0 -0.19281 --0.90224E-01 0 -0.18145 --0.84482E-01 0 -0.17009 --0.78739E-01 0 -0.15873 --0.73298E-01 0 -0.14809 --0.68760E-01 0 -0.13961 --0.64221E-01 0 -0.13113 --0.59682E-01 0 -0.12265 --0.55408E-01 0 -0.11471 --0.51927E-01 0 -0.10841 --0.48445E-01 0 -0.10211 --0.44963E-01 0 -0.95805E-01 --0.41698E-01 0 -0.89905E-01 --0.39083E-01 0 -0.85213E-01 --0.36468E-01 0 -0.80521E-01 --0.33852E-01 0 -0.75829E-01 --0.31405E-01 0 -0.71431E-01 --0.29463E-01 0 -0.67911E-01 --0.27521E-01 0 -0.64392E-01 --0.25579E-01 0 -0.60873E-01 --0.23763E-01 0 -0.57566E-01 --0.22326E-01 0 -0.54899E-01 --0.20888E-01 0 -0.52232E-01 --0.19451E-01 0 -0.49565E-01 --0.18106E-01 0 -0.47054E-01 --0.17040E-01 0 -0.45011E-01 --0.15974E-01 0 -0.42967E-01 --0.14908E-01 0 -0.40924E-01 --0.13909E-01 0 -0.38996E-01 --0.13114E-01 0 -0.37415E-01 --0.12318E-01 0 -0.35834E-01 --0.11523E-01 0 -0.34252E-01 --0.10775E-01 0 -0.32542E-01 --0.10172E-01 0 -0.30444E-01 --0.95694E-02 0 -0.28347E-01 --0.89665E-02 0 -0.26249E-01 --0.83996E-02 0 -0.24665E-01 --0.79406E-02 0 -0.24621E-01 --0.74816E-02 0 -0.24577E-01 --0.70226E-02 0 -0.24533E-01 --0.65901E-02 0 -0.24304E-01 --0.62368E-02 0 -0.23520E-01 --0.58836E-02 0 -0.22735E-01 --0.55304E-02 0 -0.21951E-01 --0.51959E-02 0 -0.21207E-01 --0.49172E-02 0 -0.20585E-01 --0.46386E-02 0 -0.19964E-01 --0.43599E-02 0 -0.19342E-01 --0.40949E-02 0 -0.18753E-01 --0.38709E-02 0 -0.18262E-01 --0.36470E-02 0 -0.17770E-01 --0.34230E-02 0 -0.17279E-01 --0.32090E-02 0 -0.16814E-01 --0.30250E-02 0 -0.16429E-01 --0.28410E-02 0 -0.16044E-01 --0.26570E-02 0 -0.15659E-01 --0.24802E-02 0 -0.15296E-01 --0.23252E-02 0 -0.15000E-01 --0.21702E-02 0 -0.14705E-01 --0.20152E-02 0 -0.14409E-01 --0.18654E-02 0 -0.14132E-01 --0.17311E-02 0 -0.13913E-01 --0.15968E-02 0 -0.13694E-01 --0.14624E-02 0 -0.13475E-01 --0.13316E-02 0 -0.13273E-01 --0.12114E-02 0 -0.13122E-01 --0.10912E-02 0 -0.12971E-01 --0.97101E-03 0 -0.12820E-01 --0.85301E-03 0 -0.12685E-01 --0.74161E-03 0 -0.12596E-01 --0.63022E-03 0 -0.12507E-01 --0.51883E-03 0 -0.12418E-01 --0.40851E-03 0 -0.11580E-01 --0.30142E-03 0 -0.84917E-02 --0.19432E-03 0 -0.54038E-02 --0.87232E-04 0 -0.23159E-02 -0.26857 0 -1.1889 -0.26312 0 -1.2204 -0.25668 0 -1.2548 -0.24982 0 -1.2903 -0.24248 0 -1.3245 -0.23467 0 -1.3573 -0.22672 0 -1.3892 -0.21845 0 -1.4191 -0.21017 0 -1.4486 -0.20185 0 -1.4756 -0.19353 0 -1.5026 -0.18549 0 -1.5269 -0.17747 0 -1.5511 -0.16986 0 -1.5733 -0.16237 0 -1.5950 -0.15528 0 -1.6153 -0.14845 0 -1.6347 -0.14192 0 -1.6533 -0.13579 0 -1.6708 -0.12982 0 -1.6879 -0.12435 0 -1.7037 -0.11891 0 -1.7195 -0.11402 0 -1.7338 -0.10912 0 -1.7482 -0.10463 0 -1.7615 -0.10020 0 -1.7746 -0.96029E-01 0 -1.7869 -0.91975E-01 0 -1.7989 -0.88087E-01 0 -1.8103 -0.84352E-01 0 -1.8212 -0.80720E-01 0 -1.8317 -0.77288E-01 0 -1.8416 -0.73907E-01 0 -1.8513 -0.70798E-01 0 -1.8602 -0.67689E-01 0 -1.8691 -0.64931E-01 0 -1.8772 -0.62182E-01 0 -1.8853 -0.59742E-01 0 -1.8928 -0.57383E-01 0 -1.9001 -0.55263E-01 0 -1.9071 -0.53294E-01 0 -1.9139 -0.51481E-01 0 -1.9197 -0.49876E-01 0 -1.9244 -0.48323E-01 0 -1.9300 -0.46929E-01 0 -1.9386 -0.45589E-01 0 -1.9452 -0.44275E-01 0 -1.9511 -0.42984E-01 0 -1.9569 -0.41660E-01 0 -1.9625 -0.40286E-01 0 -1.9681 -0.38795E-01 0 -1.9736 -0.37304E-01 0 -1.9791 -0.35568E-01 0 -1.9842 -0.33789E-01 0 -1.9892 -0.31871E-01 0 -1.9939 -0.29782E-01 0 -1.9982 -0.27682E-01 0 -2.0025 -0.25362E-01 0 -2.0060 -0.23043E-01 0 -2.0095 -0.20682E-01 0 -2.0123 -0.18299E-01 0 -2.0148 -0.15954E-01 0 -2.0170 -0.13723E-01 0 -2.0185 -0.11493E-01 0 -2.0200 -0.95775E-02 0 -2.0207 -0.77180E-02 0 -2.0213 -0.61015E-02 0 -2.0215 -0.47822E-02 0 -2.0215 -0.34939E-02 0 -2.0214 -0.27946E-02 0 -2.0209 -0.20953E-02 0 -2.0205 -0.17796E-02 0 -2.0200 -0.16705E-02 0 -2.0194 -0.16592E-02 0 -2.0190 -0.19413E-02 0 -2.0188 -0.23829E-02 0 -2.0186 -0.29095E-02 0 -2.0186 -0.35318E-02 0 -2.0189 -0.41855E-02 0 -2.0194 -0.48337E-02 0 -2.0201 -0.54344E-02 0 -2.0208 -0.60350E-02 0 -2.0216 -0.64676E-02 0 -2.0227 -0.68705E-02 0 -2.0238 -0.71590E-02 0 -2.0250 -0.73078E-02 0 -2.0262 -0.74455E-02 0 -2.0275 -0.73712E-02 0 -2.0287 -0.72969E-02 0 -2.0299 -0.71372E-02 0 -2.0310 -0.69315E-02 0 -2.0321 -0.67200E-02 0 -2.0332 -0.64910E-02 0 -2.0341 -0.62619E-02 0 -2.0350 -0.60741E-02 0 -2.0359 -0.58935E-02 0 -2.0368 -0.57293E-02 0 -2.0377 -0.55853E-02 0 -2.0386 -0.54367E-02 0 -2.0396 -0.52016E-02 0 -2.0408 -0.49666E-02 0 -2.0419 -0.45095E-02 0 -2.0431 -0.39329E-02 0 -2.0442 -0.32257E-02 0 -2.0456 -0.21264E-02 0 -2.0477 -0.58540E-03 0 -2.0495 --0.12903E-02 0 -2.0511 --0.37282E-02 0 -2.0527 --0.68430E-02 0 -2.0544 --0.10527E-01 0 -2.0558 --0.15243E-01 0 -2.0560 --0.19958E-01 0 -2.0562 --0.26279E-01 0 -2.0553 --0.32883E-01 0 -2.0541 --0.40367E-01 0 -2.0519 --0.48929E-01 0 -2.0483 --0.57582E-01 0 -2.0445 --0.67979E-01 0 -2.0375 --0.78376E-01 0 -2.0305 --0.89768E-01 0 -2.0209 --0.10169 0 -2.0098 --0.11389 0 -1.9975 --0.12689 0 -1.9817 --0.13990 0 -1.9659 --0.15335 0 -1.9458 --0.16688 0 -1.9249 --0.18039 0 -1.9018 --0.19388 0 -1.8758 --0.20734 0 -1.8495 --0.22024 0 -1.8185 --0.23314 0 -1.7876 --0.24534 0 -1.7538 --0.25718 0 -1.7185 --0.26868 0 -1.6822 --0.27919 0 -1.6425 --0.28933 0 -1.6022 --0.29837 0 -1.5598 --0.30699 0 -1.5168 --0.31434 0 -1.4719 --0.32121 0 -1.4266 --0.32666 0 -1.3798 --0.33159 0 -1.3326 --0.33496 0 -1.2844 --0.33778 0 -1.2358 --0.33895 0 -1.1856 --0.33946 0 -1.1361 --0.33804 0 -1.0885 --0.33661 0 -1.0409 --0.33336 0 -0.99356 --0.32914 0 -0.94634 --0.32479 0 -0.89923 --0.31813 0 -0.85443 --0.31147 0 -0.80963 --0.30396 0 -0.76631 --0.29543 0 -0.72481 --0.28689 0 -0.68330 --0.27731 0 -0.64510 --0.26755 0 -0.60749 --0.25764 0 -0.57091 --0.24729 0 -0.53745 --0.23694 0 -0.50400 --0.22656 0 -0.47325 --0.21616 0 -0.44396 --0.20577 0 -0.41488 --0.19572 0 -0.38958 --0.18567 0 -0.36428 --0.17590 0 -0.34065 --0.16648 0 -0.31904 --0.15705 0 -0.29744 --0.14829 0 -0.27850 --0.13965 0 -0.26003 --0.13128 0 -0.24259 --0.12376 0 -0.22827 --0.11623 0 -0.21395 --0.10871 0 -0.19962 --0.10153 0 -0.18612 --0.95390E-01 0 -0.17510 --0.89252E-01 0 -0.16407 --0.83114E-01 0 -0.15304 --0.77304E-01 0 -0.14273 --0.72478E-01 0 -0.13455 --0.67653E-01 0 -0.12637 --0.62827E-01 0 -0.11819 --0.58287E-01 0 -0.11054 --0.54606E-01 0 -0.10450 --0.50924E-01 0 -0.98452E-01 --0.47243E-01 0 -0.92407E-01 --0.43794E-01 0 -0.86751E-01 --0.41041E-01 0 -0.82263E-01 --0.38288E-01 0 -0.77775E-01 --0.35536E-01 0 -0.73287E-01 --0.32962E-01 0 -0.69081E-01 --0.30925E-01 0 -0.65717E-01 --0.28887E-01 0 -0.62353E-01 --0.26850E-01 0 -0.58989E-01 --0.24945E-01 0 -0.55828E-01 --0.23440E-01 0 -0.53276E-01 --0.21935E-01 0 -0.50724E-01 --0.20429E-01 0 -0.48172E-01 --0.19022E-01 0 -0.45768E-01 --0.17906E-01 0 -0.43809E-01 --0.16790E-01 0 -0.41850E-01 --0.15674E-01 0 -0.39890E-01 --0.14628E-01 0 -0.38041E-01 --0.13795E-01 0 -0.36520E-01 --0.12962E-01 0 -0.35000E-01 --0.12128E-01 0 -0.33480E-01 --0.11345E-01 0 -0.31828E-01 --0.10713E-01 0 -0.29782E-01 --0.10081E-01 0 -0.27736E-01 --0.94484E-02 0 -0.25690E-01 --0.88537E-02 0 -0.24150E-01 --0.83715E-02 0 -0.24130E-01 --0.78894E-02 0 -0.24110E-01 --0.74073E-02 0 -0.24090E-01 --0.69529E-02 0 -0.23885E-01 --0.65815E-02 0 -0.23123E-01 --0.62102E-02 0 -0.22362E-01 --0.58389E-02 0 -0.21601E-01 --0.54871E-02 0 -0.20879E-01 --0.51939E-02 0 -0.20274E-01 --0.49007E-02 0 -0.19670E-01 --0.46074E-02 0 -0.19065E-01 --0.43285E-02 0 -0.18492E-01 --0.40925E-02 0 -0.18013E-01 --0.38565E-02 0 -0.17534E-01 --0.36205E-02 0 -0.17055E-01 --0.33950E-02 0 -0.16601E-01 --0.32008E-02 0 -0.16225E-01 --0.30067E-02 0 -0.15849E-01 --0.28125E-02 0 -0.15474E-01 --0.26260E-02 0 -0.15119E-01 --0.24622E-02 0 -0.14830E-01 --0.22984E-02 0 -0.14541E-01 --0.21346E-02 0 -0.14251E-01 --0.19763E-02 0 -0.13981E-01 --0.18342E-02 0 -0.13766E-01 --0.16920E-02 0 -0.13552E-01 --0.15499E-02 0 -0.13337E-01 --0.14115E-02 0 -0.13140E-01 --0.12842E-02 0 -0.12992E-01 --0.11568E-02 0 -0.12844E-01 --0.10295E-02 0 -0.12696E-01 --0.90449E-03 0 -0.12563E-01 --0.78640E-03 0 -0.12476E-01 --0.66832E-03 0 -0.12389E-01 --0.55023E-03 0 -0.12301E-01 --0.43327E-03 0 -0.11471E-01 --0.31969E-03 0 -0.84124E-02 --0.20612E-03 0 -0.53533E-02 --0.92540E-04 0 -0.22943E-02 -0.28888 0 -1.1941 -0.28280 0 -1.2262 -0.27566 0 -1.2611 -0.26804 0 -1.2972 -0.25991 0 -1.3317 -0.25128 0 -1.3649 -0.24250 0 -1.3970 -0.23340 0 -1.4271 -0.22430 0 -1.4567 -0.21519 0 -1.4836 -0.20609 0 -1.5106 -0.19735 0 -1.5347 -0.18862 0 -1.5588 -0.18038 0 -1.5808 -0.17229 0 -1.6022 -0.16466 0 -1.6222 -0.15733 0 -1.6413 -0.15034 0 -1.6596 -0.14381 0 -1.6768 -0.13746 0 -1.6936 -0.13166 0 -1.7092 -0.12591 0 -1.7246 -0.12073 0 -1.7388 -0.11556 0 -1.7529 -0.11083 0 -1.7660 -0.10615 0 -1.7789 -0.10175 0 -1.7911 -0.97460E-01 0 -1.8028 -0.93339E-01 0 -1.8141 -0.89372E-01 0 -1.8248 -0.85509E-01 0 -1.8352 -0.81849E-01 0 -1.8449 -0.78241E-01 0 -1.8545 -0.74917E-01 0 -1.8633 -0.71592E-01 0 -1.8720 -0.68646E-01 0 -1.8799 -0.65710E-01 0 -1.8878 -0.63118E-01 0 -1.8952 -0.60615E-01 0 -1.9023 -0.58383E-01 0 -1.9092 -0.56322E-01 0 -1.9158 -0.54440E-01 0 -1.9215 -0.52797E-01 0 -1.9260 -0.51214E-01 0 -1.9316 -0.49813E-01 0 -1.9401 -0.48472E-01 0 -1.9466 -0.47159E-01 0 -1.9524 -0.45869E-01 0 -1.9582 -0.44536E-01 0 -1.9639 -0.43142E-01 0 -1.9695 -0.41602E-01 0 -1.9751 -0.40063E-01 0 -1.9807 -0.38227E-01 0 -1.9859 -0.36338E-01 0 -1.9911 -0.34278E-01 0 -1.9959 -0.32011E-01 0 -2.0003 -0.29729E-01 0 -2.0047 -0.27176E-01 0 -2.0083 -0.24622E-01 0 -2.0118 -0.22010E-01 0 -2.0146 -0.19365E-01 0 -2.0171 -0.16761E-01 0 -2.0193 -0.14280E-01 0 -2.0207 -0.11798E-01 0 -2.0220 -0.96722E-02 0 -2.0226 -0.76093E-02 0 -2.0230 -0.58246E-02 0 -2.0230 -0.43799E-02 0 -2.0227 -0.29708E-02 0 -2.0223 -0.22382E-02 0 -2.0217 -0.15055E-02 0 -2.0210 -0.12126E-02 0 -2.0202 -0.11566E-02 0 -2.0195 -0.12119E-02 0 -2.0188 -0.16012E-02 0 -2.0184 -0.21691E-02 0 -2.0182 -0.28310E-02 0 -2.0181 -0.35961E-02 0 -2.0182 -0.43891E-02 0 -2.0188 -0.51689E-02 0 -2.0195 -0.58815E-02 0 -2.0203 -0.65940E-02 0 -2.0211 -0.70958E-02 0 -2.0222 -0.75604E-02 0 -2.0235 -0.78863E-02 0 -2.0248 -0.80427E-02 0 -2.0261 -0.81859E-02 0 -2.0275 -0.80789E-02 0 -2.0287 -0.79719E-02 0 -2.0300 -0.77707E-02 0 -2.0312 -0.75187E-02 0 -2.0323 -0.72653E-02 0 -2.0334 -0.70076E-02 0 -2.0343 -0.67498E-02 0 -2.0352 -0.65706E-02 0 -2.0361 -0.64054E-02 0 -2.0370 -0.62823E-02 0 -2.0379 -0.62109E-02 0 -2.0388 -0.61374E-02 0 -2.0398 -0.60256E-02 0 -2.0410 -0.59138E-02 0 -2.0423 -0.55944E-02 0 -2.0436 -0.51633E-02 0 -2.0450 -0.45978E-02 0 -2.0466 -0.36291E-02 0 -2.0490 -0.21898E-02 0 -2.0512 -0.39053E-03 0 -2.0534 --0.20181E-02 0 -2.0555 --0.51684E-02 0 -2.0578 --0.89460E-02 0 -2.0598 --0.13863E-01 0 -2.0608 --0.18781E-01 0 -2.0617 --0.25484E-01 0 -2.0616 --0.32501E-01 0 -2.0612 --0.40503E-01 0 -2.0598 --0.49706E-01 0 -2.0569 --0.59012E-01 0 -2.0539 --0.70268E-01 0 -2.0476 --0.81524E-01 0 -2.0414 --0.93891E-01 0 -2.0323 --0.10686 0 -2.0217 --0.12012 0 -2.0100 --0.13429 0 -1.9945 --0.14845 0 -1.9790 --0.16311 0 -1.9590 --0.17786 0 -1.9383 --0.19258 0 -1.9151 --0.20728 0 -1.8890 --0.22194 0 -1.8626 --0.23598 0 -1.8312 --0.25002 0 -1.7999 --0.26330 0 -1.7657 --0.27617 0 -1.7299 --0.28868 0 -1.6929 --0.30011 0 -1.6526 --0.31114 0 -1.6116 --0.32098 0 -1.5684 --0.33037 0 -1.5246 --0.33838 0 -1.4788 --0.34587 0 -1.4325 --0.35182 0 -1.3847 --0.35721 0 -1.3366 --0.36089 0 -1.2874 --0.36397 0 -1.2376 --0.36524 0 -1.1863 --0.36579 0 -1.1357 --0.36420 0 -1.0871 --0.36261 0 -1.0384 --0.35902 0 -0.99010 --0.35434 0 -0.94191 --0.34953 0 -0.89384 --0.34217 0 -0.84824 --0.33481 0 -0.80263 --0.32652 0 -0.75861 --0.31712 0 -0.71653 --0.30771 0 -0.67445 --0.29720 0 -0.63586 --0.28648 0 -0.59790 --0.27562 0 -0.56103 --0.26432 0 -0.52744 --0.25302 0 -0.49386 --0.24171 0 -0.46309 --0.23041 0 -0.43385 --0.21913 0 -0.40482 --0.20826 0 -0.37970 --0.19740 0 -0.35458 --0.18685 0 -0.33116 --0.17670 0 -0.30981 --0.16655 0 -0.28847 --0.15714 0 -0.26986 --0.14786 0 -0.25173 --0.13890 0 -0.23463 --0.13085 0 -0.22063 --0.12280 0 -0.20662 --0.11476 0 -0.19261 --0.10709 0 -0.17944 --0.10056 0 -0.16874 --0.94022E-01 0 -0.15805 --0.87488E-01 0 -0.14735 --0.81309E-01 0 -0.13736 --0.76197E-01 0 -0.12949 --0.71084E-01 0 -0.12161 --0.65972E-01 0 -0.11373 --0.61167E-01 0 -0.10638 --0.57285E-01 0 -0.10059 --0.53404E-01 0 -0.94798E-01 --0.49522E-01 0 -0.89009E-01 --0.45889E-01 0 -0.83596E-01 --0.42999E-01 0 -0.79312E-01 --0.40109E-01 0 -0.75029E-01 --0.37219E-01 0 -0.70745E-01 --0.34519E-01 0 -0.66731E-01 --0.32386E-01 0 -0.63522E-01 --0.30253E-01 0 -0.60314E-01 --0.28120E-01 0 -0.57105E-01 --0.26128E-01 0 -0.54090E-01 --0.24554E-01 0 -0.51653E-01 --0.22981E-01 0 -0.49216E-01 --0.21408E-01 0 -0.46779E-01 --0.19937E-01 0 -0.44483E-01 --0.18771E-01 0 -0.42607E-01 --0.17605E-01 0 -0.40732E-01 --0.16439E-01 0 -0.38857E-01 --0.15347E-01 0 -0.37085E-01 --0.14476E-01 0 -0.35626E-01 --0.13605E-01 0 -0.34166E-01 --0.12734E-01 0 -0.32707E-01 --0.11916E-01 0 -0.31114E-01 --0.11254E-01 0 -0.29119E-01 --0.10592E-01 0 -0.27125E-01 --0.99303E-02 0 -0.25131E-01 --0.93077E-02 0 -0.23636E-01 --0.88024E-02 0 -0.23640E-01 --0.82972E-02 0 -0.23643E-01 --0.77920E-02 0 -0.23647E-01 --0.73157E-02 0 -0.23465E-01 --0.69262E-02 0 -0.22727E-01 --0.65368E-02 0 -0.21989E-01 --0.61474E-02 0 -0.21251E-01 --0.57784E-02 0 -0.20551E-01 --0.54706E-02 0 -0.19963E-01 --0.51628E-02 0 -0.19375E-01 --0.48550E-02 0 -0.18788E-01 --0.45621E-02 0 -0.18230E-01 --0.43141E-02 0 -0.17764E-01 --0.40661E-02 0 -0.17297E-01 --0.38181E-02 0 -0.16830E-01 --0.35810E-02 0 -0.16389E-01 --0.33767E-02 0 -0.16022E-01 --0.31724E-02 0 -0.15655E-01 --0.29681E-02 0 -0.15288E-01 --0.27717E-02 0 -0.14942E-01 --0.25991E-02 0 -0.14660E-01 --0.24266E-02 0 -0.14377E-01 --0.22540E-02 0 -0.14094E-01 --0.20871E-02 0 -0.13829E-01 --0.19372E-02 0 -0.13620E-01 --0.17873E-02 0 -0.13410E-01 --0.16374E-02 0 -0.13200E-01 --0.14913E-02 0 -0.13006E-01 --0.13569E-02 0 -0.12861E-01 --0.12224E-02 0 -0.12716E-01 --0.10880E-02 0 -0.12571E-01 --0.95597E-03 0 -0.12441E-01 --0.83119E-03 0 -0.12356E-01 --0.70641E-03 0 -0.12270E-01 --0.58163E-03 0 -0.12185E-01 --0.45803E-03 0 -0.11363E-01 --0.33797E-03 0 -0.83330E-02 --0.21791E-03 0 -0.53028E-02 --0.97849E-04 0 -0.22726E-02 -0.31059 0 -1.2007 -0.30371 0 -1.2335 -0.29566 0 -1.2691 -0.28709 0 -1.3058 -0.27797 0 -1.3409 -0.26832 0 -1.3744 -0.25853 0 -1.4068 -0.24843 0 -1.4369 -0.23833 0 -1.4666 -0.22831 0 -1.4934 -0.21829 0 -1.5203 -0.20875 0 -1.5441 -0.19923 0 -1.5679 -0.19032 0 -1.5895 -0.18158 0 -1.6106 -0.17339 0 -1.6302 -0.16557 0 -1.6489 -0.15814 0 -1.6668 -0.15124 0 -1.6836 -0.14454 0 -1.7000 -0.13847 0 -1.7152 -0.13244 0 -1.7304 -0.12705 0 -1.7442 -0.12166 0 -1.7581 -0.11672 0 -1.7710 -0.11185 0 -1.7837 -0.10724 0 -1.7956 -0.10274 0 -1.8073 -0.98403E-01 0 -1.8184 -0.94207E-01 0 -1.8290 -0.90109E-01 0 -1.8392 -0.86203E-01 0 -1.8488 -0.82350E-01 0 -1.8582 -0.78781E-01 0 -1.8668 -0.75213E-01 0 -1.8754 -0.72054E-01 0 -1.8831 -0.68905E-01 0 -1.8908 -0.66147E-01 0 -1.8979 -0.63490E-01 0 -1.9048 -0.61151E-01 0 -1.9114 -0.59013E-01 0 -1.9178 -0.57091E-01 0 -1.9233 -0.55454E-01 0 -1.9277 -0.53890E-01 0 -1.9331 -0.52546E-01 0 -1.9414 -0.51272E-01 0 -1.9478 -0.50030E-01 0 -1.9537 -0.48811E-01 0 -1.9595 -0.47536E-01 0 -1.9652 -0.46180E-01 0 -1.9709 -0.44638E-01 0 -1.9767 -0.43095E-01 0 -1.9825 -0.41173E-01 0 -1.9879 -0.39183E-01 0 -1.9932 -0.36975E-01 0 -1.9982 -0.34500E-01 0 -2.0028 -0.32006E-01 0 -2.0074 -0.29158E-01 0 -2.0111 -0.26309E-01 0 -2.0147 -0.23371E-01 0 -2.0176 -0.20386E-01 0 -2.0201 -0.17443E-01 0 -2.0222 -0.14628E-01 0 -2.0234 -0.11814E-01 0 -2.0247 -0.94120E-02 0 -2.0250 -0.70826E-02 0 -2.0251 -0.50814E-02 0 -2.0249 -0.34812E-02 0 -2.0242 -0.19234E-02 0 -2.0235 -0.11687E-02 0 -2.0225 -0.41394E-03 0 -2.0214 -0.18041E-03 0 -2.0204 -0.22753E-03 0 -2.0193 -0.40518E-03 0 -2.0184 -0.97441E-03 0 -2.0178 -0.17477E-02 0 -2.0174 -0.26260E-02 0 -2.0172 -0.36151E-02 0 -2.0173 -0.46222E-02 0 -2.0178 -0.56008E-02 0 -2.0185 -0.64764E-02 0 -2.0194 -0.73520E-02 0 -2.0203 -0.79446E-02 0 -2.0217 -0.84873E-02 0 -2.0230 -0.88514E-02 0 -2.0245 -0.89974E-02 0 -2.0260 -0.91269E-02 0 -2.0275 -0.89450E-02 0 -2.0289 -0.87631E-02 0 -2.0303 -0.84734E-02 0 -2.0315 -0.81256E-02 0 -2.0327 -0.77838E-02 0 -2.0337 -0.74599E-02 0 -2.0346 -0.71361E-02 0 -2.0355 -0.69539E-02 0 -2.0363 -0.67968E-02 0 -2.0371 -0.67268E-02 0 -2.0379 -0.67632E-02 0 -2.0388 -0.68024E-02 0 -2.0397 -0.68953E-02 0 -2.0410 -0.69882E-02 0 -2.0423 -0.69133E-02 0 -2.0437 -0.67479E-02 0 -2.0453 -0.64493E-02 0 -2.0472 -0.57511E-02 0 -2.0500 -0.45567E-02 0 -2.0526 -0.29765E-02 0 -2.0553 -0.73542E-03 0 -2.0581 --0.23243E-02 0 -2.0612 --0.60820E-02 0 -2.0640 --0.11115E-01 0 -2.0659 --0.16147E-01 0 -2.0678 --0.23195E-01 0 -2.0686 --0.30598E-01 0 -2.0693 --0.39117E-01 0 -2.0689 --0.49000E-01 0 -2.0671 --0.59000E-01 0 -2.0651 --0.71216E-01 0 -2.0597 --0.83432E-01 0 -2.0543 --0.96909E-01 0 -2.0460 --0.11107 0 -2.0361 --0.12556 0 -2.0250 --0.14107 0 -2.0099 --0.15657 0 -1.9949 --0.17263 0 -1.9750 --0.18878 0 -1.9544 --0.20489 0 -1.9312 --0.22096 0 -1.9049 --0.23700 0 -1.8783 --0.25232 0 -1.8465 --0.26764 0 -1.8147 --0.28212 0 -1.7799 --0.29614 0 -1.7434 --0.30977 0 -1.7058 --0.32221 0 -1.6647 --0.33423 0 -1.6228 --0.34497 0 -1.5787 --0.35521 0 -1.5339 --0.36398 0 -1.4871 --0.37219 0 -1.4397 --0.37874 0 -1.3907 --0.38468 0 -1.3414 --0.38876 0 -1.2909 --0.39217 0 -1.2399 --0.39358 0 -1.1872 --0.39419 0 -1.1351 --0.39242 0 -1.0852 --0.39065 0 -1.0353 --0.38662 0 -0.98575 --0.38138 0 -0.93635 --0.37599 0 -0.88709 --0.36776 0 -0.84050 --0.35953 0 -0.79391 --0.35029 0 -0.74905 --0.33981 0 -0.70628 --0.32934 0 -0.66351 --0.31770 0 -0.62451 --0.30585 0 -0.58618 --0.29386 0 -0.54900 --0.28146 0 -0.51532 --0.26906 0 -0.48164 --0.25672 0 -0.45092 --0.24442 0 -0.42180 --0.23214 0 -0.39289 --0.22040 0 -0.36803 --0.20865 0 -0.34317 --0.19729 0 -0.32005 --0.18638 0 -0.29905 --0.17547 0 -0.27805 --0.16540 0 -0.25986 --0.15548 0 -0.24216 --0.14589 0 -0.22548 --0.13733 0 -0.21186 --0.12876 0 -0.19824 --0.12019 0 -0.18461 --0.11203 0 -0.17182 --0.10511 0 -0.16153 --0.98194E-01 0 -0.15123 --0.91274E-01 0 -0.14093 --0.84740E-01 0 -0.13132 --0.79362E-01 0 -0.12380 --0.73984E-01 0 -0.11628 --0.68606E-01 0 -0.10876 --0.63559E-01 0 -0.10175 --0.59504E-01 0 -0.96253E-01 --0.55448E-01 0 -0.90759E-01 --0.51393E-01 0 -0.85265E-01 --0.47601E-01 0 -0.80132E-01 --0.44599E-01 0 -0.76078E-01 --0.41596E-01 0 -0.72025E-01 --0.38594E-01 0 -0.67972E-01 --0.35790E-01 0 -0.64173E-01 --0.33581E-01 0 -0.61137E-01 --0.31373E-01 0 -0.58100E-01 --0.29165E-01 0 -0.55064E-01 --0.27102E-01 0 -0.52208E-01 --0.25475E-01 0 -0.49897E-01 --0.23849E-01 0 -0.47586E-01 --0.22223E-01 0 -0.45274E-01 --0.20701E-01 0 -0.43094E-01 --0.19496E-01 0 -0.41310E-01 --0.18291E-01 0 -0.39525E-01 --0.17086E-01 0 -0.37740E-01 --0.15957E-01 0 -0.36054E-01 --0.15056E-01 0 -0.34659E-01 --0.14155E-01 0 -0.33265E-01 --0.13254E-01 0 -0.31871E-01 --0.12407E-01 0 -0.30341E-01 --0.11722E-01 0 -0.28403E-01 --0.11036E-01 0 -0.26464E-01 --0.10350E-01 0 -0.24526E-01 --0.97051E-02 0 -0.23079E-01 --0.91808E-02 0 -0.23108E-01 --0.86565E-02 0 -0.23136E-01 --0.81321E-02 0 -0.23165E-01 --0.76377E-02 0 -0.23008E-01 --0.72330E-02 0 -0.22295E-01 --0.68283E-02 0 -0.21582E-01 --0.64236E-02 0 -0.20870E-01 --0.60400E-02 0 -0.20193E-01 --0.57197E-02 0 -0.19623E-01 --0.53993E-02 0 -0.19054E-01 --0.50790E-02 0 -0.18484E-01 --0.47741E-02 0 -0.17944E-01 --0.45155E-02 0 -0.17491E-01 --0.42569E-02 0 -0.17038E-01 --0.39983E-02 0 -0.16584E-01 --0.37511E-02 0 -0.16155E-01 --0.35377E-02 0 -0.15798E-01 --0.33244E-02 0 -0.15441E-01 --0.31110E-02 0 -0.15084E-01 --0.29059E-02 0 -0.14747E-01 --0.27254E-02 0 -0.14471E-01 --0.25449E-02 0 -0.14196E-01 --0.23645E-02 0 -0.13920E-01 --0.21898E-02 0 -0.13662E-01 --0.20328E-02 0 -0.13457E-01 --0.18757E-02 0 -0.13252E-01 --0.17186E-02 0 -0.13047E-01 --0.15656E-02 0 -0.12858E-01 --0.14246E-02 0 -0.12716E-01 --0.12835E-02 0 -0.12574E-01 --0.11425E-02 0 -0.12433E-01 --0.10040E-02 0 -0.12306E-01 --0.87299E-03 0 -0.12222E-01 --0.74198E-03 0 -0.12138E-01 --0.61097E-03 0 -0.12055E-01 --0.48118E-03 0 -0.11243E-01 --0.35506E-03 0 -0.82447E-02 --0.22894E-03 0 -0.52466E-02 --0.10282E-03 0 -0.22486E-02 -0.33276 0 -1.2078 -0.32503 0 -1.2414 -0.31601 0 -1.2776 -0.30641 0 -1.3150 -0.29624 0 -1.3506 -0.28551 0 -1.3845 -0.27464 0 -1.4171 -0.26348 0 -1.4474 -0.25234 0 -1.4771 -0.24136 0 -1.5038 -0.23037 0 -1.5305 -0.22001 0 -1.5540 -0.20966 0 -1.5775 -0.20006 0 -1.5987 -0.19066 0 -1.6194 -0.18192 0 -1.6386 -0.17360 0 -1.6568 -0.16573 0 -1.6743 -0.15847 0 -1.6907 -0.15143 0 -1.7067 -0.14510 0 -1.7215 -0.13882 0 -1.7363 -0.13323 0 -1.7499 -0.12764 0 -1.7635 -0.12252 0 -1.7761 -0.11746 0 -1.7886 -0.11265 0 -1.8004 -0.10796 0 -1.8118 -0.10340 0 -1.8228 -0.98980E-01 0 -1.8332 -0.94646E-01 0 -1.8433 -0.90488E-01 0 -1.8528 -0.86382E-01 0 -1.8620 -0.82561E-01 0 -1.8704 -0.78740E-01 0 -1.8788 -0.75358E-01 0 -1.8863 -0.71988E-01 0 -1.8938 -0.69060E-01 0 -1.9007 -0.66246E-01 0 -1.9074 -0.63802E-01 0 -1.9137 -0.61592E-01 0 -1.9199 -0.59639E-01 0 -1.9252 -0.58023E-01 0 -1.9294 -0.56496E-01 0 -1.9346 -0.55230E-01 0 -1.9427 -0.54046E-01 0 -1.9491 -0.52897E-01 0 -1.9548 -0.51774E-01 0 -1.9607 -0.50578E-01 0 -1.9665 -0.49280E-01 0 -1.9723 -0.47749E-01 0 -1.9783 -0.46218E-01 0 -1.9842 -0.44215E-01 0 -1.9898 -0.42127E-01 0 -1.9954 -0.39768E-01 0 -2.0006 -0.37076E-01 0 -2.0055 -0.34361E-01 0 -2.0103 -0.31196E-01 0 -2.0140 -0.28032E-01 0 -2.0178 -0.24745E-01 0 -2.0208 -0.21390E-01 0 -2.0232 -0.18082E-01 0 -2.0253 -0.14908E-01 0 -2.0264 -0.11734E-01 0 -2.0275 -0.90336E-02 0 -2.0275 -0.64165E-02 0 -2.0274 -0.41826E-02 0 -2.0268 -0.24170E-02 0 -2.0258 -0.70111E-03 0 -2.0247 --0.71888E-04 0 -2.0233 --0.84489E-03 0 -2.0219 --0.10069E-02 0 -2.0205 --0.83993E-03 0 -2.0191 --0.52135E-03 0 -2.0178 -0.25204E-03 0 -2.0170 -0.12571E-02 0 -2.0164 -0.23789E-02 0 -2.0161 -0.36190E-02 0 -2.0161 -0.48650E-02 0 -2.0167 -0.60648E-02 0 -2.0175 -0.71206E-02 0 -2.0185 -0.81763E-02 0 -2.0195 -0.88670E-02 0 -2.0210 -0.94932E-02 0 -2.0226 -0.98959E-02 0 -2.0242 -0.10025E-01 0 -2.0259 -0.10135E-01 0 -2.0276 -0.98640E-02 0 -2.0291 -0.95931E-02 0 -2.0306 -0.91992E-02 0 -2.0319 -0.87391E-02 0 -2.0331 -0.82933E-02 0 -2.0342 -0.78910E-02 0 -2.0350 -0.74886E-02 0 -2.0358 -0.72995E-02 0 -2.0365 -0.71481E-02 0 -2.0372 -0.71350E-02 0 -2.0379 -0.72911E-02 0 -2.0387 -0.74557E-02 0 -2.0395 -0.77804E-02 0 -2.0408 -0.81051E-02 0 -2.0421 -0.83101E-02 0 -2.0437 -0.84505E-02 0 -2.0454 -0.84606E-02 0 -2.0475 -0.80796E-02 0 -2.0507 -0.71776E-02 0 -2.0539 -0.58641E-02 0 -2.0572 -0.38367E-02 0 -2.0606 -0.90959E-03 0 -2.0645 --0.27904E-02 0 -2.0683 --0.79091E-02 0 -2.0711 --0.13028E-01 0 -2.0740 --0.20408E-01 0 -2.0759 --0.28187E-01 0 -2.0777 --0.37224E-01 0 -2.0784 --0.47800E-01 0 -2.0776 --0.58507E-01 0 -2.0767 --0.71717E-01 0 -2.0723 --0.84927E-01 0 -2.0679 --0.99559E-01 0 -2.0604 --0.11496 0 -2.0513 --0.13073 0 -2.0408 --0.14764 0 -2.0262 --0.16455 0 -2.0116 --0.18206 0 -1.9920 --0.19968 0 -1.9714 --0.21724 0 -1.9482 --0.23475 0 -1.9217 --0.25221 0 -1.8949 --0.26886 0 -1.8626 --0.28551 0 -1.8304 --0.30122 0 -1.7949 --0.31643 0 -1.7577 --0.33121 0 -1.7193 --0.34471 0 -1.6774 --0.35775 0 -1.6347 --0.36941 0 -1.5896 --0.38054 0 -1.5438 --0.39011 0 -1.4958 --0.39907 0 -1.4473 --0.40625 0 -1.3971 --0.41276 0 -1.3465 --0.41727 0 -1.2946 --0.42104 0 -1.2422 --0.42260 0 -1.1880 --0.42329 0 -1.1345 --0.42132 0 -1.0833 --0.41936 0 -1.0320 --0.41487 0 -0.98110 --0.40904 0 -0.93041 --0.40304 0 -0.87987 --0.39388 0 -0.83224 --0.38471 0 -0.78462 --0.37445 0 -0.73885 --0.36284 0 -0.69537 --0.35123 0 -0.65188 --0.33840 0 -0.61245 --0.32536 0 -0.57374 --0.31219 0 -0.53626 --0.29864 0 -0.50250 --0.28509 0 -0.46874 --0.27168 0 -0.43808 --0.25834 0 -0.40910 --0.24504 0 -0.38034 --0.23240 0 -0.35577 --0.21976 0 -0.33120 --0.20755 0 -0.30840 --0.19587 0 -0.28778 --0.18420 0 -0.26715 --0.17346 0 -0.24940 --0.16289 0 -0.23216 --0.15268 0 -0.21593 --0.14359 0 -0.20271 --0.13450 0 -0.18950 --0.12541 0 -0.17629 --0.11677 0 -0.16391 --0.10947 0 -0.15402 --0.10217 0 -0.14414 --0.94865E-01 0 -0.13426 --0.87980E-01 0 -0.12506 --0.82344E-01 0 -0.11792 --0.76707E-01 0 -0.11077 --0.71071E-01 0 -0.10362 --0.65788E-01 0 -0.96962E-01 --0.61568E-01 0 -0.91777E-01 --0.57348E-01 0 -0.86592E-01 --0.53128E-01 0 -0.81407E-01 --0.49186E-01 0 -0.76564E-01 --0.46079E-01 0 -0.72750E-01 --0.42972E-01 0 -0.68936E-01 --0.39865E-01 0 -0.65122E-01 --0.36966E-01 0 -0.61547E-01 --0.34688E-01 0 -0.58688E-01 --0.32411E-01 0 -0.55829E-01 --0.30133E-01 0 -0.52970E-01 --0.28007E-01 0 -0.50280E-01 --0.26332E-01 0 -0.48097E-01 --0.24657E-01 0 -0.45915E-01 --0.22982E-01 0 -0.43732E-01 --0.21416E-01 0 -0.41672E-01 --0.20175E-01 0 -0.39980E-01 --0.18935E-01 0 -0.38289E-01 --0.17694E-01 0 -0.36597E-01 --0.16531E-01 0 -0.34996E-01 --0.15603E-01 0 -0.33669E-01 --0.14674E-01 0 -0.32342E-01 --0.13746E-01 0 -0.31015E-01 --0.12873E-01 0 -0.29549E-01 --0.12165E-01 0 -0.27668E-01 --0.11457E-01 0 -0.25786E-01 --0.10750E-01 0 -0.23905E-01 --0.10084E-01 0 -0.22507E-01 --0.95416E-02 0 -0.22562E-01 --0.89996E-02 0 -0.22616E-01 --0.84575E-02 0 -0.22670E-01 --0.79462E-02 0 -0.22539E-01 --0.75272E-02 0 -0.21852E-01 --0.71081E-02 0 -0.21164E-01 --0.66891E-02 0 -0.20477E-01 --0.62918E-02 0 -0.19824E-01 --0.59596E-02 0 -0.19274E-01 --0.56273E-02 0 -0.18723E-01 --0.52951E-02 0 -0.18172E-01 --0.49788E-02 0 -0.17649E-01 --0.47101E-02 0 -0.17210E-01 --0.44415E-02 0 -0.16770E-01 --0.41729E-02 0 -0.16331E-01 --0.39159E-02 0 -0.15915E-01 --0.36939E-02 0 -0.15568E-01 --0.34719E-02 0 -0.15221E-01 --0.32499E-02 0 -0.14873E-01 --0.30363E-02 0 -0.14546E-01 --0.28482E-02 0 -0.14278E-01 --0.26600E-02 0 -0.14009E-01 --0.24719E-02 0 -0.13741E-01 --0.22898E-02 0 -0.13489E-01 --0.21258E-02 0 -0.13289E-01 --0.19618E-02 0 -0.13089E-01 --0.17978E-02 0 -0.12890E-01 --0.16380E-02 0 -0.12705E-01 --0.14906E-02 0 -0.12567E-01 --0.13431E-02 0 -0.12428E-01 --0.11957E-02 0 -0.12290E-01 --0.10509E-02 0 -0.12166E-01 --0.91379E-03 0 -0.12084E-01 --0.77670E-03 0 -0.12002E-01 --0.63961E-03 0 -0.11921E-01 --0.50378E-03 0 -0.11118E-01 --0.37175E-03 0 -0.81534E-02 --0.23971E-03 0 -0.51886E-02 --0.10768E-03 0 -0.22237E-02 -0.35493 0 -1.2150 -0.34634 0 -1.2493 -0.33635 0 -1.2862 -0.32574 0 -1.3242 -0.31451 0 -1.3603 -0.30270 0 -1.3946 -0.29075 0 -1.4275 -0.27853 0 -1.4578 -0.26635 0 -1.4876 -0.25440 0 -1.5142 -0.24245 0 -1.5407 -0.23126 0 -1.5640 -0.22010 0 -1.5871 -0.20980 0 -1.6079 -0.19975 0 -1.6282 -0.19044 0 -1.6469 -0.18162 0 -1.6648 -0.17331 0 -1.6818 -0.16569 0 -1.6977 -0.15833 0 -1.7133 -0.15174 0 -1.7278 -0.14520 0 -1.7422 -0.13941 0 -1.7555 -0.13362 0 -1.7688 -0.12831 0 -1.7812 -0.12307 0 -1.7935 -0.11807 0 -1.8051 -0.11317 0 -1.8164 -0.10841 0 -1.8272 -0.10375 0 -1.8375 -0.99183E-01 0 -1.8475 -0.94773E-01 0 -1.8567 -0.90415E-01 0 -1.8659 -0.86341E-01 0 -1.8741 -0.82267E-01 0 -1.8823 -0.78663E-01 0 -1.8896 -0.75071E-01 0 -1.8968 -0.71973E-01 0 -1.9035 -0.69002E-01 0 -1.9099 -0.66453E-01 0 -1.9161 -0.64171E-01 0 -1.9220 -0.62186E-01 0 -1.9271 -0.60593E-01 0 -1.9312 -0.59101E-01 0 -1.9362 -0.57914E-01 0 -1.9441 -0.56819E-01 0 -1.9503 -0.55763E-01 0 -1.9560 -0.54736E-01 0 -1.9619 -0.53619E-01 0 -1.9678 -0.52379E-01 0 -1.9737 -0.50860E-01 0 -1.9798 -0.49341E-01 0 -1.9860 -0.47256E-01 0 -1.9918 -0.45072E-01 0 -1.9976 -0.42561E-01 0 -2.0031 -0.39652E-01 0 -2.0081 -0.36715E-01 0 -2.0131 -0.33235E-01 0 -2.0170 -0.29755E-01 0 -2.0209 -0.26118E-01 0 -2.0239 -0.22395E-01 0 -2.0264 -0.18721E-01 0 -2.0284 -0.15187E-01 0 -2.0294 -0.11654E-01 0 -2.0303 -0.86553E-02 0 -2.0301 -0.57504E-02 0 -2.0296 -0.32838E-02 0 -2.0288 -0.13528E-02 0 -2.0274 --0.52114E-03 0 -2.0259 --0.13124E-02 0 -2.0241 --0.21037E-02 0 -2.0223 --0.21942E-02 0 -2.0206 --0.19074E-02 0 -2.0189 --0.14479E-02 0 -2.0173 --0.47033E-03 0 -2.0162 -0.76649E-03 0 -2.0155 -0.21317E-02 0 -2.0150 -0.36229E-02 0 -2.0150 -0.51078E-02 0 -2.0156 -0.65289E-02 0 -2.0164 -0.77648E-02 0 -2.0176 -0.90006E-02 0 -2.0187 -0.97894E-02 0 -2.0204 -0.10499E-01 0 -2.0221 -0.10940E-01 0 -2.0239 -0.11053E-01 0 -2.0258 -0.11143E-01 0 -2.0277 -0.10783E-01 0 -2.0293 -0.10423E-01 0 -2.0309 -0.99250E-02 0 -2.0323 -0.93525E-02 0 -2.0335 -0.88029E-02 0 -2.0346 -0.83220E-02 0 -2.0353 -0.78410E-02 0 -2.0361 -0.76450E-02 0 -2.0367 -0.74993E-02 0 -2.0372 -0.75433E-02 0 -2.0379 -0.78191E-02 0 -2.0386 -0.81089E-02 0 -2.0393 -0.86654E-02 0 -2.0406 -0.92220E-02 0 -2.0419 -0.97068E-02 0 -2.0437 -0.10153E-01 0 -2.0456 -0.10472E-01 0 -2.0479 -0.10408E-01 0 -2.0515 -0.97986E-02 0 -2.0552 -0.87517E-02 0 -2.0590 -0.69380E-02 0 -2.0632 -0.41435E-02 0 -2.0679 -0.50122E-03 0 -2.0725 --0.47037E-02 0 -2.0764 --0.99086E-02 0 -2.0802 --0.17621E-01 0 -2.0832 --0.25776E-01 0 -2.0861 --0.35331E-01 0 -2.0879 --0.46599E-01 0 -2.0882 --0.58014E-01 0 -2.0884 --0.72218E-01 0 -2.0850 --0.86422E-01 0 -2.0815 --0.10221 0 -2.0749 --0.11885 0 -2.0665 --0.13590 0 -2.0567 --0.15422 0 -2.0425 --0.17253 0 -2.0284 --0.19150 0 -2.0089 --0.21058 0 -1.9885 --0.22960 0 -1.9652 --0.24853 0 -1.9385 --0.26742 0 -1.9115 --0.28540 0 -1.8787 --0.30338 0 -1.8460 --0.32033 0 -1.8099 --0.33672 0 -1.7720 --0.35266 0 -1.7329 --0.36720 0 -1.6901 --0.38126 0 -1.6465 --0.39385 0 -1.6004 --0.40588 0 -1.5536 --0.41623 0 -1.5045 --0.42595 0 -1.4549 --0.43376 0 -1.4034 --0.44085 0 -1.3516 --0.44577 0 -1.2984 --0.44990 0 -1.2446 --0.45163 0 -1.1889 --0.45238 0 -1.1339 --0.45022 0 -1.0813 --0.44806 0 -1.0287 --0.44313 0 -0.97646 --0.43670 0 -0.92448 --0.43008 0 -0.87266 --0.41999 0 -0.82399 --0.40990 0 -0.77532 --0.39862 0 -0.72866 --0.38587 0 -0.68445 --0.37313 0 -0.64025 --0.35911 0 -0.60039 --0.34487 0 -0.56130 --0.33051 0 -0.52352 --0.31581 0 -0.48968 --0.30112 0 -0.45583 --0.28663 0 -0.42524 --0.27226 0 -0.39640 --0.25794 0 -0.36779 --0.24440 0 -0.34351 --0.23086 0 -0.31923 --0.21781 0 -0.29676 --0.20537 0 -0.27651 --0.19293 0 -0.25626 --0.18152 0 -0.23895 --0.17030 0 -0.22216 --0.15948 0 -0.20637 --0.14986 0 -0.19357 --0.14025 0 -0.18076 --0.13063 0 -0.16796 --0.12150 0 -0.15599 --0.11382 0 -0.14652 --0.10614 0 -0.13706 --0.98455E-01 0 -0.12760 --0.91220E-01 0 -0.11880 --0.85325E-01 0 -0.11203 --0.79430E-01 0 -0.10525 --0.73535E-01 0 -0.98479E-01 --0.68018E-01 0 -0.92178E-01 --0.63633E-01 0 -0.87301E-01 --0.59248E-01 0 -0.82425E-01 --0.54863E-01 0 -0.77548E-01 --0.50771E-01 0 -0.72997E-01 --0.47559E-01 0 -0.69422E-01 --0.44348E-01 0 -0.65847E-01 --0.41137E-01 0 -0.62272E-01 --0.38141E-01 0 -0.58920E-01 --0.35795E-01 0 -0.56239E-01 --0.33449E-01 0 -0.53557E-01 --0.31102E-01 0 -0.50875E-01 --0.28912E-01 0 -0.48351E-01 --0.27188E-01 0 -0.46297E-01 --0.25465E-01 0 -0.44243E-01 --0.23742E-01 0 -0.42190E-01 --0.22131E-01 0 -0.40250E-01 --0.20854E-01 0 -0.38651E-01 --0.19578E-01 0 -0.37052E-01 --0.18301E-01 0 -0.35453E-01 --0.17105E-01 0 -0.33939E-01 --0.16149E-01 0 -0.32679E-01 --0.15193E-01 0 -0.31419E-01 --0.14238E-01 0 -0.30158E-01 --0.13338E-01 0 -0.28757E-01 --0.12609E-01 0 -0.26933E-01 --0.11879E-01 0 -0.25109E-01 --0.11149E-01 0 -0.23284E-01 --0.10462E-01 0 -0.21936E-01 --0.99024E-02 0 -0.22016E-01 --0.93427E-02 0 -0.22095E-01 --0.87829E-02 0 -0.22175E-01 --0.82547E-02 0 -0.22070E-01 --0.78213E-02 0 -0.21408E-01 --0.73880E-02 0 -0.20747E-01 --0.69546E-02 0 -0.20085E-01 --0.65436E-02 0 -0.19456E-01 --0.61994E-02 0 -0.18924E-01 --0.58553E-02 0 -0.18392E-01 --0.55112E-02 0 -0.17860E-01 --0.51835E-02 0 -0.17355E-01 --0.49048E-02 0 -0.16929E-01 --0.46261E-02 0 -0.16503E-01 --0.43475E-02 0 -0.16078E-01 --0.40808E-02 0 -0.15674E-01 --0.38501E-02 0 -0.15337E-01 --0.36194E-02 0 -0.15000E-01 --0.33887E-02 0 -0.14663E-01 --0.31667E-02 0 -0.14345E-01 --0.29709E-02 0 -0.14084E-01 --0.27751E-02 0 -0.13822E-01 --0.25793E-02 0 -0.13561E-01 --0.23897E-02 0 -0.13316E-01 --0.22188E-02 0 -0.13122E-01 --0.20479E-02 0 -0.12927E-01 --0.18770E-02 0 -0.12732E-01 --0.17104E-02 0 -0.12552E-01 --0.15566E-02 0 -0.12417E-01 --0.14027E-02 0 -0.12282E-01 --0.12489E-02 0 -0.12147E-01 --0.10978E-02 0 -0.12026E-01 --0.95458E-03 0 -0.11946E-01 --0.81142E-03 0 -0.11866E-01 --0.66825E-03 0 -0.11787E-01 --0.52639E-03 0 -0.10994E-01 --0.38844E-03 0 -0.80622E-02 --0.25049E-03 0 -0.51305E-02 --0.11254E-03 0 -0.21988E-02 -0.37960 0 -1.2248 -0.36978 0 -1.2601 -0.35842 0 -1.2978 -0.34638 0 -1.3367 -0.33371 0 -1.3734 -0.32043 0 -1.4080 -0.30704 0 -1.4412 -0.29344 0 -1.4715 -0.27990 0 -1.5012 -0.26675 0 -1.5274 -0.25360 0 -1.5536 -0.24144 0 -1.5763 -0.22931 0 -1.5989 -0.21826 0 -1.6191 -0.20749 0 -1.6387 -0.19763 0 -1.6568 -0.18835 0 -1.6739 -0.17967 0 -1.6903 -0.17179 0 -1.7057 -0.16419 0 -1.7207 -0.15748 0 -1.7347 -0.15082 0 -1.7486 -0.14496 0 -1.7616 -0.13911 0 -1.7746 -0.13372 0 -1.7868 -0.12840 0 -1.7988 -0.12327 0 -1.8103 -0.11824 0 -1.8215 -0.11328 0 -1.8322 -0.10839 0 -1.8424 -0.10356 0 -1.8523 -0.98841E-01 0 -1.8615 -0.94167E-01 0 -1.8704 -0.89749E-01 0 -1.8785 -0.85332E-01 0 -1.8865 -0.81418E-01 0 -1.8935 -0.77518E-01 0 -1.9005 -0.74192E-01 0 -1.9067 -0.71015E-01 0 -1.9128 -0.68352E-01 0 -1.9186 -0.66014E-01 0 -1.9242 -0.64048E-01 0 -1.9289 -0.62572E-01 0 -1.9327 -0.61225E-01 0 -1.9375 -0.60265E-01 0 -1.9450 -0.59417E-01 0 -1.9511 -0.58618E-01 0 -1.9568 -0.57854E-01 0 -1.9626 -0.56973E-01 0 -1.9687 -0.55933E-01 0 -1.9748 -0.54532E-01 0 -1.9813 -0.53132E-01 0 -1.9877 -0.51003E-01 0 -1.9940 -0.48746E-01 0 -2.0002 -0.46069E-01 0 -2.0060 -0.42880E-01 0 -2.0115 -0.39655E-01 0 -2.0169 -0.35724E-01 0 -2.0210 -0.31793E-01 0 -2.0252 -0.27642E-01 0 -2.0283 -0.23374E-01 0 -2.0308 -0.19154E-01 0 -2.0328 -0.15080E-01 0 -2.0335 -0.11005E-01 0 -2.0343 -0.75581E-02 0 -2.0336 -0.42214E-02 0 -2.0328 -0.14114E-02 0 -2.0314 --0.75491E-03 0 -2.0294 --0.28521E-02 0 -2.0274 --0.36364E-02 0 -2.0250 --0.44208E-02 0 -2.0226 --0.43554E-02 0 -2.0203 --0.38324E-02 0 -2.0181 --0.31024E-02 0 -2.0161 --0.17512E-02 0 -2.0146 --0.98725E-04 0 -2.0136 -0.16981E-02 0 -2.0130 -0.36269E-02 0 -2.0130 -0.55206E-02 0 -2.0136 -0.73136E-02 0 -2.0146 -0.88397E-02 0 -2.0160 -0.10366E-01 0 -2.0174 -0.11290E-01 0 -2.0194 -0.12108E-01 0 -2.0215 -0.12575E-01 0 -2.0236 -0.12614E-01 0 -2.0258 -0.12623E-01 0 -2.0280 -0.12059E-01 0 -2.0298 -0.11495E-01 0 -2.0317 -0.10765E-01 0 -2.0331 -0.99458E-02 0 -2.0343 -0.91640E-02 0 -2.0354 -0.84941E-02 0 -2.0360 -0.78242E-02 0 -2.0366 -0.75650E-02 0 -2.0370 -0.73782E-02 0 -2.0372 -0.74743E-02 0 -2.0376 -0.79160E-02 0 -2.0380 -0.83825E-02 0 -2.0385 -0.93212E-02 0 -2.0397 -0.10260E-01 0 -2.0408 -0.11234E-01 0 -2.0425 -0.12227E-01 0 -2.0446 -0.13107E-01 0 -2.0471 -0.13650E-01 0 -2.0510 -0.13632E-01 0 -2.0553 -0.13152E-01 0 -2.0598 -0.11846E-01 0 -2.0649 -0.94533E-02 0 -2.0707 -0.61122E-02 0 -2.0765 -0.10105E-02 0 -2.0816 --0.40912E-02 0 -2.0868 --0.12049E-01 0 -2.0913 --0.20510E-01 0 -2.0957 --0.30576E-01 0 -2.0990 --0.42603E-01 0 -2.1009 --0.54799E-01 0 -2.1026 --0.70194E-01 0 -2.1005 --0.85588E-01 0 -2.0985 --0.10279 0 -2.0930 --0.12097 0 -2.0856 --0.13962 0 -2.0767 --0.15970 0 -2.0631 --0.17977 0 -2.0496 --0.20055 0 -2.0303 --0.22145 0 -2.0100 --0.24225 0 -1.9867 --0.26292 0 -1.9596 --0.28354 0 -1.9323 --0.30306 0 -1.8988 --0.32259 0 -1.8654 --0.34095 0 -1.8285 --0.35868 0 -1.7897 --0.37590 0 -1.7497 --0.39161 0 -1.7058 --0.40680 0 -1.6612 --0.42045 0 -1.6139 --0.43351 0 -1.5659 --0.44483 0 -1.5155 --0.45549 0 -1.4645 --0.46415 0 -1.4116 --0.47204 0 -1.3582 --0.47760 0 -1.3033 --0.48228 0 -1.2477 --0.48431 0 -1.1900 --0.48525 0 -1.1332 --0.48289 0 -1.0787 --0.48052 0 -1.0242 --0.47498 0 -0.97026 --0.46774 0 -0.91654 --0.46028 0 -0.86301 --0.44889 0 -0.81297 --0.43750 0 -0.76294 --0.42480 0 -0.71514 --0.41051 0 -0.67008 --0.39621 0 -0.62501 --0.38064 0 -0.58472 --0.36484 0 -0.54527 --0.34897 0 -0.50723 --0.33288 0 -0.47343 --0.31678 0 -0.43963 --0.30104 0 -0.40926 --0.28550 0 -0.38074 --0.27001 0 -0.35245 --0.25551 0 -0.32862 --0.24101 0 -0.30480 --0.22709 0 -0.28281 --0.21386 0 -0.26308 --0.20063 0 -0.24335 --0.18854 0 -0.22663 --0.17666 0 -0.21044 --0.16522 0 -0.19522 --0.15508 0 -0.18292 --0.14495 0 -0.17062 --0.13481 0 -0.15833 --0.12520 0 -0.14687 --0.11716 0 -0.13792 --0.10911 0 -0.12897 --0.10107 0 -0.12002 --0.93508E-01 0 -0.11172 --0.87396E-01 0 -0.10540 --0.81285E-01 0 -0.99075E-01 --0.75173E-01 0 -0.92751E-01 --0.69464E-01 0 -0.86880E-01 --0.64963E-01 0 -0.82365E-01 --0.60463E-01 0 -0.77850E-01 --0.55962E-01 0 -0.73335E-01 --0.51768E-01 0 -0.69123E-01 --0.48494E-01 0 -0.65818E-01 --0.45220E-01 0 -0.62513E-01 --0.41946E-01 0 -0.59207E-01 --0.38895E-01 0 -0.56107E-01 --0.36511E-01 0 -0.53619E-01 --0.34126E-01 0 -0.51131E-01 --0.31742E-01 0 -0.48644E-01 --0.29516E-01 0 -0.46299E-01 --0.27767E-01 0 -0.44383E-01 --0.26017E-01 0 -0.42467E-01 --0.24268E-01 0 -0.40551E-01 --0.22632E-01 0 -0.38739E-01 --0.21335E-01 0 -0.37239E-01 --0.20038E-01 0 -0.35738E-01 --0.18741E-01 0 -0.34237E-01 --0.17526E-01 0 -0.32815E-01 --0.16553E-01 0 -0.31625E-01 --0.15581E-01 0 -0.30435E-01 --0.14609E-01 0 -0.29245E-01 --0.13693E-01 0 -0.27912E-01 --0.12949E-01 0 -0.26148E-01 --0.12206E-01 0 -0.24385E-01 --0.11462E-01 0 -0.22621E-01 --0.10761E-01 0 -0.21325E-01 --0.10189E-01 0 -0.21431E-01 --0.96169E-02 0 -0.21537E-01 --0.90450E-02 0 -0.21642E-01 --0.85051E-02 0 -0.21563E-01 --0.80614E-02 0 -0.20929E-01 --0.76177E-02 0 -0.20295E-01 --0.71740E-02 0 -0.19660E-01 --0.67529E-02 0 -0.19056E-01 --0.63998E-02 0 -0.18544E-01 --0.60467E-02 0 -0.18032E-01 --0.56935E-02 0 -0.17521E-01 --0.53570E-02 0 -0.17034E-01 --0.50704E-02 0 -0.16623E-01 --0.47838E-02 0 -0.16212E-01 --0.44972E-02 0 -0.15800E-01 --0.42228E-02 0 -0.15410E-01 --0.39850E-02 0 -0.15084E-01 --0.37472E-02 0 -0.14758E-01 --0.35094E-02 0 -0.14431E-01 --0.32805E-02 0 -0.14123E-01 --0.30782E-02 0 -0.13870E-01 --0.28760E-02 0 -0.13616E-01 --0.26737E-02 0 -0.13363E-01 --0.24778E-02 0 -0.13125E-01 --0.23009E-02 0 -0.12936E-01 --0.21241E-02 0 -0.12746E-01 --0.19472E-02 0 -0.12557E-01 --0.17747E-02 0 -0.12382E-01 --0.16153E-02 0 -0.12251E-01 --0.14558E-02 0 -0.12119E-01 --0.12963E-02 0 -0.11988E-01 --0.11396E-02 0 -0.11870E-01 --0.99104E-03 0 -0.11792E-01 --0.84247E-03 0 -0.11714E-01 --0.69389E-03 0 -0.11637E-01 --0.54665E-03 0 -0.10855E-01 --0.40340E-03 0 -0.79601E-02 --0.26015E-03 0 -0.50655E-02 --0.11690E-03 0 -0.21709E-02 -0.40427 0 -1.2346 -0.39322 0 -1.2709 -0.38049 0 -1.3095 -0.36702 0 -1.3492 -0.35290 0 -1.3865 -0.33815 0 -1.4215 -0.32332 0 -1.4549 -0.30834 0 -1.4852 -0.29345 0 -1.5148 -0.27910 0 -1.5407 -0.26475 0 -1.5665 -0.25162 0 -1.5887 -0.23852 0 -1.6107 -0.22671 0 -1.6303 -0.21524 0 -1.6492 -0.20482 0 -1.6666 -0.19508 0 -1.6831 -0.18602 0 -1.6988 -0.17788 0 -1.7136 -0.17006 0 -1.7280 -0.16322 0 -1.7416 -0.15644 0 -1.7550 -0.15052 0 -1.7677 -0.14459 0 -1.7803 -0.13913 0 -1.7923 -0.13373 0 -1.8042 -0.12848 0 -1.8155 -0.12330 0 -1.8266 -0.11815 0 -1.8372 -0.11303 0 -1.8474 -0.10794 0 -1.8571 -0.10291 0 -1.8662 -0.97919E-01 0 -1.8750 -0.93158E-01 0 -1.8829 -0.88397E-01 0 -1.8907 -0.84174E-01 0 -1.8974 -0.79964E-01 0 -1.9041 -0.76411E-01 0 -1.9100 -0.73028E-01 0 -1.9158 -0.70251E-01 0 -1.9212 -0.67857E-01 0 -1.9263 -0.65910E-01 0 -1.9308 -0.64552E-01 0 -1.9343 -0.63349E-01 0 -1.9388 -0.62615E-01 0 -1.9460 -0.62015E-01 0 -1.9519 -0.61474E-01 0 -1.9575 -0.60972E-01 0 -1.9634 -0.60327E-01 0 -1.9696 -0.59486E-01 0 -1.9759 -0.58204E-01 0 -1.9827 -0.56922E-01 0 -1.9895 -0.54749E-01 0 -1.9961 -0.52420E-01 0 -2.0027 -0.49577E-01 0 -2.0090 -0.46109E-01 0 -2.0148 -0.42594E-01 0 -2.0206 -0.38212E-01 0 -2.0250 -0.33830E-01 0 -2.0294 -0.29167E-01 0 -2.0326 -0.24352E-01 0 -2.0351 -0.19588E-01 0 -2.0372 -0.14972E-01 0 -2.0377 -0.10356E-01 0 -2.0382 -0.64608E-02 0 -2.0372 -0.26923E-02 0 -2.0359 --0.46105E-03 0 -2.0341 --0.28627E-02 0 -2.0315 --0.51831E-02 0 -2.0289 --0.59604E-02 0 -2.0259 --0.67378E-02 0 -2.0229 --0.65165E-02 0 -2.0200 --0.57575E-02 0 -2.0173 --0.47569E-02 0 -2.0148 --0.30320E-02 0 -2.0130 --0.96394E-03 0 -2.0118 -0.12645E-02 0 -2.0110 -0.36310E-02 0 -2.0109 -0.59334E-02 0 -2.0116 -0.80984E-02 0 -2.0128 -0.99147E-02 0 -2.0144 -0.11731E-01 0 -2.0161 -0.12791E-01 0 -2.0184 -0.13717E-01 0 -2.0209 -0.14211E-01 0 -2.0234 -0.14175E-01 0 -2.0259 -0.14103E-01 0 -2.0284 -0.13335E-01 0 -2.0304 -0.12566E-01 0 -2.0324 -0.11605E-01 0 -2.0339 -0.10539E-01 0 -2.0352 -0.95251E-02 0 -2.0362 -0.86662E-02 0 -2.0367 -0.78073E-02 0 -2.0371 -0.74849E-02 0 -2.0372 -0.72571E-02 0 -2.0373 -0.74052E-02 0 -2.0373 -0.80129E-02 0 -2.0375 -0.86562E-02 0 -2.0377 -0.99769E-02 0 -2.0387 -0.11298E-01 0 -2.0397 -0.12761E-01 0 -2.0414 -0.14300E-01 0 -2.0435 -0.15743E-01 0 -2.0462 -0.16892E-01 0 -2.0506 -0.17466E-01 0 -2.0554 -0.17553E-01 0 -2.0606 -0.16753E-01 0 -2.0665 -0.14763E-01 0 -2.0734 -0.11723E-01 0 -2.0804 -0.67247E-02 0 -2.0869 -0.17263E-02 0 -2.0934 --0.64763E-02 0 -2.0994 --0.15244E-01 0 -2.1054 --0.25821E-01 0 -2.1102 --0.38607E-01 0 -2.1136 --0.51584E-01 0 -2.1168 --0.68169E-01 0 -2.1161 --0.84755E-01 0 -2.1154 --0.10338 0 -2.1110 --0.12310 0 -2.1047 --0.14334 0 -2.0967 --0.16517 0 -2.0838 --0.18701 0 -2.0708 --0.20960 0 -2.0517 --0.23233 0 -2.0315 --0.25491 0 -2.0081 --0.27731 0 -1.9808 --0.29965 0 -1.9530 --0.32073 0 -1.9190 --0.34181 0 -1.8849 --0.36157 0 -1.8471 --0.38063 0 -1.8074 --0.39914 0 -1.7664 --0.41602 0 -1.7216 --0.43235 0 -1.6758 --0.44704 0 -1.6274 --0.46114 0 -1.5782 --0.47343 0 -1.5265 --0.48502 0 -1.4742 --0.49454 0 -1.4197 --0.50322 0 -1.3648 --0.50942 0 -1.3082 --0.51465 0 -1.2509 --0.51700 0 -1.1912 --0.51812 0 -1.1324 --0.51555 0 -1.0761 --0.51298 0 -1.0198 --0.50684 0 -0.96407 --0.49878 0 -0.90861 --0.49049 0 -0.85335 --0.47779 0 -0.80195 --0.46509 0 -0.75055 --0.45098 0 -0.70162 --0.43514 0 -0.65570 --0.41930 0 -0.60977 --0.40217 0 -0.56905 --0.38482 0 -0.52924 --0.36743 0 -0.49095 --0.34994 0 -0.45719 --0.33245 0 -0.42344 --0.31546 0 -0.39328 --0.29874 0 -0.36507 --0.28209 0 -0.33710 --0.26663 0 -0.31373 --0.25117 0 -0.29037 --0.23636 0 -0.26887 --0.22234 0 -0.24966 --0.20832 0 -0.23045 --0.19557 0 -0.21431 --0.18303 0 -0.19871 --0.17096 0 -0.18406 --0.16030 0 -0.17227 --0.14965 0 -0.16048 --0.13899 0 -0.14870 --0.12890 0 -0.13775 --0.12049 0 -0.12931 --0.11209 0 -0.12087 --0.10368 0 -0.11244 --0.95795E-01 0 -0.10464 --0.89467E-01 0 -0.98769E-01 --0.83139E-01 0 -0.92896E-01 --0.76811E-01 0 -0.87024E-01 --0.70910E-01 0 -0.81581E-01 --0.66294E-01 0 -0.77428E-01 --0.61678E-01 0 -0.73275E-01 --0.57061E-01 0 -0.69122E-01 --0.52765E-01 0 -0.65249E-01 --0.49429E-01 0 -0.62213E-01 --0.46093E-01 0 -0.59178E-01 --0.42756E-01 0 -0.56143E-01 --0.39649E-01 0 -0.53293E-01 --0.37226E-01 0 -0.50999E-01 --0.34804E-01 0 -0.48706E-01 --0.32382E-01 0 -0.46412E-01 --0.30121E-01 0 -0.44247E-01 --0.28345E-01 0 -0.42469E-01 --0.26570E-01 0 -0.40691E-01 --0.24794E-01 0 -0.38913E-01 --0.23132E-01 0 -0.37229E-01 --0.21815E-01 0 -0.35826E-01 --0.20498E-01 0 -0.34424E-01 --0.19182E-01 0 -0.33022E-01 --0.17947E-01 0 -0.31690E-01 --0.16958E-01 0 -0.30571E-01 --0.15969E-01 0 -0.29451E-01 --0.14980E-01 0 -0.28332E-01 --0.14048E-01 0 -0.27067E-01 --0.13290E-01 0 -0.25364E-01 --0.12532E-01 0 -0.23661E-01 --0.11774E-01 0 -0.21958E-01 --0.11059E-01 0 -0.20714E-01 --0.10475E-01 0 -0.20846E-01 --0.98912E-02 0 -0.20978E-01 --0.93071E-02 0 -0.21110E-01 --0.87556E-02 0 -0.21057E-01 --0.83015E-02 0 -0.20450E-01 --0.78474E-02 0 -0.19843E-01 --0.73934E-02 0 -0.19235E-01 --0.69623E-02 0 -0.18657E-01 --0.66001E-02 0 -0.18165E-01 --0.62380E-02 0 -0.17673E-01 --0.58758E-02 0 -0.17181E-01 --0.55306E-02 0 -0.16713E-01 --0.52360E-02 0 -0.16316E-01 --0.49415E-02 0 -0.15920E-01 --0.46469E-02 0 -0.15523E-01 --0.43648E-02 0 -0.15147E-01 --0.41199E-02 0 -0.14831E-01 --0.38750E-02 0 -0.14515E-01 --0.36301E-02 0 -0.14200E-01 --0.33942E-02 0 -0.13902E-01 --0.31855E-02 0 -0.13656E-01 --0.29768E-02 0 -0.13410E-01 --0.27681E-02 0 -0.13164E-01 --0.25659E-02 0 -0.12934E-01 --0.23831E-02 0 -0.12750E-01 --0.22002E-02 0 -0.12566E-01 --0.20174E-02 0 -0.12382E-01 --0.18390E-02 0 -0.12212E-01 --0.16739E-02 0 -0.12084E-01 --0.15089E-02 0 -0.11956E-01 --0.13438E-02 0 -0.11828E-01 --0.11815E-02 0 -0.11714E-01 --0.10275E-02 0 -0.11638E-01 --0.87351E-03 0 -0.11562E-01 --0.71953E-03 0 -0.11487E-01 --0.56691E-03 0 -0.10716E-01 --0.41836E-03 0 -0.78581E-02 --0.26982E-03 0 -0.50006E-02 --0.12127E-03 0 -0.21431E-02 -0.42978 0 -1.2454 -0.41733 0 -1.2827 -0.40308 0 -1.3223 -0.38803 0 -1.3628 -0.37231 0 -1.4007 -0.35595 0 -1.4360 -0.33956 0 -1.4697 -0.32309 0 -1.4999 -0.30674 0 -1.5294 -0.29111 0 -1.5548 -0.27547 0 -1.5803 -0.26133 0 -1.6018 -0.24723 0 -1.6232 -0.23464 0 -1.6420 -0.22246 0 -1.6601 -0.21150 0 -1.6768 -0.20132 0 -1.6925 -0.19192 0 -1.7075 -0.18357 0 -1.7216 -0.17558 0 -1.7355 -0.16868 0 -1.7485 -0.16184 0 -1.7615 -0.15590 0 -1.7738 -0.14997 0 -1.7861 -0.14448 0 -1.7979 -0.13905 0 -1.8096 -0.13371 0 -1.8208 -0.12840 0 -1.8318 -0.12307 0 -1.8424 -0.11771 0 -1.8525 -0.11235 0 -1.8622 -0.10697 0 -1.8711 -0.10163 0 -1.8799 -0.96479E-01 0 -1.8875 -0.91325E-01 0 -1.8952 -0.86742E-01 0 -1.9016 -0.82174E-01 0 -1.9079 -0.78357E-01 0 -1.9135 -0.74736E-01 0 -1.9188 -0.71832E-01 0 -1.9238 -0.69382E-01 0 -1.9285 -0.67470E-01 0 -1.9326 -0.66269E-01 0 -1.9358 -0.65257E-01 0 -1.9399 -0.64815E-01 0 -1.9467 -0.64535E-01 0 -1.9524 -0.64324E-01 0 -1.9579 -0.64162E-01 0 -1.9639 -0.63824E-01 0 -1.9702 -0.63246E-01 0 -1.9768 -0.62130E-01 0 -1.9840 -0.61014E-01 0 -1.9912 -0.58814E-01 0 -1.9983 -0.56422E-01 0 -2.0054 -0.53408E-01 0 -2.0121 -0.49633E-01 0 -2.0184 -0.45802E-01 0 -2.0246 -0.40912E-01 0 -2.0294 -0.36022E-01 0 -2.0341 -0.30779E-01 0 -2.0374 -0.25344E-01 0 -2.0400 -0.19960E-01 0 -2.0420 -0.14728E-01 0 -2.0423 -0.94946E-02 0 -2.0426 -0.50866E-02 0 -2.0412 -0.82412E-03 0 -2.0394 --0.27211E-02 0 -2.0370 --0.53897E-02 0 -2.0338 --0.79629E-02 0 -2.0305 --0.87235E-02 0 -2.0268 --0.94841E-02 0 -2.0231 --0.90703E-02 0 -2.0196 --0.80242E-02 0 -2.0163 --0.66961E-02 0 -2.0133 --0.45221E-02 0 -2.0110 --0.19569E-02 0 -2.0096 -0.78649E-03 0 -2.0086 -0.36728E-02 0 -2.0085 -0.64578E-02 0 -2.0093 -0.90592E-02 0 -2.0106 -0.11211E-01 0 -2.0126 -0.13363E-01 0 -2.0146 -0.14569E-01 0 -2.0174 -0.15610E-01 0 -2.0202 -0.16119E-01 0 -2.0231 -0.15978E-01 0 -2.0260 -0.15793E-01 0 -2.0289 -0.14765E-01 0 -2.0311 -0.13738E-01 0 -2.0334 -0.12484E-01 0 -2.0350 -0.11109E-01 0 -2.0363 -0.98014E-02 0 -2.0373 -0.86989E-02 0 -2.0375 -0.75965E-02 0 -2.0378 -0.71771E-02 0 -2.0376 -0.68783E-02 0 -2.0373 -0.70656E-02 0 -2.0370 -0.78470E-02 0 -2.0368 -0.86770E-02 0 -2.0367 -0.10432E-01 0 -2.0374 -0.12186E-01 0 -2.0382 -0.14216E-01 0 -2.0399 -0.16394E-01 0 -2.0420 -0.18495E-01 0 -2.0448 -0.20364E-01 0 -2.0496 -0.21649E-01 0 -2.0550 -0.22423E-01 0 -2.0609 -0.22248E-01 0 -2.0678 -0.20768E-01 0 -2.0758 -0.18128E-01 0 -2.0841 -0.13309E-01 0 -2.0920 -0.84910E-02 0 -2.1000 -0.79994E-04 0 -2.1077 --0.89650E-02 0 -2.1153 --0.20046E-01 0 -2.1218 --0.33615E-01 0 -2.1269 --0.47398E-01 0 -2.1318 --0.65247E-01 0 -2.1326 --0.83096E-01 0 -2.1333 --0.10323 0 -2.1302 --0.12461 0 -2.1251 --0.14657 0 -2.1181 --0.17029 0 -2.1058 --0.19402 0 -2.0934 --0.21856 0 -2.0745 --0.24324 0 -2.0545 --0.26772 0 -2.0309 --0.29197 0 -2.0032 --0.31614 0 -1.9751 --0.33883 0 -1.9403 --0.36151 0 -1.9054 --0.38272 0 -1.8668 --0.40313 0 -1.8260 --0.42294 0 -1.7840 --0.44098 0 -1.7381 --0.45845 0 -1.6913 --0.47422 0 -1.6417 --0.48937 0 -1.5912 --0.50269 0 -1.5382 --0.51529 0 -1.4845 --0.52575 0 -1.4285 --0.53533 0 -1.3719 --0.54229 0 -1.3136 --0.54820 0 -1.2544 --0.55094 0 -1.1926 --0.55231 0 -1.1317 --0.54956 0 -1.0734 --0.54680 0 -1.0151 --0.54001 0 -0.95735 --0.53103 0 -0.89998 --0.52180 0 -0.84283 --0.50764 0 -0.78996 --0.49347 0 -0.73708 --0.47778 0 -0.68694 --0.46022 0 -0.64013 --0.44266 0 -0.59331 --0.42384 0 -0.55218 --0.40481 0 -0.51205 --0.38579 0 -0.47354 --0.36683 0 -0.43990 --0.34787 0 -0.40626 --0.32958 0 -0.37640 --0.31166 0 -0.34857 --0.29382 0 -0.32100 --0.27740 0 -0.29815 --0.26098 0 -0.27530 --0.24529 0 -0.25434 --0.23049 0 -0.23570 --0.21569 0 -0.21705 --0.20226 0 -0.20152 --0.18907 0 -0.18655 --0.17639 0 -0.17250 --0.16521 0 -0.16125 --0.15403 0 -0.15000 --0.14285 0 -0.13875 --0.13228 0 -0.12833 --0.12351 0 -0.12044 --0.11475 0 -0.11255 --0.10599 0 -0.10465 --0.97787E-01 0 -0.97380E-01 --0.91258E-01 0 -0.91982E-01 --0.84730E-01 0 -0.86583E-01 --0.78201E-01 0 -0.81184E-01 --0.72126E-01 0 -0.76191E-01 --0.67411E-01 0 -0.72413E-01 --0.62697E-01 0 -0.68635E-01 --0.57982E-01 0 -0.64857E-01 --0.53600E-01 0 -0.61334E-01 --0.50215E-01 0 -0.58574E-01 --0.46829E-01 0 -0.55814E-01 --0.43443E-01 0 -0.53054E-01 --0.40291E-01 0 -0.50460E-01 --0.37840E-01 0 -0.48362E-01 --0.35388E-01 0 -0.46264E-01 --0.32937E-01 0 -0.44166E-01 --0.30649E-01 0 -0.42183E-01 --0.28853E-01 0 -0.40544E-01 --0.27056E-01 0 -0.38904E-01 --0.25260E-01 0 -0.37265E-01 --0.23579E-01 0 -0.35709E-01 --0.22246E-01 0 -0.34406E-01 --0.20912E-01 0 -0.33102E-01 --0.19579E-01 0 -0.31798E-01 --0.18328E-01 0 -0.30558E-01 --0.17326E-01 0 -0.29509E-01 --0.16323E-01 0 -0.28460E-01 --0.15320E-01 0 -0.27411E-01 --0.14375E-01 0 -0.26214E-01 --0.13605E-01 0 -0.24573E-01 --0.12835E-01 0 -0.22931E-01 --0.12064E-01 0 -0.21289E-01 --0.11338E-01 0 -0.20097E-01 --0.10743E-01 0 -0.20255E-01 --0.10148E-01 0 -0.20413E-01 --0.95532E-02 0 -0.20571E-01 --0.89911E-02 0 -0.20545E-01 --0.85277E-02 0 -0.19965E-01 --0.80643E-02 0 -0.19385E-01 --0.76009E-02 0 -0.18805E-01 --0.71607E-02 0 -0.18252E-01 --0.67903E-02 0 -0.17780E-01 --0.64199E-02 0 -0.17308E-01 --0.60494E-02 0 -0.16836E-01 --0.56961E-02 0 -0.16387E-01 --0.53942E-02 0 -0.16005E-01 --0.50922E-02 0 -0.15623E-01 --0.47902E-02 0 -0.15241E-01 --0.45009E-02 0 -0.14879E-01 --0.42493E-02 0 -0.14574E-01 --0.39977E-02 0 -0.14269E-01 --0.37461E-02 0 -0.13964E-01 --0.35037E-02 0 -0.13676E-01 --0.32888E-02 0 -0.13438E-01 --0.30740E-02 0 -0.13200E-01 --0.28592E-02 0 -0.12962E-01 --0.26509E-02 0 -0.12739E-01 --0.24623E-02 0 -0.12560E-01 --0.22738E-02 0 -0.12382E-01 --0.20852E-02 0 -0.12203E-01 --0.19012E-02 0 -0.12038E-01 --0.17307E-02 0 -0.11914E-01 --0.15602E-02 0 -0.11790E-01 --0.13897E-02 0 -0.11665E-01 --0.12220E-02 0 -0.11554E-01 --0.10628E-02 0 -0.11480E-01 --0.90360E-03 0 -0.11407E-01 --0.74439E-03 0 -0.11333E-01 --0.58656E-03 0 -0.10573E-01 --0.43287E-03 0 -0.77537E-02 --0.27919E-03 0 -0.49342E-02 --0.12551E-03 0 -0.21146E-02 -0.45778 0 -1.2591 -0.44348 0 -1.2978 -0.42724 0 -1.3384 -0.41013 0 -1.3799 -0.39237 0 -1.4183 -0.37400 0 -1.4540 -0.35565 0 -1.4878 -0.33735 0 -1.5177 -0.31923 0 -1.5469 -0.30208 0 -1.5717 -0.28493 0 -1.5964 -0.26964 0 -1.6170 -0.25441 0 -1.6375 -0.24101 0 -1.6553 -0.22810 0 -1.6724 -0.21663 0 -1.6880 -0.20610 0 -1.7027 -0.19647 0 -1.7168 -0.18806 0 -1.7301 -0.18005 0 -1.7431 -0.17327 0 -1.7555 -0.16655 0 -1.7679 -0.16079 0 -1.7799 -0.15503 0 -1.7918 -0.14966 0 -1.8035 -0.14433 0 -1.8151 -0.13899 0 -1.8263 -0.13363 0 -1.8373 -0.12814 0 -1.8479 -0.12253 0 -1.8581 -0.11685 0 -1.8679 -0.11103 0 -1.8768 -0.10523 0 -1.8855 -0.99537E-01 0 -1.8930 -0.93842E-01 0 -1.9004 -0.88749E-01 0 -1.9064 -0.83672E-01 0 -1.9124 -0.79485E-01 0 -1.9174 -0.75528E-01 0 -1.9222 -0.72459E-01 0 -1.9266 -0.69951E-01 0 -1.9307 -0.68126E-01 0 -1.9342 -0.67200E-01 0 -1.9370 -0.66518E-01 0 -1.9405 -0.66566E-01 0 -1.9467 -0.66819E-01 0 -1.9521 -0.67161E-01 0 -1.9575 -0.67567E-01 0 -1.9636 -0.67748E-01 0 -1.9702 -0.67626E-01 0 -1.9772 -0.66819E-01 0 -1.9849 -0.66012E-01 0 -1.9927 -0.63833E-01 0 -2.0005 -0.61412E-01 0 -2.0083 -0.58207E-01 0 -2.0158 -0.54045E-01 0 -2.0227 -0.49812E-01 0 -2.0296 -0.44246E-01 0 -2.0348 -0.38679E-01 0 -2.0400 -0.32652E-01 0 -2.0436 -0.26378E-01 0 -2.0463 -0.20152E-01 0 -2.0483 -0.14073E-01 0 -2.0483 -0.79942E-02 0 -2.0483 -0.28810E-02 0 -2.0463 --0.20617E-02 0 -2.0438 --0.61440E-02 0 -2.0407 --0.91745E-02 0 -2.0365 --0.12089E-01 0 -2.0324 --0.12804E-01 0 -2.0277 --0.13518E-01 0 -2.0230 --0.12802E-01 0 -2.0186 --0.11316E-01 0 -2.0145 --0.94891E-02 0 -2.0107 --0.66403E-02 0 -2.0080 --0.33329E-02 0 -2.0062 -0.17541E-03 0 -2.0050 -0.38280E-02 0 -2.0049 -0.73170E-02 0 -2.0059 -0.10549E-01 0 -2.0076 -0.13171E-01 0 -2.0101 -0.15793E-01 0 -2.0126 -0.17182E-01 0 -2.0160 -0.18353E-01 0 -2.0195 -0.18845E-01 0 -2.0230 -0.18507E-01 0 -2.0264 -0.18114E-01 0 -2.0299 -0.16662E-01 0 -2.0325 -0.15210E-01 0 -2.0351 -0.13483E-01 0 -2.0368 -0.11607E-01 0 -2.0381 -0.98235E-02 0 -2.0390 -0.83135E-02 0 -2.0390 -0.68034E-02 0 -2.0389 -0.61863E-02 0 -2.0382 -0.57267E-02 0 -2.0373 -0.59142E-02 0 -2.0365 -0.68926E-02 0 -2.0357 -0.79393E-02 0 -2.0349 -0.10283E-01 0 -2.0352 -0.12626E-01 0 -2.0355 -0.15455E-01 0 -2.0369 -0.18546E-01 0 -2.0389 -0.21597E-01 0 -2.0417 -0.24527E-01 0 -2.0468 -0.26879E-01 0 -2.0529 -0.28699E-01 0 -2.0596 -0.29502E-01 0 -2.0676 -0.28859E-01 0 -2.0770 -0.26913E-01 0 -2.0869 -0.22505E-01 0 -2.0967 -0.18097E-01 0 -2.1065 -0.95880E-02 0 -2.1163 -0.35483E-03 0 -2.1260 --0.11212E-01 0 -2.1347 --0.25632E-01 0 -2.1419 --0.40298E-01 0 -2.1490 --0.59628E-01 0 -2.1517 --0.78958E-01 0 -2.1544 --0.10091 0 -2.1529 --0.12427 0 -2.1491 --0.14830 0 -2.1434 --0.17432 0 -2.1319 --0.20035 0 -2.1204 --0.22723 0 -2.1016 --0.25426 0 -2.0816 --0.28101 0 -2.0579 --0.30742 0 -2.0296 --0.33373 0 -2.0009 --0.35821 0 -1.9651 --0.38269 0 -1.9293 --0.40544 0 -1.8894 --0.42725 0 -1.8474 --0.44841 0 -1.8042 --0.46762 0 -1.7571 --0.48624 0 -1.7090 --0.50313 0 -1.6582 --0.51942 0 -1.6064 --0.53392 0 -1.5520 --0.54772 0 -1.4968 --0.55941 0 -1.4391 --0.57020 0 -1.3808 --0.57831 0 -1.3203 --0.58524 0 -1.2589 --0.58865 0 -1.1945 --0.59048 0 -1.1310 --0.58760 0 -1.0701 --0.58472 0 -1.0093 --0.57710 0 -0.94909 --0.56693 0 -0.88927 --0.55645 0 -0.82972 --0.54033 0 -0.77504 --0.52421 0 -0.72035 --0.50644 0 -0.66877 --0.48664 0 -0.62098 --0.46685 0 -0.57318 --0.44594 0 -0.53172 --0.42484 0 -0.49138 --0.40385 0 -0.45279 --0.38320 0 -0.41947 --0.36255 0 -0.38615 --0.34284 0 -0.35680 --0.32363 0 -0.32958 --0.30452 0 -0.30261 --0.28713 0 -0.28046 --0.26975 0 -0.25831 --0.25319 0 -0.23804 --0.23763 0 -0.22009 --0.22208 0 -0.20214 --0.20799 0 -0.18734 --0.19416 0 -0.17309 --0.18086 0 -0.15975 --0.16916 0 -0.14912 --0.15745 0 -0.13848 --0.14575 0 -0.12785 --0.13469 0 -0.11805 --0.12559 0 -0.11078 --0.11649 0 -0.10351 --0.10739 0 -0.96246E-01 --0.98890E-01 0 -0.89581E-01 --0.92210E-01 0 -0.84724E-01 --0.85529E-01 0 -0.79867E-01 --0.78849E-01 0 -0.75010E-01 --0.72648E-01 0 -0.70526E-01 --0.67889E-01 0 -0.67162E-01 --0.63129E-01 0 -0.63799E-01 --0.58370E-01 0 -0.60435E-01 --0.53951E-01 0 -0.57295E-01 --0.50555E-01 0 -0.54828E-01 --0.47158E-01 0 -0.52360E-01 --0.43762E-01 0 -0.49893E-01 --0.40601E-01 0 -0.47568E-01 --0.38146E-01 0 -0.45672E-01 --0.35691E-01 0 -0.43776E-01 --0.33236E-01 0 -0.41880E-01 --0.30945E-01 0 -0.40084E-01 --0.29146E-01 0 -0.38585E-01 --0.27346E-01 0 -0.37087E-01 --0.25547E-01 0 -0.35588E-01 --0.23863E-01 0 -0.34163E-01 --0.22525E-01 0 -0.32959E-01 --0.21187E-01 0 -0.31754E-01 --0.19850E-01 0 -0.30550E-01 --0.18594E-01 0 -0.29402E-01 --0.17586E-01 0 -0.28425E-01 --0.16577E-01 0 -0.27447E-01 --0.15569E-01 0 -0.26469E-01 --0.14618E-01 0 -0.25341E-01 --0.13842E-01 0 -0.23762E-01 --0.13065E-01 0 -0.22182E-01 --0.12288E-01 0 -0.20603E-01 --0.11555E-01 0 -0.19464E-01 --0.10954E-01 0 -0.19648E-01 --0.10352E-01 0 -0.19831E-01 --0.97507E-02 0 -0.20015E-01 --0.91822E-02 0 -0.20015E-01 --0.87124E-02 0 -0.19462E-01 --0.82427E-02 0 -0.18910E-01 --0.77729E-02 0 -0.18358E-01 --0.73264E-02 0 -0.17831E-01 --0.69499E-02 0 -0.17379E-01 --0.65734E-02 0 -0.16928E-01 --0.61968E-02 0 -0.16476E-01 --0.58375E-02 0 -0.16046E-01 --0.55297E-02 0 -0.15679E-01 --0.52220E-02 0 -0.15312E-01 --0.49142E-02 0 -0.14946E-01 --0.46192E-02 0 -0.14597E-01 --0.43621E-02 0 -0.14303E-01 --0.41050E-02 0 -0.14009E-01 --0.38480E-02 0 -0.13716E-01 --0.36002E-02 0 -0.13438E-01 --0.33801E-02 0 -0.13208E-01 --0.31601E-02 0 -0.12978E-01 --0.29400E-02 0 -0.12748E-01 --0.27266E-02 0 -0.12532E-01 --0.25331E-02 0 -0.12359E-01 --0.23395E-02 0 -0.12186E-01 --0.21460E-02 0 -0.12013E-01 --0.19570E-02 0 -0.11854E-01 --0.17817E-02 0 -0.11733E-01 --0.16064E-02 0 -0.11612E-01 --0.14311E-02 0 -0.11492E-01 --0.12586E-02 0 -0.11384E-01 --0.10947E-02 0 -0.11312E-01 --0.93080E-03 0 -0.11241E-01 --0.76688E-03 0 -0.11169E-01 --0.60436E-03 0 -0.10421E-01 --0.44602E-03 0 -0.76422E-02 --0.28769E-03 0 -0.48632E-02 --0.12936E-03 0 -0.20842E-02 -0.48579 0 -1.2729 -0.46963 0 -1.3128 -0.45140 0 -1.3545 -0.43223 0 -1.3969 -0.41244 0 -1.4360 -0.39204 0 -1.4720 -0.37174 0 -1.5059 -0.35162 0 -1.5356 -0.33171 0 -1.5644 -0.31305 0 -1.5885 -0.29440 0 -1.6126 -0.27796 0 -1.6323 -0.26159 0 -1.6518 -0.24737 0 -1.6686 -0.23373 0 -1.6846 -0.22176 0 -1.6992 -0.21088 0 -1.7130 -0.20102 0 -1.7261 -0.19255 0 -1.7385 -0.18452 0 -1.7507 -0.17785 0 -1.7626 -0.17126 0 -1.7743 -0.16568 0 -1.7860 -0.16009 0 -1.7976 -0.15483 0 -1.8091 -0.14962 0 -1.8206 -0.14427 0 -1.8318 -0.13886 0 -1.8429 -0.13321 0 -1.8535 -0.12734 0 -1.8638 -0.12134 0 -1.8736 -0.11508 0 -1.8825 -0.10883 0 -1.8912 -0.10259 0 -1.8984 -0.96359E-01 0 -1.9057 -0.90757E-01 0 -1.9113 -0.85170E-01 0 -1.9169 -0.80612E-01 0 -1.9214 -0.76320E-01 0 -1.9256 -0.73086E-01 0 -1.9294 -0.70521E-01 0 -1.9329 -0.68781E-01 0 -1.9358 -0.68132E-01 0 -1.9381 -0.67779E-01 0 -1.9412 -0.68317E-01 0 -1.9467 -0.69103E-01 0 -1.9519 -0.69998E-01 0 -1.9571 -0.70972E-01 0 -1.9633 -0.71673E-01 0 -1.9701 -0.72006E-01 0 -1.9775 -0.71507E-01 0 -1.9858 -0.71009E-01 0 -1.9941 -0.68851E-01 0 -2.0027 -0.66401E-01 0 -2.0112 -0.63006E-01 0 -2.0194 -0.58456E-01 0 -2.0271 -0.53822E-01 0 -2.0346 -0.47579E-01 0 -2.0403 -0.41336E-01 0 -2.0459 -0.34526E-01 0 -2.0497 -0.27411E-01 0 -2.0525 -0.20343E-01 0 -2.0546 -0.13419E-01 0 -2.0543 -0.64938E-02 0 -2.0541 -0.67550E-03 0 -2.0514 --0.49475E-02 0 -2.0483 --0.95669E-02 0 -2.0443 --0.12959E-01 0 -2.0393 --0.16216E-01 0 -2.0342 --0.16884E-01 0 -2.0285 --0.17552E-01 0 -2.0228 --0.16534E-01 0 -2.0176 --0.14608E-01 0 -2.0127 --0.12282E-01 0 -2.0082 --0.87584E-02 0 -2.0049 --0.47089E-02 0 -2.0027 --0.43567E-03 0 -2.0014 -0.39832E-02 0 -2.0013 -0.81763E-02 0 -2.0025 -0.12038E-01 0 -2.0045 -0.15131E-01 0 -2.0075 -0.18224E-01 0 -2.0106 -0.19794E-01 0 -2.0146 -0.21097E-01 0 -2.0187 -0.21572E-01 0 -2.0228 -0.21037E-01 0 -2.0269 -0.20434E-01 0 -2.0309 -0.18558E-01 0 -2.0338 -0.16682E-01 0 -2.0367 -0.14481E-01 0 -2.0386 -0.12106E-01 0 -2.0399 -0.98455E-02 0 -2.0407 -0.79280E-02 0 -2.0404 -0.60104E-02 0 -2.0401 -0.51955E-02 0 -2.0388 -0.45751E-02 0 -2.0374 -0.47628E-02 0 -2.0360 -0.59383E-02 0 -2.0345 -0.72016E-02 0 -2.0332 -0.10134E-01 0 -2.0330 -0.13066E-01 0 -2.0328 -0.16695E-01 0 -2.0340 -0.20698E-01 0 -2.0359 -0.24699E-01 0 -2.0387 -0.28690E-01 0 -2.0441 -0.32109E-01 0 -2.0508 -0.34975E-01 0 -2.0583 -0.36757E-01 0 -2.0674 -0.36950E-01 0 -2.0782 -0.35698E-01 0 -2.0897 -0.31701E-01 0 -2.1014 -0.27704E-01 0 -2.1130 -0.19096E-01 0 -2.1249 -0.96746E-02 0 -2.1368 --0.23791E-02 0 -2.1476 --0.17650E-01 0 -2.1570 --0.33198E-01 0 -2.1662 --0.54010E-01 0 -2.1708 --0.74821E-01 0 -2.1754 --0.98583E-01 0 -2.1755 --0.12393 0 -2.1732 --0.15003 0 -2.1688 --0.17835 0 -2.1580 --0.20667 0 -2.1473 --0.23590 0 -2.1287 --0.26529 0 -2.1088 --0.29431 0 -2.0849 --0.32287 0 -2.0560 --0.35132 0 -2.0268 --0.37760 0 -1.9899 --0.40387 0 -1.9531 --0.42816 0 -1.9121 --0.45138 0 -1.8689 --0.47389 0 -1.8244 --0.49426 0 -1.7761 --0.51403 0 -1.7268 --0.53204 0 -1.6747 --0.54946 0 -1.6216 --0.56516 0 -1.5658 --0.58016 0 -1.5091 --0.59307 0 -1.4498 --0.60507 0 -1.3896 --0.61433 0 -1.3271 --0.62229 0 -1.2635 --0.62635 0 -1.1964 --0.62865 0 -1.1303 --0.62564 0 -1.0669 --0.62264 0 -1.0035 --0.61419 0 -0.94082 --0.60282 0 -0.87857 --0.59110 0 -0.81661 --0.57303 0 -0.76011 --0.55495 0 -0.70362 --0.53509 0 -0.65060 --0.51307 0 -0.60183 --0.49104 0 -0.55306 --0.46805 0 -0.51126 --0.44488 0 -0.47070 --0.42192 0 -0.43203 --0.39958 0 -0.39904 --0.37724 0 -0.36604 --0.35609 0 -0.33719 --0.33560 0 -0.31058 --0.31521 0 -0.28422 --0.29686 0 -0.26276 --0.27851 0 -0.24131 --0.26108 0 -0.22175 --0.24477 0 -0.20449 --0.22847 0 -0.18724 --0.21372 0 -0.17316 --0.19925 0 -0.15964 --0.18533 0 -0.14700 --0.17310 0 -0.13698 --0.16087 0 -0.12696 --0.14864 0 -0.11694 --0.13711 0 -0.10777 --0.12767 0 -0.10113 --0.11823 0 -0.94484E-01 --0.10878 0 -0.87841E-01 --0.99993E-01 0 -0.81781E-01 --0.93161E-01 0 -0.77465E-01 --0.86329E-01 0 -0.73150E-01 --0.79496E-01 0 -0.68835E-01 --0.73171E-01 0 -0.64861E-01 --0.68366E-01 0 -0.61912E-01 --0.63561E-01 0 -0.58962E-01 --0.58757E-01 0 -0.56013E-01 --0.54302E-01 0 -0.53257E-01 --0.50895E-01 0 -0.51082E-01 --0.47488E-01 0 -0.48906E-01 --0.44081E-01 0 -0.46731E-01 --0.40911E-01 0 -0.44676E-01 --0.38452E-01 0 -0.42982E-01 --0.35994E-01 0 -0.41288E-01 --0.33536E-01 0 -0.39594E-01 --0.31241E-01 0 -0.37984E-01 --0.29439E-01 0 -0.36627E-01 --0.27636E-01 0 -0.35269E-01 --0.25834E-01 0 -0.33911E-01 --0.24146E-01 0 -0.32617E-01 --0.22804E-01 0 -0.31512E-01 --0.21462E-01 0 -0.30407E-01 --0.20120E-01 0 -0.29302E-01 --0.18860E-01 0 -0.28247E-01 --0.17846E-01 0 -0.27340E-01 --0.16832E-01 0 -0.26434E-01 --0.15818E-01 0 -0.25527E-01 --0.14862E-01 0 -0.24468E-01 --0.14078E-01 0 -0.22951E-01 --0.13295E-01 0 -0.21434E-01 --0.12512E-01 0 -0.19917E-01 --0.11772E-01 0 -0.18831E-01 --0.11164E-01 0 -0.19040E-01 --0.10556E-01 0 -0.19249E-01 --0.99483E-02 0 -0.19459E-01 --0.93733E-02 0 -0.19484E-01 --0.88971E-02 0 -0.18960E-01 --0.84210E-02 0 -0.18435E-01 --0.79449E-02 0 -0.17911E-01 --0.74921E-02 0 -0.17410E-01 --0.71095E-02 0 -0.16979E-01 --0.67268E-02 0 -0.16547E-01 --0.63442E-02 0 -0.16116E-01 --0.59788E-02 0 -0.15705E-01 --0.56653E-02 0 -0.15353E-01 --0.53518E-02 0 -0.15002E-01 --0.50382E-02 0 -0.14650E-01 --0.47375E-02 0 -0.14315E-01 --0.44749E-02 0 -0.14033E-01 --0.42124E-02 0 -0.13750E-01 --0.39498E-02 0 -0.13467E-01 --0.36966E-02 0 -0.13199E-01 --0.34714E-02 0 -0.12977E-01 --0.32461E-02 0 -0.12755E-01 --0.30209E-02 0 -0.12533E-01 --0.28023E-02 0 -0.12325E-01 --0.26038E-02 0 -0.12158E-01 --0.24053E-02 0 -0.11991E-01 --0.22068E-02 0 -0.11823E-01 --0.20129E-02 0 -0.11669E-01 --0.18328E-02 0 -0.11552E-01 --0.16526E-02 0 -0.11435E-01 --0.14725E-02 0 -0.11318E-01 --0.12952E-02 0 -0.11213E-01 --0.11266E-02 0 -0.11144E-01 --0.95799E-03 0 -0.11075E-01 --0.78937E-03 0 -0.11006E-01 --0.62215E-03 0 -0.10269E-01 --0.45917E-03 0 -0.75306E-02 --0.29619E-03 0 -0.47922E-02 --0.13321E-03 0 -0.20538E-02 -0.51596 0 -1.2896 -0.49742 0 -1.3310 -0.47670 0 -1.3738 -0.45501 0 -1.4172 -0.43276 0 -1.4569 -0.40998 0 -1.4931 -0.38737 0 -1.5269 -0.36514 0 -1.5562 -0.34318 0 -1.5845 -0.32279 0 -1.6077 -0.30241 0 -1.6308 -0.28472 0 -1.6493 -0.26711 0 -1.6675 -0.25207 0 -1.6830 -0.23771 0 -1.6977 -0.22532 0 -1.7110 -0.21419 0 -1.7235 -0.20425 0 -1.7355 -0.19590 0 -1.7468 -0.18804 0 -1.7581 -0.18171 0 -1.7692 -0.17546 0 -1.7804 -0.17026 0 -1.7917 -0.16506 0 -1.8030 -0.16009 0 -1.8144 -0.15514 0 -1.8259 -0.14990 0 -1.8372 -0.14452 0 -1.8485 -0.13874 0 -1.8594 -0.13260 0 -1.8698 -0.12622 0 -1.8798 -0.11939 0 -1.8889 -0.11254 0 -1.8976 -0.10556 0 -1.9048 -0.98573E-01 0 -1.9119 -0.92244E-01 0 -1.9170 -0.85931E-01 0 -1.9222 -0.80834E-01 0 -1.9260 -0.76054E-01 0 -1.9294 -0.72578E-01 0 -1.9324 -0.69929E-01 0 -1.9350 -0.68320E-01 0 -1.9372 -0.68085E-01 0 -1.9388 -0.68227E-01 0 -1.9412 -0.69499E-01 0 -1.9458 -0.71086E-01 0 -1.9505 -0.72811E-01 0 -1.9556 -0.74637E-01 0 -1.9619 -0.76120E-01 0 -1.9690 -0.77140E-01 0 -1.9770 -0.77118E-01 0 -1.9861 -0.77096E-01 0 -1.9952 -0.75010E-01 0 -2.0048 -0.72559E-01 0 -2.0143 -0.68947E-01 0 -2.0235 -0.63913E-01 0 -2.0321 -0.58776E-01 0 -2.0406 -0.51670E-01 0 -2.0468 -0.44563E-01 0 -2.0531 -0.36750E-01 0 -2.0573 -0.28555E-01 0 -2.0603 -0.20403E-01 0 -2.0624 -0.12379E-01 0 -2.0618 -0.43559E-02 0 -2.0612 --0.23902E-02 0 -2.0577 --0.89108E-02 0 -2.0538 --0.14241E-01 0 -2.0489 --0.18117E-01 0 -2.0426 --0.21828E-01 0 -2.0364 --0.22424E-01 0 -2.0294 --0.23020E-01 0 -2.0224 --0.21573E-01 0 -2.0160 --0.19027E-01 0 -2.0100 --0.15999E-01 0 -2.0045 --0.11528E-01 0 -2.0005 --0.64400E-02 0 -1.9979 --0.10997E-02 0 -1.9963 -0.43816E-02 0 -1.9963 -0.95407E-02 0 -1.9978 -0.14258E-01 0 -2.0004 -0.17970E-01 0 -2.0042 -0.21682E-01 0 -2.0080 -0.23458E-01 0 -2.0129 -0.24892E-01 0 -2.0180 -0.25295E-01 0 -2.0230 -0.24437E-01 0 -2.0278 -0.23497E-01 0 -2.0325 -0.20995E-01 0 -2.0359 -0.18493E-01 0 -2.0393 -0.15602E-01 0 -2.0413 -0.12502E-01 0 -2.0426 -0.95454E-02 0 -2.0434 -0.70190E-02 0 -2.0426 -0.44925E-02 0 -2.0418 -0.33404E-02 0 -2.0399 -0.24307E-02 0 -2.0377 -0.25440E-02 0 -2.0354 -0.39077E-02 0 -2.0331 -0.53862E-02 0 -2.0308 -0.90479E-02 0 -2.0298 -0.12710E-01 0 -2.0289 -0.17370E-01 0 -2.0296 -0.22569E-01 0 -2.0311 -0.27822E-01 0 -2.0338 -0.33238E-01 0 -2.0395 -0.38108E-01 0 -2.0467 -0.42410E-01 0 -2.0552 -0.45552E-01 0 -2.0655 -0.46934E-01 0 -2.0780 -0.46696E-01 0 -2.0913 -0.43356E-01 0 -2.1052 -0.40017E-01 0 -2.1191 -0.31428E-01 0 -2.1335 -0.21913E-01 0 -2.1480 -0.93956E-02 0 -2.1614 --0.67918E-02 0 -2.1734 --0.23295E-01 0 -2.1852 --0.45802E-01 0 -2.1921 --0.68308E-01 0 -2.1991 --0.94179E-01 0 -2.2011 --0.12186 0 -2.2006 --0.15038 0 -2.1977 --0.18142 0 -2.1878 --0.21246 0 -2.1780 --0.24445 0 -2.1596 --0.27661 0 -2.1397 --0.30827 0 -2.1154 --0.33931 0 -2.0857 --0.37021 0 -2.0556 --0.39841 0 -2.0175 --0.42661 0 -1.9793 --0.45246 0 -1.9369 --0.47703 0 -1.8921 --0.50080 0 -1.8462 --0.52218 0 -1.7966 --0.54295 0 -1.7460 --0.56193 0 -1.6927 --0.58040 0 -1.6384 --0.59736 0 -1.5813 --0.61372 0 -1.5233 --0.62830 0 -1.4623 --0.64195 0 -1.4004 --0.65282 0 -1.3356 --0.66232 0 -1.2695 --0.66770 0 -1.1993 --0.67096 0 -1.1300 --0.66790 0 -1.0634 --0.66483 0 -0.99685 --0.65535 0 -0.93111 --0.64242 0 -0.86581 --0.62909 0 -0.80084 --0.60838 0 -0.74222 --0.58766 0 -0.68360 --0.56510 0 -0.62897 --0.54028 0 -0.57922 --0.51546 0 -0.52948 --0.49001 0 -0.48754 --0.46444 0 -0.44698 --0.43922 0 -0.40846 --0.41505 0 -0.37606 --0.39088 0 -0.34366 --0.36826 0 -0.31557 --0.34647 0 -0.28979 --0.32481 0 -0.26428 --0.30557 0 -0.24368 --0.28633 0 -0.22309 --0.26809 0 -0.20435 --0.25110 0 -0.18787 --0.23410 0 -0.17139 --0.21872 0 -0.15809 --0.20363 0 -0.14535 --0.18912 0 -0.13346 --0.17633 0 -0.12411 --0.16354 0 -0.11476 --0.15076 0 -0.10541 --0.13872 0 -0.96915E-01 --0.12895 0 -0.90971E-01 --0.11917 0 -0.85026E-01 --0.10940 0 -0.79081E-01 --0.10034 0 -0.73694E-01 --0.93413E-01 0 -0.69976E-01 --0.86488E-01 0 -0.66258E-01 --0.79563E-01 0 -0.62541E-01 --0.73169E-01 0 -0.59124E-01 --0.68369E-01 0 -0.56611E-01 --0.63569E-01 0 -0.54098E-01 --0.58769E-01 0 -0.51585E-01 --0.54322E-01 0 -0.49230E-01 --0.50932E-01 0 -0.47350E-01 --0.47543E-01 0 -0.45470E-01 --0.44153E-01 0 -0.43590E-01 --0.41000E-01 0 -0.41807E-01 --0.38556E-01 0 -0.40313E-01 --0.36113E-01 0 -0.38820E-01 --0.33669E-01 0 -0.37326E-01 --0.31387E-01 0 -0.35901E-01 --0.29593E-01 0 -0.34682E-01 --0.27799E-01 0 -0.33464E-01 --0.26005E-01 0 -0.32245E-01 --0.24325E-01 0 -0.31079E-01 --0.22986E-01 0 -0.30072E-01 --0.21647E-01 0 -0.29065E-01 --0.20308E-01 0 -0.28058E-01 --0.19051E-01 0 -0.27094E-01 --0.18036E-01 0 -0.26258E-01 --0.17022E-01 0 -0.25421E-01 --0.16008E-01 0 -0.24584E-01 --0.15051E-01 0 -0.23593E-01 --0.14265E-01 0 -0.22138E-01 --0.13479E-01 0 -0.20683E-01 --0.12693E-01 0 -0.19229E-01 --0.11950E-01 0 -0.18196E-01 --0.11338E-01 0 -0.18430E-01 --0.10726E-01 0 -0.18664E-01 --0.10114E-01 0 -0.18897E-01 --0.95351E-02 0 -0.18949E-01 --0.90545E-02 0 -0.18452E-01 --0.85740E-02 0 -0.17955E-01 --0.80934E-02 0 -0.17458E-01 --0.76362E-02 0 -0.16982E-01 --0.72488E-02 0 -0.16571E-01 --0.68615E-02 0 -0.16161E-01 --0.64742E-02 0 -0.15750E-01 --0.61041E-02 0 -0.15358E-01 --0.57859E-02 0 -0.15021E-01 --0.54676E-02 0 -0.14684E-01 --0.51493E-02 0 -0.14348E-01 --0.48438E-02 0 -0.14027E-01 --0.45766E-02 0 -0.13756E-01 --0.43094E-02 0 -0.13484E-01 --0.40422E-02 0 -0.13212E-01 --0.37843E-02 0 -0.12955E-01 --0.35545E-02 0 -0.12741E-01 --0.33247E-02 0 -0.12527E-01 --0.30949E-02 0 -0.12313E-01 --0.28718E-02 0 -0.12112E-01 --0.26688E-02 0 -0.11951E-01 --0.24658E-02 0 -0.11789E-01 --0.22628E-02 0 -0.11627E-01 --0.20644E-02 0 -0.11478E-01 --0.18799E-02 0 -0.11365E-01 --0.16954E-02 0 -0.11252E-01 --0.15108E-02 0 -0.11139E-01 --0.13292E-02 0 -0.11037E-01 --0.11562E-02 0 -0.10970E-01 --0.98323E-03 0 -0.10903E-01 --0.81026E-03 0 -0.10836E-01 --0.63870E-03 0 -0.10111E-01 --0.47140E-03 0 -0.74150E-02 --0.30410E-03 0 -0.47186E-02 --0.13680E-03 0 -0.20223E-02 -0.54831 0 -1.3094 -0.52683 0 -1.3523 -0.50314 0 -1.3963 -0.47846 0 -1.4408 -0.45334 0 -1.4810 -0.42780 0 -1.5173 -0.40255 0 -1.5510 -0.37791 0 -1.5796 -0.35361 0 -1.6071 -0.33129 0 -1.6291 -0.30897 0 -1.6511 -0.28992 0 -1.6679 -0.27098 0 -1.6847 -0.25510 0 -1.6985 -0.24004 0 -1.7115 -0.22729 0 -1.7233 -0.21604 0 -1.7343 -0.20615 0 -1.7449 -0.19810 0 -1.7550 -0.19061 0 -1.7653 -0.18484 0 -1.7756 -0.17914 0 -1.7860 -0.17453 0 -1.7970 -0.16993 0 -1.8079 -0.16541 0 -1.8194 -0.16091 0 -1.8310 -0.15587 0 -1.8426 -0.15061 0 -1.8542 -0.14474 0 -1.8655 -0.13829 0 -1.8764 -0.13147 0 -1.8867 -0.12394 0 -1.8960 -0.11635 0 -1.9049 -0.10842 0 -1.9120 -0.10048 0 -1.9190 -0.93211E-01 0 -1.9236 -0.85953E-01 0 -1.9282 -0.80152E-01 0 -1.9311 -0.74729E-01 0 -1.9337 -0.70936E-01 0 -1.9356 -0.68175E-01 0 -1.9371 -0.66742E-01 0 -1.9383 -0.67060E-01 0 -1.9390 -0.67861E-01 0 -1.9405 -0.70113E-01 0 -1.9439 -0.72767E-01 0 -1.9481 -0.75600E-01 0 -1.9530 -0.78563E-01 0 -1.9593 -0.81089E-01 0 -1.9670 -0.83030E-01 0 -1.9756 -0.83651E-01 0 -1.9858 -0.84271E-01 0 -1.9960 -0.82307E-01 0 -2.0068 -0.79887E-01 0 -2.0176 -0.76030E-01 0 -2.0280 -0.70416E-01 0 -2.0378 -0.64674E-01 0 -2.0475 -0.56518E-01 0 -2.0545 -0.48361E-01 0 -2.0616 -0.39323E-01 0 -2.0662 -0.29810E-01 0 -2.0695 -0.20331E-01 0 -2.0717 -0.10956E-01 0 -2.0707 -0.15805E-02 0 -2.0697 --0.63160E-02 0 -2.0654 --0.13952E-01 0 -2.0604 --0.20167E-01 0 -2.0542 --0.24646E-01 0 -2.0465 --0.28926E-01 0 -2.0388 --0.29424E-01 0 -2.0301 --0.29922E-01 0 -2.0215 --0.27921E-01 0 -2.0137 --0.24574E-01 0 -2.0063 --0.20641E-01 0 -1.9996 --0.14949E-01 0 -1.9947 --0.85261E-02 0 -1.9917 --0.18165E-02 0 -1.9898 -0.50233E-02 0 -1.9899 -0.11410E-01 0 -1.9920 -0.17208E-01 0 -1.9952 -0.21689E-01 0 -2.0000 -0.26169E-01 0 -2.0048 -0.28173E-01 0 -2.0109 -0.29740E-01 0 -2.0172 -0.30014E-01 0 -2.0233 -0.28708E-01 0 -2.0291 -0.27302E-01 0 -2.0349 -0.23973E-01 0 -2.0388 -0.20644E-01 0 -2.0428 -0.16846E-01 0 -2.0450 -0.12795E-01 0 -2.0463 -0.89230E-02 0 -2.0469 -0.55864E-02 0 -2.0456 -0.22498E-02 0 -2.0443 -0.62094E-03 0 -2.0413 --0.70651E-03 0 -2.0382 --0.74223E-03 0 -2.0348 -0.80082E-03 0 -2.0312 -0.24933E-02 0 -2.0277 -0.70249E-02 0 -2.0257 -0.11557E-01 0 -2.0237 -0.17482E-01 0 -2.0237 -0.24159E-01 0 -2.0247 -0.30967E-01 0 -2.0270 -0.38171E-01 0 -2.0329 -0.44877E-01 0 -2.0407 -0.51002E-01 0 -2.0501 -0.55889E-01 0 -2.0618 -0.58813E-01 0 -2.0762 -0.59906E-01 0 -2.0917 -0.57471E-01 0 -2.1082 -0.55036E-01 0 -2.1246 -0.46584E-01 0 -2.1420 -0.37070E-01 0 -2.1596 -0.24112E-01 0 -2.1761 -0.69425E-02 0 -2.1912 --0.10589E-01 0 -2.2061 --0.35005E-01 0 -2.2157 --0.59420E-01 0 -2.2254 --0.87695E-01 0 -2.2297 --0.11805 0 -2.2312 --0.14936 0 -2.2301 --0.18354 0 -2.2213 --0.21771 0 -2.2125 --0.25289 0 -2.1942 --0.28824 0 -2.1743 --0.32290 0 -2.1495 --0.35673 0 -2.1188 --0.39038 0 -2.0876 --0.42066 0 -2.0478 --0.45093 0 -2.0080 --0.47834 0 -1.9638 --0.50421 0 -1.9173 --0.52916 0 -1.8696 --0.55138 0 -1.8186 --0.57299 0 -1.7667 --0.59281 0 -1.7122 --0.61224 0 -1.6568 --0.63053 0 -1.5986 --0.64841 0 -1.5393 --0.66509 0 -1.4768 --0.68084 0 -1.4132 --0.69379 0 -1.3459 --0.70534 0 -1.2770 --0.71269 0 -1.2031 --0.71744 0 -1.1301 --0.71437 0 -1.0597 --0.71130 0 -0.98940 --0.70057 0 -0.91995 --0.68572 0 -0.85099 --0.67041 0 -0.78242 --0.64639 0 -0.72136 --0.62236 0 -0.66029 --0.59647 0 -0.60388 --0.56829 0 -0.55317 --0.54011 0 -0.50245 --0.51183 0 -0.46055 --0.48353 0 -0.42021 --0.45577 0 -0.38207 --0.42963 0 -0.35054 --0.40349 0 -0.31901 --0.37933 0 -0.29192 --0.35625 0 -0.26723 --0.33331 0 -0.24278 --0.31325 0 -0.22321 --0.29318 0 -0.20363 --0.27421 0 -0.18584 --0.25660 0 -0.17023 --0.23898 0 -0.15461 --0.22301 0 -0.14214 --0.20732 0 -0.13023 --0.19221 0 -0.11914 --0.17884 0 -0.11051 --0.16546 0 -0.10188 --0.15209 0 -0.93255E-01 --0.13953 0 -0.85490E-01 --0.12943 0 -0.80315E-01 --0.11933 0 -0.75141E-01 --0.10924 0 -0.69966E-01 --0.99923E-01 0 -0.65319E-01 --0.92965E-01 0 -0.62255E-01 --0.86007E-01 0 -0.59191E-01 --0.79049E-01 0 -0.56127E-01 --0.72644E-01 0 -0.53316E-01 --0.67898E-01 0 -0.51261E-01 --0.63152E-01 0 -0.49207E-01 --0.58407E-01 0 -0.47152E-01 --0.54011E-01 0 -0.45215E-01 --0.50668E-01 0 -0.43634E-01 --0.47324E-01 0 -0.42052E-01 --0.43980E-01 0 -0.40470E-01 --0.40869E-01 0 -0.38960E-01 --0.38458E-01 0 -0.37665E-01 --0.36047E-01 0 -0.36370E-01 --0.33635E-01 0 -0.35076E-01 --0.31383E-01 0 -0.33834E-01 --0.29609E-01 0 -0.32752E-01 --0.27835E-01 0 -0.31671E-01 --0.26061E-01 0 -0.30589E-01 --0.24398E-01 0 -0.29550E-01 --0.23070E-01 0 -0.28640E-01 --0.21742E-01 0 -0.27729E-01 --0.20414E-01 0 -0.26819E-01 --0.19166E-01 0 -0.25944E-01 --0.18157E-01 0 -0.25176E-01 --0.17148E-01 0 -0.24409E-01 --0.16138E-01 0 -0.23641E-01 --0.15185E-01 0 -0.22717E-01 --0.14400E-01 0 -0.21324E-01 --0.13615E-01 0 -0.19931E-01 --0.12830E-01 0 -0.18538E-01 --0.12088E-01 0 -0.17558E-01 --0.11475E-01 0 -0.17816E-01 --0.10862E-01 0 -0.18074E-01 --0.10248E-01 0 -0.18331E-01 --0.96677E-02 0 -0.18407E-01 --0.91846E-02 0 -0.17938E-01 --0.87016E-02 0 -0.17468E-01 --0.82185E-02 0 -0.16998E-01 --0.77586E-02 0 -0.16549E-01 --0.73680E-02 0 -0.16158E-01 --0.69774E-02 0 -0.15768E-01 --0.65868E-02 0 -0.15377E-01 --0.62133E-02 0 -0.15004E-01 --0.58914E-02 0 -0.14682E-01 --0.55695E-02 0 -0.14361E-01 --0.52475E-02 0 -0.14039E-01 --0.49383E-02 0 -0.13733E-01 --0.46673E-02 0 -0.13472E-01 --0.43962E-02 0 -0.13212E-01 --0.41251E-02 0 -0.12951E-01 --0.38634E-02 0 -0.12704E-01 --0.36296E-02 0 -0.12498E-01 --0.33958E-02 0 -0.12292E-01 --0.31620E-02 0 -0.12086E-01 --0.29350E-02 0 -0.11893E-01 --0.27280E-02 0 -0.11737E-01 --0.25210E-02 0 -0.11581E-01 --0.23140E-02 0 -0.11425E-01 --0.21117E-02 0 -0.11281E-01 --0.19232E-02 0 -0.11172E-01 --0.17346E-02 0 -0.11063E-01 --0.15461E-02 0 -0.10953E-01 --0.13605E-02 0 -0.10855E-01 --0.11835E-02 0 -0.10790E-01 --0.10065E-02 0 -0.10725E-01 --0.82955E-03 0 -0.10660E-01 --0.65400E-03 0 -0.99481E-02 --0.48271E-03 0 -0.72953E-02 --0.31142E-03 0 -0.46425E-02 --0.14012E-03 0 -0.19896E-02 -0.58067 0 -1.3291 -0.55625 0 -1.3737 -0.52958 0 -1.4189 -0.50191 0 -1.4644 -0.47392 0 -1.5052 -0.44562 0 -1.5415 -0.41774 0 -1.5750 -0.39068 0 -1.6029 -0.36405 0 -1.6298 -0.33979 0 -1.6505 -0.31554 0 -1.6713 -0.29513 0 -1.6866 -0.27484 0 -1.7018 -0.25812 0 -1.7140 -0.24237 0 -1.7254 -0.22927 0 -1.7356 -0.21789 0 -1.7451 -0.20805 0 -1.7543 -0.20031 0 -1.7633 -0.19319 0 -1.7724 -0.18797 0 -1.7820 -0.18282 0 -1.7916 -0.17881 0 -1.8023 -0.17480 0 -1.8129 -0.17074 0 -1.8244 -0.16667 0 -1.8361 -0.16185 0 -1.8480 -0.15671 0 -1.8599 -0.15073 0 -1.8716 -0.14398 0 -1.8829 -0.13673 0 -1.8936 -0.12850 0 -1.9031 -0.12016 0 -1.9122 -0.11128 0 -1.9191 -0.10240 0 -1.9261 -0.94178E-01 0 -1.9301 -0.85976E-01 0 -1.9342 -0.79469E-01 0 -1.9363 -0.73404E-01 0 -1.9379 -0.69294E-01 0 -1.9388 -0.66422E-01 0 -1.9392 -0.65164E-01 0 -1.9394 -0.66035E-01 0 -1.9393 -0.67496E-01 0 -1.9398 -0.70726E-01 0 -1.9421 -0.74449E-01 0 -1.9457 -0.78389E-01 0 -1.9503 -0.82489E-01 0 -1.9568 -0.86059E-01 0 -1.9650 -0.88919E-01 0 -1.9743 -0.90183E-01 0 -1.9855 -0.91447E-01 0 -1.9967 -0.89605E-01 0 -2.0088 -0.87215E-01 0 -2.0209 -0.83113E-01 0 -2.0326 -0.76918E-01 0 -2.0435 -0.70572E-01 0 -2.0544 -0.61366E-01 0 -2.0622 -0.52159E-01 0 -2.0701 -0.41896E-01 0 -2.0752 -0.31064E-01 0 -2.0787 -0.20259E-01 0 -2.0810 -0.95320E-02 0 -2.0796 --0.11948E-02 0 -2.0782 --0.10242E-01 0 -2.0730 --0.18992E-01 0 -2.0670 --0.26093E-01 0 -2.0596 --0.31176E-01 0 -2.0504 --0.36024E-01 0 -2.0412 --0.36424E-01 0 -2.0309 --0.36824E-01 0 -2.0207 --0.34268E-01 0 -2.0114 --0.30121E-01 0 -2.0027 --0.25282E-01 0 -1.9947 --0.18370E-01 0 -1.9890 --0.10612E-01 0 -1.9854 --0.25334E-02 0 -1.9833 -0.56649E-02 0 -1.9836 -0.13280E-01 0 -1.9861 -0.20158E-01 0 -1.9900 -0.25407E-01 0 -1.9958 -0.30656E-01 0 -2.0017 -0.32888E-01 0 -2.0089 -0.34587E-01 0 -2.0164 -0.34733E-01 0 -2.0236 -0.32980E-01 0 -2.0305 -0.31107E-01 0 -2.0373 -0.26951E-01 0 -2.0418 -0.22795E-01 0 -2.0463 -0.18089E-01 0 -2.0487 -0.13088E-01 0 -2.0500 -0.83007E-02 0 -2.0505 -0.41538E-02 0 -2.0486 -0.69880E-05 0 -2.0467 --0.20985E-02 0 -2.0428 --0.38437E-02 0 -2.0386 --0.40285E-02 0 -2.0342 --0.23060E-02 0 -2.0294 --0.39963E-03 0 -2.0247 -0.50019E-02 0 -2.0216 -0.10403E-01 0 -2.0185 -0.17594E-01 0 -2.0178 -0.25748E-01 0 -2.0183 -0.34112E-01 0 -2.0202 -0.43105E-01 0 -2.0262 -0.51645E-01 0 -2.0348 -0.59595E-01 0 -2.0450 -0.66227E-01 0 -2.0582 -0.70691E-01 0 -2.0744 -0.73116E-01 0 -2.0921 -0.71585E-01 0 -2.1112 -0.70055E-01 0 -2.1302 -0.61740E-01 0 -2.1506 -0.52227E-01 0 -2.1712 -0.38828E-01 0 -2.1908 -0.20677E-01 0 -2.2090 -0.21173E-02 0 -2.2269 --0.24207E-01 0 -2.2393 --0.50532E-01 0 -2.2517 --0.81211E-01 0 -2.2583 --0.11423 0 -2.2618 --0.14833 0 -2.2625 --0.18565 0 -2.2548 --0.22297 0 -2.2470 --0.26132 0 -2.2289 --0.29986 0 -2.2088 --0.33754 0 -2.1836 --0.37416 0 -2.1518 --0.41056 0 -2.1196 --0.44290 0 -2.0781 --0.47524 0 -2.0367 --0.50422 0 -1.9908 --0.53138 0 -1.9424 --0.55752 0 -1.8931 --0.58057 0 -1.8407 --0.60303 0 -1.7874 --0.62369 0 -1.7318 --0.64408 0 -1.6752 --0.66369 0 -1.6159 --0.68310 0 -1.5553 --0.70189 0 -1.4913 --0.71974 0 -1.4259 --0.73477 0 -1.3562 --0.74837 0 -1.2846 --0.75769 0 -1.2070 --0.76391 0 -1.1302 --0.76084 0 -1.0561 --0.75777 0 -0.98195 --0.74580 0 -0.90880 --0.72903 0 -0.83617 --0.71174 0 -0.76400 --0.68440 0 -0.70049 --0.65706 0 -0.63699 --0.62783 0 -0.57880 --0.59629 0 -0.52711 --0.56475 0 -0.47542 --0.53365 0 -0.43357 --0.50261 0 -0.39344 --0.47231 0 -0.35568 --0.44420 0 -0.32502 --0.41609 0 -0.29436 --0.39040 0 -0.26828 --0.36602 0 -0.24466 --0.34181 0 -0.22129 --0.32092 0 -0.20274 --0.30003 0 -0.18418 --0.28034 0 -0.16733 --0.26210 0 -0.15258 --0.24386 0 -0.13783 --0.22729 0 -0.12619 --0.21101 0 -0.11511 --0.19531 0 -0.10481 --0.18135 0 -0.96908E-01 --0.16738 0 -0.89002E-01 --0.15341 0 -0.81096E-01 --0.14034 0 -0.74065E-01 --0.12991 0 -0.69660E-01 --0.11949 0 -0.65256E-01 --0.10907 0 -0.60851E-01 --0.99508E-01 0 -0.56945E-01 --0.92517E-01 0 -0.54535E-01 --0.85526E-01 0 -0.52124E-01 --0.78534E-01 0 -0.49714E-01 --0.72118E-01 0 -0.47507E-01 --0.67427E-01 0 -0.45911E-01 --0.62735E-01 0 -0.44315E-01 --0.58044E-01 0 -0.42719E-01 --0.53701E-01 0 -0.41201E-01 --0.50403E-01 0 -0.39917E-01 --0.47105E-01 0 -0.38633E-01 --0.43806E-01 0 -0.37350E-01 --0.40738E-01 0 -0.36113E-01 --0.38359E-01 0 -0.35017E-01 --0.35981E-01 0 -0.33921E-01 --0.33602E-01 0 -0.32825E-01 --0.31379E-01 0 -0.31767E-01 --0.29625E-01 0 -0.30823E-01 --0.27871E-01 0 -0.29878E-01 --0.26116E-01 0 -0.28933E-01 --0.24471E-01 0 -0.28021E-01 --0.23155E-01 0 -0.27207E-01 --0.21838E-01 0 -0.26393E-01 --0.20521E-01 0 -0.25579E-01 --0.19282E-01 0 -0.24793E-01 --0.18278E-01 0 -0.24095E-01 --0.17273E-01 0 -0.23396E-01 --0.16269E-01 0 -0.22698E-01 --0.15320E-01 0 -0.21841E-01 --0.14536E-01 0 -0.20510E-01 --0.13752E-01 0 -0.19179E-01 --0.12968E-01 0 -0.17848E-01 --0.12226E-01 0 -0.16921E-01 --0.11612E-01 0 -0.17202E-01 --0.10997E-01 0 -0.17484E-01 --0.10383E-01 0 -0.17765E-01 --0.98003E-02 0 -0.17866E-01 --0.93147E-02 0 -0.17424E-01 --0.88292E-02 0 -0.16981E-01 --0.83436E-02 0 -0.16539E-01 --0.78809E-02 0 -0.16115E-01 --0.74871E-02 0 -0.15745E-01 --0.70932E-02 0 -0.15375E-01 --0.66993E-02 0 -0.15004E-01 --0.63225E-02 0 -0.14650E-01 --0.59969E-02 0 -0.14344E-01 --0.56714E-02 0 -0.14037E-01 --0.53458E-02 0 -0.13731E-01 --0.50328E-02 0 -0.13438E-01 --0.47579E-02 0 -0.13189E-01 --0.44829E-02 0 -0.12939E-01 --0.42080E-02 0 -0.12690E-01 --0.39424E-02 0 -0.12453E-01 --0.37046E-02 0 -0.12255E-01 --0.34669E-02 0 -0.12057E-01 --0.32292E-02 0 -0.11860E-01 --0.29982E-02 0 -0.11674E-01 --0.27872E-02 0 -0.11524E-01 --0.25762E-02 0 -0.11373E-01 --0.23653E-02 0 -0.11223E-01 --0.21589E-02 0 -0.11084E-01 --0.19664E-02 0 -0.10979E-01 --0.17739E-02 0 -0.10873E-01 --0.15814E-02 0 -0.10768E-01 --0.13917E-02 0 -0.10673E-01 --0.12108E-02 0 -0.10610E-01 --0.10298E-02 0 -0.10547E-01 --0.84885E-03 0 -0.10484E-01 --0.66930E-03 0 -0.97849E-02 --0.49402E-03 0 -0.71756E-02 --0.31873E-03 0 -0.45663E-02 --0.14345E-03 0 -0.19570E-02 -0.61659 0 -1.3561 -0.58779 0 -1.4024 -0.55720 0 -1.4487 -0.52580 0 -1.4950 -0.49428 0 -1.5360 -0.46264 0 -1.5720 -0.43151 0 -1.6050 -0.40142 0 -1.6318 -0.37184 0 -1.6574 -0.34515 0 -1.6763 -0.31847 0 -1.6953 -0.29649 0 -1.7084 -0.27466 0 -1.7213 -0.25715 0 -1.7312 -0.24080 0 -1.7402 -0.22760 0 -1.7483 -0.21645 0 -1.7556 -0.20708 0 -1.7630 -0.20012 0 -1.7704 -0.19385 0 -1.7781 -0.18971 0 -1.7867 -0.18565 0 -1.7955 -0.18277 0 -1.8059 -0.17989 0 -1.8163 -0.17675 0 -1.8282 -0.17357 0 -1.8402 -0.16927 0 -1.8528 -0.16449 0 -1.8656 -0.15851 0 -1.8781 -0.15141 0 -1.8903 -0.14358 0 -1.9018 -0.13429 0 -1.9120 -0.12482 0 -1.9217 -0.11437 0 -1.9287 -0.10392 0 -1.9357 -0.94062E-01 0 -1.9391 -0.84215E-01 0 -1.9424 -0.76433E-01 0 -1.9432 -0.69187E-01 0 -1.9434 -0.64465E-01 0 -1.9426 -0.61340E-01 0 -1.9411 -0.60341E-01 0 -1.9397 -0.62146E-01 0 -1.9382 -0.64735E-01 0 -1.9371 -0.69680E-01 0 -1.9374 -0.75257E-01 0 -1.9401 -0.81111E-01 0 -1.9443 -0.87164E-01 0 -1.9511 -0.92511E-01 0 -1.9600 -0.96930E-01 0 -1.9705 -0.99268E-01 0 -1.9834 -0.10161 0 -1.9964 -0.99971E-01 0 -2.0104 -0.97635E-01 0 -2.0246 -0.93173E-01 0 -2.0381 -0.86111E-01 0 -2.0509 -0.78866E-01 0 -2.0635 -0.68153E-01 0 -2.0726 -0.57440E-01 0 -2.0817 -0.45432E-01 0 -2.0874 -0.32726E-01 0 -2.0913 -0.20024E-01 0 -2.0938 -0.73306E-02 0 -2.0920 --0.53627E-02 0 -2.0902 --0.16146E-01 0 -2.0836 --0.26593E-01 0 -2.0763 --0.35065E-01 0 -2.0671 --0.41124E-01 0 -2.0558 --0.46893E-01 0 -2.0443 --0.47168E-01 0 -2.0316 --0.47442E-01 0 -2.0188 --0.44007E-01 0 -2.0073 --0.38575E-01 0 -1.9965 --0.32277E-01 0 -1.9866 --0.23382E-01 0 -1.9796 --0.13462E-01 0 -1.9753 --0.31696E-02 0 -1.9730 -0.72093E-02 0 -1.9735 -0.16768E-01 0 -1.9769 -0.25329E-01 0 -1.9821 -0.31713E-01 0 -1.9897 -0.38098E-01 0 -1.9973 -0.40556E-01 0 -2.0064 -0.42322E-01 0 -2.0159 -0.42131E-01 0 -2.0249 -0.39547E-01 0 -2.0333 -0.36817E-01 0 -2.0416 -0.31304E-01 0 -2.0470 -0.25791E-01 0 -2.0523 -0.19625E-01 0 -2.0550 -0.13107E-01 0 -2.0563 -0.68480E-02 0 -2.0566 -0.13658E-02 0 -2.0538 --0.41164E-02 0 -2.0511 --0.71036E-02 0 -2.0458 --0.96504E-02 0 -2.0400 --0.10245E-01 0 -2.0338 --0.84551E-02 0 -2.0271 --0.64269E-02 0 -2.0204 -0.11959E-03 0 -2.0155 -0.66661E-02 0 -2.0105 -0.15652E-01 0 -2.0084 -0.25952E-01 0 -2.0078 -0.36596E-01 0 -2.0088 -0.48275E-01 0 -2.0147 -0.59603E-01 0 -2.0238 -0.70345E-01 0 -2.0351 -0.79675E-01 0 -2.0499 -0.86553E-01 0 -2.0685 -0.91089E-01 0 -2.0891 -0.91050E-01 0 -2.1116 -0.91010E-01 0 -2.1342 -0.83089E-01 0 -2.1586 -0.73777E-01 0 -2.1833 -0.59977E-01 0 -2.2069 -0.40693E-01 0 -2.2292 -0.20939E-01 0 -2.2512 --0.77494E-02 0 -2.2673 --0.36437E-01 0 -2.2833 --0.70172E-01 0 -2.2930 --0.10662 0 -2.2992 --0.14433 0 -2.3023 --0.18579 0 -2.2959 --0.22725 0 -2.2895 --0.26983 0 -2.2714 --0.31261 0 -2.2511 --0.35423 0 -2.2249 --0.39443 0 -2.1914 --0.43436 0 -2.1573 --0.46902 0 -2.1133 --0.50369 0 -2.0692 --0.53410 0 -2.0207 --0.56221 0 -1.9697 --0.58907 0 -1.9179 --0.61219 0 -1.8638 --0.63467 0 -1.8091 --0.65527 0 -1.7528 --0.67579 0 -1.6956 --0.69612 0 -1.6363 --0.71673 0 -1.5756 --0.73820 0 -1.5107 --0.75950 0 -1.4441 --0.78026 0 -1.3722 --0.79890 0 -1.2976 --0.81113 0 -1.2149 --0.81991 0 -1.1329 --0.81833 0 -1.0529 --0.81674 0 -0.97284 --0.80259 0 -0.89414 --0.78168 0 -0.81615 --0.76018 0 -0.73873 --0.72744 0 -0.67212 --0.69471 0 -0.60550 --0.66047 0 -0.54537 --0.62438 0 -0.49317 --0.58829 0 -0.44096 --0.55370 0 -0.39987 --0.51938 0 -0.36074 --0.48610 0 -0.32413 --0.45596 0 -0.29507 --0.42582 0 -0.26600 --0.39868 0 -0.24153 --0.37314 0 -0.21955 --0.34781 0 -0.19780 --0.32635 0 -0.18056 --0.30489 0 -0.16331 --0.28479 0 -0.14761 --0.26634 0 -0.13377 --0.24789 0 -0.11993 --0.23079 0 -0.10909 --0.21392 0 -0.98775E-01 --0.19757 0 -0.89258E-01 --0.18279 0 -0.82139E-01 --0.16800 0 -0.75020E-01 --0.15321 0 -0.67901E-01 --0.13943 0 -0.61697E-01 --0.12871 0 -0.58240E-01 --0.11799 0 -0.54784E-01 --0.10727 0 -0.51327E-01 --0.97526E-01 0 -0.48323E-01 --0.90715E-01 0 -0.46676E-01 --0.83903E-01 0 -0.45030E-01 --0.77092E-01 0 -0.43384E-01 --0.70842E-01 0 -0.41866E-01 --0.66275E-01 0 -0.40735E-01 --0.61709E-01 0 -0.39605E-01 --0.57142E-01 0 -0.38474E-01 --0.52915E-01 0 -0.37375E-01 --0.49707E-01 0 -0.36374E-01 --0.46499E-01 0 -0.35373E-01 --0.43291E-01 0 -0.34371E-01 --0.40305E-01 0 -0.33393E-01 --0.37984E-01 0 -0.32485E-01 --0.35662E-01 0 -0.31577E-01 --0.33341E-01 0 -0.30669E-01 --0.31170E-01 0 -0.29784E-01 --0.29451E-01 0 -0.28967E-01 --0.27732E-01 0 -0.28151E-01 --0.26014E-01 0 -0.27335E-01 --0.24401E-01 0 -0.26542E-01 --0.23105E-01 0 -0.25819E-01 --0.21810E-01 0 -0.25096E-01 --0.20514E-01 0 -0.24373E-01 --0.19294E-01 0 -0.23672E-01 --0.18302E-01 0 -0.23039E-01 --0.17310E-01 0 -0.22406E-01 --0.16317E-01 0 -0.21773E-01 --0.15379E-01 0 -0.20981E-01 --0.14601E-01 0 -0.19710E-01 --0.13823E-01 0 -0.18439E-01 --0.13045E-01 0 -0.17169E-01 --0.12308E-01 0 -0.16292E-01 --0.11696E-01 0 -0.16595E-01 --0.11084E-01 0 -0.16898E-01 --0.10472E-01 0 -0.17201E-01 --0.98913E-02 0 -0.17325E-01 --0.94059E-02 0 -0.16909E-01 --0.89205E-02 0 -0.16494E-01 --0.84351E-02 0 -0.16078E-01 --0.79722E-02 0 -0.15679E-01 --0.75771E-02 0 -0.15328E-01 --0.71819E-02 0 -0.14978E-01 --0.67868E-02 0 -0.14627E-01 --0.64085E-02 0 -0.14292E-01 --0.60807E-02 0 -0.14000E-01 --0.57529E-02 0 -0.13708E-01 --0.54252E-02 0 -0.13416E-01 --0.51099E-02 0 -0.13138E-01 --0.48323E-02 0 -0.12899E-01 --0.45546E-02 0 -0.12661E-01 --0.42770E-02 0 -0.12422E-01 --0.40086E-02 0 -0.12196E-01 --0.37678E-02 0 -0.12006E-01 --0.35270E-02 0 -0.11816E-01 --0.32863E-02 0 -0.11626E-01 --0.30521E-02 0 -0.11447E-01 --0.28379E-02 0 -0.11303E-01 --0.26237E-02 0 -0.11158E-01 --0.24095E-02 0 -0.11014E-01 --0.21999E-02 0 -0.10880E-01 --0.20040E-02 0 -0.10778E-01 --0.18080E-02 0 -0.10676E-01 --0.16121E-02 0 -0.10575E-01 --0.14191E-02 0 -0.10483E-01 --0.12347E-02 0 -0.10422E-01 --0.10502E-02 0 -0.10362E-01 --0.86578E-03 0 -0.10301E-01 --0.68276E-03 0 -0.96145E-02 --0.50396E-03 0 -0.70507E-02 --0.32517E-03 0 -0.44868E-02 --0.14638E-03 0 -0.19229E-02 -0.65371 0 -1.3855 -0.62005 0 -1.4336 -0.58521 0 -1.4809 -0.54985 0 -1.5280 -0.51457 0 -1.5691 -0.47938 0 -1.6047 -0.44481 0 -1.6370 -0.41148 0 -1.6625 -0.37875 0 -1.6867 -0.34947 0 -1.7036 -0.32018 0 -1.7205 -0.29656 0 -1.7311 -0.27312 0 -1.7416 -0.25483 0 -1.7489 -0.23794 0 -1.7554 -0.22472 0 -1.7610 -0.21391 0 -1.7660 -0.20514 0 -1.7714 -0.19912 0 -1.7771 -0.19388 0 -1.7833 -0.19099 0 -1.7909 -0.18819 0 -1.7988 -0.18662 0 -1.8090 -0.18506 0 -1.8192 -0.18299 0 -1.8315 -0.18086 0 -1.8440 -0.17718 0 -1.8574 -0.17284 0 -1.8711 -0.16688 0 -1.8847 -0.15943 0 -1.8980 -0.15097 0 -1.9106 -0.14051 0 -1.9216 -0.12977 0 -1.9320 -0.11755 0 -1.9391 -0.10532 0 -1.9462 -0.93586E-01 0 -1.9488 -0.81861E-01 0 -1.9513 -0.72611E-01 0 -1.9507 -0.64005E-01 0 -1.9492 -0.58573E-01 0 -1.9466 -0.55149E-01 0 -1.9431 -0.54437E-01 0 -1.9398 -0.57302E-01 0 -1.9366 -0.61177E-01 0 -1.9338 -0.68080E-01 0 -1.9318 -0.75774E-01 0 -1.9334 -0.83812E-01 0 -1.9372 -0.92087E-01 0 -1.9442 -0.99458E-01 0 -1.9540 -0.10565 0 -1.9659 -0.10920 0 -1.9807 -0.11276 0 -1.9956 -0.11136 0 -2.0119 -0.10909 0 -2.0284 -0.10422 0 -2.0441 -0.96200E-01 0 -2.0588 -0.87959E-01 0 -2.0734 -0.75587E-01 0 -2.0838 -0.63216E-01 0 -2.0942 -0.49289E-01 0 -2.1007 -0.34524E-01 0 -2.1052 -0.19735E-01 0 -2.1079 -0.48700E-02 0 -2.1056 --0.99947E-02 0 -2.1033 --0.22710E-01 0 -2.0954 --0.35047E-01 0 -2.0865 --0.45053E-01 0 -2.0754 --0.52211E-01 0 -2.0616 --0.59019E-01 0 -2.0477 --0.59159E-01 0 -2.0322 --0.59298E-01 0 -2.0167 --0.54876E-01 0 -2.0027 --0.47997E-01 0 -1.9895 --0.40056E-01 0 -1.9775 --0.28926E-01 0 -1.9690 --0.16565E-01 0 -1.9640 --0.37788E-02 0 -1.9613 -0.90546E-02 0 -1.9623 -0.20796E-01 0 -1.9667 -0.31239E-01 0 -1.9733 -0.38882E-01 0 -1.9829 -0.46524E-01 0 -1.9925 -0.49209E-01 0 -2.0038 -0.51020E-01 0 -2.0155 -0.50422E-01 0 -2.0265 -0.46880E-01 0 -2.0367 -0.43162E-01 0 -2.0466 -0.36116E-01 0 -2.0529 -0.29070E-01 0 -2.0592 -0.21258E-01 0 -2.0622 -0.13035E-01 0 -2.0635 -0.51186E-02 0 -2.0635 --0.18741E-02 0 -2.0599 --0.88667E-02 0 -2.0562 --0.12871E-01 0 -2.0493 --0.16347E-01 0 -2.0418 --0.17439E-01 0 -2.0336 --0.15618E-01 0 -2.0246 --0.13499E-01 0 -2.0158 --0.57158E-02 0 -2.0087 -0.20674E-02 0 -2.0016 -0.13026E-01 0 -1.9978 -0.25694E-01 0 -1.9959 -0.38861E-01 0 -1.9958 -0.53523E-01 0 -2.0015 -0.67958E-01 0 -2.0111 -0.81813E-01 0 -2.0235 -0.94160E-01 0 -2.0402 -0.10374 0 -2.0613 -0.11065 0 -2.0849 -0.11230 0 -2.1113 -0.11394 0 -2.1376 -0.10650 0 -2.1663 -0.97457E-01 0 -2.1954 -0.83271E-01 0 -2.2235 -0.62803E-01 0 -2.2503 -0.41798E-01 0 -2.2767 -0.10596E-01 0 -2.2967 --0.20607E-01 0 -2.3167 --0.57615E-01 0 -2.3296 --0.97749E-01 0 -2.3388 --0.13933 0 -2.3445 --0.18527 0 -2.3396 --0.23121 0 -2.3347 --0.27837 0 -2.3165 --0.32573 0 -2.2959 --0.37161 0 -2.2686 --0.41566 0 -2.2331 --0.45936 0 -2.1970 --0.49644 0 -2.1500 --0.53352 0 -2.1030 --0.56531 0 -2.0515 --0.59425 0 -1.9976 --0.62169 0 -1.9432 --0.64460 0 -1.8873 --0.66685 0 -1.8312 --0.68708 0 -1.7742 --0.70746 0 -1.7167 --0.72830 0 -1.6578 --0.75001 0 -1.5972 --0.77435 0 -1.5318 --0.79954 0 -1.4642 --0.82727 0 -1.3900 --0.85193 0 -1.3124 --0.86739 0 -1.2243 --0.87909 0 -1.1365 --0.87949 0 -1.0498 --0.87989 0 -0.96317 --0.86325 0 -0.87830 --0.83745 0 -0.79440 --0.81099 0 -0.71119 --0.77217 0 -0.64124 --0.73334 0 -0.57129 --0.69352 0 -0.50916 --0.65249 0 -0.45659 --0.61146 0 -0.40402 --0.57317 0 -0.36395 --0.53537 0 -0.32607 --0.49897 0 -0.29086 --0.46678 0 -0.26363 --0.43459 0 -0.23640 --0.40601 0 -0.21376 --0.37938 0 -0.19359 --0.35297 0 -0.17363 --0.33103 0 -0.15781 --0.30909 0 -0.14198 --0.28868 0 -0.12747 --0.27016 0 -0.11457 --0.25164 0 -0.10167 --0.23403 0 -0.91604E-01 --0.21657 0 -0.82041E-01 --0.19956 0 -0.73292E-01 --0.18387 0 -0.66981E-01 --0.16818 0 -0.60671E-01 --0.15248 0 -0.54360E-01 --0.13796 0 -0.49015E-01 --0.12695 0 -0.46565E-01 --0.11594 0 -0.44116E-01 --0.10492 0 -0.41666E-01 --0.95022E-01 0 -0.39618E-01 --0.88461E-01 0 -0.38772E-01 --0.81901E-01 0 -0.37926E-01 --0.75340E-01 0 -0.37081E-01 --0.69315E-01 0 -0.36281E-01 --0.64897E-01 0 -0.35618E-01 --0.60478E-01 0 -0.34955E-01 --0.56060E-01 0 -0.34292E-01 --0.51971E-01 0 -0.33614E-01 --0.48868E-01 0 -0.32889E-01 --0.45765E-01 0 -0.32165E-01 --0.42662E-01 0 -0.31440E-01 --0.39771E-01 0 -0.30716E-01 --0.37515E-01 0 -0.29992E-01 --0.35259E-01 0 -0.29267E-01 --0.33003E-01 0 -0.28543E-01 --0.30892E-01 0 -0.27828E-01 --0.29214E-01 0 -0.27137E-01 --0.27536E-01 0 -0.26447E-01 --0.25858E-01 0 -0.25757E-01 --0.24282E-01 0 -0.25081E-01 --0.23011E-01 0 -0.24446E-01 --0.21740E-01 0 -0.23812E-01 --0.20469E-01 0 -0.23178E-01 --0.19272E-01 0 -0.22560E-01 --0.18294E-01 0 -0.21992E-01 --0.17316E-01 0 -0.21423E-01 --0.16338E-01 0 -0.20854E-01 --0.15412E-01 0 -0.20125E-01 --0.14642E-01 0 -0.18914E-01 --0.13872E-01 0 -0.17703E-01 --0.13102E-01 0 -0.16492E-01 --0.12372E-01 0 -0.15665E-01 --0.11763E-01 0 -0.15990E-01 --0.11155E-01 0 -0.16314E-01 --0.10546E-01 0 -0.16638E-01 --0.99685E-02 0 -0.16784E-01 --0.94841E-02 0 -0.16395E-01 --0.89997E-02 0 -0.16006E-01 --0.85153E-02 0 -0.15616E-01 --0.80531E-02 0 -0.15241E-01 --0.76573E-02 0 -0.14911E-01 --0.72615E-02 0 -0.14580E-01 --0.68658E-02 0 -0.14249E-01 --0.64866E-02 0 -0.13932E-01 --0.61572E-02 0 -0.13654E-01 --0.58278E-02 0 -0.13377E-01 --0.54983E-02 0 -0.13100E-01 --0.51813E-02 0 -0.12835E-01 --0.49013E-02 0 -0.12608E-01 --0.46213E-02 0 -0.12380E-01 --0.43414E-02 0 -0.12152E-01 --0.40705E-02 0 -0.11936E-01 --0.38270E-02 0 -0.11754E-01 --0.35835E-02 0 -0.11572E-01 --0.33400E-02 0 -0.11390E-01 --0.31031E-02 0 -0.11219E-01 --0.28858E-02 0 -0.11080E-01 --0.26686E-02 0 -0.10941E-01 --0.24514E-02 0 -0.10802E-01 --0.22387E-02 0 -0.10673E-01 --0.20396E-02 0 -0.10575E-01 --0.18405E-02 0 -0.10477E-01 --0.16414E-02 0 -0.10379E-01 --0.14451E-02 0 -0.10291E-01 --0.12574E-02 0 -0.10232E-01 --0.10697E-02 0 -0.10174E-01 --0.88193E-03 0 -0.10115E-01 --0.69559E-03 0 -0.94419E-02 --0.51346E-03 0 -0.69240E-02 --0.33132E-03 0 -0.44062E-02 --0.14918E-03 0 -0.18884E-02 -0.69083 0 -1.4149 -0.65230 0 -1.4648 -0.61322 0 -1.5132 -0.57389 0 -1.5609 -0.53486 0 -1.6022 -0.49613 0 -1.6374 -0.45811 0 -1.6689 -0.42154 0 -1.6931 -0.38566 0 -1.7159 -0.35378 0 -1.7309 -0.32189 0 -1.7458 -0.29663 0 -1.7539 -0.27159 0 -1.7618 -0.25252 0 -1.7666 -0.23507 0 -1.7705 -0.22185 0 -1.7737 -0.21137 0 -1.7765 -0.20320 0 -1.7798 -0.19813 0 -1.7838 -0.19390 0 -1.7885 -0.19227 0 -1.7952 -0.19073 0 -1.8021 -0.19048 0 -1.8121 -0.19023 0 -1.8221 -0.18923 0 -1.8348 -0.18814 0 -1.8478 -0.18508 0 -1.8620 -0.18118 0 -1.8767 -0.17526 0 -1.8913 -0.16745 0 -1.9057 -0.15836 0 -1.9193 -0.14672 0 -1.9311 -0.13471 0 -1.9422 -0.12072 0 -1.9494 -0.10672 0 -1.9566 -0.93110E-01 0 -1.9585 -0.79506E-01 0 -1.9602 -0.68790E-01 0 -1.9582 -0.58824E-01 0 -1.9551 -0.52682E-01 0 -1.9506 -0.48958E-01 0 -1.9450 -0.48533E-01 0 -1.9398 -0.52458E-01 0 -1.9351 -0.57618E-01 0 -1.9304 -0.66479E-01 0 -1.9262 -0.76291E-01 0 -1.9267 -0.86512E-01 0 -1.9301 -0.97011E-01 0 -1.9374 -0.10641 0 -1.9481 -0.11437 0 -1.9612 -0.11914 0 -1.9780 -0.12391 0 -1.9948 -0.12275 0 -2.0133 -0.12054 0 -2.0321 -0.11528 0 -2.0500 -0.10629 0 -2.0668 -0.97051E-01 0 -2.0833 -0.83022E-01 0 -2.0950 -0.68992E-01 0 -2.1068 -0.53146E-01 0 -2.1141 -0.36322E-01 0 -2.1190 -0.19445E-01 0 -2.1220 -0.24093E-02 0 -2.1192 --0.14627E-01 0 -2.1164 --0.29274E-01 0 -2.1071 --0.43500E-01 0 -2.0967 --0.55041E-01 0 -2.0837 --0.63299E-01 0 -2.0674 --0.71144E-01 0 -2.0511 --0.71150E-01 0 -2.0328 --0.71155E-01 0 -2.0145 --0.65745E-01 0 -1.9980 --0.57420E-01 0 -1.9825 --0.47835E-01 0 -1.9684 --0.34469E-01 0 -1.9584 --0.19669E-01 0 -1.9526 --0.43881E-02 0 -1.9496 -0.10900E-01 0 -1.9510 -0.24823E-01 0 -1.9565 -0.37150E-01 0 -1.9645 -0.46050E-01 0 -1.9761 -0.54950E-01 0 -1.9876 -0.57862E-01 0 -2.0012 -0.59718E-01 0 -2.0151 -0.58713E-01 0 -2.0281 -0.54212E-01 0 -2.0400 -0.49508E-01 0 -2.0517 -0.40928E-01 0 -2.0589 -0.32348E-01 0 -2.0661 -0.22891E-01 0 -2.0694 -0.12962E-01 0 -2.0707 -0.33892E-02 0 -2.0705 --0.51139E-02 0 -2.0659 --0.13617E-01 0 -2.0612 --0.18638E-01 0 -2.0527 --0.23043E-01 0 -2.0435 --0.24633E-01 0 -2.0334 --0.22781E-01 0 -2.0222 --0.20571E-01 0 -2.0111 --0.11551E-01 0 -2.0019 --0.25313E-02 0 -1.9927 -0.10400E-01 0 -1.9873 -0.25437E-01 0 -1.9840 -0.41126E-01 0 -1.9829 -0.58772E-01 0 -1.9883 -0.76312E-01 0 -1.9985 -0.93282E-01 0 -2.0118 -0.10865 0 -2.0304 -0.12093 0 -2.0541 -0.13021 0 -2.0808 -0.13354 0 -2.1109 -0.13688 0 -2.1410 -0.12992 0 -2.1740 -0.12114 0 -2.2076 -0.10656 0 -2.2401 -0.84913E-01 0 -2.2713 -0.62658E-01 0 -2.3022 -0.28941E-01 0 -2.3261 --0.47764E-02 0 -2.3500 --0.45058E-01 0 -2.3663 --0.88874E-01 0 -2.3784 --0.13434 0 -2.3867 --0.18476 0 -2.3833 --0.23518 0 -2.3799 --0.28690 0 -2.3616 --0.33886 0 -2.3407 --0.38898 0 -2.3123 --0.43688 0 -2.2748 --0.48435 0 -2.2367 --0.52385 0 -2.1868 --0.56335 0 -2.1368 --0.59652 0 -2.0824 --0.62629 0 -2.0256 --0.65430 0 -1.9686 --0.67702 0 -1.9109 --0.69903 0 -1.8532 --0.71889 0 -1.7956 --0.73913 0 -1.7378 --0.76048 0 -1.6793 --0.78329 0 -1.6188 --0.81051 0 -1.5528 --0.83959 0 -1.4842 --0.87427 0 -1.4079 --0.90496 0 -1.3272 --0.92366 0 -1.2336 --0.93827 0 -1.1401 --0.94065 0 -1.0468 --0.94303 0 -0.95351 --0.92391 0 -0.86247 --0.89321 0 -0.77264 --0.86180 0 -0.68364 --0.81689 0 -0.61036 --0.77197 0 -0.53707 --0.72658 0 -0.47295 --0.68061 0 -0.42002 --0.63463 0 -0.36708 --0.59265 0 -0.32802 --0.55136 0 -0.29140 --0.51184 0 -0.25759 --0.47761 0 -0.23220 --0.44337 0 -0.20681 --0.41335 0 -0.18599 --0.38561 0 -0.16763 --0.35814 0 -0.14947 --0.33571 0 -0.13506 --0.31328 0 -0.12065 --0.29258 0 -0.10733 --0.27398 0 -0.95367E-01 --0.25539 0 -0.83401E-01 --0.23727 0 -0.74118E-01 --0.21923 0 -0.65308E-01 --0.20155 0 -0.57325E-01 --0.18495 0 -0.51823E-01 --0.16836 0 -0.46321E-01 --0.15176 0 -0.40820E-01 --0.13649 0 -0.36333E-01 --0.12518 0 -0.34891E-01 --0.11388 0 -0.33448E-01 --0.10257 0 -0.32006E-01 --0.92518E-01 0 -0.30913E-01 --0.86208E-01 0 -0.30868E-01 --0.79898E-01 0 -0.30823E-01 --0.73588E-01 0 -0.30778E-01 --0.67788E-01 0 -0.30695E-01 --0.63518E-01 0 -0.30500E-01 --0.59248E-01 0 -0.30305E-01 --0.54978E-01 0 -0.30110E-01 --0.51026E-01 0 -0.29852E-01 --0.48029E-01 0 -0.29404E-01 --0.45031E-01 0 -0.28957E-01 --0.42033E-01 0 -0.28509E-01 --0.39237E-01 0 -0.28038E-01 --0.37047E-01 0 -0.27498E-01 --0.34856E-01 0 -0.26958E-01 --0.32666E-01 0 -0.26418E-01 --0.30614E-01 0 -0.25872E-01 --0.28977E-01 0 -0.25307E-01 --0.27340E-01 0 -0.24743E-01 --0.25703E-01 0 -0.24178E-01 --0.24163E-01 0 -0.23619E-01 --0.22917E-01 0 -0.23074E-01 --0.21671E-01 0 -0.22529E-01 --0.20425E-01 0 -0.21984E-01 --0.19249E-01 0 -0.21449E-01 --0.18286E-01 0 -0.20944E-01 --0.17322E-01 0 -0.20440E-01 --0.16359E-01 0 -0.19935E-01 --0.15446E-01 0 -0.19269E-01 --0.14683E-01 0 -0.18118E-01 --0.13921E-01 0 -0.16967E-01 --0.13158E-01 0 -0.15816E-01 --0.12435E-01 0 -0.15039E-01 --0.11830E-01 0 -0.15385E-01 --0.11225E-01 0 -0.15730E-01 --0.10620E-01 0 -0.16075E-01 --0.10046E-01 0 -0.16244E-01 --0.95623E-02 0 -0.15881E-01 --0.90789E-02 0 -0.15517E-01 --0.85956E-02 0 -0.15154E-01 --0.81340E-02 0 -0.14804E-01 --0.77376E-02 0 -0.14493E-01 --0.73412E-02 0 -0.14182E-01 --0.69448E-02 0 -0.13871E-01 --0.65647E-02 0 -0.13572E-01 --0.62337E-02 0 -0.13309E-01 --0.59026E-02 0 -0.13047E-01 --0.55715E-02 0 -0.12784E-01 --0.52526E-02 0 -0.12533E-01 --0.49703E-02 0 -0.12316E-01 --0.46880E-02 0 -0.12099E-01 --0.44058E-02 0 -0.11882E-01 --0.41325E-02 0 -0.11676E-01 --0.38862E-02 0 -0.11502E-01 --0.36400E-02 0 -0.11328E-01 --0.33937E-02 0 -0.11154E-01 --0.31540E-02 0 -0.10990E-01 --0.29337E-02 0 -0.10857E-01 --0.27135E-02 0 -0.10724E-01 --0.24933E-02 0 -0.10590E-01 --0.22775E-02 0 -0.10467E-01 --0.20752E-02 0 -0.10372E-01 --0.18729E-02 0 -0.10278E-01 --0.16706E-02 0 -0.10184E-01 --0.14712E-02 0 -0.10099E-01 --0.12801E-02 0 -0.10042E-01 --0.10891E-02 0 -0.99859E-02 --0.89807E-03 0 -0.99295E-02 --0.70843E-03 0 -0.92692E-02 --0.52295E-03 0 -0.67974E-02 --0.33747E-03 0 -0.43256E-02 --0.15199E-03 0 -0.18538E-02 -0.72778 0 -1.4611 -0.68390 0 -1.5109 -0.64074 0 -1.5589 -0.59790 0 -1.6060 -0.55489 0 -1.6465 -0.51174 0 -1.6809 -0.46912 0 -1.7112 -0.42760 0 -1.7336 -0.38691 0 -1.7543 -0.35099 0 -1.7660 -0.31506 0 -1.7776 -0.28782 0 -1.7817 -0.26086 0 -1.7855 -0.24152 0 -1.7861 -0.22424 0 -1.7859 -0.21182 0 -1.7855 -0.20256 0 -1.7849 -0.19587 0 -1.7852 -0.19264 0 -1.7868 -0.19038 0 -1.7894 -0.19117 0 -1.7949 -0.19204 0 -1.8006 -0.19424 0 -1.8106 -0.19644 0 -1.8206 -0.19761 0 -1.8343 -0.19864 0 -1.8485 -0.19712 0 -1.8645 -0.19450 0 -1.8814 -0.18899 0 -1.8982 -0.18079 0 -1.9151 -0.17073 0 -1.9310 -0.15702 0 -1.9448 -0.14276 0 -1.9577 -0.12557 0 -1.9657 -0.10838 0 -1.9737 -0.90960E-01 0 -1.9746 -0.73534E-01 0 -1.9753 -0.59456E-01 0 -1.9707 -0.46248E-01 0 -1.9647 -0.38279E-01 0 -1.9565 -0.33624E-01 0 -1.9470 -0.33672E-01 0 -1.9381 -0.39922E-01 0 -1.9301 -0.47813E-01 0 -1.9219 -0.60624E-01 0 -1.9131 -0.74633E-01 0 -1.9116 -0.89149E-01 0 -1.9142 -0.10399 0 -1.9221 -0.11728 0 -1.9347 -0.12861 0 -1.9504 -0.13557 0 -1.9710 -0.14253 0 -1.9915 -0.14157 0 -2.0141 -0.13920 0 -2.0370 -0.13305 0 -2.0586 -0.12226 0 -2.0785 -0.11118 0 -2.0981 -0.94563E-01 0 -2.1118 -0.77950E-01 0 -2.1256 -0.59194E-01 0 -2.1341 -0.39283E-01 0 -2.1400 -0.19232E-01 0 -2.1435 --0.12391E-02 0 -2.1402 --0.21710E-01 0 -2.1370 --0.39680E-01 0 -2.1258 --0.57207E-01 0 -2.1132 --0.71560E-01 0 -2.0972 --0.82032E-01 0 -2.0770 --0.91979E-01 0 -2.0567 --0.91955E-01 0 -2.0334 --0.91931E-01 0 -2.0101 --0.84790E-01 0 -1.9891 --0.73816E-01 0 -1.9693 --0.61196E-01 0 -1.9513 --0.43641E-01 0 -1.9388 --0.24285E-01 0 -1.9318 --0.43616E-02 0 -1.9285 -0.15465E-01 0 -1.9308 -0.33371E-01 0 -1.9385 -0.49063E-01 0 -1.9494 -0.60033E-01 0 -1.9650 -0.71003E-01 0 -1.9805 -0.73901E-01 0 -1.9981 -0.75374E-01 0 -2.0161 -0.73238E-01 0 -2.0326 -0.66690E-01 0 -2.0473 -0.59906E-01 0 -2.0618 -0.48633E-01 0 -2.0703 -0.37361E-01 0 -2.0789 -0.25102E-01 0 -2.0827 -0.12313E-01 0 -2.0840 --0.70265E-04 0 -2.0834 --0.11233E-01 0 -2.0773 --0.22396E-01 0 -2.0713 --0.29444E-01 0 -2.0602 --0.35766E-01 0 -2.0481 --0.38621E-01 0 -2.0348 --0.37239E-01 0 -2.0197 --0.35391E-01 0 -2.0047 --0.24712E-01 0 -1.9914 --0.14033E-01 0 -1.9781 -0.19685E-02 0 -1.9694 -0.20837E-01 0 -1.9632 -0.40653E-01 0 -1.9597 -0.63313E-01 0 -1.9641 -0.86118E-01 0 -1.9745 -0.10839 0 -1.9890 -0.12894 0 -2.0100 -0.14590 0 -2.0375 -0.15929 0 -2.0687 -0.16554 0 -2.1045 -0.17179 0 -2.1404 -0.16568 0 -2.1799 -0.15739 0 -2.2201 -0.14238 0 -2.2590 -0.11916 0 -2.2965 -0.95254E-01 0 -2.3335 -0.58307E-01 0 -2.3631 -0.21359E-01 0 -2.3927 --0.23351E-01 0 -2.4139 --0.72241E-01 0 -2.4307 --0.12318 0 -2.4429 --0.18025 0 -2.4419 --0.23732 0 -2.4408 --0.29606 0 -2.4223 --0.35508 0 -2.4006 --0.41172 0 -2.3701 --0.46543 0 -2.3288 --0.51859 0 -2.2868 --0.56109 0 -2.2313 --0.60358 0 -2.1757 --0.63762 0 -2.1159 --0.66711 0 -2.0538 --0.69430 0 -1.9920 --0.71456 0 -1.9314 --0.73393 0 -1.8716 --0.75060 0 -1.8139 --0.76777 0 -1.7569 --0.78647 0 -1.7018 --0.80728 0 -1.6458 --0.83443 0 -1.5873 --0.86539 0 -1.5238 --0.90774 0 -1.4456 --0.95365 0 -1.3609 --1.0102 0 -1.2568 --1.0512 0 -1.1523 --1.0455 0 -1.0467 --1.0397 0 -0.94108 --1.0092 0 -0.83780 --0.96538 0 -0.73578 --0.92102 0 -0.63507 --0.86664 0 -0.55930 --0.81226 0 -0.48352 --0.75829 0 -0.41883 --0.70481 0 -0.36769 --0.65133 0 -0.31655 --0.60518 0 -0.28053 --0.56032 0 -0.24719 --0.51773 0 -0.21668 --0.48193 0 -0.19466 --0.44614 0 -0.17265 --0.41518 0 -0.15479 --0.38683 0 -0.13916 --0.35877 0 -0.12370 --0.33629 0 -0.11139 --0.31380 0 -0.99083E-01 --0.29335 0 -0.87266E-01 --0.27538 0 -0.76053E-01 --0.25741 0 -0.64840E-01 --0.24102 0 -0.55617E-01 --0.22490 0 -0.46746E-01 --0.20767 0 -0.38950E-01 --0.18707 0 -0.34378E-01 --0.16647 0 -0.29806E-01 --0.14587 0 -0.25234E-01 --0.12790 0 -0.21835E-01 --0.11782 0 -0.21955E-01 --0.10773 0 -0.22075E-01 --0.97646E-01 0 -0.22195E-01 --0.88595E-01 0 -0.22512E-01 --0.82650E-01 0 -0.23422E-01 --0.76704E-01 0 -0.24333E-01 --0.70759E-01 0 -0.25243E-01 --0.65299E-01 0 -0.25966E-01 --0.61295E-01 0 -0.26129E-01 --0.57291E-01 0 -0.26291E-01 --0.53287E-01 0 -0.26454E-01 --0.49572E-01 0 -0.26524E-01 --0.46723E-01 0 -0.26318E-01 --0.43874E-01 0 -0.26111E-01 --0.41026E-01 0 -0.25904E-01 --0.38365E-01 0 -0.25653E-01 --0.36268E-01 0 -0.25267E-01 --0.34170E-01 0 -0.24882E-01 --0.32073E-01 0 -0.24496E-01 --0.30106E-01 0 -0.24093E-01 --0.28526E-01 0 -0.23637E-01 --0.26947E-01 0 -0.23181E-01 --0.25367E-01 0 -0.22726E-01 --0.23880E-01 0 -0.22267E-01 --0.22670E-01 0 -0.21800E-01 --0.21460E-01 0 -0.21333E-01 --0.20249E-01 0 -0.20867E-01 --0.19106E-01 0 -0.20405E-01 --0.18165E-01 0 -0.19957E-01 --0.17224E-01 0 -0.19510E-01 --0.16283E-01 0 -0.19063E-01 --0.15390E-01 0 -0.18454E-01 --0.14641E-01 0 -0.17359E-01 --0.13892E-01 0 -0.16264E-01 --0.13143E-01 0 -0.15169E-01 --0.12432E-01 0 -0.14438E-01 --0.11834E-01 0 -0.14801E-01 --0.11237E-01 0 -0.15164E-01 --0.10640E-01 0 -0.15527E-01 --0.10072E-01 0 -0.15715E-01 --0.95929E-02 0 -0.15376E-01 --0.91137E-02 0 -0.15037E-01 --0.86345E-02 0 -0.14698E-01 --0.81764E-02 0 -0.14371E-01 --0.77818E-02 0 -0.14079E-01 --0.73871E-02 0 -0.13786E-01 --0.69925E-02 0 -0.13493E-01 --0.66138E-02 0 -0.13211E-01 --0.62829E-02 0 -0.12963E-01 --0.59520E-02 0 -0.12714E-01 --0.56211E-02 0 -0.12465E-01 --0.53021E-02 0 -0.12227E-01 --0.50189E-02 0 -0.12021E-01 --0.47358E-02 0 -0.11814E-01 --0.44526E-02 0 -0.11608E-01 --0.41782E-02 0 -0.11411E-01 --0.39304E-02 0 -0.11245E-01 --0.36825E-02 0 -0.11078E-01 --0.34347E-02 0 -0.10912E-01 --0.31932E-02 0 -0.10755E-01 --0.29709E-02 0 -0.10627E-01 --0.27485E-02 0 -0.10499E-01 --0.25262E-02 0 -0.10371E-01 --0.23083E-02 0 -0.10253E-01 --0.21036E-02 0 -0.10162E-01 --0.18989E-02 0 -0.10071E-01 --0.16941E-02 0 -0.99803E-02 --0.14922E-02 0 -0.98987E-02 --0.12985E-02 0 -0.98443E-02 --0.11049E-02 0 -0.97899E-02 --0.91121E-03 0 -0.97355E-02 --0.71892E-03 0 -0.90888E-02 --0.53071E-03 0 -0.66651E-02 --0.34250E-03 0 -0.42414E-02 --0.15429E-03 0 -0.18178E-02 -0.76472 0 -1.5073 -0.71551 0 -1.5571 -0.66827 0 -1.6046 -0.62191 0 -1.6510 -0.57493 0 -1.6909 -0.52735 0 -1.7244 -0.48013 0 -1.7535 -0.43366 0 -1.7740 -0.38816 0 -1.7927 -0.34820 0 -1.8011 -0.30824 0 -1.8095 -0.27901 0 -1.8094 -0.25013 0 -1.8091 -0.23051 0 -1.8057 -0.21340 0 -1.8014 -0.20179 0 -1.7972 -0.19375 0 -1.7932 -0.18854 0 -1.7906 -0.18714 0 -1.7899 -0.18687 0 -1.7904 -0.19007 0 -1.7946 -0.19336 0 -1.7992 -0.19800 0 -1.8091 -0.20265 0 -1.8191 -0.20598 0 -1.8338 -0.20913 0 -1.8492 -0.20915 0 -1.8671 -0.20782 0 -1.8860 -0.20272 0 -1.9051 -0.19412 0 -1.9245 -0.18310 0 -1.9426 -0.16731 0 -1.9585 -0.15081 0 -1.9733 -0.13042 0 -1.9821 -0.11004 0 -1.9908 -0.88810E-01 0 -1.9907 -0.67562E-01 0 -1.9903 -0.50122E-01 0 -1.9831 -0.33672E-01 0 -1.9743 -0.23876E-01 0 -1.9625 -0.18289E-01 0 -1.9490 -0.18810E-01 0 -1.9364 -0.27386E-01 0 -1.9251 -0.38008E-01 0 -1.9133 -0.54768E-01 0 -1.9000 -0.72976E-01 0 -1.8965 -0.91787E-01 0 -1.8984 -0.11096 0 -1.9068 -0.12816 0 -1.9212 -0.14285 0 -1.9396 -0.15200 0 -1.9639 -0.16115 0 -1.9882 -0.16039 0 -2.0149 -0.15787 0 -2.0419 -0.15082 0 -2.0671 -0.13823 0 -2.0902 -0.12530 0 -2.1129 -0.10610 0 -2.1286 -0.86909E-01 0 -2.1444 -0.65242E-01 0 -2.1542 -0.42244E-01 0 -2.1609 -0.19019E-01 0 -2.1650 --0.48876E-02 0 -2.1613 --0.28794E-01 0 -2.1576 --0.50085E-01 0 -2.1445 --0.70914E-01 0 -2.1298 --0.88079E-01 0 -2.1108 --0.10076 0 -2.0866 --0.11281 0 -2.0623 --0.11276 0 -2.0340 --0.11271 0 -2.0057 --0.10383 0 -1.9802 --0.90211E-01 0 -1.9561 --0.74558E-01 0 -1.9343 --0.52813E-01 0 -1.9193 --0.28902E-01 0 -1.9110 --0.43350E-02 0 -1.9073 -0.20031E-01 0 -1.9107 -0.41919E-01 0 -1.9205 -0.60976E-01 0 -1.9344 -0.74015E-01 0 -1.9539 -0.87055E-01 0 -1.9733 -0.89939E-01 0 -1.9950 -0.91031E-01 0 -2.0171 -0.87764E-01 0 -2.0371 -0.79168E-01 0 -2.0547 -0.70304E-01 0 -2.0719 -0.56339E-01 0 -2.0818 -0.42373E-01 0 -2.0917 -0.27313E-01 0 -2.0960 -0.11663E-01 0 -2.0972 --0.35297E-02 0 -2.0963 --0.17352E-01 0 -2.0888 --0.31175E-01 0 -2.0814 --0.40251E-01 0 -2.0677 --0.48489E-01 0 -2.0528 --0.52609E-01 0 -2.0361 --0.51696E-01 0 -2.0172 --0.50211E-01 0 -1.9983 --0.37873E-01 0 -1.9809 --0.25535E-01 0 -1.9635 --0.64628E-02 0 -1.9515 -0.16236E-01 0 -1.9424 -0.40179E-01 0 -1.9364 -0.67854E-01 0 -1.9399 -0.95924E-01 0 -1.9505 -0.12351 0 -1.9662 -0.14923 0 -1.9896 -0.17087 0 -2.0208 -0.18836 0 -2.0566 -0.19753 0 -2.0982 -0.20670 0 -2.1398 -0.20144 0 -2.1858 -0.19364 0 -2.2325 -0.17819 0 -2.2779 -0.15341 0 -2.3216 -0.12785 0 -2.3649 -0.87673E-01 0 -2.4002 -0.47495E-01 0 -2.4354 --0.16442E-02 0 -2.4616 --0.55608E-01 0 -2.4829 --0.11201 0 -2.4992 --0.17574 0 -2.5005 --0.23947 0 -2.5018 --0.30521 0 -2.4829 --0.37131 0 -2.4605 --0.43445 0 -2.4279 --0.49399 0 -2.3828 --0.55282 0 -2.3370 --0.59832 0 -2.2758 --0.64382 0 -2.2146 --0.67873 0 -2.1494 --0.70793 0 -2.0820 --0.73429 0 -2.0155 --0.75211 0 -1.9520 --0.76884 0 -1.8899 --0.78231 0 -1.8322 --0.79642 0 -1.7760 --0.81246 0 -1.7243 --0.83126 0 -1.6728 --0.85836 0 -1.6218 --0.89119 0 -1.5635 --0.94122 0 -1.4834 --1.0023 0 -1.3947 --1.0968 0 -1.2800 --1.1641 0 -1.1645 --1.1503 0 -1.0466 --1.1364 0 -0.92865 --1.0945 0 -0.81314 --1.0375 0 -0.69892 --0.98024 0 -0.58651 --0.91639 0 -0.50824 --0.85255 0 -0.42996 --0.78999 0 -0.36471 --0.72902 0 -0.31536 --0.66804 0 -0.26601 --0.61772 0 -0.23304 --0.56928 0 -0.20297 --0.52361 0 -0.17576 --0.48626 0 -0.15713 --0.44892 0 -0.13850 --0.41701 0 -0.12359 --0.38805 0 -0.11070 --0.35940 0 -0.97934E-01 --0.33686 0 -0.87727E-01 --0.31432 0 -0.77521E-01 --0.29412 0 -0.67200E-01 --0.27678 0 -0.56739E-01 --0.25944 0 -0.46278E-01 --0.24477 0 -0.37117E-01 --0.23058 0 -0.28184E-01 --0.21379 0 -0.20575E-01 --0.18919 0 -0.16932E-01 --0.16459 0 -0.13290E-01 --0.13999 0 -0.96476E-02 --0.11932 0 -0.73364E-02 --0.11045 0 -0.90188E-02 --0.10158 0 -0.10701E-01 --0.92718E-01 0 -0.12384E-01 --0.84673E-01 0 -0.14112E-01 --0.79091E-01 0 -0.15977E-01 --0.73510E-01 0 -0.17843E-01 --0.67929E-01 0 -0.19708E-01 --0.62809E-01 0 -0.21237E-01 --0.59071E-01 0 -0.21758E-01 --0.55334E-01 0 -0.22278E-01 --0.51596E-01 0 -0.22798E-01 --0.48118E-01 0 -0.23197E-01 --0.45418E-01 0 -0.23231E-01 --0.42718E-01 0 -0.23265E-01 --0.40018E-01 0 -0.23300E-01 --0.37492E-01 0 -0.23268E-01 --0.35488E-01 0 -0.23036E-01 --0.33485E-01 0 -0.22805E-01 --0.31481E-01 0 -0.22574E-01 --0.29597E-01 0 -0.22314E-01 --0.28075E-01 0 -0.21967E-01 --0.26554E-01 0 -0.21620E-01 --0.25032E-01 0 -0.21273E-01 --0.23597E-01 0 -0.20916E-01 --0.22422E-01 0 -0.20527E-01 --0.21248E-01 0 -0.20138E-01 --0.20074E-01 0 -0.19749E-01 --0.18964E-01 0 -0.19360E-01 --0.18045E-01 0 -0.18971E-01 --0.17126E-01 0 -0.18581E-01 --0.16207E-01 0 -0.18191E-01 --0.15333E-01 0 -0.17639E-01 --0.14598E-01 0 -0.16600E-01 --0.13863E-01 0 -0.15561E-01 --0.13127E-01 0 -0.14522E-01 --0.12428E-01 0 -0.13838E-01 --0.11839E-01 0 -0.14218E-01 --0.11249E-01 0 -0.14598E-01 --0.10660E-01 0 -0.14979E-01 --0.10099E-01 0 -0.15185E-01 --0.96236E-02 0 -0.14871E-01 --0.91485E-02 0 -0.14557E-01 --0.86734E-02 0 -0.14243E-01 --0.82188E-02 0 -0.13938E-01 --0.78260E-02 0 -0.13664E-01 --0.74331E-02 0 -0.13390E-01 --0.70402E-02 0 -0.13115E-01 --0.66629E-02 0 -0.12851E-01 --0.63321E-02 0 -0.12616E-01 --0.60014E-02 0 -0.12382E-01 --0.56707E-02 0 -0.12147E-01 --0.53516E-02 0 -0.11922E-01 --0.50675E-02 0 -0.11726E-01 --0.47835E-02 0 -0.11529E-01 --0.44994E-02 0 -0.11333E-01 --0.42240E-02 0 -0.11146E-01 --0.39746E-02 0 -0.10987E-01 --0.37251E-02 0 -0.10829E-01 --0.34756E-02 0 -0.10670E-01 --0.32324E-02 0 -0.10520E-01 --0.30080E-02 0 -0.10397E-01 --0.27836E-02 0 -0.10275E-01 --0.25592E-02 0 -0.10152E-01 --0.23391E-02 0 -0.10039E-01 --0.21319E-02 0 -0.99514E-02 --0.19248E-02 0 -0.98642E-02 --0.17176E-02 0 -0.97770E-02 --0.15132E-02 0 -0.96986E-02 --0.13169E-02 0 -0.96462E-02 --0.11206E-02 0 -0.95939E-02 --0.92435E-03 0 -0.95416E-02 --0.72940E-03 0 -0.89084E-02 --0.53847E-03 0 -0.65328E-02 --0.34753E-03 0 -0.41573E-02 --0.15660E-03 0 -0.17817E-02 -0.79799 0 -1.5581 -0.74469 0 -1.6062 -0.69419 0 -1.6528 -0.64493 0 -1.6987 -0.59426 0 -1.7381 -0.54225 0 -1.7713 -0.49035 0 -1.7997 -0.43868 0 -1.8183 -0.38814 0 -1.8349 -0.34392 0 -1.8393 -0.29971 0 -1.8438 -0.26855 0 -1.8387 -0.23780 0 -1.8334 -0.21817 0 -1.8251 -0.20155 0 -1.8161 -0.19094 0 -1.8079 -0.18424 0 -1.8003 -0.18058 0 -1.7945 -0.18103 0 -1.7912 -0.18279 0 -1.7894 -0.18857 0 -1.7923 -0.19444 0 -1.7956 -0.20162 0 -1.8056 -0.20880 0 -1.8155 -0.21440 0 -1.8315 -0.21979 0 -1.8482 -0.22155 0 -1.8683 -0.22174 0 -1.8899 -0.21716 0 -1.9119 -0.20816 0 -1.9344 -0.19613 0 -1.9556 -0.17813 0 -1.9741 -0.15925 0 -1.9912 -0.13558 0 -2.0012 -0.11190 0 -2.0111 -0.86589E-01 0 -2.0100 -0.61237E-01 0 -2.0086 -0.40043E-01 0 -1.9985 -0.19929E-01 0 -1.9861 -0.80351E-02 0 -1.9698 -0.13405E-02 0 -1.9511 -0.21528E-02 0 -1.9337 -0.12865E-01 0 -1.9183 -0.26142E-01 0 -1.9020 -0.47113E-01 0 -1.8832 -0.70358E-01 0 -1.8772 -0.94496E-01 0 -1.8782 -0.11903 0 -1.8874 -0.14108 0 -1.9041 -0.15995 0 -1.9259 -0.17174 0 -1.9549 -0.18354 0 -1.9840 -0.18273 0 -2.0156 -0.17971 0 -2.0477 -0.17132 0 -2.0773 -0.15638 0 -2.1037 -0.14108 0 -2.1298 -0.11906 0 -2.1476 -0.97036E-01 0 -2.1654 -0.72195E-01 0 -2.1767 -0.45837E-01 0 -2.1845 -0.19123E-01 0 -2.1893 --0.86586E-02 0 -2.1853 --0.36441E-01 0 -2.1813 --0.61665E-01 0 -2.1663 --0.86437E-01 0 -2.1493 --0.10708 0 -2.1270 --0.12269 0 -2.0983 --0.13752 0 -2.0693 --0.13763 0 -2.0349 --0.13774 0 -2.0005 --0.12678 0 -1.9693 --0.10988 0 -1.9400 --0.90469E-01 0 -1.9135 --0.63558E-01 0 -1.8954 --0.34080E-01 0 -1.8857 --0.38568E-02 0 -1.8817 -0.26036E-01 0 -1.8863 -0.52799E-01 0 -1.8989 -0.75964E-01 0 -1.9165 -0.91465E-01 0 -1.9410 -0.10697 0 -1.9655 -0.10951 0 -1.9922 -0.10978 0 -2.0193 -0.10484 0 -2.0435 -0.93554E-01 0 -2.0642 -0.81977E-01 0 -2.0844 -0.64948E-01 0 -2.0957 -0.47918E-01 0 -2.1070 -0.29676E-01 0 -2.1117 -0.10781E-01 0 -2.1130 --0.76248E-02 0 -2.1117 --0.24560E-01 0 -2.1027 --0.41495E-01 0 -2.0937 --0.53062E-01 0 -2.0771 --0.63681E-01 0 -2.0591 --0.69497E-01 0 -2.0387 --0.69442E-01 0 -2.0152 --0.68688E-01 0 -1.9918 --0.54642E-01 0 -1.9693 --0.40597E-01 0 -1.9469 --0.18003E-01 0 -1.9307 -0.91926E-02 0 -1.9179 -0.37983E-01 0 -1.9089 -0.71559E-01 0 -1.9110 -0.10580 0 -1.9217 -0.13960 0 -1.9385 -0.17142 0 -1.9646 -0.19860 0 -2.0000 -0.22099 0 -2.0410 -0.23361 0 -2.0893 -0.24623 0 -2.1376 -0.24177 0 -2.1910 -0.23429 0 -2.2452 -0.21819 0 -2.2978 -0.19155 0 -2.3482 -0.16408 0 -2.3981 -0.12066 0 -2.4396 -0.77238E-01 0 -2.4810 -0.23404E-01 0 -2.5128 --0.36038E-01 0 -2.5395 --0.98449E-01 0 -2.5605 --0.16976 0 -2.5647 --0.24108 0 -2.5688 --0.31496 0 -2.5497 --0.38929 0 -2.5265 --0.46007 0 -2.4914 --0.52651 0 -2.4417 --0.59206 0 -2.3911 --0.64095 0 -2.3229 --0.68984 0 -2.2547 --0.72539 0 -2.1827 --0.75376 0 -2.1088 --0.77865 0 -2.0365 --0.79308 0 -1.9695 --0.80623 0 -1.9048 --0.81554 0 -1.8469 --0.82561 0 -1.7915 --0.83798 0 -1.7437 --0.85363 0 -1.6974 --0.87916 0 -1.6554 --0.91210 0 -1.6066 --0.96730 0 -1.5377 --1.0406 0 -1.4554 --1.1683 0 -1.3330 --1.2596 0 -1.2043 --1.2418 0 -1.0566 --1.2240 0 -0.90894 --1.1727 0 -0.77588 --1.1033 0 -0.65069 --1.0338 0 -0.52778 --0.96140 0 -0.44829 --0.88897 0 -0.36880 --0.81860 0 -0.30414 --0.75077 0 -0.25759 --0.68294 0 -0.21105 --0.62891 0 -0.18219 --0.57731 0 -0.15646 --0.52894 0 -0.13345 --0.49024 0 -0.11859 --0.45154 0 -0.10373 --0.41882 0 -0.92030E-01 --0.38932 0 -0.82030E-01 --0.36017 0 -0.72133E-01 --0.33758 0 -0.64185E-01 --0.31500 0 -0.56236E-01 --0.29503 0 -0.47751E-01 --0.27824 0 -0.38612E-01 --0.26146 0 -0.29472E-01 --0.24617 0 -0.19206E-01 --0.23114 0 -0.87410E-02 --0.21323 0 -0.24932E-03 --0.18670 0 0.23222E-02 --0.16017 0 0.48937E-02 --0.13364 0 0.74653E-02 --0.11176 0 0.84298E-02 --0.10379 0 0.45735E-02 --0.95830E-01 0 0.71723E-03 --0.87867E-01 0 -0.31391E-02 --0.80612E-01 0 -0.66857E-02 --0.75480E-01 0 -0.93036E-02 --0.70348E-01 0 -0.11921E-01 --0.65216E-01 0 -0.14539E-01 --0.60493E-01 0 -0.16720E-01 --0.56999E-01 0 -0.17588E-01 --0.53505E-01 0 -0.18457E-01 --0.50011E-01 0 -0.19325E-01 --0.46752E-01 0 -0.20040E-01 --0.44201E-01 0 -0.20294E-01 --0.41649E-01 0 -0.20549E-01 --0.39098E-01 0 -0.20803E-01 --0.36706E-01 0 -0.20972E-01 --0.34791E-01 0 -0.20887E-01 --0.32875E-01 0 -0.20802E-01 --0.30960E-01 0 -0.20717E-01 --0.29157E-01 0 -0.20592E-01 --0.27691E-01 0 -0.20348E-01 --0.26224E-01 0 -0.20105E-01 --0.24757E-01 0 -0.19861E-01 --0.23372E-01 0 -0.19600E-01 --0.22232E-01 0 -0.19286E-01 --0.21091E-01 0 -0.18972E-01 --0.19951E-01 0 -0.18658E-01 --0.18871E-01 0 -0.18339E-01 --0.17973E-01 0 -0.18004E-01 --0.17075E-01 0 -0.17670E-01 --0.16177E-01 0 -0.17335E-01 --0.15321E-01 0 -0.16838E-01 --0.14591E-01 0 -0.15854E-01 --0.13862E-01 0 -0.14869E-01 --0.13133E-01 0 -0.13885E-01 --0.12439E-01 0 -0.13246E-01 --0.11851E-01 0 -0.13643E-01 --0.11263E-01 0 -0.14040E-01 --0.10675E-01 0 -0.14436E-01 --0.10117E-01 0 -0.14661E-01 --0.96459E-02 0 -0.14371E-01 --0.91752E-02 0 -0.14081E-01 --0.87045E-02 0 -0.13790E-01 --0.82537E-02 0 -0.13508E-01 --0.78628E-02 0 -0.13252E-01 --0.74719E-02 0 -0.12996E-01 --0.70810E-02 0 -0.12739E-01 --0.67053E-02 0 -0.12492E-01 --0.63750E-02 0 -0.12271E-01 --0.60446E-02 0 -0.12050E-01 --0.57143E-02 0 -0.11829E-01 --0.53954E-02 0 -0.11616E-01 --0.51107E-02 0 -0.11430E-01 --0.48260E-02 0 -0.11244E-01 --0.45413E-02 0 -0.11058E-01 --0.42651E-02 0 -0.10881E-01 --0.40143E-02 0 -0.10730E-01 --0.37635E-02 0 -0.10578E-01 --0.35126E-02 0 -0.10427E-01 --0.32680E-02 0 -0.10284E-01 --0.30417E-02 0 -0.10167E-01 --0.28154E-02 0 -0.10049E-01 --0.25891E-02 0 -0.99321E-02 --0.23671E-02 0 -0.98232E-02 --0.21577E-02 0 -0.97396E-02 --0.19484E-02 0 -0.96559E-02 --0.17391E-02 0 -0.95723E-02 --0.15324E-02 0 -0.94970E-02 --0.13337E-02 0 -0.94467E-02 --0.11351E-02 0 -0.93963E-02 --0.93638E-03 0 -0.93460E-02 --0.73901E-03 0 -0.87265E-02 --0.54557E-03 0 -0.63995E-02 --0.35214E-03 0 -0.40724E-02 --0.15871E-03 0 -0.17453E-02 -0.82024 0 -1.6226 -0.76660 0 -1.6643 -0.71526 0 -1.7086 -0.66494 0 -1.7540 -0.61147 0 -1.7939 -0.55501 0 -1.8285 -0.49818 0 -1.8572 -0.44062 0 -1.8741 -0.38432 0 -1.8883 -0.33521 0 -1.8869 -0.28610 0 -1.8855 -0.25314 0 -1.8727 -0.22070 0 -1.8596 -0.20183 0 -1.8445 -0.18664 0 -1.8290 -0.17762 0 -1.8156 -0.17262 0 -1.8035 -0.17074 0 -1.7939 -0.17308 0 -1.7874 -0.17701 0 -1.7827 -0.18589 0 -1.7839 -0.19483 0 -1.7856 -0.20478 0 -1.7957 -0.21474 0 -1.8058 -0.22296 0 -1.8235 -0.23094 0 -1.8422 -0.23503 0 -1.8658 -0.23745 0 -1.8915 -0.23373 0 -1.9183 -0.22432 0 -1.9461 -0.21113 0 -1.9723 -0.19052 0 -1.9951 -0.16887 0 -2.0163 -0.14163 0 -2.0285 -0.11438 0 -2.0408 -0.84155E-01 0 -2.0391 -0.53853E-01 0 -2.0370 -0.27728E-01 0 -2.0225 -0.26868E-02 0 -2.0049 --0.12119E-01 0 -1.9812 --0.20449E-01 0 -1.9537 --0.19891E-01 0 -1.9283 --0.76093E-02 0 -1.9059 -0.80930E-02 0 -1.8822 -0.34058E-01 0 -1.8550 -0.64860E-01 0 -1.8454 -0.97418E-01 0 -1.8452 -0.13040 0 -1.8556 -0.16014 0 -1.8761 -0.18559 0 -1.9032 -0.20141 0 -1.9402 -0.21723 0 -1.9771 -0.21567 0 -2.0165 -0.21104 0 -2.0564 -0.19999 0 -2.0921 -0.18108 0 -2.1227 -0.16184 0 -2.1529 -0.13625 0 -2.1730 -0.11067 0 -2.1932 -0.81867E-01 0 -2.2064 -0.51330E-01 0 -2.2159 -0.20182E-01 0 -2.2220 --0.12798E-01 0 -2.2181 --0.45777E-01 0 -2.2142 --0.76768E-01 0 -2.1971 --0.10741 0 -2.1776 --0.13355 0 -2.1512 --0.15418 0 -2.1161 --0.17383 0 -2.0806 --0.17467 0 -2.0366 --0.17552 0 -1.9926 --0.16145 0 -1.9528 --0.13935 0 -1.9152 --0.11403 0 -1.8814 --0.79018E-01 0 -1.8588 --0.40943E-01 0 -1.8472 --0.20238E-02 0 -1.8428 -0.36358E-01 0 -1.8495 -0.70675E-01 0 -1.8665 -0.10018 0 -1.8901 -0.11932 0 -1.9228 -0.13845 0 -1.9556 -0.13970 0 -1.9902 -0.13780 0 -2.0252 -0.12959 0 -2.0554 -0.11366 0 -2.0799 -0.97476E-01 0 -2.1039 -0.76268E-01 0 -2.1166 -0.55060E-01 0 -2.1294 -0.32494E-01 0 -2.1347 -0.91975E-02 0 -2.1361 --0.13627E-01 0 -2.1345 --0.35032E-01 0 -2.1236 --0.56438E-01 0 -2.1127 --0.71884E-01 0 -2.0923 --0.86279E-01 0 -2.0703 --0.95084E-01 0 -2.0447 --0.97055E-01 0 -2.0147 --0.98133E-01 0 -1.9847 --0.82234E-01 0 -1.9543 --0.66335E-01 0 -1.9239 --0.38872E-01 0 -1.9011 --0.51824E-02 0 -1.8824 -0.30619E-01 0 -1.8683 -0.72754E-01 0 -1.8680 -0.11588 0 -1.8785 -0.15863 0 -1.8965 -0.19928 0 -1.9259 -0.23465 0 -1.9669 -0.26428 0 -2.0149 -0.28195 0 -2.0728 -0.29963 0 -2.1307 -0.29577 0 -2.1943 -0.28812 0 -2.2588 -0.27072 0 -2.3206 -0.24138 0 -2.3789 -0.21118 0 -2.4368 -0.16449 0 -2.4860 -0.11781 0 -2.5351 -0.58477E-01 0 -2.5747 --0.76580E-02 0 -2.6092 --0.77684E-01 0 -2.6372 --0.15938 0 -2.6458 --0.24108 0 -2.6543 --0.32649 0 -2.6350 --0.41256 0 -2.6108 --0.49435 0 -2.5719 --0.57092 0 -2.5152 --0.64633 0 -2.4573 --0.69978 0 -2.3777 --0.75323 0 -2.2981 --0.78875 0 -2.2156 --0.81461 0 -2.1314 --0.83607 0 -2.0502 --0.84431 0 -1.9779 --0.85106 0 -1.9090 --0.85335 0 -1.8507 --0.85647 0 -1.7963 --0.86209 0 -1.7536 --0.87115 0 -1.7145 --0.89058 0 -1.6863 --0.91837 0 -1.6605 --0.97124 0 -1.6416 --1.0476 0 -1.5970 --1.1946 0 -1.4754 --1.3025 0 -1.3268 --1.2933 0 -1.0971 --1.2842 0 -0.86740 --1.2293 0 -0.70085 --1.1499 0 -0.56832 --1.0705 0 -0.43858 --0.99216 0 -0.36170 --0.91377 0 -0.28483 --0.83792 0 -0.22423 --0.76517 0 -0.18353 --0.69242 0 -0.14283 --0.63605 0 -0.12125 --0.58256 0 -0.10305 --0.53259 0 -0.86928E-01 --0.49316 0 -0.77032E-01 --0.45373 0 -0.67135E-01 --0.42057 0 -0.59378E-01 --0.39079 0 -0.52773E-01 --0.36137 0 -0.46237E-01 --0.33876 0 -0.41010E-01 --0.31615 0 -0.35783E-01 --0.29632 0 -0.30158E-01 --0.27990 0 -0.24045E-01 --0.26348 0 -0.17932E-01 --0.24047 0 -0.30647E-02 --0.21631 0 0.13348E-01 --0.19262 0 0.25927E-01 --0.17039 0 0.27004E-01 --0.14817 0 0.28081E-01 --0.12594 0 0.29158E-01 --0.10726 0 0.28000E-01 --0.99258E-01 0 0.20135E-01 --0.91252E-01 0 0.12270E-01 --0.83247E-01 0 0.44054E-02 --0.76136E-01 0 -0.21837E-02 --0.71707E-01 0 -0.49452E-02 --0.67279E-01 0 -0.77068E-02 --0.62850E-01 0 -0.10468E-01 --0.58699E-01 0 -0.12837E-01 --0.55380E-01 0 -0.14024E-01 --0.52062E-01 0 -0.15212E-01 --0.48743E-01 0 -0.16400E-01 --0.45653E-01 0 -0.17393E-01 --0.43249E-01 0 -0.17806E-01 --0.40844E-01 0 -0.18218E-01 --0.38440E-01 0 -0.18630E-01 --0.36177E-01 0 -0.18948E-01 --0.34337E-01 0 -0.18984E-01 --0.32497E-01 0 -0.19019E-01 --0.30657E-01 0 -0.19055E-01 --0.28922E-01 0 -0.19043E-01 --0.27503E-01 0 -0.18885E-01 --0.26084E-01 0 -0.18728E-01 --0.24665E-01 0 -0.18571E-01 --0.23323E-01 0 -0.18390E-01 --0.22211E-01 0 -0.18141E-01 --0.21098E-01 0 -0.17892E-01 --0.19986E-01 0 -0.17642E-01 --0.18931E-01 0 -0.17384E-01 --0.18050E-01 0 -0.17098E-01 --0.17168E-01 0 -0.16813E-01 --0.16286E-01 0 -0.16527E-01 --0.15439E-01 0 -0.16079E-01 --0.14693E-01 0 -0.15146E-01 --0.13948E-01 0 -0.14213E-01 --0.13203E-01 0 -0.13280E-01 --0.12493E-01 0 -0.12682E-01 --0.11888E-01 0 -0.13092E-01 --0.11284E-01 0 -0.13502E-01 --0.10679E-01 0 -0.13912E-01 --0.10109E-01 0 -0.14153E-01 --0.96436E-02 0 -0.13884E-01 --0.91779E-02 0 -0.13616E-01 --0.87122E-02 0 -0.13348E-01 --0.82659E-02 0 -0.13087E-01 --0.78776E-02 0 -0.12847E-01 --0.74894E-02 0 -0.12608E-01 --0.71012E-02 0 -0.12368E-01 --0.67277E-02 0 -0.12137E-01 --0.63985E-02 0 -0.11929E-01 --0.60694E-02 0 -0.11720E-01 --0.57402E-02 0 -0.11512E-01 --0.54222E-02 0 -0.11312E-01 --0.51376E-02 0 -0.11135E-01 --0.48530E-02 0 -0.10959E-01 --0.45684E-02 0 -0.10783E-01 --0.42921E-02 0 -0.10614E-01 --0.40406E-02 0 -0.10470E-01 --0.37892E-02 0 -0.10326E-01 --0.35378E-02 0 -0.10181E-01 --0.32923E-02 0 -0.10045E-01 --0.30649E-02 0 -0.99328E-02 --0.28375E-02 0 -0.98206E-02 --0.26101E-02 0 -0.97083E-02 --0.23868E-02 0 -0.96041E-02 --0.21760E-02 0 -0.95238E-02 --0.19652E-02 0 -0.94435E-02 --0.17544E-02 0 -0.93632E-02 --0.15462E-02 0 -0.92909E-02 --0.13458E-02 0 -0.92425E-02 --0.11454E-02 0 -0.91941E-02 --0.94506E-03 0 -0.91457E-02 --0.74596E-03 0 -0.85401E-02 --0.55072E-03 0 -0.62627E-02 --0.35548E-03 0 -0.39854E-02 --0.16024E-03 0 -0.17080E-02 -0.84248 0 -1.6871 -0.78850 0 -1.7223 -0.73633 0 -1.7643 -0.68495 0 -1.8094 -0.62869 0 -1.8497 -0.56777 0 -1.8857 -0.50602 0 -1.9148 -0.44255 0 -1.9299 -0.38051 0 -1.9417 -0.32650 0 -1.9345 -0.27248 0 -1.9273 -0.23773 0 -1.9067 -0.20359 0 -1.8858 -0.18549 0 -1.8639 -0.17172 0 -1.8419 -0.16430 0 -1.8232 -0.16101 0 -1.8068 -0.16091 0 -1.7932 -0.16513 0 -1.7835 -0.17123 0 -1.7761 -0.18320 0 -1.7754 -0.19521 0 -1.7755 -0.20795 0 -1.7858 -0.22068 0 -1.7961 -0.23151 0 -1.8155 -0.24209 0 -1.8362 -0.24852 0 -1.8633 -0.25317 0 -1.8931 -0.25031 0 -1.9247 -0.24048 0 -1.9578 -0.22614 0 -1.9890 -0.20291 0 -2.0161 -0.17850 0 -2.0413 -0.14768 0 -2.0559 -0.11686 0 -2.0705 -0.81721E-01 0 -2.0681 -0.46470E-01 0 -2.0653 -0.15412E-01 0 -2.0466 --0.14556E-01 0 -2.0237 --0.32273E-01 0 -1.9926 --0.42239E-01 0 -1.9563 --0.41934E-01 0 -1.9229 --0.28084E-01 0 -1.8935 --0.99564E-02 0 -1.8625 -0.21003E-01 0 -1.8268 -0.59362E-01 0 -1.8135 -0.10034 0 -1.8121 -0.14178 0 -1.8239 -0.17920 0 -1.8481 -0.21123 0 -1.8806 -0.23108 0 -1.9254 -0.25093 0 -1.9702 -0.24861 0 -2.0174 -0.24238 0 -2.0650 -0.22865 0 -2.1069 -0.20578 0 -2.1417 -0.18259 0 -2.1759 -0.15345 0 -2.1984 -0.12430 0 -2.2209 -0.91539E-01 0 -2.2361 -0.56823E-01 0 -2.2472 -0.21241E-01 0 -2.2547 --0.16936E-01 0 -2.2509 --0.55114E-01 0 -2.2471 --0.91871E-01 0 -2.2279 --0.12838 0 -2.2060 --0.16001 0 -2.1753 --0.18568 0 -2.1339 --0.21014 0 -2.0919 --0.21172 0 -2.0383 --0.21330 0 -1.9848 --0.19612 0 -1.9362 --0.16883 0 -1.8903 --0.13759 0 -1.8492 --0.94479E-01 0 -1.8222 --0.47806E-01 0 -1.8086 --0.19073E-03 0 -1.8039 -0.46680E-01 0 -1.8127 -0.88551E-01 0 -1.8342 -0.12440 0 -1.8637 -0.14717 0 -1.9047 -0.16993 0 -1.9457 -0.16989 0 -1.9882 -0.16582 0 -2.0310 -0.15433 0 -2.0674 -0.13377 0 -2.0957 -0.11297 0 -2.1234 -0.87588E-01 0 -2.1376 -0.62202E-01 0 -2.1518 -0.35313E-01 0 -2.1578 -0.76144E-02 0 -2.1593 --0.19628E-01 0 -2.1573 --0.45505E-01 0 -2.1445 --0.71381E-01 0 -2.1318 --0.90707E-01 0 -2.1076 --0.10888 0 -2.0815 --0.12067 0 -2.0507 --0.12467 0 -2.0143 --0.12758 0 -1.9777 --0.10983 0 -1.9393 --0.92073E-01 0 -1.9009 --0.59741E-01 0 -1.8715 --0.19557E-01 0 -1.8468 -0.23254E-01 0 -1.8276 -0.73948E-01 0 -1.8250 -0.12596 0 -1.8353 -0.17766 0 -1.8545 -0.22714 0 -1.8872 -0.27069 0 -1.9337 -0.30756 0 -1.9889 -0.33029 0 -2.0563 -0.35302 0 -2.1237 -0.34978 0 -2.1975 -0.34196 0 -2.2724 -0.32325 0 -2.3434 -0.29122 0 -2.4097 -0.25829 0 -2.4755 -0.20833 0 -2.5324 -0.15837 0 -2.5893 -0.93550E-01 0 -2.6367 -0.20722E-01 0 -2.6790 --0.56920E-01 0 -2.7139 --0.14901 0 -2.7269 --0.24109 0 -2.7398 --0.33803 0 -2.7203 --0.43583 0 -2.6950 --0.52863 0 -2.6524 --0.61533 0 -2.5886 --0.70059 0 -2.5235 --0.75861 0 -2.4326 --0.81662 0 -2.3416 --0.85211 0 -2.2484 --0.87547 0 -2.1540 --0.89350 0 -2.0638 --0.89555 0 -1.9862 --0.89590 0 -1.9133 --0.89116 0 -1.8546 --0.88733 0 -1.8012 --0.88619 0 -1.7635 --0.88868 0 -1.7317 --0.90200 0 -1.7173 --0.92463 0 -1.7143 --0.97518 0 -1.7455 --1.0547 0 -1.7386 --1.2209 0 -1.6179 --1.3455 0 -1.4494 --1.3449 0 -1.1376 --1.3444 0 -0.82586 --1.2860 0 -0.62583 --1.1965 0 -0.48596 --1.1073 0 -0.34937 --1.0229 0 -0.27511 --0.93858 0 -0.20085 --0.85724 0 -0.14432 --0.77957 0 -0.10946 --0.70191 0 -0.74603E-01 --0.64319 0 -0.60308E-01 --0.58781 0 -0.49641E-01 --0.53624 0 -0.40407E-01 --0.49608 0 -0.35474E-01 --0.45592 0 -0.30540E-01 --0.42232 0 -0.26727E-01 --0.39226 0 -0.23516E-01 --0.36257 0 -0.20340E-01 --0.33993 0 -0.17836E-01 --0.31730 0 -0.15331E-01 --0.29762 0 -0.12564E-01 --0.28156 0 -0.94785E-02 --0.26550 0 -0.63926E-02 --0.23478 0 0.13077E-01 --0.20148 0 0.35437E-01 --0.17202 0 0.52103E-01 --0.15409 0 0.51686E-01 --0.13616 0 0.51269E-01 --0.11823 0 0.50851E-01 --0.10277 0 0.47570E-01 --0.94723E-01 0 0.35697E-01 --0.86675E-01 0 0.23823E-01 --0.78627E-01 0 0.11950E-01 --0.71660E-01 0 0.23184E-02 --0.67935E-01 0 -0.58690E-03 --0.64209E-01 0 -0.34922E-02 --0.60484E-01 0 -0.63976E-02 --0.56905E-01 0 -0.89533E-02 --0.53762E-01 0 -0.10460E-01 --0.50619E-01 0 -0.11967E-01 --0.47476E-01 0 -0.13474E-01 --0.44555E-01 0 -0.14747E-01 --0.42297E-01 0 -0.15317E-01 --0.40039E-01 0 -0.15887E-01 --0.37782E-01 0 -0.16457E-01 --0.35647E-01 0 -0.16923E-01 --0.33883E-01 0 -0.17080E-01 --0.32118E-01 0 -0.17237E-01 --0.30353E-01 0 -0.17394E-01 --0.28687E-01 0 -0.17493E-01 --0.27316E-01 0 -0.17422E-01 --0.25945E-01 0 -0.17351E-01 --0.24574E-01 0 -0.17280E-01 --0.23274E-01 0 -0.17181E-01 --0.22190E-01 0 -0.16996E-01 --0.21106E-01 0 -0.16812E-01 --0.20021E-01 0 -0.16627E-01 --0.18992E-01 0 -0.16429E-01 --0.18126E-01 0 -0.16193E-01 --0.17261E-01 0 -0.15956E-01 --0.16396E-01 0 -0.15719E-01 --0.15556E-01 0 -0.15321E-01 --0.14795E-01 0 -0.14439E-01 --0.14034E-01 0 -0.13557E-01 --0.13273E-01 0 -0.12674E-01 --0.12547E-01 0 -0.12119E-01 --0.11925E-01 0 -0.12542E-01 --0.11304E-01 0 -0.12965E-01 --0.10683E-01 0 -0.13388E-01 --0.10102E-01 0 -0.13644E-01 --0.96412E-02 0 -0.13398E-01 --0.91806E-02 0 -0.13151E-01 --0.87199E-02 0 -0.12905E-01 --0.82780E-02 0 -0.12665E-01 --0.78924E-02 0 -0.12442E-01 --0.75069E-02 0 -0.12220E-01 --0.71213E-02 0 -0.11997E-01 --0.67501E-02 0 -0.11782E-01 --0.64221E-02 0 -0.11586E-01 --0.60941E-02 0 -0.11391E-01 --0.57661E-02 0 -0.11195E-01 --0.54489E-02 0 -0.11007E-01 --0.51644E-02 0 -0.10840E-01 --0.48799E-02 0 -0.10674E-01 --0.45955E-02 0 -0.10507E-01 --0.43191E-02 0 -0.10347E-01 --0.40670E-02 0 -0.10210E-01 --0.38149E-02 0 -0.10073E-01 --0.35629E-02 0 -0.99359E-02 --0.33167E-02 0 -0.98062E-02 --0.30881E-02 0 -0.96990E-02 --0.28596E-02 0 -0.95918E-02 --0.26311E-02 0 -0.94846E-02 --0.24066E-02 0 -0.93849E-02 --0.21943E-02 0 -0.93080E-02 --0.19820E-02 0 -0.92311E-02 --0.17697E-02 0 -0.91541E-02 --0.15600E-02 0 -0.90848E-02 --0.13579E-02 0 -0.90383E-02 --0.11558E-02 0 -0.89919E-02 --0.95374E-03 0 -0.89454E-02 --0.75291E-03 0 -0.83536E-02 --0.55587E-03 0 -0.61260E-02 --0.35883E-03 0 -0.38984E-02 --0.16178E-03 0 -0.16707E-02 -0.86812 0 -1.7486 -0.82418 0 -1.7774 -0.77578 0 -1.8188 -0.72543 0 -1.8659 -0.66453 0 -1.9090 -0.59360 0 -1.9483 -0.52053 0 -1.9791 -0.44316 0 -1.9927 -0.36752 0 -2.0021 -0.30174 0 -1.9876 -0.23596 0 -1.9732 -0.19763 0 -1.9428 -0.16019 0 -1.9119 -0.14568 0 -1.8821 -0.13736 0 -1.8526 -0.13442 0 -1.8284 -0.13498 0 -1.8079 -0.13848 0 -1.7903 -0.14595 0 -1.7770 -0.15641 0 -1.7662 -0.17613 0 -1.7636 -0.19579 0 -1.7617 -0.21430 0 -1.7724 -0.23282 0 -1.7830 -0.24933 0 -1.8042 -0.26557 0 -1.8268 -0.27830 0 -1.8579 -0.28952 0 -1.8928 -0.28923 0 -1.9304 -0.27826 0 -1.9705 -0.26098 0 -2.0080 -0.23131 0 -2.0403 -0.20032 0 -2.0704 -0.16223 0 -2.0880 -0.12414 0 -2.1056 -0.77422E-01 0 -2.1033 -0.30487E-01 0 -2.1004 --0.13348E-01 0 -2.0768 --0.56377E-01 0 -2.0477 --0.81942E-01 0 -2.0071 --0.96459E-01 0 -1.9594 --0.94298E-01 0 -1.9157 --0.70141E-01 0 -1.8773 --0.41086E-01 0 -1.8371 -0.26608E-02 0 -1.7914 -0.51854E-01 0 -1.7739 -0.10305 0 -1.7711 -0.15480 0 -1.7844 -0.20179 0 -1.8132 -0.24207 0 -1.8523 -0.26701 0 -1.9072 -0.29195 0 -1.9620 -0.28796 0 -2.0191 -0.27887 0 -2.0765 -0.26119 0 -2.1255 -0.23303 0 -2.1643 -0.20465 0 -2.2023 -0.17198 0 -2.2271 -0.13931 0 -2.2518 -0.10242 0 -2.2691 -0.63263E-01 0 -2.2824 -0.22904E-01 0 -2.2915 --0.21062E-01 0 -2.2882 --0.65029E-01 0 -2.2850 --0.10856 0 -2.2640 --0.15201 0 -2.2398 --0.19047 0 -2.2047 --0.22283 0 -2.1562 --0.25371 0 -2.1068 --0.25665 0 -2.0411 --0.25959 0 -1.9755 --0.23854 0 -1.9161 --0.20456 0 -1.8600 --0.16580 0 -1.8099 --0.11266 0 -1.7778 --0.55552E-01 0 -1.7619 -0.25611E-02 0 -1.7570 -0.59705E-01 0 -1.7683 -0.11093 0 -1.7950 -0.15472 0 -1.8318 -0.18212 0 -1.8834 -0.20953 0 -1.9350 -0.20721 0 -1.9876 -0.19965 0 -2.0403 -0.18351 0 -2.0837 -0.15690 0 -2.1157 -0.13014 0 -2.1469 -0.10044 0 -2.1624 -0.70744E-01 0 -2.1779 -0.39196E-01 0 -2.1845 -0.66507E-02 0 -2.1864 --0.25501E-01 0 -2.1841 --0.56470E-01 0 -2.1694 --0.87439E-01 0 -2.1547 --0.11131 0 -2.1265 --0.13393 0 -2.0959 --0.14947 0 -2.0593 --0.15635 0 -2.0155 --0.16191 0 -1.9714 --0.14234 0 -1.9230 --0.12277 0 -1.8746 --0.84586E-01 0 -1.8368 --0.36375E-01 0 -1.8048 -0.15023E-01 0 -1.7794 -0.75983E-01 0 -1.7740 -0.13847 0 -1.7839 -0.20070 0 -1.8043 -0.26062 0 -1.8406 -0.31410 0 -1.8932 -0.35986 0 -1.9565 -0.38892 0 -2.0354 -0.41799 0 -2.1144 -0.41489 0 -2.2003 -0.40611 0 -2.2874 -0.38531 0 -2.3687 -0.34982 0 -2.4427 -0.31348 0 -2.5163 -0.26114 0 -2.5815 -0.20881 0 -2.6466 -0.13860 0 -2.7032 -0.58764E-01 0 -2.7552 --0.27090E-01 0 -2.7988 --0.13100 0 -2.8171 --0.23491 0 -2.8355 --0.34504 0 -2.8159 --0.45626 0 -2.7897 --0.56178 0 -2.7428 --0.66032 0 -2.6707 --0.75706 0 -2.5969 --0.81972 0 -2.4916 --0.88238 0 -2.3862 --0.91615 0 -2.2798 --0.93437 0 -2.1728 --0.94612 0 -2.0715 --0.93847 0 -1.9878 --0.92884 0 -1.9102 --0.91327 0 -1.8509 --0.89840 0 -1.7981 --0.88565 0 -1.7651 --0.87587 0 -1.7400 --0.87499 0 -1.7390 --0.88239 0 -1.7541 --0.91459 0 -1.8178 --0.94704 0 -1.8747 --0.98020 0 -1.9114 --2.4644 0 -2.1722 --1.9802 0 -2.2648 --1.4961 0 -2.3575 --1.2914 0 -2.3080 --1.2371 0 -2.1820 --1.1769 0 -2.0619 --1.0021 0 -2.0524 --0.82732 0 -2.0430 --0.71598 0 -2.0111 --0.68217 0 -1.9517 --0.64836 0 -1.8924 --0.63579 0 -1.8381 --0.62696 0 -1.7847 --0.61668 0 -1.7369 --0.60205 0 -1.7059 --0.58742 0 -1.6750 --0.58771 0 -1.6432 --0.59603 0 -1.6110 --0.60731 0 -1.5775 --0.67473 0 -1.5176 --0.74214 0 -1.4577 --0.86729 0 -1.2861 --1.0630 0 -0.97777 --1.2587 0 -0.66946 --1.0578 0 0.13641 --0.78691 0 1.0301 --0.10568E-01 0 0.77268E-01 --0.34383E-01 0 0.71949E-01 --0.58197E-01 0 0.66630E-01 --0.82012E-01 0 0.61311E-01 --0.97415E-01 0 0.54282E-01 --0.87587E-01 0 0.42124E-01 --0.77759E-01 0 0.29966E-01 --0.67931E-01 0 0.17807E-01 --0.60053E-01 0 0.78063E-02 --0.58023E-01 0 0.42778E-02 --0.55994E-01 0 0.74918E-03 --0.53965E-01 0 -0.27794E-02 --0.51747E-01 0 -0.58390E-02 --0.48967E-01 0 -0.74919E-02 --0.46186E-01 0 -0.91448E-02 --0.43405E-01 0 -0.10798E-01 --0.40836E-01 0 -0.12221E-01 --0.38901E-01 0 -0.12955E-01 --0.36966E-01 0 -0.13688E-01 --0.35031E-01 0 -0.14422E-01 --0.33183E-01 0 -0.15037E-01 --0.31599E-01 0 -0.15297E-01 --0.30014E-01 0 -0.15557E-01 --0.28430E-01 0 -0.15817E-01 --0.26929E-01 0 -0.16014E-01 --0.25680E-01 0 -0.16024E-01 --0.24432E-01 0 -0.16033E-01 --0.23183E-01 0 -0.16043E-01 --0.21995E-01 0 -0.16019E-01 --0.20993E-01 0 -0.15895E-01 --0.19990E-01 0 -0.15770E-01 --0.18987E-01 0 -0.15646E-01 --0.18032E-01 0 -0.15505E-01 --0.17223E-01 0 -0.15314E-01 --0.16415E-01 0 -0.15123E-01 --0.15606E-01 0 -0.14932E-01 --0.14834E-01 0 -0.14581E-01 --0.14172E-01 0 -0.13748E-01 --0.13510E-01 0 -0.12915E-01 --0.12848E-01 0 -0.12082E-01 --0.12215E-01 0 -0.11566E-01 --0.11671E-01 0 -0.12001E-01 --0.11127E-01 0 -0.12437E-01 --0.10583E-01 0 -0.12872E-01 --0.10063E-01 0 -0.13142E-01 --0.96130E-02 0 -0.12917E-01 --0.91631E-02 0 -0.12692E-01 --0.87131E-02 0 -0.12468E-01 --0.82808E-02 0 -0.12248E-01 --0.79012E-02 0 -0.12041E-01 --0.75216E-02 0 -0.11835E-01 --0.71421E-02 0 -0.11629E-01 --0.67761E-02 0 -0.11429E-01 --0.64511E-02 0 -0.11246E-01 --0.61261E-02 0 -0.11063E-01 --0.58011E-02 0 -0.10880E-01 --0.54865E-02 0 -0.10703E-01 --0.52029E-02 0 -0.10546E-01 --0.49193E-02 0 -0.10389E-01 --0.46357E-02 0 -0.10231E-01 --0.43599E-02 0 -0.10081E-01 --0.41073E-02 0 -0.99504E-02 --0.38547E-02 0 -0.98201E-02 --0.36020E-02 0 -0.96898E-02 --0.33551E-02 0 -0.95666E-02 --0.31249E-02 0 -0.94643E-02 --0.28948E-02 0 -0.93620E-02 --0.26647E-02 0 -0.92597E-02 --0.24384E-02 0 -0.91646E-02 --0.22238E-02 0 -0.90909E-02 --0.20093E-02 0 -0.90173E-02 --0.17947E-02 0 -0.89436E-02 --0.15825E-02 0 -0.88772E-02 --0.13777E-02 0 -0.88326E-02 --0.11729E-02 0 -0.87880E-02 --0.96802E-03 0 -0.87434E-02 --0.76439E-03 0 -0.81656E-02 --0.56437E-03 0 -0.59881E-02 --0.36435E-03 0 -0.38106E-02 --0.16432E-03 0 -0.16331E-02 -0.84382 0 -1.7562 -0.82469 0 -1.7995 -0.78978 0 -1.8603 -0.74790 0 -1.9289 -0.68591 0 -1.9886 -0.60477 0 -2.0397 -0.52070 0 -2.0779 -0.43071 0 -2.0902 -0.34251 0 -2.0967 -0.26444 0 -2.0699 -0.18637 0 -2.0432 -0.14417 0 -1.9877 -0.10312 0 -1.9312 -0.99545E-01 0 -1.8864 -0.10608 0 -1.8447 -0.11027 0 -1.8199 -0.11294 0 -1.8061 -0.11651 0 -1.7874 -0.12130 0 -1.7620 -0.13313 0 -1.7410 -0.16679 0 -1.7334 -0.19964 0 -1.7274 -0.22023 0 -1.7464 -0.24083 0 -1.7655 -0.25988 0 -1.7819 -0.27872 0 -1.7980 -0.30220 0 -1.8340 -0.32768 0 -1.8785 -0.33216 0 -1.9312 -0.31718 0 -1.9914 -0.29411 0 -2.0435 -0.25518 0 -2.0797 -0.21623 0 -2.1137 -0.17721 0 -2.1363 -0.13819 0 -2.1588 -0.79285E-01 0 -2.1647 -0.19873E-01 0 -2.1702 --0.40381E-01 0 -2.1412 --0.10085 0 -2.1032 --0.13736 0 -2.0416 --0.15869 0 -1.9652 --0.15618 0 -1.8943 --0.12221 0 -1.8310 --0.82296E-01 0 -1.7724 --0.24525E-01 0 -1.7278 -0.39693E-01 0 -1.7086 -0.10629 0 -1.7042 -0.17355 0 -1.7191 -0.23641 0 -1.7535 -0.29159 0 -1.8027 -0.32817 0 -1.8765 -0.36474 0 -1.9502 -0.35319 0 -2.0265 -0.33315 0 -2.1033 -0.30413 0 -2.1623 -0.26414 0 -2.1996 -0.22454 0 -2.2363 -0.19229 0 -2.2631 -0.16005 0 -2.2899 -0.11951 0 -2.3105 -0.74506E-01 0 -2.3279 -0.27989E-01 0 -2.3406 --0.23051E-01 0 -2.3389 --0.74091E-01 0 -2.3373 --0.12697 0 -2.3163 --0.18018 0 -2.2918 --0.23017 0 -2.2530 --0.27623 0 -2.1968 --0.32042 0 -2.1388 --0.32918 0 -2.0498 --0.33793 0 -1.9608 --0.30950 0 -1.8821 --0.26104 0 -1.8091 --0.20735 0 -1.7448 --0.13794 0 -1.7071 --0.65297E-01 0 -1.6893 -0.80515E-02 0 -1.6844 -0.80272E-01 0 -1.6986 -0.14681 0 -1.7321 -0.20487 0 -1.7798 -0.24320 0 -1.8509 -0.28153 0 -1.9220 -0.27078 0 -1.9942 -0.25138 0 -2.0666 -0.22289 0 -2.1201 -0.18327 0 -2.1505 -0.14410 0 -2.1802 -0.11335 0 -2.1968 -0.82601E-01 0 -2.2134 -0.45974E-01 0 -2.2216 -0.61822E-02 0 -2.2252 --0.33189E-01 0 -2.2237 --0.71300E-01 0 -2.2065 --0.10941 0 -2.1894 --0.13975 0 -2.1566 --0.16871 0 -2.1210 --0.19085 0 -2.0778 --0.20464 0 -2.0253 --0.21680 0 -1.9720 --0.19789 0 -1.9045 --0.17898 0 -1.8370 --0.13116 0 -1.7848 --0.67780E-01 0 -1.7408 --0.12419E-02 0 -1.7058 -0.74764E-01 0 -1.6979 -0.15148 0 -1.7078 -0.22774 0 -1.7294 -0.30192 0 -1.7690 -0.37062 0 -1.8280 -0.43138 0 -1.9015 -0.47377 0 -1.9991 -0.51617 0 -2.0968 -0.50875 0 -2.2041 -0.49254 0 -2.3131 -0.46335 0 -2.4074 -0.41829 0 -2.4838 -0.37321 0 -2.5600 -0.32758 0 -2.6340 -0.28196 0 -2.7079 -0.20763 0 -2.7797 -0.11785 0 -2.8503 -0.20156E-01 0 -2.9099 --0.10126 0 -2.9363 --0.22268 0 -2.9627 --0.35179 0 -2.9442 --0.48225 0 -2.9178 --0.60745 0 -2.8659 --0.72623 0 -2.7829 --0.84267 0 -2.6973 --0.91462 0 -2.5644 --0.98656 0 -2.4315 --1.0146 0 -2.3019 --1.0190 0 -2.1742 --1.0162 0 -2.0558 --0.99181 0 -1.9653 --0.96572 0 -1.8825 --0.93447 0 -1.8227 --0.90373 0 -1.7705 --0.87450 0 -1.7407 --0.84714 0 -1.7196 --0.82535 0 -1.7248 --0.80635 0 -1.7437 --0.79573 0 -1.8041 --0.77794 0 -1.8569 --0.73862 0 -1.8872 --2.1432 0 -2.0608 --1.8264 0 -2.1188 --1.5097 0 -2.1767 --1.3227 0 -2.1561 --1.2056 0 -2.0931 --1.0872 0 -2.0326 --0.94452 0 -2.0187 --0.80188 0 -2.0048 --0.71670 0 -1.9670 --0.70177 0 -1.9000 --0.68684 0 -1.8330 --0.67102 0 -1.7846 --0.65505 0 -1.7394 --0.63904 0 -1.6982 --0.62295 0 -1.6684 --0.60685 0 -1.6387 --0.60070 0 -1.6085 --0.59989 0 -1.5782 --0.60101 0 -1.5469 --0.63861 0 -1.4967 --0.67620 0 -1.4466 --0.77802 0 -1.3145 --0.95832 0 -1.0824 --1.1386 0 -0.85028 --0.94238 0 0.78368E-02 --0.67968 0 0.97643 --0.75349E-02 0 0.60601E-01 --0.24063E-01 0 0.57937E-01 --0.40591E-01 0 0.55273E-01 --0.57119E-01 0 0.52609E-01 --0.68600E-01 0 0.48207E-01 --0.64943E-01 0 0.38589E-01 --0.61285E-01 0 0.28972E-01 --0.57628E-01 0 0.19355E-01 --0.54355E-01 0 0.11184E-01 --0.52238E-01 0 0.73502E-02 --0.50120E-01 0 0.35168E-02 --0.48003E-01 0 -0.31655E-03 --0.45892E-01 0 -0.36196E-02 --0.43800E-01 0 -0.53318E-02 --0.41708E-01 0 -0.70440E-02 --0.39616E-01 0 -0.87561E-02 --0.37619E-01 0 -0.10248E-01 --0.35910E-01 0 -0.11079E-01 --0.34201E-01 0 -0.11911E-01 --0.32491E-01 0 -0.12742E-01 --0.30860E-01 0 -0.13450E-01 --0.29461E-01 0 -0.13786E-01 --0.28062E-01 0 -0.14122E-01 --0.26664E-01 0 -0.14458E-01 --0.25330E-01 0 -0.14728E-01 --0.24193E-01 0 -0.14800E-01 --0.23056E-01 0 -0.14871E-01 --0.21919E-01 0 -0.14943E-01 --0.20835E-01 0 -0.14978E-01 --0.19909E-01 0 -0.14903E-01 --0.18984E-01 0 -0.14828E-01 --0.18059E-01 0 -0.14753E-01 --0.17176E-01 0 -0.14659E-01 --0.16420E-01 0 -0.14507E-01 --0.15664E-01 0 -0.14355E-01 --0.14908E-01 0 -0.14203E-01 --0.14195E-01 0 -0.13892E-01 --0.13613E-01 0 -0.13104E-01 --0.13031E-01 0 -0.12316E-01 --0.12449E-01 0 -0.11528E-01 --0.11892E-01 0 -0.11048E-01 --0.11411E-01 0 -0.11492E-01 --0.10930E-01 0 -0.11936E-01 --0.10449E-01 0 -0.12380E-01 --0.99791E-02 0 -0.12661E-01 --0.95414E-02 0 -0.12456E-01 --0.91038E-02 0 -0.12251E-01 --0.86661E-02 0 -0.12045E-01 --0.82449E-02 0 -0.11843E-01 --0.78733E-02 0 -0.11652E-01 --0.75016E-02 0 -0.11461E-01 --0.71300E-02 0 -0.11270E-01 --0.67712E-02 0 -0.11084E-01 --0.64508E-02 0 -0.10912E-01 --0.61304E-02 0 -0.10741E-01 --0.58100E-02 0 -0.10569E-01 --0.54993E-02 0 -0.10403E-01 --0.52181E-02 0 -0.10255E-01 --0.49368E-02 0 -0.10106E-01 --0.46555E-02 0 -0.99575E-02 --0.43816E-02 0 -0.98150E-02 --0.41297E-02 0 -0.96912E-02 --0.38777E-02 0 -0.95673E-02 --0.36258E-02 0 -0.94435E-02 --0.33791E-02 0 -0.93262E-02 --0.31485E-02 0 -0.92285E-02 --0.29178E-02 0 -0.91308E-02 --0.26872E-02 0 -0.90331E-02 --0.24602E-02 0 -0.89422E-02 --0.22443E-02 0 -0.88715E-02 --0.20283E-02 0 -0.88009E-02 --0.18124E-02 0 -0.87303E-02 --0.15987E-02 0 -0.86666E-02 --0.13919E-02 0 -0.86238E-02 --0.11852E-02 0 -0.85809E-02 --0.97844E-03 0 -0.85380E-02 --0.77283E-03 0 -0.79743E-02 --0.57062E-03 0 -0.58478E-02 --0.36841E-03 0 -0.37213E-02 --0.16621E-03 0 -0.15949E-02 -0.86234 0 -1.7519 -0.87730 0 -1.8075 -0.85604 0 -1.8928 -0.81878 0 -1.9913 -0.74852 0 -2.0725 -0.64687 0 -2.1373 -0.54227 0 -2.1842 -0.43170 0 -2.1951 -0.32303 0 -2.1985 -0.22507 0 -2.1593 -0.12711 0 -2.1200 -0.77467E-01 0 -2.0335 -0.29382E-01 0 -1.9453 -0.43564E-01 0 -1.8831 -0.74549E-01 0 -1.8279 -0.88931E-01 0 -1.8062 -0.92529E-01 0 -1.8064 -0.93340E-01 0 -1.7884 -0.90378E-01 0 -1.7461 -0.10177 0 -1.7107 -0.15770 0 -1.6967 -0.21144 0 -1.6857 -0.23242 0 -1.7186 -0.25340 0 -1.7515 -0.27384 0 -1.7587 -0.29421 0 -1.7624 -0.33479 0 -1.8026 -0.38403 0 -1.8582 -0.39610 0 -1.9297 -0.37367 0 -2.0158 -0.34074 0 -2.0854 -0.28722 0 -2.1229 -0.23630 0 -2.1589 -0.19944 0 -2.1863 -0.16258 0 -2.2137 -0.86407E-01 0 -2.2318 -0.92282E-02 0 -2.2496 --0.75775E-01 0 -2.2161 --0.16281 0 -2.1693 --0.21621 0 -2.0828 --0.24833 0 -1.9711 --0.24406 0 -1.8695 --0.19181 0 -1.7812 --0.13333 0 -1.7027 --0.56174E-01 0 -1.6541 -0.25935E-01 0 -1.6319 -0.10994 0 -1.6259 -0.19470 0 -1.6421 -0.27629 0 -1.6821 -0.34983 0 -1.7424 -0.40235 0 -1.8395 -0.45488 0 -1.9367 -0.43193 0 -2.0377 -0.39567 0 -2.1395 -0.35066 0 -2.2096 -0.29498 0 -2.2410 -0.24066 0 -2.2723 -0.21230 0 -2.3013 -0.18394 0 -2.3302 -0.14032 0 -2.3550 -0.88495E-01 0 -2.3775 -0.35015E-01 0 -2.3945 --0.23417E-01 0 -2.3950 --0.81850E-01 0 -2.3954 --0.14494 0 -2.3755 --0.20885 0 -2.3520 --0.27257 0 -2.3105 --0.33606 0 -2.2471 --0.39724 0 -2.1809 --0.41484 0 -2.0620 --0.43243 0 -1.9431 --0.39457 0 -1.8410 --0.32686 0 -1.7480 --0.25398 0 -1.6675 --0.16558 0 -1.6247 --0.75490E-01 0 -1.6052 -0.14756E-01 0 -1.6006 -0.10379 0 -1.6176 -0.18831 0 -1.6578 -0.26393 0 -1.7175 -0.31737 0 -1.8127 -0.37081 0 -1.9079 -0.34768 0 -2.0053 -0.31105 0 -2.1030 -0.26539 0 -2.1678 -0.20871 0 -2.1923 -0.15342 0 -2.2165 -0.12471 0 -2.2344 -0.95990E-01 0 -2.2524 -0.54367E-01 0 -2.2628 -0.57952E-02 0 -2.2691 --0.42172E-01 0 -2.2689 --0.88324E-01 0 -2.2490 --0.13448 0 -2.2291 --0.17200 0 -2.1916 --0.20800 0 -2.1510 --0.23811 0 -2.1013 --0.26102 0 -2.0402 --0.28198 0 -1.9776 --0.26584 0 -1.8858 --0.24969 0 -1.7940 --0.19027 0 -1.7243 --0.10754 0 -1.6665 --0.22280E-01 0 -1.6207 -0.70583E-01 0 -1.6111 -0.16264 0 -1.6212 -0.25388 0 -1.6442 -0.34346 0 -1.6864 -0.42961 0 -1.7513 -0.50840 0 -1.8355 -0.56855 0 -1.9553 -0.62870 0 -2.0751 -0.61386 0 -2.2092 -0.58577 0 -2.3459 -0.54385 0 -2.4544 -0.48500 0 -2.5287 -0.42750 0 -2.6034 -0.39542 0 -2.6859 -0.36335 0 -2.7685 -0.28586 0 -2.8588 -0.18393 0 -2.9533 -0.72048E-01 0 -3.0330 --0.69678E-01 0 -3.0683 --0.21140 0 -3.1036 --0.36207 0 -3.0867 --0.51431 0 -3.0607 --0.66271 0 -3.0039 --0.80643 0 -2.9096 --0.94722 0 -2.8116 --1.0322 0 -2.6437 --1.1173 0 -2.4759 --1.1382 0 -2.3183 --1.1247 0 -2.1663 --1.1039 0 -2.0281 --1.0616 0 -1.9314 --1.0184 0 -1.8439 --0.97274 0 -1.7841 --0.92792 0 -1.7325 --0.88573 0 -1.7054 --0.84507 0 -1.6871 --0.80901 0 -1.6948 --0.77403 0 -1.7135 --0.74229 0 -1.7649 --0.70368 0 -1.8089 --0.64442 0 -1.8305 --2.0871 0 -1.8896 --1.8326 0 -1.9428 --1.5782 0 -1.9960 --1.4071 0 -1.9941 --1.2807 0 -1.9625 --1.1554 0 -1.9316 --1.0495 0 -1.9153 --0.94363 0 -1.8990 --0.88498 0 -1.8583 --0.88412 0 -1.7877 --0.88325 0 -1.7171 --0.87486 0 -1.6705 --0.86514 0 -1.6280 --0.85649 0 -1.5879 --0.85105 0 -1.5547 --0.84560 0 -1.5214 --0.85050 0 -1.4847 --0.86096 0 -1.4460 --0.87329 0 -1.4058 --0.92101 0 -1.3354 --0.96873 0 -1.2650 --1.0574 0 -1.1239 --1.1962 0 -0.89653 --1.3350 0 -0.66913 --1.1087 0 0.11228 --0.81798 0 0.99144 --0.73578E-02 0 0.47586E-01 --0.20854E-01 0 0.46698E-01 --0.34351E-01 0 0.45810E-01 --0.47848E-01 0 0.44922E-01 --0.57559E-01 0 0.42366E-01 --0.55916E-01 0 0.34803E-01 --0.54272E-01 0 0.27240E-01 --0.52629E-01 0 0.19677E-01 --0.50936E-01 0 0.13058E-01 --0.49098E-01 0 0.92725E-02 --0.47261E-01 0 0.54871E-02 --0.45423E-01 0 0.17018E-02 --0.43588E-01 0 -0.15829E-02 --0.41765E-01 0 -0.33654E-02 --0.39941E-01 0 -0.51480E-02 --0.38118E-01 0 -0.69305E-02 --0.36357E-01 0 -0.84923E-02 --0.34784E-01 0 -0.93916E-02 --0.33212E-01 0 -0.10291E-01 --0.31639E-01 0 -0.11190E-01 --0.30131E-01 0 -0.11966E-01 --0.28819E-01 0 -0.12369E-01 --0.27508E-01 0 -0.12773E-01 --0.26196E-01 0 -0.13176E-01 --0.24941E-01 0 -0.13511E-01 --0.23858E-01 0 -0.13638E-01 --0.22775E-01 0 -0.13766E-01 --0.21692E-01 0 -0.13893E-01 --0.20656E-01 0 -0.13981E-01 --0.19765E-01 0 -0.13952E-01 --0.18874E-01 0 -0.13922E-01 --0.17983E-01 0 -0.13893E-01 --0.17131E-01 0 -0.13842E-01 --0.16396E-01 0 -0.13726E-01 --0.15662E-01 0 -0.13611E-01 --0.14927E-01 0 -0.13495E-01 --0.14227E-01 0 -0.13223E-01 --0.13634E-01 0 -0.12478E-01 --0.13041E-01 0 -0.11734E-01 --0.12447E-01 0 -0.10989E-01 --0.11879E-01 0 -0.10544E-01 --0.11386E-01 0 -0.10995E-01 --0.10892E-01 0 -0.11446E-01 --0.10399E-01 0 -0.11898E-01 --0.99211E-02 0 -0.12190E-01 --0.94911E-02 0 -0.12003E-01 --0.90611E-02 0 -0.11816E-01 --0.86311E-02 0 -0.11629E-01 --0.82169E-02 0 -0.11444E-01 --0.78503E-02 0 -0.11268E-01 --0.74836E-02 0 -0.11091E-01 --0.71169E-02 0 -0.10914E-01 --0.67626E-02 0 -0.10742E-01 --0.64452E-02 0 -0.10581E-01 --0.61278E-02 0 -0.10421E-01 --0.58104E-02 0 -0.10261E-01 --0.55024E-02 0 -0.10105E-01 --0.52228E-02 0 -0.99652E-02 --0.49431E-02 0 -0.98250E-02 --0.46635E-02 0 -0.96848E-02 --0.43909E-02 0 -0.95502E-02 --0.41396E-02 0 -0.94326E-02 --0.38883E-02 0 -0.93150E-02 --0.36369E-02 0 -0.91974E-02 --0.33907E-02 0 -0.90859E-02 --0.31600E-02 0 -0.89927E-02 --0.29292E-02 0 -0.88994E-02 --0.26984E-02 0 -0.88062E-02 --0.24712E-02 0 -0.87193E-02 --0.22546E-02 0 -0.86516E-02 --0.20381E-02 0 -0.85840E-02 --0.18215E-02 0 -0.85163E-02 --0.16071E-02 0 -0.84553E-02 --0.13994E-02 0 -0.84141E-02 --0.11916E-02 0 -0.83729E-02 --0.98390E-03 0 -0.83317E-02 --0.77726E-03 0 -0.77820E-02 --0.57391E-03 0 -0.57068E-02 --0.37055E-03 0 -0.36316E-02 --0.16720E-03 0 -0.15564E-02 -0.88151 0 -1.7359 -0.93286 0 -1.8016 -0.92644 0 -1.9085 -0.89451 0 -2.0335 -0.81494 0 -2.1335 -0.69006 0 -2.2097 -0.56299 0 -2.2636 -0.43151 0 -2.2728 -0.30192 0 -2.2730 -0.18296 0 -2.2225 -0.64009E-01 0 -2.1720 -0.23571E-02 0 -2.0571 --0.57446E-01 0 -1.9401 --0.19663E-01 0 -1.8618 -0.44453E-01 0 -1.7938 -0.71463E-01 0 -1.7749 -0.74374E-01 0 -1.7878 -0.68981E-01 0 -1.7706 -0.52352E-01 0 -1.7127 -0.60773E-01 0 -1.6639 -0.14691 0 -1.6433 -0.22882 0 -1.6267 -0.24741 0 -1.6711 -0.26600 0 -1.7154 -0.28527 0 -1.7148 -0.30464 0 -1.7082 -0.36793 0 -1.7528 -0.45004 0 -1.8194 -0.47119 0 -1.9082 -0.43577 0 -2.0176 -0.38811 0 -2.1031 -0.31644 0 -2.1417 -0.25166 0 -2.1794 -0.22414 0 -2.2120 -0.19662 0 -2.2446 -0.99726E-01 0 -2.2747 -0.10592E-02 0 -2.3047 --0.11148 0 -2.2681 --0.22763 0 -2.2141 --0.30057 0 -2.1055 --0.34617 0 -1.9622 --0.34002 0 -1.8330 --0.26561 0 -1.7226 --0.18551 0 -1.6267 --0.88353E-01 0 -1.5748 -0.11896E-01 0 -1.5501 -0.11345 0 -1.5425 -0.21584 0 -1.5597 -0.31675 0 -1.6043 -0.41048 0 -1.6739 -0.48417 0 -1.7916 -0.55786 0 -1.9092 -0.51948 0 -2.0320 -0.46132 0 -2.1556 -0.39504 0 -2.2346 -0.31883 0 -2.2590 -0.24550 0 -2.2837 -0.22675 0 -2.3132 -0.20801 0 -2.3428 -0.16278 0 -2.3703 -0.10330 0 -2.3968 -0.42316E-01 0 -2.4173 --0.23164E-01 0 -2.4199 --0.88644E-01 0 -2.4224 --0.16176 0 -2.4044 --0.23622 0 -2.3828 --0.31416 0 -2.3401 --0.39636 0 -2.2717 --0.47594 0 -2.1996 --0.50576 0 -2.0547 --0.53558 0 -1.9098 --0.48691 0 -1.7876 --0.39598 0 -1.6776 --0.30084 0 -1.5835 --0.19303 0 -1.5368 --0.85418E-01 0 -1.5162 -0.21715E-01 0 -1.5121 -0.12760 0 -1.5315 -0.23062 0 -1.5774 -0.32561 0 -1.6474 -0.39935 0 -1.7638 -0.47309 0 -1.8802 -0.43354 0 -1.9996 -0.37399 0 -2.1196 -0.30586 0 -2.1936 -0.22725 0 -2.2111 -0.15152 0 -2.2287 -0.13045 0 -2.2465 -0.10938 0 -2.2643 -0.64003E-01 0 -2.2757 -0.55354E-02 0 -2.2835 --0.51899E-01 0 -2.2837 --0.10624 0 -2.2608 --0.16057 0 -2.2379 --0.20528 0 -2.1955 --0.24829 0 -2.1497 --0.28628 0 -2.0939 --0.31811 0 -2.0261 --0.34782 0 -1.9561 --0.33698 0 -1.8452 --0.32614 0 -1.7343 --0.25395 0 -1.6514 --0.14873 0 -1.5836 --0.42417E-01 0 -1.5302 -0.67149E-01 0 -1.5200 -0.17424 0 -1.5307 -0.28015 0 -1.5551 -0.38495 0 -1.5994 -0.48881 0 -1.6687 -0.58713 0 -1.7616 -0.66980 0 -1.9003 -0.75247 0 -2.0390 -0.72718 0 -2.1966 -0.68284 0 -2.3574 -0.62365 0 -2.4784 -0.54632 0 -2.5506 -0.47245 0 -2.6238 -0.46420 0 -2.7150 -0.45594 0 -2.8063 -0.37573 0 -2.9143 -0.25676 0 -3.0314 -0.12683 0 -3.1301 --0.36014E-01 0 -3.1738 --0.19886 0 -3.2175 --0.37154 0 -3.2026 --0.54597 0 -3.1773 --0.71845 0 -3.1166 --0.88854 0 -3.0126 --1.0552 0 -2.9038 --1.1568 0 -2.7044 --1.2583 0 -2.5049 --1.2705 0 -2.3224 --1.2345 0 -2.1488 --1.1922 0 -1.9933 --1.1311 0 -1.8915 --1.0702 0 -1.8003 --1.0098 0 -1.7410 --0.95077 0 -1.6905 --0.89555 0 -1.6662 --0.84157 0 -1.6504 --0.79130 0 -1.6604 --0.74056 0 -1.6786 --0.68843 0 -1.7215 --0.62985 0 -1.7572 --0.55195 0 -1.7707 --2.0311 0 -1.7253 --1.8348 0 -1.7745 --1.6385 0 -1.8236 --1.4839 0 -1.8388 --1.3518 0 -1.8357 --1.2227 0 -1.8318 --1.1515 0 -1.8120 --1.0804 0 -1.7922 --1.0462 0 -1.7487 --1.0570 0 -1.6764 --1.0677 0 -1.6040 --1.0658 0 -1.5594 --1.0615 0 -1.5196 --1.0594 0 -1.4807 --1.0635 0 -1.4444 --1.0675 0 -1.4081 --1.0822 0 -1.3652 --1.1027 0 -1.3188 --1.1249 0 -1.2704 --1.1810 0 -1.1818 --1.2371 0 -1.0932 --1.3128 0 -0.94516 --1.4126 0 -0.72432 --1.5124 0 -0.50348 --1.2604 0 0.20657 --0.94634 0 1.0030 --0.71622E-02 0 0.35281E-01 --0.17739E-01 0 0.36028E-01 --0.28315E-01 0 0.36776E-01 --0.38891E-01 0 0.37523E-01 --0.46881E-01 0 0.36679E-01 --0.47112E-01 0 0.31059E-01 --0.47342E-01 0 0.25439E-01 --0.47572E-01 0 0.19819E-01 --0.47360E-01 0 0.14679E-01 --0.45824E-01 0 0.10979E-01 --0.44288E-01 0 0.72798E-02 --0.42752E-01 0 0.35803E-02 --0.41211E-01 0 0.34551E-03 --0.39655E-01 0 -0.14952E-02 --0.38099E-01 0 -0.33360E-02 --0.36543E-01 0 -0.51767E-02 --0.35018E-01 0 -0.67977E-02 --0.33586E-01 0 -0.77593E-02 --0.32154E-01 0 -0.87209E-02 --0.30721E-01 0 -0.96825E-02 --0.29341E-01 0 -0.10521E-01 --0.28119E-01 0 -0.10988E-01 --0.26896E-01 0 -0.11456E-01 --0.25674E-01 0 -0.11923E-01 --0.24500E-01 0 -0.12319E-01 --0.23473E-01 0 -0.12500E-01 --0.22446E-01 0 -0.12681E-01 --0.21419E-01 0 -0.12861E-01 --0.20435E-01 0 -0.13001E-01 --0.19580E-01 0 -0.13015E-01 --0.18725E-01 0 -0.13030E-01 --0.17870E-01 0 -0.13045E-01 --0.17050E-01 0 -0.13036E-01 --0.16338E-01 0 -0.12956E-01 --0.15626E-01 0 -0.12876E-01 --0.14914E-01 0 -0.12796E-01 --0.14229E-01 0 -0.12560E-01 --0.13628E-01 0 -0.11859E-01 --0.13028E-01 0 -0.11157E-01 --0.12427E-01 0 -0.10456E-01 --0.11851E-01 0 -0.10044E-01 --0.11348E-01 0 -0.10503E-01 --0.10845E-01 0 -0.10961E-01 --0.10342E-01 0 -0.11420E-01 --0.98594E-02 0 -0.11721E-01 --0.94374E-02 0 -0.11552E-01 --0.90154E-02 0 -0.11384E-01 --0.85934E-02 0 -0.11215E-01 --0.81865E-02 0 -0.11048E-01 --0.78250E-02 0 -0.10885E-01 --0.74636E-02 0 -0.10723E-01 --0.71021E-02 0 -0.10560E-01 --0.67524E-02 0 -0.10401E-01 --0.64382E-02 0 -0.10252E-01 --0.61239E-02 0 -0.10103E-01 --0.58097E-02 0 -0.99532E-02 --0.55045E-02 0 -0.98082E-02 --0.52266E-02 0 -0.96763E-02 --0.49487E-02 0 -0.95445E-02 --0.46708E-02 0 -0.94126E-02 --0.43997E-02 0 -0.92858E-02 --0.41490E-02 0 -0.91744E-02 --0.38984E-02 0 -0.90630E-02 --0.36478E-02 0 -0.89516E-02 --0.34021E-02 0 -0.88458E-02 --0.31712E-02 0 -0.87569E-02 --0.29404E-02 0 -0.86681E-02 --0.27096E-02 0 -0.85792E-02 --0.24821E-02 0 -0.84964E-02 --0.22649E-02 0 -0.84316E-02 --0.20477E-02 0 -0.83669E-02 --0.18305E-02 0 -0.83021E-02 --0.16155E-02 0 -0.82437E-02 --0.14068E-02 0 -0.82041E-02 --0.11981E-02 0 -0.81646E-02 --0.98936E-03 0 -0.81251E-02 --0.78170E-03 0 -0.75895E-02 --0.57720E-03 0 -0.55656E-02 --0.37270E-03 0 -0.35418E-02 --0.16819E-03 0 -0.15179E-02 -0.90585 0 -1.6253 -1.0120 0 -1.6852 -1.0299 0 -1.7903 -1.0090 0 -1.9153 -0.91174 0 -2.0116 -0.74189 0 -2.0807 -0.57695 0 -2.1283 -0.42190 0 -2.1324 -0.26778 0 -2.1282 -0.11896 0 -2.0766 --0.29850E-01 0 -2.0250 --0.14004 0 -1.9035 --0.24899 0 -1.7797 --0.14087 0 -1.6954 -0.25825E-01 0 -1.6218 -0.84961E-01 0 -1.6027 -0.74241E-01 0 -1.6189 -0.35093E-01 0 -1.6017 --0.42515E-01 0 -1.5394 --0.57360E-01 0 -1.4851 -0.12252 0 -1.4557 -0.29078 0 -1.4304 -0.28476 0 -1.4662 -0.27874 0 -1.5020 -0.27641 0 -1.5053 -0.27458 0 -1.5043 -0.40549 0 -1.5566 -0.59329 0 -1.6318 -0.63555 0 -1.7265 -0.54278 0 -1.8392 -0.44139 0 -1.9268 -0.32308 0 -1.9648 -0.22939 0 -2.0032 -0.26861 0 -2.0433 -0.30784 0 -2.0833 -0.16263 0 -2.1247 -0.12700E-01 0 -2.1660 --0.14969 0 -2.1365 --0.31532 0 -2.0886 --0.42895 0 -1.9802 --0.50970 0 -1.8335 --0.50060 0 -1.7032 --0.37302 0 -1.5943 --0.24683 0 -1.5003 --0.12478 0 -1.4511 --0.43814E-02 0 -1.4273 -0.11578 0 -1.4196 -0.23691 0 -1.4345 -0.36174 0 -1.4750 -0.49044 0 -1.5405 -0.62702 0 -1.6553 -0.76359 0 -1.7701 -0.67745 0 -1.8902 -0.55201 0 -2.0112 -0.42212 0 -2.0814 -0.28677 0 -2.0895 -0.16004 0 -2.0981 -0.19681 0 -2.1156 -0.23358 0 -2.1331 -0.19846 0 -2.1528 -0.12463 0 -2.1737 -0.51816E-01 0 -2.1906 --0.17953E-01 0 -2.1952 --0.87723E-01 0 -2.1998 --0.16937 0 -2.1902 --0.25312 0 -2.1781 --0.34923 0 -2.1463 --0.46047 0 -2.0906 --0.56960 0 -2.0307 --0.63878 0 -1.8910 --0.70796 0 -1.7513 --0.63738 0 -1.6358 --0.49155 0 -1.5333 --0.34955 0 -1.4463 --0.21903 0 -1.4059 --0.93225E-01 0 -1.3888 -0.30714E-01 0 -1.3865 -0.15379 0 -1.4049 -0.27944 0 -1.4477 -0.40822 0 -1.5144 -0.54382 0 -1.6286 -0.67942 0 -1.7428 -0.59103 0 -1.8602 -0.46311 0 -1.9783 -0.33003 0 -2.0440 -0.19064 0 -2.0460 -0.59787E-01 0 -2.0481 -0.91287E-01 0 -2.0540 -0.12279 0 -2.0598 -0.83578E-01 0 -2.0619 -0.62932E-02 0 -2.0619 --0.67584E-01 0 -2.0551 --0.13124 0 -2.0274 --0.19489 0 -1.9996 --0.24679 0 -1.9503 --0.29662 0 -1.8971 --0.34167 0 -1.8403 --0.38088 0 -1.7793 --0.41888 0 -1.7169 --0.43368 0 -1.6291 --0.44848 0 -1.5414 --0.35425 0 -1.4797 --0.20130 0 -1.4320 --0.55334E-01 0 -1.3959 -0.69695E-01 0 -1.3946 -0.18942 0 -1.4093 -0.30751 0 -1.4346 -0.42600 0 -1.4762 -0.54971 0 -1.5396 -0.67961 0 -1.6252 -0.82286 0 -1.7560 -0.96611 0 -1.8867 -0.90626 0 -2.0409 -0.81057 0 -2.1993 -0.69792 0 -2.3181 -0.56453 0 -2.3886 -0.44271 0 -2.4605 -0.54048 0 -2.5611 -0.63826 0 -2.6617 -0.55869 0 -2.7810 -0.38362 0 -2.9103 -0.20472 0 -3.0194 -0.14276E-01 0 -3.0679 --0.17616 0 -3.1163 --0.37460 0 -3.1053 --0.57444 0 -3.0838 --0.77792 0 -3.0266 --0.98587 0 -2.9258 --1.1907 0 -2.8198 --1.3363 0 -2.6156 --1.4820 0 -2.4113 --1.4716 0 -2.2276 --1.3772 0 -2.0549 --1.2848 0 -1.9012 --1.1986 0 -1.8042 --1.1147 0 -1.7177 --1.0378 0 -1.6629 --0.96292 0 -1.6164 --0.89417 0 -1.5949 --0.82662 0 -1.5811 --0.76268 0 -1.5903 --0.69800 0 -1.6066 --0.63112 0 -1.6444 --0.55944 0 -1.6755 --0.47338 0 -1.6867 --1.9759 0 -1.6173 --1.8046 0 -1.6676 --1.6333 0 -1.7179 --1.5010 0 -1.7373 --1.3896 0 -1.7401 --1.2812 0 -1.7412 --1.2293 0 -1.7095 --1.1775 0 -1.6779 --1.1504 0 -1.6333 --1.1537 0 -1.5729 --1.1569 0 -1.5126 --1.1533 0 -1.4723 --1.1484 0 -1.4355 --1.1459 0 -1.3988 --1.1503 0 -1.3622 --1.1546 0 -1.3255 --1.1693 0 -1.2808 --1.1896 0 -1.2318 --1.2113 0 -1.1808 --1.2618 0 -1.0905 --1.3122 0 -1.0003 --1.3763 0 -0.86094 --1.4571 0 -0.66147 --1.5379 0 -0.46199 --1.2951 0 0.21970 --0.99507 0 0.98648 --0.68180E-02 0 0.28660E-01 --0.15363E-01 0 0.29916E-01 --0.23907E-01 0 0.31172E-01 --0.32452E-01 0 0.32428E-01 --0.39106E-01 0 0.32228E-01 --0.40089E-01 0 0.27661E-01 --0.41071E-01 0 0.23093E-01 --0.42053E-01 0 0.18526E-01 --0.42526E-01 0 0.14273E-01 --0.41470E-01 0 0.10962E-01 --0.40413E-01 0 0.76512E-02 --0.39357E-01 0 0.43405E-02 --0.38240E-01 0 0.14071E-02 --0.36943E-01 0 -0.39441E-03 --0.35647E-01 0 -0.21959E-02 --0.34350E-01 0 -0.39974E-02 --0.33062E-01 0 -0.55932E-02 --0.31802E-01 0 -0.65716E-02 --0.30542E-01 0 -0.75500E-02 --0.29282E-01 0 -0.85285E-02 --0.28058E-01 0 -0.93878E-02 --0.26946E-01 0 -0.98897E-02 --0.25833E-01 0 -0.10392E-01 --0.24720E-01 0 -0.10894E-01 --0.23647E-01 0 -0.11324E-01 --0.22694E-01 0 -0.11542E-01 --0.21740E-01 0 -0.11759E-01 --0.20787E-01 0 -0.11976E-01 --0.19870E-01 0 -0.12151E-01 --0.19064E-01 0 -0.12198E-01 --0.18258E-01 0 -0.12246E-01 --0.17453E-01 0 -0.12293E-01 --0.16678E-01 0 -0.12316E-01 --0.16000E-01 0 -0.12265E-01 --0.15321E-01 0 -0.12213E-01 --0.14642E-01 0 -0.12161E-01 --0.13989E-01 0 -0.11957E-01 --0.13411E-01 0 -0.11293E-01 --0.12833E-01 0 -0.10630E-01 --0.12255E-01 0 -0.99666E-02 --0.11700E-01 0 -0.95846E-02 --0.11212E-01 0 -0.10047E-01 --0.10725E-01 0 -0.10508E-01 --0.10237E-01 0 -0.10970E-01 --0.97689E-02 0 -0.11279E-01 --0.93573E-02 0 -0.11126E-01 --0.89458E-02 0 -0.10973E-01 --0.85342E-02 0 -0.10820E-01 --0.81369E-02 0 -0.10668E-01 --0.77823E-02 0 -0.10518E-01 --0.74277E-02 0 -0.10368E-01 --0.70731E-02 0 -0.10219E-01 --0.67297E-02 0 -0.10071E-01 --0.64198E-02 0 -0.99320E-02 --0.61100E-02 0 -0.97925E-02 --0.58001E-02 0 -0.96530E-02 --0.54989E-02 0 -0.95174E-02 --0.52236E-02 0 -0.93930E-02 --0.49483E-02 0 -0.92687E-02 --0.46730E-02 0 -0.91444E-02 --0.44041E-02 0 -0.90247E-02 --0.41547E-02 0 -0.89188E-02 --0.39054E-02 0 -0.88130E-02 --0.36560E-02 0 -0.87072E-02 --0.34113E-02 0 -0.86066E-02 --0.31808E-02 0 -0.85217E-02 --0.29502E-02 0 -0.84367E-02 --0.27196E-02 0 -0.83518E-02 --0.24923E-02 0 -0.82726E-02 --0.22747E-02 0 -0.82105E-02 --0.20570E-02 0 -0.81484E-02 --0.18394E-02 0 -0.80862E-02 --0.16237E-02 0 -0.80301E-02 --0.14141E-02 0 -0.79921E-02 --0.12045E-02 0 -0.79540E-02 --0.99485E-03 0 -0.79160E-02 --0.78621E-03 0 -0.73945E-02 --0.58054E-03 0 -0.54226E-02 --0.37487E-03 0 -0.34508E-02 --0.16920E-03 0 -0.14789E-02 diff --git a/src/programs/Simulation/HDGeant/storeTrajectory.c b/src/programs/Simulation/HDGeant/storeTrajectory.c deleted file mode 100644 index 7af55536a7..0000000000 --- a/src/programs/Simulation/HDGeant/storeTrajectory.c +++ /dev/null @@ -1,166 +0,0 @@ - - -#include - -#include - -extern s_HDDM_t* thisOutputEvent; - -unsigned int Npoints=0; -unsigned int Maxpoints; -int last_track_num; -int last_stack_num; -int track_id; -s_McTrajectoryPoint_t *traj_points = NULL; - -/*--------------------- -// cleartrajectories_ -//--------------------*/ -void cleartrajectories_(void) -{ - Npoints = 0; - - /* First time through, allocate buffer for trajectory points */ - if(traj_points==NULL){ - Maxpoints = 100000; - traj_points = (s_McTrajectoryPoint_t*)malloc(Maxpoints*sizeof(s_McTrajectoryPoint_t)); - } - - last_track_num = -1; - last_stack_num = -1; - track_id = 0; -} - -/*--------------------- -// addtrajectorypoint_ -//--------------------*/ -void addtrajectorypoint_(float *VECT, float *TOFG, float *DESTEP - ,float *GEKIN, int *ITRA, int *ISTAK, int *IPART - ,float *RADL, float *STEP, int *NMEC, int* LMEC, int *storetraj) -{ - static int warned = 0; - if(!warned){ - printf("\n\n ** WARNING **\n\nYou have set the TRAJ flag to %d.\n", *storetraj); - printf("This will significantly increase the output file size.\n\n\n"); - warned = 1; - } - - /* We want to record a unique id for every particle in the event. - The value in ITRA is the primary track's number from which this - particle originated. The value in ISTAK is the stack poisition - of the current particle (ISTAK==0 means it's the primary). - Because the stack is reused during showers, there is no - combination of ITRA and ISTAK that is guaranteed to be unique - for a given particle in the event. Therefore, we need to keep - track of this ourselves. Use the track_id global to do this by - watching for changes to ITRA or increases in ISTAK. - - The variable "point_on_this_track" is used to decide whether or - not to add this as a new track point, or to overwrite the previous - track point if we're only keeping birth/death info. - */ - static int point_on_this_track = 0; - if(last_stack_num<*ISTAK || last_track_num!=*ITRA){ - track_id++; - point_on_this_track=0; - }else{ - point_on_this_track++; - } - last_track_num = *ITRA; - last_stack_num = *ISTAK; - - /* storetraj = 0 don't store trajectory info - storetraj = 1 store birth and death points of primary tracks - storetraj = 2 store birth and death points of all particles - storetraj = 3 store full trajectory of primary tracks - storetraj = 4 store full trajectory of primary tracks and birth/death points of secondaries - storetraj = 5 store full trajectory for all particles - */ - - int is_primary = (*ISTAK==0); - int store_full_traj = 0; - switch(*storetraj){ - case 0: return; - case 1: - if(!is_primary)return; - break; - case 2: - break; - case 3: - if(!is_primary)return; - store_full_traj = 1; - break; - case 4: - if(is_primary)store_full_traj=1; - break; - case 5: - store_full_traj = 1; - break; - default: - return; - } - - /* If buffer is full, print warning and return */ - static int Nwarns = 0; - if(Npoints>=Maxpoints){ - if(Nwarns<10){ - fprintf(stderr,"%s:%d Too many trajectory points to store! Dropping some.\n",__FILE__,__LINE__); - if(++Nwarns == 10)fprintf(stderr,"******** LAST WARNING!! *********\n"); - } - return; - } - - /* If we're only storing birth and death points, then backup and - overwrite the last trajectory point on this track. If it is a - different track, then don't overwrite the previous one. - */ - if(store_full_traj==0 && point_on_this_track>1 && Npoints>0)Npoints--; - - /* Finally, fill in the new trajectory point info */ - s_McTrajectoryPoint_t *p = &traj_points[Npoints++]; - - p->E = *GEKIN; - p->dE = *DESTEP; - p->part = *IPART; - p->x = VECT[0]; - p->y = VECT[1]; - p->z = VECT[2]; - p->px = VECT[6]*VECT[3]; - p->py = VECT[6]*VECT[4]; - p->pz = VECT[6]*VECT[5]; - p->t = *TOFG; - p->primary_track = *ITRA; - p->track = track_id; - p->radlen = *RADL; - p->step = *STEP; - p->mech = LMEC[*NMEC-1]; -} - -/*--------------------- -// pickMCTrajectory -//--------------------*/ -s_McTrajectory_t* pickMCTrajectory(void) -{ - unsigned int i; - - if(Npoints==0)return HDDM_NULL; - - s_McTrajectory_t* McTrajectory = make_s_McTrajectory(); - s_McTrajectoryPoints_t *points = make_s_McTrajectoryPoints(Npoints); - McTrajectory->mcTrajectoryPoints = points; - - /* copying all of this isn't really the most efficient way to do this, - but if we're actually writing all of this stuff out, then it doesn't - need to be! - */ - points->mult = 0; - for(i=0; iin[i] = traj_points[i]; - points->mult++; - } - - return McTrajectory; -} - - - diff --git a/src/programs/Simulation/HDGeant/timel.c b/src/programs/Simulation/HDGeant/timel.c deleted file mode 100644 index 40406a8853..0000000000 --- a/src/programs/Simulation/HDGeant/timel.c +++ /dev/null @@ -1,195 +0,0 @@ -/* - * $Id$ - * - * $Log$ - * Revision 1.2 2001/09/25 21:39:54 jonesrt - * -fixed problems compiling with local copy of cernlib routine timel.c - * (the cernlib team botched that routine in the 2001 libkernlib.a distribution) - * -rtj- - * - * Revision 1.2 1997/02/04 17:34:47 mclareni - * Merge Winnt and 97a versions - * - * Revision 1.1.1.1.2.1 1997/01/21 11:29:45 mclareni - * All mods for Winnt 96a on winnt branch - * - * Revision 1.1.1.1 1996/02/15 17:49:27 mclareni - * Kernlib - * - */ -#include "kerngen/pilot.h" -#if defined(CERNLIB_WINNT) -#include "wntgs/timel.c" -#elif defined(CERNLIB_QMDOS) -#include "dosgs/timel.c" -#elif defined(CERNLIB_QMIRTD) -#include "irtdgs/timel.c" -#else -/*> ROUTINE TIMEL - CERN PROGLIB# Z007 TIMEST .VERSION KERNFOR 4.39 940228 - ORIG. 01/03/85 FCA, mod 03/11/93 GF -*/ -#include -#include -#include -#include -#include -#include - -#ifndef CLOCKS_PER_SEC -#define CLOCKS_PER_SEC CLK_TCK -#endif - - -#ifndef RLIMIT_CPU -#define RLIMIT_CPU 0 /* For HP-UX... */ -#endif -#ifndef RLIM_INFINITY -#define RLIM_INFINITY 0x7fffffff /* For HP-UX... */ -#endif - -#if defined(CERNLIB_QSYSBSD)||defined(CERNLIB_QMVMI)||defined(CERNLIB_QMVAOS) -#define HZ 60.; -#endif - -#ifndef HZ -#ifdef __GNUC__ -#define HZ 1 -#else -#define HZ 1./CLOCKS_PER_SEC -#endif -#endif - -struct tms tps; -static float timlim; -static time_t timstart, timlast; -static int tml_init = 1; -float deftim = 999.; - -#if defined(CERNLIB_QX_SC) -#define timest timest_ -#define timex timex_ -#define timed timed_ -#define timel timel_ -#endif -#if defined(CERNLIB_QXCAPT) -#define timest TIMEST -#define timex TIMEX -#define timed TIMED -#define timel TIMEL -#endif - - /* local routine called by timst, and time_init */ -static void time_st(timl) -float timl; -{ - times(&tps); - timlim = timl; - timstart = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime; - timlast = timstart; - tml_init = 0; - return; -} - /* local routine to start by default */ -static void time_init() -{ - struct rlimit rlimit; - float maxtime; - - maxtime=deftim; - - if (getrlimit(RLIMIT_CPU, &rlimit)==0) { - if ( rlimit.rlim_cur != RLIM_INFINITY ) - maxtime = (float) rlimit.rlim_cur; - } - - time_st(maxtime); - return; -} - -void timest(timl) -float *timl; -{ - struct rlimit rlimit; - float maxtime; - - if (tml_init != 0) { - -/* get maximum time allowed by system, and do not allow more */ - maxtime = *timl; - if (getrlimit(RLIMIT_CPU, &rlimit)==0) { - maxtime = (float) rlimit.rlim_cur; - maxtime = ( maxtime > *timl ) ? *timl : maxtime; - } - time_st(maxtime); - } - return; -} -void timex(tx) -/* -C - CERN PROGLIB# Z007 TIMEX .VERSION KERNFOR 4.39 940228 -C -*/ -float *tx; -{ - time_t timnow; - if (tml_init) { - time_init(); - *tx = 0.; - } - else { - times(&tps); - timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime; - *tx = (float) (timnow - timstart) / HZ; - } - return; -} - -void timed(td) -/* -C - CERN PROGLIB# Z007 TIMED .VERSION KERNFOR 4.39 940228 -C -*/ -float *td; -{ - time_t timnow; - if (tml_init) { - time_init(); - *td = timlim; - } - else { - times(&tps); - timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime; - *td = (float) (timnow - timlast) / HZ; - timlast = timnow; - } - return; -} - -void timel(tl) -/* -C - CERN PROGLIB# Z007 TIMEL .VERSION KERNFOR 4.39 940228 -C -*/ -float *tl; -{ - time_t timnow; - if (tml_init) { - time_init(); - *tl = timlim; - } - else { - times(&tps); - timnow = tps.tms_utime+tps.tms_cutime+tps.tms_stime+tps.tms_cstime; - *tl = timlim - (float) (timnow - timstart) / HZ; - } - return; -} -#ifdef __GNUC__ -#undef time_t -#endif -/*> END <----------------------------------------------------------*/ -#endif diff --git a/src/programs/Simulation/HDGeant/trapfpe.c b/src/programs/Simulation/HDGeant/trapfpe.c deleted file mode 100644 index d065ace67e..0000000000 --- a/src/programs/Simulation/HDGeant/trapfpe.c +++ /dev/null @@ -1,22 +0,0 @@ -#ifdef TRAPFPE -#include -#endif - -void trapfpe_ () -{ - -#ifdef TRAPFPE - - fpu_control_t cw = _FPU_MASK_PM | // bypass PrecisionLoss traps - _FPU_MASK_UM | // bypass Underflow traps - // _FPU_MASK_OM | // bypass Overflow traps - // _FPU_MASK_DM | // bypass Denormalized traps - // _FPU_MASK_IM | // bypass Invalid traps - // _FPU_MASK_ZM | // bypass ZeroDivide traps - _FPU_EXTENDED; // enable extended precision - - _FPU_SETCW(cw); - -#endif - -} diff --git a/src/programs/Simulation/HDGeant/uginit.F b/src/programs/Simulation/HDGeant/uginit.F deleted file mode 100644 index fbf025af07..0000000000 --- a/src/programs/Simulation/HDGeant/uginit.F +++ /dev/null @@ -1,476 +0,0 @@ -* -* $Id$ -* -* $Log: uginit.F,v $ -* Revision 1.12 2005/01/29 19:25:30 jonesrt -* hitLGD.c -* - renamed to hitFCal.c [rtj] -* Makefile.orig -* - modified to reflect the name change for hitLGD.c [rtj] -* control.in -* - it seems that I always have touched this file at some point! [rtj] -* gustep.F -* - added argument ISTAK to argument list for hitXXX functions, so that -* they can determine whether a given track is the primary or not [rtj] -* - some of the names of volumes have been changed in the recent geometry -* update, reflect that fact in the Makefile [rtj] -* hddm_s.c, hddm_s.h -* - updated from hddm (you should generate these using hddm-c and then -* copy them over from hddm to this folder) [rtj] -* hddsGeant3.F -* - updated from hdds (you should generate this using hdds-geant and -* then copy it over from hdds to this folder) [rtj] -* uginit.F -* - added a line to switch HBOOK from //LUN3 (closed after return from -* GRFILE) back to the geant.hbook output file on unit 50 [rtj] -* hddmInput.c -* - modified to store the actual coordinates of the event vertex in the -* Monte Carlo section of the output record, in case that the vertex -* was generated by the simulator instead of the generator [rtj] -* hitXXX.c -* - modified to accommodate an extra tag primary="boolean" on all of -* the cheat tags, to tell whether the hit was produced by one of the -* original primaries, or by a secondary produced by one of them. -* - hitFTOF.c modified to accommodate two layers instead of one [rtj] -* - hitStart.c modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - modified to accommodate the segmented readout [rtj] -* - hitCerenkov.c - added a cheat tag to the Cerenkov readout [rtj] -* - all cheat tags have been modified to report all three coordinates -* (in the global reference system) instead of only two [rtj] -* -* Revision 1.11 2005/01/21 09:36:34 davidl -* Read in BFIELD and NOSECONDARIES cards and store in hdtrackparams common block -* -* Revision 1.10 2003/10/30 12:29:24 jonesrt -* README.txt: updated build procedures that work up to Redhat 9 -* hddmInput.c,hddmOutput.c: small change to hddm input/output library -* that reflects a change in the Monte Carlo hddm template. -* uginit.F: added a line to generate geometry rz file needed by g2root -* Makefile: updates to make build work under Redhat 9 and cernlib 2003 -* gelhad/Makefile: updates to make build work under Redhat 9 -* [richard.t.jones@uconn.edu] -* -* Revision 1.9 2002/07/10 19:53:08 jonesrt -* - moved open/close of hbook file from hdgeant.f to uginit.F/uglast.F so that -* it gets called from hdgeant++ [rtj] -* - fixed Makefile to make hdgeant++ export its symbols to dynamic COMIS -* functions [rtj] -* -* Revision 1.8 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.7 2002/06/28 19:01:03 jonesrt -* Major revision 1.1 -Richard Jones, Chris Gauthier, University of Connecticut -* -* 1. Added hadronic interactions for photons with the Gelhad package -* http://www.slac.stanford.edu/BFROOT/www/Computing/Offline/Simulation/gelhad.html -* Routines affected are: -* - uginit.F : added new card GELH to set up gelhad parameters and -* call to gelh_vrfy() to print out their values. -* - uglast.F : added call to gelh_last() to print out summary info. -* - gtgama.F : Gelhad replacement for standard Geant routine that adds -* simulation of hadronic photoproduction processes. -* - gelhad/ : contains a number of new functions (Fortran) and includes -* to support the hadronic photoproduction simulation. -* -* 2. Added muon-pair production by stealing every (Melectron/Mmuon)**2 pair -* production events and trying to convert to muon pairs. The deficit in -* e+/e- events resulting from this theft is negligible. The angular -* distribution of muon pairs is generated using the general Geant method -* in gpairg.F with the electron mass replaced by the muon mass. -* Routines affected are: -* - gpairg.F : added a switch to replace e+/e- with mu+/mu- in a small -* fraction of the pair-production vertices. -* -* Revision 1.6 2001/09/27 20:07:39 jonesrt -* -fixed memcheck.c to solve alpha compiler problems -* -rtj- -* -* Revision 1.5 2001/08/02 15:54:18 jonesrt -* added a check to uginit to verify that the random number generator has been -* correctly initialized with valid seeds (or sequency number 1..215 !!!) -rtj -* -* Revision 1.4 2001/08/02 03:08:05 jonesrt -* Now the BEAM data card is supported, with correct generation of -* coherent bremsstrahlung radiation. -rtj -* -* Revision 1.3 2001/07/19 23:25:51 jonesrt -* numerous new files as I develop the prototype hits libraries -rtj -* -* Revision 1.2 2001/07/15 07:31:38 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/08 06:24:35 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE UGINIT -* -************************************************************************ -* * -* To initialise GEANT3 program and read data cards * -* * -************************************************************************ -* -#include "geant321/gcflag.inc" -#include "geant321/gckine.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcscan.inc" -#include "geant321/gctrak.inc" -#include "hdtrackparams.inc" -#include "backgrounds.inc" -#include "controlparams.inc" -* - integer iskip - integer infile(20) - integer outfile(20) - common /inputFile/ iskip,infile,outfile - data iskip/0/ - data infile/20*0/ - data outfile/20*0/ - - integer bfield_type(20) - integer bfield_map(20) - integer PS_bfield_type(20) - integer PS_bfield_map(20) - common /bfieldInfo/ bfield_type,bfield_map, - + PS_bfield_type,PS_bfield_map - data bfield_type/20*0/ - data bfield_map/20*0/ - data PS_bfield_type/20*0/ - data PS_bfield_map/20*0/ - - integer postsmear - integer mcsmearopts(64) - integer deleteunsmeared - common /smearing/ postsmear,mcsmearopts,deleteunsmeared - data mcsmearopts/64*0/ - data postsmear/0/ - data deleteunsmeared/0/ - - integer myrunno - data myrunno/1/ - - integer openInput, skipInput, openOutput - external openInput, skipInput, openOutput - real beamE0, beamEpeak, beamEmin, radColDist, colDiam - real beamEmit, radThick - common /beamPars/ beamE0,beamEpeak,beamEmin,radColDist,colDiam, - + beamEmit, radThick - data beamE0/0/ - data beamEpeak/0/ - data beamEmin/0/ - data radColDist/76.0/ - data colDiam/0.0034/ - data beamEmit/1e-8/ - data radThick/20e-6/ - -c The following parameters are declared in hdtrackparams.inc above. - data nosecondaries/0/ - data storetraj/0/ - data plog_particle_gun/0/ - data tlog_particle_gun/0/ - -c The following parameters are declared in controlparams.inc above. - data writenohits/0/ - data showersincol/0/ - data driftclusters/0/ - data tgtwidth/2*0/ - data get_next_evt/1/ - data trigger_time_sigma_ns/10./ - data event_count/0/ - data override_run_number/0/ - data genbeam_precol/0/ - data genbeam_postcol/0/ - data genbeam_mode/20*0/ - character*10 genbeam_modes - equivalence (genbeam_mode(1), genbeam_modes) - -c The following parameters are declared in backgrounds.inc above. - data bgrate/0/ - data bggate/0,0/ - data bgtagonly/0/ - -C Use this parameter to set up a minimum photon energy -C for the coherent bremsstrahlung beam generator - see beamgen.F - real xMinimum,freqMaximum,beamStartZ,Theta02 - common /coherentGen/xMinimum,freqMaximum,beamStartZ,Theta02 - -* -* ----------------------------------------------------------------- -* -* Initialize GEANT -C..geant.. - call trapfpe() - CALL GINIT -* -* Prints version number -* - WRITE(LOUT,1000) - 1000 FORMAT(/,' MODE VERSION 1.00 : ',/) -* -* IKINE = particle type (default=1=gamma) -* PKINE(1)=particle energy -* IKINE and PKINE can be changed with the data card KINE -* - IDRUN=-1 - PKINE(1)=10. - PKINE(5)=4. - IKINE=1 - ICOMP=1 - IPAIR=1 - IBREM=1 - IANNI=1 - IPHOT=1 - IHADR=1 - MAXNST=100000 - ILOSS=1 -* -* Make the default origin for the particle gun at 0,0,65cm -* and the default widths of vertex volume dR=0,dZ=0cm. -* - VSCAN(1)=0 - VSCAN(2)=0 - VSCAN(3)=65 - tgtwidth(1)=0. - tgtwidth(2)=0. -* -* Initialize GEANT/ZBOOK data structures -* -C..geant.. - CALL GZINIT -* -* Define user FFREAD data cards (format free input) -* -* -* Read the data cards -* - OPEN(UNIT=4,FILE='control.in',STATUS='UNKNOWN') - CALL FFSET('LINP',4) - CALL FFSET('SIZE',16) - call ffkey('infile',infile,20,'MIXED') - call ffkey('skip',iskip,1,'INTEGER') - call ffkey('outfile',outfile,20,'MIXED') - call ffkey('postsmear',postsmear,1,'INTEGER') - call ffkey('mcsmearopts',mcsmearopts,64,'MIXED') - call ffkey('deleteunsmeared',deleteunsmeared,1,'INTEGER') - call ffkey('beam',beamE0,7,'REAL') - call ffkey('genbeam',genbeam_mode,20,'MIXED') - call ffkey('bfieldmap', bfield_map,20,'MIXED') - call ffkey('bfieldtype', bfield_type,20,'MIXED') - call ffkey('psbfieldmap', PS_bfield_map,20,'MIXED') - call ffkey('psbfieldtype', PS_bfield_type,20,'MIXED') - call ffkey('nosecondaries', nosecondaries,1,'INTEGER') - call ffkey('trajectories', storetraj,1,'INTEGER') - call ffkey('plog', plog_particle_gun,1,'INTEGER') - call ffkey('tlog', tlog_particle_gun,1,'INTEGER') - CALL FFKEY('bgrate',bgrate,1,'REAL') - CALL FFKEY('bggate',bggate,2,'REAL') - CALL FFKEY('bgtagonly',bgtagonly,1,'INTEGER') - CALL FFKEY('savehits',writenohits,1,'INTEGER') - CALL FFKEY('showersincol',showersincol,1,'INTEGER') - call FFKEY('driftclusters',driftclusters,1,'INTEGER') - call FFKEY('tgtwidth',tgtwidth,2,'REAL') - call FFKEY('trefsigma',trigger_time_sigma_ns,1,'REAL') - call gtgamaff() - CALL GFFGO -* -* Verify that the random number seeds are OK -* - call GRNDMQ(iseed1,iseed2,0,'G') - if ((iseed1.eq.0).and.(iseed2.eq.0)) then - write(LOUT,980) 'UGINIT error: ' -980 format(a14,'initial random number generator seeds are 0!') - stop 'cannot continue without good random numbers' - endif -* -* Open the input stream -* -c nevent = 0 - if (infile(1) .gt. 0) then - ifail = openInput(infile) - if (ifail .ne. 0) then - write(lout,9000) infile - 9000 format('GUKINE ERROR - Could not open input stream ',20a4) - stop - endif - get_next_evt=0 -* Get the run number from the input file - call extractRunNumber(myrunno) -* .. but override it with the RUNG card if IDRUN>0 - if (IDRUN.lt.0) then - IDRUN=myrunno - else - override_run_number=1 - endif - - write(6,*) 'run number ',IDRUN,override_run_number - if (iskip .gt. 0) then - ifail = skipInput(iskip) - endif -c if (nevent .eq. 0) then -c nevent = 999999999 -c endif - endif -* -* Open the output stream -* - if (outfile(1) .ne. 0) then - ifail = openOutput(outfile) - if (ifail .ne. 0) then - write(lout,9010) outfile - 9010 format('GUKINE ERROR - Could not open output stream ',20a4) - stop - endif - endif -* -* Assign the beam parameters -* - if (beamEmin.lt.0) then - print * - print *, 'Error in uginit:', - + ' beamEmin is specified with negative value,', - + ' cannot continue.' - stop - endif - - if (genbeam_mode(1).ne.0.and.beamE0.gt.0.and.infile(1).eq.0) then - call CUTOL(genbeam_modes) - if (genbeam_modes(1:6).eq.'precol') then - genbeam_precol = 1 - elseif (genbeam_modes(1:7).eq.'postcol') then - genbeam_postcol = 1 - else - print *, 'uginit.F: GENBEAM option ', genbeam_modes, - + ' is not supported in this release of hdgeant,', - + ' cannot continue.' - stop - endif - - - endif - - if(showersincol.ne.0) then - print *,'uginit.F: Enable showers in the primary collimator' - endif - - if(writenohits.ne.0) then - print *, 'uginit.F: Enable writing events with no hits in the', - + ' detector to the hddm output file' - endif - - -* Scale BG rate according to the threshold set on energy of bremsstrahlung -* photons. bgrate corresponds to Rate(E_brem = 0.12 GeV). -* -* Note added by RTJ, March 4, 2017 -* I am disabling this ad-hoc formula for automatically adjusting BGRATE -* according to the beamEmin value, because it assumes too much: -* (1) that the collimator is 3.4mm -- generally NOT true, and -* (2) that the value of Emin is low enough that BGRATE is insensitive -* to the diamond orientation. -* All of this relies too much on the user understanding the limits -* of the approximations involved, and I think in the end users are -* being fooled into thinking the simulation is valid for a given set -* of collimators and energy cuts when it isn't. In its place, I am -* adding an explanation in control.in that whenever you enable the -* BGRATE card, you need to do a quick calculation to get the right -* number to give for the rate that matches with the value of beamEmin -* that is set in the BEAM card. - - if (beamEmin.gt.0) then -* bgrate = bgrate*(0.12*9.1625*LOG(0.12/beamEmin)/4.936 + 1.0) - xMinimum = beamEmin/beamE0 - print *,'uginit.F: BGRATE rate is ',bgrate - endif - - if (bgrate .lt. 0) then - print * - print *, 'Error in uginit:', - + ' BGRATE specified with negative value,', - + ' cannot continue.' - stop - elseif (bggate(1) .gt. bggate(2)) then - print * - print *, 'Error in uginit:', - + ' BGGATE specified with negative interval,', - + ' cannot continue.' - stop - endif - if (beamE0 .gt. 0) then - call cobrems(beamE0,beamEpeak,beamEmit,radThick, - + radColDist,colDiam,0) - elseif (infile(1) .eq. 0) then - continue ! single-particle gun (mode 1), ignore background gen. - elseif (bgrate .gt. 0) then - print * - print *, 'Error in uginit:', - + ' BGRATE specified without BEAM card,', - + ' cannot continue.' - stop - endif -* -* Initialize graphics package -* - CALL GDINIT -* -* Initialize the Hall D geometry -* - call HDDSgeant3_wrapper -* if (runtime_geom .eq. 0) then -* call HDDSgeant3 -* else -* call HDDSgeant3_runtime -* endif - call Goptimize -* Set some default value for run number if not set otherwise - if (IDRUN.lt.0) IDRUN=1 - call initcalibdb(bfield_type, bfield_map, PS_bfield_type, - + PS_bfield_map, IDRUN) - call copytocplusplus(infile,outfile,postsmear,mcsmearopts - +,deleteunsmeared) - call copygatetocplusplus(bggate(1), bggate(2)) -* -* Open the HBOOK file for output -* - call HROPEN(50,'RZfile','geant.hbook','N',65536,istat) -* -* Initialize GEANT tracking structures -* -C..geant.. - CALL GGCLOS - CALL GPART - CALL GPHYSI - CALL GRFILE(3,'hdgeant.rz','ON') - CALL HCDIR('//RZfile',' ') -* -* Initialize the GELHAD package and verify parameters -* - call gelh_vrfy() -* -* Load FLUKA and MICAP cross section data if selected -* - if (IHADR.ge.3) call FLINIT - if (IHADR.eq.4) call GMORIN - - call gidClear() - - END diff --git a/src/programs/Simulation/HDGeant/uglast.F b/src/programs/Simulation/HDGeant/uglast.F deleted file mode 100644 index 1bece945a0..0000000000 --- a/src/programs/Simulation/HDGeant/uglast.F +++ /dev/null @@ -1,81 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.5 2002/07/10 19:53:08 jonesrt -* - moved open/close of hbook file from hdgeant.f to uginit.F/uglast.F so that -* it gets called from hdgeant++ [rtj] -* - fixed Makefile to make hdgeant++ export its symbols to dynamic COMIS -* functions [rtj] -* -* Revision 1.4 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.3 2002/06/28 19:01:03 jonesrt -* Major revision 1.1 -Richard Jones, Chris Gauthier, University of Connecticut -* -* 1. Added hadronic interactions for photons with the Gelhad package -* http://www.slac.stanford.edu/BFROOT/www/Computing/Offline/Simulation/gelhad.html -* Routines affected are: -* - uginit.F : added new card GELH to set up gelhad parameters and -* call to gelh_vrfy() to print out their values. -* - uglast.F : added call to gelh_last() to print out summary info. -* - gtgama.F : Gelhad replacement for standard Geant routine that adds -* simulation of hadronic photoproduction processes. -* - gelhad/ : contains a number of new functions (Fortran) and includes -* to support the hadronic photoproduction simulation. -* -* 2. Added muon-pair production by stealing every (Melectron/Mmuon)**2 pair -* production events and trying to convert to muon pairs. The deficit in -* e+/e- events resulting from this theft is negligible. The angular -* distribution of muon pairs is generated using the general Geant method -* in gpairg.F with the electron mass replaced by the muon mass. -* Routines affected are: -* - gpairg.F : added a switch to replace e+/e- with mu+/mu- in a small -* fraction of the pair-production vertices. -* -* Revision 1.2 2001/07/24 05:37:19 jonesrt -* First working prototype of hits package -rtj -* -* Revision 1.1 2001/07/08 06:24:35 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE UGLAST -* -************************************************************************ -* * -* Termination routine to print histograms and statistics * -* * -************************************************************************ -#include "geant321/gcomis.inc" -* -* ----------------------------------------------------------------- -* - call gelh_last() - CALL GLAST -* -* Close HIGZ -* - CALL IGEND -* - call HROUT(0,icycle,' ') - call HREND('RZfile') - call closeOutput() - END diff --git a/src/programs/Simulation/HDGeant/utilities/SConscript b/src/programs/Simulation/HDGeant/utilities/SConscript deleted file mode 100644 index 499177c054..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/SConscript +++ /dev/null @@ -1,17 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddCERNLIB(env) -sbms.AddDANA(env) -sbms.AddROOT(env) - -env.AppendUnique(CPPPATH = '#libraries/HDDM') - -sbms.executables(env) - - diff --git a/src/programs/Simulation/HDGeant/utilities/bcal2nt.cpp b/src/programs/Simulation/HDGeant/utilities/bcal2nt.cpp deleted file mode 100644 index d7fb161e13..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/bcal2nt.cpp +++ /dev/null @@ -1,146 +0,0 @@ -/* - * bcal2nt - an simple program for accessing the bcal information - * of events stored in a hddm file, and storing them in - * a paw ntuple. - * - * Richard Jones - * GlueX collaboration - * May 15, 2005 - * - */ - -#include -#include -#include - -extern "C" { - - struct bcalnt_struct { - int event; - int module; - int layer; - int sector; - int nhit; - float t[200]; - float E[200]; - } bcalnt; - - #define BCALNT_FORM "event:i,module:i,layer:i,sector:i,nhit[0,200]:i,t(nhit):r,E(nhit):r,z(nhit):r" - - #define PAWC_SIZE 1000000 - struct { - float q[PAWC_SIZE]; - } pawc_; - - struct { - int iq[100]; - } quest_; - - void hlimit(int size) - { - void hlimit_(int *words); - hlimit_(&size); - } - void hbset(const char* name, int *value, int *istat) - { - void hbset_(const char *,int *,int *,int); - hbset_(name, value, istat, strlen(name)); - } - void hropen(int lun, const char *name, const char *filename, const char *status, int *lrec, int *istat) - { - void hropen_(int *,const char *,const char *,const char *,int *,int *,int,int,int); - hropen_(&lun, name, filename, status, lrec, istat, strlen(name), - strlen(filename), strlen(status)); - } - void hbnt(int id,const char*chtitle,const char*chopt) - { - void hbnt_(int *id ,const char* name, const char* chmod,int ,int); - hbnt_(&id,chtitle,chopt,strlen(chtitle),strlen(chopt)); - } - void hbname(int id,const char*chblok,void*variable,const char*chform) - { - void hbname_(int *id, const char* chblok, void*variable, const char*chform, int,int); - hbname_(&id,chblok,variable,chform,strlen(chblok),strlen(chform)); - } - void hfnt(int id) - { - void hfnt_(int*id); - hfnt_(&id); - } - void hrend(const char*filename) - { - void hrend_(const char *,int); - hrend_(filename, strlen(filename)); - return; - } - void hrout(int num, int *icycle, const char *opt) - { - void hrout_(int *,int *,const char *,int); - hrout_(&num, icycle, opt, strlen(opt)); - } - -} - -int process_event(hddm_s::HDDM &event); - -int main(int argc, char **argv) -{ - int input; - int lrec=65536; - int status; - int cycle=1; // initialize to 1 just to avoid compiler warnings - - hlimit(PAWC_SIZE); - hbset("BSIZE",&lrec,&status); - quest_.iq[9] = 256000; // extend RZ quota to 2^32 bits - hropen(50,"RZfile","bcal2nt.hbook","NQE",&lrec,&status); - hbnt(1,"BCal diagnostic ntuple"," "); - hbname(1,"bcalnt",&bcalnt,BCALNT_FORM); - - hddm_s::HDDM record; - for (input=1; input> record; - process_event(record); - record.clear(); - } - } - hrout(1,&cycle," "); - hrend("RZfile"); -} - -int process_event(hddm_s::HDDM &event) -{ - hddm_s::HitViewList views = event.getHitViews(); - if (views.size() == 0) { - std::cerr << "no hits information in this file, quitting!" - << std::endl; - exit(1); - } - - hddm_s::BcalCellList cells = event.getBcalCells(); - hddm_s::BcalCellList::iterator iter; - for (iter = cells.begin(); iter != cells.end(); ++iter) { - bcalnt.event = iter->getEventNo(); - bcalnt.module = iter->getModule(); - bcalnt.layer = iter->getLayer(); - bcalnt.sector = iter->getSector(); - hddm_s::BcalTruthHitList hits = iter->getBcalTruthHits(); - hddm_s::BcalTruthHitList::iterator hiter; - int hit=0; - for (hiter = hits.begin(); hiter != hits.end(); ++hiter, ++hit) { - bcalnt.t[hit] = hiter->getT(); - bcalnt.E[hit] = hiter->getE(); - } - bcalnt.nhit = hits.size(); - hfnt(1); - } - return 1; -} diff --git a/src/programs/Simulation/HDGeant/utilities/bcal2nt_c.c b/src/programs/Simulation/HDGeant/utilities/bcal2nt_c.c deleted file mode 100644 index c1b27749e5..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/bcal2nt_c.c +++ /dev/null @@ -1,145 +0,0 @@ -/* - * bcal2nt - an simple program for accessing the bcal information - * of events stored in a hddm file, and storing them in - * a paw ntuple. - * - * Richard Jones - * GlueX collaboration - * May 15, 2005 - * - */ - -#include -#include -#include - -struct bcalnt_struct { - int event; - int module; - int layer; - int sector; - int nhit; - float t[200]; - float E[200]; -} bcalnt; - -#define BCALNT_FORM "event:i,module:i,layer:i,sector:i,nhit[0,200]:i,t(nhit):r,E(nhit):r,z(nhit):r" - -#define PAWC_SIZE 1000000 -struct { - float q[PAWC_SIZE]; -} pawc_; - -struct { - int iq[100]; -} quest_; - -void hlimit(int size) -{ - void hlimit_(int *words); - hlimit_(&size); -} -void hbset(char* name, int *value, int *istat) -{ - void hbset_(char *,int *,int *,int); - hbset_(name, value, istat, strlen(name)); -} -void hropen(int lun, char *name, char*filename, char*status, int *lrec, int *istat) -{ - void hropen_(int *,char *,char *,char *,int *,int *,int,int,int); - hropen_(&lun, name, filename, status, lrec, istat, strlen(name), - strlen(filename), strlen(status)); -} -void hbnt(int id,char*chtitle,char*chopt) -{ - void hbnt_(int *id ,char* name, char* chmod,int ,int); - hbnt_(&id,chtitle,chopt,strlen(chtitle),strlen(chopt)); -} -void hbname(int id,char*chblok,void*variable,char*chform) -{ - void hbname_(int *id, char* chblok, void*variable, char*chform, int,int); - hbname_(&id,chblok,variable,chform,strlen(chblok),strlen(chform)); -} -void hfnt(int id) -{ - void hfnt_(int*id); - hfnt_(&id); -} -void hrend(char*filename) -{ - void hrend_(char *,int); - hrend_(filename, strlen(filename)); - return; -} -void hrout(int num, int *icycle, char*opt) -{ - void hrout_(int *,int *,char *,int); - hrout_(&num, icycle, opt, strlen(opt)); -} - -int process_event(s_HDDM_t *event); - -int main(int argc, char **argv) -{ - s_HDDM_t *thisInputEvent = 0; - s_iostream_t *thisInputFile = 0; - int input; - int lrec=65536; - int status; - int cycle; - - hlimit(PAWC_SIZE); - hbset("BSIZE",&lrec,&status); - quest_.iq[9] = 256000; // extend RZ quota to 2^32 bits - hropen(50,"RZfile","bcal2nt.hbook","NQE",&lrec,&status); - hbnt(1,"BCal diagnostic ntuple"," "); - hbname(1,"bcalnt",&bcalnt,BCALNT_FORM); - - for (input=1; inputphysicsEvents->in[0].hitView) == HDDM_NULL) { - fprintf(stderr,"no hits information in this file, quitting!\n"); - exit(1); - } - - if (hits->barrelEMcal != HDDM_NULL) { - s_BcalCells_t *cells = hits->barrelEMcal->bcalCells; - int cell; - for (cell=0; cell < cells->mult; cell++) { - s_BcalTruthHits_t *hits = cells->in[cell].bcalTruthHits; - int hit; - bcalnt.event = event->physicsEvents->in[0].eventNo; - bcalnt.module = cells->in[cell].module; - bcalnt.layer = cells->in[cell].layer; - bcalnt.sector = cells->in[cell].sector; - for (hit=0; hit < hits->mult; hit++) { - bcalnt.t[hit] = hits->in[hit].t; - bcalnt.E[hit] = hits->in[hit].E; - } - bcalnt.nhit = hit; - hfnt(1); - } - return 1; - } - else { - return 0; - } -} diff --git a/src/programs/Simulation/HDGeant/utilities/cdccount.cpp b/src/programs/Simulation/HDGeant/utilities/cdccount.cpp deleted file mode 100644 index 9ac650e0ff..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/cdccount.cpp +++ /dev/null @@ -1,45 +0,0 @@ -/* - * cdccount - an example program for accessing the contents - * of events stored in a hddm file. - * - * Richard Jones - * GlueX collaboration - * January 14, 2012 - * - */ - -#include -#include -#include -#include - -int process_event(hddm_s::HDDM &event); - -int main(int argc, char **argv) -{ - hddm_s::HDDM record; - int events_with_hits = 0; - int events = 0; - for (int input=1; input> record; - events_with_hits += process_event(record); - record.clear(); - ++events; - } - } - printf("Total events seen %d, with cdc hits %d.\n",events,events_with_hits); -} - -int process_event(hddm_s::HDDM &event) -{ - hddm_s::CdcTruthPointList truthPoints = event.getCdcTruthPoints(); - return truthPoints.size(); -} diff --git a/src/programs/Simulation/HDGeant/utilities/cdccount_c.c b/src/programs/Simulation/HDGeant/utilities/cdccount_c.c deleted file mode 100644 index 45a3812254..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/cdccount_c.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * cdccount - an example program for accessing the contents - * of events stored in a hddm file. - * - * Richard Jones - * GlueX collaboration - * January 10, 2005 - * - */ - -#include -#include -#include - -int process_event(s_HDDM_t *event); - -int main(int argc, char **argv) -{ - s_HDDM_t *thisInputEvent = 0; - s_iostream_t *thisInputFile = 0; - int events_with_hits = 0; - int events = 0; - int input; - for (input=1; inputphysicsEvents->in[0].hitView; - if (hits == HDDM_NULL || - hits->centralDC == HDDM_NULL || - hits->centralDC->cdcTruthPoints == HDDM_NULL) { - return 0; - } - //printf("New event number %d,",event->physicsEvents->in[0].eventNo); - //printf(" run number %d\n",event->physicsEvents->in[0].runNo); - points = hits->centralDC->cdcTruthPoints; - //printf(" found %d cdcTruthPoints!\n",points->mult); - int ipoint; - int count=0; - for (ipoint=0; ipointmult; ipoint++) { - s_CdcTruthPoint_t *point = &points->in[ipoint]; - if (fabs(point->dradius-19.5) < 0.5e5) { - //printf(" dradius=%f,",point->dradius); - //printf(" phi=%f,",point->phi); - //printf(" primary=%s,",point->primary ? "true":"false"); - //printf(" r=%f,",point->r); - //printf(" track=%f,",point->track); - //printf(" z=%f,",point->z); - //printf(" dE/dx=%f\n",point->dEdx * 1e6); - } - ++count; - } - return count; -} diff --git a/src/programs/Simulation/HDGeant/utilities/cdcdump.cpp b/src/programs/Simulation/HDGeant/utilities/cdcdump.cpp deleted file mode 100644 index 6c43d74f11..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/cdcdump.cpp +++ /dev/null @@ -1,60 +0,0 @@ -/* - * cdcdump - an example program for accessing the contents - * of events stored in a hddm file. - * - * Richard Jones - * GlueX collaboration - * January 10, 2005 - * - */ - -#include -#include -#include - -int process_event(hddm_s::HDDM &event); - -int main(int argc, char **argv) -{ - hddm_s::HDDM record; - int input; - for (input=1; input> record; - process_event(record); - record.clear(); - } - } -} - -int process_event(hddm_s::HDDM &event) -{ - std::cout << "New event number " << event.getPhysicsEvent().getEventNo() - << " run number " << event.getPhysicsEvent().getRunNo() - << std::endl; - - hddm_s::CdcTruthPointList truths = event.getCdcTruthPoints(); - std::cout << " found " << truths.size() << " cdcTruthPoints!" - << std::endl; - - hddm_s::CdcTruthPointList::iterator iter; - for (iter = truths.begin(); iter != truths.end(); ++iter) { - if (fabs(iter->getDradius()-19.5) < 0.5e5) { - std::cout << " dradius=" << iter->getDradius() << "," - << " phi=" << iter->getPhi() << "," - << " primary=" << ((iter->getPrimary())? "true,":"false,") - << " r=" << iter->getR() << "," - << " track=" << iter->getTrack() << "," - << " z=" << iter->getZ() << "," - << " dE/dx=" << iter->getDEdx()*1e6 << std::endl; - } - } - return 1; -} diff --git a/src/programs/Simulation/HDGeant/utilities/cdcdump_c.c b/src/programs/Simulation/HDGeant/utilities/cdcdump_c.c deleted file mode 100644 index da1918aa9b..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/cdcdump_c.c +++ /dev/null @@ -1,65 +0,0 @@ -/* - * cdcdump - an example program for accessing the contents - * of events stored in a hddm file. - * - * Richard Jones - * GlueX collaboration - * January 10, 2005 - * - */ - -#include -#include -#include - -int process_event(s_HDDM_t *event); - -int main(int argc, char **argv) -{ - s_HDDM_t *thisInputEvent = 0; - s_iostream_t *thisInputFile = 0; - int input; - for (input=1; inputphysicsEvents->in[0].hitView; - if (hits == HDDM_NULL || - hits->centralDC == HDDM_NULL || - hits->centralDC->cdcTruthPoints == HDDM_NULL) { - return 0; - } - printf("New event number %d,",event->physicsEvents->in[0].eventNo); - printf(" run number %d\n",event->physicsEvents->in[0].runNo); - points = hits->centralDC->cdcTruthPoints; - printf(" found %d cdcTruthPoints!\n",points->mult); - int ipoint; - for (ipoint=0; ipointmult; ipoint++) { - s_CdcTruthPoint_t *point = &points->in[ipoint]; - if (fabs(point->dradius-19.5) < 0.5e5) { - printf(" dradius=%f,",point->dradius); - printf(" phi=%f,",point->phi); - printf(" primary=%s,",point->primary ? "true":"false"); - printf(" r=%f,",point->r); - printf(" track=%d,",point->track); - printf(" z=%f,",point->z); - printf(" dE/dx=%f\n",point->dEdx * 1e6); - } - } - return 1; -} diff --git a/src/programs/Simulation/HDGeant/utilities/hddmcp.cpp b/src/programs/Simulation/HDGeant/utilities/hddmcp.cpp deleted file mode 100644 index 2e67dd4a24..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/hddmcp.cpp +++ /dev/null @@ -1,66 +0,0 @@ -/* - * hddmcp - a utility program for copying from one hddm file to another, - * and in the process stripping out everything except a desired - * subset of the data fields. The template for the output hddm - * file (a subset of what is found in the input hddm file) is - * assumed to have already been created, perhaps by grabbing the - * header from the input hddm file into your favorite text editor, - * stripping out the desired parts, and saving the resulting xml - * template into a new file called x.hddm, which then must be - * processed into c++ using the following command. - * - * $ hddm-cpp x.hddm - * - * Richard Jones - * GlueX collaboration - * January 14, 2012 - * - */ - -#include -#include -#include - -int main(int argc, char **argv) -{ - int input, output; - if (argc < 2) { - std::cerr << "Usage: hddmcp ... " - << std::endl; - exit(1); - } - else { - output = argc-1; - } - - std::ofstream ofs(argv[output]); - if (!ofs.is_open()) { - std::cerr << "Usage: hddmcp ... " - << std::endl; - exit(1); - } - hddm_s::ostream ostr(ofs); - ostr.setCompression(hddm_s::k_bz2_compression); - - std::ifstream ifs; - hddm_s::HDDM record; - for (input=1; input> record; - ostr << record; - record.clear(); - ++count; - } - } - } -} diff --git a/src/programs/Simulation/HDGeant/utilities/hddmcp_c.c b/src/programs/Simulation/HDGeant/utilities/hddmcp_c.c deleted file mode 100644 index 3365572476..0000000000 --- a/src/programs/Simulation/HDGeant/utilities/hddmcp_c.c +++ /dev/null @@ -1,53 +0,0 @@ -/* - * hddmcp - a utility program for copying from one hddm file to another, - * and in the process stripping out everything except a desired - * subset of the data fields. The template for the output hddm - * file (a subset of what is found in the input hddm file) is - * assumed to have already been created, perhaps by grabbing the - * header from the input hddm file, stripping out the desired parts - * and dumping the resulting template into a new file called x.hddm, - * which then must be processed into c using the following command. - * - * $ hddm-c x.hddm - * - * Richard Jones - * GlueX collaboration - * October 6, 2009 - * - */ - -#include -#include -#include - -int main(int argc, char **argv) -{ - s_HDDM_t *thisInputEvent = 0; - s_iostream_t *thisInputFile = 0; - s_iostream_t *thisOutputFile = 0; - int input, output; - if (argc < 2) { - printf("Usage: hddmcp ... \n"); - exit(1); - } - else { - output = argc-1; - } - thisOutputFile = init_s_HDDM(argv[output]); - for (input=1; input0.15 GeV, matching the total - photoproduction cross section. It can be used to calculate the hadronic - background for GLUEX etc. - The photon beam spectrum is calculated using the code from R.Jones for - the coherent bremsstrahlung. - - There are two effective energy ranges: - 1) E>3 GeV : PYTHIA is used - 2) 0.15 PYTHIA particle codes - - particle.dat - a list of particle properties used for the low energy mode (2) - - One file is used to control the job and to set the number of events to simulate, - the energy range etc. - - fort.15 linked to run.ffr - list of commands and definitions in the FFREAD format - An example of the file is attached: -------------------------------------------------------------------- -LIST -C -C === INPUT file for BGGEN -C -TRIG 395000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -RUNNO 9000 run number of generated events, default is two -C -C -- writing out events -C HDDM simple ntuple -WROUT 1 1 1 - -NPRIEV 100 number of events to print -EPHLIM 0.15 12. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 12. electron beam energy -EPEAK 9. coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -STOP -------------------------------------------------------------------- - - - - Compilation: - > cd code - > make - makes ./.bin/bggen - - - Running: - > cd ../run/ - > ../code/.bin/*/bggen > log - - Output files: - - bggen.his - histograms - - 1) bggen.hddm - HDDM file with events - 2) bggen.dat - sequential file with events - 3) bggen.nt - CW-ntuple with events - See the flag WROUT. - - - In order to study the output one can use the ntuple: - > cd ../paw/ - PAW> exec example_1 - plots several variables of interest - - A code to read the output file bggen.dat: - > cd ../paw/ - > make - > ./bgg_read.exe - - An example of the event printout is attached. - The first 2 lines describe the beam and the target particles: - 1) GEANT code - 2) Particle Data Group code (PDG) = KF (PYTHIA) - 3) mass - 4)-6) - 3-momentum - The next lines are the secondary particles: - 1) # - 2) GEANT code - 3)-7) PYTHIA-type codes: - - k1 =1 - final particle, <>1 - intermediate particle (not to be used with GEANT) - - k2 =KF=PDG code - - k3 >0 - reference to the origin particle #=k3 - - k4 >0 - the first # of the decay product - - k5 >0 - the last # of the decay product - 8) mass - 9)-11) - 3-momentum - - Event 95 Process= 0 PYTHIA - GEANT PDG mass Px Py Pz - beam 1 22 0.0000 0.000 0.000 11.896 - target 14 2212 0.9383 0.000 0.000 0.000 - # GEANT k1 kf=PDG origin decay pr mass Px Py Pz - 1 0 12 -2 0 5 5 0.3300 -0.098 0.112 2.564 - 2 0 11 2 0 5 5 0.3300 0.104 -0.043 0.364 - 3 0 12 2 0 8 8 0.3300 0.098 -0.112 9.123 - 4 0 11 2101 0 8 8 0.5793 -0.104 0.043 -0.156 - 5 0 11 91 1 6 7 0.9954 0.006 0.069 2.929 - 6 9 1 -211 5 0 0 0.1396 0.060 0.212 1.116 - 7 0 11 213 5 13 14 0.6969 -0.054 -0.143 1.813 - 8 0 11 92 3 9 12 3.8021 -0.006 -0.069 8.968 - 9 17 1 221 8 0 0 0.5475 0.226 0.286 1.786 - 10 8 1 211 8 0 0 0.1396 0.157 -0.346 4.118 - 11 0 11 331 8 15 17 0.9579 0.101 0.016 1.864 - 12 13 1 2112 8 0 0 0.9396 -0.491 -0.025 1.199 - 13 8 1 211 7 0 0 0.1396 -0.009 -0.169 1.788 - 14 7 1 111 7 0 0 0.1350 -0.045 0.026 0.025 - 15 7 1 111 11 0 0 0.1350 0.105 0.085 0.225 - 16 7 1 111 11 0 0 0.1350 0.117 -0.065 0.373 - 17 17 1 221 11 0 0 0.5475 -0.120 -0.004 1.266 - Event 96 Process= 1 p pi0 - beam 1 22 0.0000 0.000 0.000 0.267 - target 14 2212 0.9383 0.000 0.000 0.000 - 1 14 1 2212 0 0 0 0.9383 0.067 -0.114 0.334 - 2 7 1 111 0 0 0 0.1350 -0.067 0.114 -0.067 - Event 97 Process= 4 p rho0 - beam 1 22 0.0000 0.000 0.000 1.387 - target 14 2212 0.9383 0.000 0.000 0.000 - 1 14 1 2212 0 0 0 0.9383 0.363 0.120 0.715 - 2 0 10 113 0 3 4 0.7616 -0.363 -0.120 0.673 - 3 8 1 211 2 0 0 0.1396 -0.063 0.245 0.473 - 4 9 1 -211 2 0 0 0.1396 -0.300 -0.365 0.200 - - - The output printout contains: - ==================================================================================================== - Events Simulated: 10000 Reference interaction rate: 394.67 kHz - process events fraction range - ---------------------------------------------------------------------------------------------------- - 0 PYTHIA 2161 21.6 % 3.000 - write out the HDDS file (events) (F) -C (2)>0 - write out a sequential file -C (3)>0 - write out an ntuple file - + ,LUNWR ! (1) LUN for HDDS file -C (2) LUN for the sequential file -C (3) LUN for the ntuple file - + ,IRND_SEQ ! the random number sequence (each integer number gives a different sequence) (F) - + ,NPRIEV ! number of events to print - + ,IDBEAM ! histogram ID for the beam (=0 - fixed energy) (F) - + ,NHBEA ! number of bins in IDBEAM - + ,IFPYTH ! PYTHIA is used - + ,IDLOWEN ! <>0 - starting ID of histograms for the low energy generator - INTEGER IPLUND ! PYTHIA particle codes (KF) - + ,IDECLUND ! =0 - forbid the decays of this particle in PYTHIA - INTEGER KCGEAN ! GEANT code for the PYTHIA internal code KC (with sign) - REAL EPH_LIM ! limits on the photon beam energy GeV (F) - + ,EELEC ! electron beam energy (F) - + ,EPEAK ! energy of the coherent peak (the right edge) (F) - + ,DCOLL ! collimator diameter (m) (F) - + ,ZCOLL ! distance to the collimator (cm) (F) - + ,EEMIT ! emittance of the electron beam (m rad) - + ,RADT ! thickness of the diamond radiator (m) - + ,EPYMIN ! minimal energy for PYTHIA, (F) -C below that the low energy generator is used -C the value may be adjusted to the bin boundary of IDBEA - + ,ELOWMIN ! minimal energy for the low energy generator (F) - + ,RATESEC ! reference interation rate (Hz), calculated - + ,VERTEX ! Vertex set in HDDM output file (cm) n.b. 0,0,0 is the default which means hdgeant will use its default, 0,0,65 -C - - diff --git a/src/programs/Simulation/bggen/code/bg_end.F b/src/programs/Simulation/bggen/code/bg_end.F deleted file mode 100644 index 59cc121b8f..0000000000 --- a/src/programs/Simulation/bggen/code/bg_end.F +++ /dev/null @@ -1,39 +0,0 @@ - SUBROUTINE BG_END -C -C--- End of the job for BG simulation -C - IMPLICIT NONE -C - INCLUDE 'bg_ctrl.inc' -C - INTEGER icycle,lun,lrec,idnt,iost -C - IF(IWROUT(1).NE.0) THEN - CALL CLOSE_HDDM_OUTPUT - ENDIF -C - IF(IWROUT(2).NE.0) THEN - CLOSE(UNIT=LUNWR(2)) - WRITE(6,*) ' Closed output data file LUN=',LUNWR(2) - ENDIF -C - IF(IWROUT(3).NE.0) THEN - icycle=0 - idnt=9 - CALL HCDIR('//bgkin',' ') - CALL HROUT(idnt,icycle,' ') - CALL HREND('bgkin') - CLOSE(UNIT=LUNWR(3)) - WRITE(6,*) ' Closed output ntuple file LUN=',LUNWR(3) - ENDIF -C - lun=9 - lrec=1024 - CALL HROPEN(lun,'HISOUT','bggen.his','N',lrec,iost) - CALL HROUT(0,icycle,' ') - CALL HREND('HISOUT') - CLOSE(UNIT=lun) - WRITE(6,*) ' Histograms written to file bggen.his' -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen/code/bg_eve.F b/src/programs/Simulation/bggen/code/bg_eve.F deleted file mode 100644 index 9b32f4bbba..0000000000 --- a/src/programs/Simulation/bggen/code/bg_eve.F +++ /dev/null @@ -1,146 +0,0 @@ - SUBROUTINE BG_EVE(IPRI) -C -C--- Simulates one BG event -C IPRI>0 - print this event -C - IMPLICIT NONE - INTEGER IPRI -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_evec.inc' -C - REAL HRNDM1 - LOGICAL HEXIST -C - INTEGER i,j,ip,ierr,lout,idnt - REAL ebeam - CHARACTER cent(2)*6,cproc*16 -C - REAL ptmp1(4,2),ptmp2(4,MXTRA) ! auxill. arrays to simplify the HDDM mapping - INTEGER ifl1(6,2),ifl2(6,MXTRA) -C -C ------------------------------------------------------------------ -C - lout=6 - IEVPROC=-1 - INDUM(1)=0 - INDUM(2)=0 - cent(1)='beam ' - cent(2)='target' -C -C--- Beam energy -C - IF(IDBEAM.EQ.0.OR..NOT.HEXIST(IDBEAM)) GO TO 999 -C - ebeam=HRNDM1(IDBEAM) -C -C--- Beam/target definitions -C - ITPIN(1,1)=1 ! beam GEANT type - ITPIN(1,2)=14 ! beam target type - ITPIN(2,1)=IPLUND(ITPIN(1,1)) ! KF types - ITPIN(2,2)=IPLUND(ITPIN(1,2)) -C - DO i=1,2 - AMIN(i)=AM_PART(ITPIN(1,i)) - ENDDO - DO i=1,3 - PIN(i,1)=0. - PIN(i,2)=0. - ENDDO - PIN(3,1)=ebeam -C - NTRA=0 -C -C--- Choose the package -C - ierr=0 - IF(ebeam.LT.EPYMIN) THEN -C - CALL LOWEN_EVE(ierr) - IF(IEVPROC.GT.0) cproc=CNPROC(IEVPROC) -C - ELSE -C - CALL PYTH_EVE(ierr) - cproc='PYTHIA' -C - ENDIF - IF(ierr.NE.0) GO TO 999 -C -C--- Remove the GEANT type for the decaying particles (KF type is retained) -C needed to avoid copying these particles into GEANT -C - DO i=1,NTRA - IF(ITPTRA(2,i).NE.1.AND.ITPTRA(3,i).NE.0) ITPTRA(1,i)=0 - ENDDO -C -C--- Print the event -C - IF(IPRI.NE.0) THEN - WRITE(lout,1000) IEVENT,IEVPROC,cproc - 1000 FORMAT(' Event ',I6,' Process=',I4,3X,A16) - WRITE(lout,1005) - + (cent(i),(ITPIN(j,i),j=1,2),AMIN(i),(PIN(j,i),j=1,3),i=1,2) - 1005 FORMAT(1X,A6,3X,I3,2X,I5,3X,4X,F8.4,3X,3F8.3) - WRITE(lout,1010) - + (i,(ITPTRA(j,i),j=1,6),AMTRA(i),(PTRA(j,i),j=1,3),i=1,NTRA) - 1010 FORMAT(1X,I3,3X,I3,I6,2X,I5,3X,3I4,4X,F8.4,3X,3F8.3) - ENDIF -C -C--- Output file for HDDM -C - IF(IWROUT(1).NE.0) THEN - DO i=1,2 - DO j=1,6 - ifl1(j,i)=0 - ENDDO - ifl1(1,i)=ITPIN(1,i) - ifl1(3,i)=ITPIN(2,i) - DO j=1,3 - ptmp1(j,i)=PIN(j,i) - ENDDO - ptmp1(4,i)=SQRT(ptmp1(1,i)**2+ptmp1(2,i)**2+ptmp1(3,i)**2 - + +AMIN(i)**2) - ENDDO - DO i=1,NTRA - DO j=1,6 - ifl2(j,i)=ITPTRA(j,i) - ENDDO -C - DO j=1,3 - ptmp2(j,i)=PTRA(j,i) - ENDDO - ptmp2(4,i)=SQRT(ptmp2(1,i)**2+ptmp2(2,i)**2+ptmp2(3,i)**2 - + +AMTRA(i)**2) - ENDDO - CALL WRITE_HDDM_EVENT(RUNNO, IEVENT,IEVPROC - + ,ifl1(1,1),ptmp1(1,1) - + ,NTRA,ifl2(1,1),ptmp2(1,1)) -C write(6,1010) (i,(ifl1(j,i),j=1,6),(ptmp1(j,i),j=1,4),i=1,2) -C write(6,1010) (i,(ifl2(j,i),j=1,6),(ptmp2(j,i),j=1,4),i=1,NTRA) - ENDIF -C -C--- Sequential output file -C - IF(IWROUT(2).NE.0) THEN - WRITE(LUNWR(2)) IEVENT,IEVPROC - + ,(( ITPIN(j,i),j=1,2), AMIN(i),( PIN(j,i),j=1,3),i=1,2) - + ,NTRA,((ITPTRA(j,i),j=1,6),AMTRA(i),(PTRA(j,i),j=1,3),i=1,NTRA) - ENDIF -C -C--- NTUPLE -C - IF(IWROUT(3).NE.0) THEN - idnt=9 - CALL HFNT(idnt) - ENDIF -C - 999 CONTINUE -C write(6,*) ebeam,IEVPROC,ibin,xstot,xssum,NTRA -C - END -C - diff --git a/src/programs/Simulation/bggen/code/bg_evec.inc b/src/programs/Simulation/bggen/code/bg_evec.inc deleted file mode 100644 index b130acd15a..0000000000 --- a/src/programs/Simulation/bggen/code/bg_evec.inc +++ /dev/null @@ -1,23 +0,0 @@ -C -C--- Simulated event -C - INTEGER MXTRA - PARAMETER (MXTRA=100) - COMMON/EV_RECORD/ IEVENT,INDUM(2),IEVPROC - + ,ITPIN(2,2),AMIN(2),PIN(3,2) - + ,NTRA - + ,ITPTRA(6,MXTRA),AMTRA(MXTRA),PTRA(3,MXTRA) - INTEGER IEVENT ! event number - + ,INDUM ! dummies (for later use) - + ,IEVPROC ! the process number (=0 - PYTHIA) - + ,ITPIN ! (1,k)=GEANT type, (2,k) - KF (LUND), k=1 - beam, =2 -target - + ,NTRA ! number of particles including the beam and the target - + ,ITPTRA ! (1,k) track type (GEANT), (2-6,k) - LUND flags (KS,decays) - REAL AMIN ! masses of the beam and the target - + ,PIN ! (1-3,k) - 3-momenta, k=1 - beam, k=2 - target - + ,AMTRA ! secondary particles' masses - + ,PTRA ! 3-momenta - -C - - diff --git a/src/programs/Simulation/bggen/code/bg_hddm.c b/src/programs/Simulation/bggen/code/bg_hddm.c deleted file mode 100644 index 044138f8eb..0000000000 --- a/src/programs/Simulation/bggen/code/bg_hddm.c +++ /dev/null @@ -1,158 +0,0 @@ -#include - -#include "HDDM/hddm_s.h" - -s_iostream_t* hddmOutputStream=NULL; - -void bg_getvertex_(float myvertex[3]); - -typedef struct { - int geantid; - int mech; /* what do the values of this correspond to */ - int kfid; - int parent; - int firstdaughter; - int lastdaughter; -} keve_t; - -typedef struct { - float px; - float py; - float pz; - float en; -} peve_t; - -/*----------------- -// open_hddm_output_ -//-----------------*/ -void open_hddm_output_(const char *outputfile, int len) -{ - /* Copy FORTRAN string into a C-style string */ - char outfile[256]; - strncpy(outfile, outputfile, len); - outfile[len]=0; - - /* Open output file */ - hddmOutputStream = init_s_HDDM(outfile); - if (! hddmOutputStream) { - fprintf(stderr, "Unable to open output file \"%s\" for writing.\n", outfile); - exit(-3); - } - - printf("Opened HDDM file \"%s\" for writing ...\n", outfile); -} - -/*----------------- -// close_hddm_output_ -//-----------------*/ -void close_hddm_output_(void) -{ - /* Close output file */ - close_s_HDDM(hddmOutputStream); - - printf("Closed HDDM output file\n"); -} - -/*----------------- -// write_hddm_event_ -//-----------------*/ -void write_hddm_event_(int *runno, int *iev, int *iproc, - keve_t *kin, peve_t *pin, - int *ntra, keve_t *keve, peve_t *peve) -{ - /* Loop over events */ - int i; - static int Nevents = 0; - static int Nevents_written = 0; - int runNumber = *runno; - float vertex[3]={0.0, 0.0, 0.0}; - - Nevents++; - - /* Start a new event */ - s_PhysicsEvents_t* pes; - s_Reactions_t* rs; - s_Beam_t* bs; - s_Momentum_t *mom; - s_Properties_t *prop; - s_Target_t* ts; - s_Vertices_t* vs; - s_Origin_t* origin; - s_Products_t* ps; - - s_HDDM_t *thisOutputEvent = make_s_HDDM(); - thisOutputEvent->physicsEvents = pes = make_s_PhysicsEvents(1); - pes->mult = 1; - pes->in[0].runNo = runNumber; - pes->in[0].eventNo = Nevents; - pes->in[0].reactions = rs = make_s_Reactions(1); - rs->mult = 1; - rs->in[0].type = *iproc; - - rs->in[0].beam = bs = make_s_Beam(); - bs->type = kin[0].geantid; - bs->momentum = mom = make_s_Momentum(); - mom->px = pin[0].px; - mom->py = pin[0].py; - mom->pz = pin[0].pz; - mom->E = pin[0].en; - bs->properties = prop = make_s_Properties(); - prop->charge = 0.0; - prop->mass = 0.0; - - rs->in[0].target = ts = make_s_Target(); - ts->type = kin[1].geantid; - ts->momentum = mom = make_s_Momentum(); - mom->px = pin[1].px; - mom->py = pin[1].py; - mom->pz = pin[1].pz; - mom->E = pin[1].en; - ts->properties = prop = make_s_Properties(); - prop->charge = +1; - prop->mass = 0.938272; /* this should be derived from type ... */ - - rs->in[0].vertices = vs = make_s_Vertices(1); - vs->mult = 1; - vs->in[0].origin = origin = make_s_Origin(); - vs->in[0].products = ps = make_s_Products(*ntra); - ps->mult = 0; - - // Copy vertex values from FORTRAN common block - bg_getvertex_(vertex); - - origin->t = 0.0; - origin->vx = vertex[0]; - origin->vy = vertex[1]; - origin->vz = vertex[2]; - - for (i=0; i < *ntra; i++) { - /* double E2; unused so commented out 12/18/2013 DL */ - //if(keve[i].geantid==0)continue; - - ps->in[ps->mult].type = keve[i].geantid; - ps->in[ps->mult].mech = keve[i].mech; - ps->in[ps->mult].pdgtype = keve[i].kfid; - ps->in[ps->mult].id = i+1; - ps->in[ps->mult].parentid = keve[i].parent; - - - ps->in[ps->mult].momentum = make_s_Momentum(); - ps->in[ps->mult].momentum->px = peve[i].px; - ps->in[ps->mult].momentum->py = peve[i].py; - ps->in[ps->mult].momentum->pz = peve[i].pz; - ps->in[ps->mult].momentum->E = peve[i].en; - ps->mult++; - } - - if ( *ntra > 0) { - Nevents_written++; - if (flush_s_HDDM(thisOutputEvent, hddmOutputStream) != 0) { - fprintf(stderr,"Error - write failed to output hddm file " - "after %d events were written.\n", Nevents_written); - exit(2); - } - if (Nevents_written%10000 == 0) - printf("Wrote event %d events (%d generated)\n", - Nevents_written, Nevents); - } -} diff --git a/src/programs/Simulation/bggen/code/bg_ini.F b/src/programs/Simulation/bggen/code/bg_ini.F deleted file mode 100644 index 6f87b672c7..0000000000 --- a/src/programs/Simulation/bggen/code/bg_ini.F +++ /dev/null @@ -1,246 +0,0 @@ - SUBROUTINE BG_INI(IERR) -C -C--- Initialize the FFREAD and the relevant variables -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_partc.inc' -C - INTEGER mxffr,jffr - PARAMETER (mxffr=10000) - COMMON/CFREAD/ jffr(mxffr) -C - INTEGER ier -C - INTEGER i,j,lun,lout,iost,ip,kd(4),kf,lenc,idgea - REAL am,wg - CHARACTER cline*132 -C - lout=6 - IERR=1 -C - CALL HBOOK_INI -C - NEVENT=0 - RUNNO=2 - IWROUT(1)=1 - IWROUT(2)=0 - IWROUT(3)=0 - IRND_SEQ=0 - NPRIEV=0 - EPH_LIM(1)=0.15 - EPH_LIM(2)=12. - EELEC=12. ! electron energy - EPEAK=9. ! peak right edge - EEMIT=1e-8 ! electron beam emittance (m.rad) - RADT=50e-6 ! radiator thickness (m) - ZCOLL=7600. - DCOLL=0.0034 - EPYMIN=3. ! min energy for PYTHIA - ELOWMIN=0.15 -C - LUNWR(1)=0 ! HDDS file - LUN not used - LUNWR(2)=2 ! sequential file - LUNWR(3)=3 ! NTUPLE file -C -C--- Redefine FFREAD settings -C - CALL FFINIT(mxffr) - CALL FFSET('LINP',15) - CALL FFSET('LOUT',6) - CALL FFSET('SIZE',16) - CALL FFSET('LENG',120) -C - CALL FFKEY('TRIG' , NEVENT , 1,'INTEGER') - CALL FFKEY('RUNNO' , RUNNO , 1,'INTEGER') - CALL FFKEY('WROUT' , IWROUT(1) , 3,'INTEGER') - CALL FFKEY('RNDMSEQ' , IRND_SEQ , 1,'INTEGER') - CALL FFKEY('NPRIEV' , NPRIEV , 1,'INTEGER') - CALL FFKEY('EPHLIM' , EPH_LIM(1) , 2,'REAL') - CALL FFKEY('EELEC' , EELEC , 1,'REAL') - CALL FFKEY('EPEAK' , EPEAK , 1,'REAL') - CALL FFKEY('EEMIT' , EEMIT , 1,'REAL') - CALL FFKEY('RADTHICK' , RADT , 1,'REAL') - CALL FFKEY('ZCOLLIM' , ZCOLL , 1,'REAL') - CALL FFKEY('DCOLLIM' , DCOLL , 1,'REAL') - CALL FFKEY('EPYTHMIN' , EPYMIN , 1,'REAL') - CALL FFKEY('ELOWMIN' , ELOWMIN , 1,'REAL') - CALL FFKEY('VERTEX' , VERTEX(1) , 3,'REAL') -C - CALL FFGO -C -C -C--- Read the particle masses (GEANT numbering) -C - DO ip=1,MXPART - AM_PART(ip)=0. - WG_PART(ip)=0. - DO i=1,4 - KD_PART(i,ip)=0 - ENDDO - ENDDO -C - lun=9 - OPEN(lun,FILE='particle.dat',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file particle.dat' - GO TO 999 - ENDIF - 10 READ(lun,FMT='(A)',IOSTAT=iost) cline - IF(iost.EQ.0) THEN -C - IF(cline(1:1).NE.'*'.AND.cline(1:1).NE.'C') THEN - READ(cline,*) ip,am,wg,kd -C write(6,*) ip,am,wg,kd - IF(ip.GT.0.AND.ip.LE.MXPART) THEN - AM_PART(ip)=am - WG_PART(ip)=wg - DO i=1,4 - KD_PART(i,ip)=kd(i) - ENDDO - ELSE - WRITE(lout,*) ' --- ERROR: Reading file particle.dat ', - + 'GEANT index is out of range ',ip - ENDIF - ENDIF -C - GO TO 10 -C - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file particle.dat' - GO TO 999 - ENDIF -C -C--- Read the GEANT<->PYTHIA particle table -C - DO i=1,MXPGEANT - IPLUND(i)=0 - IDECLUND(i)=0 - ENDDO - DO i=-MXPKC,MXPKC - KCGEAN(i)=0 - ENDDO -C - OPEN(lun,FILE='pythia-geant.map',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file pythia-geant.map' - GO TO 999 - ENDIF - 15 READ(lun,'(A)',IOSTAT=iost) cline - IF(iost.EQ.0) THEN -C - lenc=0 - DO i=1,LEN_TRIM(cline) - IF(cline(i:i).EQ.'!') GO TO 20 - lenc=i - ENDDO - 20 CONTINUE - IF(lenc.GE.3) THEN - READ(cline(1:lenc),*) j,kf - idgea=ABS(j) - ENDIF - IF(idgea.GT.0.AND.idgea.LE.MXPGEANT) THEN - IF(kf.NE.0) THEN - IPLUND(idgea) =kf - IF(j.LT.0) IDECLUND(idgea)=1 - ENDIF - ENDIF -C - GO TO 15 -C - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file pythia-geant.map' - GO TO 999 - ENDIF - CLOSE(lun) -C - CALL RND_INI(IRND_SEQ) ! random number initialization -C - IF(EPH_LIM(1).LT.ELOWMIN) THEN - WRITE(6,1005) ELOWMIN - 1005 FORMAT(' --- Initialization warning: EPH_LIM(1) is set' - + ,' to ELOWMIN:',F10.4) - EPH_LIM(1)=ELOWMIN - ENDIF -C - IF(EPH_LIM(1).GT.EPH_LIM(2)) THEN - WRITE(6,1000) EPH_LIM - 1000 FORMAT(' *** Initialization error: energy limits:',2F10.4) - GO TO 999 - ELSE IF(EPH_LIM(1).EQ.EPH_LIM(2)) THEN -C -C--- Increase E2 slightly in order to make a valid histogram -C - EPH_LIM(2)=EPH_LIM(1)*1.0001 -C - ELSE -C -C--- Bremsstrahlung beam: the E0 and Epeak should be cosistent -C - IF(EELEC.LT.EPH_LIM(2)) THEN - WRITE(6,1010) EELEC,EPH_LIM(2) - 1010 FORMAT(' *** Initialization error: EeEe:',2F10.4) - GO TO 999 - ENDIF -C - ENDIF -C -C--- Beam spectrum -C - IDBEAM=9000 - NHBEA=0 - CALL COHBEAM_INI(IDBEAM,EELEC,EPEAK,EPH_LIM,ZCOLL,DCOLL) -C -C--- Pythia -C - IFPYTH=0 - IF(EPH_LIM(2).GT.EPYMIN) THEN - CALL PYTH_INI(ier) - IF(ier.NE.0) GO TO 999 - IFPYTH=1 - ENDIF -C -C--- Low energy processes -C - IDLOWEN=0 - IF(EPH_LIM(1).LT.EPYMIN) THEN - IDLOWEN=10000 - CALL LOWEN_INI(ier) - IF(ier.NE.0) GO TO 999 - ENDIF -C -C--- Output file for HDDM -C - IF(IWROUT(1).NE.0) THEN - CALL OPEN_HDDM_OUTPUT('bggen.hddm') - ENDIF -C -C--- Sequential output file -C - IF(IWROUT(2).NE.0) THEN - OPEN(LUNWR(2),FILE='bggen.dat',STATUS='UNKNOWN' - + ,FORM='UNFORMATTED') - ENDIF -C -C--- NTUPLE -C - IF(IWROUT(3).NE.0) THEN - CALL BG_NTUP_INI(ier) - IF(ier.NE.0) GO TO 999 - ENDIF -C - IERR=0 - 999 RETURN - END - - diff --git a/src/programs/Simulation/bggen/code/bg_ntup_ini.F b/src/programs/Simulation/bggen/code/bg_ntup_ini.F deleted file mode 100644 index c1fde1742c..0000000000 --- a/src/programs/Simulation/bggen/code/bg_ntup_ini.F +++ /dev/null @@ -1,42 +0,0 @@ - SUBROUTINE BG_NTUP_INI(IERR) -C -C--- Initialize the ntuple -C - IMPLICIT NONE - INTEGER IERR -C - COMMON/QUEST/ IQUEST(100) - INTEGER IQUEST -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER lrec,idnt,iost - CHARACTER cpar*3 -C - IERR=1 - lrec=2048 - IQUEST(10)=128000 - CALL HROPEN(LUNWR(3),'bgkin','bggen.nt','N',lrec,iost) - IF(iost.NE.0) THEN - WRITE(6,*)'*** ERROR opening NTUPLE, iost=',iost - GO TO 999 - ENDIF - idnt=9 - CALL HBNT(idnt,'BGkinem',' ') - CALL HBNAME(idnt,'run',IEVENT,'ieve') - CALL HBNAME(idnt,'run',INDUM(1),'irun') - CALL HBNAME(idnt,'run',INDUM(2),'iend[-120,120]') - CALL HBNAME(idnt,'bgki',IEVPROC,'iproc') - CALL HBNAME(idnt,'bgki',ITPIN(1,1) ,'itypin(2,2)') - CALL HBNAME(idnt,'bgki',AMIN(1) ,'amin(2)') - CALL HBNAME(idnt,'bgki',PIN(1,1),'pin(3,2)') - WRITE(cpar,FMT='(I3)') MXTRA - CALL HBNAME(idnt,'bgki',NTRA,'np[0,'//cpar//']') - CALL HBNAME(idnt,'bgki',ITPTRA(1,1) ,'ityp(6,np)') - CALL HBNAME(idnt,'bgki',AMTRA(1) ,'am(np)') - CALL HBNAME(idnt,'bgki',PTRA(1,1),'pout(3,np)') -C - IERR=0 - 999 RETURN - END diff --git a/src/programs/Simulation/bggen/code/bg_partc.inc b/src/programs/Simulation/bggen/code/bg_partc.inc deleted file mode 100644 index 1a7fba63de..0000000000 --- a/src/programs/Simulation/bggen/code/bg_partc.inc +++ /dev/null @@ -1,14 +0,0 @@ -C -C--- Particle masses -C - INTEGER MXPART - PARAMETER (MXPART=100) - COMMON/BG_PARTC/ AM_PART(MXPART),WG_PART(MXPART) - + ,KD_PART(4,MXPART) - REAL AM_PART ! (i) - particle mass GeV/c^2, i - GEANT number - + ,WG_PART ! full widths - + ,KD_PART ! (1-3) decay products (one decay allowed) -C ! (4) =0 - decay uniform in theta, =1 - like rho (sin**2), =2 - J/Psi-type -C - - diff --git a/src/programs/Simulation/bggen/code/bg_proc.inc b/src/programs/Simulation/bggen/code/bg_proc.inc deleted file mode 100644 index 423c191572..0000000000 --- a/src/programs/Simulation/bggen/code/bg_proc.inc +++ /dev/null @@ -1,10 +0,0 @@ -C -C--- BG processes definitions -C - INTEGER MXPROC,MXOUT - PARAMETER (MXPROC=10,MXOUT=6) - COMMON/BG_PROC/ ITYPROC(MXOUT,MXPROC) - COMMON/BG_PROC1/ CNPROC(MXPROC) -C - INTEGER ITYPROC ! (1:6,iproc) - GEANT types (or 0) of the secondary particles for process iproc - CHARACTER CNPROC*16 ! (iproc) - the process description (name) diff --git a/src/programs/Simulation/bggen/code/bggen.cc b/src/programs/Simulation/bggen/code/bggen.cc deleted file mode 100644 index 9df9598292..0000000000 --- a/src/programs/Simulation/bggen/code/bggen.cc +++ /dev/null @@ -1,11 +0,0 @@ - - -extern "C" void bggen_(void); - -int main(int narg, char *argv[]) -{ - bggen_(); - - return 0; -} - diff --git a/src/programs/Simulation/bggen/code/bggen_F.F b/src/programs/Simulation/bggen/code/bggen_F.F deleted file mode 100644 index 167528466e..0000000000 --- a/src/programs/Simulation/bggen/code/bggen_F.F +++ /dev/null @@ -1,94 +0,0 @@ -C -C--- Simulates "background" photoproduction by a coherent Bremsstrahlung beam -C Reaction: gamma+p -C Control flags are read from fort.15 (FFREAD) -C E>3 GeV (can be changed in fort.15) - use PYTHIA -C E<3 GeV - a coctail of several dominating photoproduction processes -C -C Includes: a) calculation of the coherent+incoherent photon energy spectra -C b) parametrization for the cross sections: -C - full (formula fit to data) -C - p pi0, n pi+ - using SAID -C - p 2pi, n 2pi, p eta, p 3pi, n 3pi (formula fit to data) -C c) simulation if unbiased (equal weight) events in a given beam energy range: -C - beam energy simulated (beam spectrum times the total cross section) -C - the process is chosen randomly accordingly to the their probabilities -C -C--- Input: file "fort.15" -C the number of events, the beam energy range, the distance to the collimator etc -C file "particle.dat" contains a table for particle masses (GEANT numbering) -C -C - SUBROUTINE BGGEN -C - IMPLICIT NONE -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER ierr,iev,ipri,i - INTEGER nproc(0:MXPROC) - CHARACTER cnam(0:MXPROC)*16,cmom*18 -C -C ------------------------------------------------------------------ -C - CALL BG_INI(ierr) - IF(ierr.NE.0) GO TO 999 -C - DO i=0,MXPROC - nproc(i)=0 - ENDDO - IEVENT=0 -C - DO iev=1,NEVENT -C - IEVENT=iev - ipri=0 - IF(iev.LE.NPRIEV) ipri=1 -C - CALL BG_EVE(ipri) -C - IF(IEVPROC.GE.0.AND.IEVPROC.LE.MXPROC) THEN - nproc(IEVPROC)=nproc(IEVPROC)+1 - ENDIF -C - ENDDO -C - WRITE(6,1980) - 1980 FORMAT(///1X,100('=')) - WRITE(6,1990) NEVENT,RATESEC/1000. - 1990 FORMAT(' Events Simulated: ',I9,5X,'Reference interaction rate:' - + ,F12.2,' kHz') - IF(NEVENT.GT.0) THEN - cnam(0)='PYTHIA ' - DO i=1,MXPROC - cnam(i)=CNPROC(i) - ENDDO - WRITE(6,2000) - 2000 FORMAT(' process ',16X,' events fraction range') - WRITE(6,2005) - 2005 FORMAT(1X,100('-')) - DO i=0,MXPROC - cmom=' ' - IF(i.EQ.0) THEN - WRITE(cmom,2006) EPYMIN,EPH_LIM(2) - 2006 FORMAT(F5.2,'lab rotation matrix - rotate(1,1)=1 - rotate(1,2)=0 - rotate(1,3)=0 - rotate(2,1)=0 - rotate(2,2)=1 - rotate(2,3)=0 - rotate(3,1)=0 - rotate(3,2)=0 - rotate(3,3)=1 - call rotmat(rotate,0d0,dpi/2,0d0) !point (1,0,0) along beam - call rotmat(rotate,0d0,0d0,dpi/4) !point (0,1,1) vertically - call rotmat(rotate,-thx,0d0,0d0) !the goniometer-x rotation - call rotmat(rotate,0d0,-thy,0d0) !the goniometer-y rotation - write(6,2000) (rotate(1,j),j=1,3) - write(6,2000) (rotate(2,j),j=1,3) - write(6,2000) (rotate(3,j),j=1,3) -2000 format(3f12.6) - end - - real function cohrat(x) - real x - include 'cobrems.inc' - real yc,yi - yc=dNcdx(x) - yi=dNidx(x) - cohrat=(yc+yi)/(yi+1e-30) - end - - real function dNtdx(x) - real x - include 'cobrems.inc' - dNtdx=dNcdx(x)+dNidx(x) - end - - real function dNtdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - dNtdx3=dNcdx(x)+dNidx(x) - end - - real function dNtdk(k) - real k - include 'cobrems.inc' - dNtdk=dNtdx(k/E)/E - end - - real function dNcdx(x) - real x - include 'cobrems.inc' - real phi - phi=REAL(dpi/4) - dNcdx=REAL(2*dpi*dNcdxdp(x,phi)) - end - - real function dNcdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - real phi - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - phi=REAL(dpi/4) - dNcdx3=REAL(2*dpi*dNcdxdp(x,phi)) - end - - real function dNcdxdp(x,phi) - real x,phi - include 'cobrems.inc' - integer h,k,l - double precision ReS,ImS,S2 - double precision q2,qT2,q(3),qdota - real xmax,theta2,FF,sum - integer hmin,kmin,lmin - real q3min - integer i - real sigma0 - sigma0=REAL(16*dpi*t*Z**2*alpha**3*E*(hbarc/a**2)*(hbarc/a/me)**4) - q2points=0 - q3min=1 - sum=0 - do h=-4,4 ! can replace with 0,0 for cpu speed-up if crystal alignment is "reasonable" - do k=-10,10 - do l=-10,10 -c do k=-2,-2 -c do l=-2,-2 - if (h/2*2.eq.h) then - if (k/2*2.ne.k) then - goto 10 - elseif (l/2*2.ne.l) then - goto 10 - elseif ((h+k+l)/4*4.ne.h+k+l) then - goto 10 - endif - elseif (k/2*2.eq.k) then - goto 10 - elseif (l/2*2.eq.l) then - goto 10 - endif - ReS=0 - ImS=0 - do i=1,nsites - qdota=2*dpi*(h*ucell(1,i) + k*ucell(2,i) + l*ucell(3,i)) - ReS=ReS+cos(qdota) - ImS=ImS+sin(qdota) - enddo - S2=ReS**2+ImS**2 - if (S2.lt.1e-4) then - goto 10 - endif - qnorm=REAL(2*dpi*hbarc/a) - q(1)=qnorm*(rotate(1,1)*h + rotate(1,2)*k + rotate(1,3)*l) - q(2)=qnorm*(rotate(2,1)*h + rotate(2,2)*k + rotate(2,3)*l) - q(3)=qnorm*(rotate(3,1)*h + rotate(3,2)*k + rotate(3,3)*l) - q2=q(1)**2+q(2)**2+q(3)**2 - qT2=q(1)**2+q(2)**2 - xmax=REAL(2*E*q(3)) - xmax=xmax/(xmax+me**2) - if ((x.gt.xmax).or.(xmax.gt.1)) then - goto 10 - else -c write(6,*) h,k,l,S2 -c write(6,*) q2,xmax - endif - if (q(3).lt.q3min) then - q3min=REAL(q(3)) - hmin=h - kmin=k - lmin=l - endif - theta2=(1-x)*xmax/(x*(1-xmax)) - 1 - FF=REAL(1/(1+q2*betaFF**2)) - sum=REAL(sum+sigma0*qT2*S2*exp(-Aphonon*q2) - + * (FF*betaFF**2)**2 - + * ((1-x)/(x*(1+theta2))**2) - + * ((1+(1-x)**2) - + - 8*(theta2/(1+theta2)**2)*(1-x)*cos(phi)**2) - + * acceptance(theta2) - + * polarization(x,theta2,phi)) -C comment out the preceding line to disable polarization -RTJ - q2points=q2points+1 - q2theta2(q2points)=theta2 - q2weight(q2points)=sum -10 continue - enddo - enddo - enddo - dNcdxdp=sum -c if (q3min.lt.1) write(6,*) hmin,kmin,lmin,' best plane at',x - end - - real function dNidx(x) - real x - include 'cobrems.inc' - integer iter,niter - real theta2 !numerical integration over d(theta**2) over [0,inf] - real u,du !is transformed by u=1/(1+theta**2) to d(u) over [0,1] - niter=50 - dNidx=0 - if (x.gt.1) then - return - endif - du=1./niter - do iter=1,niter - u=(iter-0.5)/niter - theta2=(1-u)/u - dNidx=dNidx+dNidxdt2(x,theta2)*du/u**2 - enddo -c write(6,*) dNidx - end - -C In the following paper, a closed form is given for the integral that -C is being performed analytically by dNidx. I include this second form -C here in case some time it might be useful as a cross check. -C -C "Coherent bremsstrahlung in crystals as a tool for producing high -C energy photon beams to be used in photoproduction experiments at -C CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. -C -C Note: in this paper they have swapped subscripts for coherent and -C incoherent intensities. This is not very helpful to the reader! -C -C The result is some 15% lower radiation rate than the result of dNidx. -C I take the latter to be more detailed (because it gives a more -C realistic behaviour at the endpoint and agrees better with the PDG -C radiation length for carbon). Most of this deficiency is remedied -C by simply replacing Z**2 in the cross section with Z*(Z+zeta) as -C recommended by Kaune et.al., and followed by the PDG in their fit -C to radiation lengths. -C -C WARNING -C dNidx and dNBidx give the incoherent radiation rate for crystalline -C radiators. If you take the incoherent radiation formulae here and -C integrate them you will NOT obtain the radiation length for amorphous -C radiators; it will be overestimated by some 15%. The reason is that -C the part of the integral in q-space that is covered by the discrete -C sum has been subtracted to avoid double-counting with the coherent -C part. If you were to spin the crystal fast enough, the coherent -C spectrum would average out to yield the remaining 15% with a spectral -C shape resembling the Bethe-Heitler result. - - real function dNBidx(x) - real x - include 'cobrems.inc' - real psiC1,psiC2 - real AoverB2,Tfact - real zeta - AoverB2=Aphonon/betaFF**2 - Tfact=-(1+AoverB2)*exp(AoverB2)*EXPINT(AoverB2) - psiC1=2*(2*log(betaFF*me)+Tfact+2) - psiC2=psiC1-2/3. - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - dNBidx=nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + * (psiC1*(1+(1-x)**2) - psiC2*(1-x)*2/3.) - end - - real function dNidxdt2(x,theta2) - real x,theta2 - include 'cobrems.inc' - real MSchiff,delta,zeta - delta=1.02 - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - MSchiff=1/(((me*x)/(2*E*(1-x)))**2 + 1/(betaFF*me*(1+theta2))**2) - dNidxdt2=2*nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + *( ((1+(1-x)**2)-4*theta2*(1-x)/(1+theta2)**2)/(1+theta2)**2 - + *(log(MSchiff) - 2*delta*Z/(Z+zeta)) - + + 16*theta2*(1-x)/(1+theta2)**4 - (2-x)**2/(1+theta2)**2 ) - + * acceptance(theta2) -c write(6,*) dNidxdt2 - end - - real function rpara(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rpara=0.5*((1+1-x)**2)*(1+theta2)**2 - + -8*theta2*(1-x)*cos(phi)**2 - + -8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function rortho(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rortho=0.5*x**2*(1+theta2)**2 - + +8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function polarization(x,theta2,phi) - real x,theta2,phi - real Npara,Nperp - real paverage - include 'cobrems.inc' - if (unpolar) then - polarization=1 - return - endif - -c This formula was taken from Eq. A5 of Kaune, Miller, et.al. -c PhysRevD.11.479, but it has been averaged over phi already. -c 8/30/2017 - replacing this with the full phi-dependent -c expression below, based on Eq. A4. -c paverage=2*(1-x)/((1+theta2)**2*((1-x)**2+1) - 4*theta2*(1-x)) - - Npara = 0.5*(2-x)**2*(1+theta2)**2 - 8*theta2*(1-x)*cos(phi)**2 - - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 - Nperp = 0.5*x**2*(1+theta2)**2 + - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 - polarization = (Npara - Nperp) / (Npara + Nperp) - end - - real function acceptance2(theta2,phi,xshift,yshift) - real theta2,phi,xshift,yshift - include 'cobrems.inc' - real xc,yc - real theta - theta=sqrt(theta2)*me/E - xc=D*tan(theta)*cos(phi)+xshift - yc=D*tan(theta)*sin(phi)+yshift - acceptance2 = acceptance((atan2(sqrt(xc**2+yc**2),D)*(E/me))**2) - end - - real function acceptance(theta2) - real theta2 - include 'cobrems.inc' - vector sig(4) - real u,var0,varMS,thetaC - real pu,du2,u0,u1,u2 - integer iter,niter - real theta -Comment out the following lines to enable collimation -RTJ -c acceptance=1 -c return -Comment out the preceding lines to enable collimation -RTJ - acceptance=0 - niter=50 - theta=sqrt(theta2) - thetaC=collim/(2*D)*(E/me) - var0=(spot/D*(E/me))**2 - varMS=sigma2MS(t)*(E/me)**2 - sig(1)=sqrt(var0) - sig(2)=sqrt(varMS) - if (theta.lt.thetaC) then - u1=thetaC-theta - if (u1**2/(var0+varMS).gt.20) then - acceptance=1 - return - endif - do iter=1,niter - u=u1*(iter-0.5)/niter - u2=u**2 - du2=2*u*u1/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=acceptance + pu*du2 - enddo - endif - u0=abs(theta-thetaC) - u1=abs(theta+thetaC) - do iter=1,niter - u=u0+(u1-u0)*(iter-0.5)/niter - u2=u**2 - du2=2*u*(u1-u0)/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=REAL(acceptance + pu*du2/dpi - + * atan2(sqrt((theta2-(thetaC-u)**2)*((thetaC+u)**2-theta2)), - + theta2-thetaC**2+u2)) - enddo - end - - subroutine rotmat(matrix,thx,thy,thz) - double precision matrix(3,3),thx,thy,thz -C Matrix(out) = Rx(thx) Ry(thy) Rz(thz) Matrix(in) -C with rotations understood in the passive sense - double precision x,y,z - double precision sint,cost - integer i - if (thz.ne.0) then - sint=sin(thz) - cost=cos(thz) - do i=1,3 - x=matrix(1,i) - y=matrix(2,i) - matrix(1,i)=cost*x+sint*y - matrix(2,i)=-sint*x+cost*y - enddo - endif - if (thy.ne.0) then - sint=-sin(thy) - cost=cos(thy) - do i=1,3 - x=matrix(1,i) - z=matrix(3,i) - matrix(1,i)=cost*x+sint*z - matrix(3,i)=-sint*x+cost*z - enddo - endif - if (thx.ne.0) then - sint=sin(thx) - cost=cos(thx) - do i=1,3 - y=matrix(2,i) - z=matrix(3,i) - matrix(2,i)=cost*y+sint*z - matrix(3,i)=-sint*y+cost*z - enddo - endif - end - - subroutine convol(nbins) - integer nbins - include 'cobrems.inc' - vector hisx(10000),hisy(10000),sig(4) - real norm(10000),result(10000) - real x,x0,x1,dx - real alph,dalph - real var0,varMS - real term - integer i,ii,j - x0=hisx(1) - x1=hisx(nbins) - var0=(mospread**2+(emit/spot)**2) - varMS=sigma2MS(t) - sig(3)=sqrt(var0)*E/me - sig(4)=sqrt(varMS)*E/me -C--Here we have to guess which characteristic angle alph inside the crystal -C is dominantly responsible for the coherent photons in this bin in x. -C I just use the smallest of the two angles, but this does not work when -C both angles are small, and you have to be more clever -- BEWARE!!! -C--In any case, fine-tuning below the mosaic spread limit makes no sense. - alph=REAL(min(abs(thx),abs(thy))) - if (alph.eq.0) then - alph=REAL(max(abs(thx),abs(thy))) - else - alph=max(alph,mospread) - endif - - do j=1,nbins - norm(j)=0 - result(j)=0 - do i=-nbins,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - norm(j)=norm(j)+term - enddo - enddo - -c write(6,*) norm - - do i=-nbins,nbins - if (i.lt.1) then - ii=1-i - else - ii=i - endif - do j=1,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - result(ii)=result(ii)+term*hisy(j)/norm(j) - enddo - enddo - - do i=1,nbins - if (abs(result(i)).gt.1e-35) then - hisy(i)=result(i) - else - hisy(i)=0 - endif - enddo - end - - real function sigma2MS(tt) - real tt -C--Chose one of the available implementations of this function below. -c Some formulas, although valid for a reasonable range of target thickness, -c can go negative for extremely small target thicknesses. Here I protect -c against these unusual cases by taking the absolute value. [rtj] - sigma2MS=abs(sigma2MS_Geant(tt)) - end - - real function sigma2MS_Kaune(tt) - real tt - include 'cobrems.inc' -C--Multiple scattering formula of Kaune et.al. -c with a correction factor from a multiple-scattering calculation -c taking into account the atomic and nuclear form factors for carbon. - -c--Note by RTJ, Oct. 13, 2008: -c I think this formula overestimates multiple scattering in thin targets -c like these diamond radiators, because it scales simply like sqrt(tt). -c Although the leading behavior is sqrt(tt/radlen), it should increase -c faster than that because of the 1/theta**2 tail of the Rutherford -c distribution that makes the central gaussian region swell with increasing -c number of scattering events. For comparison, I include below the PDG -c formula (sigma2MS), the Moliere formula used in the Geant3 simulation -c of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for -c thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 -c (sigma2MS_Hanson). The latter two separate the gaussian part from the -c tails in different ways, but both agree that the central part is much -c more narrow than the formulation by Kaune et.al. below. - - carboncor=4.2/4.6 - sigma2MS_Kaune=REAL(8*dpi*nsites*alpha**2*Z**2 - + *tt*(hbarc/(E*a))**2/a - + *log(183*Z**(-1/3.)) - + *carboncor) - end - - real function sigma2MS_pdg(tt) - real tt - include 'cobrems.inc' -C--The PDG formula instead (with beta=1, charge=1) -c This formula is said to be within 11% for t > 1e-3 rad.len. - sigma2MS_pdg=(13.6e-3/E)**2*(tt/radlen) - + *(1+0.038*log(tt/radlen))**2 - end - - real function sigma2MS_Geant(tt) - real tt - include 'cobrems.inc' -C--Geant3 formula for the rms multiple-scattering angle -c This formula is based on the theory of Moliere scattering. It contains -c a cutoff parameter F that is used for the fractional integral of the -c scattering probability distribution that is included in computing the -c rms. This is needed because the complete distribution of scattering -c angles connects smoothly from a central gaussian (small-angle -c multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford -c scattering regime) through the so-called plural scattering region. - F=0.98 ! probability cutoff in definition of sigma2MS - density=3.534 ! g/cm^3 - chi2cc=(0.39612e-2)**2*(Z*(Z+1))*(density/12) ! GeV^2/m - chi2c=chi2cc*(tt/E**2) - rBohr=0.52917721e-10 ! m - chi2alpha=1.13*(hbarc/(E*rBohr*0.885))**2 - + *Z**(2/3.)*(1+3.34*(alpha*Z)**2) - omega0=chi2c/(1.167*chi2alpha) ! mean number of scatters - gnu=omega0/(2*(1-F)) - sigma2MS_Geant=chi2c/(1+F**2)*((1+gnu)/gnu*log(1+gnu)-1) - end - - real function sigma2MS_Hanson(tt) - real tt - include 'cobrems.inc' -C--Formulation of the rms projected angle attributed to Hanson et.al. -c in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere -c theory used to give the 1/e angular width of the scattering distribution. -c In the paper, though, they compare it with experiment for a variety of -c metal foils down to 1e-4 rad.len. in thickness, and show excellent -c agreement with the gaussian approximation out to 4 sigma or so. I -c like this paper because of the excellent agreement between the theory -c and experimental data. - density=3.534 ! g/cm^3 - ttingcm=tt*100*density - Atomicweight=12.01 - EinMeV=E*1000 - theta2max=0.157*Z*(Z+1)/Atomicweight*(ttingcm/EinMeV**2) - theta2screen=theta2max*Atomicweight*(1+3.35*(Z*alpha)**2) - + /(7800*(Z+1)*Z**(1/3.)*ttingcm) - BminuslogB=log(theta2max/theta2screen)-0.154 - Blast=1 - do i=1,999 - B=BminuslogB+log(Blast) - if (B.lt.1.2) then - B=1.21 - goto 10 - elseif (abs(B-Blast).gt.1e-6) then - Blast=B - else - goto 10 - endif - enddo - 10 continue - sigma2MS_Hanson=theta2max*(B-1.2)/2 - end diff --git a/src/programs/Simulation/bggen/code/cobrems.inc b/src/programs/Simulation/bggen/code/cobrems.inc deleted file mode 100644 index b690f0abf3..0000000000 --- a/src/programs/Simulation/bggen/code/cobrems.inc +++ /dev/null @@ -1,16 +0,0 @@ -C units: length in m; energy,momentum,mass in GeV; angles in radians - common /cophys/dpi,me,alpha,hbarc - real me,alpha,hbarc - double precision dpi - integer nsites - parameter (nsites=8) - common /cotarg/Z,a,radlen,Aphonon,mospread,betaFF,ucell(3,nsites) - real Z,a,radlen,Aphonon,mospread,betaFF,ucell - common /cosetup/thx,thy,rotate(3,3),E,Erms,emit,spot,D,t,collim - double precision thx,thy,rotate - real E,Erms,emit,spot,D,t,collim - common /coQ2list/q2points,q2theta2(1000),q2weight(1000) - integer q2points - real q2theta2,q2weight - common /coselect/unpolar - logical unpolar diff --git a/src/programs/Simulation/bggen/code/cohbeam_ini.F b/src/programs/Simulation/bggen/code/cohbeam_ini.F deleted file mode 100644 index f7d67fd4f3..0000000000 --- a/src/programs/Simulation/bggen/code/cohbeam_ini.F +++ /dev/null @@ -1,80 +0,0 @@ -C - SUBROUTINE COHBEAM_INI(ID,E0,EP,ELIM,ZCOLLIM,COLDIAM) -C -C--- Photoproduction by the coherent Brem. beam -C--- ID - histogram with the dN/dE*sigma(E), -C where dN/dE - coh. Brem., sigma(E) - total photoprod. on protons -C E0 - e- energy -C EP - coherent peak energy -C ELIM - energy limits -C ZCOLLIM - distance to the collimator -C COLDIAM - collimator diameter -C - IMPLICIT NONE - INTEGER ID - REAL E0,EP,ELIM(2),ZCOLLIM,COLDIAM -C - INCLUDE 'bg_ctrl.inc' -C - REAL DNIDX,DNCDX,GPXSECT -C - INTEGER i,nb,ibrem - REAL emn,emx,flx,xsec,dx,de,e,xstot,xlum,ecurr,targth,frate,vv -C - ibrem=1 - IF(ELIM(2).LT.ELIM(1)*1.006) ibrem=0 -C -C--- Initialize the coherent Bremsstrahlung -C - targth=30. ! target thickness - ecurr=2.25E-6 ! beam current on a 20um crystal - the "high luminosity" setting - xlum=ecurr/1.6E-19*targth*0.071*0.602 ! luminosity factor: 2.25uA on 20um (1.7e-4 RL) crystal, 30 cm LH2 (1/b) -C - IF(ibrem.NE.0) THEN - CALL COBREMS(E0,EP,EEMIT,RADT,ZCOLLIM/100.,COLDIAM,0) ! collimator distance in m - ENDIF -C - emn=ELIM(1) - emx=ELIM(2) - de=MIN(0.005,emx-emn) - dx=de/E0 - nb=INT((emx-emn)/de+0.001) - NHBEA=nb -C - CALL HBOOK1(ID ,'Beam flux dn/dE*sigma(E)' ,nb,emn,emx,0.) - CALL HBOOK1(ID+10,'Total cross section in mb',nb,emn,emx,0.) - CALL HBOOK1(ID+11,'Beam flux dn/dE' ,nb,emn,emx,0.) -C - frate=0. - DO i=1,nb - e=ELIM(1)+(i-0.5)*de - xstot=GPXSECT(e)*1.E-3 ! x-sec in b - IF(ibrem.NE.0) THEN - flx=(DNIDX(e/E0)+DNCDX(e/E0))*dx/de - vv=xstot*flx*xlum - frate=frate+vv*de - CALL HF1(ID+11,e,flx) - ELSE - vv=1. - ENDIF - CALL HF1(ID ,e,vv) - CALL HF1(ID+10,e,xstot) - ENDDO -C CALL HPRINT(ID) -C - RATESEC=0. - IF(ibrem.NE.0) THEN - RATESEC=frate - WRITE(6,FMT='(//10X,''Rates:'')') - WRITE(6,1000) ecurr*1.E6,emn,emx - 1000 FORMAT(10X,'Beam: ',F8.2,' uA e-, gamma in ',2F6.2,' GeV') - WRITE(6,1005) targth - 1005 FORMAT(10X,'Target: ',F8.2,' cm LH2') - WRITE(6,1010) frate/1000. - 1010 FORMAT(10X,'Interaction rate: ',F8.1,' kHz') - ENDIF -C - CALL HCOPY(ID,ID+1,' ') ! a copy of the final histogram to be used for HRNDM1 -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen/code/gbrwign.F b/src/programs/Simulation/bggen/code/gbrwign.F deleted file mode 100644 index f85c4260e4..0000000000 --- a/src/programs/Simulation/bggen/code/gbrwign.F +++ /dev/null @@ -1,38 +0,0 @@ - REAL FUNCTION GBRWIGN(DUMMY) -C. -C. ****************************************************************** -C. * * -C. * Breit-Wigner distribution * -C. * ==>Called by : GDECAY * -C. * * -C. ****************************************************************** -C. - IMPLICIT NONE - REAL DUMMY - REAL RNDM - INTEGER itry - REAL gg,gm,xrn,pi,de -C. -C. ------------------------------------------------------------------ -C -C-- Create Lorentz distributed energy with FWHM HBAR/TLIFE. -C-- (via integral-transformation of Lorentz-distribution) -C-- (M.Guckes) -C f(E)=gamma/2pi/(E**2+gamma**2/4) - non relativistic -C--- Modified by E.Ch. May 2007 - itry=0 - 10 itry=itry+1 -C CALL GRNDM(rndm,1) -C gamma=3.291086E-25/TLIFE*2. - de=1./2.*TAN(3.1416*(RNDM(de)-0.5)) -C write(6,*) itry,gamma,de - IF(ABS(de).GT.2.0) THEN - IF(itry.LT.1000) GO TO 10 - WRITE(6,*) ' *** GBRWIGN: too many tries for tau=' - + ,itry - de=0. - ENDIF - GBRWIGN=de -C - RETURN - END diff --git a/src/programs/Simulation/bggen/code/gdecan.F b/src/programs/Simulation/bggen/code/gdecan.F deleted file mode 100644 index 1362cfe199..0000000000 --- a/src/programs/Simulation/bggen/code/gdecan.F +++ /dev/null @@ -1,227 +0,0 @@ -* $Header: /afs/cern.ch/exp/compass/src/cvs/comgeant/code/src/omgbatch/ompro/gdecan.F,v 1.1.1.1 1997/06/02 17:39:52 fdr Exp $ -* $Log: gdecan.F,v $ -* Revision 1.1.1.1 1997/06/02 17:39:52 fdr -* Comgeant Monte-Carlo -* -* Revision 3.2.0.1 1996/11/07 19:23:23 las -* First CVS version. -* -*CMZ : 06/03/96 16.55.41 by E.Chudakov -*-- Author : Adapted from FOWL by D.Barberis, Uni.HD, 4/10/89. -*-- Updated by E.Chudakov (random numbers, SAVE...) 02/01/95 -*-- Updated by E.Chudakov (equal weights) 06/03/96 -C - SUBROUTINE GDECAN(NPFOWL,TEFOWL,AMFOWL,WTFOWL,PCFOWL) -*--- -* Phase-space decay into N particles. -* -* Input: -* NPFOWL number of decay particles -* TEFOWL mass of decaying particle -* AMFOWL(1:NPFOWL) masses of decay products -* WTFOWL<=0. diff. weights of events -* WTFOWL>0. equal (=1.) weights of events -* Output: -* WTFOWL weight of the event (or not changed) -* PCFOWL(1:4,1:NPFOWL) four-momentum of decay products -* -* Adapted from FOWL by D.Barberis, Uni.HD, 4/10/89. -*--- -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id: gdecan.F,v 1.1.1.1 1997/06/02 17:39:52 fdr Exp $'/ -C#endif - DIMENSION AMFOWL(NPFOWL), PCFOWL(4,NPFOWL) - COMMON /SHUFFL/ RNO(50), NTNM4, NTM2, NTM1 - PARAMETER ( MXFOWL = 20 ) - DIMENSION PD(MXFOWL), EMM(MXFOWL), EMS(MXFOWL), SM(MXFOWL) - DIMENSION AMSAVE(MXFOWL) - REAL wgtinim,rrr - INTEGER ntry -C - SAVE ETC,NPSAVE,AMSAVE,SM,TECMTM,WTMAXQ,EMS,EMM -C - DATA TWOPI / 6.2831853073 / - DATA ETC / -1. / -*--- Initialization. - wgtinim=WTFOWL - ntry=0 - WTFOWL = 0. - CALL VZERO(PCFOWL,4*NPFOWL) - IF (NPFOWL.LT.2.OR.NPFOWL.GT.MXFOWL) GO TO 900 -*--- Check if same as last time, if so skip first part. - IF (TEFOWL.EQ.ETC) THEN - IF (NPFOWL.EQ.NPSAVE) THEN - DO 150 I=1,NPFOWL - IF (AMFOWL(I).NE.AMSAVE(I)) GO TO 151 - 150 CONTINUE - GO TO 300 - ENDIF - ENDIF - 151 ETC = TEFOWL - NPSAVE = NPFOWL - CALL UCOPY(AMFOWL,AMSAVE,NPFOWL) -C PRINT 9001, NPFOWL,TEFOWL,(AMFOWL(I),I=1,NPFOWL) -C 9001 FORMAT(2X,I3,'-BODY PHASESPACE BY FOWL',4X,F8.5,' going to ' -C + ,(6F8.5)) - NTM1 = NPFOWL - 1 - NTM2 = NTM1 - 1 - NTP1 = NPFOWL + 1 - NTNM4 = 3 * NPFOWL - 4 - EMM(1) = AMFOWL(1) - TM = 0.0 - DO 200 I=1,NPFOWL - EMS(I) = AMFOWL(I)**2 - TM = TM + AMFOWL(I) - SM(I) = TM - 200 CONTINUE -*--- Constants depending on TEFOWL. - TECMTM = TEFOWL - TM - EMM(NPFOWL) = TEFOWL -*--- Constant cross-section as function of TEFOWL. - EMMAX = TECMTM + AMFOWL(1) - EMMIN = 0.0 - WTMAX = 1.0 - DO 350 I=2,NPFOWL - EMMIN = EMMIN + AMFOWL(I-1) - EMMAX = EMMAX + AMFOWL(I) - WTMAX = WTMAX * OPDK(EMMAX,EMMIN,AMFOWL(I)) - 350 CONTINUE - WTMAXQ = 1.0 / WTMAX -*--- Calculation of WT based on effective masses EMM. - 300 CALL ORANGNR -*--- ORANGNR fills RNO with 3*NPFOWL-4 random numbers, -*--- of which the first NPFOWL-2 are ordered. - IF (NTM2.GT.0) THEN - DO 508 J=2,NTM1 - EMM(J) = RNO(J-1) * (TECMTM) + SM(J) - 508 CONTINUE - ENDIF - WTFOWL = WTMAXQ - IR = NTM2 - DO 530 I=1,NTM1 - PD(I) = OPDK(EMM(I+1),EMM(I),AMFOWL(I+1)) - WTFOWL = WTFOWL * PD(I) - 530 CONTINUE -C -C--- Try again in order to get rid of the weight? -C - IF(wgtinim.GT.1.E-10) THEN - ntry=ntry+1 - IF(ntry.LT.10000) THEN - CALL GRNDM(rrr,1) - IF(rrr.GT.WTFOWL/wgtinim) GO TO 300 - ENDIF - ENDIF -C -*--- Complete specification of event (Raubold-Lynch method). - PCFOWL(1,1) = 0.0 - PCFOWL(2,1) = PD(1) - PCFOWL(3,1) = 0.0 - DO 570 I=2,NPFOWL - PCFOWL(1,I) = 0.0 - PCFOWL(2,I) = -PD(I-1) - PCFOWL(3,I) = 0.0 - IR = IR + 1 - BANG = TWOPI * RNO(IR) - CB = COS(BANG) - SB = SIN(BANG) - IR = IR + 1 - C = 2.0 * RNO(IR) - 1.0 - S = SQRT(1.0-C*C) - IF (I.LT.NPFOWL) THEN - ESYS = SQRT(PD(I)**2+EMM(I)**2) - BETA = PD(I) / ESYS - GAMA = ESYS / EMM(I) - DO 568 J=1,I - AA = PCFOWL(1,J)**2 + PCFOWL(2,J)**2 + PCFOWL(3,J)**2 - PCFOWL(4,J) = SQRT(AA+EMS(J)) - CALL OROTES2(C,S,CB,SB,PCFOWL(1,J)) - PSAVE = GAMA * ( PCFOWL(2,J) + BETA * PCFOWL(4,J) ) - PCFOWL(2,J) = PSAVE - 568 CONTINUE - ELSE - 1567 DO 1568 J=1,I - AA = PCFOWL(1,J)**2 + PCFOWL(2,J)**2 + PCFOWL(3,J)**2 - PCFOWL(4,J) = SQRT(AA+EMS(J)) - CALL OROTES2(C,S,CB,SB,PCFOWL(1,J)) - 1568 CONTINUE - ENDIF - 570 CONTINUE - 900 RETURN - END - FUNCTION OPDK(A,B,C) -* -*-- CMS momentum for a two-body decay ( A --> B + C ) -* - A2 = A*A - B2 = B*B - C2 = C*C - PD = A2 + (B2-C2)**2/A2 - 2.0*(B2+C2) - IF (PD.LT.0.) THEN - PRINT 900, A, B, C, PD - PD=0. - ENDIF - OPDK = 0.5 * SQRT(PD) - RETURN - 900 FORMAT('0PDK : A,B,C,PD =',4E15.7) - END - SUBROUTINE ORANGNR -* -*--- Assembles random numbers for one event. -* - COMMON /SHUFFL/ RNO(50), NTNM4, NTM2, NTM1 -C DO i= 1,NTM2 -C RNO(I) = RNDM(DUMMY) -C END DO -C - CALL GRNDM(RNO(1),NTM2) -C -*--- Order the first NTM2 random numbers -*--- two is a special case (faster) - IF (NTM2-2) 200,160,110 - 110 KM1 = NTM2 - 1 - DO 150 I= 1, KM1 - IQUIT = 0 - NI = NTM2 - I - DO 140 J= 1, NI - IF (RNO(J) - RNO(J+1)) 140,140,120 - 120 SAV = RNO(J) - RNO(J) = RNO(J+1) - RNO(J+1) = SAV - IQUIT = 1 - 140 CONTINUE - IF (IQUIT) 200,200,150 - 150 CONTINUE - GO TO 200 - 160 IF (RNO(1).LE.RNO(2)) GO TO 200 - SAV = RNO(1) - RNO(1) = RNO(2) - RNO(2) = SAV - 200 CONTINUE -*--- Choose the rest of the random numbers. -C DO 300 I= NTM1, NTNM4 -C 300 RNO(I) = RNDM(DUMMY) -C -C DO i= NTM1,NTNM4 -C RNO(I) = RNDM(DUMMY) -C END DO - CALL GRNDM(RNO(NTM1),NTNM4-NTM1+1) -C - RETURN - END - SUBROUTINE OROTES2(C,S,C2,S2,PCF) -* -*--- This subroutine does two rotations (xy and xz). -* - DIMENSION PCF(4) - SA = PCF(1) - SB = PCF(2) - A = SA*C - SB*S - PCF(2) = SA*S + SB*C - B = PCF(3) - PCF(1) = A*C2 - B*S2 - PCF(3) = A*S2 + B*C2 - RETURN - END diff --git a/src/programs/Simulation/bggen/code/gloren.F b/src/programs/Simulation/bggen/code/gloren.F deleted file mode 100644 index 141f5cc2c1..0000000000 --- a/src/programs/Simulation/bggen/code/gloren.F +++ /dev/null @@ -1,34 +0,0 @@ - SUBROUTINE GLOREN(BETA,PA,PB) -C. -C. ****************************************************************** -C. * * -C * Routine to transform momentum and energy from the * -C * Lorentz frame A to the Lorentz frame B * -C * * -C * PA(1) * -C * PA(2) Momentum components in frame A * -C * PA(3) * -C * PA(4) Energy * -C * PB(..) same quantities in frame B * -C * * -C * BETA(1) Components of velocity of frame B * -C * BETA(2) as seen from frame A * -C * BETA(3) * -C * BETA(4) 1./SQRT(1.-BETA**2) * -C. * * -C. * ==>Called by : GDECAY,GDECA3 * -C. * Author M.Hansroul ********* * -C. * * -C. ****************************************************************** -C. - DIMENSION BETA(4),PA(4),PB(4) -C. -C. ------------------------------------------------------------------ -C. - BETPA = BETA(1)*PA(1) + BETA(2)*PA(2) + BETA(3)*PA(3) - BPGAM = (BETPA * BETA(4)/(BETA(4) + 1.) - PA(4)) * BETA(4) - PB(1) = PA(1) + BPGAM * BETA(1) - PB(2) = PA(2) + BPGAM * BETA(2) - PB(3) = PA(3) + BPGAM * BETA(3) - PB(4) =(PA(4) - BETPA) * BETA(4) - END diff --git a/src/programs/Simulation/bggen/code/gpxcosthr.F b/src/programs/Simulation/bggen/code/gpxcosthr.F deleted file mode 100644 index f8076bb702..0000000000 --- a/src/programs/Simulation/bggen/code/gpxcosthr.F +++ /dev/null @@ -1,301 +0,0 @@ - SUBROUTINE GPXCOSTHR(IPROC,E0,TMN,TMX,COSTH,IERR) -C -C=== Generates a random value for COS(TH) in CM, -C using various functions: -C polinomial distrubutions: -C cos(th)=X=a(0)+a(1)*X+a(2)*X**2, where -C a(i)=b(0,i)+b(1,i)*E0+b(2,i)*E0**2+b(3,i)*E0**3 -C the factors b are stored -C -C--- Input: E0 - energy -C IPROC - process -C TMN,TMX (-t to the target) for the -t-dependence simulation -C Output: COSTH - COS(th) in CM - random value, for the 1-st secondary particle (should be the baryon) -C IERR >0 - error (not defined) -C - IMPLICIT NONE -C - INTEGER IPROC,IERR - REAL E0,COSTH,TMN,TMX -C - REAL RNDM - DOUBLE PRECISION DPOLFMY,DINT_F2 - EXTERNAL DPOLFMY,DINT_F2 -C - COMMON/CFUN_COS/ DFPA(10) - DOUBLE PRECISION DFPA -C - INTEGER i,j,npol,maxf - + ,iset ! array index for the polynomial coefficients for this process - + ,npar ! the number of parameters in the final distribution function - + ,ivar ! distribution used, =1 - cos(th), =2 - -t - + ,ifun ! function used used, =1 - polynomial, =2 - exp(a+b*x)+c converted to a*exp(bx)+c - REAL rnd,xx,tt,qq - + ,csign ! +1 or -1 multiplication factor for COSTH, depending on the data used -> baryon - DOUBLE PRECISION da(3),de0,dx,dx0,dxlim(2),dd - + ,df,dfe,df1,df2,dmin,dnorm - + ,dq(4),dtmp(4),dr(2),dl(2),dv,dres,dintg -C - COMPLEX*16 dz(3) -C - INTEGER mxpro,mxpar,mxfun - PARAMETER (mxpro=3,mxpar=3,mxfun=2) - REAL bb(4,mxpar,mxpro) ! polynomial coefficients for cos,t functions coefficients - + ,elim(2,mxpro) ! energy limits for these polynomilas. beyond them the edge value is taken - INTEGER nparf(mxfun) -C - DATA bb/ - + 10.22637, -4.23276, 0.81462, 0. ! p rho: (proc=4) - + ,-39.04430, 29.35012, -6.47698, 0. ! - + ,46.54426, -38.59182, 8.25751, 0. ! - + , 6.24956, -1.58878, 0.08898, 0. ! Delta++ pi- (5) - + ,16.14728, -24.19744, 6.55671, 0. ! - + , 7.32414, -1.37016, -0.63512, 0. ! - + ,-0.68852, 2.80721, -1.90364, 0.36498 ! p eta (proc=8) - + ,-1.09740, 1.69941, -0.67707, 0.11149 - + , 3.53044, -8.35135, 5.66832, -1.08696 - + / - DATA elim/ - + 1.5, 2.5 - + ,1.25, 2.4 - + ,0.75, 3.0 - + / - DATA nparf/3,3/ -C -C ------------------------------------------------------------------ -C - IERR=1 - COSTH=0. - IF(IPROC.LT.3.OR.IPROC.GT.12) GO TO 999 - IERR=2 -C - iset=0 - IF(IPROC.EQ.4) THEN ! p rho - iset=1 - npol=3 - ivar=2 - ifun=2 - csign=1. - ELSE IF(IPROC.EQ.5) THEN ! Delta++ pi- - iset=2 - npol=3 - ivar=2 - ifun=2 - csign=1. - ELSE IF(IPROC.EQ.8) THEN ! p eta - iset=3 - npol=4 - ivar=1 - ifun=1 - csign=-1. - ENDIF -C - IF(iset.EQ.0) GO TO 999 - IERR=3 - npar=nparf(ifun) -C -C--- Calculate the polynomial coefficients for the given energy -C - de0=DBLE(E0) - IF(E0.LT.elim(1,iset)) de0=elim(1,iset) - IF(E0.GT.elim(2,iset)) de0=elim(2,iset) - DO i=1,npar - DO j=1,npol - dtmp(j)=DBLE(bb(j,i,iset)) - ENDDO -C write(6,*) 'dtmp=',(dtmp(i),i=1,npol) - da(i)=DPOLFMY(npol,dtmp(1),de0) - ENDDO -C - IF(ifun.EQ.2) THEN -C -C--- convert to a*exp(bx)+c -C - da(1)=EXP(da(1)) - ENDIF -C write(6,*) 'da=',(da(i),i=1,npar) -C -C--- Limits of the variable -C - IF(ivar.EQ.1) THEN ! cos(th) - dxlim(1)=-1.D0 - dxlim(2)= 1.D0 - ELSE IF(ivar.EQ.2) THEN ! -t - dxlim(1)=TMN - dxlim(2)=TMX - ENDIF -C -C--- For the polynomial function (ifun=1) sure that the function is positive in the full range of the variable -C -C write(6,*) 'ifun,ivar,npol,npar=',ifun,ivar,npol,npar - IF(ifun.EQ.1) THEN ! p2 is assumed... - IF(da(3).LT.0.D0.AND. - + da(2)**2-4.D0*da(1)*da(3).LT.0.D0) GO TO 999 ! all the curve is negative - IERR=4 - dfe=1.D0 - IF(ABS(da(3)).GT.1.D-10) THEN ! there is an extremum - dx0=-da(1)/2.D0/da(3) - IF(dx0.GT.dxlim(1).AND.dx0.LT.dxlim(2)) THEN ! extremum is inside the interval - dfe=DPOLFMY(3,da(1),dx0) - ENDIF - ENDIF - df1=DPOLFMY(3,da(1),dxlim(1)) - df2=DPOLFMY(3,da(1),dxlim(2)) - dmin=MIN(dfe,df1,df2) - IF(dmin.LT.0.D0) THEN ! if needed, add a constant to the function in order to make it positive - da(1)=da(1)-dmin+1.D-15 - ENDIF - ENDIF -C -C--- Normalize the function -C - dd=dxlim(2)-dxlim(1) -C write(6,*) 'da=',(da(i),i=1,npar),dd - IF(ifun.EQ.1) THEN - dnorm=da(1)*dd+da(2)/2.D0*(dxlim(2)**2-dxlim(1)**2) - + +da(3)/3.D0*(dxlim(2)**3-dxlim(1)**3) - DO i=1,npar - da(i)=da(i)/dnorm - ENDDO - ELSE IF(ifun.EQ.2) THEN - dnorm=da(3)*dd - IF(ABS(da(2)).GT.1.D-8) THEN - dnorm=dnorm+ - + da(1)/da(2)*(EXP(da(2)*dxlim(2))-EXP(da(2)*dxlim(1))) - ELSE - dnorm=dnorm+da(1)*dd - ENDIF - da(1)=da(1)/dnorm - da(3)=da(3)/dnorm - ENDIF -C write(6,*) 'da=',(da(i),i=1,npar),dnorm -C -C--- Calculate the integral function crossing with rnd -C - rnd=RNDM(rnd) -C - IF(ifun.EQ.1) THEN -C -C--- Integral -C - dtmp(1)=0.D0 - dtmp(2)=da(1) - dtmp(3)=da(2)/2. - dtmp(4)=da(3)/3. - df=DPOLFMY(4,dtmp(1),dxlim(1)) - dtmp(1)=-df ! the integral function is 0 at the left edge -C -C--- The integral function factors are in reverse order to match the cernlib routine -C - DO i=1,4 - dq(i)=dtmp(5-i) - ENDDO - -C - dq(4)=dq(4)-DBLE(rnd) -C - CALL DMULLZ(dq(1),3,1000,dz) -C - DO i=1,3 - dr(1)=DBLE(dz(i)) - dr(2)=DIMAG(dz(i)) - IF(ABS(dr(2)).LT.1.D-10) THEN - IF(dr(1).GE.dxlim(1).AND.dr(1).LE.dxlim(2)) THEN - IERR=0 - xx=REAL(dr(1)) ! solution found - ENDIF - ENDIF - ENDDO - ELSE IF(ifun.EQ.2) THEN -C -C--- Integral function -C - dl(1)=dxlim(1) - dl(2)=dxlim(2) - IF(ABS(da(2)).LT.1E-8) THEN - xx=dl(1)+DBLE(rnd)*(dl(2)-dl(1)) - IERR=0 - ELSE - DFPA(1)=da(1)/da(2) - DFPA(2)=da(2) - DFPA(3)=da(3) - DFPA(4)=0.D0 - DFPA(4)=-DINT_F2(dl(1),0) ! the function should be 0 at dl(1) - dintg=DINT_F2(dl(2),0) - IF(dintg.LT.1.D0) THEN - DFPA(1)=DFPA(1)/dintg - DFPA(3)=DFPA(3)/dintg - DFPA(4)=DFPA(4)/dintg - ENDIF - DFPA(4)=DFPA(4)-DBLE(rnd) ! zero crossing -C - maxf=5000 - CALL DZERO(dl(1),dl(2),dv,dres,1.D-5,maxf,DINT_F2) - xx=REAL(dv) - IF(ABS(dres).GT.ABS(dl(2)-dl(1))) THEN - WRITE(6,FMT= - + '('' *** GPXCOSTHR random generator failed '',3D12.5)') - + ,dres,dl - WRITE(6,FMT='(10D12.4)') (da(i),i=1,3),(DFPA(i),i=1,4) - WRITE(6,FMT='(10D12.4)') - + DINT_F2(dl(1),0),DINT_F2(dl(2),0) - ELSE - IERR=0 - ENDIF - ENDIF - ENDIF -C - IF(IERR.NE.0) GO TO 999 -C - IF(ivar.EQ.1) THEN - COSTH=xx - ELSE IF(ivar.EQ.2) THEN ! calculate the polar angle in CM - tt=xx -C t=m1**2+m3**2-2E1*E3+2p1*p3*ct - COSTH=0. - qq=(TMX-TMN)/2. -C write(6,*) 'tmn=',TMN,TMX,qq - IF(qq.GT.0.) COSTH=(tt-(TMX+TMN)/2.)/qq - ENDIF - COSTH=COSTH*csign -C - 999 CONTINUE -C - END -C - DOUBLE PRECISION FUNCTION DPOLFMY(N,DA,DX) -C--- Polynomial function - IMPLICIT NONE - INTEGER N,i - DOUBLE PRECISION DA(N),DX,dp,dres -C - dres=0.D0 - dp=1.D0 - DO i=1,N - dres=dres+DA(i)*dp - dp=dp*DX - ENDDO - DPOLFMY=dres - RETURN - END -C - DOUBLE PRECISION FUNCTION DINT_F2(DX,IFL) -C--- Integral Function of a*EXP(b*x)+c - IMPLICIT NONE - INTEGER IFL - DOUBLE PRECISION DX - COMMON/CFUN_COS/ DFPA(10) - DOUBLE PRECISION DFPA - INTEGER ntry - SAVE ntry -C - DINT_F2=DFPA(1)*EXP(DFPA(2)*DX)+DFPA(3)*DX+DFPA(4) - IF(IFL.EQ.1) THEN - ntry=1 - ELSE IF(IFL.EQ.2) THEN - ntry=ntry+1 - ELSE IF(IFL.EQ.3) THEN -C WRITE(6,*) ' DZERO calls=',ntry - ENDIF - RETURN - END diff --git a/src/programs/Simulation/bggen/code/gpxsecp.F b/src/programs/Simulation/bggen/code/gpxsecp.F deleted file mode 100644 index c5c35ba330..0000000000 --- a/src/programs/Simulation/bggen/code/gpxsecp.F +++ /dev/null @@ -1,144 +0,0 @@ - REAL FUNCTION GPXSECP(E,IPROC) -C -C--- This function describes the partial gamma+p cross section, say gamma p --> p pi+ pi- -C--- process: 1,2 - SAID (called from elsewhere) -C 3 - p pi+ pi- no resonances -C 4 - p rho0 -C 5 - Delta++ pi- -C 6 - p pi0 pi0 -C 7 - n pi+ pi0 -C 8 - p eta -C 9 - p pi+ pi- pi0 -C 10 - n 2pi+ pi- -C 11 - p pi+ pi- full -C - IMPLICIT NONE - REAL E - INTEGER IPROC -C - COMMON/PAWPAR/ PARA(20) - REAL PARA -C VECTOR PAR(20) -C VECTOR IPFIT(10) -C - REAL GP_F1,GP_F2,GP_F3,GP_F4 -C - INTEGER ig,i,k,npar,mxp,ipro,ifit - PARAMETER (mxp=11) - REAL f1,f2,e0,ered,ff - REAL parf1(4,mxp) - DATA parf1/4*0. - + ,4*0. - + ,4*0. - + ,0.8199,0.0268,4.405 ,62.52 - + ,0.0914,3.5619,0.4100,2.1426 - + ,0.3611,0.0250,18.74 ,15.333 - + ,0.4545,0.0597,18.74 ,15.333 - + ,0.4782,6.8940,0.0794,2.038 - + ,0.0529,0.994 ,23.72 ,0.0 - + ,0.0050,0.4652,1525. ,0.0 - + ,0.3768,0.0693,18.74 ,15.333 - + / -C - ifit=0 - npar=2 - ipro=IPROC -C ifit=IPFIT(1) -C npar=IPFIT(2) -C ipro=IPFIT(3) -C write(6,*) ifit,npar,ipro -C - IF(ifit.EQ.2) THEN - DO i=1,npar -C PARA(i)=PAR(i) - ENDDO - ENDIF - IF(ifit.NE.0) THEN - k=0 - DO i=1,4 - k=k+1 -C IF(k.LE.npar) parf1(i,ipro)=PARA(k) - ENDDO - ENDIF -C - IF(ipro.LE.2) THEN ! SAID - GPXSECP=0. - ELSEIF(ipro.EQ.3) THEN ! subtraction 11-4-5 - ff= GP_F1(parf1(1,11),E) - ff=ff-GP_F1(parf1(1,4) ,E) - ff=ff-GP_F4(parf1(1,5) ,E) - GPXSECP=ff - ELSE IF(ipro.EQ.5) THEN -C - GPXSECP=GP_F4(parf1(1,ipro),E) -C - ELSE IF(ipro.LE.7.OR.ipro.EQ.11) THEN -C - GPXSECP=GP_F1(parf1(1,ipro),E) -C - ELSE IF(ipro.EQ.8) THEN -C - GPXSECP=GP_F2(parf1(1,ipro),E) -C - ELSE IF(ipro.LE.11) THEN -C - GPXSECP=GP_F3(parf1(1,ipro),E) -C - ENDIF -C - IF(GPXSECP.LE.0.) GPXSECP=1.E-9 -C - END -C - REAL FUNCTION GP_F1(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=P(1) - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(2)**2*ATAN(ered**2*P(3))/3.14*2. - f2=1.+P(4)/E - GP_F1=f1*f2 - END -C - REAL FUNCTION GP_F2(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.68 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*EXP(-(E-0.6)**2/2*P(2)**2) - f2=P(3)**2*EXP(-(E-1.1)*P(4)) - GP_F2=(f1+f2)*ered - END -C - REAL FUNCTION GP_F3(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.55 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*ATAN(ered**2*P(2))/3.14*2. - f2=1.+P(3)/E - GP_F3=f1*f2 - END -C - REAL FUNCTION GP_F4(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.4 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*EXP(1.-((E-0.8)*P(2))**6)*ATAN(ered**2*100) - f2=P(3)**2*EXP(-ered*P(4))*ered - GP_F4=f1+f2 - END - diff --git a/src/programs/Simulation/bggen/code/gpxsect.F b/src/programs/Simulation/bggen/code/gpxsect.F deleted file mode 100644 index d374350d51..0000000000 --- a/src/programs/Simulation/bggen/code/gpxsect.F +++ /dev/null @@ -1,64 +0,0 @@ - REAL FUNCTION GPXSECT(E) -C -C--- This function describes the total gamma+p cross section at 0.18-100 GeV -C - IMPLICIT NONE - REAL E -C -C COMMON/PAWPAR/ PARA(20) -C REAL PARA -C VECTOR PAR(20) -C VECTOR IPFIT(10) - REAL PAR(20),PARA(20) - INTEGER IPFIT(10) -C - INTEGER mxgaus,ig,i,k - PARAMETER (mxgaus=3) - REAL pgaus(3,mxgaus) - REAL f1,f2,f3,e0 - REAL parf1(2),parf2(2) - DATA pgaus/0.43,0.32,0.055 - + ,0.13,0.73,0.130 - + ,0.08,1.08,0.080/ - DATA parf1/0.119,21.3/ - DATA parf2/0.114,1.04/ -C - IPFIT(1)=0 - IF(IPFIT(1).EQ.2) THEN - DO i=1,13 - PARA(i)=PAR(i) - ENDDO - ENDIF - IF(IPFIT(1).NE.0) THEN - k=0 - DO i=1,2 - k=k+1 - parf1(i)=PARA(k) - ENDDO - DO i=1,2 - k=k+1 - parf2(i)=PARA(k) - ENDDO - DO ig=1,mxgaus - DO i=1,3 - k=k+1 - pgaus(i,ig)=PARA(k) - ENDDO - ENDDO - ENDIF -C - e0=0.15 -C - f3=0 - DO ig=1,mxgaus - f3=f3+pgaus(1,ig)*exp(-(E-pgaus(2,ig))**2/pgaus(3,ig)**2/2.) - ENDDO -C - f1=parf1(1)*ATAN((E-e0)*parf1(2))/3.14*2 - f2=parf2(1)*(E-e0)*EXP(-E*parf2(2)) -C - GPXSECT=f1+f2+f3 - IF(GPXSECT.LT.0.) GPXSECT=0. -C - END - diff --git a/src/programs/Simulation/bggen/code/grndm.F b/src/programs/Simulation/bggen/code/grndm.F deleted file mode 100644 index 6a3fc5f4e1..0000000000 --- a/src/programs/Simulation/bggen/code/grndm.F +++ /dev/null @@ -1,14 +0,0 @@ -C -C--- GEANT random function, redefined (RNDM - is in fact RANLUX) -C - SUBROUTINE GRNDM(X,N) - IMPLICIT NONE - INTEGER N !,i - REAL X(N) -C - CALL RANLUX(X(1),N) -C DO i=1,N -C X(i)=RNDM(i) -C ENDDO -C - END diff --git a/src/programs/Simulation/bggen/code/hbook_ini.F b/src/programs/Simulation/bggen/code/hbook_ini.F deleted file mode 100644 index 71b980566c..0000000000 --- a/src/programs/Simulation/bggen/code/hbook_ini.F +++ /dev/null @@ -1,18 +0,0 @@ - SUBROUTINE HBOOK_INI -C -C--- Initialize the HBOOK -C -C - IMPLICIT NONE -C - INTEGER mxpawc - PARAMETER (mxpawc=1000000) - COMMON/PAWC/ HMEM(mxpawc) - REAL HMEM -C -C - CALL HLIMIT(mxpawc) -C - RETURN - END - diff --git a/src/programs/Simulation/bggen/code/include/amf2com.inc b/src/programs/Simulation/bggen/code/include/amf2com.inc deleted file mode 100644 index 62c4a02eb3..0000000000 --- a/src/programs/Simulation/bggen/code/include/amf2com.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision taa,tm,sfm0 - common/amf2/taa,tm(8,6),sfm0(8) diff --git a/src/programs/Simulation/bggen/code/include/bseocom.inc b/src/programs/Simulation/bggen/code/include/bseocom.inc deleted file mode 100644 index 48f80011dc..0000000000 --- a/src/programs/Simulation/bggen/code/include/bseocom.inc +++ /dev/null @@ -1,4 +0,0 @@ - double precision ois,oir,oi12,eeis,eeir,eei12, - + eei1i2,eb,eeb,tm3 - common/bseo/ois,oir,oi12,eeis,eeir,eei12, - + eei1i2,eb,eeb,tm3(6,4,3) diff --git a/src/programs/Simulation/bggen/code/include/cmpcom.inc b/src/programs/Simulation/bggen/code/include/cmpcom.inc deleted file mode 100644 index 55dbfd99c1..0000000000 --- a/src/programs/Simulation/bggen/code/include/cmpcom.inc +++ /dev/null @@ -1,5 +0,0 @@ - double precision amp,amp2,ap,ap2,aml,aml2,al2,amc2,amh, - + amt,rtara,rtarz,fermom,amm,amn,chbar,barn - integer isf20 - common/cmp/amp,amp2,ap,ap2,aml,aml2,al2,amc2,amh, - + amt,rtara,rtarz,fermom,amm,amn,chbar,barn,isf20 diff --git a/src/programs/Simulation/bggen/code/include/concom.inc b/src/programs/Simulation/bggen/code/include/concom.inc deleted file mode 100644 index 8bd52235e5..0000000000 --- a/src/programs/Simulation/bggen/code/include/concom.inc +++ /dev/null @@ -1,8 +0,0 @@ - real PIE,ALPHA,CHBAR,APRMAS,AMUMAS,AELMAS - double precision DMUPR2,DMUNE2,DPI,DALPI,DCMOTT,DCTSAI,DP26 - double precision DP23,DC1,DC2,DC3,DC4,DC5,DCE,DCM,DCSPEN -C CONSANTS COMMON -C ...MAS= PARTICLE MASSES - COMMON /CONCOM/ PIE,ALPHA,CHBAR,APRMAS,AMUMAS,AELMAS - 1 ,DMUPR2,DMUNE2,DPI,DALPI,DCMOTT,DCTSAI,DP26 - 2 ,DP23,DC1,DC2,DC3,DC4,DC5,DCE,DCM,DCSPEN(14) diff --git a/src/programs/Simulation/bggen/code/include/deltacom.inc b/src/programs/Simulation/bggen/code/include/deltacom.inc deleted file mode 100644 index 6359b947d7..0000000000 --- a/src/programs/Simulation/bggen/code/include/deltacom.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision delta5 - common/delta5/delta5 diff --git a/src/programs/Simulation/bggen/code/include/density.inc b/src/programs/Simulation/bggen/code/include/density.inc deleted file mode 100644 index 91194ee3ea..0000000000 --- a/src/programs/Simulation/bggen/code/include/density.inc +++ /dev/null @@ -1,14 +0,0 @@ - integer nt - integer ntdis,ntpho - integer ntx,nty - parameter(ntdis=35) - parameter(ntpho=44) - parameter(nt=ntpho) - - real*4 denstk,width - real*4 densdis,widdis - real*4 denspho,widpho -* make these arrays large enough for all cases - common/density/ntx,nty,denstk(nt,nt,245,3),width(nt,nt,7,3) - & ,densdis(ntdis,ntdis,245,3),widdis(ntdis,ntdis,7,3) - & ,denspho(ntpho,ntpho,245,3),widpho(ntpho,ntpho,7,3) diff --git a/src/programs/Simulation/bggen/code/include/double.inc b/src/programs/Simulation/bggen/code/include/double.inc deleted file mode 100644 index 5d798976f5..0000000000 --- a/src/programs/Simulation/bggen/code/include/double.inc +++ /dev/null @@ -1 +0,0 @@ - IMPLICIT DOUBLE PRECISION (D) diff --git a/src/programs/Simulation/bggen/code/include/gamcom.inc b/src/programs/Simulation/bggen/code/include/gamcom.inc deleted file mode 100644 index 26600ecc72..0000000000 --- a/src/programs/Simulation/bggen/code/include/gamcom.inc +++ /dev/null @@ -1,8 +0,0 @@ - double precision DSTK,DCTK,DOM,DQ2,DW1J,DW2J,DTK,DPHK - + ,DSITKM,DSIMJ,DCVTKM - + ,DCVMJ,DDELMJ,DDETKM - integer NDXTKM,NDXMJ - COMMON /GAMCOM/ DSTK,DCTK,DOM,DQ2,DW1J,DW2J,DTK,DPHK - + ,DSITKM(245,80),DSIMJ(80),DCVTKM(245,80) - + ,DCVMJ(80),DDELMJ(80),DDETKM(245,80) - + ,NDXTKM(80),NDXMJ diff --git a/src/programs/Simulation/bggen/code/include/intcom.inc b/src/programs/Simulation/bggen/code/include/intcom.inc deleted file mode 100644 index 46fff5bcd9..0000000000 --- a/src/programs/Simulation/bggen/code/include/intcom.inc +++ /dev/null @@ -1,2 +0,0 @@ - integer ISUMMJ - COMMON /INTCOM/ ISUMMJ diff --git a/src/programs/Simulation/bggen/code/include/kincom.inc b/src/programs/Simulation/bggen/code/include/kincom.inc deleted file mode 100644 index 49e0403292..0000000000 --- a/src/programs/Simulation/bggen/code/include/kincom.inc +++ /dev/null @@ -1,15 +0,0 @@ - double precision DM,DM2,DMT,DMT2,DELTA,DEL1 - 1 ,DXX,DYY,DNUNU,DQ2Q2,DCTR,DTR,DSP - 2 ,DES,DES2,DSVEK,DSVEK2,DCTS,DSTS,DTS - 3 ,DEP,DEP2,DPVEK,DPVEK2,DCTP,DSTP,DTP - 4 ,DU2,DU0,DUVEK,DUVEK2 - 5 ,DMJ,DFTSAI -C THIS COMMON CONTAINS KINEMATICAL VARIABLES FOR A GIVEN MUON ARM -C AND A GIVEN TARGET MASS. IT IS FILLED IN THE ROUTINE RADKIN. -C (EXCEPT DMJ WHICH IS FILLED LATER) - COMMON /KINCOM/ DM,DM2,DMT,DMT2,DELTA,DEL1 - 1 ,DXX,DYY,DNUNU,DQ2Q2,DCTR,DTR,DSP - 2 ,DES,DES2,DSVEK,DSVEK2,DCTS,DSTS,DTS - 3 ,DEP,DEP2,DPVEK,DPVEK2,DCTP,DSTP,DTP - 4 ,DU2,DU0,DUVEK,DUVEK2 - 5 ,DMJ,DFTSAI diff --git a/src/programs/Simulation/bggen/code/include/leptou.inc b/src/programs/Simulation/bggen/code/include/leptou.inc deleted file mode 100644 index f902ced340..0000000000 --- a/src/programs/Simulation/bggen/code/include/leptou.inc +++ /dev/null @@ -1,9 +0,0 @@ -* -* to avoid variable conflictions, a second keep element is necessary -* with the same common block name (see LPTOU2) -* - COMMON /LEPTOU/ CUT(14),LST(40),PARL(30), - & X,Y,W2,Q2,U - REAL CUT,PARL,X,Y,W2,Q2,U - INTEGER LST - SAVE /LEPTOU/ diff --git a/src/programs/Simulation/bggen/code/include/mcRadCor.inc b/src/programs/Simulation/bggen/code/include/mcRadCor.inc deleted file mode 100644 index a3b92170fb..0000000000 --- a/src/programs/Simulation/bggen/code/include/mcRadCor.inc +++ /dev/null @@ -1,46 +0,0 @@ - INTEGER mcRadCor, - + mcRadCor_9999 - INTEGER mcRadCor_ID - CHARACTER*4 mcRadCor_cType - REAL mcRadCor_XTrue, - + mcRadCor_YTrue, - + mcRadCor_NuTrue, - + mcRadCor_Q2True, - + mcRadCor_W2True, - + mcRadCor_ThetaBrems, - + mcRadCor_PhiBrems, - + mcRadCor_SigRad, - + mcRadCor_SigCor, - + mcRadCor_SigCorErr, - + mcRadCor_TailIne, - + mcRadCor_TailEla, - + mcRadCor_TailCoh, - + mcRadCor_Vacuum, - + mcRadCor_Vertex, - + mcRadCor_Small, - + mcRadCor_RedFac, - + mcRadCor_EBrems - - COMMON /mcRadCor/ mcRadCor, - + mcRadCor_ID, - + mcRadCor_cType, - + mcRadCor_XTrue, - + mcRadCor_YTrue, - + mcRadCor_NuTrue, - + mcRadCor_Q2True, - + mcRadCor_W2True, - + mcRadCor_ThetaBrems, - + mcRadCor_PhiBrems, - + mcRadCor_SigRad, - + mcRadCor_SigCor, - + mcRadCor_SigCorErr, - + mcRadCor_TailIne, - + mcRadCor_TailEla, - + mcRadCor_TailCoh, - + mcRadCor_Vacuum, - + mcRadCor_Vertex, - + mcRadCor_Small, - + mcRadCor_RedFac, - + mcRadCor_EBrems, - + mcRadCor_9999 - diff --git a/src/programs/Simulation/bggen/code/include/mc_set.inc b/src/programs/Simulation/bggen/code/include/mc_set.inc deleted file mode 100644 index a0e579c2c0..0000000000 --- a/src/programs/Simulation/bggen/code/include/mc_set.inc +++ /dev/null @@ -1,52 +0,0 @@ - common /common_mc_set/ - + mcSet_EneBeam, - + mcSet_TarA, - + mcSet_TarZ, - + mcSet_Q2Min, - + mcSet_Q2Max, - + mcSet_YMin, - + mcSet_YMax, - + qedrad, - + Model, - + genSet_FStruct, - + genSet_R, - + mcSet_PTarget, - + mcSet_PBeam, - + mcSet_XMin, - + mcSet_XMax - save /common_mc_set/ - - integer - + qedrad, - + Model, - + mcSet_TarA, - + mcSet_TarZ - - real - + mcSet_EneBeam, - + mcSet_Q2Min, - + mcSet_Q2Max, - + mcSet_YMin, - + mcSet_YMax, - + mcSet_XMin, - + mcSet_XMax - - character*4 - + genSet_FStruct, - + genSet_R, - + mcSet_PBeam, - + mcSet_PTarget - - common /mcevnt/ - + weight, - + genq2, gennu, genx, geny, genw2, - + genthe, genphi, geneprim, genpprim, - + genpx, genpy, genpz, - + genvx, genvy, genvz - save /mcevnt/ - - real weight, ! event weight - + genq2, gennu, genx, geny, genw2, ! vertex kinematics - + genthe, genphi, geneprim, genpprim, ! scattered lepton - + genpx, genpy, genpz, ! scat lepton 3-vector - + genvx, genvy, genvz diff --git a/src/programs/Simulation/bggen/code/include/mconsp.inc b/src/programs/Simulation/bggen/code/include/mconsp.inc deleted file mode 100644 index 7dd4bd0476..0000000000 --- a/src/programs/Simulation/bggen/code/include/mconsp.inc +++ /dev/null @@ -1,17 +0,0 @@ - - double precision PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS - double precision EMMU,PMASS,AVO,NMASS - - parameter (PI = 3.14159265358979324D0) - parameter (TWOPI = 6.28318530717958648D0) - parameter (PIBY2 = 1.57079632679489662D0) - parameter (DEGRAD = 0.0174532925199432958D0) - parameter (RADDEG = 57.2957795130823209D0) - parameter (CLIGHT = 29979245800.D0) - parameter (BIG = 10000000000.D0) - parameter (EMASS = 0.0005109990615D0) - parameter (EMMU = 0.105658387D0) - parameter (PMASS = 0.9382723128D0) - parameter (AVO = 0.60221367D0) - parameter (NMASS = 0.939566D0) -* diff --git a/src/programs/Simulation/bggen/code/include/phiout.inc b/src/programs/Simulation/bggen/code/include/phiout.inc deleted file mode 100644 index 4ea0eb1c0d..0000000000 --- a/src/programs/Simulation/bggen/code/include/phiout.inc +++ /dev/null @@ -1,7 +0,0 @@ - double precision DPHI,DSUMPH,DDEPHI - + ,DEG,DTHG,DPHIG,DPLABG - integer KMP - character*4 vertextype - COMMON /PHIOUT/ DPHI(61),DSUMPH(61),DDEPHI(61) - + ,DEG,DTHG,DPHIG,DPLABG(3),KMP, - + vertextype diff --git a/src/programs/Simulation/bggen/code/include/polcom.inc b/src/programs/Simulation/bggen/code/include/polcom.inc deleted file mode 100644 index a0940ecfde..0000000000 --- a/src/programs/Simulation/bggen/code/include/polcom.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision as,bs,cs,ae,be,ce,apn,apq,dk2ks,dksp1,dapks - common/pol/as,bs,cs,ae,be,ce,apn,apq,dk2ks,dksp1,dapks diff --git a/src/programs/Simulation/bggen/code/include/ppicom.inc b/src/programs/Simulation/bggen/code/include/ppicom.inc deleted file mode 100644 index e31168cd23..0000000000 --- a/src/programs/Simulation/bggen/code/include/ppicom.inc +++ /dev/null @@ -1,3 +0,0 @@ - double precision pi,pi2,alfa - integer i1,i2 - common/p/pi,pi2,alfa,i1(8),i2(8) diff --git a/src/programs/Simulation/bggen/code/include/py6int1.inc b/src/programs/Simulation/bggen/code/include/py6int1.inc deleted file mode 100644 index 36ed984f29..0000000000 --- a/src/programs/Simulation/bggen/code/include/py6int1.inc +++ /dev/null @@ -1,8 +0,0 @@ - -C----------------------------------------------------------------- - -C...Internal variables. - COMMON/PYINT1/MINT(400),VINT(400) - INTEGER MINT - DOUBLE PRECISION VINT - SAVE/PYINT1/ diff --git a/src/programs/Simulation/bggen/code/include/py6pars.inc b/src/programs/Simulation/bggen/code/include/py6pars.inc deleted file mode 100644 index b9d5b37cd3..0000000000 --- a/src/programs/Simulation/bggen/code/include/py6pars.inc +++ /dev/null @@ -1,8 +0,0 @@ - -C----------------------------------------------------------------- - -C...Parameters. - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - INTEGER MSTP,MSTI - DOUBLE PRECISION PARP,PARI - SAVE/PYPARS/ diff --git a/src/programs/Simulation/bggen/code/include/py6strf.inc b/src/programs/Simulation/bggen/code/include/py6strf.inc deleted file mode 100644 index b535eedcd7..0000000000 --- a/src/programs/Simulation/bggen/code/include/py6strf.inc +++ /dev/null @@ -1,7 +0,0 @@ -* -* to avoid variable conflictions, a second keep element is necessary -* with the same common block name (see LPTOU2) -* - COMMON /py6strf/ py6f1, py6f2, py6R - DOUBLE PRECISION py6f1, py6f2, py6R - SAVE /py6strf/ diff --git a/src/programs/Simulation/bggen/code/include/pypars.inc b/src/programs/Simulation/bggen/code/include/pypars.inc deleted file mode 100644 index 32b330b859..0000000000 --- a/src/programs/Simulation/bggen/code/include/pypars.inc +++ /dev/null @@ -1,4 +0,0 @@ - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - INTEGER MSTP,MSTI - double precision PARP,PARI - SAVE /PYPARS/ diff --git a/src/programs/Simulation/bggen/code/include/radgen.inc b/src/programs/Simulation/bggen/code/include/radgen.inc deleted file mode 100644 index 31feab1099..0000000000 --- a/src/programs/Simulation/bggen/code/include/radgen.inc +++ /dev/null @@ -1,26 +0,0 @@ - real radgen_xmin, radgen_xmax, radgen_ymin, radgen_ymax - - parameter (radgen_xmin=1.0e-09) - parameter (radgen_xmax=0.99) - parameter (radgen_ymin=0.05) - parameter (radgen_ymax=0.95) - - double precision sigrad,tine,tnuc,tpro,tbor,demin,phipoi - + ,sig1g,sigcor,vac,vertex,small,redfac - + ,dsts,dcts - + ,taout,rrout,dsitkm,dcvtkm,ddetkm,dsigmr,drcurr,ddeler - - integer ntk,nrr,itkcur,iphi,ndxtkm - - real sigradu, sigradp, sig1gu, sig1gp - - common /rgencom/sigrad,tine,tnuc,tpro,tbor,demin - + ,sig1g,sigcor,vac,vertex,small,redfac - + ,dsts,dcts - + ,phipoi,taout,rrout - + ,dsitkm(400,3),dcvtkm(400,3),ddetkm(400,3) - + ,dsigmr(200,400),drcurr(200,400),ddeler(200,400) - + ,ntk,nrr ,itkcur,iphi,ndxtkm(3) - + ,sigradu, sigradp, sig1gu, sig1gp - - diff --git a/src/programs/Simulation/bggen/code/include/radgenkeys.inc b/src/programs/Simulation/bggen/code/include/radgenkeys.inc deleted file mode 100644 index 9fd8f5a095..0000000000 --- a/src/programs/Simulation/bggen/code/include/radgenkeys.inc +++ /dev/null @@ -1,4 +0,0 @@ - - integer ixytest, kill_elas_res - real plrun,pnrun - common/radgenkeys/plrun,pnrun,ixytest,kill_elas_res diff --git a/src/programs/Simulation/bggen/code/include/sxycom.inc b/src/programs/Simulation/bggen/code/include/sxycom.inc deleted file mode 100644 index 35f45e3554..0000000000 --- a/src/programs/Simulation/bggen/code/include/sxycom.inc +++ /dev/null @@ -1,4 +0,0 @@ - double precision s,x,sx,sxp,y,ym,w2,als,alx,alm,aly, - + sqls,sqlx,sqly,sqlm,allm,an,tamin,tamax,xs,ys,tpl,tmi - common/sxy/s,x,sx,sxp,y,ym,w2,als,alx,alm,aly, - + sqls,sqlx,sqly,sqlm,allm,an,tamin,tamax,xs,ys,tpl,tmi diff --git a/src/programs/Simulation/bggen/code/include/tailcom.inc b/src/programs/Simulation/bggen/code/include/tailcom.inc deleted file mode 100644 index 2ef5ea75dc..0000000000 --- a/src/programs/Simulation/bggen/code/include/tailcom.inc +++ /dev/null @@ -1,9 +0,0 @@ - real pl,pn - integer ita,isf1,isf2,isf3,ire - double precision qfor,q2bin,ffnuc,un,qn - integer nqbin,nndummy - - common/tail/un,pl,pn,qn,ita,isf1,isf2,isf3,ire - COMMON /FORCOM/ QFOR,Q2BIN,NQBIN,nndummy,FFNUC(600) - - diff --git a/src/programs/Simulation/bggen/code/include/xytabcom.inc b/src/programs/Simulation/bggen/code/include/xytabcom.inc deleted file mode 100644 index a182ae5575..0000000000 --- a/src/programs/Simulation/bggen/code/include/xytabcom.inc +++ /dev/null @@ -1,39 +0,0 @@ - real x,y - + ,sig1g_u,sigrad_u - + ,tbor_u,tine_u,tnuc_u,tpro_u - + ,sig1g_p,sigrad_p - + ,tbor_p,tine_p,tnuc_p,tpro_p - + ,vac_u,vertex_u,small_u,redfac_u - + ,sig1g_udis,sigrad_udis - + ,tbor_udis,tine_udis,tnuc_udis,tpro_udis - + ,sig1g_pdis,sigrad_pdis - + ,tbor_pdis,tine_pdis,tnuc_pdis,tpro_pdis - + ,vac_udis,vertex_udis,small_udis,redfac_udis - + ,sig1g_upho,sigrad_upho - + ,tbor_upho,tine_upho,tnuc_upho,tpro_upho - + ,sig1g_ppho,sigrad_ppho - + ,tbor_ppho,tine_ppho,tnuc_ppho,tpro_ppho - + ,vac_upho,vertex_upho,small_upho,redfac_upho - common/xytab/x(nt),y(nt) - + ,sig1g_u(nt,nt),sigrad_u(nt,nt),tbor_u(nt,nt) - + ,tine_u(nt,nt),tnuc_u(nt,nt),tpro_u(nt,nt) - + ,sig1g_p(nt,nt),sigrad_p(nt,nt),tbor_p(nt,nt) - + ,tine_p(nt,nt),tnuc_p(nt,nt),tpro_p(nt,nt) - + ,vac_u(nt,nt),vertex_u(nt,nt),small_u(nt,nt) - + ,redfac_u(nt,nt) - + ,sig1g_udis(ntdis,ntdis),sigrad_udis(ntdis,ntdis) - + ,tbor_udis(ntdis,ntdis),tine_udis(ntdis,ntdis) - + ,tnuc_udis(ntdis,ntdis),tpro_udis(ntdis,ntdis) - + ,sig1g_pdis(ntdis,ntdis),sigrad_pdis(ntdis,ntdis) - + ,tbor_pdis(ntdis,ntdis),tine_pdis(ntdis,ntdis) - + ,tnuc_pdis(ntdis,ntdis),tpro_pdis(ntdis,ntdis) - + ,vac_udis(ntdis,ntdis),vertex_udis(ntdis,ntdis) - + ,small_udis(ntdis,ntdis),redfac_udis(ntdis,ntdis) - + ,sig1g_upho(ntpho,ntpho),sigrad_upho(ntpho,ntpho) - + ,tbor_upho(ntpho,ntpho),tine_upho(ntpho,ntpho) - + ,tnuc_upho(ntpho,ntpho),tpro_upho(ntpho,ntpho) - + ,sig1g_ppho(ntpho,ntpho),sigrad_ppho(ntpho,ntpho) - + ,tbor_ppho(ntpho,ntpho),tine_ppho(ntpho,ntpho) - + ,tnuc_ppho(ntpho,ntpho),tpro_ppho(ntpho,ntpho) - + ,vac_upho(ntpho,ntpho),vertex_upho(ntpho,ntpho) - + ,small_upho(ntpho,ntpho),redfac_upho(ntpho,ntpho) diff --git a/src/programs/Simulation/bggen/code/lowen_eve.F b/src/programs/Simulation/bggen/code/lowen_eve.F deleted file mode 100644 index 82ec26b266..0000000000 --- a/src/programs/Simulation/bggen/code/lowen_eve.F +++ /dev/null @@ -1,291 +0,0 @@ - SUBROUTINE LOWEN_EVE(IERR) -C -C--- Simulates 1 event of low energy (<3 GeV) photoproduction -C Reaction: gamma+p -C IDLOWEN - is the starting number of a set of predefined histograms with E,cos(th) distributions -C -C Processes: -C 1) p pi0 -C 2) n pi+ -C 3) p pi+ pi- non res -C 4) p rho0 -C 5) Delta++ pi- -C 6) p pi0 pi0 -C 7) n pi+ pi0 -C 8) p eta -C 9) p pi+ pi- pi0 -C 10) n pi+ pi+ pi- -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_evec.inc' -C - REAL HRNDM1,RNDM,HI,GBRWIGN - LOGICAL HEXIST -C - INTEGER i,j,ip,np,ibin,nproc,iproc,ityp,ihi,ierr1,ntry,ires - + ,id1,ifla,ityd,ntry1,ihel,np1 - REAL ebeam,xstot,xssum,xstmp,rnd,ecm,ecm2,bet(4),qq,ct,st,phi,wgt - + ,twopi - + ,amtot ! sum of the masses - + ,pcmm(4) ! 4-mom of the mesons - + ,betm(4) ! vel of CM as seen from the rest frame of the mesons - + ,ppf,epf1,epf2,ppi,tt,tmn,tmx,amdec,amd(6),xfac,pcms(4),par(6) - + ,wdm -C - REAL ami(2),pcmi(4,2),plabi(4,2) - + ,am(MXOUT),pcm(4,MXOUT),plab(4,MXOUT) - + ,wgt4mx(MXPROC) ! max weight for the 4-body process (potentially, for each process) - INTEGER ity(MXOUT),ndec(MXOUT),kdec(3,MXOUT),kdectyp(MXOUT) - + ,it1dec(MXOUT),itorig(MXOUT) -C - DATA wgt4mx/10*-1./ -C -C ------------------------------------------------------------------ -C - IERR=1 - IEVPROC=-1 - nproc=MXPROC ! number of defined processes -C -C--- Beam energy -C - ebeam=PIN(3,1) - CALL HXI(IDBEAM,ebeam,ibin) ! get ibin - the bin number for this energy -C - NTRA=0 -C -C--- Initial state (beam goes along Z - no rotation applied) -C - DO i=1,2 - ami(i)=AMIN(i) - DO j=1,3 - plabi(j,i)=PIN(j,i) - ENDDO - qq=plabi(1,i)**2+plabi(2,i)**2+plabi(3,i)**2 - plabi(4,i)=SQRT(qq+ami(i)**2) - ENDDO - DO j=1,4 - pcms(j)=plabi(j,1)+plabi(j,2) - ENDDO -C -C write(6,*) 'ami', ami,plab(4,1),plab(4,2) - ecm2=ami(1)**2+ami(2)**2+2.*plabi(4,1)*plabi(4,2) - ecm=SQRT(ecm2) -C -C--- Choose a process -C - xstot=HI(IDBEAM+10,ibin) - xssum=HI(IDLOWEN+15,ibin) ! sum of all processes -C write(6,*) ' xstot..', IEVENT,xstot,xssum - IF(xstot.LE.0.) GO TO 999 ! no simulation (low energy?) - IF(xssum.LE.0.) GO TO 999 -C - xstmp=0. - rnd=RNDM(xstmp) - iproc=1 - DO i=1,nproc-1 - xstmp=xstmp+HI(IDLOWEN+10000*iproc,ibin)/xssum - IF(xstmp.GE.rnd) GO TO 20 - iproc=i+1 - ENDDO - 20 CONTINUE -C - IEVPROC=iproc -C - ntry=0 - 30 np=0 - ntry=ntry+1 - amtot=0. - ires=0 - DO ip=1,MXOUT - ityp=ITYPROC(ip,IEVPROC) - IF(ityp.GT.0.AND.ityp.LE.MXPART) THEN - np=np+1 - ity(np)=ityp - am(np)=AM_PART(ityp) - amdec=0. - ndec(np)=0 - itorig(np)=0 - it1dec(np)=0 - DO i=1,3 - ityd=KD_PART(i,ityp) - IF(ityd.GT.0.AND.ityd.LE.MXPART) THEN - ndec(np)=ndec(np)+1 - kdec(ndec(np),np)=ityd - amdec=amdec+AM_PART(ityd) - ENDIF - ENDDO - kdectyp(np)=KD_PART(4,ityp) - IF(WG_PART(ityp).GT.0.) THEN - ires=1 - ntry1=0 - 35 ntry1=ntry1+1 - wdm=WG_PART(ityp)*GBRWIGN(am) -C write(6,*) am(np),wdm,amdec - IF(am(np)+wdm.LT.amdec+0.01) THEN - IF(ntry1.LT.1000) GO TO 35 - WRITE(6,*) ' *** BGGEN_EVE unsuff mass for decay ' - + ,ityp,am(np),wdm,am(np)+wdm,amdec - GO TO 999 - ENDIF - am(np)=am(np)+wdm - ENDIF - amtot=amtot+am(np) - ENDIF - ENDDO -C write(6,*) ' np..', np,amtot,ecm-0.01 - IF(np.LT.1) GO TO 999 - IF(amtot.GE.ecm-0.01) THEN - IF(ntry.LT.1000) GO TO 30 - GO TO 999 - ENDIF -C - DO i=1,3 - bet(i)=(plabi(i,1)+plabi(i,2))/(plabi(4,1)+plabi(4,2)) - ENDDO - bet(4)=(plabi(4,1)+plabi(4,2))/ecm - DO i=1,2 - CALL GLOREN(bet,plabi(1,i),pcmi(1,i)) - ENDDO - DO i=1,3 - bet(i)=-bet(i) - ENDDO -C -C--- Treat the kinematics as 2-body one, in CM -C - twopi=ACOS(0.)*4. - ierr1=1 - IF(np.EQ.2) THEN -C IF(IEVPROC.LE.2.OR. ! SAID -C + IEVPROC.EQ.6 ! eta -C + ) THEN -C--- In CM: momentum and energies of the particles -C - epf1=(ecm2+am(1)**2-am(2)**2)/2./ecm - ppf =SQRT(epf1**2-am(1)**2) ! final momentum - ppi=SQRT(pcmi(4,2)**2-ami(2)**2) ! initial momentum - IF(ppf.LE.0.) GO TO 999 -C - id1=IDLOWEN+10000*IEVPROC - ihi=0 - IF(HEXIST(id1+1)) THEN - ihi=INT(HI(id1+1,ibin)+0.1) - IF(ihi.GT.0) THEN - ct= HRNDM1(id1+10+ihi) - ct=-ct ! first particle is the recoil - invert the COS(TH) - ierr1=0 - ENDIF - ENDIF - IF(ierr1.NE.0) THEN - qq=ami(2)**2+am(1)**2-2.*epf1*pcmi(4,2) - tmn=-(qq+2.*ppf*ppi) - tmx=-(qq-2.*ppf*ppi) - CALL GPXCOSTHR(IEVPROC,ebeam,tmn,tmx,ct,ierr1) ! generated for the secondary baryon - ENDIF - IF(ierr1.NE.0) THEN - WRITE(6,*) ' *** Error in simulating COS(TH) ',ierr1 - + ,' proc=',IEVPROC - ENDIF -C - st=SQRT(1.-ct**2) - phi=twopi*RNDM(st) -C -C--- 2-body -C - pcm(4,1)=epf1 -C - pcm(1,1)=ppf*st*COS(phi) - pcm(2,1)=ppf*st*SIN(phi) - pcm(3,1)=ppf*ct -C - DO i=1,3 - pcm(i,2)=-pcm(i,1) - ENDDO - pcm(4,2)=ecm-pcm(4,1) -C -C--- Boost to Lab -C - DO i=1,2 - CALL GLOREN(bet,pcm(1,i),plab(1,i)) - ENDDO -C -C--- Decays? -C - DO i=1,2 - IF(ndec(i).GT.0) THEN - it1dec(i)=np+1 - DO j=1,ndec(i) - amd(j)=AM_PART(kdec(j,i)) - am (np+j)=amd(j) - ity(np+j)=kdec(j,i) - ndec(np+j)=0 - itorig(np+j)=i - it1dec(np+j)=0 - ENDDO - IF(ndec(i).EQ.2) THEN ! 2-body decay - ihel=kdectyp(i) ! decay angle flag =0 - unoform, =1 - rho-like, =2 - j/psi-like - CALL OMDECA2(plab(1,i),amd(1),ihel,plab(1,np+1)) - ELSE IF(ndec(i).EQ.3) THEN - CALL OMDECA3(plab(1,i),amd(1),0.,plab(1,np+1)) - ENDIF - np=np+ndec(i) - ENDIF - ENDDO -C - ELSE IF(np.EQ.3) THEN -C - xfac=0. - CALL OMDECA3(pcms(1),am(1),xfac,plab(1,1)) -C - ELSE IF(np.EQ.4) THEN -C -C--- Phase space: -C - IF(wgt4mx(IEVPROC).LT.0.) THEN ! initialize the max weight - DO i=1,20000 - wgt=0. - CALL GDECAN(np,ecm,am,wgt,pcm(1,1)) - wgt4mx(IEVPROC)=MAX(wgt4mx(IEVPROC),wgt) - ENDDO - wgt4mx(IEVPROC)=wgt4mx(IEVPROC)*1.2 - ENDIF - wgt=wgt4mx(IEVPROC) - CALL GDECAN(np,ecm,am,wgt,pcm(1,1)) - DO i=1,np - CALL GLOREN(bet,pcm(1,i),plab(1,i)) - ENDDO -C - ENDIF -C - DO i=1,np - DO j=1,3 - PTRA(j,i)=plab(j,i) - ENDDO - AMTRA(i)=am(i) - ITPTRA(1,i)=ity(i) - DO j=2,6 - ITPTRA(j,i)=0 - ENDDO -C write(6,*) i,ity(i),MXPGEANT,IPLUND(ity(i)),itorig(i),it1dec(i) - IF(ity(i).GT.0.AND.ity(i).LE.MXPGEANT) THEN - ITPTRA(3,i)=IPLUND(ity(i)) - ENDIF - ITPTRA(4,i)=itorig(i) - ITPTRA(5,i)=it1dec(i) - IF(it1dec(i).GT.0) ITPTRA(6,i)=it1dec(i)+ndec(i)-1 - ITPTRA(2,i)=1 - IF(it1dec(i).NE.0) ITPTRA(2,i)=10 ! indicates that this particle should not be used in GEANT - ENDDO - NTRA=np -C - IERR=0 - 999 CONTINUE -C write(6,*) ebeam,IEVPROC,ibin,xstot,xssum,NTRA -C - END -C - diff --git a/src/programs/Simulation/bggen/code/lowen_ini.F b/src/programs/Simulation/bggen/code/lowen_ini.F deleted file mode 100644 index c4e27b7618..0000000000 --- a/src/programs/Simulation/bggen/code/lowen_ini.F +++ /dev/null @@ -1,142 +0,0 @@ - SUBROUTINE LOWEN_INI(IERR) -C -C--- Low energy photoproduction initialization -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' -C - REAL SAIDE,SAIDXSECA,GPXSECP - LOGICAL HEXIST -C - INTEGER i,j,nb,ipro,npro,id1,idt,ncth,icth,ihi,lun,iost - + ip,lout - REAL emn,emx,flx1,flx2,flx,xsec,dx,de,e,dcth,cth - + ,xlum,ecurr,xsth,targth,frate -C - CHARACTER tit*132,cpro*2,cenr*4,cline*132 -C - CHARACTER cnampro(MXPROC)*16 - DATA cnampro/'p pi0 ' - + ,'n pi+ ' - + ,'p pi+ pi- ' - + ,'p rho0 ' - + ,'Delta++ pi- ' - + ,'p pi0 pi0 ' - + ,'n pi+ pi0 ' - + ,'p eta ' - + ,'p pi+ pi- pi0 ' - + ,'n pi+ pi+ pi- ' - + / -C - INTEGER itypr(MXOUT,MXPROC) - DATA itypr/14, 7, 0, 0, 0, 0 - + ,13, 8, 0, 0, 0, 0 - + ,14, 8, 9, 0, 0, 0 - + ,14,80, 0, 0, 0, 0 - + ,82, 9, 0, 0, 0, 0 - + ,14, 7, 7, 0, 0, 0 - + ,13, 8, 7, 0, 0, 0 - + ,14,17, 0, 0, 0, 0 - + ,14, 8, 9, 7, 0, 0 - + ,13, 8, 8, 9, 0, 0 - + / -C - IERR=1 - lout=6 -C - DO i=1,MXPROC - CNPROC(i)=cnampro(i) - DO j=1,MXOUT - ITYPROC(j,i)=itypr(j,i) - ENDDO - ENDDO -C -C - IF(NHBEA.LT.1) THEN - WRITE(6,1010) NHBEA - 1010 FORMAT(' *** Initialization error: NHBEA=',I6) - GO TO 999 - ENDIF -C - emn=EPH_LIM(1) - emx=MIN(EPYMIN,EPH_LIM(2)) -C -C--- Adjust the emx to the bin boundary -C - de=(EPH_LIM(2)-EPH_LIM(1))/NHBEA - nb=INT((emx-emn)/de) - emx=emn+nb*de - EPYMIN=emx -C -C--- Initialize the processes -C - npro=10 ! number of defined processes - ncth=100 ! number of bins in the COS(th) distribution - dcth=2./ncth - DO ipro=1,npro - id1=IDLOWEN+10000*ipro - WRITE(cpro,FMT='(I2)') ipro - CALL HBOOK1(id1,'X-section for process '//cpro,nb,emn,emx,0.) -C -C--- Define the COS(TH) plots? -C - IF(ipro.LE.2.OR. ! SAID - + ipro.EQ.8) THEN ! eta - CALL HBOOK1(id1+1,'refer for COS(TH) for process '//cpro - + ,nb,emn,emx,0.) - ENDIF -C - DO i=1,nb - e=emn+(i-0.5)*de -C -C--- Full x-section -C - IF(ipro.LE.2) THEN -C -C--- SAID is used -C - xsec=SAIDE(e,ipro,1) ! SAID cross section, supressed above 2 GeV - ihi=i - ELSE - xsec=GPXSECP(e,ipro) ! x-sec in mb - ihi=0 -C CALL GPXCOSTH(e,ipro,0.,ihi,xsth) ! check the COS(th) distribution - ENDIF -C - CALL HF1(id1,e,xsec) - CALL HF1(id1+1,e,REAL(ihi)) -C -C--- Get the cos(th) distributions -C - idt=id1+10+ihi - IF(ihi.NE.0.AND..NOT.HEXIST(idt)) THEN ! fill the COS(th) distrib if not yet filled - WRITE(cenr,FMT='(I4)') i - CALL HBOOK1(idt,'COS(TH), proc '//cpro//' energy '//cenr - + ,ncth,-1.,1.,0.) - DO icth=1,ncth - cth=-1.+(icth-0.5)*dcth - IF(ipro.LE.2) THEN - xsth=SAIDXSECA(e,cth,ipro,1) - ELSE -C CALL GPXCOSTH(e,ipro,cth,ihi,xsth) ! get the COS(th) distribution - ENDIF - CALL HF1(idt,cth,xsth) - ENDDO - ENDIF - ENDDO -C - IF(ipro.EQ.1) THEN - CALL HCOPY(id1,IDLOWEN+15,'X-section for all process ') - ELSE - CALL HOPERA(id1,'+',IDLOWEN+15,IDLOWEN+15,1.,1.) - ENDIF -C - ENDDO -C - IERR=0 - 999 RETURN - END diff --git a/src/programs/Simulation/bggen/code/omdeca2.F b/src/programs/Simulation/bggen/code/omdeca2.F deleted file mode 100644 index fd48699174..0000000000 --- a/src/programs/Simulation/bggen/code/omdeca2.F +++ /dev/null @@ -1,133 +0,0 @@ - SUBROUTINE OMDECA2(P0,AM,IHEL,POUT) -C -C--- 2-body decay -C -C--- Input: P0 - initial 4-vector, P0**2 - mass(energy) of the initial state, -C defined in the "LAB" frame -C AM(1:2) - masses of the products -C IHEL: =0 - cos(th) (to P0 direction) uniform of the 1-st particle -C =1 - sin(th)**2=(1-cos(th)**2) - for 1-->0+0 rho -C =2 - (1+cos(th)**2) - for 2-->1/2+1/2 psi -C -C Output: POUT(1:4,1:2) - the secondary 4-momenta -C -C - - IMPLICIT NONE - REAL P0(4),AM(2),POUT(4,2) - INTEGER IHEL -C - REAL RNDM,ORNDPOLY -C - REAL pp(4,2) ! CM, Z looks along P0 - + ,pcm(4,2) ! CM, lab orientation - + ,bet(4) - + ,ecms,ecm,epf1,ppf,ct,st,phi - + ,rot(3,3),poly(10),xlim(2),p0m,twopi - INTEGER i,j -C -C--- -C - DO i=1,2 - DO j=1,4 - POUT(j,i)=0. - ENDDO - ENDDO -C - ecms=P0(4)**2-P0(1)**2-P0(2)**2-P0(3)**2 - IF(ecms.LE.0.) THEN - WRITE(6,*) ' *** OMDECA2 space-like initial vector ',ecms,P0 - GO TO 999 - ENDIF - ecm=SQRT(ecms) - IF(ecm.LE.AM(1)+AM(2)) THEN - WRITE(6,*) ' *** OMDECA2 below threshold ',ecm,AM - GO TO 999 - ENDIF -C - epf1=(ecms+AM(1)**2-AM(2)**2)/2./ecm - ppf=SQRT(epf1**2-AM(1)**2) -C - IF(IHEL.EQ.0) THEN - ct=-1.+2.*RNDM(ct) - ELSE - xlim(1)=-1. - xlim(2)= 1. - IF(IHEL.EQ.1) THEN - poly(1)= 1. ! 1-ct**2 rho 1 --> 0 0 - poly(2)= 0. ! - poly(3)=-1. ! - ELSE IF(IHEL.EQ.2) THEN - poly(1)= 1. ! 1+ct**2 jpsi 1 --> 1/2 1/2 - poly(2)= 0. ! - poly(3)= 1. ! - ENDIF - ct=ORNDPOLY(2,poly,xlim) - IF(ct.LT.-2.) THEN - WRITE(6,*) ' *** OMDECA2 ct= ',ct,ecm,IHEL - GO TO 999 - ENDIF - IF(ABS(ct).GT.1.) THEN - WRITE(6,*) ' *** OMDECA2 err ct= ',ct,ecm,IHEL - ENDIF - ENDIF -C - twopi=ACOS(0.)*4. -C - st=SQRT(1.-ct**2) - phi=twopi*RNDM(st) -C -C--- 2-body -C - pp(4,1)=epf1 -C - pp(1,1)=ppf*st*COS(phi) - pp(2,1)=ppf*st*SIN(phi) - pp(3,1)=ppf*ct -C - DO j=1,3 - pp(j,2)=-pp(j,1) - ENDDO - pp(4,2)=ecm-pp(4,1) -C -C--- Rotate to the frame where Z goes along P0 -C - p0m=SQRT(P0(1)**2+P0(2)**2+P0(3)**2) - IF(p0m.GT.0.00001) THEN - CALL OMROTS(P0,rot) - DO i=1,2 - CALL OMROTV(pp(1,i),rot,pcm(1,i)) - pcm(4,i)=pp(4,i) - ENDDO -C write(6,FMT='(A4,4F10.4)') 'p0= ' ,(P0 (j),j=1,4) -C write(6,FMT='(3F10.4)') ct,pp(3,1)/ppf -C + ,(pcm(1,1)*P0(1)+pcm(2,1)*P0(2)+pcm(3,1)*P0(3))/ppf/p0m - ELSE - DO i=1,2 - DO j=1,4 - pcm(j,i)=pp(j,i) - ENDDO - ENDDO - ENDIF -C -C--- Boost to Lab -C - bet(4)=p0(4)/ecm - DO j=1,3 - bet(j)=-P0(j)/P0(4) - ENDDO - DO i=1,2 - CALL GLOREN(bet,pcm(1,i),POUT(1,i)) - ENDDO -C -C write(6,*) 'p0=',p0,ecm -C write(6,FMT='(3F10.4)') rot -C write(6,FMT='(4F10.5)') bet -C write(6,FMT='(A4,4F10.4)') ('pp= ' ,(pp (j,i),j=1,4),i=1,2) -C write(6,FMT='(A4,4F10.4)') ('pcm=' ,(pcm(j,i),j=1,4),i=1,2) -C write(6,FMT='(A4,4F10.4)')'dif=',(P0(j)-POUT(j,1)-POUT(j,2),j=1,4) -C write(6,FMT='(A4,4F10.4)') ('lab=' ,(POUT(j,i),j=1,4),i=1,2) -C - 999 RETURN - END - diff --git a/src/programs/Simulation/bggen/code/omdeca3.F b/src/programs/Simulation/bggen/code/omdeca3.F deleted file mode 100644 index 7b350e9c3d..0000000000 --- a/src/programs/Simulation/bggen/code/omdeca3.F +++ /dev/null @@ -1,181 +0,0 @@ - SUBROUTINE OMDECA3(P0,AM,XFAC,POUT) -C -C--- 3-body phase space decays/reactions -C -C--- Input: P0 - initial 4-vector, P0**2 - mass(energy) of the initial state, -C defined in the "LAB" frame -C AM(1:3) - masses of the products -C XFAC: generate the COS(TH) (of 23 to P0 direction in CM) as EXP(XFAC*COSTH) -C =0. - uniform distribution form -1 to 1 -C -C Output: POUT(1:4,1:3) - the secondary 4-momenta -C -C -C==== Method: dG = const * dm12**2 * dm23**2 -C==== 1) simulate m12**2,m23**2 in the allowed intervals, independently -C 2) reject kinematically forbidden combinations (no reordering of random numbers) -C 2) using m23**2: -C calculate e1a,p1a in CM of 1+2+3 -C calculate e2b,p2b in CM of 2+3 -C 1 is sent along -Z -C 2) calculate the COS(TH) of m23 decay in its CM, from m12 and e1a,p1a,e2b,p2b -C 3) if no solution exists - jump to 1) -C 4) rotate the event (3 random angles) -C - IMPLICIT NONE - REAL P0(4),AM(3),XFAC,POUT(4,3) -C - REAL RNDM -C - REAL pp(4,3) ! CM, 1 along -Z, 2,3 - in ZX plane - + ,ppv(4,3) ! CM, in this frame Z is along P0 - + ,vm(3) ! direction of the 23 combination in CM, LAB angles - + ,am12s,am23s,am12,am23,rnd(2),q,ams(3),ecm,ecms - + ,p1a,e1a,p2b,e2b,costh,bet,gam,twopi,phi,phi2,ct,st - + ,rot(3,3),p0m,betap(4) - INTEGER i,j,ntry -C -C--- -C - DO i=1,3 - DO j=1,4 - POUT(j,i)=0. - ENDDO - ENDDO - ecms=P0(4)**2-P0(1)**2-P0(2)**2-P0(3)**2 - IF(ecms.LE.0.) THEN - WRITE(6,*) ' *** OMDECA3 space-like initial vector ',ecms,P0 - GO TO 999 - ENDIF - ecm=SQRT(ecms) - IF(ecm.LE.AM(1)+AM(2)+AM(3)) THEN - WRITE(6,*) ' *** OMDECA3 below threshold ',ecm,AM - GO TO 999 - ENDIF - DO i=1,3 - ams(i)=AM(i)**2 - ENDDO - ntry=0 -C - 10 ntry=ntry+1 - IF(ntry.GT.10000) THEN - WRITE(6,*) ' *** OMDECA3 error - long looping, ntry=',ntry - GO TO 999 - ENDIF - DO i=1,2 - rnd(i)=RNDM(rnd(i)) - ENDDO - q=(AM(1)+AM(2))**2 - am12s=q+rnd(1)*((ecm-AM(3))**2-q) - q=(AM(2)+AM(3))**2 - am23s=q+rnd(2)*((ecm-AM(1))**2-q) - am12=SQRT(am12s) - am23=SQRT(am23s) -C - q=ecms+ams(1)+ams(2)+ams(3)-am12s - IF(am23s.GE.q-(AM(1)+AM(3))**2) GO TO 10 - IF(am23s.LE.q- (ecm-AM(2))**2) GO TO 10 -C - e1a=(ecms+ams(1)-am23s)/2./ecm - p1a=SQRT(e1a**2-ams(1)) - e2b=(am23s+ams(2)-ams(3))/2./am23 - p2b=SQRT(e2b**2-ams(2)) -C -C--- am23 goes along Z -C--- Lorentz boost to am23: -C - bet=p1a/(ecm-e1a) - gam=(ecm-e1a)/am23 -C - costh=(am12s-ams(1)-ams(2)-2.*gam*e2b*(e1a+bet*p1a))/ - + (2.*gam*p2b*(p1a+bet*e1a)) - IF(ABS(costh).GT.1.) GO TO 10 -C - DO i=1,3 - DO j=1,4 - pp(j,i)=0. - ENDDO - ENDDO -C - pp(3,1)=-p1a - pp(4,1)= e1a - pp(1,2)= p2b*SQRT(1.-costh**2) - pp(3,2)= gam*(p2b*costh+bet*e2b) - pp(4,2)= gam*(e2b +bet*p2b*costh) - DO i=1,3 - pp(i,3)=-pp(i,1)-pp(i,2) - ENDDO - pp(4,3)=ecm-pp(4,1)-pp(4,2) -C - twopi=4.*ACOS(0.) -C -C--- Rotate 2,3 around Z -C - phi2=twopi*RNDM(twopi) - DO i=2,3 - q=pp(1,i) - pp(1,i)=q*COS(phi2) - pp(2,i)=q*SIN(phi2) - ENDDO -C -C--- Random polar angle (apply exponential COSTH-dep, if needed) -C - IF(ABS(XFAC).GT.0.001) THEN - ct=LOG(EXP(-XFAC)+RNDM(ct)*(EXP(XFAC)-EXP(-XFAC)))/XFAC - ELSE - ct=-1.+RNDM(ct)*2. - ENDIF -C - phi=twopi*RNDM(phi) - st=SQRT(1.-ct**2) - vm(1)=st*COS(phi) ! the direction of 23 combination in LAB, CM - vm(2)=st*SIN(phi) - vm(3)=ct -C - CALL OMROTS(vm,rot) ! rotate the momenta to this frame - DO i=1,3 - CALL OMROTV(pp(1,i),rot,ppv(1,i)) - ppv(4,i)=pp(4,i) - ENDDO -C -C--- Rotate to the frame where Z goes along P0 -C - p0m=SQRT(P0(1)**2+P0(2)**2+P0(3)**2) - IF(p0m.GT.0.00001) THEN - CALL OMROTS(P0,rot) - DO i=1,3 - CALL OMROTV(ppv(1,i),rot,pp(1,i)) - pp(4,i)=ppv(4,i) - ENDDO - ELSE - DO i=1,3 - DO j=1,4 - pp(j,i)=ppv(j,i) - ENDDO - ENDDO - ENDIF -C -C--- Lorentz boost to P0 -C - q=0. - DO i=1,3 - betap(i)=-P0(i)/P0(4) - q=q+betap(i)**2 - ENDDO -C - IF(q.GT.1.E-10) THEN - betap(4)=P0(4)/ecm - DO i=1,3 - CALL GLOREN(betap(1),pp(1,i),POUT(1,i)) - ENDDO - ELSE - DO i=1,3 - DO j=1,3 - POUT(j,i)=pp(j,i) - ENDDO - ENDDO - ENDIF -C - 999 RETURN - END - diff --git a/src/programs/Simulation/bggen/code/omrots.F b/src/programs/Simulation/bggen/code/omrots.F deleted file mode 100644 index 14e36bfe95..0000000000 --- a/src/programs/Simulation/bggen/code/omrots.F +++ /dev/null @@ -1,85 +0,0 @@ -* $Header:$ -* $Log:$ -* - SUBROUTINE OMROTS(V,ROT) -C -C ****************************************************************** -C * * -C * Fill a rotation matrix V=ROT*V1 * -C * INPUT: V - 3 vector * -C * OUTPUT: ROT - rotation matrix (V1 looks along Z) * -C * * -C * ==>Called by : kinematics programs * -C * * -C ****************************************************************** -C - IMPLICIT NONE - REAL V(3),ROT(3,3) -C -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id:$'/ -C#endif -C - INTEGER i,j,mn,mx,m3 - REAL ptot,vn(3),vx(3),q -C -C ------------------------------------------------------------------ -C - ptot=SQRT(V(1)**2+V(2)**2+V(3)**2) - IF(ptot.GT.0.) THEN - - DO i=1,3 - vn(i)=V(i)/ptot - ROT(3,i)=vn(i) - ENDDO -C -C--- Define X-Y (arbitrary) - a vector normal to vn -C - mn=1 - DO i=2,3 - IF(ABS(vn(i)).LT.ABS(vn(mn))) mn=i - ENDDO - mx=3 - DO i=1,2 - IF(ABS(vn(i)).GT.ABS(vn(mx))) mx=i - ENDDO - m3=mn+1 - IF(m3.GT.3) m3=m3-3 - IF(m3.EQ.mx) m3=m3+1 - IF(m3.GT.3) m3=m3-3 -C--- condition: vx*vn=0. - vx(mx)=0. - vx(mn)=1. - vx(m3)=0. - IF(vn(m3).NE.0.) vx(m3)=-vn(mn)*vx(mn)/vn(m3) - q=SQRT(1.+vx(m3)**2) - DO i=1,3 - vx(i)=vx(i)/q - ENDDO -C - DO i=1,3 - ROT(1,i)=vx(i) - ENDDO -C -C--- Y-coord -C - ROT(2,1)= vn(2)*vx(3)-vn(3)*vx(2) - ROT(2,2)=-vn(1)*vx(3)+vn(3)*vx(1) - ROT(2,3)= vn(1)*vx(2)-vn(2)*vx(1) -C - ELSE - DO i=1,3 - DO j=1,3 - IF(j.EQ.i) THEN - ROT(j,i)=1. - ELSE - ROT(j,i)=0. - ENDIF - ENDDO - ENDDO - ENDIF -C - RETURN - END diff --git a/src/programs/Simulation/bggen/code/omrotv.F b/src/programs/Simulation/bggen/code/omrotv.F deleted file mode 100644 index f72b415185..0000000000 --- a/src/programs/Simulation/bggen/code/omrotv.F +++ /dev/null @@ -1,41 +0,0 @@ -* $Header:$ -* $Log:$ -* - SUBROUTINE OMROTV(V1,ROT,V2) -C -C ****************************************************************** -C * * -C * Vector rotation V1 ==> V2 using ROT matrix * -C * * -C * ==>Called by : OMKINE * -C * * -C ****************************************************************** -C - IMPLICIT NONE - REAL V1(3),ROT(3,3),V2(3) -C -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id:$'/ -C#endif -C - INTEGER i,j -C -C ------------------------------------------------------------------ -C - DO i=1,3 - V2(i)=0. - DO j=1,3 - V2(i)=V2(i)+ROT(j,i)*V1(j) - ENDDO - ENDDO -C - RETURN - END - - - - - - diff --git a/src/programs/Simulation/bggen/code/orndpoly.F b/src/programs/Simulation/bggen/code/orndpoly.F deleted file mode 100644 index 2b49c641be..0000000000 --- a/src/programs/Simulation/bggen/code/orndpoly.F +++ /dev/null @@ -1,97 +0,0 @@ - REAL FUNCTION ORNDPOLY(NP,RP,XLIM) -C -C--- Generate a random number to a polynomial distribution (NP<3): -C RP(0)+RP(1)*X**1+...+RP(NP)*X**NP -C in an interval XLIM(1):XLIM(2) - IMPLICIT NONE - INTEGER NP - REAL RP(0:NP),XLIM(2) -C - REAL RNDM -C - INTEGER i,j,np1,np2,nsol,nrusf - REAL p(0:20) ! - integral polynomial - + ,anorm,xx,qq,rnd,xres(20) -C - DOUBLE PRECISION dp(0:20),dx(10),dd -C - ORNDPOLY=-9999. - xx=0. - IF(NP.LT.0) GO TO 999 - IF(XLIM(1).GE.XLIM(2)) GO TO 999 -C -C--- Integrate the polynomial -C - np1=NP+1 - p(0)=0. - DO i=1,np1 - p(i)=RP(i-1)/REAL(i) - p(0)=p(0)-p(i)*XLIM(1)**i ! normalization: =0 at XLIM(1) - ENDDO -C - anorm=0. - DO i=0,np1 - anorm=anorm+p(i)*XLIM(2)**i ! normalization: =1 at XLIM(2) - ENDDO - np2=1 ! the real power of the polynomial - DO i=0,np1 - p(i)=p(i)/anorm - IF(ABS(p(i)).GT.1.E-15) np2=i - ENDDO -C - IF(np2.LT.1) GO TO 999 -C - rnd=RNDM(dx) - p(0)=p(0)-rnd -C - nsol=0 - IF(np2.EQ.1) THEN ! flat distr - xx=XLIM(1)+rnd*(XLIM(2)-XLIM(1)) - nsol=1 -C - ELSE IF(np2.EQ.2) THEN ! linear -C - qq=p(1)**2-4.*p(0)*p(2) - IF(qq.LT.0.) THEN - WRITE(6,*) ' *** ORNDPOLY err 1, NP=',NP - GO TO 999 - ENDIF - xres(1)=(-p(1)-SQRT(qq))/(2.*p(2)) - xres(2)=(-p(1)+SQRT(qq))/(2.*p(2)) - DO i=1,2 - IF(xres(i).GE.XLIM(1).AND.xres(i).LE.XLIM(2)) THEN - xx=xres(i) - nsol=nsol+1 - ENDIF - ENDDO -C - ELSE IF(np2.EQ.3) THEN ! 2-nd, 3-rd for the integral -C - DO i=0,np2-1 - dp(i)=p(i)/p(np2) - ENDDO -C - CALL DRTEQ3(dp(2),dp(1),dp(0),dx,dd) -C - nrusf=1 ! number of real non degenerated solutions - IF(dd.EQ.0.D0) nrusf=2 - IF(dd.LT.0.D0) nrusf=3 - DO i=1,nrusf - xres(i)=dx(i) - IF(xres(i).GE.XLIM(1).AND.xres(i).LE.XLIM(2)) THEN - xx=xres(i) - nsol=nsol+1 - ENDIF - ENDDO -C - ENDIF - IF(nsol.GT.1) THEN - WRITE(6,*) ' *** ORNDPOLY several solutions NP,nsol=',NP,nsol - GO TO 999 - ELSE IF(nsol.EQ.1) THEN - ORNDPOLY=xx - ENDIF -C -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen/code/parp_ini.F b/src/programs/Simulation/bggen/code/parp_ini.F deleted file mode 100644 index 08baa07172..0000000000 --- a/src/programs/Simulation/bggen/code/parp_ini.F +++ /dev/null @@ -1,15 +0,0 @@ - SUBROUTINE PARP_INI(IAD,VAL) -C -C--- For PYTHIA: set a PARP value -C - IMPLICIT NONE - INTEGER IAD - REAL VAL -C - INCLUDE 'include/pypars.inc' -C - PARP(2)=2. - IF(IAD.GT.0.AND.IAD.LE.200) THEN - PARP(IAD)=VAL - ENDIF - END diff --git a/src/programs/Simulation/bggen/code/pyr.F b/src/programs/Simulation/bggen/code/pyr.F deleted file mode 100644 index 07488b9567..0000000000 --- a/src/programs/Simulation/bggen/code/pyr.F +++ /dev/null @@ -1,11 +0,0 @@ -C - DOUBLE PRECISION FUNCTION PYR(IX) - IMPLICIT NONE - INTEGER IX - REAL a -C - CALL RANLUX(a,1) - PYR=DBLE(a) - RETURN - END - diff --git a/src/programs/Simulation/bggen/code/pyth_eve.F b/src/programs/Simulation/bggen/code/pyth_eve.F deleted file mode 100644 index 9fd4b0ff3e..0000000000 --- a/src/programs/Simulation/bggen/code/pyth_eve.F +++ /dev/null @@ -1,58 +0,0 @@ - SUBROUTINE PYTH_EVE(IERR) -C -C--- Simulates 1 PYTHIA event -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER PYK,PYCOMP - DOUBLE PRECISION PYP - EXTERNAL PYK,PYP,PYCOMP -C - REAL beamen -C - INTEGER i,j,nlnd,ilnd,kf,kc -C -C ------------------------------------------------------------------ -C -C--- Variable energy? -C - beamen=PIN(3,1) - IF(NHBEA.GT.1) THEN - CALL PARP_INI(171,beamen/EPH_LIM(2)) ! the relative energy for this event - ENDIF -C - CALL PYEVNT - CALL PYEDIT(15) ! filter out some intermediate entries - nlnd=PYK(0,1) - NTRA=nlnd -C - DO ilnd=1,MIN(nlnd,MXTRA) - DO i=1,5 - ITPTRA(i+1,ilnd)=PYK(ilnd,i) - ENDDO - kf=ITPTRA(3,ilnd) - kc=PYCOMP(kf) - IF(kf.LT.0) kc=-kc -C write(6,*) ilnd,kf,kc,MXPKC,KCGEAN(kc) - IF(ABS(kc).LE.MXPKC) THEN - ITPTRA(1,ilnd)=KCGEAN(kc) - ELSE - ITPTRA(1,ilnd)=0 - ENDIF - DO i=1,3 - PTRA(i,ilnd)=REAL(PYP(ilnd,i)) - ENDDO - AMTRA(ilnd)=REAL(PYP(ilnd,5)) -C - ENDDO -C - IEVPROC=0 - IERR=0 - 999 CONTINUE -C - END - diff --git a/src/programs/Simulation/bggen/code/pyth_ini.F b/src/programs/Simulation/bggen/code/pyth_ini.F deleted file mode 100644 index 810933324b..0000000000 --- a/src/programs/Simulation/bggen/code/pyth_ini.F +++ /dev/null @@ -1,89 +0,0 @@ - SUBROUTINE PYTH_INI(IERR) -C -C--- Initilize PYTHIA -C Reaction: gamma+p -C--- Input: /phctrl/ beam energy -C file "pythia-geant.dat" contains a table for PYTHIA<->GEANT particle code conversion -C file "pythia.dat" - redefinition of PYTHIA parameters (from HERMES, adapted to GLUEX) -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' -C - INTEGER PYCOMP - EXTERNAL PYCOMP -C - DOUBLE PRECISION dbeam - CHARACTER cpar*100 -C - INTEGER lun,lout,i,j,lenc,kf,kc,ks,iost -C -C ------------------------------------------------------------------ -C - IERR=1 -C - lun=9 - lout=6 -C -C--- KF/KC/GEANT mapping -C - DO i=1,MXPGEANT - kf=IPLUND(i) - IF(kf.NE.0) THEN - kc=PYCOMP(kf) - IF(kc.GT.0.AND.kc.LE.MXPKC) THEN - IF(kf.LT.0) kc=-kc - KCGEAN(kc)=i - kc=ABS(kc) -C write(lout,FMT='(10I8)') i,kf,kc -C -C--- Forbid the decays for particles with GEANT code -C - IF(IDECLUND(i).EQ.0) THEN - WRITE(cpar,1000) kc,0 - 1000 FORMAT('MDCY(',I4,',1)=',I2) - CALL PYGIVE(cpar) - ENDIF - ENDIF - ENDIF - ENDDO -C -C--- Read the pythia settings for JLab energies -C - OPEN(lun,FILE='pythia.dat',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file pythia.dat' - GO TO 999 - ENDIF - 30 READ(lun,'(A)',IOSTAT=iost) cpar - IF(iost.EQ.0) THEN - CALL PYGIVE(cpar) - GO TO 30 - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file pythia.dat' - GO TO 999 - ENDIF - CLOSE(lun) -C -C--- Variable energy? -C - IF(NHBEA.GT.1) THEN - cpar='MSTP(171)=1' - CALL PYGIVE(cpar) - cpar='MSTP(172)=1' - CALL PYGIVE(cpar) - ENDIF -C -C--- Initialize PYTHIA -C - dbeam=DBLE(EPH_LIM(2)) -C - CALL PYINIT('FIXT','gamma','p+',dbeam) -C - IERR=0 - 999 CONTINUE -C - END - diff --git a/src/programs/Simulation/bggen/code/pythia_h.F b/src/programs/Simulation/bggen/code/pythia_h.F deleted file mode 100644 index e2cf26454c..0000000000 --- a/src/programs/Simulation/bggen/code/pythia_h.F +++ /dev/null @@ -1,62285 +0,0 @@ - -C********************************************************************* - -C...PDFSET -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE PDFSET(PARM,VALUE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local arrays and character variables. - CHARACTER*20 PARM(20) - DOUBLE PRECISION VALUE(20) - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - PARM(20)=PARM(1) - VALUE(20)=VALUE(1) - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine PDFSET in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PY1ENT -C...Stores one parton/particle in commonblock PYJETS. - - SUBROUTINE PY1ENT(IP,KF,PE,THE,PHI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)) CALL PYERRM(21, - &'(PY1ENT:) writing outside PYJETS memory') - KC=PYCOMP(KF) - IF(KC.EQ.0) CALL PYERRM(12,'(PY1ENT:) unknown flavour code') - -C...Find mass. Reset K, P and V vectors. - PM=0D0 - IF(MSTU(10).EQ.1) PM=P(IPA,5) - IF(MSTU(10).GE.2) PM=PYMASS(KF) - DO 100 J=1,5 - K(IPA,J)=0 - P(IPA,J)=0D0 - V(IPA,J)=0D0 - 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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY2ENT -C...Stores two partons/particles in their CM frame, -C...with the first along the +z axis. - - SUBROUTINE PY2ENT(IP,KF1,KF2,PECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-1) CALL PYERRM(21, - &'(PY2ENT:) writing outside PYJETS memory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - IF(KC1.EQ.0.OR.KC2.EQ.0) CALL PYERRM(12, - &'(PY2ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - DO 110 I=IPA,IPA+1 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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 PYERRM(2, - & '(PY2ENT:) 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 PYERRM(13, - &'(PY2ENT:) energy smaller than sum of masses') - PA=SQRT(MAX(0D0,(PECM**2-PM1**2-PM2**2)**2-(2D0*PM1*PM2)**2))/ - &(2D0*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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY2FRM -C...An interface from a two-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY2FRM(IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(2) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSE - CALL PYERRM(16,'(PY2FRM:) more than one fermion') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSE - CALL PYERRM(16,'(PY2FRM:) more than one antifermion') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I1.EQ.0.OR.I2.EQ.0) THEN - CALL PYERRM(16,'(PY2FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1) THEN - CALL PYERRM(6,'(PY2FRM:) fermions arranged in wrong order') - ENDIF - -C...Check whether fermion pair is quarks or leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY2FRM:) fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Do colour joining and parton showers. - IP1=I1 - IP2=I2 - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 110 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 110 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 120 I=1,NTAU - K(INTAU(I),1)=1 - 120 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PY3ENT -C...Stores 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. - - SUBROUTINE PY3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-2) CALL PYERRM(21, - &'(PY3ENT:) writing outside PYJETS memory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - KC3=PYCOMP(KF3) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL PYERRM(12, - &'(PY3ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - PM3=0D0 - IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) - IF(MSTU(10).GE.2) PM3=PYMASS(KF3) - DO 110 I=IPA,IPA+2 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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 PYERRM(2,'(PY3ENT:) 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.5D0*X1*PECM.LE.PM1.OR.0.5D0*(2D0-X1-X3)*PECM.LE.PM2.OR. - &0.5D0*X3*PECM.LE.PM3) MKERR=1 - PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) - PA2=SQRT(MAX(1D-10,(0.5D0*(2D0-X1-X3)*PECM)**2-PM2**2)) - PA3=SQRT(MAX(1D-10,(0.5D0*X3*PECM)**2-PM3**2)) - CTHE2=(PA3**2-PA1**2-PA2**2)/(2D0*PA1*PA2) - CTHE3=(PA2**2-PA1**2-PA3**2)/(2D0*PA1*PA3) - IF(ABS(CTHE2).GE.1.001D0.OR.ABS(CTHE3).GE.1.001D0) MKERR=1 - CTHE3=MAX(-1D0,MIN(1D0,CTHE3)) - IF(MKERR.NE.0) CALL PYERRM(13, - &'(PY3ENT:) 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(1D0-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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY4ENT -C...Stores 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. - - SUBROUTINE PY4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-3) CALL PYERRM(21, - &'(PY4ENT:) writing outside PYJETS momory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - KC3=PYCOMP(KF3) - KC4=PYCOMP(KF4) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL PYERRM(12, - &'(PY4ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - PM3=0D0 - IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) - IF(MSTU(10).GE.2) PM3=PYMASS(KF3) - PM4=0D0 - IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) - IF(MSTU(10).GE.2) PM4=PYMASS(KF4) - DO 110 I=IPA,IPA+3 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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.0D0) - & THEN - ELSE - CALL PYERRM(2,'(PY4ENT:) 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.5D0*X1*PECM.LE.PM1.OR.0.5D0*X2*PECM.LE.PM2.OR. - &0.5D0*(2D0-X1-X2-X4)*PECM.LE.PM3.OR.0.5D0*X4*PECM.LE.PM4) - &MKERR=1 - PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) - PA2=SQRT(MAX(1D-10,(0.5D0*X2*PECM)**2-PM2**2)) - PA4=SQRT(MAX(1D-10,(0.5D0*X4*PECM)**2-PM4**2)) - X24=X1+X2+X4-1D0-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 - CTHE4=(X1*X4-2D0*X14)*PECM**2/(4D0*PA1*PA4) - IF(ABS(CTHE4).GE.1.002D0) MKERR=1 - CTHE4=MAX(-1D0,MIN(1D0,CTHE4)) - STHE4=SQRT(1D0-CTHE4**2) - CTHE2=(X1*X2-2D0*X12)*PECM**2/(4D0*PA1*PA2) - IF(ABS(CTHE2).GE.1.002D0) MKERR=1 - CTHE2=MAX(-1D0,MIN(1D0,CTHE2)) - STHE2=SQRT(1D0-CTHE2**2) - CPHI2=((X2*X4-2D0*X24)*PECM**2-4D0*PA2*CTHE2*PA4*CTHE4)/ - &MAX(1D-8*PECM**2,4D0*PA2*STHE2*PA4*STHE4) - IF(ABS(CPHI2).GE.1.05D0) MKERR=1 - CPHI2=MAX(-1D0,MIN(1D0,CPHI2)) - IF(MKERR.EQ.1) CALL PYERRM(13, - &'(PY4ENT:) 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(1D0-CPHI2**2)*(-1D0)**INT(PYR(0)+0.5D0) - 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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY4FRM -C...An interface from a four-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY4FRM(ATOTSQ,A1SQ,A2SQ,ISTRAT,IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(4) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - I3=0 - I4=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSE - CALL PYERRM(16,'(PY4FRM:) more than two fermions') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4FRM:) more than two antifermions') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I3.EQ.0.OR.I4.EQ.0) THEN - CALL PYERRM(16,'(PY4FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN - CALL PYERRM(6,'(PY4FRM:) fermions arranged in wrong order') - ENDIF - -C...Check which fermion pairs are quarks and which leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY4FRM:) first fermion pair inconsistent') - ENDIF - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQL34=1 - ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN - IQL34=2 - ELSE - CALL PYERRM(16,'(PY4FRM:) second fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Decide on dipole pairing. - IP1=I1 - IP2=I2 - IP3=I3 - IP4=I4 - IF(IQL12.EQ.IQL34) THEN - R1SQ=A1SQ - R2SQ=A2SQ - DELTA=ATOTSQ-A1SQ-A2SQ - IF(ISTRAT.EQ.1) THEN - IF(DELTA.GT.0D0) R1SQ=R1SQ+DELTA - IF(DELTA.LT.0D0) R2SQ=MAX(0D0,R2SQ+DELTA) - ELSEIF(ISTRAT.EQ.2) THEN - IF(DELTA.GT.0D0) R2SQ=R2SQ+DELTA - IF(DELTA.LT.0D0) R1SQ=MAX(0D0,R1SQ+DELTA) - ENDIF - IF(R2SQ.GT.PYR(0)*(R1SQ+R2SQ)) THEN - IP2=I4 - IP4=I2 - ENDIF - ENDIF - -C...If colour reconnection then bookkeep W+W- or Z0Z0 -C...and copy q qbar q qbar consecutively. - IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN - K(N+1,1)=11 - K(N+1,3)=IP1 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,1)=11 - K(N+2,3)=IP3 - K(N+2,4)=N+5 - K(N+2,5)=N+6 - IF(K(IP1,2)+K(IP2,2).EQ.0) THEN - K(N+1,2)=23 - K(N+2,2)=23 - MINT(1)=22 - ELSEIF(PYCHGE(K(IP1,2)).GT.0) THEN - K(N+1,2)=24 - K(N+2,2)=-24 - MINT(1)=25 - ELSE - K(N+1,2)=-24 - K(N+2,2)=24 - MINT(1)=25 - ENDIF - DO 110 J=1,5 - K(N+3,J)=K(IP1,J) - K(N+4,J)=K(IP2,J) - K(N+5,J)=K(IP3,J) - K(N+6,J)=K(IP4,J) - P(N+1,J)=P(IP1,J)+P(IP2,J) - P(N+2,J)=P(IP3,J)+P(IP4,J) - P(N+3,J)=P(IP1,J) - P(N+4,J)=P(IP2,J) - P(N+5,J)=P(IP3,J) - P(N+6,J)=P(IP4,J) - V(N+1,J)=V(IP1,J) - V(N+2,J)=V(IP3,J) - V(N+3,J)=V(IP1,J) - V(N+4,J)=V(IP2,J) - V(N+5,J)=V(IP3,J) - V(N+6,J)=V(IP4,J) - 110 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+5,3)=N+2 - K(N+6,3)=N+2 -C...Remove original q qbar q qbar and update counters. - K(IP1,1)=K(IP1,1)+10 - K(IP2,1)=K(IP2,1)+10 - K(IP3,1)=K(IP3,1)+10 - K(IP4,1)=K(IP4,1)+10 - IW1=N+1 - IW2=N+2 - NSD1=N+2 - IP1=N+3 - IP2=N+4 - IP3=N+5 - IP4=N+6 - N=N+6 - ENDIF - -C...Do colour joinings and parton showers. - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - NAFT1=N - IF(IQL34.EQ.1) THEN - IJOIN(1)=IP3 - IJOIN(2)=IP4 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN - PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- - & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 - CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) - ENDIF - -C...Optionally do colour reconnection. - MINT(32)=0 - MSTI(32)=0 - IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN - CALL PYRECO(IW1,IW2,NSD1,NAFT1) - MSTI(32)=MINT(32) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 120 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 120 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 130 I=1,NTAU - K(INTAU(I),1)=1 - 130 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PY4JET -C...An interface from a four-parton generator to include -C...parton showers and hadronization. - - SUBROUTINE PY4JET(PMAX,IRAD,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),PTOT(4),BETA(3) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final partons. - I1=0 - I2=0 - I3=0 - I4=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.KFA.EQ.21) THEN - IF(K(I,2).GT.0.AND.K(I,2).LE.6) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two quarks') - ENDIF - ELSEIF(K(I,2).LT.0) THEN - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two antiquarks') - ENDIF - ELSE - IF(I3.EQ.0) THEN - I3=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two gluons') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I1.EQ.0.OR.I2.EQ.0.OR.I3.EQ.0.OR.I4.EQ.0) THEN - CALL PYERRM(16,'(PY4JET:) event contains too few partons') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN - CALL PYERRM(6,'(PY4JET:) partons arranged in wrong order') - ENDIF - -C...Check whether second pair are quarks or gluons. - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQG34=1 - ELSEIF(K(I3,2).EQ.21.AND.K(I4,2).EQ.21) THEN - IQG34=2 - ELSE - CALL PYERRM(16,'(PY4JET:) second parton pair inconsistent') - ENDIF - -C...Boost partons to their cm frame. - DO 110 J=1,4 - PTOT(J)=P(I1,J)+P(I2,J)+P(I3,J)+P(I4,J) - 110 CONTINUE - ECM=SQRT(MAX(0D0,PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2)) - DO 120 J=1,3 - BETA(J)=PTOT(J)/PTOT(4) - 120 CONTINUE - CALL PYROBO(I1,I1,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I2,I2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I3,I3,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I4,I4,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - NSAV=N - -C...Decide and set up shower history for q qbar q' qbar' events. - IF(IQG34.EQ.1) THEN - W1=PY4JTW(0,I1,I3,I4) - W2=PY4JTW(0,I2,I3,I4) - IF(W1.GT.PYR(0)*(W1+W2)) THEN - CALL PY4JTS(0,I1,I3,I4,I2,QMAX) - ELSE - CALL PY4JTS(0,I2,I3,I4,I1,QMAX) - ENDIF - -C...Decide and set up shower history for q qbar g g events. - ELSE - W1=PY4JTW(I1,I3,I2,I4) - W2=PY4JTW(I1,I4,I2,I3) - W3=PY4JTW(0,I3,I1,I4) - W4=PY4JTW(0,I4,I1,I3) - W5=PY4JTW(0,I3,I2,I4) - W6=PY4JTW(0,I4,I2,I3) - W7=PY4JTW(0,I1,I3,I4) - W8=PY4JTW(0,I2,I3,I4) - WR=(W1+W2+W3+W4+W5+W6+W7+W8)*PYR(0) - IF(W1.GT.WR) THEN - CALL PY4JTS(I1,I3,I2,I4,0,QMAX) - ELSEIF(W1+W2.GT.WR) THEN - CALL PY4JTS(I1,I4,I2,I3,0,QMAX) - ELSEIF(W1+W2+W3.GT.WR) THEN - CALL PY4JTS(0,I3,I1,I4,I2,QMAX) - ELSEIF(W1+W2+W3+W4.GT.WR) THEN - CALL PY4JTS(0,I4,I1,I3,I2,QMAX) - ELSEIF(W1+W2+W3+W4+W5.GT.WR) THEN - CALL PY4JTS(0,I3,I2,I4,I1,QMAX) - ELSEIF(W1+W2+W3+W4+W5+W6.GT.WR) THEN - CALL PY4JTS(0,I4,I2,I3,I1,QMAX) - ELSEIF(W1+W2+W3+W4+W5+W6+W7.GT.WR) THEN - CALL PY4JTS(0,I1,I3,I4,I2,QMAX) - ELSE - CALL PY4JTS(0,I2,I3,I4,I1,QMAX) - ENDIF - ENDIF - -C...Boost back original partons and mark them as deleted. - CALL PYROBO(I1,I1,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I2,I2,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I4,I4,0D0,0D0,BETA(1),BETA(2),BETA(3)) - K(I1,1)=K(I1,1)+10 - K(I2,1)=K(I2,1)+10 - K(I3,1)=K(I3,1)+10 - K(I4,1)=K(I4,1)+10 - -C...Rotate shower initiating partons to be along z axis. - PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) - CALL PYROBO(NSAV+1,NSAV+6,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) - CALL PYROBO(NSAV+1,NSAV+6,-THE,0D0,0D0,0D0,0D0) - -C...Set up copy of shower initiating partons as on mass shell. - DO 140 I=N+1,N+2 - DO 130 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=V(I1,J) - 130 CONTINUE - K(I,1)=1 - K(I,2)=K(I-6,2) - 140 CONTINUE - IF(K(NSAV+1,2).EQ.K(I1,2)) THEN - K(N+1,3)=I1 - P(N+1,5)=P(I1,5) - K(N+2,3)=I2 - P(N+2,5)=P(I2,5) - ELSE - K(N+1,3)=I2 - P(N+1,5)=P(I2,5) - K(N+2,3)=I1 - P(N+2,5)=P(I1,5) - ENDIF - PABS=SQRT(MAX(0D0,(ECM**2-P(N+1,5)**2-P(N+2,5)**2)**2- - &(2D0*P(N+1,5)*P(N+2,5))**2))/(2D0*ECM) - P(N+1,3)=PABS - P(N+1,4)=SQRT(PABS**2+P(N+1,5)**2) - P(N+2,3)=-PABS - P(N+2,4)=SQRT(PABS**2+P(N+2,5)**2) - N=N+2 - -C...Decide whether to allow or not photon radiation in showers. -C...Connect up colours. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - IJOIN(1)=N-1 - IJOIN(2)=N - CALL PYJOIN(2,IJOIN) - -C...Decide on maximum virtuality and do parton shower. - IF(PMAX.LT.PARJ(82)) THEN - PQMAX=QMAX - ELSE - PQMAX=PMAX - ENDIF - CALL PYSHOW(NSAV+1,-100,PQMAX) - -C...Rotate and boost back system. - CALL PYROBO(NSAV+1,N,THE,PHI,BETA(1),BETA(2),BETA(3)) - -C...Do fragmentation and decays. - CALL PYEXEC - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PY4JTS -C...Auxiliary to PY4JET, to set up chosen configuration. - - SUBROUTINE PY4JTS(IA1,IA2,IA3,IA4,IA5,QMAX) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - SAVE /PYJETS/ - -C...Reset info. - DO 110 I=N+1,N+6 - DO 100 J=1,5 - K(I,J)=0 - V(I,J)=V(IA2,J) - 100 CONTINUE - K(I,1)=16 - 110 CONTINUE - -C...First case: when both original partons radiate. -C...N+1 -> (IA1=N+3) + (IA2=N+4), N+2 -> (IA3=N+5) + (IA4=N+6). - IF(IA1.NE.0) THEN - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA1,2) - K(N+2,2)=K(IA3,2) - K(N+3,2)=K(IA1,2) - K(N+4,2)=K(IA2,2) - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA1 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA3 - K(N+2,4)=N+5 - K(N+2,5)=N+6 - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+5,3)=N+2 - K(N+6,3)=N+2 - -C...Set up momenta for new partons. - DO 120 J=1,5 - P(N+1,J)=P(IA1,J)+P(IA2,J) - P(N+2,J)=P(IA3,J)+P(IA4,J) - P(N+3,J)=P(IA1,J) - P(N+4,J)=P(IA2,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 120 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - QMAX=MIN(P(N+1,5),P(N+2,5)) - -C...Second case: q radiates twice. -C...N+1 -> (IA2=N+4) + N+3, N+3 -> (IA3=N+5) + (IA4=N+6), -C...IA5=N+2 does not radiate. - ELSEIF(K(IA2,2).EQ.21) THEN - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA3,2) - K(N+2,2)=K(IA5,2) - K(N+3,2)=K(IA3,2) - K(N+4,2)=K(IA2,2) - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA3 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA5 - K(N+3,3)=N+1 - K(N+3,4)=N+5 - K(N+3,5)=N+6 - K(N+4,3)=N+1 - K(N+5,3)=N+3 - K(N+6,3)=N+3 - -C...Set up momenta for new partons. - DO 130 J=1,5 - P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) - P(N+2,J)=P(IA5,J) - P(N+3,J)=P(IA3,J)+P(IA4,J) - P(N+4,J)=P(IA2,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 130 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+3,5)=SQRT(MAX(0D0,P(N+3,4)**2-P(N+3,1)**2-P(N+3,2)**2- - & P(N+3,3)**2)) - QMAX=P(N+3,5) - -C...Third case: q radiates g, g branches. -C...N+1 -> (IA2=N+3) + N+4, N+4 -> (IA3=N+5) + (IA4=N+6), -C...IA5=N+2 does not radiate. - ELSE - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA2,2) - K(N+2,2)=K(IA5,2) - K(N+3,2)=K(IA2,2) - K(N+4,2)=21 - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA2 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA5 - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+4,4)=N+5 - K(N+4,5)=N+6 - K(N+5,3)=N+4 - K(N+6,3)=N+4 - -C...Set up momenta for new partons. - DO 140 J=1,5 - P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) - P(N+2,J)=P(IA5,J) - P(N+3,J)=P(IA2,J) - P(N+4,J)=P(IA3,J)+P(IA4,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 140 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+4,5)=SQRT(MAX(0D0,P(N+4,4)**2-P(N+4,1)**2-P(N+4,2)**2- - & P(N+4,3)**2)) - QMAX=P(N+4,5) - - ENDIF - N=N+6 - - RETURN - END - -C********************************************************************* - -C...PY4JTW -C...Auxiliary to PY4JET, to evaluate weight of configuration. - - FUNCTION PY4JTW(IA1,IA2,IA3,IA4) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - SAVE /PYJETS/ - -C...First case: when both original partons radiate. -C...IA1 /= 0: N+1 -> IA1 + IA2, N+2 -> IA3 + IA4. - IF(IA1.NE.0) THEN - DO 100 J=1,4 - P(N+1,J)=P(IA1,J)+P(IA2,J) - P(N+2,J)=P(IA3,J)+P(IA4,J) - 100 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - Z1=P(IA1,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2-P(IA1,5)**2) - Z2=P(IA3,4)/P(N+2,4) - WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2-P(IA3,5)**2) - -C...Second case: when one original parton radiates to three. -C...IA1 = 0: N+1 -> IA2 + N+2, N+2 -> IA3 + IA4. - ELSE - DO 110 J=1,4 - P(N+2,J)=P(IA3,J)+P(IA4,J) - P(N+1,J)=P(N+2,J)+P(IA2,J) - 110 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - IF(K(IA2,2).EQ.21) THEN - Z1=P(N+2,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- - & P(IA3,5)**2) - ELSE - Z1=P(IA2,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- - & P(IA2,5)**2) - ENDIF - Z2=P(IA3,4)/P(N+2,4) - IF(K(IA2,2).EQ.21) THEN - WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2- - & P(IA3,5)**2) - ELSEIF(K(IA3,2).EQ.21) THEN - WT2=3D0*((1D0-Z2*(1D0-Z2))**2/(Z2*(1D0-Z2)))/P(N+2,5)**2 - ELSE - WT2=0.5D0*(Z2**2+(1D0-Z2)**2) - ENDIF - ENDIF - -C...Total weight. - PY4JTW=WT1*WT2 - - RETURN - END - -C********************************************************************* - -C...PY6FRM -C...An interface from a six-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY6FRM(P12,P13,P21,P23,P31,P32,PTOP,IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(6),BETA(3),BETAO(3),BETAN(3) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - I3=0 - I4=0 - I5=0 - I6=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSEIF(I5.EQ.0) THEN - I5=I - ELSE - CALL PYERRM(16,'(PY6FRM:) more than three fermions') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSEIF(I6.EQ.0) THEN - I6=I - ELSE - CALL PYERRM(16,'(PY6FRM:) more than three antifermions') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I5.EQ.0.OR.I6.EQ.0) THEN - CALL PYERRM(16,'(PY6FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3.OR.I5.LT.I4.OR.I6.LT.I5) THEN - CALL PYERRM(6,'(PY6FRM:) fermions arranged in wrong order') - ENDIF - -C...Check which fermion pairs are quarks and which leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) first fermion pair inconsistent') - ENDIF - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQL34=1 - ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN - IQL34=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) second fermion pair inconsistent') - ENDIF - IF(IABS(K(I5,2)).LT.10.AND.IABS(K(I6,2)).LT.10) THEN - IQL56=1 - ELSEIF(IABS(K(I5,2)).GT.10.AND.IABS(K(I6,2)).GT.10) THEN - IQL56=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) third fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Allow dipole pairings only among leptons and quarks separately. - P12D=P12 - P13D=0D0 - IF(IQL34.EQ.IQL56) P13D=P13 - P21D=0D0 - IF(IQL12.EQ.IQL34) P21D=P21 - P23D=0D0 - IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P23D=P23 - P31D=0D0 - IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P31D=P31 - P32D=0D0 - IF(IQL12.EQ.IQL56) P32D=P32 - -C...Decide whether t+tbar. - ITOP=0 - IF(PYR(0).LT.PTOP) THEN - ITOP=1 - -C...If t+tbar: reconstruct t's. - IT=N+1 - ITB=N+2 - DO 110 J=1,5 - K(IT,J)=0 - K(ITB,J)=0 - P(IT,J)=P(I1,J)+P(I3,J)+P(I4,J) - P(ITB,J)=P(I2,J)+P(I5,J)+P(I6,J) - V(IT,J)=0D0 - V(ITB,J)=0D0 - 110 CONTINUE - K(IT,1)=1 - K(ITB,1)=1 - K(IT,2)=6 - K(ITB,2)=-6 - P(IT,5)=SQRT(MAX(0D0,P(IT,4)**2-P(IT,1)**2-P(IT,2)**2- - & P(IT,3)**2)) - P(ITB,5)=SQRT(MAX(0D0,P(ITB,4)**2-P(ITB,1)**2-P(ITB,2)**2- - & P(ITB,3)**2)) - N=N+2 - -C...If t+tbar: colour join t's and let them shower. - IJOIN(1)=IT - IJOIN(2)=ITB - CALL PYJOIN(2,IJOIN) - PMTTS=(P(IT,4)+P(ITB,4))**2-(P(IT,1)+P(ITB,1))**2- - & (P(IT,2)+P(ITB,2))**2-(P(IT,3)+P(ITB,3))**2 - CALL PYSHOW(IT,ITB,SQRT(MAX(0D0,PMTTS))) - -C...If t+tbar: pick up the t's after shower. - ITNEW=IT - ITBNEW=ITB - DO 120 I=ITB+1,N - IF(K(I,2).EQ.6) ITNEW=I - IF(K(I,2).EQ.-6) ITBNEW=I - 120 CONTINUE - -C...If t+tbar: loop over two top systems. - DO 200 IT1=1,2 - IF(IT1.EQ.1) THEN - ITO=IT - ITN=ITNEW - IBO=I1 - IW1=I3 - IW2=I4 - ELSE - ITO=ITB - ITN=ITBNEW - IBO=I2 - IW1=I5 - IW2=I6 - ENDIF - IF(IABS(K(IBO,2)).NE.5) CALL PYERRM(6, - & '(PY6FRM:) not b in t decay') - -C...If t+tbar: find boost from original to new top frame. - DO 130 J=1,3 - BETAO(J)=P(ITO,J)/P(ITO,4) - BETAN(J)=P(ITN,J)/P(ITN,4) - 130 CONTINUE - -C...If t+tbar: boost copy of b by t shower and connect it in colour. - N=N+1 - IB=N - K(IB,1)=3 - K(IB,2)=K(IBO,2) - K(IB,3)=ITN - DO 140 J=1,5 - P(IB,J)=P(IBO,J) - V(IB,J)=0D0 - 140 CONTINUE - CALL PYROBO(IB,IB,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(IB,IB,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - K(IB,4)=MSTU(5)*ITN - K(IB,5)=MSTU(5)*ITN - K(ITN,4)=K(ITN,4)+IB - K(ITN,5)=K(ITN,5)+IB - K(ITN,1)=K(ITN,1)+10 - K(IBO,1)=K(IBO,1)+10 - -C...If t+tbar: construct W recoiling against b. - N=N+1 - IW=N - DO 150 J=1,5 - K(IW,J)=0 - V(IW,J)=0D0 - 150 CONTINUE - K(IW,1)=1 - KCHW=PYCHGE(K(IW1,2))+PYCHGE(K(IW2,2)) - IF(IABS(KCHW).EQ.3) THEN - K(IW,2)=ISIGN(24,KCHW) - ELSE - CALL PYERRM(16,'(PY6FRM:) fermion pair inconsistent with W') - ENDIF - K(IW,3)=IW1 - -C...If t+tbar: construct W momentum, including boost by t shower. - DO 160 J=1,4 - P(IW,J)=P(IW1,J)+P(IW2,J) - 160 CONTINUE - P(IW,5)=SQRT(MAX(0D0,P(IW,4)**2-P(IW,1)**2-P(IW,2)**2- - & P(IW,3)**2)) - CALL PYROBO(IW,IW,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(IW,IW,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - -C...If t+tbar: boost b and W to top rest frame. - DO 170 J=1,3 - BETA(J)=(P(IB,J)+P(IW,J))/(P(IB,4)+P(IW,4)) - 170 CONTINUE - CALL PYROBO(IB,IB,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(IW,IW,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - -C...If t+tbar: let b shower and pick up modified W. - PMTS=(P(IB,4)+P(IW,4))**2-(P(IB,1)+P(IW,1))**2- - & (P(IB,2)+P(IW,2))**2-(P(IB,3)+P(IW,3))**2 - CALL PYSHOW(IB,IW,SQRT(MAX(0D0,PMTS))) - DO 180 I=IW,N - IF(IABS(K(I,2)).EQ.24) IWM=I - 180 CONTINUE - -C...If t+tbar: take copy of W decay products. - DO 190 J=1,5 - K(N+1,J)=K(IW1,J) - P(N+1,J)=P(IW1,J) - V(N+1,J)=V(IW1,J) - K(N+2,J)=K(IW2,J) - P(N+2,J)=P(IW2,J) - V(N+2,J)=V(IW2,J) - 190 CONTINUE - K(IW1,1)=K(IW1,1)+10 - K(IW2,1)=K(IW2,1)+10 - K(IWM,1)=K(IWM,1)+10 - K(IWM,4)=N+1 - K(IWM,5)=N+2 - K(N+1,3)=IWM - K(N+2,3)=IWM - IF(IT1.EQ.1) THEN - I3=N+1 - I4=N+2 - ELSE - I5=N+1 - I6=N+2 - ENDIF - N=N+2 - -C...If t+tbar: boost W decay products, first by effects of t shower, -C...then by those of b shower. b and its shower simple boost back. - CALL PYROBO(N-1,N,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(N-1,N,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - CALL PYROBO(N-1,N,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(N-1,N,0D0,0D0,-P(IW,1)/P(IW,4), - & -P(IW,2)/P(IW,4),-P(IW,3)/P(IW,4)) - CALL PYROBO(N-1,N,0D0,0D0,P(IWM,1)/P(IWM,4), - & P(IWM,2)/P(IWM,4),P(IWM,3)/P(IWM,4)) - CALL PYROBO(IB,IB,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(IW,N,0D0,0D0,BETA(1),BETA(2),BETA(3)) - 200 CONTINUE - ENDIF - -C...Decide on dipole pairing. - IP1=I1 - IP3=I3 - IP5=I5 - PRN=PYR(0)*(P12D+P13D+P21D+P23D+P31D+P32D) - IF(ITOP.EQ.1.OR.PRN.LT.P12D) THEN - IP2=I2 - IP4=I4 - IP6=I6 - ELSEIF(PRN.LT.P12D+P13D) THEN - IP2=I2 - IP4=I6 - IP6=I4 - ELSEIF(PRN.LT.P12D+P13D+P21D) THEN - IP2=I4 - IP4=I2 - IP6=I6 - ELSEIF(PRN.LT.P12D+P13D+P21D+P23D) THEN - IP2=I4 - IP4=I6 - IP6=I2 - ELSEIF(PRN.LT.P12D+P13D+P21D+P23D+P31D) THEN - IP2=I6 - IP4=I2 - IP6=I4 - ELSE - IP2=I6 - IP4=I4 - IP6=I2 - ENDIF - -C...Do colour joinings and parton showers -C...(except ones already made for t+tbar). - IF(ITOP.EQ.0) THEN - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - ENDIF - IF(IQL34.EQ.1) THEN - IJOIN(1)=IP3 - IJOIN(2)=IP4 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN - PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- - & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 - CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) - ENDIF - IF(IQL56.EQ.1) THEN - IJOIN(1)=IP5 - IJOIN(2)=IP6 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL56.EQ.1.OR.IRAD.EQ.1) THEN - PM56S=(P(IP5,4)+P(IP6,4))**2-(P(IP5,1)+P(IP6,1))**2- - & (P(IP5,2)+P(IP6,2))**2-(P(IP5,3)+P(IP6,3))**2 - CALL PYSHOW(IP5,IP6,SQRT(MAX(0D0,PM56S))) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 210 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 210 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 220 I=1,NTAU - K(INTAU(I),1)=1 - 220 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PYADSH -C...Administers the generation of successive final-state showers -C...in external processes. - - SUBROUTINE PYADSH(NFIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ -C...Local array. - DIMENSION IBEG(100),KSAV(100,5),PSUM(4),BETA(3) - -C...Set primary vertex. - DO 100 J=1,5 - V(MINT(83)+5,J)=0D0 - V(MINT(83)+6,J)=0D0 - V(MINT(84)+1,J)=0D0 - V(MINT(84)+2,J)=0D0 - 100 CONTINUE - -C...Isolate systems of particles with the same mother. - NSYS=0 - IMS=-1 - DO 140 I=MINT(84)+3,NFIN - IM=K(I,3) - IF(IM.GT.0.AND.IM.LE.MINT(84)) IM=K(IM,3) - IF(IM.NE.IMS) THEN - NSYS=NSYS+1 - IBEG(NSYS)=I - IMS=IM - ENDIF - -C...Set production vertices. - IF(IM.LE.MINT(83)+6.OR.(IM.GT.MINT(84).AND.IM.LE.MINT(84)+2)) - & THEN - DO 110 J=1,4 - V(I,J)=0D0 - 110 CONTINUE - ELSE - DO 120 J=1,4 - V(I,J)=V(IM,J)+V(IM,5)*P(IM,J)/P(IM,5) - 120 CONTINUE - ENDIF - IF(MSTP(125).GE.1) THEN - IDOC=I-MSTP(126)+4 - DO 130 J=1,5 - V(IDOC,J)=V(I,J) - 130 CONTINUE - ENDIF - 140 CONTINUE - -C...End loop over systems. Return if no showers to be performed. - IBEG(NSYS+1)=NFIN+1 - IF(MSTP(71).LE.0) RETURN - -C...Loop through systems of particles; check that sensible size. - DO 260 ISYS=1,NSYS - NSIZ=IBEG(ISYS+1)-IBEG(ISYS) - IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN - ELSEIF(NSIZ.LE.1) THEN - CALL PYERRM(2,'(PYADSH:) only one particle in system') - ELSEIF(NSIZ.GT.80) THEN - CALL PYERRM(2,'(PYADSH:) more than 80 particles in system') - ELSE - -C...Save status codes and daughters of showering pair; reset them. - DO 150 J=1,4 - PSUM(J)=0D0 - 150 CONTINUE - DO 170 II=1,NSIZ - I=IBEG(ISYS)-1+II - KSAV(II,1)=K(I,1) - IF(K(I,1).GT.10) THEN - K(I,1)=1 - IF(KSAV(II,1).EQ.14) K(I,1)=3 - ENDIF - IF(KSAV(II,1).LE.10) THEN - ELSEIF(K(I,1).EQ.1) THEN - KSAV(II,4)=K(I,4) - KSAV(II,5)=K(I,5) - K(I,4)=0 - K(I,5)=0 - ELSE - KSAV(II,4)=MOD(K(I,4),MSTU(5)) - KSAV(II,5)=MOD(K(I,5),MSTU(5)) - K(I,4)=K(I,4)-KSAV(II,4) - K(I,5)=K(I,5)-KSAV(II,5) - ENDIF - DO 160 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 160 CONTINUE - 170 CONTINUE - -C...Perform shower. - QMAX=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2- - & PSUM(3)**2)) - IF(ISYS.EQ.1) QMAX=MIN(QMAX,SQRT(PARP(71))*VINT(55)) - NSAV=N - IF(NSIZ.EQ.2) THEN - CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX) - ELSE - CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX) - ENDIF - -C...Look up showered copies of original showering particles. - DO 250 II=1,NSIZ - I=IBEG(ISYS)-1+II - IMV=I - IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN - ELSEIF(K(I,1).EQ.11) THEN - 180 IMV=MOD(K(IMV,4),MSTU(5)) - IF(K(IMV,1).EQ.11) GOTO 180 - ELSE - KDA1=MOD(K(I,4),MSTU(5)) - KDA2=MOD(K(I,5),MSTU(5)) - DO 190 I3=I+1,N - IF(K(I3,2).EQ.K(I,2).AND.(I3.EQ.KDA1.OR.I3.EQ.KDA2)) - & THEN - IMV=I3 - KDA1=MOD(K(I3,4),MSTU(5)) - KDA2=MOD(K(I3,5),MSTU(5)) - ENDIF - 190 CONTINUE - ENDIF - -C...Restore daughter info of original partons to showered copies. - IF(KSAV(II,1).GT.10) K(IMV,1)=KSAV(II,1) - IF(KSAV(II,1).LE.10) THEN - ELSEIF(K(I,1).EQ.1) THEN - K(IMV,4)=KSAV(II,4) - K(IMV,5)=KSAV(II,5) - ELSE - K(IMV,4)=K(IMV,4)+KSAV(II,4) - K(IMV,5)=K(IMV,5)+KSAV(II,5) - ENDIF - -C...Reset mother info of existing daughters to showered copies. - DO 200 I3=IBEG(ISYS+1),NFIN - IF(K(I3,3).EQ.I) K(I3,3)=IMV - IF(K(I3,1).EQ.3.OR.K(I3,1).EQ.14) THEN - IF(K(I3,4)/MSTU(5).EQ.I) K(I3,4)=K(I3,4)+MSTU(5)*(IMV-I) - IF(K(I3,5)/MSTU(5).EQ.I) K(I3,5)=K(I3,5)+MSTU(5)*(IMV-I) - ENDIF - 200 CONTINUE - -C...Boost all original daughters to new frame of showered copy. - IF(IMV.NE.I) THEN - DO 210 J=1,3 - BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4)) - 210 CONTINUE - FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2) - DO 220 J=1,3 - BETA(J)=FAC*BETA(J) - 220 CONTINUE - DO 240 I3=IBEG(ISYS+1),NFIN - IMO=I3 - 230 IMO=K(IMO,3) - IF(MSTP(128).LE.0) THEN - IF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) GOTO 230 - IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3))) - & CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - ELSE - IF(IMO.EQ.IMV) THEN - CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN - GOTO 230 - ENDIF - ENDIF - 240 CONTINUE - ENDIF - 250 CONTINUE - -C...End of loop over showering systems - ENDIF - 260 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYALEM -C...Calculates the running alpha_electromagnetic. - - FUNCTION PYALEM(Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -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)/(3D0*PARU(1)) - IF(MSTU(101).LE.0.OR.Q2.LT.2D-6) THEN - RPIGG=0D0 - ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN - RPIGG=0D0 - ELSEIF(MSTU(101).EQ.2) THEN - RPIGG=1D0-PARU(101)/PARU(103) - ELSEIF(Q2.LT.0.09D0) THEN - RPIGG=AEMPI*(13.4916D0+LOG(Q2))+0.00835D0*LOG(1D0+Q2) - ELSEIF(Q2.LT.9D0) THEN - RPIGG=AEMPI*(16.3200D0+2D0*LOG(Q2))+ - & 0.00238D0*LOG(1D0+3.927D0*Q2) - ELSEIF(Q2.LT.1D4) THEN - RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00165D0+ - & 0.00299D0*LOG(1D0+Q2) - ELSE - RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00221D0+ - & 0.00293D0*LOG(1D0+Q2) - ENDIF - -C...Calculate running alpha_em. - PYALEM=PARU(101)/(1D0-RPIGG) - PARU(108)=PYALEM - - RETURN - END - -C********************************************************************* - -C...PYALPS -C...Gives the value of alpha_strong. - - FUNCTION PYALPS(Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Constant alpha_strong trivial. Pick artificial Lambda. - IF(MSTU(111).LE.0) THEN - PYALPS=PARU(111) - MSTU(118)=MSTU(112) - PARU(117)=0.2D0 - IF(Q2.GT.0.04D0) PARU(117)=SQRT(Q2)*EXP(-6D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))) - 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)**(2D0/(33D0-2D0*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)**(2D0/(33D0-2D0*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=(33D0-2D0*NF)/6D0 - ALGQ=LOG(MAX(1.0001D0,Q2EFF/ALAM2)) - IF(MSTU(111).EQ.1) THEN - PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) - ELSE - B1=(153D0-19D0*NF)/6D0 - PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1D0-B1*LOG(ALGQ)/ - & (B0**2*ALGQ))) - ENDIF - MSTU(118)=NF - PARU(118)=PYALPS - - RETURN - END - -C********************************************************************* - -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) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - 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=PARU(1)-PYANGL - ELSEIF(X.LT.0D0) THEN - PYANGL=-PARU(1)-PYANGL - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYAPPS -C...Uses approximate analytical formulae to determine the full set of -C...MSSM parameters from SUGRA input. -C...See M. Drees and S.P. Martin, hep-ph/9504124 - - SUBROUTINE PYAPPS - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/ - - IMSS(5)=0 - IMSS(8)=0 - XMT=PMAS(6,1) - XMZ2=PMAS(23,1)**2 - XMW2=PMAS(24,1)**2 - TANB=RMSS(5) - BETA=ATAN(TANB) - XW=PARU(102) - XMG=RMSS(1) - XMG2=XMG*XMG - XM0=RMSS(8) - XM02=XM0*XM0 - AT=-RMSS(16) - RMSS(15)=AT - RMSS(17)=AT - SINB=TANB/SQRT(TANB**2+1D0) - COSB=SINB/TANB - - DTERM=XMZ2*COS(2D0*BETA) - XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM) - XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM) - RMSS(6)=XMEL - RMSS(7)=XMER - XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM)) - XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM)) - XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM)) - XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM)) - DO 100 I=1,5,2 - PMAS(PYCOMP(KSUSY1+I),1)=XMDL - PMAS(PYCOMP(KSUSY2+I),1)=XMDR - PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL - PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR - 100 CONTINUE - XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA)) - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - XARG=SQRT(XARG) - ENDIF - DO 110 I=11,15,2 - PMAS(PYCOMP(KSUSY1+I),1)=XMEL - PMAS(PYCOMP(KSUSY2+I),1)=XMER - PMAS(PYCOMP(KSUSY1+I+1),1)=XARG - PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 - 110 CONTINUE - RMT=PYMRUN(6,PMAS(6,1)**2) - XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+ - &(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG)) - RMB=PYMRUN(5,PMAS(6,1)**2) - XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+ - &(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG)) - XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0) - ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/ - &SINB)**2) - RMSS(16)=-ATP - XMU2=-.5D0*XMZ2+(SINB**2*(XM02+.52D0*XMG2-XTOP)- - &COSB**2*(XM02+.52D0*XMG2-XBOT-XTAU/3D0))/(COSB**2-SINB**2) - XMA2=2D0*(XM02+.52D0*XMG2+XMU2)-XTOP-XBOT-XTAU/3D0 - XMU=SIGN(SQRT(XMU2),RMSS(4)) - RMSS(4)=XMU - IF(XMA2.GT.0D0) THEN - RMSS(19)=SQRT(XMA2) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: PSEUDOSCALAR MASS**2 < 0 ' - STOP - ENDIF - ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM - IF(ARG.GT.0D0) THEN - RMSS(14)=SQRT(ARG) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: RIGHT STAU MASS**2 < 0 ' - STOP - ENDIF - ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM - IF(ARG.GT.0D0) THEN - RMSS(13)=SQRT(ARG) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: LEFT STAU MASS**2 < 0 ' - STOP - ENDIF - ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0) - IF(ARG.GT.0D0) THEN - RMSS(10)=SQRT(ARG) - ELSE - RMSS(10)=-SQRT(-ARG) - ENDIF - ARG=PYRNMQ(2,-2D0*XTOP/3D0) - IF(ARG.GT.0D0) THEN - RMSS(12)=SQRT(ARG) - ELSE - RMSS(12)=-SQRT(-ARG) - ENDIF - ARG=PYRNMQ(3,-2D0*XBOT/3D0) - IF(ARG.GT.0D0) THEN - RMSS(11)=SQRT(ARG) - ELSE - RMSS(11)=-SQRT(-ARG) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYBESQ -C...Calculates the momentum shift in a system of two particles assuming -C...the relative momentum squared should be shifted to Q2NEW. NI is the -C...last position occupied in /PYJETS/. - - SUBROUTINE PYBESQ(I1,I2,NI,Q2OLD,Q2NEW) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) -C SAVE /PYJETS/,/PYDAT1/ -C...Local arrays and data. - DIMENSION DP(5) - SAVE HC1 - - IF(MSTJ(55).EQ.0) THEN - DQ2=Q2NEW-Q2OLD - DP2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ - & (P(I1,3)-P(I2,3))**2 - DP12=P(I1,1)**2+P(I1,2)**2+P(I1,3)**2 - & -P(I2,1)**2-P(I2,2)**2-P(I2,3)**2 - SE=P(I1,4)+P(I2,4) - DE=P(I1,4)-P(I2,4) - DQ2SE=DQ2+SE**2 - DA=SE*DE*DP12-DP2*DQ2SE - DB=DP2*DQ2SE-DP12**2 - HA=(DA+SQRT(MAX(DA**2+DQ2*(DQ2+SE**2-DE**2)*DB,0D0)))/(2D0*DB) - DO 100 J=1,3 - PD=HA*(P(I1,J)-P(I2,J)) - P(NI+1,J)=PD - P(NI+2,J)=-PD - 100 CONTINUE - RETURN - ENDIF - - K(NI+1,1)=1 - K(NI+2,1)=1 - DO 110 J=1,5 - P(NI+1,J)=P(I1,J) - P(NI+2,J)=P(I2,J) - DP(J)=P(I1,J)+P(I2,J) - 110 CONTINUE - -C...Boost to cms and rotate first particle to z-axis - CALL PYROBO(NI+1,NI+2,0.0D0,0.0D0, - &-DP(1)/DP(4),-DP(2)/DP(4),-DP(3)/DP(4)) - PHI=PYANGL(P(NI+1,1),P(NI+1,2)) - THE=PYANGL(P(NI+1,3),SQRT(P(NI+1,1)**2+P(NI+1,2)**2)) - S=Q2NEW+(P(I1,5)+P(I2,5))**2 - PZ=0.5D0*SQRT(Q2NEW*(S-(P(I1,5)-P(I2,5))**2)/S) - P(NI+1,1)=0.0D0 - P(NI+1,2)=0.0D0 - P(NI+1,3)=PZ - P(NI+1,4)=SQRT(PZ**2+P(I1,5)**2) - P(NI+2,1)=0.0D0 - P(NI+2,2)=0.0D0 - P(NI+2,3)=-PZ - P(NI+2,4)=SQRT(PZ**2+P(I2,5)**2) - DP(4)=SQRT(DP(1)**2+DP(2)**2+DP(3)**2+S) - CALL PYROBO(NI+1,NI+2,THE,PHI, - &DP(1)/DP(4),DP(2)/DP(4),DP(3)/DP(4)) - - DO 120 J=1,3 - P(NI+1,J)=P(NI+1,J)-P(I1,J) - P(NI+2,J)=P(NI+2,J)-P(I2,J) - 120 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYBKSB -C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 -C...processes. - - SUBROUTINE PYBKSB(A,N,NP,INDX,B) - IMPLICIT NONE - INTEGER N,NP,INDX(N) - COMPLEX*16 A(NP,NP),B(N) - INTEGER I,II,J,LL - COMPLEX*16 SUM - - II=0 - DO 110 I=1,N - LL=INDX(I) - SUM=B(LL) - B(LL)=B(I) - IF (II.NE.0)THEN - DO 100 J=II,I-1 - SUM=SUM-A(I,J)*B(J) - 100 CONTINUE - ELSE IF (ABS(SUM).NE.0D0) THEN - II=I - ENDIF - B(I)=SUM - 110 CONTINUE - DO 130 I=N,1,-1 - SUM=B(I) - DO 120 J=I+1,N - SUM=SUM-A(I,J)*B(J) - 120 CONTINUE - B(I)=SUM/A(I,I) - 130 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYBOEI -C...Modifies an event so as to approximately take into account -C...Bose-Einstein effects according to a simple phenomenological -C...parametrization. - - SUBROUTINE PYBOEI(NSAV) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYINT1/ -C...Local arrays and data. - DIMENSION DPS(4),KFBE(9),NBE(0:10),BEI(100),BEI3(100), - &BEIW(100),BEI3W(100) - DATA KFBE/211,-211,111,321,-321,130,310,221,331/ -C...Statement function: squared invariant mass. - SDIP(I,J)=((P(I,4)+P(J,4))**2-(P(I,3)+P(J,3))**2- - &(P(I,2)+P(J,2))**2-(P(I,1)+P(J,1))**2) - -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)=0D0 - 100 CONTINUE - DO 120 I=1,N - KFA=IABS(K(I,2)) - IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22) - & .AND.K(I,3).GT.0) THEN - KFMA=IABS(K(K(I,3),2)) - IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) - ENDIF - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 - DO 110 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 110 CONTINUE - 120 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4), - &-DPS(3)/DPS(4)) - PECM=0D0 - 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...Check if we have separated strings - -C...Reserve copy of particles by species at end of record. - IWP=0 - IWN=0 - NBE(0)=N+MSTU(3) - NMAX=NBE(0) - SMMIN=PECM - DO 190 IBE=1,MIN(10,MSTJ(52)+1) - NBE(IBE)=NBE(IBE-1) - DO 180 I=NSAV+1,N - IF(IBE.EQ.MIN(10,MSTJ(52)+1)) THEN - DO 140 IIBE=1,IBE-1 - IF(K(I,2).EQ.KFBE(IIBE)) GOTO 180 - 140 CONTINUE - ELSE - IF(K(I,2).NE.KFBE(IBE)) GOTO 180 - ENDIF - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 180 - IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYBOEI:) no more memory left in PYJETS') - RETURN - ENDIF - NBE(IBE)=NBE(IBE)+1 - NMAX=NBE(IBE) - K(NBE(IBE),1)=I - K(NBE(IBE),2)=0 - K(NBE(IBE),3)=0 - K(NBE(IBE),4)=0 - K(NBE(IBE),5)=0 - P(NBE(IBE),1)=0.0D0 - P(NBE(IBE),2)=0.0D0 - P(NBE(IBE),3)=0.0D0 - P(NBE(IBE),4)=0.0D0 - P(NBE(IBE),5)=0.0D0 - SMMIN=MIN(SMMIN,P(I,5)) -C...Check if particles comes from different W's or Z's - IF((MSTJ(53).NE.0.OR.MSTJ(56).GT.0).AND.MINT(32).EQ.0) THEN - IM=I - 150 IF(K(IM,3).GT.0) THEN - IM=K(IM,3) - IF(ABS(K(IM,2)).NE.24.AND.K(IM,2).NE.23) GOTO 150 - K(NBE(IBE),5)=IM - IF(IWP.EQ.0.AND.K(IM,2).EQ.24) IWP=IM - IF(IWN.EQ.0.AND.K(IM,2).EQ.-24) IWN=IM - IF(IWP.EQ.0.AND.K(IM,2).EQ.23) IWP=IM - IF(IWN.EQ.0.AND.K(IM,2).EQ.23.AND.IM.NE.IWP) IWN=IM - ENDIF - ENDIF -C...Check if particles comes from different strings. - IF(PARJ(94).GT.0.0D0) THEN - IM=I - 160 IF(K(IM,3).GT.0) THEN - IM=K(IM,3) - IF(K(IM,2).NE.92.AND.K(IM,2).NE.91) GOTO 160 - K(NBE(IBE),5)=IM - ENDIF - ENDIF - DO 170 J=1,3 - P(NBE(IBE),J)=0D0 - V(NBE(IBE),J)=0D0 - 170 CONTINUE - P(NBE(IBE),5)=-1.0D0 - 180 CONTINUE - 190 CONTINUE - IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 510 - -C...Calculate separation between W+ and W- or between two Z0's. -C...No separation if there has been re-connections. - SIGW=PARJ(93) - IF(IWP.GT.0.AND.IWN.GT.0.AND.MSTJ(56).GT.0.AND.MINT(32).EQ.0) THEN - IF(K(IWP,2).EQ.23) THEN - DMW=PMAS(23,1) - DGW=PMAS(23,2) - ELSE - DMW=PMAS(24,1) - DGW=PMAS(24,2) - ENDIF - DMP=P(IWP,5) - DMN=P(IWN,5) - TAUPD=DMP/SQRT((DMP**2-DMW**2)**2+(DGW*(DMP**2)/DMW)**2) - TAUND=DMN/SQRT((DMN**2-DMW**2)**2+(DGW*(DMN**2)/DMW)**2) - TAUP=-TAUPD*LOG(PYR(IDUM)) - TAUN=-TAUND*LOG(PYR(IDUM)) - DXP=TAUP*PYP(IWP,8)/DMP - DXN=TAUN*PYP(IWN,8)/DMN - DX=DXP+DXN - SIGW=1.0D0/(1.0D0/PARJ(93)+REAL(MSTJ(56))*DX) - IF(PARJ(94).LT.0.0D0) SIGW=1.0D0/(1.0D0/SIGW-1.0D0/PARJ(94)) - ENDIF - -C...Add separation between strings. - IF(PARJ(94).GT.0.0D0) THEN - SIGW=1.0D0/(1.0D0/SIGW+1.0D0/PARJ(94)) - IWP=-1 - IWN=-1 - ENDIF - - IF(MSTJ(57).EQ.1.AND.MSTJ(54).LT.0) THEN - DO 220 IBE=1,MIN(9,MSTJ(52)) - DO 210 I1M=NBE(IBE-1)+1,NBE(IBE) - Q2MIN=PECM**2 - I1=K(I1M,1) - DO 200 I2M=NBE(IBE-1)+1,NBE(IBE) - IF(I2M.EQ.I1M) GOTO 200 - I2=K(I2M,1) - Q2=(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 - IF(Q2.GT.0.0D0.AND.Q2.LT.Q2MIN) THEN - Q2MIN=Q2 - ENDIF - 200 CONTINUE - P(I1M,5)=Q2MIN - 210 CONTINUE - 220 CONTINUE - ENDIF - -C...Tabulate integral for subsequent momentum shift. - DO 400 IBE=1,MIN(9,MSTJ(52)) - IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 270 - IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) - & .LE.1) GOTO 270 - 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 270 - IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 270 - IF(IBE.EQ.1) PMHQ=2D0*PYMASS(211) - IF(IBE.EQ.4) PMHQ=2D0*PYMASS(321) - IF(IBE.EQ.8) PMHQ=2D0*PYMASS(221) - IF(IBE.EQ.9) PMHQ=2D0*PYMASS(331) - QDEL=0.1D0*MIN(PMHQ,PARJ(93)) - QDEL3=0.1D0*MIN(PMHQ,PARJ(93)*3.0D0) - QDELW=0.1D0*MIN(PMHQ,SIGW) - QDEL3W=0.1D0*MIN(PMHQ,SIGW*3.0D0) - IF(MSTJ(51).EQ.1) THEN - NBIN=MIN(100,NINT(9D0*PARJ(93)/QDEL)) - NBIN3=MIN(100,NINT(27D0*PARJ(93)/QDEL3)) - NBINW=MIN(100,NINT(9D0*SIGW/QDELW)) - NBIN3W=MIN(100,NINT(27D0*SIGW/QDEL3W)) - BEEX=EXP(0.5D0*QDEL/PARJ(93)) - BEEX3=EXP(0.5D0*QDEL3/(3.0D0*PARJ(93))) - BEEXW=EXP(0.5D0*QDELW/SIGW) - BEEX3W=EXP(0.5D0*QDEL3W/(3.0D0*SIGW)) - BERT=EXP(-QDEL/PARJ(93)) - BERT3=EXP(-QDEL3/(3.0D0*PARJ(93))) - BERTW=EXP(-QDELW/SIGW) - BERT3W=EXP(-QDEL3W/(3.0D0*SIGW)) - ELSE - NBIN=MIN(100,NINT(3D0*PARJ(93)/QDEL)) - NBIN3=MIN(100,NINT(9D0*PARJ(93)/QDEL3)) - NBINW=MIN(100,NINT(3D0*SIGW/QDELW)) - NBIN3W=MIN(100,NINT(9D0*SIGW/QDEL3W)) - ENDIF - DO 230 IBIN=1,NBIN - QBIN=QDEL*(IBIN-0.5D0) - BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12D0)/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) - 230 CONTINUE - DO 240 IBIN=1,NBIN3 - QBIN=QDEL3*(IBIN-0.5D0) - BEI3(IBIN)=QDEL3*(QBIN**2+QDEL3**2/12D0)/SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEX3=BEEX3*BERT3 - BEI3(IBIN)=BEI3(IBIN)*BEEX3 - ELSE - BEI3(IBIN)=BEI3(IBIN)*EXP(-(QBIN/(3.0D0*PARJ(93)))**2) - ENDIF - IF(IBIN.GE.2) BEI3(IBIN)=BEI3(IBIN)+BEI3(IBIN-1) - 240 CONTINUE - DO 250 IBIN=1,NBINW - QBIN=QDELW*(IBIN-0.5D0) - BEIW(IBIN)=QDELW*(QBIN**2+QDELW**2/12D0)/SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEXW=BEEXW*BERTW - BEIW(IBIN)=BEIW(IBIN)*BEEXW - ELSE - BEIW(IBIN)=BEIW(IBIN)*EXP(-(QBIN/SIGW)**2) - ENDIF - IF(IBIN.GE.2) BEIW(IBIN)=BEIW(IBIN)+BEIW(IBIN-1) - 250 CONTINUE - DO 260 IBIN=1,NBIN3W - QBIN=QDEL3W*(IBIN-0.5D0) - BEI3W(IBIN)=QDEL3W*(QBIN**2+QDEL3W**2/12D0)/ - & SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEX3W=BEEX3W*BERT3W - BEI3W(IBIN)=BEI3W(IBIN)*BEEX3W - ELSE - BEI3W(IBIN)=BEI3W(IBIN)*EXP(-(QBIN/(3.0D0*SIGW))**2) - ENDIF - IF(IBIN.GE.2) BEI3W(IBIN)=BEI3W(IBIN)+BEI3W(IBIN-1) - 260 CONTINUE - -C...Loop through particle pairs and find old relative momentum. - 270 DO 390 I1M=NBE(IBE-1)+1,NBE(IBE)-1 - I1=K(I1M,1) - DO 380 I2M=I1M+1,NBE(IBE) - IF(MSTJ(53).EQ.1.AND.K(I1M,5).NE.K(I2M,5)) GOTO 380 - IF(MSTJ(53).EQ.2.AND.K(I1M,5).EQ.K(I2M,5)) GOTO 380 - I2=K(I2M,1) - Q2OLD=(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 - IF(Q2OLD.LE.0.0D0) GOTO 380 - QOLD=SQRT(Q2OLD) - -C...Calculate new relative momentum. - QMOV=0.0D0 - QMOV3=0.0D0 - QMOVW=0.0D0 - QMOV3W=0.0D0 - IF(QOLD.LT.1D-3*QDEL) THEN - GOTO 280 - ELSEIF(QOLD.LE.QDEL) THEN - QMOV=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN-0.1D0)*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 - 280 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV))**(2D0/3D0) - IF(QOLD.LT.1D-3*QDEL3) THEN - GOTO 290 - ELSEIF(QOLD.LE.QDEL3) THEN - QMOV3=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN3-0.1D0)*QDEL3) THEN - RBIN3=QOLD/QDEL3 - IBIN3=RBIN3 - RINP3=(RBIN3**3-IBIN3**3)/(3*IBIN3*(IBIN3+1)+1) - QMOV3=(BEI3(IBIN3)+RINP3*(BEI3(IBIN3+1)-BEI3(IBIN3)))* - & SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOV3=BEI3(NBIN3)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 290 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3))**(2D0/3D0) - RSCALE=1.0D0 - IF(MSTJ(54).EQ.2) - & RSCALE=1.0D0-EXP(-(QOLD/(2D0*PARJ(93)))**2) - IF((IWP.NE.-1.AND.MSTJ(56).LE.0).OR.IWP.EQ.0.OR.IWN.EQ.0.OR. - & K(I1M,5).EQ.K(I2M,5)) GOTO 320 - - IF(QOLD.LT.1D-3*QDELW) THEN - GOTO 300 - ELSEIF(QOLD.LE.QDELW) THEN - QMOVW=QOLD/3D0 - ELSEIF(QOLD.LT.(NBINW-0.1D0)*QDELW) THEN - RBINW=QOLD/QDELW - IBINW=RBINW - RINPW=(RBINW**3-IBINW**3)/(3*IBINW*(IBINW+1)+1) - QMOVW=(BEIW(IBINW)+RINPW*(BEIW(IBINW+1)-BEIW(IBINW)))* - & SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOVW=BEIW(NBINW)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 300 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOVW))**(2D0/3D0) - IF(QOLD.LT.1D-3*QDEL3W) THEN - GOTO 310 - ELSEIF(QOLD.LE.QDEL3W) THEN - QMOV3W=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN3W-0.1D0)*QDEL3W) THEN - RBIN3W=QOLD/QDEL3W - IBIN3W=RBIN3W - RINP3W=(RBIN3W**3-IBIN3W**3)/(3*IBIN3W*(IBIN3W+1)+1) - QMOV3W=(BEI3W(IBIN3W)+RINP3W*(BEI3W(IBIN3W+1)- - & BEI3W(IBIN3W)))*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOV3W=BEI3W(NBIN3W)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 310 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3W))**(2D0/3D0) - IF(MSTJ(54).EQ.2) - & RSCALE=1.0D0-EXP(-(QOLD/(2D0*SIGW))**2) - - 320 CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW) - DO 330 J=1,3 - P(I1M,J)=P(I1M,J)+P(NMAX+1,J) - P(I2M,J)=P(I2M,J)+P(NMAX+2,J) - 330 CONTINUE - IF(MSTJ(54).GE.1) THEN - CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW3) - DO 340 J=1,3 - V(I1M,J)=V(I1M,J)+P(NMAX+1,J)*RSCALE - V(I2M,J)=V(I2M,J)+P(NMAX+2,J)*RSCALE - 340 CONTINUE - ELSEIF(MSTJ(54).LE.-1) THEN - EDEL=P(I1,4)+P(I2,4)- - & SQRT(MAX(Q2NEW-Q2OLD+(P(I1,4)+P(I2,4))**2,0.0D0)) - A2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ - & (P(I1,3)-P(I2,3))**2 - WMAX=-1.0D20 - MI3=0 - MI4=0 - S12=SDIP(I1,I2) - SM1=(P(I1,5)+SMMIN)**2 - DO 360 I3M=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - IF(I3M.EQ.I1M.OR.I3M.EQ.I2M) GOTO 360 - IF(MSTJ(53).EQ.1.AND.K(I3M,5).NE.K(I1M,5)) GOTO 360 - IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. - & K(I3M,5).NE.K(I1M,5)) GOTO 360 - I3=K(I3M,1) - IF(K(I3,2).EQ.K(I1,2)) GOTO 360 - S13=SDIP(I1,I3) - S23=SDIP(I2,I3) - SM3=(P(I3,5)+SMMIN)**2 - IF(MSTJ(54).EQ.-2) THEN - WI=(MIN(S12*SM3,S13*MIN(SM1,SM3), - & S23*MIN(SM1,SM3))*SM1) - ELSE - WI=((P(I1,4)+P(I2,4)+P(I3,4))**2- - & (P(I1,3)+P(I2,3)+P(I3,3))**2- - & (P(I1,2)+P(I2,2)+P(I3,2))**2- - & (P(I1,1)+P(I2,1)+P(I3,1))**2) - ENDIF - IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) THEN - IF (WMAX*WI.GE.(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2)))) - & GOTO 360 - ELSE - IF(WMAX*WI.GE.1.0) GOTO 360 - ENDIF - DO 350 I4M=I3M+1,NBE(MIN(10,MSTJ(52)+1)) - IF(I4M.EQ.I1M.OR.I4M.EQ.I2M) GOTO 350 - IF(MSTJ(53).EQ.1.AND.K(I4M,5).NE.K(I1M,5)) GOTO 350 - IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. - & K(I4M,5).NE.K(I1M,5)) GOTO 350 - I4=K(I4M,1) - IF(K(I3,2).EQ.K(I4,2).OR.K(I4,2).EQ.K(I1,2)) - & GOTO 350 - IF((P(I3,4)+P(I4,4)+EDEL)**2.LT. - & (P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ - & (P(I3,3)+P(I4,3))**2+(P(I3,5)+P(I4,5))**2) - & GOTO 350 - IF(MSTJ(54).EQ.-2) THEN - S14=SDIP(I1,I4) - S24=SDIP(I2,I4) - S34=SDIP(I3,I4) - W=S12*MIN(MIN(S23,S24),MIN(S13,S14))*S34 - W=MIN(W,S13*MIN(MIN(S23,S34),S12)*S24) - W=MIN(W,S14*MIN(MIN(S24,S34),S12)*S23) - W=MIN(W,MIN(S23,S24)*S13*S14) - W=1.0D0/W - ELSE -C...weight=1-cos(theta)/mtot2 - S1234=(P(I1,4)+P(I2,4)+P(I3,4)+P(I4,4))**2- - & (P(I1,3)+P(I2,3)+P(I3,3)+P(I4,3))**2- - & (P(I1,2)+P(I2,2)+P(I3,2)+P(I4,2))**2- - & (P(I1,1)+P(I2,1)+P(I3,1)+P(I4,1))**2 - W=1.0D0/S1234 - IF(W.LE.WMAX) GOTO 350 - ENDIF - IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) - & W=W*(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2))) - IF(MSTJ(57).EQ.1.AND.P(I4M,5).GT.0) - & W=W*(1.0D0-EXP(-P(I4M,5)/(PARJ(93)**2))) - IF(W.LE.WMAX) GOTO 350 - MI3=I3M - MI4=I4M - WMAX=W - 350 CONTINUE - 360 CONTINUE - IF(MI4.EQ.0) GOTO 380 - I3=K(MI3,1) - I4=K(MI4,1) - EOLD=P(I3,4)+P(I4,4) - ENEW=EOLD+EDEL - P2=(P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ - & (P(I3,3)+P(I4,3))**2 - Q2NEWP=MAX(0.0D0,ENEW**2-P2-(P(I3,5)+P(I4,5))**2) - Q2OLDP=MAX(0.0D0,EOLD**2-P2-(P(I3,5)+P(I4,5))**2) - CALL PYBESQ(I3,I4,NMAX,Q2OLDP,Q2NEWP) - DO 370 J=1,3 - V(MI3,J)=V(MI3,J)+P(NMAX+1,J) - V(MI4,J)=V(MI4,J)+P(NMAX+2,J) - 370 CONTINUE - ENDIF - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - -C...Shift momenta and recalculate energies. - ESUMP=0.0D0 - ESUM=0.0D0 - PROD=0.0D0 - DO 430 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - I=K(IM,1) - ESUMP=ESUMP+P(I,4) - DO 410 J=1,3 - P(I,J)=P(I,J)+P(IM,J) - 410 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - ESUM=ESUM+P(I,4) - DO 420 J=1,3 - PROD=PROD+V(IM,J)*P(I,J)/P(I,4) - 420 CONTINUE - 430 CONTINUE - - PARJ(96)=0.0D0 - IF(MSTJ(54).NE.0.AND.PROD.NE.0.0D0) THEN - 440 ALPHA=(ESUMP-ESUM)/PROD - PARJ(96)=PARJ(96)+ALPHA - PROD=0.0D0 - ESUM=0.0D0 - DO 470 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - I=K(IM,1) - DO 450 J=1,3 - P(I,J)=P(I,J)+ALPHA*V(IM,J) - 450 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - ESUM=ESUM+P(I,4) - DO 460 J=1,3 - PROD=PROD+V(IM,J)*P(I,J)/P(I,4) - 460 CONTINUE - 470 CONTINUE - IF(PROD.NE.0.0D0.AND.ABS(ESUMP-ESUM)/PECM.GT.0.00001D0) - & GOTO 440 - ENDIF - -C...Rescale all momenta for energy conservation. - PES=0D0 - PQS=0D0 - DO 480 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 480 - PES=PES+P(I,4) - PQS=PQS+P(I,5)**2/P(I,4) - 480 CONTINUE - PARJ(95)=PES-PECM - FAC=(PECM-PQS)/(PES-PQS) - DO 500 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 500 - DO 490 J=1,3 - P(I,J)=FAC*P(I,J) - 490 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 500 CONTINUE - -C...Boost back to correct reference frame. - 510 CALL PYROBO(0,0,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) - DO 520 I=1,N - IF(K(I,1).LT.0) K(I,1)=-K(I,1) - 520 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYBOOK -C...Books a histogram. - - SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Local character variables. - CHARACTER TITLE*(*), TITFX*60 - -C...Check that input is sensible. Find initial address in memory. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYBOOK:) not allowed histogram number') - IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28, - &'(PYBOOK:) not allowed number of bins') - IF(XL.GE.XU) CALL PYERRM(28, - &'(PYBOOK:) x limits in wrong order') - INDX(ID)=IHIST(4) - IHIST(4)=IHIST(4)+28+NX - IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28, - &'(PYBOOK:) out of histogram space') - IS=INDX(ID) - -C...Store histogram size and reset contents. - BIN(IS+1)=NX - BIN(IS+2)=XL - BIN(IS+3)=XU - BIN(IS+4)=(XU-XL)/NX - CALL PYNULL(ID) - -C...Store title by conversion to integer to double precision. - TITFX=TITLE//' ' - DO 100 IT=1,20 - BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+ - & 256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT)) - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYCBA2 -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE -C CBABK2, WHICH IS A COMPLEX VERSION OF BALBAK, -C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). -C -C THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX GENERAL -C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C BALANCED MATRIX DETERMINED BY CBAL. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY CBAL. -C -C SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS -C AND SCALING FACTORS USED BY CBAL. -C -C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS TO BE -C BACK TRANSFORMED IN THEIR FIRST M COLUMNS. -C -C ON OUTPUT -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE TRANSFORMED EIGENVECTORS -C IN THEIR FIRST M COLUMNS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCBA2(NM,N,LOW,IGH,SCALE,M,ZR,ZI) - - INTEGER I,J,K,M,N,II,NM,IGH,LOW - DOUBLE PRECISION SCALE(4),ZR(4,4),ZI(4,4) - DOUBLE PRECISION S - - IF (M .EQ. 0) GOTO 150 - IF (IGH .EQ. LOW) GOTO 120 -C - DO 110 I = LOW, IGH - S = SCALE(I) -C .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED -C IF THE FOREGOING STATEMENT IS REPLACED BY -C S=1.0D0/SCALE(I). .......... - DO 100 J = 1, M - ZR(I,J) = ZR(I,J) * S - ZI(I,J) = ZI(I,J) * S - 100 CONTINUE -C - 110 CONTINUE -C .......... FOR I=LOW-1 STEP -1 UNTIL 1, -C IGH+1 STEP 1 UNTIL N DO -- .......... - 120 DO 140 II = 1, N - I = II - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 - IF (I .LT. LOW) I = LOW - II - K = SCALE(I) - IF (K .EQ. I) GOTO 140 -C - DO 130 J = 1, M - S = ZR(I,J) - ZR(I,J) = ZR(K,J) - ZR(K,J) = S - S = ZI(I,J) - ZI(I,J) = ZI(K,J) - ZI(K,J) = S - 130 CONTINUE -C - 140 CONTINUE -C - 150 RETURN - END - -C********************************************************************* - -C...PYCBAL -C...Auxiliary to PYEICG -C -C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE -C CBALANCE, WHICH IS A COMPLEX VERSION OF BALANCE, -C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). -C -C THIS SUBROUTINE BALANCES A COMPLEX MATRIX AND ISOLATES -C EIGENVALUES WHENEVER POSSIBLE. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX MATRIX TO BE BALANCED. -C -C ON OUTPUT -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE BALANCED MATRIX. -C -C LOW AND IGH ARE TWO INTEGERS SUCH THAT AR(I,J) AND AI(I,J) -C ARE EQUAL TO ZERO IF -C (1) I IS GREATER THAN J AND -C (2) J=1,...,LOW-1 OR I=IGH+1,...,N. -C -C SCALE CONTAINS INFORMATION DETERMINING THE -C PERMUTATIONS AND SCALING FACTORS USED. -C -C SUPPOSE THAT THE PRINCIPAL SUBMATRIX IN ROWS LOW THROUGH IGH -C HAS BEEN BALANCED, THAT P(J) DENOTES THE INDEX INTERCHANGED -C WITH J DURING THE PERMUTATION STEP, AND THAT THE ELEMENTS -C OF THE DIAGONAL MATRIX USED ARE DENOTED BY D(I,J). THEN -C SCALE(J) = P(J), FOR J = 1,...,LOW-1 -C = D(J,J) J = LOW,...,IGH -C = P(J) J = IGH+1,...,N. -C THE ORDER IN WHICH THE INTERCHANGES ARE MADE IS N TO IGH+1, -C THEN 1 TO LOW-1. -C -C NOTE THAT 1 IS RETURNED FOR IGH IF IGH IS ZERO FORMALLY. -C -C THE ALGOL PROCEDURE EXC CONTAINED IN CBALANCE APPEARS IN -C CBAL IN LINE. (NOTE THAT THE ALGOL ROLES OF IDENTIFIERS -C K,L HAVE BEEN REVERSED.) -C -C ARITHMETIC IS REAL THROUGHOUT. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCBAL(NM,N,AR,AI,LOW,IGH,SCALE) - - INTEGER I,J,K,L,M,N,JJ,NM,IGH,LOW,IEXC - DOUBLE PRECISION AR(4,4),AI(4,4),SCALE(4) - DOUBLE PRECISION C,F,G,R,S,B2,RADIX - LOGICAL NOCONV - - RADIX = 16.0D0 -C - B2 = RADIX * RADIX - K = 1 - L = N - GOTO 150 -C .......... IN-LINE PROCEDURE FOR ROW AND -C COLUMN EXCHANGE .......... - 100 SCALE(M) = J - IF (J .EQ. M) GOTO 130 -C - DO 110 I = 1, L - F = AR(I,J) - AR(I,J) = AR(I,M) - AR(I,M) = F - F = AI(I,J) - AI(I,J) = AI(I,M) - AI(I,M) = F - 110 CONTINUE -C - DO 120 I = K, N - F = AR(J,I) - AR(J,I) = AR(M,I) - AR(M,I) = F - F = AI(J,I) - AI(J,I) = AI(M,I) - AI(M,I) = F - 120 CONTINUE -C - 130 IF(IEXC.EQ.1) GOTO 140 - IF(IEXC.EQ.2) GOTO 180 -C .......... SEARCH FOR ROWS ISOLATING AN EIGENVALUE -C AND PUSH THEM DOWN .......... - 140 IF (L .EQ. 1) GOTO 320 - L = L - 1 -C .......... FOR J=L STEP -1 UNTIL 1 DO -- .......... - 150 DO 170 JJ = 1, L - J = L + 1 - JJ -C - DO 160 I = 1, L - IF (I .EQ. J) GOTO 160 - IF (AR(J,I) .NE. 0.0D0 .OR. AI(J,I) .NE. 0.0D0) GOTO 170 - 160 CONTINUE -C - M = L - IEXC = 1 - GOTO 100 - 170 CONTINUE -C - GOTO 190 -C .......... SEARCH FOR COLUMNS ISOLATING AN EIGENVALUE -C AND PUSH THEM LEFT .......... - 180 K = K + 1 -C - 190 DO 210 J = K, L -C - DO 200 I = K, L - IF (I .EQ. J) GOTO 200 - IF (AR(I,J) .NE. 0.0D0 .OR. AI(I,J) .NE. 0.0D0) GOTO 210 - 200 CONTINUE -C - M = K - IEXC = 2 - GOTO 100 - 210 CONTINUE -C .......... NOW BALANCE THE SUBMATRIX IN ROWS K TO L .......... - DO 220 I = K, L - 220 SCALE(I) = 1.0D0 -C .......... ITERATIVE LOOP FOR NORM REDUCTION .......... - 230 NOCONV = .FALSE. -C - DO 310 I = K, L - C = 0.0D0 - R = 0.0D0 -C - DO 240 J = K, L - IF (J .EQ. I) GOTO 240 - C = C + DABS(AR(J,I)) + DABS(AI(J,I)) - R = R + DABS(AR(I,J)) + DABS(AI(I,J)) - 240 CONTINUE -C .......... GUARD AGAINST ZERO C OR R DUE TO UNDERFLOW .......... - IF (C .EQ. 0.0D0 .OR. R .EQ. 0.0D0) GOTO 310 - G = R / RADIX - F = 1.0D0 - S = C + R - 250 IF (C .GE. G) GOTO 260 - F = F * RADIX - C = C * B2 - GOTO 250 - 260 G = R * RADIX - 270 IF (C .LT. G) GOTO 280 - F = F / RADIX - C = C / B2 - GOTO 270 -C .......... NOW BALANCE .......... - 280 IF ((C + R) / F .GE. 0.95D0 * S) GOTO 310 - G = 1.0D0 / F - SCALE(I) = SCALE(I) * F - NOCONV = .TRUE. -C - DO 290 J = K, N - AR(I,J) = AR(I,J) * G - AI(I,J) = AI(I,J) * G - 290 CONTINUE -C - DO 300 J = 1, L - AR(J,I) = AR(J,I) * F - AI(J,I) = AI(J,I) * F - 300 CONTINUE -C - 310 CONTINUE -C - IF (NOCONV) GOTO 230 -C - 320 LOW = K - IGH = L - RETURN - END - -C********************************************************************* - -C...PYCDIV -C...Auxiliary to PYCMQR -C -C COMPLEX DIVISION, (CR,CI) = (AR,AI)/(BR,BI) -C - - SUBROUTINE PYCDIV(AR,AI,BR,BI,CR,CI) - - DOUBLE PRECISION AR,AI,BR,BI,CR,CI - DOUBLE PRECISION S,ARS,AIS,BRS,BIS - - S = DABS(BR) + DABS(BI) - ARS = AR/S - AIS = AI/S - BRS = BR/S - BIS = BI/S - S = BRS**2 + BIS**2 - CR = (ARS*BRS + AIS*BIS)/S - CI = (AIS*BRS - ARS*BIS)/S - RETURN - END - -C********************************************************************* - -C...PYCELL -C...Provides a simple way of jet finding in eta-phi-ET coordinates, -C...as used for calorimeters at hadron colliders. - - SUBROUTINE PYCELL(NJET) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Loop over all particles. Find cell that was hit by given particle. - PTLRAT=1D0/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=PYCOMP(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.PYCHGE(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.5D0* - & (ETA/PARU(51)+1D0)))) - PHI=PYANGL(P(I,1),P(I,2)) - IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5D0* - & (PHI/PARU(1)+1D0)))) - 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 PYERRM(11,'(PYCELL:) no more memory left in PYJETS') - 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(-2D0*LOG(MAX(1D-10,PYR(0)))*PEI)* - & COS(PARU(2)*PYR(0)) - IF(PEF.LT.0D0.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.0D0) 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=0D0 - 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 PYERRM(11,'(PYCELL:) no more memory left in PYJETS') - 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)=0D0 - P(NJ,4)=0D0 - P(NJ,5)=0D0 - -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)=0D0 - 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=0D0 - 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)=0D0 - 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)=0D0 - 260 CONTINUE - ELSEIF(MSTU(54).GE.3) THEN - DO 270 I=N+1,N+NJET - P(I,5)=SQRT(MAX(0D0,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)=MAX(0,NJET) - IF(MSTU(43).GE.2) N=N+MAX(0,NJET) - - RETURN - END - -C********************************************************************* - -C...PYCHGE -C...Gives three times the charge for a particle/parton. - - FUNCTION PYCHGE(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT2/ - -C...Read out charge and change sign for antiparticle. - PYCHGE=0 - KC=PYCOMP(KF) - IF(KC.NE.0) PYCHGE=KCHG(KC,1)*ISIGN(1,KF) - - RETURN - END - -C********************************************************************* - -C...PYCJDC -C...Calculate decay widths for the charginos (admixtures of -C...charged Wino and charged Higgsino. - -C...Input: KCIN = KF code for particle -C...Output: XLAM = widths -C... IDLAM = KF codes for decay particles -C... IKNT = number of decay channels defined -C...AUTHOR: STEPHEN MRENNA -C...Last change: -C...10-16-95: force decay chi^+_1 -> chi^0_1 e+ nu_e -C...when CHIENU .NE. 0 - - SUBROUTINE PYCJDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -CC &SFMIX(16,4), -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP - COMPLEX*16 CAL,CBL,CAR,CBR,CA,CB - INTEGER KFIN,KCIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, - &XMZ,XMZ2,AXMJ,AXMI - DOUBLE PRECISION S12MIN,S12MAX - DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2,XMK - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I,BETA,ALFA - DOUBLE PRECISION PYX2XH,PYX2XG - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,IH,J,IJ,I,IKNT - INTEGER ITH(3) - INTEGER ITHC - DOUBLE PRECISION ETAH(3),DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA,TANB - - DOUBLE PRECISION PYALEM,PI,PYALPS - DOUBLE PRECISION FCOL - INTEGER KF1,KF2,ISF - INTEGER KFNCHI(4),KFCCHI(2) - - DOUBLE PRECISION TEMP - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - DATA ITH/25,35,36/ - DATA ITHC/37/ - DATA ETAH/1D0,1D0,-1D0/ - DATA SR2/1.4142136D0/ - DATA PI/3.141592654D0/ - DATA PREC/1D-2/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XMZ2=XMZ**2 - XW=1D0-XMW2/XMZ2 - XW1=1D0-XW - TANW = SQRT(XW/XW1) - -C...1 OR 2 DEPENDING ON CHARGINO TYPE - IX=1 - IF(KFIN.EQ.KFCCHI(2)) IX=2 - KCIN=PYCOMP(KFIN) - - XMI=SMW(IX) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - TANB=RMSS(5) - BETA=ATAN(TANB) - CBETA=COS(BETA) - SBETA=TANB*CBETA - ALFA=RMSS(18) - - DO 110 I=1,2 - DO 100 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - -C...GRAVITINO DECAY MODES - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) -C SINW=SQRT(XW) -C COSW=SQRT(1D0-XW) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR+XMW) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*( - & .5D0*(ABS(VMIXC(IX,1))**2+ABS(UMIXC(IX,1))**2)+ - & .5D0*((ABS(VMIXC(IX,2))*SBETA)**2+(ABS(UMIXC(IX,2))*CBETA)**2))* - & (1D0-XMW2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(37,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=37 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(.5D0*((ABS(VMIXC(IX,2))*CBETA)**2+ - & (ABS(UMIXC(IX,2))*SBETA)**2)) - & *(1D0-PMAS(37,1)**2/XMI2)**4 - ENDIF - ENDIF - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS - IF(IX.EQ.1) GOTO 170 - XMJ=SMW(1) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - -C...CHI_2+ -> CHI_1+ + Z0 - IF(AXMI.GE.AXMJ+XMZ) THEN - LKNT=LKNT+1 - IJ=1 - OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- - & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 - ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- - & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - -C...CHARGED LEPTONS - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IA=11 - JA=12 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - XXC(9)=PMAS(23,1) - XXC(10)=PMAS(23,2) - IJ=1 - OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- - & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 - ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- - & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=11 - IDLAM(LKNT,3)=-11 - IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-13 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-15 - ENDIF - ENDIF - -C...NEUTRINOS - 120 CONTINUE - IA=12 - JA=11 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(7)=-DCMPLX(EI/XW1)*OLPP - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(12,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=12 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=14 - IDLAM(LKNT,3)=-14 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(16,1)) THEN - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=16 - IDLAM(LKNT,3)=-16 - ENDIF - -C...D-TYPE QUARKS - 130 CONTINUE - IA=1 - JA=2 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF - -C...U-TYPE QUARKS - 140 CONTINUE - IA=2 - JA=1 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 150 CONTINUE - ENDIF - -C...CHI_2+ -> CHI_1+ + H0_K - EH(2)=COS(ALFA) - EH(1)=SIN(ALFA) - EH(3)=-SBETA - DH(2)=-SIN(ALFA) - DH(1)=COS(ALFA) - DH(3)=COS(BETA) - DO 160 IH=1,3 - XMH=PMAS(ITH(IH),1) - XMH2=XMH**2 -C...NO 3-BODY OPTION - IF(AXMI.GE.AXMJ+XMH) THEN - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMJ2,XMH2) - OLPP=(VMIXC(2,1)*DCONJG(UMIXC(1,2))*EH(IH) - - & VMIXC(2,2)*DCONJG(UMIXC(1,1))*DH(IH))/SR2 - ORPP=(DCONJG(VMIXC(1,1))*UMIXC(2,2)*EH(IH) - - & DCONJG(VMIXC(1,2))*UMIXC(2,1)*DH(IH))/SR2 - XMK=XMJ*ETAH(IH) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=ITH(IH) - IDLAM(LKNT,3)=0 - ENDIF - 160 CONTINUE - -C...CHI1 JUMPS TO HERE - 170 CONTINUE - -C...CHI+_I -> CHI0_J + W+ - DO 220 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - IF(AXMI.GE.AXMJ+XMW) THEN - LKNT=LKNT+1 - DO 180 I=1,4 - ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) - 180 CONTINUE - CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- - & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2) - CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ - & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2) - GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 - GLR=DBLE(CXC(1)*DCONJG(CXC(3))) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 -C...LEPTONS - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - DO 190 I=1,4 - ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) - 190 CONTINUE - CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- - & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2)/SR2 - CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ - & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2)/SR2 - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - IA=11 - JA=12 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IX,1)*DCONJG(ZMIXC(IJ,1)*(EJ-T3J)* - & TANW+ZMIXC(IJ,2)*T3J)/SR2 - CXC(4)=-DCONJG(UMIXC(IX,1))*( - & ZMIXC(IJ,1)*(EI-T3I)*TANW+ZMIXC(IJ,2)*T3I)/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(9)=PMAS(24,1) - XXC(10)=PMAS(24,2) -CCC IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) -C...1/(2PI)**3*/(32*M**3)*G^4, G^2/(4*PI)= AEM/XW, -C...--> 1/(16PI)/M**3*(AEM/XW)**2 - IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN - LKNT=LKNT+1 - TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-11 - IDLAM(LKNT,3)=12 -C...ONLY DECAY CHI+1 -> E+ NU_E - IF( IMSS(12).NE. 0 ) GOTO 260 - IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-13 - IDLAM(LKNT,3)=14 - ENDIF - ENDIF - IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN - LKNT=LKNT+1 - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-15 - IDLAM(LKNT,3)=16 - ENDIF - -C...NOW, DO THE QUARKS - 200 CONTINUE - IA=1 - JA=2 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IX,1)*DCONJG(ZMIXC(IJ,1)*(EJ-T3J)* - & TANW+ZMIXC(IJ,2)*T3J) - CXC(4)=-DCONJG(UMIXC(IX,1))*( - & ZMIXC(IJ,1)*(EI-T3I)*TANW+ZMIXC(IJ,2)*T3I) - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 210 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-1 - IDLAM(LKNT,3)=2 - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-3 - IDLAM(LKNT,3)=4 - ENDIF - ENDIF - 210 CONTINUE - ENDIF - 220 CONTINUE - -C...CHI+_I -> CHI0_J + H+ - DO 230 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - XMHP=PMAS(ITHC,1) - IF(AXMI.GE.AXMJ+XMHP) THEN - LKNT=LKNT+1 - OLPP=CBETA*(ZMIXC(IJ,4)*DCONJG(VMIXC(IX,1))+(ZMIXC(IJ,2)+ - & ZMIXC(IJ,1)*TANW)*DCONJG(VMIXC(IX,2))/SR2) - ORPP=SBETA*(DCONJG(ZMIXC(IJ,3))*UMIXC(IX,1)- - & (DCONJG(ZMIXC(IJ,2))+DCONJG(ZMIXC(IJ,1))*TANW)* - & UMIXC(IX,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=ITHC - IDLAM(LKNT,3)=0 - ELSE - - ENDIF - 230 CONTINUE - -C...2-BODY DECAYS TO FERMION SFERMION - DO 240 J=1,16 - IF(J.GE.7.AND.J.LE.10) GOTO 240 - IF(MOD(J,2).EQ.0) THEN - KF1=KSUSY1+J-1 - ELSE - KF1=KSUSY1+J+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - XMF=PMAS(J,1) - IF(J.LE.6) THEN - FCOL=3D0 - ELSE - FCOL=1D0 - ENDIF - -C...U~ D_L - IF(MOD(J,2).EQ.0) THEN - XMFP=PMAS(J-1,1) - CAL=UMIXC(IX,1) - CBL=-XMF*VMIXC(IX,2)/XMW/SBETA/SR2 - CAR=-XMFP*UMIXC(IX,2)/XMW/CBETA/SR2 - CBR=0D0 - ISF=J-1 - ELSE - XMFP=PMAS(J+1,1) - CAL=VMIXC(IX,1) - CBL=-XMF*UMIXC(IX,2)/XMW/CBETA/SR2 - CBR=0D0 - CAR=-XMFP*VMIXC(IX,2)/XMW/SBETA/SR2 - ISF=J+1 - ENDIF - -C...~U_L D - IF(AXMI.GE.XMF+XMSF1) THEN - LKNT=LKNT+1 - XMA2=XMSF1**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - CA=CAL*SFMIX(ISF,1)+CAR*SFMIX(ISF,2) - CB=CBL*SFMIX(ISF,1)+CBR*SFMIX(ISF,2) - XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,3)=0 - IF(MOD(J,2).EQ.0) THEN - IDLAM(LKNT,1)=-KF1 - IDLAM(LKNT,2)=J - ELSE - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=-J - ENDIF - ENDIF - -C...U~ D_R - IF(AXMI.GE.XMF+XMSF2) THEN - LKNT=LKNT+1 - XMA2=XMSF2**2 - XMB2=XMF**2 - CA=CAL*SFMIX(ISF,3)+CAR*SFMIX(ISF,4) - CB=CBL*SFMIX(ISF,3)+CBR*SFMIX(ISF,4) - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,3)=0 - IF(MOD(J,2).EQ.0) THEN - IDLAM(LKNT,1)=-KF2 - IDLAM(LKNT,2)=J - ELSE - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=-J - ENDIF - ENDIF - 240 CONTINUE - -C...3-BODY DECAY TO Q Q~' GLUINO, ONLY IF IT CANNOT PROCEED THROUGH -C...A 2-BODY -- 2-BODY CHAIN - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - IF(AXMI.GE.XMJ) THEN - AXMJ=ABS(XMJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) - XXC(9)=1D6 - XXC(10)=0D0 - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) - ORPP=DCONJG(OLPP) - CXC(1)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX(0D0,0D0) - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - CXC(2)=UMIXC(IX,1)*OLPP/SR2 - CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 250 - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=-1 - IDLAM(LKNT,3)=2 - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=-3 - IDLAM(LKNT,3)=4 - ENDIF - ENDIF - 250 CONTINUE - ENDIF - -C...R-violating decay modes (SKANDS). - CALL PYRVCH(KFIN,XLAM,IDLAM,LKNT) - - 260 IKNT=LKNT - XLAM(0)=0D0 - DO 270 I=1,IKNT - XLAM(0)=XLAM(0)+XLAM(I) - IF(XLAM(I).LT.0D0) THEN - WRITE(MSTU(11),*) ' XLAM(I) = ',XLAM(I),KCIN, - & (IDLAM(I,J),J=1,3) - XLAM(I)=0D0 - ENDIF - 270 CONTINUE - IF(XLAM(0).EQ.0D0) THEN - XLAM(0)=1D-6 - WRITE(MSTU(11),*) ' XLAM(0) = ',XLAM(0) - WRITE(MSTU(11),*) LKNT - WRITE(MSTU(11),*) (XLAM(J),J=1,LKNT) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYCLUS -C...Subdivides the particle content of an event into jets/clusters. - - SUBROUTINE PYCLUS(NJET) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays and saved variables. - 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))*2D0*P(I1,5)*P(I2,5)/(0.0001D0+P(I1,5)+P(I2,5))**2 - R2M(I1,I2)=2D0*P(I1,4)*P(I2,4)*(1D0-(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)=2D0*MIN(P(I1,4),P(I2,4))**2*(1D0-(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)=0D0 - 100 CONTINUE - PSS=0D0 - PIMASS=PMAS(PYCOMP(211),1) - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 140 - ENDIF - IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYCLUS:) no more memory left in PYJETS') - 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)=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS - 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(0D0,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 PYERRM(8,'(PYCLUS:) 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.25D0*PARU(43) - IF(NP.LE.MSTU(47)+2) RINIT=0D0 - 170 RINIT=0.8D0*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)=0D0 - 190 CONTINUE - DO 210 I=N+NP+1,N+2*NP - IF(P(I,5).GT.2D0*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.2D0*RINIT) NPRE=1 - IF(RINIT.GE.0.2D0*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=0D0 - 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.2D0*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=0D0 - PSJT=0D0 - 310 IF(MSTU(46).LE.1) THEN - DO 330 I=N+1,N+NJET - DO 320 J=1,4 - V(I,J)=0D0 - 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=0D0 - 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=2D0*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=0D0 - 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=0D0 - 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)=-1D0 - 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=0D0 - 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,0D0)) - DO 560 J=1,5 - V(I,J)=0D0 - 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)=0D0 - IF(IEMP.NE.0) THEN - CALL PYERRM(8,'(PYCLUS:) failed to reconstruct as requested') - NJET=-1 - RETURN - ENDIF - IF(MSTU(43).LE.1) MSTU(3)=MAX(0,NJET) - IF(MSTU(43).GE.2) N=N+MAX(0,NJET) - NSAV=NJET - - RETURN - END - -C********************************************************************* - -C...PYCMQ2 -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE -C ALGOL PROCEDURE COMLR2, NUM. MATH. 16, 181-204(1970) BY PETERS -C AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 372-395(1971). -C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS -C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. -C -C THIS SUBROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS -C OF A COMPLEX UPPER HESSENBERG MATRIX BY THE QR -C METHOD. THE EIGENVECTORS OF A COMPLEX GENERAL MATRIX -C CAN ALSO BE FOUND IF CORTH HAS BEEN USED TO REDUCE -C THIS GENERAL MATRIX TO HESSENBERG FORM. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C ORTR AND ORTI CONTAIN INFORMATION ABOUT THE UNITARY TRANS- -C FORMATIONS USED IN THE REDUCTION BY CORTH, IF PERFORMED. -C ONLY ELEMENTS LOW THROUGH IGH ARE USED. IF THE EIGENVECTORS -C OF THE HESSENBERG MATRIX ARE DESIRED, SET ORTR(J) AND -C ORTI(J) TO 0.0D0 FOR THESE ELEMENTS. -C -C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. -C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN FURTHER -C INFORMATION ABOUT THE TRANSFORMATIONS WHICH WERE USED IN THE -C REDUCTION BY CORTH, IF PERFORMED. IF THE EIGENVECTORS OF -C THE HESSENBERG MATRIX ARE DESIRED, THESE ELEMENTS MAY BE -C ARBITRARY. -C -C ON OUTPUT -C -C ORTR, ORTI, AND THE UPPER HESSENBERG PORTIONS OF HR AND HI -C HAVE BEEN DESTROYED. -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR -C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT -C FOR INDICES IERR+1,...,N. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS. THE EIGENVECTORS -C ARE UNNORMALIZED. IF AN ERROR EXIT IS MADE, NONE OF -C THE EIGENVECTORS HAS BEEN FOUND. -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED -C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. -C -C CALLS PYCDIV FOR COMPLEX DIVISION. -C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED OCTOBER 1989. -C -C MESHED OVERFLOW CONTROL WITH VECTORS OF ISOLATED ROOTS (10/19/89 BSG) -C MESHED OVERFLOW CONTROL WITH TRIANGULAR MULTIPLY (10/30/89 BSG) -C - - SUBROUTINE PYCMQ2(NM,N,LOW,IGH,ORTR,ORTI,HR,HI,WR,WI,ZR,ZI,IERR) - - INTEGER I,J,K,L,M,N,EN,II,JJ,LL,NM,NN,IGH,IP1, - X ITN,ITS,LOW,LP1,ENM1,IEND,IERR - DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), - X ORTR(4),ORTI(4) - DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, - X PYTHAG - - IERR = 0 -C .......... INITIALIZE EIGENVECTOR MATRIX .......... - DO 110 J = 1, N -C - DO 100 I = 1, N - ZR(I,J) = 0.0D0 - ZI(I,J) = 0.0D0 - 100 CONTINUE - ZR(J,J) = 1.0D0 - 110 CONTINUE -C .......... FORM THE MATRIX OF ACCUMULATED TRANSFORMATIONS -C FROM THE INFORMATION LEFT BY CORTH .......... - IEND = IGH - LOW - 1 - IF (IEND.LT.0) GOTO 220 - IF (IEND.EQ.0) GOTO 170 -C .......... FOR I=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... - DO 160 II = 1, IEND - I = IGH - II - IF (ORTR(I) .EQ. 0.0D0 .AND. ORTI(I) .EQ. 0.0D0) GOTO 160 - IF (HR(I,I-1) .EQ. 0.0D0 .AND. HI(I,I-1) .EQ. 0.0D0) GOTO 160 -C .......... NORM BELOW IS NEGATIVE OF H FORMED IN CORTH .......... - NORM = HR(I,I-1) * ORTR(I) + HI(I,I-1) * ORTI(I) - IP1 = I + 1 -C - DO 120 K = IP1, IGH - ORTR(K) = HR(K,I-1) - ORTI(K) = HI(K,I-1) - 120 CONTINUE -C - DO 150 J = I, IGH - SR = 0.0D0 - SI = 0.0D0 -C - DO 130 K = I, IGH - SR = SR + ORTR(K) * ZR(K,J) + ORTI(K) * ZI(K,J) - SI = SI + ORTR(K) * ZI(K,J) - ORTI(K) * ZR(K,J) - 130 CONTINUE -C - SR = SR / NORM - SI = SI / NORM -C - DO 140 K = I, IGH - ZR(K,J) = ZR(K,J) + SR * ORTR(K) - SI * ORTI(K) - ZI(K,J) = ZI(K,J) + SR * ORTI(K) + SI * ORTR(K) - 140 CONTINUE -C - 150 CONTINUE -C - 160 CONTINUE -C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... - 170 L = LOW + 1 -C - DO 210 I = L, IGH - LL = MIN0(I+1,IGH) - IF (HI(I,I-1) .EQ. 0.0D0) GOTO 210 - NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) - YR = HR(I,I-1) / NORM - YI = HI(I,I-1) / NORM - HR(I,I-1) = NORM - HI(I,I-1) = 0.0D0 -C - DO 180 J = I, N - SI = YR * HI(I,J) - YI * HR(I,J) - HR(I,J) = YR * HR(I,J) + YI * HI(I,J) - HI(I,J) = SI - 180 CONTINUE -C - DO 190 J = 1, LL - SI = YR * HI(J,I) + YI * HR(J,I) - HR(J,I) = YR * HR(J,I) - YI * HI(J,I) - HI(J,I) = SI - 190 CONTINUE -C - DO 200 J = LOW, IGH - SI = YR * ZI(J,I) + YI * ZR(J,I) - ZR(J,I) = YR * ZR(J,I) - YI * ZI(J,I) - ZI(J,I) = SI - 200 CONTINUE -C - 210 CONTINUE -C .......... STORE ROOTS ISOLATED BY CBAL .......... - 220 DO 230 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 230 - WR(I) = HR(I,I) - WI(I) = HI(I,I) - 230 CONTINUE -C - EN = IGH - TR = 0.0D0 - TI = 0.0D0 - ITN = 30*N -C .......... SEARCH FOR NEXT EIGENVALUE .......... - 240 IF (EN .LT. LOW) GOTO 430 - ITS = 0 - ENM1 = EN - 1 -C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT -C FOR L=EN STEP -1 UNTIL LOW DO -- .......... - 250 DO 260 LL = LOW, EN - L = EN + LOW - LL - IF (L .EQ. LOW) GOTO 270 - TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) - X + DABS(HR(L,L)) + DABS(HI(L,L)) - TST2 = TST1 + DABS(HR(L,L-1)) - IF (TST2 .EQ. TST1) GOTO 270 - 260 CONTINUE -C .......... FORM SHIFT .......... - 270 IF (L .EQ. EN) GOTO 420 - IF (ITN .EQ. 0) GOTO 550 - IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 290 - SR = HR(EN,EN) - SI = HI(EN,EN) - XR = HR(ENM1,EN) * HR(EN,ENM1) - XI = HI(ENM1,EN) * HR(EN,ENM1) - IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 300 - YR = (HR(ENM1,ENM1) - SR) / 2.0D0 - YI = (HI(ENM1,ENM1) - SI) / 2.0D0 - CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) - IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 280 - ZZR = -ZZR - ZZI = -ZZI - 280 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) - SR = SR - XR - SI = SI - XI - GOTO 300 -C .......... FORM EXCEPTIONAL SHIFT .......... - 290 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) - SI = 0.0D0 -C - 300 DO 310 I = LOW, EN - HR(I,I) = HR(I,I) - SR - HI(I,I) = HI(I,I) - SI - 310 CONTINUE -C - TR = TR + SR - TI = TI + SI - ITS = ITS + 1 - ITN = ITN - 1 -C .......... REDUCE TO TRIANGLE (ROWS) .......... - LP1 = L + 1 -C - DO 330 I = LP1, EN - SR = HR(I,I-1) - HR(I,I-1) = 0.0D0 - NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) - XR = HR(I-1,I-1) / NORM - WR(I-1) = XR - XI = HI(I-1,I-1) / NORM - WI(I-1) = XI - HR(I-1,I-1) = NORM - HI(I-1,I-1) = 0.0D0 - HI(I,I-1) = SR / NORM -C - DO 320 J = I, N - YR = HR(I-1,J) - YI = HI(I-1,J) - ZZR = HR(I,J) - ZZI = HI(I,J) - HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR - HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI - HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR - HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI - 320 CONTINUE -C - 330 CONTINUE -C - SI = HI(EN,EN) - IF (SI .EQ. 0.0D0) GOTO 350 - NORM = PYTHAG(HR(EN,EN),SI) - SR = HR(EN,EN) / NORM - SI = SI / NORM - HR(EN,EN) = NORM - HI(EN,EN) = 0.0D0 - IF (EN .EQ. N) GOTO 350 - IP1 = EN + 1 -C - DO 340 J = IP1, N - YR = HR(EN,J) - YI = HI(EN,J) - HR(EN,J) = SR * YR + SI * YI - HI(EN,J) = SR * YI - SI * YR - 340 CONTINUE -C .......... INVERSE OPERATION (COLUMNS) .......... - 350 DO 390 J = LP1, EN - XR = WR(J-1) - XI = WI(J-1) -C - DO 370 I = 1, J - YR = HR(I,J-1) - YI = 0.0D0 - ZZR = HR(I,J) - ZZI = HI(I,J) - IF (I .EQ. J) GOTO 360 - YI = HI(I,J-1) - HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - 360 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 370 CONTINUE -C - DO 380 I = LOW, IGH - YR = ZR(I,J-1) - YI = ZI(I,J-1) - ZZR = ZR(I,J) - ZZI = ZI(I,J) - ZR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - ZI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - ZR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - ZI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 380 CONTINUE -C - 390 CONTINUE -C - IF (SI .EQ. 0.0D0) GOTO 250 -C - DO 400 I = 1, EN - YR = HR(I,EN) - YI = HI(I,EN) - HR(I,EN) = SR * YR - SI * YI - HI(I,EN) = SR * YI + SI * YR - 400 CONTINUE -C - DO 410 I = LOW, IGH - YR = ZR(I,EN) - YI = ZI(I,EN) - ZR(I,EN) = SR * YR - SI * YI - ZI(I,EN) = SR * YI + SI * YR - 410 CONTINUE -C - GOTO 250 -C .......... A ROOT FOUND .......... - 420 HR(EN,EN) = HR(EN,EN) + TR - WR(EN) = HR(EN,EN) - HI(EN,EN) = HI(EN,EN) + TI - WI(EN) = HI(EN,EN) - EN = ENM1 - GOTO 240 -C .......... ALL ROOTS FOUND. BACKSUBSTITUTE TO FIND -C VECTORS OF UPPER TRIANGULAR FORM .......... - 430 NORM = 0.0D0 -C - DO 440 I = 1, N -C - DO 440 J = I, N - TR = DABS(HR(I,J)) + DABS(HI(I,J)) - IF (TR .GT. NORM) NORM = TR - 440 CONTINUE -C - IF (N .EQ. 1 .OR. NORM .EQ. 0.0D0) GOTO 560 -C .......... FOR EN=N STEP -1 UNTIL 2 DO -- .......... - DO 500 NN = 2, N - EN = N + 2 - NN - XR = WR(EN) - XI = WI(EN) - HR(EN,EN) = 1.0D0 - HI(EN,EN) = 0.0D0 - ENM1 = EN - 1 -C .......... FOR I=EN-1 STEP -1 UNTIL 1 DO -- .......... - DO 490 II = 1, ENM1 - I = EN - II - ZZR = 0.0D0 - ZZI = 0.0D0 - IP1 = I + 1 -C - DO 450 J = IP1, EN - ZZR = ZZR + HR(I,J) * HR(J,EN) - HI(I,J) * HI(J,EN) - ZZI = ZZI + HR(I,J) * HI(J,EN) + HI(I,J) * HR(J,EN) - 450 CONTINUE -C - YR = XR - WR(I) - YI = XI - WI(I) - IF (YR .NE. 0.0D0 .OR. YI .NE. 0.0D0) GOTO 470 - TST1 = NORM - YR = TST1 - 460 YR = 0.01D0 * YR - TST2 = NORM + YR - IF (TST2 .GT. TST1) GOTO 460 - 470 CONTINUE - CALL PYCDIV(ZZR,ZZI,YR,YI,HR(I,EN),HI(I,EN)) -C .......... OVERFLOW CONTROL .......... - TR = DABS(HR(I,EN)) + DABS(HI(I,EN)) - IF (TR .EQ. 0.0D0) GOTO 490 - TST1 = TR - TST2 = TST1 + 1.0D0/TST1 - IF (TST2 .GT. TST1) GOTO 490 - DO 480 J = I, EN - HR(J,EN) = HR(J,EN)/TR - HI(J,EN) = HI(J,EN)/TR - 480 CONTINUE -C - 490 CONTINUE -C - 500 CONTINUE -C .......... END BACKSUBSTITUTION .......... -C .......... VECTORS OF ISOLATED ROOTS .......... - DO 520 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 520 -C - DO 510 J = I, N - ZR(I,J) = HR(I,J) - ZI(I,J) = HI(I,J) - 510 CONTINUE -C - 520 CONTINUE -C .......... MULTIPLY BY TRANSFORMATION MATRIX TO GIVE -C VECTORS OF ORIGINAL FULL MATRIX. -C FOR J=N STEP -1 UNTIL LOW DO -- .......... - DO 540 JJ = LOW, N - J = N + LOW - JJ - M = MIN0(J,IGH) -C - DO 540 I = LOW, IGH - ZZR = 0.0D0 - ZZI = 0.0D0 -C - DO 530 K = LOW, M - ZZR = ZZR + ZR(I,K) * HR(K,J) - ZI(I,K) * HI(K,J) - ZZI = ZZI + ZR(I,K) * HI(K,J) + ZI(I,K) * HR(K,J) - 530 CONTINUE -C - ZR(I,J) = ZZR - ZI(I,J) = ZZI - 540 CONTINUE -C - GOTO 560 -C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT -C CONVERGED AFTER 30*N ITERATIONS .......... - 550 IERR = EN - 560 RETURN - END - -C********************************************************************* - -C...PYCMQR -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE -C ALGOL PROCEDURE COMLR, NUM. MATH. 12, 369-376(1968) BY MARTIN -C AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 396-403(1971). -C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS -C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. -C -C THIS SUBROUTINE FINDS THE EIGENVALUES OF A COMPLEX -C UPPER HESSENBERG MATRIX BY THE QR METHOD. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. -C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN -C INFORMATION ABOUT THE UNITARY TRANSFORMATIONS USED IN -C THE REDUCTION BY CORTH, IF PERFORMED. -C -C ON OUTPUT -C -C THE UPPER HESSENBERG PORTIONS OF HR AND HI HAVE BEEN -C DESTROYED. THEREFORE, THEY MUST BE SAVED BEFORE -C CALLING COMQR IF SUBSEQUENT CALCULATION OF -C EIGENVECTORS IS TO BE PERFORMED. -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR -C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT -C FOR INDICES IERR+1,...,N. -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED -C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. -C -C CALLS PYCDIV FOR COMPLEX DIVISION. -C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCMQR(NM,N,LOW,IGH,HR,HI,WR,WI,IERR) - - INTEGER I,J,L,N,EN,LL,NM,IGH,ITN,ITS,LOW,LP1,ENM1,IERR - DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4) - DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, - X PYTHAG - - IERR = 0 - IF (LOW .EQ. IGH) GOTO 130 -C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... - L = LOW + 1 -C - DO 120 I = L, IGH - LL = MIN0(I+1,IGH) - IF (HI(I,I-1) .EQ. 0.0D0) GOTO 120 - NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) - YR = HR(I,I-1) / NORM - YI = HI(I,I-1) / NORM - HR(I,I-1) = NORM - HI(I,I-1) = 0.0D0 -C - DO 100 J = I, IGH - SI = YR * HI(I,J) - YI * HR(I,J) - HR(I,J) = YR * HR(I,J) + YI * HI(I,J) - HI(I,J) = SI - 100 CONTINUE -C - DO 110 J = LOW, LL - SI = YR * HI(J,I) + YI * HR(J,I) - HR(J,I) = YR * HR(J,I) - YI * HI(J,I) - HI(J,I) = SI - 110 CONTINUE -C - 120 CONTINUE -C .......... STORE ROOTS ISOLATED BY CBAL .......... - 130 DO 140 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 - WR(I) = HR(I,I) - WI(I) = HI(I,I) - 140 CONTINUE -C - EN = IGH - TR = 0.0D0 - TI = 0.0D0 - ITN = 30*N -C .......... SEARCH FOR NEXT EIGENVALUE .......... - 150 IF (EN .LT. LOW) GOTO 320 - ITS = 0 - ENM1 = EN - 1 -C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT -C FOR L=EN STEP -1 UNTIL LOW D0 -- .......... - 160 DO 170 LL = LOW, EN - L = EN + LOW - LL - IF (L .EQ. LOW) GOTO 180 - TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) - X + DABS(HR(L,L)) + DABS(HI(L,L)) - TST2 = TST1 + DABS(HR(L,L-1)) - IF (TST2 .EQ. TST1) GOTO 180 - 170 CONTINUE -C .......... FORM SHIFT .......... - 180 IF (L .EQ. EN) GOTO 300 - IF (ITN .EQ. 0) GOTO 310 - IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 200 - SR = HR(EN,EN) - SI = HI(EN,EN) - XR = HR(ENM1,EN) * HR(EN,ENM1) - XI = HI(ENM1,EN) * HR(EN,ENM1) - IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 210 - YR = (HR(ENM1,ENM1) - SR) / 2.0D0 - YI = (HI(ENM1,ENM1) - SI) / 2.0D0 - CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) - IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 190 - ZZR = -ZZR - ZZI = -ZZI - 190 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) - SR = SR - XR - SI = SI - XI - GOTO 210 -C .......... FORM EXCEPTIONAL SHIFT .......... - 200 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) - SI = 0.0D0 -C - 210 DO 220 I = LOW, EN - HR(I,I) = HR(I,I) - SR - HI(I,I) = HI(I,I) - SI - 220 CONTINUE -C - TR = TR + SR - TI = TI + SI - ITS = ITS + 1 - ITN = ITN - 1 -C .......... REDUCE TO TRIANGLE (ROWS) .......... - LP1 = L + 1 -C - DO 240 I = LP1, EN - SR = HR(I,I-1) - HR(I,I-1) = 0.0D0 - NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) - XR = HR(I-1,I-1) / NORM - WR(I-1) = XR - XI = HI(I-1,I-1) / NORM - WI(I-1) = XI - HR(I-1,I-1) = NORM - HI(I-1,I-1) = 0.0D0 - HI(I,I-1) = SR / NORM -C - DO 230 J = I, EN - YR = HR(I-1,J) - YI = HI(I-1,J) - ZZR = HR(I,J) - ZZI = HI(I,J) - HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR - HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI - HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR - HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI - 230 CONTINUE -C - 240 CONTINUE -C - SI = HI(EN,EN) - IF (SI .EQ. 0.0D0) GOTO 250 - NORM = PYTHAG(HR(EN,EN),SI) - SR = HR(EN,EN) / NORM - SI = SI / NORM - HR(EN,EN) = NORM - HI(EN,EN) = 0.0D0 -C .......... INVERSE OPERATION (COLUMNS) .......... - 250 DO 280 J = LP1, EN - XR = WR(J-1) - XI = WI(J-1) -C - DO 270 I = L, J - YR = HR(I,J-1) - YI = 0.0D0 - ZZR = HR(I,J) - ZZI = HI(I,J) - IF (I .EQ. J) GOTO 260 - YI = HI(I,J-1) - HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - 260 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 270 CONTINUE -C - 280 CONTINUE -C - IF (SI .EQ. 0.0D0) GOTO 160 -C - DO 290 I = L, EN - YR = HR(I,EN) - YI = HI(I,EN) - HR(I,EN) = SR * YR - SI * YI - HI(I,EN) = SR * YI + SI * YR - 290 CONTINUE -C - GOTO 160 -C .......... A ROOT FOUND .......... - 300 WR(EN) = HR(EN,EN) + TR - WI(EN) = HI(EN,EN) + TI - EN = ENM1 - GOTO 150 -C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT -C CONVERGED AFTER 30*N ITERATIONS .......... - 310 IERR = EN - 320 RETURN - END - -C********************************************************************* - -C...PYCOMP -C...Compress the standard KF codes for use in mass and decay arrays; -C...also checks whether a given code actually is defined. - - FUNCTION PYCOMP(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ -C...Local arrays and saved data. - DIMENSION KFORD(100:500),KCORD(101:500) - SAVE KFORD,KCORD,NFORD,KFLAST,KCLAST - -C...Whenever necessary reorder codes for faster search. - IF(MSTU(20).EQ.0) THEN - NFORD=100 - KFORD(100)=0 - DO 120 I=101,500 - KFA=KCHG(I,4) - IF(KFA.LE.100) GOTO 120 - NFORD=NFORD+1 - DO 100 I1=NFORD-1,0,-1 - IF(KFA.GE.KFORD(I1)) GOTO 110 - KFORD(I1+1)=KFORD(I1) - KCORD(I1+1)=KCORD(I1) - 100 CONTINUE - 110 KFORD(I1+1)=KFA - KCORD(I1+1)=I - 120 CONTINUE - MSTU(20)=1 - KFLAST=0 - KCLAST=0 - ENDIF - -C...Fast action if same code as in latest call. - IF(KF.EQ.KFLAST) THEN - PYCOMP=KCLAST - RETURN - ENDIF - -C...Starting values. Remove internal diquark flags. - PYCOMP=0 - KFA=IABS(KF) - IF(MOD(KFA/10,10).EQ.0.AND.KFA.LT.100000 - & .AND.MOD(KFA/1000,10).GT.0) KFA=MOD(KFA,10000) - -C...Simple cases: direct translation. - IF(KFA.GT.KFORD(NFORD)) THEN - ELSEIF(KFA.LE.100) THEN - PYCOMP=KFA - -C...Else binary search. - ELSE - IMIN=100 - IMAX=NFORD+1 - 130 IAVG=(IMIN+IMAX)/2 - IF(KFORD(IAVG).GT.KFA) THEN - IMAX=IAVG - IF(IMAX.GT.IMIN+1) GOTO 130 - ELSEIF(KFORD(IAVG).LT.KFA) THEN - IMIN=IAVG - IF(IMAX.GT.IMIN+1) GOTO 130 - ELSE - PYCOMP=KCORD(IAVG) - ENDIF - ENDIF - -C...Check if antiparticle allowed. - IF(PYCOMP.NE.0.AND.KF.LT.0) THEN - IF(KCHG(PYCOMP,3).EQ.0) PYCOMP=0 - ENDIF - -C...Save codes for possible future fast action. - KFLAST=KF - KCLAST=PYCOMP - - RETURN - END - -C********************************************************************* - -C...PYCRTH -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A COMPLEX ANALOGUE OF -C THE ALGOL PROCEDURE ORTHES, NUM. MATH. 12, 349-368(1968) -C BY MARTIN AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). -C -C GIVEN A COMPLEX GENERAL MATRIX, THIS SUBROUTINE -C REDUCES A SUBMATRIX SITUATED IN ROWS AND COLUMNS -C LOW THROUGH IGH TO UPPER HESSENBERG FORM BY -C UNITARY SIMILARITY TRANSFORMATIONS. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX INPUT MATRIX. -C -C ON OUTPUT -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE HESSENBERG MATRIX. INFORMATION -C ABOUT THE UNITARY TRANSFORMATIONS USED IN THE REDUCTION -C IS STORED IN THE REMAINING TRIANGLES UNDER THE -C HESSENBERG MATRIX. -C -C ORTR AND ORTI CONTAIN FURTHER INFORMATION ABOUT THE -C TRANSFORMATIONS. ONLY ELEMENTS LOW THROUGH IGH ARE USED. -C -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCRTH(NM,N,LOW,IGH,AR,AI,ORTR,ORTI) - - INTEGER I,J,M,N,II,JJ,LA,MP,NM,IGH,KP1,LOW - DOUBLE PRECISION AR(4,4),AI(4,4),ORTR(4),ORTI(4) - DOUBLE PRECISION F,G,H,FI,FR,SCALE,PYTHAG - - LA = IGH - 1 - KP1 = LOW + 1 - IF (LA .LT. KP1) GOTO 210 -C - DO 200 M = KP1, LA - H = 0.0D0 - ORTR(M) = 0.0D0 - ORTI(M) = 0.0D0 - SCALE = 0.0D0 -C .......... SCALE COLUMN (ALGOL TOL THEN NOT NEEDED) .......... - DO 100 I = M, IGH - 100 SCALE = SCALE + DABS(AR(I,M-1)) + DABS(AI(I,M-1)) -C - IF (SCALE .EQ. 0.0D0) GOTO 200 - MP = M + IGH -C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... - DO 110 II = M, IGH - I = MP - II - ORTR(I) = AR(I,M-1) / SCALE - ORTI(I) = AI(I,M-1) / SCALE - H = H + ORTR(I) * ORTR(I) + ORTI(I) * ORTI(I) - 110 CONTINUE -C - G = DSQRT(H) - F = PYTHAG(ORTR(M),ORTI(M)) - IF (F .EQ. 0.0D0) GOTO 120 - H = H + F * G - G = G / F - ORTR(M) = (1.0D0 + G) * ORTR(M) - ORTI(M) = (1.0D0 + G) * ORTI(M) - GOTO 130 -C - 120 ORTR(M) = G - AR(M,M-1) = SCALE -C .......... FORM (I-(U*UT)/H) * A .......... - 130 DO 160 J = M, N - FR = 0.0D0 - FI = 0.0D0 -C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... - DO 140 II = M, IGH - I = MP - II - FR = FR + ORTR(I) * AR(I,J) + ORTI(I) * AI(I,J) - FI = FI + ORTR(I) * AI(I,J) - ORTI(I) * AR(I,J) - 140 CONTINUE -C - FR = FR / H - FI = FI / H -C - DO 150 I = M, IGH - AR(I,J) = AR(I,J) - FR * ORTR(I) + FI * ORTI(I) - AI(I,J) = AI(I,J) - FR * ORTI(I) - FI * ORTR(I) - 150 CONTINUE -C - 160 CONTINUE -C .......... FORM (I-(U*UT)/H)*A*(I-(U*UT)/H) .......... - DO 190 I = 1, IGH - FR = 0.0D0 - FI = 0.0D0 -C .......... FOR J=IGH STEP -1 UNTIL M DO -- .......... - DO 170 JJ = M, IGH - J = MP - JJ - FR = FR + ORTR(J) * AR(I,J) - ORTI(J) * AI(I,J) - FI = FI + ORTR(J) * AI(I,J) + ORTI(J) * AR(I,J) - 170 CONTINUE -C - FR = FR / H - FI = FI / H -C - DO 180 J = M, IGH - AR(I,J) = AR(I,J) - FR * ORTR(J) - FI * ORTI(J) - AI(I,J) = AI(I,J) + FR * ORTI(J) - FI * ORTR(J) - 180 CONTINUE -C - 190 CONTINUE -C - ORTR(M) = SCALE * ORTR(M) - ORTI(M) = SCALE * ORTI(M) - AR(M,M-1) = -G * AR(M,M-1) - AI(M,M-1) = -G * AI(M,M-1) - 200 CONTINUE -C - 210 RETURN - END - -C********************************************************************* - -C...PYCSRT -C...Auxiliary to PYCMQR -C -C (YR,YI) = COMPLEX DSQRT(XR,XI) -C BRANCH CHOSEN SO THAT YR .GE. 0.0 AND SIGN(YI) .EQ. SIGN(XI) -C - - SUBROUTINE PYCSRT(XR,XI,YR,YI) - - DOUBLE PRECISION XR,XI,YR,YI - DOUBLE PRECISION S,TR,TI,PYTHAG - - TR = XR - TI = XI - S = DSQRT(0.5D0*(PYTHAG(TR,TI) + DABS(TR))) - IF (TR .GE. 0.0D0) YR = S - IF (TI .LT. 0.0D0) S = -S - IF (TR .LE. 0.0D0) YI = S - IF (TR .LT. 0.0D0) YR = 0.5D0*(TI/YI) - IF (TR .GT. 0.0D0) YI = 0.5D0*(TI/YR) - RETURN - END - -C********************************************************************* - -C...PYCT5L -C...Auxiliary function for parametrization of CTEQ5L. -C...Author: J. Pumplin 9/99. - -C...CTEQ5M1 and CTEQ5L Parton Distribution Functions -C...in Parametrized Form -C... September 15, 1999 -C -C...Ref: "GLOBAL QCD ANALYSIS OF PARTON STRUCTURE OF THE NUCLEON: -C... CTEQ5 PPARTON DISTRIBUTIONS" -C...hep-ph/9903282 - -C...The CTEQ5M1 set given here is an updated version of the original -C...CTEQ5M set posted, in the table version, on the Web page of CTEQ. -C...The differences between CTEQ5M and CTEQ5M1 are insignificant for -C...almost all applications. -C...The improvement is in the QCD evolution which is now more -C...accurate, and which agrees completely with the benchmark work -C...of the HERA 96/97 Workshop. -C...The differences between the parametrized and the corresponding -C...table versions (on which it is based) are of similar order as -C...between the two version. - -C...!! Because accurate parametrizations over a wide range of (x,Q) -C...is hard to obtain, only the most widely used sets CTEQ5M and -C...CTEQ5L are available in parametrized form for now. - -C...These parametrizations were obtained by Jon Pumplin. - -C Iset PDF Description Alpha_s(Mz) Lam4 Lam5 -C ------------------------------------------------------------------- -C 1 CTEQ5M1 Standard NLO MSbar scheme 0.118 326 226 -C 3 CTEQ5L Leading Order 0.127 192 146 -C ------------------------------------------------------------------- -C...Note the Qcd-lambda values given for CTEQ5L is for the leading -C...order form of Alpha_s!! Alpha_s(Mz) gives the absolute -C...calibration. - -C...The two Iset value are adopted to agree with the standard table -C...versions. - -C...Range of validity: -C...The range of (x, Q) covered by this parametrization of the QCD -C...evolved parton distributions is 1E-6 < x < 1 ; -C...1.1 GeV < Q < 10 TeV. Of course, the PDF's are constrained by -C...data only in a subset of that region; and the assumed DGLAP -C...evolution is unlikely to be valid for all of it either. - -C...The range of (x, Q) used in the CTEQ5 round of global analysis is -C...approximately 0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2 for -C...fixed target experiments; 0.0001 < x < 0.3 from HERA data; and -C...Q^2 up to 40,000 GeV^2 from Tevatron inclusive Jet data. - - FUNCTION PYCT5L(IFL,X,Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - - PARAMETER (NEX=8, NLF=2) - DIMENSION AM(0:NEX,0:NLF,-5:2) - DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) - DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) - DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) - DIMENSION AF(0:NEX) - - DATA MEXVEC( 2) / 8 / - DATA MLFVEC( 2) / 2 / - DATA UT1VEC( 2) / 0.4971265E+01 / - DATA UT2VEC( 2) / -0.1105128E+01 / - DATA ALFVEC( 2) / 0.2987216E+00 / - DATA QMAVEC( 2) / 0.0000000E+00 / - DATA (AM( 0,K, 2),K=0, 2) - & / 0.5292616E+01, -0.2751910E+01, -0.2488990E+01 / - DATA (AM( 1,K, 2),K=0, 2) - & / 0.9714424E+00, 0.1011827E-01, -0.1023660E-01 / - DATA (AM( 2,K, 2),K=0, 2) - & / -0.1651006E+02, 0.7959721E+01, 0.8810563E+01 / - DATA (AM( 3,K, 2),K=0, 2) - & / -0.1643394E+02, 0.5892854E+01, 0.9348874E+01 / - DATA (AM( 4,K, 2),K=0, 2) - & / 0.3067422E+02, 0.4235796E+01, -0.5112136E+00 / - DATA (AM( 5,K, 2),K=0, 2) - & / 0.2352526E+02, -0.5305168E+01, -0.1169174E+02 / - DATA (AM( 6,K, 2),K=0, 2) - & / -0.1095451E+02, 0.3006577E+01, 0.5638136E+01 / - DATA (AM( 7,K, 2),K=0, 2) - & / -0.1172251E+02, -0.2183624E+01, 0.4955794E+01 / - DATA (AM( 8,K, 2),K=0, 2) - & / 0.1662533E-01, 0.7622870E-02, -0.4895887E-03 / - - DATA MEXVEC( 1) / 8 / - DATA MLFVEC( 1) / 2 / - DATA UT1VEC( 1) / 0.2612618E+01 / - DATA UT2VEC( 1) / -0.1258304E+06 / - DATA ALFVEC( 1) / 0.3407552E+00 / - DATA QMAVEC( 1) / 0.0000000E+00 / - DATA (AM( 0,K, 1),K=0, 2) - & / 0.9905300E+00, -0.4502235E+00, 0.1624441E+00 / - DATA (AM( 1,K, 1),K=0, 2) - & / 0.8867534E+00, 0.1630829E-01, -0.4049085E-01 / - DATA (AM( 2,K, 1),K=0, 2) - & / 0.8547974E+00, 0.3336301E+00, 0.1371388E+00 / - DATA (AM( 3,K, 1),K=0, 2) - & / 0.2941113E+00, -0.1527905E+01, 0.2331879E+00 / - DATA (AM( 4,K, 1),K=0, 2) - & / 0.3384235E+02, 0.3715315E+01, 0.8276930E+00 / - DATA (AM( 5,K, 1),K=0, 2) - & / 0.6230115E+01, 0.3134639E+01, -0.1729099E+01 / - DATA (AM( 6,K, 1),K=0, 2) - & / -0.1186928E+01, -0.3282460E+00, 0.1052020E+00 / - DATA (AM( 7,K, 1),K=0, 2) - & / -0.8545702E+01, -0.6247947E+01, 0.3692561E+01 / - DATA (AM( 8,K, 1),K=0, 2) - & / 0.1724598E-01, 0.7120465E-02, 0.4003646E-04 / - - DATA MEXVEC( 0) / 8 / - DATA MLFVEC( 0) / 2 / - DATA UT1VEC( 0) / -0.4656819E+00 / - DATA UT2VEC( 0) / -0.2742390E+03 / - DATA ALFVEC( 0) / 0.4491863E+00 / - DATA QMAVEC( 0) / 0.0000000E+00 / - DATA (AM( 0,K, 0),K=0, 2) - & / 0.1193572E+03, -0.3886845E+01, -0.1133965E+01 / - DATA (AM( 1,K, 0),K=0, 2) - & / -0.9421449E+02, 0.3995885E+01, 0.1607363E+01 / - DATA (AM( 2,K, 0),K=0, 2) - & / 0.4206383E+01, 0.2485954E+00, 0.2497468E+00 / - DATA (AM( 3,K, 0),K=0, 2) - & / 0.1210557E+03, -0.3015765E+01, -0.1423651E+01 / - DATA (AM( 4,K, 0),K=0, 2) - & / -0.1013897E+03, -0.7113478E+00, 0.2621865E+00 / - DATA (AM( 5,K, 0),K=0, 2) - & / -0.1312404E+01, -0.9297691E+00, -0.1562531E+00 / - DATA (AM( 6,K, 0),K=0, 2) - & / 0.1627137E+01, 0.4954111E+00, -0.6387009E+00 / - DATA (AM( 7,K, 0),K=0, 2) - & / 0.1537698E+00, -0.2487878E+00, 0.8305947E+00 / - DATA (AM( 8,K, 0),K=0, 2) - & / 0.2496448E-01, 0.2457823E-02, 0.8234276E-03 / - - DATA MEXVEC(-1) / 8 / - DATA MLFVEC(-1) / 2 / - DATA UT1VEC(-1) / 0.3862583E+01 / - DATA UT2VEC(-1) / -0.1265969E+01 / - DATA ALFVEC(-1) / 0.2457668E+00 / - DATA QMAVEC(-1) / 0.0000000E+00 / - DATA (AM( 0,K,-1),K=0, 2) - & / 0.2647441E+02, 0.1059277E+02, -0.9176654E+00 / - DATA (AM( 1,K,-1),K=0, 2) - & / 0.1990636E+01, 0.8558918E-01, 0.4248667E-01 / - DATA (AM( 2,K,-1),K=0, 2) - & / -0.1476095E+02, -0.3276255E+02, 0.1558110E+01 / - DATA (AM( 3,K,-1),K=0, 2) - & / -0.2966889E+01, -0.3649037E+02, 0.1195914E+01 / - DATA (AM( 4,K,-1),K=0, 2) - & / -0.1000519E+03, -0.2464635E+01, 0.1964849E+00 / - DATA (AM( 5,K,-1),K=0, 2) - & / 0.3718331E+02, 0.4700389E+02, -0.2772142E+01 / - DATA (AM( 6,K,-1),K=0, 2) - & / -0.1872722E+02, -0.2291189E+02, 0.1089052E+01 / - DATA (AM( 7,K,-1),K=0, 2) - & / -0.1628146E+02, -0.1823993E+02, 0.2537369E+01 / - DATA (AM( 8,K,-1),K=0, 2) - & / -0.1156300E+01, -0.1280495E+00, 0.5153245E-01 / - - DATA MEXVEC(-2) / 7 / - DATA MLFVEC(-2) / 2 / - DATA UT1VEC(-2) / 0.1895615E+00 / - DATA UT2VEC(-2) / -0.3069097E+01 / - DATA ALFVEC(-2) / 0.5293999E+00 / - DATA QMAVEC(-2) / 0.0000000E+00 / - DATA (AM( 0,K,-2),K=0, 2) - & / -0.6556775E+00, 0.2490190E+00, 0.3966485E-01 / - DATA (AM( 1,K,-2),K=0, 2) - & / 0.1305102E+01, -0.1188925E+00, -0.4600870E-02 / - DATA (AM( 2,K,-2),K=0, 2) - & / -0.2371436E+01, 0.3566814E+00, -0.2834683E+00 / - DATA (AM( 3,K,-2),K=0, 2) - & / -0.6152826E+01, 0.8339877E+00, -0.7233230E+00 / - DATA (AM( 4,K,-2),K=0, 2) - & / -0.8346558E+01, 0.2892168E+01, 0.2137099E+00 / - DATA (AM( 5,K,-2),K=0, 2) - & / 0.1279530E+02, 0.1021114E+00, 0.5787439E+00 / - DATA (AM( 6,K,-2),K=0, 2) - & / 0.5858816E+00, -0.1940375E+01, -0.4029269E+00 / - DATA (AM( 7,K,-2),K=0, 2) - & / -0.2795725E+02, -0.5263392E+00, 0.1290229E+01 / - - DATA MEXVEC(-3) / 7 / - DATA MLFVEC(-3) / 2 / - DATA UT1VEC(-3) / 0.3753257E+01 / - DATA UT2VEC(-3) / -0.1113085E+01 / - DATA ALFVEC(-3) / 0.3713141E+00 / - DATA QMAVEC(-3) / 0.0000000E+00 / - DATA (AM( 0,K,-3),K=0, 2) - & / 0.1580931E+01, -0.2273826E+01, -0.1822245E+01 / - DATA (AM( 1,K,-3),K=0, 2) - & / 0.2702644E+01, 0.6763243E+00, 0.7231586E-02 / - DATA (AM( 2,K,-3),K=0, 2) - & / -0.1857924E+02, 0.3907500E+01, 0.5850109E+01 / - DATA (AM( 3,K,-3),K=0, 2) - & / -0.3044793E+02, 0.2639332E+01, 0.5566644E+01 / - DATA (AM( 4,K,-3),K=0, 2) - & / -0.4258011E+01, -0.5429244E+01, 0.4418946E+00 / - DATA (AM( 5,K,-3),K=0, 2) - & / 0.3465259E+02, -0.5532604E+01, -0.4904153E+01 / - DATA (AM( 6,K,-3),K=0, 2) - & / -0.1658858E+02, 0.2923275E+01, 0.2266286E+01 / - DATA (AM( 7,K,-3),K=0, 2) - & / -0.1149263E+02, 0.2877475E+01, -0.7999105E+00 / - - DATA MEXVEC(-4) / 7 / - DATA MLFVEC(-4) / 2 / - DATA UT1VEC(-4) / 0.4400772E+01 / - DATA UT2VEC(-4) / -0.1356116E+01 / - DATA ALFVEC(-4) / 0.3712017E-01 / - DATA QMAVEC(-4) / 0.1300000E+01 / - DATA (AM( 0,K,-4),K=0, 2) - & / -0.8293661E+00, -0.3982375E+01, -0.6494283E-01 / - DATA (AM( 1,K,-4),K=0, 2) - & / 0.2754618E+01, 0.8338636E+00, -0.6885160E-01 / - DATA (AM( 2,K,-4),K=0, 2) - & / -0.1657987E+02, 0.1439143E+02, -0.6887240E+00 / - DATA (AM( 3,K,-4),K=0, 2) - & / -0.2800703E+02, 0.1535966E+02, -0.7377693E+00 / - DATA (AM( 4,K,-4),K=0, 2) - & / -0.6460216E+01, -0.4783019E+01, 0.4913297E+00 / - DATA (AM( 5,K,-4),K=0, 2) - & / 0.3141830E+02, -0.3178031E+02, 0.7136013E+01 / - DATA (AM( 6,K,-4),K=0, 2) - & / -0.1802509E+02, 0.1862163E+02, -0.4632843E+01 / - DATA (AM( 7,K,-4),K=0, 2) - & / -0.1240412E+02, 0.2565386E+02, -0.1066570E+02 / - - DATA MEXVEC(-5) / 6 / - DATA MLFVEC(-5) / 2 / - DATA UT1VEC(-5) / 0.5562568E+01 / - DATA UT2VEC(-5) / -0.1801317E+01 / - DATA ALFVEC(-5) / 0.4952010E-02 / - DATA QMAVEC(-5) / 0.4500000E+01 / - DATA (AM( 0,K,-5),K=0, 2) - & / -0.6031237E+01, 0.1992727E+01, -0.1076331E+01 / - DATA (AM( 1,K,-5),K=0, 2) - & / 0.2933912E+01, 0.5839674E+00, 0.7509435E-01 / - DATA (AM( 2,K,-5),K=0, 2) - & / -0.8284919E+01, 0.1488593E+01, -0.8251678E+00 / - DATA (AM( 3,K,-5),K=0, 2) - & / -0.1925986E+02, 0.2805753E+01, -0.3015446E+01 / - DATA (AM( 4,K,-5),K=0, 2) - & / -0.9480483E+01, -0.9767837E+00, -0.1165544E+01 / - DATA (AM( 5,K,-5),K=0, 2) - & / 0.2193195E+02, -0.1788518E+02, 0.9460908E+01 / - DATA (AM( 6,K,-5),K=0, 2) - & / -0.1327377E+02, 0.1201754E+02, -0.6277844E+01 / - - IF(Q .LE. QMAVEC(IFL)) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - IF(X .GE. 1.D0) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - TMP = LOG(Q/ALFVEC(IFL)) - IF(TMP .LE. 0.D0) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - SB = LOG(TMP) - SB1 = SB - 1.2D0 - SB2 = SB1*SB1 - - DO 110 I = 0, NEX - AF(I) = 0.D0 - SBX = 1.D0 - DO 100 K = 0, MLFVEC(IFL) - AF(I) = AF(I) + SBX*AM(I,K,IFL) - SBX = SB1*SBX - 100 CONTINUE - 110 CONTINUE - - Y = -LOG(X) - U = LOG(X/0.00001D0) - - PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) - PART2 = AF(0)*(1.D0 - X) + AF(3)*X - PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) - PART4 = UT1VEC(IFL)*LOG(1.D0-X) + - & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) - - PYCT5L = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) - -C...Include threshold factor. - PYCT5L = PYCT5L * (1.D0 - QMAVEC(IFL)/Q) - - RETURN - END - -C********************************************************************* - -C...PYCT5M -C...Auxiliary function for parametrization of CTEQ5M1. -C...Author: J. Pumplin 9/99. - - FUNCTION PYCT5M(IFL,X,Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - - PARAMETER (NEX=8, NLF=2) - DIMENSION AM(0:NEX,0:NLF,-5:2) - DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) - DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) - DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) - DIMENSION AF(0:NEX) - - DATA MEXVEC( 2) / 8 / - DATA MLFVEC( 2) / 2 / - DATA UT1VEC( 2) / 0.5141718E+01 / - DATA UT2VEC( 2) / -0.1346944E+01 / - DATA ALFVEC( 2) / 0.5260555E+00 / - DATA QMAVEC( 2) / 0.0000000E+00 / - DATA (AM( 0,K, 2),K=0, 2) - & / 0.4289071E+01, -0.2536870E+01, -0.1259948E+01 / - DATA (AM( 1,K, 2),K=0, 2) - & / 0.9839410E+00, 0.4168426E-01, -0.5018952E-01 / - DATA (AM( 2,K, 2),K=0, 2) - & / -0.1651961E+02, 0.9246261E+01, 0.5996400E+01 / - DATA (AM( 3,K, 2),K=0, 2) - & / -0.2077936E+02, 0.9786469E+01, 0.7656465E+01 / - DATA (AM( 4,K, 2),K=0, 2) - & / 0.3054926E+02, 0.1889536E+01, 0.1380541E+01 / - DATA (AM( 5,K, 2),K=0, 2) - & / 0.3084695E+02, -0.1212303E+02, -0.1053551E+02 / - DATA (AM( 6,K, 2),K=0, 2) - & / -0.1426778E+02, 0.6239537E+01, 0.5254819E+01 / - DATA (AM( 7,K, 2),K=0, 2) - & / -0.1909811E+02, 0.3695678E+01, 0.5495729E+01 / - DATA (AM( 8,K, 2),K=0, 2) - & / 0.1889751E-01, 0.5027193E-02, 0.6624896E-03 / - - DATA MEXVEC( 1) / 8 / - DATA MLFVEC( 1) / 2 / - DATA UT1VEC( 1) / 0.4138426E+01 / - DATA UT2VEC( 1) / -0.3221374E+01 / - DATA ALFVEC( 1) / 0.4960962E+00 / - DATA QMAVEC( 1) / 0.0000000E+00 / - DATA (AM( 0,K, 1),K=0, 2) - & / 0.1332497E+01, -0.3703718E+00, 0.1288638E+00 / - DATA (AM( 1,K, 1),K=0, 2) - & / 0.7544687E+00, 0.3255075E-01, -0.4706680E-01 / - DATA (AM( 2,K, 1),K=0, 2) - & / -0.7638814E+00, 0.5008313E+00, -0.9237374E-01 / - DATA (AM( 3,K, 1),K=0, 2) - & / -0.3689889E+00, -0.1055098E+01, -0.4645065E+00 / - DATA (AM( 4,K, 1),K=0, 2) - & / 0.3991610E+02, 0.1979881E+01, 0.1775814E+01 / - DATA (AM( 5,K, 1),K=0, 2) - & / 0.6201080E+01, 0.2046288E+01, 0.3804571E+00 / - DATA (AM( 6,K, 1),K=0, 2) - & / -0.8027900E+00, -0.7011688E+00, -0.8049612E+00 / - DATA (AM( 7,K, 1),K=0, 2) - & / -0.8631305E+01, -0.3981200E+01, 0.6970153E+00 / - DATA (AM( 8,K, 1),K=0, 2) - & / 0.2371230E-01, 0.5372683E-02, 0.1118701E-02 / - - DATA MEXVEC( 0) / 8 / - DATA MLFVEC( 0) / 2 / - DATA UT1VEC( 0) / -0.1026789E+01 / - DATA UT2VEC( 0) / -0.9051707E+01 / - DATA ALFVEC( 0) / 0.9462977E+00 / - DATA QMAVEC( 0) / 0.0000000E+00 / - DATA (AM( 0,K, 0),K=0, 2) - & / 0.1191990E+03, -0.8548739E+00, -0.1963040E+01 / - DATA (AM( 1,K, 0),K=0, 2) - & / -0.9449972E+02, 0.1074771E+01, 0.2056055E+01 / - DATA (AM( 2,K, 0),K=0, 2) - & / 0.3701064E+01, -0.1167947E-02, 0.1933573E+00 / - DATA (AM( 3,K, 0),K=0, 2) - & / 0.1171345E+03, -0.1064540E+01, -0.1875312E+01 / - DATA (AM( 4,K, 0),K=0, 2) - & / -0.1014453E+03, -0.5707427E+00, 0.4511242E-01 / - DATA (AM( 5,K, 0),K=0, 2) - & / 0.6365168E+01, 0.1275354E+01, -0.4964081E+00 / - DATA (AM( 6,K, 0),K=0, 2) - & / -0.3370693E+01, -0.1122020E+01, 0.5947751E-01 / - DATA (AM( 7,K, 0),K=0, 2) - & / -0.5327270E+01, -0.9293556E+00, 0.6629940E+00 / - DATA (AM( 8,K, 0),K=0, 2) - & / 0.2437513E-01, 0.1600939E-02, 0.6855336E-03 / - - DATA MEXVEC(-1) / 8 / - DATA MLFVEC(-1) / 2 / - DATA UT1VEC(-1) / 0.5243571E+01 / - DATA UT2VEC(-1) / -0.2870513E+01 / - DATA ALFVEC(-1) / 0.6701448E+00 / - DATA QMAVEC(-1) / 0.0000000E+00 / - DATA (AM( 0,K,-1),K=0, 2) - & / 0.2428863E+02, 0.1907035E+01, -0.4606457E+00 / - DATA (AM( 1,K,-1),K=0, 2) - & / 0.2006810E+01, -0.1265915E+00, 0.7153556E-02 / - DATA (AM( 2,K,-1),K=0, 2) - & / -0.1884546E+02, -0.2339471E+01, 0.5740679E+01 / - DATA (AM( 3,K,-1),K=0, 2) - & / -0.2527892E+02, -0.2044124E+01, 0.1280470E+02 / - DATA (AM( 4,K,-1),K=0, 2) - & / -0.1013824E+03, -0.1594199E+01, 0.2216401E+00 / - DATA (AM( 5,K,-1),K=0, 2) - & / 0.8070930E+02, 0.1792072E+01, -0.2164364E+02 / - DATA (AM( 6,K,-1),K=0, 2) - & / -0.4641050E+02, 0.1977338E+00, 0.1273014E+02 / - DATA (AM( 7,K,-1),K=0, 2) - & / -0.3910568E+02, 0.1719632E+01, 0.1086525E+02 / - DATA (AM( 8,K,-1),K=0, 2) - & / -0.1185496E+01, -0.1905847E+00, -0.8744118E-03 / - - DATA MEXVEC(-2) / 7 / - DATA MLFVEC(-2) / 2 / - DATA UT1VEC(-2) / 0.4782210E+01 / - DATA UT2VEC(-2) / -0.1976856E+02 / - DATA ALFVEC(-2) / 0.7558374E+00 / - DATA QMAVEC(-2) / 0.0000000E+00 / - DATA (AM( 0,K,-2),K=0, 2) - & / -0.6216935E+00, 0.2369963E+00, -0.7909949E-02 / - DATA (AM( 1,K,-2),K=0, 2) - & / 0.1245440E+01, -0.1031510E+00, 0.4916523E-02 / - DATA (AM( 2,K,-2),K=0, 2) - & / -0.7060824E+01, -0.3875283E-01, 0.1784981E+00 / - DATA (AM( 3,K,-2),K=0, 2) - & / -0.7430595E+01, 0.1964572E+00, -0.1284999E+00 / - DATA (AM( 4,K,-2),K=0, 2) - & / -0.6897810E+01, 0.2620543E+01, 0.8012553E-02 / - DATA (AM( 5,K,-2),K=0, 2) - & / 0.1507713E+02, 0.2340307E-01, 0.2482535E+01 / - DATA (AM( 6,K,-2),K=0, 2) - & / -0.1815341E+01, -0.1538698E+01, -0.2014208E+01 / - DATA (AM( 7,K,-2),K=0, 2) - & / -0.2571932E+02, 0.2903941E+00, -0.2848206E+01 / - - DATA MEXVEC(-3) / 7 / - DATA MLFVEC(-3) / 2 / - DATA UT1VEC(-3) / 0.4518239E+01 / - DATA UT2VEC(-3) / -0.2690590E+01 / - DATA ALFVEC(-3) / 0.6124079E+00 / - DATA QMAVEC(-3) / 0.0000000E+00 / - DATA (AM( 0,K,-3),K=0, 2) - & / -0.2734458E+01, -0.7245673E+00, -0.6351374E+00 / - DATA (AM( 1,K,-3),K=0, 2) - & / 0.2927174E+01, 0.4822709E+00, -0.1088787E-01 / - DATA (AM( 2,K,-3),K=0, 2) - & / -0.1771017E+02, -0.1416635E+01, 0.8467622E+01 / - DATA (AM( 3,K,-3),K=0, 2) - & / -0.4972782E+02, -0.3348547E+01, 0.1767061E+02 / - DATA (AM( 4,K,-3),K=0, 2) - & / -0.7102770E+01, -0.3205337E+01, 0.4101704E+00 / - DATA (AM( 5,K,-3),K=0, 2) - & / 0.7169698E+02, -0.2205985E+01, -0.2463931E+02 / - DATA (AM( 6,K,-3),K=0, 2) - & / -0.4090347E+02, 0.2103486E+01, 0.1416507E+02 / - DATA (AM( 7,K,-3),K=0, 2) - & / -0.2952639E+02, 0.5376136E+01, 0.7825585E+01 / - - DATA MEXVEC(-4) / 7 / - DATA MLFVEC(-4) / 2 / - DATA UT1VEC(-4) / 0.2783230E+01 / - DATA UT2VEC(-4) / -0.1746328E+01 / - DATA ALFVEC(-4) / 0.1115653E+01 / - DATA QMAVEC(-4) / 0.1300000E+01 / - DATA (AM( 0,K,-4),K=0, 2) - & / -0.1743872E+01, -0.1128921E+01, -0.2841969E+00 / - DATA (AM( 1,K,-4),K=0, 2) - & / 0.3345755E+01, 0.3187765E+00, 0.1378124E+00 / - DATA (AM( 2,K,-4),K=0, 2) - & / -0.2037615E+02, 0.4121687E+01, 0.2236520E+00 / - DATA (AM( 3,K,-4),K=0, 2) - & / -0.4703104E+02, 0.5353087E+01, -0.1455347E+01 / - DATA (AM( 4,K,-4),K=0, 2) - & / -0.1060230E+02, -0.1551122E+01, -0.1078863E+01 / - DATA (AM( 5,K,-4),K=0, 2) - & / 0.5088892E+02, -0.8197304E+01, 0.8083451E+01 / - DATA (AM( 6,K,-4),K=0, 2) - & / -0.2819070E+02, 0.4554086E+01, -0.5890995E+01 / - DATA (AM( 7,K,-4),K=0, 2) - & / -0.1098238E+02, 0.2590096E+01, -0.8062879E+01 / - - DATA MEXVEC(-5) / 6 / - DATA MLFVEC(-5) / 2 / - DATA UT1VEC(-5) / 0.1619654E+02 / - DATA UT2VEC(-5) / -0.3367346E+01 / - DATA ALFVEC(-5) / 0.5109891E-02 / - DATA QMAVEC(-5) / 0.4500000E+01 / - DATA (AM( 0,K,-5),K=0, 2) - & / -0.6800138E+01, 0.2493627E+01, -0.1075724E+01 / - DATA (AM( 1,K,-5),K=0, 2) - & / 0.3036555E+01, 0.3324733E+00, 0.2008298E+00 / - DATA (AM( 2,K,-5),K=0, 2) - & / -0.5203879E+01, -0.8493476E+01, -0.4523208E+01 / - DATA (AM( 3,K,-5),K=0, 2) - & / -0.1524239E+01, -0.3411912E+01, -0.1771867E+02 / - DATA (AM( 4,K,-5),K=0, 2) - & / -0.1099444E+02, 0.1320930E+01, -0.2353831E+01 / - DATA (AM( 5,K,-5),K=0, 2) - & / 0.1699299E+02, -0.3565802E+02, 0.3566872E+02 / - DATA (AM( 6,K,-5),K=0, 2) - & / -0.1465793E+02, 0.2703365E+02, -0.2176372E+02 / - - IF(Q .LE. QMAVEC(IFL)) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - IF(X .GE. 1.D0) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - TMP = LOG(Q/ALFVEC(IFL)) - IF(TMP .LE. 0.D0) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - SB = LOG(TMP) - SB1 = SB - 1.2D0 - SB2 = SB1*SB1 - - DO 110 I = 0, NEX - AF(I) = 0.D0 - SBX = 1.D0 - DO 100 K = 0, MLFVEC(IFL) - AF(I) = AF(I) + SBX*AM(I,K,IFL) - SBX = SB1*SBX - 100 CONTINUE - 110 CONTINUE - - Y = -LOG(X) - U = LOG(X/0.00001D0) - - PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) - PART2 = AF(0)*(1.D0 - X) + AF(3)*X - PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) - PART4 = UT1VEC(IFL)*LOG(1.D0-X) + - & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) - - PYCT5M = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) - -C...Include threshold factor. - PYCT5M = PYCT5M * (1.D0 - QMAVEC(IFL)/Q) - - RETURN - END - -C********************************************************************* - -C...PYCTEQ -C...Gives the CTEQ 3 parton distribution function sets in -C...parametrized form, of October 24, 1994. -C...Authors: H.L. Lai, J. Botts, J. Huston, J.G. Morfin, J.F. Owens, -C...J. Qiu, W.K. Tung and H. Weerts. - - FUNCTION PYCTEQ (ISET, IPRT, X, Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Data on Lambda values of fits, minimum Q and quark masses. - DIMENSION ALM(3), QMS(4:6) - DATA ALM / 0.177D0, 0.239D0, 0.247D0 / - DATA QMN / 1.60D0 /, (QMS(I), I=4,6) / 1.60D0, 5.00D0, 180.0D0 / - -C....Check flavour thresholds. Set up QI for SB. - IP = IABS(IPRT) - IF(IP .GE. 4) THEN - IF(Q .LE. QMS(IP)) THEN - PYCTEQ = 0D0 - RETURN - ENDIF - QI = QMS(IP) - ELSE - QI = QMN - ENDIF - -C...Use "standard lambda" of parametrization program for expansion. - ALAM = ALM (ISET) - SBL = LOG(Q/ALAM) / LOG(QI/ALAM) - SB = LOG (SBL) - SB2 = SB*SB - SB3 = SB2*SB - -C...Expansion for CTEQ3L. - IF(ISET .EQ. 1) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.1907D+00+0.4205D-01*SB +0.2752D+00*SB2- - & 0.3171D+00*SB3) - A1= 0.4611D+00+0.2331D-01*SB -0.3403D-01*SB2+0.3174D-01*SB3 - A2= 0.3504D+01+0.5739D+00*SB +0.2676D+00*SB2-0.1553D+00*SB3 - A3= 0.7452D+01-0.6742D+01*SB +0.2849D+01*SB2-0.1964D+00*SB3 - A4= 0.1116D+01-0.3435D+00*SB +0.2865D+00*SB2-0.1288D+00*SB3 - A5= 0.6659D-01+0.2714D+00*SB -0.2688D+00*SB2+0.2763D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp( 0.1141D+00+0.4764D+00*SB -0.1745D+01*SB2+ - & 0.7728D+00*SB3) - A1= 0.4275D+00-0.1290D+00*SB +0.3609D+00*SB2-0.1689D+00*SB3 - A2= 0.3000D+01+0.2946D+01*SB -0.4117D+01*SB2+0.1989D+01*SB3 - A3=-0.1302D+01+0.2322D+01*SB -0.4258D+01*SB2+0.2109D+01*SB3 - A4= 0.2586D+01-0.1920D+00*SB -0.3754D+00*SB2+0.2731D+00*SB3 - A5=-0.2251D+00-0.5374D+00*SB +0.2245D+01*SB2-0.1034D+01*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.7631D+00-0.7241D+00*SB -0.1170D+01*SB2+ - & 0.5343D+00*SB3) - A1=-0.3573D+00+0.3469D+00*SB -0.3396D+00*SB2+0.9188D-01*SB3 - A2= 0.5604D+01+0.7458D+00*SB -0.5082D+00*SB2+0.1844D+00*SB3 - A3= 0.1549D+02-0.1809D+02*SB +0.1162D+02*SB2-0.3483D+01*SB3 - A4= 0.9881D+00+0.1364D+00*SB -0.4421D+00*SB2+0.2051D+00*SB3 - A5=-0.9505D-01+0.3259D+01*SB -0.1547D+01*SB2+0.2918D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2449D+01-0.3513D+01*SB +0.4529D+01*SB2- - & 0.2031D+01*SB3) - A1=-0.4050D+00+0.3411D+00*SB -0.3669D+00*SB2+0.1109D+00*SB3 - A2= 0.7470D+01-0.2982D+01*SB +0.5503D+01*SB2-0.2419D+01*SB3 - A3= 0.1503D+02+0.1638D+01*SB -0.8772D+01*SB2+0.3852D+01*SB3 - A4= 0.1137D+01-0.1006D+01*SB +0.1485D+01*SB2-0.6389D+00*SB3 - A5=-0.5299D+00+0.3160D+01*SB -0.3104D+01*SB2+0.1219D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.2740D+01-0.7987D-01*SB -0.9015D+00*SB2- - & 0.9872D-01*SB3) - A1=-0.3909D+00+0.1244D+00*SB -0.4487D-01*SB2+0.1277D-01*SB3 - A2= 0.9163D+01+0.2823D+00*SB -0.7720D+00*SB2-0.9360D-02*SB3 - A3= 0.1080D+02-0.3915D+01*SB -0.1153D+01*SB2+0.2649D+01*SB3 - A4= 0.9894D+00-0.1647D+00*SB -0.9426D-02*SB2+0.2945D-02*SB3 - A5=-0.3395D+00+0.6998D+00*SB +0.7000D+00*SB2-0.6730D-01*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3640D+01+0.1250D+01*SB -0.2914D+01*SB2+ - & 0.8390D+00*SB3) - A1=-0.3595D+00-0.5259D-01*SB +0.3122D+00*SB2-0.1642D+00*SB3 - A2= 0.7305D+01+0.9727D+00*SB -0.9788D+00*SB2-0.5193D-01*SB3 - A3= 0.1198D+02-0.1799D+02*SB +0.2614D+02*SB2-0.1091D+02*SB3 - A4= 0.9882D+00-0.6101D+00*SB +0.9737D+00*SB2-0.4935D+00*SB3 - A5=-0.1186D+00-0.3231D+00*SB +0.3074D+01*SB2-0.1274D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1122D+01*Exp(-0.3718D+01-0.1335D+01*SB + - & 0.1651D-01*SB2) - A1=-0.4719D+00+0.7509D+00*SB -0.8420D+00*SB2+0.2901D+00*SB3 - A2= 0.6194D+01-0.1641D+01*SB +0.4907D+01*SB2-0.2523D+01*SB3 - A3= 0.4426D+01-0.4270D+01*SB +0.6581D+01*SB2-0.3474D+01*SB3 - A4= 0.2683D+00+0.9876D+00*SB -0.7612D+00*SB2+0.1780D+00*SB3 - A5=-0.4547D+00+0.4410D+01*SB -0.3712D+01*SB2+0.1245D+01*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9838D+00*Exp(-0.2548D+01-0.7660D+01*SB + - & 0.3702D+01*SB2) - A1=-0.3122D+00-0.2120D+00*SB +0.5716D+00*SB2-0.3773D+00*SB3 - A2= 0.6257D+01-0.8214D-01*SB -0.2537D+01*SB2+0.2981D+01*SB3 - A3=-0.6723D+00+0.2131D+01*SB +0.9599D+01*SB2-0.7910D+01*SB3 - A4= 0.9169D-01+0.4295D-01*SB -0.5017D+00*SB2+0.3811D+00*SB3 - A5= 0.2402D+00+0.2656D+01*SB -0.1586D+01*SB2+0.2880D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1001D+01*Exp(-0.6934D+01+0.3050D+01*SB - - & 0.6943D+00*SB2) - A1=-0.1713D+00-0.5167D+00*SB +0.1241D+01*SB2-0.1703D+01*SB3 - A2= 0.6169D+01+0.3023D+01*SB -0.1972D+02*SB2+0.1069D+02*SB3 - A3= 0.4439D+01-0.1746D+02*SB +0.1225D+02*SB2+0.8350D+00*SB3 - A4= 0.5458D+00-0.4586D+00*SB +0.9089D+00*SB2-0.4049D+00*SB3 - A5= 0.3207D+01-0.3362D+01*SB +0.5877D+01*SB2-0.7659D+01*SB3 - ENDIF - -C...Expansion for CTEQ3M. - ELSEIF(ISET .EQ. 2) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.2259D+00+0.1237D+00*SB +0.3035D+00*SB2- - & 0.2935D+00*SB3) - A1= 0.5085D+00+0.1651D-01*SB -0.3592D-01*SB2+0.2782D-01*SB3 - A2= 0.3732D+01+0.4901D+00*SB +0.2218D+00*SB2-0.1116D+00*SB3 - A3= 0.7011D+01-0.6620D+01*SB +0.2557D+01*SB2-0.1360D+00*SB3 - A4= 0.8969D+00-0.2429D+00*SB +0.1811D+00*SB2-0.6888D-01*SB3 - A5= 0.8636D-01+0.2558D+00*SB -0.3082D+00*SB2+0.2535D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp(-0.7266D+00-0.1584D+01*SB +0.1259D+01*SB2- - & 0.4305D-01*SB3) - A1= 0.5285D+00-0.3721D+00*SB +0.5150D+00*SB2-0.1697D+00*SB3 - A2= 0.4075D+01+0.8282D+00*SB -0.4496D+00*SB2+0.2107D+00*SB3 - A3= 0.3279D+01+0.5066D+01*SB -0.9134D+01*SB2+0.2897D+01*SB3 - A4= 0.4399D+00-0.5888D+00*SB +0.4802D+00*SB2-0.1664D+00*SB3 - A5= 0.3678D+00-0.8929D+00*SB +0.1592D+01*SB2-0.5713D+00*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.2318D+00-0.9779D+00*SB -0.3783D+00*SB2+ - & 0.1037D-01*SB3) - A1=-0.2916D+00+0.1754D+00*SB -0.1884D+00*SB2+0.6116D-01*SB3 - A2= 0.5349D+01+0.7460D+00*SB +0.2319D+00*SB2-0.2622D+00*SB3 - A3= 0.6920D+01-0.3454D+01*SB +0.2027D+01*SB2-0.7626D+00*SB3 - A4= 0.1013D+01+0.1423D+00*SB -0.1798D+00*SB2+0.1872D-01*SB3 - A5=-0.5465D-01+0.2303D+01*SB -0.9584D+00*SB2+0.3098D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2328D+01-0.3061D+01*SB +0.3620D+01*SB2- - & 0.1602D+01*SB3) - A1=-0.3358D+00+0.3198D+00*SB -0.4210D+00*SB2+0.1571D+00*SB3 - A2= 0.8478D+01-0.3112D+01*SB +0.5243D+01*SB2-0.2255D+01*SB3 - A3= 0.1971D+02+0.3389D+00*SB -0.5268D+01*SB2+0.2099D+01*SB3 - A4= 0.1128D+01-0.4701D+00*SB +0.7779D+00*SB2-0.3506D+00*SB3 - A5=-0.4708D+00+0.3341D+01*SB -0.3375D+01*SB2+0.1353D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.2906D+01-0.1069D+00*SB -0.1055D+01*SB2+ - & 0.2496D+00*SB3) - A1=-0.2875D+00+0.6571D-01*SB -0.1987D-01*SB2-0.1800D-02*SB3 - A2= 0.9854D+01-0.2715D+00*SB -0.7407D+00*SB2+0.2888D+00*SB3 - A3= 0.1583D+02-0.7687D+01*SB +0.3428D+01*SB2-0.3327D+00*SB3 - A4= 0.9763D+00+0.7599D-01*SB -0.2128D+00*SB2+0.6852D-01*SB3 - A5=-0.8444D-02+0.9434D+00*SB +0.4152D+00*SB2-0.1481D+00*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3780D+01+0.2499D+01*SB -0.4962D+01*SB2+ - & 0.1936D+01*SB3) - A1=-0.2639D+00-0.1575D+00*SB +0.3584D+00*SB2-0.1646D+00*SB3 - A2= 0.8082D+01+0.2794D+01*SB -0.5438D+01*SB2+0.2321D+01*SB3 - A3= 0.1811D+02-0.2000D+02*SB +0.1951D+02*SB2-0.6904D+01*SB3 - A4= 0.9822D+00+0.4972D+00*SB -0.8690D+00*SB2+0.3415D+00*SB3 - A5= 0.1772D+00-0.6078D+00*SB +0.3341D+01*SB2-0.1473D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1122D+01*Exp(-0.4232D+01-0.1808D+01*SB + - & 0.5348D+00*SB2) - A1=-0.2824D+00+0.5846D+00*SB -0.7230D+00*SB2+0.2419D+00*SB3 - A2= 0.5683D+01-0.2948D+01*SB +0.5916D+01*SB2-0.2560D+01*SB3 - A3= 0.2051D+01+0.4795D+01*SB -0.4271D+01*SB2+0.4174D+00*SB3 - A4= 0.1737D+00+0.1717D+01*SB -0.1978D+01*SB2+0.6643D+00*SB3 - A5= 0.8689D+00+0.3500D+01*SB -0.3283D+01*SB2+0.1026D+01*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9906D+00*Exp(-0.1496D+01-0.6576D+01*SB + - & 0.1569D+01*SB2) - A1=-0.2140D+00-0.6419D-01*SB -0.2741D-02*SB2+0.3185D-02*SB3 - A2= 0.5781D+01+0.1049D+00*SB -0.3930D+00*SB2+0.5174D+00*SB3 - A3=-0.9420D+00+0.5511D+00*SB +0.8817D+00*SB2+0.1903D+01*SB3 - A4= 0.2418D-01+0.4232D-01*SB -0.1244D-01*SB2-0.2365D-01*SB3 - A5= 0.7664D+00+0.1794D+01*SB -0.4917D+00*SB2-0.1284D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1000D+01*Exp(-0.8460D+01+0.1154D+01*SB + - & 0.8838D+01*SB2) - A1=-0.4316D-01-0.2976D+00*SB +0.3174D+00*SB2-0.1429D+01*SB3 - A2= 0.4910D+01+0.2273D+01*SB +0.5631D+01*SB2-0.1994D+02*SB3 - A3= 0.1190D+02-0.2000D+02*SB -0.2000D+02*SB2+0.1292D+02*SB3 - A4= 0.5771D+00-0.2552D+00*SB +0.7510D+00*SB2+0.6923D+00*SB3 - A5= 0.4402D+01-0.1627D+01*SB -0.2085D+01*SB2-0.6737D+01*SB3 - ENDIF - -C...Expansion for CTEQ3D. - ELSEIF(ISET .EQ. 3) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.2148D+00+0.5814D-01*SB +0.2734D+00*SB2- - & 0.2902D+00*SB3) - A1= 0.4810D+00+0.1657D-01*SB -0.3800D-01*SB2+0.3125D-01*SB3 - A2= 0.3509D+01+0.3923D+00*SB +0.4010D+00*SB2-0.1932D+00*SB3 - A3= 0.7055D+01-0.6552D+01*SB +0.3466D+01*SB2-0.5657D+00*SB3 - A4= 0.1061D+01-0.3453D+00*SB +0.4089D+00*SB2-0.1817D+00*SB3 - A5= 0.8687D-01+0.2548D+00*SB -0.2967D+00*SB2+0.2647D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp( 0.3961D+00+0.4914D+00*SB -0.1728D+01*SB2+ - & 0.7257D+00*SB3) - A1= 0.4162D+00-0.1419D+00*SB +0.3680D+00*SB2-0.1618D+00*SB3 - A2= 0.3248D+01+0.3028D+01*SB -0.4307D+01*SB2+0.1920D+01*SB3 - A3=-0.1100D+01+0.2184D+01*SB -0.3820D+01*SB2+0.1717D+01*SB3 - A4= 0.2082D+01-0.2756D+00*SB +0.3043D+00*SB2-0.1260D+00*SB3 - A5=-0.4822D+00-0.5706D+00*SB +0.2243D+01*SB2-0.9760D+00*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.4665D+00-0.7554D+00*SB -0.3323D+00*SB2- - & 0.2734D-04*SB3) - A1=-0.3359D+00+0.2395D+00*SB -0.2377D+00*SB2+0.7059D-01*SB3 - A2= 0.5451D+01+0.6086D+00*SB +0.8606D-01*SB2-0.1425D+00*SB3 - A3= 0.1026D+02-0.9352D+01*SB +0.4879D+01*SB2-0.1150D+01*SB3 - A4= 0.9935D+00-0.5017D-01*SB -0.1707D-01*SB2-0.1464D-02*SB3 - A5=-0.4160D-01+0.2305D+01*SB -0.1063D+01*SB2+0.3211D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2714D+01-0.2868D+01*SB +0.3700D+01*SB2- - & 0.1671D+01*SB3) - A1=-0.3893D+00+0.3341D+00*SB -0.3897D+00*SB2+0.1420D+00*SB3 - A2= 0.8359D+01-0.3267D+01*SB +0.5327D+01*SB2-0.2245D+01*SB3 - A3= 0.2359D+02-0.5669D+01*SB -0.4602D+01*SB2+0.3153D+01*SB3 - A4= 0.1106D+01-0.4745D+00*SB +0.7739D+00*SB2-0.3417D+00*SB3 - A5=-0.5557D+00+0.3433D+01*SB -0.3390D+01*SB2+0.1354D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.3323D+01+0.2296D+00*SB -0.1109D+01*SB2+ - & 0.2223D+00*SB3) - A1=-0.3410D+00+0.8847D-01*SB -0.1111D-01*SB2-0.5927D-02*SB3 - A2= 0.9753D+01-0.5182D+00*SB -0.4670D+00*SB2+0.1921D+00*SB3 - A3= 0.1977D+02-0.1600D+02*SB +0.9481D+01*SB2-0.1864D+01*SB3 - A4= 0.9818D+00+0.2839D-02*SB -0.1188D+00*SB2+0.3584D-01*SB3 - A5=-0.7934D-01+0.1004D+01*SB +0.3704D+00*SB2-0.1220D+00*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3985D+01+0.2855D+01*SB -0.5208D+01*SB2+ - & 0.1937D+01*SB3) - A1=-0.3337D+00-0.1150D+00*SB +0.3691D+00*SB2-0.1709D+00*SB3 - A2= 0.7968D+01+0.3641D+01*SB -0.6599D+01*SB2+0.2642D+01*SB3 - A3= 0.1873D+02-0.1999D+02*SB +0.1734D+02*SB2-0.5813D+01*SB3 - A4= 0.9731D+00+0.5082D+00*SB -0.8780D+00*SB2+0.3231D+00*SB3 - A5=-0.5542D-01-0.4189D+00*SB +0.3309D+01*SB2-0.1439D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1105D+01*Exp(-0.3952D+01-0.1901D+01*SB + - & 0.5137D+00*SB2) - A1=-0.3543D+00+0.6055D+00*SB -0.6941D+00*SB2+0.2278D+00*SB3 - A2= 0.5955D+01-0.2629D+01*SB +0.5337D+01*SB2-0.2300D+01*SB3 - A3= 0.1933D+01+0.4882D+01*SB -0.3810D+01*SB2+0.2290D+00*SB3 - A4= 0.1806D+00+0.1655D+01*SB -0.1893D+01*SB2+0.6395D+00*SB3 - A5= 0.4790D+00+0.3612D+01*SB -0.3152D+01*SB2+0.9684D+00*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9818D+00*Exp(-0.1825D+01-0.7464D+01*SB + - & 0.2143D+01*SB2) - A1=-0.2604D+00-0.1400D+00*SB +0.1702D+00*SB2-0.8476D-01*SB3 - A2= 0.6005D+01+0.6275D+00*SB -0.2535D+01*SB2+0.2219D+01*SB3 - A3=-0.9067D+00+0.1149D+01*SB +0.1974D+01*SB2+0.4716D+01*SB3 - A4= 0.3915D-01+0.5945D-01*SB -0.9844D-01*SB2+0.2783D-01*SB3 - A5= 0.5500D+00+0.1994D+01*SB -0.6727D+00*SB2-0.1510D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1002D+01*Exp(-0.8553D+01+0.3793D+00*SB + - & 0.9998D+01*SB2) - A1=-0.5870D-01-0.2792D+00*SB +0.6526D+00*SB2-0.1984D+01*SB3 - A2= 0.4716D+01+0.4473D+00*SB +0.1128D+02*SB2-0.1937D+02*SB3 - A3= 0.1289D+02-0.1742D+02*SB -0.1983D+02*SB2-0.9274D+00*SB3 - A4= 0.5647D+00-0.2732D+00*SB +0.1074D+01*SB2+0.5981D+00*SB3 - A5= 0.4390D+01-0.1262D+01*SB -0.9026D+00*SB2-0.9394D+01*SB3 - ENDIF - ENDIF - -C...Calculation of x * f(x, Q). - PYCTEQ = MAX(0D0, A0 *(X**A1) *((1D0-X)**A2) *(1D0+A3*(X**A4)) - & *(LOG(1D0+1D0/X))**A5 ) - - RETURN - END -C********************************************************************* -C********************************************************************* -C* ** -C* July 2004 ** -C* ** -C* The Lund Monte Carlo ** -C* ** -C* PYTHIA version 6.2 ** -C* ** -C* Torbjorn Sjostrand ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 48 16 ** -C* E-mail torbjorn@thep.lu.se ** -C* ** -C* SUSY and Technicolor parts by ** -C* Stephen Mrenna ** -C* Computing Division, Simulations Group ** -C* Fermi National Accelerator Laboratory ** -C* MS 234, Batavia, IL 60510, USA ** -C* phone + 1 - 630 - 840 - 2556 ** -C* E-mail mrenna@fnal.gov ** -C* ** -C* Baryon and lepton number violation parts by ** -C* Peter Skands ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 31 92 ** -C* E-mail zeiler@thep.lu.se ** -C* ** -C* PYTHIA 7 efforts coordinated by ** -C* Leif Lonnblad ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 77 80 ** -C* E-mail leif@thep.lu.se ** -C* ** -C* Several parts are written by Hans-Uno Bengtsson ** -C* PYSHOW is written together with Mats Bengtsson ** -C* PYMAEL is written by Emanuel Norrbin ** -C* advanced popcorn baryon production written by Patrik Eden ** -C* code for virtual photons mainly written by Christer Friberg ** -C* code for low-mass strings mainly written by Emanuel Norrbin ** -C* Bose-Einstein code mainly written by Leif Lonnblad ** -C* CTEQ parton distributions are by the CTEQ collaboration ** -C* GRV 94 parton distributions are by Glueck, Reya and Vogt ** -C* SaS photon parton distributions together with Gerhard Schuler ** -C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt ** -C* MSSM Higgs mass calculation code by M. Carena, ** -C* J.R. Espinosa, M. Quiros and C.E.M. Wagner ** -C* PYGAUS adapted from CERN library (K.S. Kolbig) ** -C* ** -C* The latest program version and documentation is found on WWW ** -C* http://www.thep.lu.se/~torbjorn/Pythia.html ** -C* ** -C* Copyright Torbjorn Sjostrand, Lund 2004 ** -C* ** -C********************************************************************* -C********************************************************************* -C * -C List of subprograms in order of appearance, with main purpose * -C (S = subroutine, F = function, B = block data) * -C * -C B PYDATA to contain all default values * -C S PYTEST to test the proper functioning of the package * -C S PYHEPC to convert between /PYJETS/ and /HEPEVT/ records * -C * -C S PYINIT to administer the initialization procedure * -C S PYEVNT to administer the generation of an event * -C S PYSTAT to print cross-section and other information * -C S PYINRE to initialize treatment of resonances * -C S PYINBM to read in beam, target and frame choices * -C S PYINKI to initialize kinematics of incoming particles * -C S PYINPR to set up the selection of included processes * -C S PYXTOT to give total, elastic and diffractive cross-sect. * -C S PYMAXI to find differential cross-section maxima * -C S PYPILE to select multiplicity of pileup events * -C S PYSAVE to save alternatives for gamma-p and gamma-gamma * -C S PYGAGA to handle lepton -> lepton + gamma branchings * -C S PYRAND to select subprocess and kinematics for event * -C S PYSCAT to set up kinematics and colour flow of event * -C S PYSSPA to simulate initial state spacelike showers * -C S PYMEMX auxiliary to PYSSPA for ME correction maximum * -C S PYMEWT auxiliary to PYSSPA for matrix element correction * -C S PYUPRE to rearranges contents of the HEPEUP commonblock * -C S PYADSH to administrate sequential final-state showers * -C S PYRESD to perform resonance decays * -C S PYMULT to generate multiple interactions * -C S PYREMN to add on target remnants * -C S PYDIFF to set up kinematics for diffractive events * -C S PYDISG to set up kinematics, remnant and showers for DIS * -C S PYDOCU to compute cross-sections and handle documentation * -C S PYFRAM to perform boosts between different frames * -C S PYWIDT to calculate full and partial widths of resonances * -C S PYOFSH to calculate partial width into off-shell channels * -C S PYRECO to handle colour reconnection in W+W- events * -C S PYKLIM to calculate borders of allowed kinematical region * -C S PYKMAP to construct value of kinematical variable * -C S PYSIGH to calculate differential cross-sections * -C S PYSGQC auxiliary to PYSIGH for QCD processes * -C S PYSGHF auxiliary to PYSIGH for heavy flavour processes * -C S PYSGWZ auxiliary to PYSIGH for W and Z processes * -C S PYSGHG auxiliary to PYSIGH for Higgs processes * -C S PYSGSU auxiliary to PYSIGH for supersymmetry processes * -C S PYSGTC auxiliary to PYSIGH for technicolor processes * -C S PYSGEX auxiliary to PYSIGH for various exotic processes * -C S PYPDFU to evaluate parton distributions * -C S PYPDFL to evaluate parton distributions at low x and Q^2 * -C S PYPDEL to evaluate electron parton distributions * -C S PYPDGA to evaluate photon parton distributions (generic) * -C S PYGGAM to evaluate photon parton distributions (SaS sets) * -C S PYGVMD to evaluate VMD part of photon parton distributions * -C S PYGANO to evaluate anomalous part of photon pdf's * -C S PYGBEH to evaluate Bethe-Heitler part of photon pdf's * -C S PYGDIR to evaluate direct contribution to photon pdf's * -C S PYPDPI to evaluate pion parton distributions * -C S PYPDPR to evaluate proton parton distributions * -C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions * -C S PYGRVL to evaluate the GRV 94L proton parton distributions * -C S PYGRVM to evaluate the GRV 94M proton parton distributions * -C S PYGRVD to evaluate the GRV 94D proton parton distributions * -C F PYGRVV auxiliary to the PYGRV* routines * -C F PYGRVW auxiliary to the PYGRV* routines * -C F PYGRVS auxiliary to the PYGRV* routines * -C F PYCT5L to evaluate the CTEQ 5L proton parton distributions * -C F PYCT5M to evaluate the CTEQ 5M1 proton parton distributions * -C S PYPDPO to evaluate old proton parton distributions * -C F PYHFTH to evaluate threshold factor for heavy flavour * -C S PYSPLI to find flavours left in hadron when one removed * -C F PYGAMM to evaluate ordinary Gamma function Gamma(x) * -C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) * -C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) * -C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) * -C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H * -C S PYSTBH to evaluate matrix element for t + b + H processes * -C * PYTBH* auxiliaries to PYSTBH * -C * -C S PYMSIN to initialize the supersymmetry simulation * -C S PYAPPS to determine MSSM parameters from SUGRA input * -C S PYSUGI to determine MSSM parameters using ISASUSY * -C F PYRNMQ to determine running squark masses * -C S PYTHRG to calculate sfermion third-gen. mass eigenstates * -C S PYINOM to calculate neutralino/chargino mass eigenstates * -C F PYRNM3 to determine running M3, gluino mass * -C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix * -C S PYHGGM to determine Higgs mass spectrum * -C S PYSUBH to determine Higgs masses in the MSSM * -C S PYPOLE to determine Higgs masses in the MSSM * -C S PYRGHM auxiliary to PYPOLE * -C S PYGFXX auxiliary to PYRGHM * -C F PYFINT auxiliary to PYPOLE * -C F PYFISB auxiliary to PYFINT * -C S PYSFDC to calculate sfermion decay partial widths * -C S PYGLUI to calculate gluino decay partial widths * -C S PYTBBN to calculate 3-body decay of gluino to neutralino * -C S PYTBBC to calculate 3-body decay of gluino to chargino * -C S PYNJDC to calculate neutralino decay partial widths * -C S PYCJDC to calculate chargino decay partial widths * -C F PYXXZ6 auxiliary for ino 3-body decays * -C F PYXXGA auxiliary for ino -> ino + gamma decay * -C F PYX2XG auxiliary for ino -> ino + gauge boson decay * -C F PYX2XH auxiliary for ino -> ino + Higgs decay * -C S PYHEXT to calculate non-SM Higgs decay partial widths * -C F PYH2XX auxiliary for H -> ino + ino decay * -C F PYGAUS to perform Gaussian integration * -C F PYGAU2 copy of PYGAUS to allow two-dimensional integration * -C F PYSIMP to perform Simpson integration * -C F PYLAMF to evaluate the lambda kinematics function * -C S PYTBDY to perform 3-body decay of gauginos * -C S PYTECM to calculate techni_rho/omega masses * -C S PYEICG to calculate eigenvalues of a 4*4 complex matrix * -C S PYCMQR auxiliary to PYEICG * -C S PYCMQ2 auxiliary to PYEICG * -C S PYCDIV auxiliary to PYCMQR * -C S PYCSRT auxiliary to PYCMQR * -C S PYTHAG auxiliary to PYCMQR * -C S PYCBAL auxiliary to PYEICG * -C S PYCBA2 auxiliary to PYEICG * -C S PYCRTH auxiliary to PYEICG * -C S PYLDCM auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * -C S PYBKSB auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * -C S PYWIDX to calculate decay widths from within PYWIDT * -C S PYRVSF to calculate R-violating sfermion decay widths * -C S PYRVNE to calculate R-violating neutralino decay widths * -C S PYRVCH to calculate R-violating chargino decay widths * -C S PYRVGL to calculate R-violating gluino decay widths * -C F PYRVSB auxiliary to PYRVSF * -C S PYRVGW to calculate R-Violating 3-body widths * -C F PYRVI1 auxiliary to PYRVGW, to do PS integration for res. * -C F PYRVI2 auxiliary to PYRVGW, to do PS integration for LR-int.* -C F PYRVI3 auxiliary to PYRVGW, to do PS X integral for int. * -C F PYRVG1 auxiliary to PYRVI1, general matrix element, res. * -C F PYRVG2 auxiliary to PYRVI2, general matrix element, LR-int. * -C F PYRVG3 auxiliary to PYRVI3, to do PS Y integral for int. * -C F PYRVG4 auxiliary to PYRVG3, general matrix element, int. * -C F PYRVR auxiliary to PYRVG1, Breit-Wigner * -C F PYRVS auxiliary to PYRVG2 & PYRVG4 * -C * -C S PY1ENT to fill one entry (= parton or particle) * -C S PY2ENT to fill two entries * -C S PY3ENT to fill three entries * -C S PY4ENT to fill four entries * -C S PY2FRM to interface to generic two-fermion generator * -C S PY4FRM to interface to generic four-fermion generator * -C S PY6FRM to interface to generic six-fermion generator * -C S PY4JET to generate a shower from a given 4-parton config * -C S PY4JTW to evaluate the weight od a shower history for above * -C S PY4JTS to set up the parton configuration for above * -C S PYJOIN to connect entries with colour flow information * -C S PYGIVE to fill (or query) commonblock variables * -C S PYEXEC to administrate fragmentation and decay chain * -C S PYPREP to rearrange showered partons along strings * -C S PYSTRF to do string fragmentation of jet system * -C S PYJURF to find boost to string junction rest frame * -C S PYINDF to do independent fragmentation of one or many jets * -C S PYDECY to do the decay of a particle * -C S PYDCYK to select parton and hadron flavours in decays * -C S PYKFDI to select parton and hadron flavours in fragm * -C S PYNMES to select number of popcorn mesons * -C S PYKFIN to calculate falvour prod. ratios from input params. * -C S PYPTDI to select transverse momenta in fragm * -C S PYZDIS to select longitudinal scaling variable in fragm * -C S PYSHOW to do timelike parton shower evolution * -C F PYMAEL auxiliary to PYSHOW, with gluon emission ME's * -C S PYBOEI to include Bose-Einstein effects (crudely) * -C S PYBESQ auxiliary to PYBOEI * -C F PYMASS to give the mass of a particle or parton * -C F PYMRUN to give the running MSbar mass of a quark * -C S PYNAME to give the name of a particle or parton * -C F PYCHGE to give three times the electric charge * -C F PYCOMP to compress standard KF flavour code to internal KC * -C S PYERRM to write error messages and abort faulty run * -C F PYALEM to give the alpha_electromagnetic value * -C F PYALPS to give the alpha_strong value * -C F PYANGL to give the angle from known x and y components * -C F PYR to provide a random number generator * -C S PYRGET to save the state of the random number generator * -C S PYRSET to set the state of the random number generator * -C S PYROBO to rotate and/or boost an event * -C S PYEDIT to remove unwanted entries from record * -C S PYLIST to list event record or particle data * -C S PYLOGO to write a logo * -C S PYUPDA to update particle data * -C F PYK to provide integer-valued event information * -C F PYP to provide real-valued event information * -C S PYSPHE to perform sphericity analysis * -C S PYTHRU to perform thrust analysis * -C S PYCLUS to perform three-dimensional cluster analysis * -C S PYCELL to perform cluster analysis in (eta, phi, E_T) * -C S PYJMAS to give high and low jet mass of event * -C S PYFOWO to give Fox-Wolfram moments * -C S PYTABU to analyze events, with tabular output * -C * -C S PYEEVT to administrate the generation of an e+e- event * -C S PYXTEE to give the total cross-section at given CM energy * -C S PYRADK to generate initial state photon radiation * -C S PYXKFL to select flavour of primary qqbar pair * -C S PYXJET to select (matrix element) jet multiplicity * -C S PYX3JT to select kinematics of three-jet event * -C S PYX4JT to select kinematics of four-jet event * -C S PYXDIF to select angular orientation of event * -C S PYONIA to perform generation of onium decay to gluons * -C * -C S PYBOOK to book a histogram * -C S PYFILL to fill an entry in a histogram * -C S PYFACT to multiply histogram contents by a factor * -C S PYOPER to perform operations between histograms * -C S PYHIST to print and reset all histograms * -C S PYPLOT to print a single histogram * -C S PYNULL to reset contents of a single histogram * -C S PYDUMP to dump histogram contents onto a file * -C * -C S PYKCUT dummy routine for user kinematical cuts * -C S PYEVWT dummy routine for weighting events * -C S UPINIT dummy routine to initialize user processes * -C S UPEVNT dummy routine to generate a user process event * -C S PDFSET dummy routine to be removed when using PDFLIB * -C S STRUCTM dummy routine to be removed when using PDFLIB * -C S STRUCTP dummy routine to be removed when using PDFLIB * -C S SUGRA dummy routine to be removed when linking with ISAJET * -C F VISAJE dummy functn. to be removed when linking with ISAJET * -C S PYTAUD dummy routine for interface to tau decay libraries * -C S PYTIME dummy routine for giving date and time * -C * -C********************************************************************* - -C...PYDATA -C...Default values for switches and parameters, -C...and particle, decay and process data. - - BLOCK DATA PYDATA - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYDATR/MRPY(6),RRPY(100) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, - &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, - &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYBINS/ - -C...PYDAT1, containing status codes and most parameters. - DATA MSTU/ - & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2, - 1 6, 1, 1, 0, 0, 1, 0, 0, 0, 0, - 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, - 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 7 30*0, - 1 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, - & 80*0/ - DATA (PARU(I),I=1,100)/ - & 3.141592653589793D0, 6.283185307179586D0, - & 0.197327D0, 5.06773D0, 0.389380D0, 2.56819D0, 4*0D0, - 1 0.001D0, 0.09D0, 0.01D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 3 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 4 2.0D0, 1.0D0, 0.25D0, 2.5D0, 0.05D0, - 4 0D0, 0D0, 0.0001D0, 0D0, 0D0, - 5 2.5D0,1.5D0,7.0D0,1.0D0,0.5D0,2.0D0,3.2D0, 0D0, 0D0, 0D0, - 6 40*0D0/ - DATA (PARU(I),I=101,200)/ - & 0.00729735D0, 0.232D0, 0.007764D0, 1.0D0, 1.16639D-5, - & 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0.20D0, 0.25D0, 1.0D0, 4.0D0, 10D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 -0.693D0, -1.0D0, 0.387D0, 1.0D0, -0.08D0, - 2 -1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, - 3 1.0D0,-1.0D0, 1.0D0,-1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 4 5.0D0, 1.0D0, 1.0D0, 0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, - 5 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 6 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 7 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, - 8 1.0D0, 1.0D0, 1.0D0, 0.0D0, 0.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, - 9 0D0, 0D0, 0D0, 0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0/ - DATA MSTJ/ - & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 1 4, 2, 0, 1, 0, 2, 2, 10, 0, 0, - 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, - 5 0, 3, 0, 2, 0, 0, 1, 0, 0, 0, - 6 40*0, - & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, - 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, - 2 80*0/ - DATA PARJ/ - & 0.10D0, 0.30D0, 0.40D0, 0.05D0, 0.50D0, - & 0.50D0, 0.50D0, 0.6D0, 1.2D0, 0.6D0, - 1 0.50D0,0.60D0,0.75D0, 0D0, 0D0, 0D0, 0D0, 1.0D0, 1.0D0, 0D0, - 2 0.36D0, 1.0D0,0.01D0, 2.0D0,1.0D0,0.4D0, 0D0, 0D0, 0D0, 0D0, - 3 0.10D0, 1.0D0, 0.8D0, 1.5D0,0D0,2.0D0,0.2D0, 0D0,0.08D0,1D0, - 4 0.3D0, 0.58D0, 0.5D0, 0.9D0,0.5D0,1.0D0,1.0D0,1.5D0,1D0,10D0, - 5 0.77D0, 0.77D0, 0.77D0, -0.05D0, -0.005D0, - 5 0D0, 0D0, 0D0, 1.0D0, 0D0, - 6 4.5D0, 0.7D0, 0D0,0.003D0, 0.5D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, - 7 10D0, 1000D0, 100D0, 1000D0, 0D0, 0.7D0,10D0, 0D0,0D0,0.5D0, - 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0,1D-4, - 9 0.02D0, 1.0D0, 0.2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - & 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 1.0D0, 0.25D0,91.187D0,2.489D0, 0.01D0, - 2 2.0D0, 1.0D0, 0.25D0,0.002D0, 0D0, - 3 0D0, 0D0, 0D0, 0D0, 0.01D0, 0.99D0, 0D0, 0D0, 0.2D0, 0D0, - 4 10*0D0, - 5 10*0D0, - 6 10*0D0, - 7 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, -0.693D0, - 8 -1.0D0, 0.387D0, 1.0D0, -0.08D0, -1.0D0, - 8 1.0D0, 1.0D0, -0.693D0, -1.0D0, 0.387D0, - 9 1.0D0, -0.08D0, -1.0D0, 1.0D0, 1.0D0, - 9 5*0D0/ - -C...PYDAT2, with particle data and flavour treatment parameters. - DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, - &-3,0,-3,6*0,3,9*0,3,2*0,3,4*0,-1,41*0,2,-1,20*0,3*3,7*0,3*3,3*0, - &3*3,3*0,3*3,6*0,3*3,3*0,3*3,4*0,-2,-3,2*1,2*0,4,2*3,6,2*-2,2*-3, - &0,2*1,2*0,2*3,-2,2*-3,2*0,-3,2*1,2*0,3,0,2*4,2*3,2*6,3,2*1,2*0, - &2*3,2*0,4,2*3,2*6,2*3,6,2*-2,2*-3,0,-3,0,2*1,2*0,2*3,0,3,2*-2, - &2*-3,2*0,2*-3,0,2*1,2*0,2*3,2*0,2*3,-2,2*-3,2*0,2*-3,2*0,-3,2*0, - &2*3,4*0,2*3,2*0,2*3,2*0,2*3,4*0,2*3,2*0,2*3,3*0,3,2*0,3,0,3,0,3, - &2*0,3,0,3,3*0,-1,2,-1,2,-1,2,-3,0,-3,0,-3,4*0,3,2*0,3,0,-1,2,-1, - &2,-1,2,-3,0,-3,0,-3,2*0,3,3*0,3,8*0,-1,2,-3,6*0,3,2*6,0,3,4*0,3, - &139*0/ - DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,20*0,1,107*0,-1,0,2*-1, - &2*0,-1,3*0,2*-1,3*0,2*-1,4*0,-1,5*0,2*-1,4*0,2*-1,5*0,2*-1,6*0, - &-1,7*0,2*-1,5*0,2*-1,6*0,2*-1,7*0,2*-1,8*0,-1,56*0,6*1,6*0,2,7*0, - &6*1,9*0,2,3*0,2,0,5*2,2*1,156*0/ - DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,3*0, - &2*1,39*0,1,0,2*1,20*0,3*1,4*0,6*1,3*0,9*1,3*0,12*1,4*0,100*1,2*0, - &2*1,2*0,4*1,2*0,6*1,2*0,8*1,3*0,1,0,2*1,0,3*1,0,4*1,3*0,12*1,3*0, - &1,2*0,1,0,12*1,0,1,3*0,1,8*0,4*1,5*0,3*1,0,1,3*0,2*1,139*0/ - DATA (KCHG(I,4),I= 1, 290)/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, - &16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36, - &37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57, - &58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78, - &79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, - &100,110,111,113,115,130,211,213,215,221,223,225,310,311,313,315, - &321,323,325,331,333,335,411,413,415,421,423,425,431,433,435,441, - &443,445,511,513,515,521,523,525,531,533,535,541,543,545,551,553, - &555,990,1103,1114,2101,2103,2112,2114,2203,2212,2214,2224,3101, - &3103,3112,3114,3122,3201,3203,3212,3214,3222,3224,3303,3312,3314, - &3322,3324,3334,4101,4103,4112,4114,4122,4132,4201,4203,4212,4214, - &4222,4224,4232,4301,4303,4312,4314,4322,4324,4332,4334,4403,4412, - &4414,4422,4424,4432,4434,4444,5101,5103,5112,5114,5122,5132,5142, - &5201,5203,5212,5214,5222,5224,5232,5242,5301,5303,5312,5314,5322, - &5324,5332,5334,5342,5401,5403,5412,5414,5422,5424,5432,5434,5442, - &5444,5503,5512,5514,5522,5524,5532,5534,5542,5544,5554,10111, - &10113,10211,10213,10221,10223,10311,10313,10321,10323,10331, - &10333,10411,10413,10421,10423,10431,10433,10441,10443,10511, - &10513,10521,10523,10531,10533,10541,10543,10551,10553,20113, - &20213,20223,20313,20323,20333,20413,20423,20433,20443,20513/ - DATA (KCHG(I,4),I= 291, 500)/20523,20533,20543,20553,100443, - &100553,1000001,1000002,1000003,1000004,1000005,1000006,1000011, - &1000012,1000013,1000014,1000015,1000016,1000021,1000022,1000023, - &1000024,1000025,1000035,1000037,1000039,2000001,2000002,2000003, - &2000004,2000005,2000006,2000011,2000012,2000013,2000014,2000015, - &2000016,3000111,3000211,3000221,3000331,3000113,3000213,3000223, - &3100021,3100111,3200111,3100113,3200113,3300113,3400113,4000001, - &4000002,4000011,4000012,5000039,9900012,9900014,9900016,9900023, - &9900024,9900041,9900042,9900110,9900210,9900220,9900330,9900440, - &9902110,9902210,139*0/ - DATA (PMAS(I,1),I= 1, 217)/2*0.33D0,0.5D0,1.5D0,4.8D0,175D0, - &2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,400D0, - &5*0D0,91.188D0,80.45D0,115D0,6*0D0,500D0,900D0,500D0,3*300D0, - &3*0D0,5000D0,200D0,40*0D0,1D0,2D0,5D0,16*0D0,0.13498D0,0.7685D0, - &1.318D0,0.49767D0,0.13957D0,0.7669D0,1.318D0,0.54745D0,0.78194D0, - &1.275D0,2*0.49767D0,0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0, - &0.95777D0,1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0, - &2.0067D0,2.46D0,1.9685D0,2.1124D0,2.5735D0,2.9798D0,3.09688D0, - &3.5562D0,5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0, - &5.3693D0,5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0, - &9.9132D0,0D0,0.77133D0,1.234D0,0.57933D0,0.77133D0,0.93957D0, - &1.233D0,0.77133D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0, - &1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0, - &1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0, - &1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0, - &2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0, - &2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0, - &2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0, - &3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0, - &5.641D0,5.84D0,7.00575D0,5.38897D0,5.40145D0,5.8D0,5.81D0,5.8D0/ - DATA (PMAS(I,1),I= 218, 500)/5.81D0,5.84D0,7.00575D0,5.56725D0, - &5.57536D0,5.96D0,5.97D0,5.96D0,5.97D0,6.12D0,6.13D0,7.19099D0, - &6.67143D0,6.67397D0,7.03724D0,7.0485D0,7.03724D0,7.0485D0, - &7.21101D0,7.219D0,8.30945D0,8.31325D0,10.07354D0,10.42272D0, - &10.44144D0,10.42272D0,10.44144D0,10.60209D0,10.61426D0, - &11.70767D0,11.71147D0,15.11061D0,0.9835D0,1.231D0,0.9835D0, - &1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0, - &2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0, - &5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0, - &2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0, - &2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0, - &3*110D0,350D0,3*210D0,500D0,125D0,250D0,400D0,2*350D0,300D0, - &4*400D0,1000D0,3*500D0,1200D0,750D0,2*200D0,7*0D0,139*0D0/ - DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.39816D0,16*0D0,2.47813D0, - &2.07115D0,0.00367D0,6*0D0,14.54029D0,0D0,16.66099D0,8.38842D0, - &3.3752D0,4.17669D0,3*0D0,417.29147D0,0.39162D0,60*0D0,0.151D0, - &0.107D0,2*0D0,0.149D0,0.107D0,0D0,0.00843D0,0.185D0,2*0D0, - &0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0.0002D0,0.00443D0,0.076D0, - &2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0.0013D0,0D0,0.002D0, - &2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,5*0D0,0.12D0, - &3*0D0,0.12D0,2*0D0,2*0.12D0,3*0D0,0.0394D0,4*0D0,0.036D0,0D0, - &0.0358D0,2*0D0,0.0099D0,0D0,0.0091D0,74*0D0,0.06D0,0.142D0, - &0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,0.287D0,0.09D0,0.25D0, - &0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,0D0,0.014D0,0.01D0, - &8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,0.053D0,3*0.05D0, - &0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,1D0,0D0,1D0,0D0, - &0.02911D0,0.01741D0,0.04536D0,0.09511D0,0.8686D0,0.62395D0, - &0.19192D0,123.27638D0,0.02296D0,0.18886D0,23.26819D0,2.86306D0, - &0D0,3.45903D0,2.59359D0,2.59687D0,0.42896D0,0.41912D0,0.14153D0, - &2*0.00098D0,0.00097D0,26.7245D0,21.74916D0,0.88159D0,0.88001D0, - &7*0D0,139*0D0/ - DATA (PMAS(I,3),I= 1, 500)/5*0D0,13.98156D0,16*0D0,24.78129D0, - &20.71149D0,0.03669D0,6*0D0,145.40294D0,0D0,166.60993D0, - &83.88423D0,33.75195D0,41.76694D0,3*0D0,4172.91467D0,3.91621D0, - &60*0D0,0.4D0,0.25D0,2*0D0,0.4D0,0.25D0,0D0,0.1D0,0.17D0,2*0D0, - &0.2D0,0.12D0,0D0,0.2D0,0.12D0,0.002D0,0.015D0,0.2D0,2*0D0,0.12D0, - &2*0D0,0.12D0,2*0D0,0.05D0,0.005D0,0D0,0.01D0,2*0D0,0.05D0,2*0D0, - &0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,5*0D0,0.14D0,3*0D0,0.14D0,2*0D0, - &2*0.14D0,3*0D0,0.04D0,4*0D0,0.035D0,0D0,0.035D0,2*0D0,0.05D0,0D0, - &0.05D0,74*0D0,0.05D0,0.25D0,0.05D0,0.25D0,0D0,0.2D0,0.4D0, - &0.005D0,0.4D0,0.01D0,0.35D0,0.001D0,0.1D0,0.08D0,0.1D0,0.08D0, - &0.1D0,0D0,0.05D0,0.02D0,6*0.1D0,0.05D0,0.1D0,0D0,0.02D0,2*0.3D0, - &0.05D0,2*0.3D0,0.02D0,2*0.1D0,0.03D0,0.001D0,4*0.1D0,3*0D0, - &19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,0.00001D0, - &0.29108D0,0.17412D0,0.45362D0,0.95114D0,8.68604D0,6.23946D0, - &1.91923D0,450D0,0.22959D0,1.88863D0,232.68185D0,28.63059D0,0D0, - &34.59032D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0, - &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0, - &8.80013D0,7*0D0,139*0D0/ - DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0, - &0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,7804.5D0,5*0D0, - &26.762D0,3*0D0,3709D0,5*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0, - &5*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,18*0D0, - &44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0, - &24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0, - &7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0, - &0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,112*0D0,139*0D0/ - DATA PARF/ - & 0.5D0,0.25D0, 0.5D0,0.25D0, 1D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, - 1 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 2 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 3 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 4 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 5 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 6 0.75D0, 0.5D0, 0D0,0.1667D0,0.0833D0,0.1667D0,0D0,0D0,0D0, 0D0, - 7 0D0, 0D0, 1D0,0.3333D0,0.6667D0,0.3333D0,0D0,0D0,0D0, 0D0, - 8 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 9 0.0099D0, 0.0056D0, 0.199D0, 1.23D0, 4.17D0, 165D0, 4*0D0, - & 0.325D0,0.325D0,0.5D0,1.6D0, 5.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0D0,0.11D0,0.16D0,0.048D0,0.50D0,0.45D0,0.55D0,0.60D0,0D0,0D0, - 2 0.2D0, 0.1D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 3 60*0D0, - 4 0.2D0, 0.5D0, 8*0D0, - 5 1800*0D0/ - DATA ((VCKM(I,J),J=1,4),I=1,4)/ - & 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0, - & 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0, - & 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0, - & 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/ - -C...PYDAT3, with particle decay parameters and data. - DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0, - &4*1,3*0,2*1,40*0,3*1,16*0,3*1,2*0,9*1,0,32*1,2*0,1,3*0,1,2*0,2*1, - &2*0,3*1,2*0,4*1,0,5*1,2*0,4*1,2*0,5*1,2*0,6*1,0,7*1,2*0,5*1,2*0, - &6*1,2*0,7*1,2*0,8*1,0,75*1,0,7*1,0,1,0,1,0,26*1,146*0/ - DATA (MDCY(I,2),I= 1, 351)/1,9,17,25,33,41,56,66,2*0,76,80,82, - &87,89,143,145,150,2*0,153,162,174,190,210,6*0,289,0,311,334,420, - &503,3*0,530,539,40*0,540,541,545,16*0,554,556,561,570,579,581, - &583,590,598,604,613,615,617,620,630,636,639,650,656,667,673,736, - &739,747,808,810,818,851,853,857,858,861,863,899,900,908,944,945, - &953,992,993,997,1028,1029,1033,1034,1043,2*0,1045,3*0,1046,2*0, - &1049,1052,2*0,1053,1055,1058,2*0,1062,1063,1066,1069,0,1072,1077, - &1079,1082,1084,2*0,1088,1089,1090,1166,2*0,1170,1171,1172,1173, - &1174,2*0,1178,1179,1181,1182,1184,1188,0,1189,1193,1197,1201, - &1205,1209,1213,2*0,1217,1218,1219,1236,1245,2*0,1254,1255,1256, - &1257,1258,1267,2*0,1276,1277,1278,1279,1280,1289,1290,2*0,1299, - &1308,1317,1326,1335,1344,1353,1362,0,1371,1380,1389,1398,1407, - &1416,1425,1434,1443,1452,1453,1454,1455,1456,1461,1464,1466,1471, - &1473,1478,1485,1489,1491,1493,1495,1497,1499,1501,1503,1504,1506, - &1508,1510,1512,1514,1516,1518,1520,1522,1523,1525,1527,1541,1543, - &1545,1549,1551,1553,1555,1557,1559,1561,1563,1565,1567,1578,1592, - &1637,1661,1706,1730,1775,1802,1833,1859,1891,1917,1949,1975,2162, - &2331,2595,2826,3106,3402,0,3657,3706,3734,3783,3811,3860,3888,0, - &3924,0,3960,0,3996,4004,4012,4020,4023,4047,4073,4097,4103,4110, - &4117,4124,4130,4136,4145,4149,4153,4156,4158,4178,4200,4222,4244/ - DATA (MDCY(I,2),I= 352, 500)/4259,4271,4278,146*0/ - DATA (MDCY(I,3),I= 1, 500)/5*8,15,2*10,2*0,4,2,5,2,54,2,5,3, - &2*0,9,12,16,20,79,6*0,22,0,23,86,83,27,3*0,9,1,40*0,1,4,9,16*0,2, - &5,2*9,2*2,7,8,6,9,2*2,3,10,6,3,11,6,11,6,63,3,8,61,2,8,33,2,4,1, - &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,2*0,1,3*0,3,2*0,3,1,2*0,2, - &3,4,2*0,1,3*3,0,5,2,3,2,4,2*0,2*1,76,4,2*0,4*1,4,2*0,1,2,1,2,4,1, - &0,7*4,2*0,2*1,17,2*9,2*0,4*1,2*9,2*0,4*1,9,1,9,2*0,8*9,0,9*9,4*1, - &5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,9*2,11,14,45,24,45,24, - &45,27,31,26,32,26,32,26,187,169,264,231,280,296,255,0,49,28,49, - &28,49,28,36,0,36,0,36,0,3*8,3,24,26,24,6,3*7,2*6,9,2*4,3,2,20, - &3*22,15,12,2*7,146*0/ - DATA (MDME(I,1),I= 1,8000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, - &7*1,-1,1,7*-1,8*1,2*-1,8*1,2*-1,73*1,-1,2*1,-1,5*1,0,2*-1,6*1,0, - &2*-1,3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,85*1, - &2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,200*1,2*-1,2*1,-1, - &1249*1,2*-1,377*1,2*-1,1868*1,2*-1,6*1,2*-1,9*1,-1,3*1,-1,3*1, - &5*-1,3*1,-1,14*1,2*-1,6*1,2*-1,67*1,2*-1,6*1,2*-1,111*1,3716*0/ - DATA (MDME(I,2),I= 1,8000)/43*102,4*0,102,0,6*53,3*102,4*0,102, - &2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41, - &8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,9*0,62*53, - &8*32,14*0,16*32,7*0,8*32,16*0,62*53,8*32,13*0,62*53,4*32,5*0, - &18*53,6*32,4*0,12,2*42,2*11,9*42,0,2,3,15*0,4*42,5*0,3,12*0,2, - &3*0,1,0,3,16*0,2*3,15*0,2*42,2*3,18*0,2*3,3*0,1,11*0,22*42,41*0, - &2*3,9*0,16*42,45*0,3,10*0,10*42,20*0,2*13,6*0,12,2*0,12,0,12, - &14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,3*13,2*42,9*0,14*42, - &19*0,48,3*13,2*42,6*0,2*11,28*42,5*0,32,3*0,4*32,2*4,0,32,45*0, - &14*42,52*0,10*13,2*42,2*11,4*0,2*42,2*11,6*0,2*42,2*11,0,2*42, - &2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11, - &2*0,3*42,8*0,48,3*13,20*42,4*0,18*42,4*0,9*42,0,162*42,50*0,2*12, - &17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,4*32,2*4,5*0,2404*53,4*32, - &3*0,6*32,3*0,4*32,3*0,4*32,8*0,8*32,14*0,16*32,12*0,8*32,8*0, - &46*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0,9*32,3733*0/ - DATA (BRAT(I) ,I= 1, 346)/43*0D0,0.00003D0,0.001765D0, - &0.998205D0,35*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0, - &0.003D0,0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0, - &0.0071D0,0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0, - &0.0034D0,0.08D0,0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0, - &0.0067D0,0.0005D0,0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0, - &0.00075D0,0.0001D0,0.0002D0,0.0011D0,3*0.0002D0,0.00022D0, - &0.0004D0,0.0001D0,2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0, - &0.00025D0,35*0D0,0.153995D0,0.11942D0,0.153984D0,0.119259D0, - &0.152272D0,3*0D0,0.033576D0,0.066806D0,0.033576D0,0.066806D0, - &0.0335D0,0.066806D0,2*0D0,0.321369D0,0.016494D0,2*0D0,0.016502D0, - &0.320615D0,2*0D0,0.00001D0,0.000591D0,6*0D0,2*0.108166D0, - &0.108087D0,0D0,0.000001D0,0D0,0.000349D0,0.048707D0,0.768308D0, - &4*0D0,0.000227D0,0.064048D0,0D0,0.040621D0,0.002043D0,0.000615D0, - &0.006981D0,0.068099D0,62*0D0,0.145835D0,0.113276D0,0.145835D0, - &0.113271D0,0.145781D0,0.049002D0,2*0D0,0.032025D0,0.063642D0, - &0.032025D0,0.063642D0,0.032022D0,0.063642D0,8*0D0,0.251225D0, - &0.0129D0,0.000006D0,0D0,0.0129D0,0.250764D0,0.00038D0,0D0, - &0.000008D0,0.000465D0,0.215418D0,5*0D0,2*0.085312D0,0.08531D0, - &7*0D0,0.000049D0,0.000774D0,5*0D0,0.000074D0,0D0,0.000417D0/ - DATA (BRAT(I) ,I= 347, 651)/0.000015D0,0.000061D0,0.30671D0, - &0.689011D0,0D0,0.002889D0,69*0D0,0.000001D0,0.000121D0, - &0.001924D0,4*0D0,0.000001D0,0.000184D0,0D0,0.003106D0,0.000015D0, - &0.000003D0,2*0D0,0.994646D0,66*0D0,0.000021D0,0.090135D0,2*0D0, - &0.000013D0,0.003714D0,0D0,0.906117D0,18*0D0,3*0.215119D0, - &0.214724D0,2*0D0,0.06996D0,0.069959D0,0D0,2*1D0,2*0.08D0,0.76D0, - &0.08D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,0.988D0,0.012D0,0.998739D0,0.00079D0,0.00038D0, - &0.000046D0,0.000045D0,2*0.34725D0,0.144D0,0.104D0,0.0245D0, - &2*0.01225D0,0.0028D0,0.0057D0,0.2112D0,0.1256D0,2*0.1939D0, - &2*0.1359D0,0.002D0,0.001D0,0.0006D0,0.999877D0,0.000123D0, - &0.99955D0,0.00045D0,2*0.34725D0,0.144D0,0.104D0,0.049D0,0.0028D0, - &0.0057D0,0.3923D0,0.321D0,0.2317D0,0.0478D0,0.0049D0,0.0013D0, - &0.0003D0,0.0007D0,0.89D0,0.08693D0,0.0221D0,0.00083D0, - &2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0,0.023D0,2*0.0115D0, - &0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0,0.665D0,0.333D0, - &0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0,0.043D0,0.059D0, - &2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0,0.0173D0,0.0482D0, - &0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0,0.166D0,0.168D0,0.084D0, - &0.086D0,0.043D0,0.059D0,2*0.029D0,2*0.002D0,0.437D0,0.208D0/ - DATA (BRAT(I) ,I= 652, 823)/0.302D0,0.0302D0,0.0212D0,0.0016D0, - &0.48947D0,0.34D0,3*0.043D0,0.027D0,0.0126D0,0.0013D0,0.0003D0, - &0.00025D0,0.00008D0,0.444D0,2*0.222D0,0.104D0,2*0.004D0,0.07D0, - &0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.07D0,0.065D0,2*0.005D0, - &2*0.011D0,5*0.001D0,0.026D0,0.019D0,0.066D0,0.041D0,0.045D0, - &0.076D0,0.0073D0,2*0.0047D0,0.026D0,0.001D0,0.0006D0,0.0066D0, - &0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0,0.006D0,0.005D0,0.012D0, - &0.0057D0,0.067D0,0.008D0,0.0022D0,0.027D0,0.004D0,0.019D0, - &0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0,0.022D0,0.087D0,0.001D0, - &0.0019D0,0.0015D0,0.0028D0,0.683D0,0.306D0,0.011D0,0.3D0,0.15D0, - &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.034D0,0.027D0, - &2*0.002D0,2*0.004D0,2*0.002D0,0.034D0,0.027D0,2*0.002D0, - &2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0,0.062D0,3*0.021D0, - &0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0,0.0109D0,0.0041D0, - &0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0,2*0.0016D0,0.0018D0, - &0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0,0.0034D0,0.0036D0, - &0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0,0.022D0,0.0077D0, - &0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0,0.0511D0,0.017D0, - &0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0,0.16D0,0.08D0, - &0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,2*0.005D0/ - DATA (BRAT(I) ,I= 824, 991)/2*0.02D0,0.03D0,2*0.005D0,0.015D0, - &0.037D0,0.028D0,0.079D0,0.095D0,0.052D0,0.0078D0,4*0.001D0, - &0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0,0.0952D0, - &0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0,0.8797D0, - &0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0, - &0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0, - &0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0, - &0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0, - &0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0, - &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0, - &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0, - &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0, - &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0, - &0.0008D0,0.0014D0,0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0, - &0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0, - &0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0, - &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0, - &0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0, - &0.0135D0,0.025D0,2*0.0002D0,0.0007D0,2*0.0004D0,0.0014D0,0.001D0, - &0.0009D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0/ - DATA (BRAT(I) ,I= 992,1183)/1D0,2*0.3D0,2*0.2D0,0.047D0,0.122D0, - &0.006D0,0.012D0,0.035D0,0.012D0,0.035D0,0.003D0,0.007D0,0.15D0, - &0.037D0,0.008D0,0.002D0,0.05D0,0.015D0,0.003D0,0.001D0,0.014D0, - &0.042D0,0.014D0,0.042D0,0.24D0,0.065D0,0.012D0,0.003D0,0.001D0, - &0.002D0,0.001D0,0.002D0,0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0, - &0.0252D0,0.0248D0,0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0, - &0.7743D0,0.029D0,0.22D0,0.78D0,1D0,0.331D0,0.663D0,0.006D0, - &0.663D0,0.331D0,0.006D0,1D0,0.999D0,0.001D0,0.88D0,2*0.06D0, - &0.639D0,0.358D0,0.002D0,0.001D0,1D0,0.88D0,2*0.06D0,0.516D0, - &0.483D0,0.001D0,0.88D0,2*0.06D0,0.9988D0,0.0001D0,0.0006D0, - &0.0004D0,0.0001D0,0.667D0,0.333D0,0.9954D0,0.0011D0,0.0035D0, - &0.333D0,0.667D0,0.676D0,0.234D0,0.085D0,0.005D0,2*1D0,0.018D0, - &2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.018D0,2*0.005D0,0.003D0, - &0.002D0,2*0.006D0,0.0066D0,0.025D0,0.016D0,0.0088D0,2*0.005D0, - &0.0058D0,0.005D0,0.0055D0,4*0.004D0,2*0.002D0,2*0.004D0,0.003D0, - &0.002D0,2*0.003D0,3*0.002D0,2*0.001D0,0.002D0,2*0.001D0, - &2*0.002D0,0.0013D0,0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0, - &2*0.002D0,2*0.001D0,2*0.002D0,2*0.001D0,0.2432D0,0.057D0, - &2*0.035D0,0.15D0,2*0.075D0,0.03D0,2*0.015D0,2*0.08D0,0.76D0, - &0.08D0,4*1D0,2*0.08D0,0.76D0,0.08D0,1D0,2*0.5D0,1D0,2*0.5D0/ - DATA (BRAT(I) ,I=1184,1377)/2*0.08D0,0.76D0,0.08D0,1D0,2*0.08D0, - &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0, - &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0, - &0.04D0,0.0077D0,0.02D0,0.0235D0,0.0285D0,0.0435D0,0.0011D0, - &0.0022D0,0.0044D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0, - &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, - &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, - &4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0/ - DATA (BRAT(I) ,I=1378,1580)/0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,0.52D0,0.26D0, - &0.11D0,2*0.055D0,0.333D0,0.334D0,0.333D0,0.667D0,0.333D0,0.28D0, - &0.14D0,0.313D0,0.157D0,0.11D0,0.667D0,0.333D0,0.28D0,0.14D0, - &0.313D0,0.157D0,0.11D0,0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0, - &4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0, - &0.333D0,4*0.5D0,0.007D0,0.993D0,1D0,0.667D0,0.333D0,0.667D0, - &0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0, - &1D0,4*0.5D0,3*0.146D0,3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0, - &0.667D0,0.333D0,0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0, - &0.333D0,2*0.5D0,0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0, - &4*0.5D0,0.35D0,0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0, - &0.027D0,0.001D0,0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0/ - DATA (BRAT(I) ,I=1581,4149)/0.008D0,0.024D0,0.008D0,0.024D0, - &0.425D0,0.02D0,0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0, - &0.017431D0,0.054048D0,0.857694D0,2*0D0,0.00025D0,0.070578D0,0D0, - &0.022748D0,0.026576D0,0.359486D0,0.561581D0,2*0D0,0.000104D0, - &0.029504D0,0.011185D0,0.034681D0,0.550354D0,2*0D0,0.00016D0, - &0.045287D0,0.358333D0,0.445781D0,0D0,0.554219D0,0.144051D0, - &2*0.351902D0,0D0,0.082107D0,0.029566D0,0.001511D0,0.000726D0, - &0.004518D0,0.006522D0,0.004518D0,0.006522D0,0.004513D0,3*0D0, - &0.002908D0,0.000973D0,0.002908D0,0.000973D0,0.002908D0, - &0.000973D0,2*0D0,0.143982D0,0.489888D0,0.1951D0,0D0,0.114302D0, - &0.008426D0,0.014868D0,0.000763D0,2*0D0,0.000763D0,0.01484D0, - &0.000003D0,2*0D0,0.000027D0,0.001945D0,5*0D0,3*0.00503D0,0D0, - &0.133776D0,0.003284D0,0.37169D0,0.006838D0,2*0.030954D0, - &0.00163D0,0D0,0.047224D0,0.073737D0,0.047224D0,0.073732D0, - &0.047179D0,3*0D0,0.034761D0,0.009166D0,0.034761D0,0.009166D0, - &0.034759D0,0.009166D0,2*0D0,4*0.009069D0,0.510147D0,0.453576D0, - &6*0D0,1D0,6*0D0,1D0,4*0.001128D0,0.571047D0,0.382288D0, - &0.042153D0,4*0.016597D0,0.93361D0,0D0,4*0.016597D0,0.93361D0,0D0, - &4*0.05515D0,0.34469D0,0D0,0.228998D0,0.164208D0,0.041503D0, - &0.850973D0,0.005411D0,0.045025D0,0.098591D0,0.849898D0/ - DATA (BRAT(I) ,I=4150,4280)/0.021617D0,0.030018D0,0.098466D0, - &0.294448D0,0.10945D0,0.596102D0,0.389906D0,0.610094D0,3*0.0633D0, - &0.063299D0,0.063295D0,0.056281D0,2*0D0,6*0.020495D0,2*0D0, - &0.327919D0,0.04099D0,0.045236D0,0.090112D0,0.19874D0,0.010204D0, - &0.000003D0,0.010205D0,0.198356D0,0.000151D0,0.000006D0, - &0.000367D0,0.081967D0,0.19874D0,0.010204D0,0.000003D0,0.010205D0, - &0.198356D0,0.000151D0,0.000006D0,0.000367D0,0.081967D0,4*0D0, - &0.198776D0,0.010206D0,0.000003D0,0.010207D0,0.19839D0,0.000151D0, - &0.000006D0,0.000367D0,0.081893D0,0.198776D0,0.010206D0, - &0.000003D0,0.010207D0,0.19839D0,0.000151D0,0.000006D0,0.000367D0, - &0.081893D0,4*0D0,0.199344D0,0.010234D0,0.000003D0,0.010236D0, - &0.198928D0,0.000149D0,0.000006D0,0.000368D0,0.080733D0, - &0.199344D0,0.010234D0,0.000003D0,0.010236D0,0.198928D0, - &0.000149D0,0.000006D0,0.000368D0,0.080733D0,4*0D0,0.184738D0, - &0.104588D0,0.184738D0,0.104587D0,0.184731D0,0.09582D0,0.022902D0, - &0.008429D0,0.015602D0,0.022902D0,0.008429D0,0.015602D0, - &0.022902D0,0.008429D0,0.015602D0,0.28959D0,0.01487D0,0.000008D0, - &0.01487D0,0.289061D0,0.000492D0,0.000009D0,0.000536D0,0.27911D0, - &2*0.037151D0,0.03715D0,0.090266D0,2*0.001805D0,0.090266D0, - &0.001805D0,0.812263D0,0.00179D0,0.090428D0,0.001809D0,0.001808D0/ - DATA (BRAT(I) ,I=4281,8000)/0.090428D0,0.001808D0,0.81372D0,0D0, - &3716*0D0/ - DATA (KFDP(I,1),I= 1, 377)/21,22,23,4*-24,25,21,22,23,4*24,25, - &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, - &4*24,25,37,1000022,1000023,1000025,1000035,1000021,1000039,21,22, - &23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12, - &22,23,-24,25,23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25, - &-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,1,2, - &3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13, - &-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022, - &2*1000023,3*1000025,4*1000035,2*1000024,2*1000037,1000001, - &2000001,1000001,-1000001,1000002,2000002,1000002,-1000002, - &1000003,2000003,1000003,-1000003,1000004,2000004,1000004, - &-1000004,1000005,2000005,1000005,-1000005,1000006,2000006, - &1000006,-1000006,1000011,2000011,1000011,-1000011,1000012, - &2000012,1000012,-1000012,1000013,2000013,1000013,-1000013, - &1000014,2000014,1000014,-1000014,1000015,2000015,1000015, - &-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12, - &13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13, - &-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,24, - &37,23,25,36,1000022,2*1000023,3*1000025,4*1000035,2*1000024, - &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002/ - DATA (KFDP(I,1),I= 378, 580)/1000002,-1000002,1000003,2000003, - &1000003,-1000003,1000004,2000004,1000004,-1000004,1000005, - &2000005,1000005,-1000005,1000006,2000006,1000006,-1000006, - &1000011,2000011,1000011,-1000011,1000012,2000012,1000012, - &-1000012,1000013,2000013,1000013,-1000013,1000014,2000014, - &1000014,-1000014,1000015,2000015,1000015,-1000015,1000016, - &2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23, - &24,23,25,24,37,1000022,2*1000023,3*1000025,4*1000035,2*1000024, - &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002, - &1000002,-1000002,1000003,2000003,1000003,-1000003,1000004, - &2000004,1000004,-1000004,1000005,2000005,1000005,-1000005, - &1000006,2000006,1000006,-1000006,1000011,2000011,1000011, - &-1000011,1000012,2000012,1000012,-1000012,1000013,2000013, - &1000013,-1000013,1000014,2000014,1000014,-1000014,1000015, - &2000015,1000015,-1000015,1000016,2000016,1000016,-1000016,-1,-3, - &-5,-7,-11,-13,-15,-17,24,2*1000022,2*1000023,2*1000025,2*1000035, - &1000006,2000006,1000006,2000006,-1000001,-1000003,-1000011, - &-1000013,-1000015,-2000015,1,2,3,4,5,6,11,13,15,2,82,-11,-13,2*2, - &-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,221,13,11,213,-213,221, - &223,321,130,310,111,331,111,211,-12,12,-14,14,211,111,22,-13,-11/ - DATA (KFDP(I,1),I= 581, 992)/2*211,213,113,221,223,321,211,331, - &22,111,211,2*22,211,22,111,211,22,211,221,111,11,211,111,2*211, - &321,130,310,221,111,211,111,130,310,321,2*311,321,311,323,313, - &323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,313,323,313, - &323,311,4*321,211,111,3*22,111,321,130,-213,113,213,211,22,111, - &11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,-313,-311, - &-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223, - &2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,-321,211, - &2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,423,413,421, - &411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,-313,2*-311, - &-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,3*-321,-311, - &-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,-321,3*-311, - &211,113,321,2*421,411,421,413,423,413,423,411,421,-15,5*-11, - &5*-13,221,331,333,221,331,333,10221,211,213,211,213,321,323,321, - &323,2212,221,331,333,221,2*2,2*431,421,411,423,413,82,11,13,82, - &443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,2*441,2*443, - &2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,511,6*12, - &6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2, - &2*4,2,4,521,511,521,513,523,513,523,511,521,6*12,6*14,2*16, - &3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,531/ - DATA (KFDP(I,1),I= 993,1402)/521,511,523,513,16,2*4,2*12,2*14, - &2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,2*-1,541,511,521, - &513,523,21,11,13,15,1,2,3,4,21,22,553,21,2112,2212,2*2112,2212, - &2112,2*2212,2112,-12,3122,3212,3112,2212,2*2112,-12,2*3122,3222, - &3112,2212,2112,2212,3122,3222,3212,3122,3112,-12,-14,-12,3322, - &3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,7*-13, - &2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322, - &3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214, - &2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,2*2, - &3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,-13, - &2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,-12, - &-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,-14,-16, - &2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, - &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, - &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, - &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, - &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2/ - DATA (KFDP(I,1),I=1403,1713)/2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, - &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, - &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,221,223,221, - &223,211,111,321,130,310,213,113,-213,321,311,321,311,323,313, - &2*311,321,311,321,313,323,321,211,111,321,130,310,2*211,313,-313, - &323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443, - &2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513, - &523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113, - &-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413, - &2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443, - &10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555, - &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &1000002,2000002,1000002,2000002,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, - &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000001, - &2000001,1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3, - &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, - &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000003/ - DATA (KFDP(I,1),I=1714,1984)/2000003,1000003,2000003,1000021, - &3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,-1000037,1000022, - &1000023,1000025,1000035,1000006,2000006,1000006,2000006,1000021, - &3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,14,13,16,15,16, - &15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,1000022,1000023, - &1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022, - &1000016,-1000015,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, - &-1000037,1000022,1000023,1000025,1000035,1000012,2000012,1000012, - &2*12,2*14,2*16,3*-14,3*-16,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000011,2000011,1000011, - &2000011,3*-13,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,1000014,2000014,1000014,2000014, - &2*12,2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000013,2000013,1000013, - &2000013,3*-11,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,1000016,2000016,1000016,2000016, - &2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000015,2000015,1000015, - &2000015,3*-11,3*-13,3*-1,3*-3,3*-5,1000039,1000001,-1000001, - &2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003/ - DATA (KFDP(I,1),I=1985,2321)/-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,6*1000022,6*1000023,6*1000025, - &6*1000035,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000037,-1000037,1000037,-1000037,1000037,-1000037,-12,12,-11,11, - &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12, - &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13, - &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14, - &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15, - &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16, - &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2, - &-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,4,1,-12,12,-12,12,-12,12, - &-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,14,-14,14,-14,14, - &-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,12,-11,11,-12,12, - &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11, - &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,-14,14, - &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13, - &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,-16,16, - &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15, - &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,-4,4,-4/ - DATA (KFDP(I,1),I=2322,2573)/4,-4,4,-6,6,-6,6,-6,6,5*1000039, - &16*1000022,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000037, - &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037, - &1000037,-1000037,1000037,-1000037,1000024,-1000024,1000037, - &-1000037,1000001,-1000001,2000001,-2000001,1000002,-1000002, - &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, - &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, - &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, - &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, - &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, - &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, - &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, - &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, - &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16/ - DATA (KFDP(I,1),I=2574,2892)/16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4, - &-4,4,-6,6,-6,6,-6,6,2*1000039,6*1000022,6*1000023,6*1000025, - &6*1000035,1000022,1000023,1000025,1000035,1000002,2000002, - &-1000001,-2000001,1000004,2000004,-1000003,-2000003,1000006, - &2000006,-1000005,-2000005,1000012,2000012,-1000011,-2000011, - &1000014,2000014,-1000013,-2000013,1000016,2000016,-1000015, - &-2000015,2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, - &-12,12,-11,-12,12,-11,-14,-13,-14,-13,-14,-13,-14,14,-13,-14,14, - &-13,-14,14,-13,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15, - &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12, - &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-14,2*-13,14, - &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14, - &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,2*-15,16,-16,2*-15,16, - &-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16, - &-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,2,-1,3*2,-1,2*4,-3, - &3*4,-3,2*6,5*1000039,16*1000022,16*1000023,1000024,-1000024, - &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024, - &-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037, - &1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037, - &-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001/ - DATA (KFDP(I,1),I=2893,3182)/2000001,-2000001,1000002,-1000002, - &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, - &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, - &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, - &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, - &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, - &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, - &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, - &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, - &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16, - &16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039, - &16*1000022,16*1000023,16*1000025,1000024,-1000024,1000024, - &-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037, - &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037/ - DATA (KFDP(I,1),I=3183,3459)/1000024,-1000024,1000037,-1000037, - &1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002, - &-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004, - &2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006, - &-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011, - &1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013, - &-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015, - &2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,-12, - &12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14, - &14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12, - &12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14, - &14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16, - &16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2, - &-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,2*1000039,15*1000024, - &6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025, - &1000035,1000002,2000002,-1000001,-2000001,1000004,2000004, - &-1000003,-2000003,1000006,2000006,-1000005,-2000005,1000012/ - DATA (KFDP(I,1),I=3460,3782)/2000012,-1000011,-2000011,1000014, - &2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015, - &2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, - &-12,12,-11,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,-13,-14,14, - &-13,-14,14,-13,-16,16,-15,-16,16,-15,-16,16,-15,-16,16,-15,-16, - &16,-15,-16,16,-15,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, - &2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, - &2*-11,12,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14, - &2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16, - &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16, - &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1, - &2,-1,3*2,-1,2*4,-3,3*4,-3,2*6,1000039,-1000024,-1000037,1000022, - &1000023,1000025,1000035,4*1000001,1000002,2000002,1000002, - &2000002,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13, - &14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037, - &1000022,1000023,1000025,1000035,4*1000002,1000001,2000001, - &1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039, - &-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003, - &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6/ - DATA (KFDP(I,1),I=3783,4127)/1000039,1000024,1000037,1000022, - &1000023,1000025,1000035,4*1000004,1000003,2000003,1000003, - &2000003,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, - &-1000037,1000022,1000023,1000025,1000035,4*1000005,1000006, - &2000006,1000006,2000006,1000021,3*-12,3*-14,3*-16,12,11,12,11,12, - &11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039, - &1000024,1000037,1000022,1000023,1000025,1000035,4*1000006, - &1000005,2000005,1000005,2000005,1000021,3*-11,3*-13,3*-15,2*-1, - &-3,1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &4*1000011,1000012,2000012,1000012,2000012,2*12,2*14,2*16,3*-14, - &3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,1000022,1000023, - &1000025,1000035,4*1000013,1000014,2000014,1000014,2000014,2*12, - &2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,4*1000015,1000016,2000016, - &1000016,2000016,2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,3,4,5, - &6,11,13,15,21,2*4,2,4,24,-11,-13,-15,3,4,5,6,11,13,15,21,5,6,21, - &2*24,2*3000211,2*22,2*23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, - &2*24,3*3000211,24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23,22, - &23,24,3000211,24,3000211,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, - &1,2,3,4,5,6,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4/ - DATA (KFDP(I,1),I=4128,8000)/5,6,1,2,3,4,5,6,1,2,3,4,5,6,21, - &3100111,3200111,21,22,23,-24,21,22,23,24,22,23,-24,23,24,1,2,3,4, - &5,6,7,8,11,12,13,14,15,16,17,18,21,22,23,24,9*11,9*-11,2*11, - &2*-11,9*13,9*-13,2*13,2*-13,9*15,9*-15,2*15,2*-15,1,2,3,4,5,6,11, - &12,9900012,13,14,9900014,15,16,9900016,3*-1,3*-3,3*-5,-11,-13, - &-15,3*-11,2*-13,-15,24,3*-11,2*-13,-15,9900024,3716*0/ - DATA (KFDP(I,2),I= 1, 339)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, - &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,6*1000006,3*7, - &2,4,6,8,7,4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14, - &13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321, - &-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211, - &-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211, - &2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, - &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, - &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, - &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, - &-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023, - &1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001, - &2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003, - &2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, - &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, - &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, - &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, - &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, - &-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8, - &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25,-1,-2,-3,-4,-5,-6/ - DATA (KFDP(I,2),I= 340, 533)/-7,-8,-11,-13,-15,-17,21,22,2*23, - &-24,2*25,-37,-24,3*36,2*1000022,1000023,1000022,1000023,1000025, - &1000022,1000023,1000025,1000035,-1000024,-1000037,-1000024, - &-1000037,-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002, - &-1000003,2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, - &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, - &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, - &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, - &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, - &-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,-37,-24,2*1000022, - &1000023,1000022,1000023,1000025,1000022,1000023,1000025,1000035, - &-1000024,-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001, - &-1000002,2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004, - &2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006, - &2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012, - &2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014, - &2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016, - &2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037, - &1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005, - &2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-3,-4,-5,-6/ - DATA (KFDP(I,2),I= 534, 938)/-7,-8,-13,-15,-17,11,-82,12,14,-1, - &-3,11,13,15,1,4,3,4,1,3,22,11,-211,2*22,-13,-11,-211,211,111,211, - &-321,130,310,22,2*111,-211,11,-11,13,-13,-211,111,22,14,12,111, - &22,111,3*211,-311,22,211,22,111,-211,211,11,-211,13,22,-211,111, - &-211,22,111,-11,-211,111,2*-211,-321,130,310,221,111,-211,111, - &2*0,-211,111,22,-211,111,-211,111,-211,211,-213,113,223,221,14, - &111,211,111,-11,-13,211,111,22,211,111,211,111,2*211,213,113,223, - &221,22,-211,111,113,223,22,111,-321,310,211,111,2*-211,221,22, - &-11,-13,-211,-321,130,310,221,-211,111,11*12,11*14,2*211,2*213, - &211,20213,2*321,2*323,211,213,211,213,211,213,211,213,211,213, - &211,213,3*211,213,211,2*321,8*211,2*113,3*211,111,22,211,111,211, - &111,4*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213, - &211,2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310, - &211,-211,4*211,321,4*211,113,2*211,-321,111,22,-211,111,-211,111, - &-211,211,-211,211,16,5*12,5*14,3*211,3*213,211,2*111,2*113, - &2*-311,2*-313,-2112,3*321,323,2*-1,22,111,321,311,321,311,-82, - &-11,-13,-82,22,-82,6*-11,6*-13,2*-15,211,213,20213,211,213,20213, - &431,433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,22, - &-211,111,-211,111,-211,211,-211,211,6*-11,6*-13,2*-15,211,213, - &20213,211,213,20213,431,433,431,433,321,323,321,323,321,323,-1/ - DATA (KFDP(I,2),I= 939,1352)/-4,-3,-4,-1,-3,22,211,111,211,111, - &4*211,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,433,431, - &433,221,331,333,221,331,333,221,331,333,-1,-4,-3,-4,-1,-3,22, - &-321,-311,-321,-311,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,-4,-3, - &-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,411,421,411,421,21, - &-11,-13,-15,-1,-2,-3,-4,2*21,22,21,2*-211,111,22,111,211,22,211, - &-211,11,2*-211,111,-211,111,22,11,22,111,-211,211,111,211,22,211, - &111,211,-211,22,11,13,11,-211,2*111,2*22,111,211,-321,-211,111, - &11,2*-211,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,211, - &213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,-211, - &-213,111,221,331,113,223,333,10221,111,221,331,113,223,211,213, - &211,213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203, - &3201,3203,2203,2101,2103,12,14,-1,-3,2*111,2*211,12,14,-1,-3,22, - &111,2*22,111,22,12,14,-1,-3,22,12,14,-1,-3,12,14,-1,-3,12,14,-1, - &-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,2*-211,11,13, - &15,-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3, - &4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,11,13,15,1,4,3,4,1,3,11, - &13,15,1,4,3,4,1,3,4*22,11,13,15,1,4,3,4,1,3,22,11,13,15,1,4,3,4, - &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, - &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3/ - DATA (KFDP(I,2),I=1353,1815)/11,13,15,1,4,3,4,1,3,11,13,15,1,4,3, - &4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4, - &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, - &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3, - &2*111,2*211,-211,111,-321,130,310,-211,111,211,-211,111,-213,113, - &-211,111,223,211,111,213,113,211,111,223,-211,111,-321,130,310, - &2*-211,-311,311,-321,321,211,111,211,111,-211,111,-211,111,311, - &2*321,311,22,2*-82,-211,111,-211,111,211,111,211,111,-321,-311, - &-321,-311,411,421,411,421,22,2*21,-211,2*211,111,-211,111,2*211, - &111,-211,211,111,211,-321,2*-311,-321,22,-211,111,211,111,-311, - &311,-321,321,211,111,-211,111,321,311,22,-82,-211,111,211,111, - &-321,-311,411,421,22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13, - &-15,-1,-2,-3,-4,2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,2*1,3,5, - &1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3, - &-5,2,2*1,4*2,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3, - &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, - &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,2*24,2*37,4,1,3,5,1,3,5,1,3,5,-3, - &2*-5,5,2*6,4*5,2*-24,2*-37,5,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3, - &4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,2*5,4*6,2*24,2*37,6,4,-15, - &16,1,3,5,1,3,5,1,3,5,-3,2*-5,11,2*12,4*11,2*-24,-37,13,15,11,15/ - DATA (KFDP(I,2),I=1816,2317)/11,13,11,13,15,11,13,15,1,3,5,1,3,5, - &1,3,5,12,2*11,4*12,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5, - &13,2*14,4*13,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, - &5,1,3,5,1,3,5,14,2*13,4*14,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3, - &5,1,3,5,15,2*16,4*15,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, - &13,15,1,3,5,1,3,5,1,3,5,16,2*15,4*16,2*24,2*37,11,13,15,11,13,15, - &1,3,5,1,3,5,1,3,5,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5, - &5,-5,5,-6,6,-6,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6, - &1,-1,3,-3,5,-5,1,-1,3,-3,5,-5,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3, - &-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2, - &-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5, - &-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4, - &-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1, - &-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,-1,-3,-13,13,-13,13,-13,13, - &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, - &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, - &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, - &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, - &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3/ - DATA (KFDP(I,2),I=2318,2770)/3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22, - &23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11, - &-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3, - &-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5, - &5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14, - &14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13, - &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, - &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, - &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, - &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, - &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3, - &3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,24,37,24,-11,-13,-15,-1,-3,24, - &-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37, - &2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1, - &-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,16,2*-15,16,-15, - &6*-11,-15,16,2*-15,16,2*-15,16,-15,6*-11,6*-13,-1,-2,-1,2,-1,-2, - &-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5, - &-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, - &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1/ - DATA (KFDP(I,2),I=2771,3221)/2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, - &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1, - &2*4,-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,22,23,25,35,36,22,23,11,13, - &15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4, - &25,35,36,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13, - &-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3, - &-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13, - &-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13, - &13,-13,13,-13,13,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15, - &15,-15,15,-15,15,-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1, - &-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6, - &-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3, - &-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2, - &-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5, - &-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,23,25,35,36, - &22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14, - &16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36, - &-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15, - &-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4, - &-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13/ - DATA (KFDP(I,2),I=3222,3669)/13,-14,14,-14,14,-15,15,-15,15,-16, - &16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11, - &-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3, - &3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2, - &2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5, - &5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4, - &4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1, - &1,-1,1,-3,3,24,37,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11, - &-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11, - &-13,-15,-1,-3,4*37,2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13, - &2*14,2*-15,2*16,-1,-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15, - &16,2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-15,16,2*-15,16, - &2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-13,14,2*-13,14,2*-13, - &14,-13,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3, - &-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2, - &-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5, - &6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4, - &-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,2*4, - &-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,1,2*2,4*1,23,25,35,36,2*-24/ - DATA (KFDP(I,2),I=3670,4136)/2*-37,2*1,3,5,1,3,5,1,3,5,1,2,3,4,5, - &6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,-5,2,2*1,4*2,23,25,35, - &36,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,23,25,35,36, - &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, - &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,23,25,35,36,2*24,2*37,4,1,3,5,1, - &3,5,1,3,5,-3,2*-5,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,1,3,5,1,3, - &5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6, - &2*5,4*6,23,25,35,36,2*24,2*37,6,1,3,5,1,3,5,1,3,5,-3,2*-5,11, - &2*12,4*11,23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, - &13,15,1,3,5,1,3,5,1,3,5,13,2*14,4*13,23,25,35,36,2*-24,2*-37,13, - &15,11,15,11,13,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,15,2*16,4*15, - &23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, - &5,1,3,5,1,3,5,-3,-4,-5,-6,-11,-13,-15,21,-1,-3,2*-5,5,12,14,16, - &-3,-4,-5,-6,-11,-13,-15,21,-5,-6,21,-24,-3000211,-24,-3000211, - &3000111,3000221,3000111,3000221,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12, - &-13,-14,-15,-16,-17,-18,23,3000111,23,3000111,22,3000221,2,4,6,8, - &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,2*3000111,2*3000221,-3000211, - &2*-24,-3000211,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16, - &-17,-18,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6, - &21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,-1/ - DATA (KFDP(I,2),I=4137,8000)/-2,-3,-4,-5,-6,3*21,3*1,4*2,1,2*11, - &2*12,11,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18, - &21,22,23,-24,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-13,2*15,3*-1,3*-3, - &3*-5,3*1,3*3,3*5,2*-11,2*15,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-11, - &2*13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16, - &9900016,2,4,6,2,4,6,2,4,6,9900012,9900014,9900016,-11,-13,-15, - &-13,2*-15,24,-11,-13,-15,-13,2*-15,9900024,3716*0/ - DATA (KFDP(I,3),I= 1,1021)/81*0,14,6*0,2*16,2*0,6*111,310,130, - &2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, - &2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130, - &402*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211, - &-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111, - &211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221, - &3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331, - &113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0, - &111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211, - &111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311, - &-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310, - &-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0, - &111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0, - &3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, - &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, - &111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423, - &-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, - &111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433, - &-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443, - &441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/ - DATA (KFDP(I,3),I=1022,2223)/511,513,511,513,1,2,13*0,2*21,11*0, - &2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112, - &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0, - &4*3,4*0,4*3,6*0,4*3,0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,4*4,1,4,3, - &2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3, - &2*2,0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, - &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, - &3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, - &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, - &3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0, - &-211,111,13*0,2*21,-211,111,199*0,2*5,210*0,-1,-3,-5,-2,-4,-6,-1, - &-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6, - &6,-2,2,-4,4,-6,6,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3, - &-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,-3,3, - &-5,5,-5,5,5*0,11,12,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, - &-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, - &-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ - DATA (KFDP(I,3),I=2224,2783)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3, - &-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14, - &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, - &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,3*0,12,14,16,2,4,0,12,14,16,2, - &4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,12,-11,11,14,-13,13,16, - &-15,15,12,-11,11,14,-13,13,16,-15,15,12,11,14,13,16,15,12,-11,11, - &14,-13,13,16,-15,15,12,11,14,13,16,15,12,11,14,13,16,15,2*2,1,-1, - &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1/ - DATA (KFDP(I,3),I=2784,3354)/2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,3,-3,5,-5,1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,7*0, - &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14, - &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, - &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,-16, - &-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0, - &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16, - &-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3, - &-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ - DATA (KFDP(I,3),I=3355,8000)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,3*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4, - &4*0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4, - &28*0,2,4,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16, - &-15,15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15, - &15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,15, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1, - &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,3,-3,5,-5, - &1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,351*0,-5,169*0,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900014,2*9900016,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900016,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900014,3757*0/ - DATA (KFDP(I,4),I= 1,8000)/94*0,4*111,6*0,111,2*0,-211,0,-211, - &3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113, - &6*111,310,2*130,402*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0, - &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, - &-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111, - &34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321, - &-311,20*0,-3,43*0,6*1,39*0,6*2,42*0,6*3,14*0,8*4,4*0,4*-5,4*0, - &2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81, - &4*0,4*81,6*0,4*81,0,28*81,13*0,6*2101,18*81,4*0,18*81,4*0,9*81,0, - &162*81,31*0,-211,111,6516*0/ - DATA (KFDP(I,5),I= 1,8000)/96*0,2*111,17*0,111,7*0,2*111,0, - &3*111,0,111,597*0,-211,2*111,-211,111,-211,111,65*0,111,-211, - &3*111,-211,111,7193*0/ - -C...PYDAT4, with particle names (character strings). - DATA (CHAF(I,1),I= 1, 100)/'d','u','s','c','b','t','b''','t''', - &2*' ','e-','nu_e','mu-','nu_mu','tau-','nu_tau','tau''-', - &'nu''_tau',2*' ','g','gamma','Z0','W+','h0',6*' ','Z''0','Z"0', - &'W''+','H0','A0','H+',' ','Graviton',' ','R0','LQ_ue',38*' ', - &'specflav','rndmflav','phasespa','c-hadron','b-hadron',2*' ', - &'junction',' ','system','cluster','string','indep.','CMshower', - &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' '/ - DATA (CHAF(I,1),I= 101, 202)/'reggeon','pi0', - &'rho0','a_20','K_L0','pi+','rho+','a_2+','eta','omega','f_2', - &'K_S0','K0','K*0','K*_20','K+','K*+','K*_2+','eta''','phi', - &'f''_2','D+','D*+','D*_2+','D0','D*0','D*_20','D_s+','D*_s+', - &'D*_2s+','eta_c','J/psi','chi_2c','B0','B*0','B*_20','B+','B*+', - &'B*_2+','B_s0','B*_s0','B*_2s0','B_c+','B*_c+','B*_2c+','eta_b', - &'Upsilon','chi_2b','pomeron','dd_1','Delta-','ud_0','ud_1','n0', - &'Delta0','uu_1','p+','Delta+','Delta++','sd_0','sd_1','Sigma-', - &'Sigma*-','Lambda0','su_0','su_1','Sigma0','Sigma*0','Sigma+', - &'Sigma*+','ss_1','Xi-','Xi*-','Xi0','Xi*0','Omega-','cd_0', - &'cd_1','Sigma_c0','Sigma*_c0','Lambda_c+','Xi_c0','cu_0','cu_1', - &'Sigma_c+','Sigma*_c+','Sigma_c++','Sigma*_c++','Xi_c+','cs_0', - &'cs_1','Xi''_c0','Xi*_c0','Xi''_c+','Xi*_c+','Omega_c0', - &'Omega*_c0','cc_1','Xi_cc+','Xi*_cc+','Xi_cc++','Xi*_cc++'/ - DATA (CHAF(I,1),I= 203, 332)/'Omega_cc+','Omega*_cc+', - &'Omega*_ccc++','bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0', - &'Xi_b-','Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+', - &'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-', - &'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0', - &'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0', - &'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-', - &'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-', - &'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+', - &'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1', - &'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c', - &'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+', - &'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1', - &'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0', - &'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L', - &'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL', - &'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+', - &'~chi_30','~chi_40','~chi_2+','~Gravitino','~d_R','~u_R','~s_R', - &'~c_R','~b_2','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR', - &'~tau_2-','~nu_tauR','pi_tc0','pi_tc+','pi''_tc0','eta_tc0'/ - DATA (CHAF(I,1),I= 333, 500)/'rho_tc0','rho_tc+','omega_tc', - &'V8_tc','pi_22_1_tc','pi_22_8_tc','rho_11_tc','rho_12_tc', - &'rho_21_tc','rho_22_tc','d*','u*','e*-','nu*_e0','Graviton*', - &'nu_Re','nu_Rmu','nu_Rtau','Z_R0','W_R+','H_L++','H_R++', - &'rho_diff0','pi_diffr+','omega_di','phi_diff','J/psi_di', - &'n_diffr0','p_diffr+',139*' '/ - DATA (CHAF(I,2),I= 1, 205)/'dbar','ubar','sbar','cbar','bbar', - &'tbar','b''bar','t''bar',2*' ','e+','nu_ebar','mu+','nu_mubar', - &'tau+','nu_taubar','tau''+','nu''_taubar',5*' ','W-',9*' ', - &'W''-',2*' ','H-',3*' ','Rbar0','LQ_uebar',39*' ','rndmflavbar', - &' ','c-hadronbar','b-hadronbar',20*' ','pi-','rho-','a_2-',4*' ', - &'Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-',3*' ','D-','D*-', - &'D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-','D*_s-','D*_2s-', - &3*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-','B*_2-','B_sbar0', - &'B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-',4*' ','dd_1bar', - &'Deltabar+','ud_0bar','ud_1bar','nbar0','Deltabar0','uu_1bar', - &'pbar-','Deltabar-','Deltabar--','sd_0bar','sd_1bar','Sigmabar+', - &'Sigma*bar+','Lambdabar0','su_0bar','su_1bar','Sigmabar0', - &'Sigma*bar0','Sigmabar-','Sigma*bar-','ss_1bar','Xibar+', - &'Xi*bar+','Xibar0','Xi*bar0','Omegabar+','cd_0bar','cd_1bar', - &'Sigma_cbar0','Sigma*_cbar0','Lambda_cbar-','Xi_cbar0','cu_0bar', - &'cu_1bar','Sigma_cbar-','Sigma*_cbar-','Sigma_cbar--', - &'Sigma*_cbar--','Xi_cbar-','cs_0bar','cs_1bar','Xi''_cbar0', - &'Xi*_cbar0','Xi''_cbar-','Xi*_cbar-','Omega_cbar0', - &'Omega*_cbar0','cc_1bar','Xi_ccbar-','Xi*_ccbar-','Xi_ccbar--', - &'Xi*_ccbar--','Omega_ccbar-','Omega*_ccbar-','Omega*_cccbar-'/ - DATA (CHAF(I,2),I= 206, 325)/'bd_0bar','bd_1bar','Sigma_bbar+', - &'Sigma*_bbar+','Lambda_bbar0','Xi_bbar+','Xi_bcbar0','bu_0bar', - &'bu_1bar','Sigma_bbar0','Sigma*_bbar0','Sigma_bbar-', - &'Sigma*_bbar-','Xi_bbar0','Xi_bcbar-','bs_0bar','bs_1bar', - &'Xi''_bbar+','Xi*_bbar+','Xi''_bbar0','Xi*_bbar0','Omega_bbar+', - &'Omega*_bbar+','Omega_bcbar0','bc_0bar','bc_1bar','Xi''_bcbar0', - &'Xi*_bcbar0','Xi''_bcbar-','Xi*_bcbar-','Omega''_bcba', - &'Omega*_bcbar0','Omega_bccbar-','Omega*_bccbar-','bb_1bar', - &'Xi_bbbar+','Xi*_bbbar+','Xi_bbbar0','Xi*_bbbar0','Omega_bbbar+', - &'Omega*_bbbar+','Omega_bbcbar0','Omega*_bbcbar0', - &'Omega*_bbbbar+',2*' ','a_0-','b_1-',2*' ','K*_0bar0','K_1bar0', - &'K*_0-','K_1-',2*' ','D*_0-','D_1-','D*_0bar0','D_1bar0', - &'D*_0s-','D_1s-',2*' ','B*_0bar0','B_1bar0','B*_0-','B_1-', - &'B*_0sbar0','B_1sbar0','B*_0c-','B_1c-',3*' ','a_1-',' ', - &'K*_1bar0','K*_1-',' ','D*_1-','D*_1bar0','D*_1s-',' ', - &'B*_1bar0','B*_1-','B*_1sbar0','B*_1c-',3*' ','~d_Lbar', - &'~u_Lbar','~s_Lbar','~c_Lbar','~b_1bar','~t_1bar','~e_L+', - &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ', - &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar', - &'~c_Rbar','~b_2bar','~t_2bar','~e_R+','~nu_eRbar','~mu_R+'/ - DATA (CHAF(I,2),I= 326, 500)/'~nu_muRbar','~tau_2+', - &'~nu_tauRbar',' ','pi_tc-',3*' ','rho_tc-',8*' ','d*bar','u*bar', - &'e*bar+','nu*_ebar0',5*' ','W_R-','H_L--','H_R--',' ', - &'pi_diffr-',3*' ','n_diffrbar0','p_diffrbar-',139*' '/ - -C...PYDATR, with initial values for the random number generator. - DATA MRPY/19780503,0,0,97,33,0/ - -C...Default values for allowed processes and kinematics constraints. - DATA MSEL/1/ - DATA MSUB/500*0/ - DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0, - &5*1,5*0,6*1,4*0,4*1,16*0,16*0,4*1,4*0,6*1,5*0,5*1,0,5*1,5*0, - &6*1,4*0,4*1,16*0/ - DATA CKIN/ - & 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0, - & 1.0D0, -10D0, 10D0, -40D0, 40D0, - 1 -40D0, 40D0, -40D0, 40D0, -40D0, - 1 40D0, -1.0D0, 1.0D0, -1.0D0, 1.0D0, - 2 0.0D0, 1.0D0, 0.0D0, 1.0D0, -1.0D0, - 2 1.0D0, -1.0D0, 1.0D0, 0D0, 0D0, - 3 2.0D0, -1.0D0, 0D0, 0D0, 0.0D0, - 3 -1.0D0, 0.0D0, -1.0D0, 4.0D0, -1.0D0, - 4 12.0D0, -1.0D0, 12.0D0, -1.0D0, 12.0D0, - 4 -1.0D0, 12.0D0, -1.0D0, 0D0, 0D0, - 5 0.0D0, -1.0D0, 0.0D0, -1.0D0, 0.0D0, - 5 -1.0D0, 0D0, 0D0, 0D0, 0D0, - 6 0.0001D0, 0.99D0, 0.0001D0, 0.99D0, 0D0, - 6 -1D0, 0D0, -1D0, 0D0, -1D0, - 7 0D0, -1D0, 0.0001D0, 0.99D0, 0.0001D0, - 7 0.99D0, 2D0, -1D0, 0D0, 0D0, - 8 120*0D0/ - -C...Default values for main switches and parameters. Reset information. - DATA (MSTP(I),I=1,100)/ - & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, - 1 1, 0, 1, 30, 0, 1, 4, 3, 4, 3, - 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, - 3 1, 8, 0, 1, 0, 2, 1, 5, 2, 0, - 4 2, 1, 3, 7, 3, 1, 1, 0, 1, 0, - 5 7, 1, 3, 1, 5, 1, 1, 5, 1, 7, - 6 2, 3, 2, 2, 1, 5, 2, 1, 0, 0, - 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8 1, 1, 100, 0, 0, 2, 0, 0, 0, 0, - 9 1, 3, 1, 3, 0, 0, 0, 0, 0, 0/ - DATA (MSTP(I),I=101,200)/ - & 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, - 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, - 2 0, 1, 2, 1, 1, 100, 0, 0, 10, 0, - 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, - 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, - 8 6, 225, 2004, 07, 01, 0, 0, 0, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA (PARP(I),I=1,100)/ - & 0.25D0, 10D0, 8*0D0, - 1 0D0, 0D0, 1.0D0, 0.01D0, 0.5D0, 1.0D0, 1.0D0, 0.4D0, 2*0D0, - 2 10*0D0, - 3 1.5D0,2.0D0,0.075D0,1.0D0,0.2D0,0D0,1.0D0,0.70D0,0.006D0,0D0, - 4 0.02D0,2.0D0,0.10D0,1000D0,2054D0,123D0,246D0,50D0,0D0,0.054D0, - 5 10*0D0, - 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 1.0D0,1D-3,2*0D0, - 7 4.0D0, 0.25D0, 8*0D0, - 8 1.90D0, 1.90D0, 0.5D0, 0.2D0, 0.33D0, - 8 0.66D0, 0.7D0, 0.5D0, 1000D0, 0.16D0, - 9 1.0D0,0.40D0,5.0D0,1.0D0,0D0,3.0D0,1.0D0,0.75D0,1.0D0,5.0D0/ - DATA (PARP(I),I=101,200)/ - & 0.5D0, 0.28D0, 1.0D0, 0.8D0, 0D0, 0D0, 0D0, 0D0, 0D0, 1D0, - 1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0, - 2 1.0D0, 0.4D0, 8*0D0, - 3 0.01D0, 9*0D0, - 4 10*0D0, - 5 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 0.5D0, 0D0, 0D0, 0D0, 2*0D0, - 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0, - 8 0.1D0, 0.01D0, 0.01D0, 0.01D0, 0.1D0, 0.01D0, 0.01D0, 0.01D0, - 8 0.3D0, 0.64D0, - 9 0.64D0, 5.0D0, 8*0D0/ - DATA MSTI/200*0/ - DATA PARI/200*0D0/ - DATA MINT/400*0/ - DATA VINT/400*0D0/ - -C...Constants for the generation of the various processes. - DATA (ISET(I),I=1,100)/ - & 1, 1, 1, -1, 3, -1, -1, 3, -2, 2, - 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2, - 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2, - 3 2, 2, 2, 2, 2, 2, -1, -1, -1, -1, - 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 5 -1, -1, 2, 2, -1, -1, -1, 2, -1, -1, - 6 -1, -1, -1, -1, -1, -1, -1, 2, 2, 2, - 7 4, 4, 4, -1, -1, 4, 4, -1, -1, 2, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, - 9 0, 0, 0, 0, 0, 9, -2, -2, 8, -2/ - DATA (ISET(I),I=101,200)/ - & -1, 1, 1, 1, 1, 2, 2, 2, -2, 2, - 1 2, 2, 2, 2, 2, -1, -1, -1, -2, -2, - 2 5, 5, 5, 5, -2, -2, -2, -2, -2, -2, - 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 4 1, 1, 1, 1, 1, 1, 1, 1, 1, -2, - 5 1, 1, 1, -2, -2, 1, 1, 1, -2, -2, - 6 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, - 7 2, 2, 5, 5, -2, 2, 2, 5, 5, -2, - 8 5, 5, 2, 2, 2, 5, 5, 2, 2, 2, - 9 1, 1, 1, 2, 2, -2, -2, -2, -2, -2/ - DATA (ISET(I),I=201,300)/ - & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2, - 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2, - 5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2, - 6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1, - 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 9 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/ - DATA (ISET(I),I=301,500)/ - & 2, 39*-2, - 4 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, - 5 5, 5, 1, 1, -1, -1, -1, -1, -1, -1, - 6 2, 2, 2, 2, 2, 2, 2, 2, -1, 2, - 7 2, 2, 2, 2, 2, 2, 2, -1, -1, -1, - 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2, - 9 1, 1, 2, 2, 2, 5*-2, - & 5, 5, 98*-2/ - DATA ((KFPR(I,J),J=1,2),I=1,50)/ - & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0, - & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0, - 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23, - 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24, - 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24, - 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23, - 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/ - DATA ((KFPR(I,J),J=1,2),I=51,100)/ - 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 21, 21, 24, 24, 23, 24, - 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22, - 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 211, - 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8 443, 21,10441, 21,20443, 21, 445, 21, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=101,150)/ - & 23, 0, 25, 0, 25, 0,10441, 0, 445, 0, - & 443, 22, 443, 21, 443, 22, 0, 0, 22, 25, - 1 21, 25, 0, 25, 21, 25, 22, 22, 21, 22, - 1 22, 23, 23, 23, 24, 24, 0, 0, 0, 0, - 2 25, 6, 25, 6, 25, 0, 25, 0, 0, 0, - 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3 0, 21, 0, 21, 0, 22, 0, 22, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 32, 0, 34, 0, 37, 0, 41, 0, 42, 0, - 4 4000011, 0, 4000001, 0, 4000002, 0, 3000331, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=151,200)/ - 5 35, 0, 35, 0, 35, 0, 0, 0, 0, 0, - 5 36, 0, 36, 0, 36, 0, 0, 0, 0, 0, - 6 6, 37, 42, 0, 42, 42, 42, 42, 11, 0, - 6 11, 0, 0, 4000001, 0, 4000002, 0, 4000011, 0, 0, - 7 23, 35, 24, 35, 35, 0, 35, 0, 0, 0, - 7 23, 36, 24, 36, 36, 0, 36, 0, 0, 0, - 8 35, 6, 35, 6, 21, 35, 0, 35, 21, 35, - 8 36, 6, 36, 6, 21, 36, 0, 36, 21, 36, - 9 3000113, 0, 3000213, 0, 3000223, 0, 11, 0, 11, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=201,240)/ - & 1000011, 1000011, 2000011, 2000011, 1000011, - & 2000011, 1000013, 1000013, 2000013, 2000013, - & 1000013, 2000013, 1000015, 1000015, 2000015, - & 2000015, 1000015, 2000015, 1000011, 1000012, - 1 1000015, 1000016, 2000015, 1000016, 1000012, - 1 1000012, 1000016, 1000016, 0, 0, - 1 1000022, 1000022, 1000023, 1000023, 1000025, - 1 1000025, 1000035, 1000035, 1000022, 1000023, - 2 1000022, 1000025, 1000022, 1000035, 1000023, - 2 1000025, 1000023, 1000035, 1000025, 1000035, - 2 1000024, 1000024, 1000037, 1000037, 1000024, - 2 1000037, 1000022, 1000024, 1000023, 1000024, - 3 1000025, 1000024, 1000035, 1000024, 1000022, - 3 1000037, 1000023, 1000037, 1000025, 1000037, - 3 1000035, 1000037, 1000021, 1000022, 1000021, - 3 1000023, 1000021, 1000025, 1000021, 1000035/ - DATA ((KFPR(I,J),J=1,2),I=241,280)/ - 4 1000021, 1000024, 1000021, 1000037, 1000021, - 4 1000021, 1000021, 1000021, 0, 0, - 4 1000002, 1000022, 2000002, 1000022, 1000002, - 4 1000023, 2000002, 1000023, 1000002, 1000025, - 5 2000002, 1000025, 1000002, 1000035, 2000002, - 5 1000035, 1000001, 1000024, 2000005, 1000024, - 5 1000001, 1000037, 2000005, 1000037, 1000002, - 5 1000021, 2000002, 1000021, 0, 0, - 6 1000006, 1000006, 2000006, 2000006, 1000006, - 6 2000006, 1000006, 1000006, 2000006, 2000006, - 6 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, - 7 1000002, 1000002, 2000002, 2000002, 1000002, - 7 2000002, 1000002, 1000002, 2000002, 2000002, - 7 1000002, 2000002, 1000002, 1000002, 2000002, - 7 2000002, 1000002, 1000002, 2000002, 2000002/ - DATA ((KFPR(I,J),J=1,2),I=281,350)/ - 8 1000005, 1000002, 2000005, 2000002, 1000005, - 8 2000002, 1000005, 1000002, 2000005, 2000002, - 8 1000005, 2000002, 1000005, 1000005, 2000005, - 8 2000005, 1000005, 1000005, 2000005, 2000005, - 9 1000005, 1000005, 2000005, 2000005, 1000005, - 9 2000005, 1000005, 1000021, 2000005, 1000021, - 9 1000005, 2000005, 37, 25, 37, - 9 35, 36, 25, 36, 35, - & 37, 37, 78*0, - 4 9900041, 0, 9900042, 0, 9900041, - 4 11, 9900042, 11, 9900041, 13, - 4 9900042, 13, 9900041, 15, 9900042, - 4 15, 9900041, 9900041, 9900042, 9900042/ - DATA ((KFPR(I,J),J=1,2),I=351,500)/ - 5 9900041, 0, 9900042, 0, 9900023, - 5 0, 9900024, 0, 0, 0, - 5 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, - 6 24, 24, 24, 3000211, 3000211, - 6 3000211, 22, 3000111, 22, 3000221, - 6 23, 3000111, 23, 3000221, 24, - 6 3000211, 0, 0, 24, 23, - 7 24, 3000111, 3000211, 23, 3000211, - 7 3000111, 22, 3000211, 23, 3000211, - 7 24, 3000111, 24, 3000221, 0, - 7 0, 0, 0, 0, 0, - 8 0, 0, 0, 0, 21, 21, 0, 21, 0, 0, - 8 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, - 9 5000039, 0, 5000039, 0, 21, - 9 5000039, 0, 5000039, 21, 5000039, - 9 10*0, - & 37, 6, 37, 6, 196*0/ - DATA COEF/10000*0D0/ - DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ - &4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2, - &3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2, - &3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1, - &3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0, - &4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3, - &2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2, - &4,0,0,0,4,0,1,3,0,0,3,0,2,4,3,0,3,4,0,0,1,0,0,1,0,0,3,4,2,0,0,2, - &3,0,0,0,1,0,0,0,0,0,3,0,2,0,0,0,2,0,3,1,2,0,0,0,3,2,1,0,1,0,0,0, - &4,4,3,3,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ - -C...Treatment of resonances. - DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,1,5*0,3*1,6*0,1,0,4*1, - &3*0,2*1,254*0,19*2,0,7*2,0,2,0,2,0,26*1,146*0/ - -C...Character constants: name of processes. - DATA PROC(0)/ 'All included subprocesses '/ - DATA (PROC(I),I=1,20)/ - &'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ', - &'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ', - &'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ', - &' ', 'W+ + W- -> h0 ', - &' ', 'f + f'' -> f + f'' (QFD) ', - 1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ', - 1'f + fbar -> g + g ', 'f + fbar -> g + gamma ', - 1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ', - 1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ', - 1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/ - DATA (PROC(I),I=21,40)/ - 2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ', - 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ', - 2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ', - 2'f + fbar -> h0 + h0 ', 'f + g -> f + g ', - 2'f + g -> f + gamma ', 'f + g -> f + Z0 ', - 3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ', - 3'f + gamma -> f + g ', 'f + gamma -> f + gamma ', - 3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', - 3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ', - 3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ - DATA (PROC(I),I=41,60)/ - 4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ', - 4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', - 4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', - 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ', - 4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ', - 5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ', - 5'g + g -> f + fbar ', 'g + gamma -> f + fbar ', - 5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ', - 5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ', - 5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/ - DATA (PROC(I),I=61,80)/ - 6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ', - 6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ', - 6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ', - 6'h0 + h0 -> f + fbar ', 'g + g -> g + g ', - 6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ', - 7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', - 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ', - 7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', - 7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ', - 7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/ - DATA (PROC(I),I=81,100)/ - 8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ', - 8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ', - 8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ', - 8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ', - 8'g + g -> chi_2c + g ', ' ', - 9'Elastic scattering ', 'Single diffractive (XB) ', - 9'Single diffractive (AX) ', 'Double diffractive ', - 9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', - 9' ', ' ', - 9'q + gamma* -> q ', ' '/ - DATA (PROC(I),I=101,120)/ - &'g + g -> gamma*/Z0 ', 'g + g -> h0 ', - &'gamma + gamma -> h0 ', 'g + g -> chi_0c ', - &'g + g -> chi_2c ', 'g + g -> J/Psi + gamma ', - &'gamma + g -> J/Psi + g ', 'gamma+gamma -> J/Psi + gamma', - &' ', 'f + fbar -> gamma + h0 ', - 1'q + qbar -> g + h0 ', 'q + g -> q + h0 ', - 1'g + g -> g + h0 ', 'g + g -> gamma + gamma ', - 1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ', - 1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ', - 1' ', ' '/ - DATA (PROC(I),I=121,140)/ - 2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ', - 2'f + f'' -> f + f'' + h0 ', - 2'f + f'' -> f" + f"'' + h0 ', - 2' ', ' ', - 2' ', ' ', - 2' ', ' ', - 3'f + gamma*_T -> f + g ', 'f + gamma*_L -> f + g ', - 3'f + gamma*_T -> f + gamma ', 'f + gamma*_L -> f + gamma ', - 3'g + gamma*_T -> f + fbar ', 'g + gamma*_L -> f + fbar ', - 3'gamma*_T+gamma*_T -> f+fbar ', 'gamma*_T+gamma*_L -> f+fbar ', - 3'gamma*_L+gamma*_T -> f+fbar ', 'gamma*_L+gamma*_L -> f+fbar '/ - DATA (PROC(I),I=141,160)/ - 4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ', - 4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ', - 4'q + l -> LQ ', 'e + gamma -> e* ', - 4'd + g -> d* ', 'u + g -> u* ', - 4'g + g -> eta_tc ', ' ', - 5'f + fbar -> H0 ', 'g + g -> H0 ', - 5'gamma + gamma -> H0 ', ' ', - 5' ', 'f + fbar -> A0 ', - 5'g + g -> A0 ', 'gamma + gamma -> A0 ', - 5' ', ' '/ - DATA (PROC(I),I=161,180)/ - 6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ', - 6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ', - 6'f + fbar -> f'' + fbar'' (g/Z)', - 6'f +fbar'' -> f" + fbar"'' (W) ', - 6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ', - 6'q + qbar -> e + e* ', ' ', - 7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ', - 7'f + f'' -> f + f'' + H0 ', - 7'f + f'' -> f" + f"'' + H0 ', - 7' ', 'f + fbar -> Z0 + A0 ', - 7'f + fbar'' -> W+/- + A0 ', - 7'f + f'' -> f + f'' + A0 ', - 7'f + f'' -> f" + f"'' + A0 ', - 7' '/ - DATA (PROC(I),I=181,200)/ - 8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ', - 8'q + qbar -> g + H0 ', 'q + g -> q + H0 ', - 8'g + g -> g + H0 ', 'g + g -> Q + Qbar + A0 ', - 8'q + qbar -> Q + Qbar + A0 ', 'q + qbar -> g + A0 ', - 8'q + g -> q + A0 ', 'g + g -> g + A0 ', - 9'f + fbar -> rho_tc0 ', 'f + f'' -> rho_tc+/- ', - 9'f + fbar -> omega_tc0 ', 'f+fbar -> f''+fbar'' (ETC) ', - 9'f+fbar'' -> f"+fbar"'' (ETC)',' ', - 9' ', ' ', - 9' ', ' '/ - DATA (PROC(I),I=201,220)/ - &'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ', - &'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar', - &'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar', - &'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar', - &'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ', - 1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar', - 1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar', - 1' ', 'f + fbar -> ~chi1 + ~chi1 ', - 1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ', - 1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/ - DATA (PROC(I),I=221,240)/ - 2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ', - 2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ', - 2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ', - 2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ', - 2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1', - 3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1', - 3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2', - 3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2', - 3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ', - 3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/ - DATA (PROC(I),I=241,260)/ - 4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ', - 4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ', - 4' ', 'qj + g -> ~qj_L + ~chi1 ', - 4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ', - 4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ', - 5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ', - 5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ', - 5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ', - 5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ', - 5'qj + g -> ~qj_R + ~g ', ' '/ - DATA (PROC(I),I=261,300)/ - 6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ', - 6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ', - 6'g + g -> ~t_2 + ~t_2bar ', ' ', - 6' ', ' ', - 6' ', ' ', - 7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ', - 7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar', - 7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar', - 7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar', - 7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar ', - 8'b + qj -> ~b_1 + ~qj_L ', 'b + qj -> ~b_2 + ~qj_R ', - 8'b + qj -> ~b_1 + ~qj_R ', 'b + qjbar -> ~b_1 + ~qj_Lbar', - 8'b + qjbar -> ~b_2 + ~qj_Rbar', 'b + qjbar -> ~b_1 + ~qj_Rbar', - 8'f + fbar -> ~b_1 + ~b_1bar ', 'f + fbar -> ~b_2 + ~b_2bar ', - 8'g + g -> ~b_1 + ~b_1bar ', 'g + g -> ~b_2 + ~b_2bar ', - 9'b + b -> ~b_1 + ~b_1 ', 'b + b -> ~b_2 + ~b_2 ', - 9'b + b -> ~b_1 + ~b_2 ', 'b + g -> ~b_1 + ~g ', - 9'b + g -> ~b_2 + ~g ', 'b + bbar -> ~b_1 + ~b_2bar ', - 9'f + fbar'' -> H+/- + h0 ', 'f + fbar -> H+/- + H0 ', - 9'f + fbar -> A0 + h0 ', 'f + fbar -> A0 + H0 '/ - DATA (PROC(I),I=301,340)/ - &'f + fbar -> H+ + H- ', 39*' '/ - DATA (PROC(I),I=341,380)/ - 4'l + l -> H_L++/-- ', 'l + l -> H_R++/-- ', - 4'l + gamma -> H_L++/-- e-/+ ', 'l + gamma -> H_R++/-- e-/+ ', - 4'l + gamma -> H_L++/-- mu-/+ ', 'l + gamma -> H_R++/-- mu-/+ ', - 4'l + gamma -> H_L++/-- tau-/+', 'l + gamma -> H_R++/-- tau-/+', - 4'f + fbar -> H_L++ + H_L-- ', 'f + fbar -> H_R++ + H_R-- ', - 5'f + f -> f'' + f'' + H_L++/-- ', - 5'f + f -> f'' + f'' + H_R++/-- ','f + fbar -> Z_R0 ', - 5'f + fbar'' -> W_R+/- ',5*' ', - 6' ', 'f + fbar -> W_L+ W_L- ', - 6'f + fbar -> W_L+/- pi_T-/+ ', 'f + fbar -> pi_T+ pi_T- ', - 6'f + fbar -> gamma pi_T0 ', 'f + fbar -> gamma pi_T0'' ', - 6'f + fbar -> Z0 pi_T0 ', 'f + fbar -> Z0 pi_T0'' ', - 6'f + fbar -> W+/- pi_T-/+ ', ' ', - 7'f + fbar'' -> W_L+/- Z_L0 ', 'f + fbar'' -> W_L+/- pi_T0 ', - 7'f + fbar'' -> pi_T+/- Z_L0 ', 'f + fbar'' -> pi_T+/- pi_T0 ', - 7'f + fbar'' -> gamma pi_T+/- ', 'f + fbar'' -> Z0 pi_T+/- ', - 7'f + fbar'' -> W+/- pi_T0 ', - 7'f + fbar'' -> W+/- pi_T0'' ', - 7' ', ' ', - 7' '/ - DATA (PROC(I),I=381,500)/ - 8'f + f'' -> f + f'' (ETC) ','f + fbar -> f'' + fbar'' (ETC)', - 8'f + fbar -> g + g (ETC) ', 'f + g -> f + g (ETC) ', - 8'g + g -> f + fbar (ETC) ', 'g + g -> g + g (ETC) ', - 8'q + qbar -> Q + Qbar (ETC) ', 'g + g -> Q + Qbar (ETC) ', - 8' ', ' ', - 9'f + fbar -> G* ', 'g + g -> G* ', - 9'q + qbar -> g + G* ', 'q + g -> q + G* ', - 9'g + g -> g + G* ', ' ', - 9 4*' ', - &'g + g -> t + b + H+/- ', 'q + qbar -> t + b + H+/- ', - & 98*' '/ - -C...Cross sections and slope offsets. - DATA SIGT/294*0D0/ - -C...Supersymmetry switches and parameters. - DATA IMSS/0, - & 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, - 1 89*0/ - DATA RMSS/0D0, - & 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0, - 1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0, - 2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,0D0,24D17,0D0, - 3 69*0D0/ -C...Initial values for R-violating SUSY couplings. -C...Should not be changed here. See PYMSIN. - DATA RVLAM/27*0D0/ - DATA RVLAMP/27*0D0/ - DATA RVLAMB/27*0D0/ - -C...Technicolor switches and parameters - DATA ITCM/0, - & 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 89*0/ - DATA RTCM/0D0, - & 82D0,1.333D0,.333D0,0.408D0,1D0,1D0,.0182D0,1D0,0D0,1.333D0, - 1 .05D0,200D0,200D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, - 2 .283D0,.707D0,0D0,0D0,0D0,1.667D0,250D0,250D0,.707D0,0D0, - 3 .707D0,0D0,1D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, - 4 1000D0, 1D0, 1D0, 1D0, 1D0, 0D0, 4*0D0, - 4 49*0D0/ - -C...Data for histogramming routines. - DATA IHIST/1000,20000,55,1/ - DATA INDX/1000*0/ - - END - - -C********************************************************************* - -C...PYDCYK -C...Handles flavour production in the decay of unstable particles -C...and small string clusters. - - SUBROUTINE PYDCYK(KFL1,KFL2,KFL3,KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - -C.. Call PYKFDI directly if no popcorn option is on - IF(MSTJ(12).LT.2) THEN - CALL PYKFDI(KFL1,KFL2,KFL3,KF) - MSTU(124)=KFL3 - RETURN - ENDIF - - KFL3=0 - KF=0 - IF(KFL1.EQ.0) RETURN - KF1A=IABS(KFL1) - KF2A=IABS(KFL2) - - NSTO=130 - NMAX=MIN(MSTU(125),10) - -C.. Identify rank 0 cluster qq - IRANK=1 - IF(KF1A.GT.10.AND.KF1A.LT.10000) IRANK=0 - - IF(KF2A.GT.0)THEN -C.. Join jets: Fails if store not empty - IF(MSTU(121).GT.0) THEN - MSTU(121)=0 - RETURN - ENDIF - CALL PYKFDI(KFL1,KFL2,KFL3,KF) - ELSEIF(KF1A.GT.10.AND.MSTU(121).GT.0)THEN -C.. Pick popcorn meson from store, return same qq, decrease store - KF=MSTU(NSTO+MSTU(121)) - KFL3=-KFL1 - MSTU(121)=MSTU(121)-1 - ELSE -C.. Generate new flavour. Then done if no diquark is generated - 100 CALL PYKFDI(KFL1,0,KFL3,KF) - IF(MSTU(121).EQ.-1) GOTO 100 - MSTU(124)=KFL3 - IF(KF.EQ.0.OR.IABS(KFL3).LE.10) RETURN - -C.. Simple case if no dynamical popcorn suppressions are considered - IF(MSTJ(12).LT.4) THEN - IF(MSTU(121).EQ.0) RETURN - NMES=1 - KFPREV=-KFL3 - CALL PYKFDI(KFPREV,0,KFL3,KFM) -C.. Due to eta+eta' suppr., a qq->M+qq attempt might end as qq->B+q - IF(IABS(KFL3).LE.10)THEN - KFL3=-KFPREV - RETURN - ENDIF - GOTO 120 - ENDIF - -C test output qq against fake Gamma, then return if no popcorn. - GB=2D0 - IF(IRANK.NE.0)THEN - CALL PYZDIS(1,2103,5D0,Z) - GB=5D0*(1D0-Z)/Z - IF(1D0-PARF(192)**GB.LT.PYR(0)) THEN - MSTU(121)=0 - GOTO 100 - ENDIF - ENDIF - IF(MSTU(121).EQ.0) RETURN - -C..Set store size memory. Pick fake dynamical variables of qq. - NMES=MSTU(121) - CALL PYPTDI(1,PX3,PY3) - X=1D0 - POPM=0D0 - G=GB - POPG=GB - -C.. Pick next popcorn meson, test with fake dynamical variables - 110 KFPREV=-KFL3 - PX1=-PX3 - PY1=-PY3 - CALL PYKFDI(KFPREV,0,KFL3,KFM) - IF(MSTU(121).EQ.-1) GOTO 100 - CALL PYPTDI(KFL3,PX3,PY3) - PM=PYMASS(KFM)**2+(PX1+PX3)**2+(PY1+PY3)**2 - CALL PYZDIS(KFPREV,KFL3,PM,Z) - G=(1D0-Z)*(G+PM/Z) - X=(1D0-Z)*X - - PTST=1D0 - GTST=1D0 - RTST=PYR(0) - IF(MSTJ(12).GT.4)THEN - POPMN=SQRT((1D0-X)*(G/X-GB)) - POPM=POPM+PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PTST=EXP((POPM-POPMN)*PARF(193)) - POPM=POPMN - ENDIF - IF(IRANK.NE.0)THEN - POPGN=X*GB - GTST=(1D0-PARF(192)**POPGN)/(1D0-PARF(192)**POPG) - POPG=POPGN - ENDIF - IF(RTST.GT.PTST*GTST)THEN - MSTU(121)=0 - IF(RTST.GT.PTST) MSTU(121)=-1 - GOTO 100 - ENDIF - -C.. Store meson - 120 IF(NMES.LE.NMAX) MSTU(NSTO+MSTU(121)+1)=KFM - IF(MSTU(121).GT.0) GOTO 110 - -C.. Test accepted system size. If OK set global popcorn size variable. - IF(NMES.GT.NMAX)THEN - KF=0 - KFL3=0 - RETURN - ENDIF - MSTU(121)=NMES - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDECY -C...Handles the decay of unstable particles. - - SUBROUTINE PYDECY(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays. - DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), - &WTCOR(10),PTAU(4),PCMTAU(4),DBETAU(3) - CHARACTER CIDC*4 - DATA WTCOR/2D0,5D0,15D0,60D0,250D0,1500D0,1.2D4,1.2D5,150D0,16D0/ - -C...Functions: momentum in two-particle decays and four-product. - PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2D0*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) - -C...Initial values. - NTRY=0 - NSAV=N - KFA=IABS(K(IP,2)) - KFS=ISIGN(1,K(IP,2)) - KC=PYCOMP(KFA) - MSTJ(92)=0 - -C...Choose lifetime and determine decay vertex. - IF(K(IP,1).EQ.5) THEN - V(IP,5)=0D0 - ELSEIF(K(IP,1).NE.4) THEN - V(IP,5)=-PMAS(KC,4)*LOG(PYR(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.1D-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 PYROBO(ITAU,ITAU,0D0,0D0,-DBETAU(1), - & -DBETAU(2),-DBETAU(3)) - PHITAU=PYANGL(P(ITAU,1),P(ITAU,2)) - CALL PYROBO(ITAU,ITAU,0D0,-PHITAU,0D0,0D0,0D0) - THETAU=PYANGL(P(ITAU,3),P(ITAU,1)) - CALL PYROBO(ITAU,ITAU,-THETAU,0D0,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 PYTAUD(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 PYROBO(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) - IF(KFORIG.NE.0) CALL PYROBO(NSAV+1,N,0D0,0D0,DBETAU(1), - & DBETAU(2),DBETAU(3)) - -C...Skip past ordinary tau decay treatment. - MMAT=0 - MBST=0 - ND=0 - GOTO 630 - ENDIF - ENDIF - -C...B-Bbar 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.5D0*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.PYR(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 PYERRM(9,'(PYDECY:) no decay channel defined') - RETURN - ENDIF - IF(MOD(KFA/1000,10).EQ.0.AND.KCA.EQ.85) KFS=-KFS - IF(KCHG(KC,3).EQ.0) THEN - KFSP=1 - KFSN=0 - IF(PYR(0).GT.0.5D0) 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=0D0 - 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 PYERRM(2,'(PYDECY:) all decay channels closed by user') - RETURN - ENDIF - -C...Select decay channel among allowed ones. - 240 RBR=BRSU*PYR(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.0D0) GOTO 250 - ENDIF - -C...Start readout of decay channel: matrix element, reset counters. - MMAT=MDME(IDC,2) - 260 NTRY=NTRY+1 - IF(MOD(NTRY,200).EQ.0) THEN - WRITE(CIDC,'(I4)') IDC -C...Do not print warning for some well-known special cases. - IF(KFA.NE.113.AND.KFA.NE.115.AND.KFA.NE.215) - & CALL PYERRM(4,'(PYDECY:) caught in loop for decay channel'// - & CIDC) - GOTO 240 - ENDIF - IF(NTRY.GT.1000) THEN - CALL PYERRM(14,'(PYDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=N - NP=0 - NQ=0 - MBST=0 - IF(MMAT.GE.11.AND.P(IP,4).GT.20D0*P(IP,5)) MBST=1 - DO 270 J=1,4 - PV(1,J)=0D0 - 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=0D0 - PSQ=0D0 - MREM=0 - MHADDY=0 - IF(KFA.GT.80) MHADDY=1 -C.. Random flavour and popcorn system memory. - IRNDMO=0 - JTMO=0 - MSTU(121)=0 - MSTU(125)=10 - -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=PYCOMP(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 PYDCYK(-KFS*INT(1D0+(2D0+PARJ(2))*PYR(0)),0,KFP,KDUMP) - IF(KFP.EQ.0) GOTO 260 - KFP=-KFP - IRNDMO=1 - MSTJ(93)=1 - IF(PV(1,5).LT.PARJ(32)+2D0*PYMASS(KFP)) GOTO 260 - ELSEIF(KP.EQ.-82) THEN - KFP=MSTU(124) - ENDIF - IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=PYCOMP(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 -C...set rndmflav popcorn system pointer - IF(KP.EQ.82.AND.MSTU(121).GT.0) JTMO=NQ - MSTJ(93)=2 - PSQ=PSQ+PYMASS(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 PYKFDI(KFP,KFI,KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 260 - MSTJ(93)=1 - P(I,5)=PYMASS(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)=PYMASS(KFP) - 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.1D0)) - IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) - 300 NTRY=NTRY+1 -C...Reset popcorn flags if new attempt. Re-select rndmflav if failed. - IF(IRNDMO.EQ.0) THEN - MSTU(121)=0 - JTMO=0 - ELSEIF(IRNDMO.EQ.1) THEN - IRNDMO=2 - ELSE - GOTO 260 - ENDIF - IF(NTRY.GT.1000) THEN - CALL PYERRM(14,'(PYDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MMAT.LE.20) THEN - GAUSS=SQRT(-2D0*CNDE*LOG(MAX(1D-10,PYR(0))))* - & SIN(PARU(2)*PYR(0)) - ND=0.5D0+0.5D0*NP+0.25D0*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.. Set maximum popcorn meson number. Test rndmflav popcorn size. - MSTU(125)=ND-NQ/2 - IF(MSTU(121).GT.MSTU(125)) GOTO 300 - -C...Form hadrons from flavour content. - DO 310 JT=1,NQ - KFL1(JT)=KFLO(JT) - 310 CONTINUE - IF(ND.EQ.NP+NQ/2) GOTO 330 - DO 320 I=N+NP+1,N+ND-NQ/2 -C.. Stick to started popcorn system, else pick side at random - JT=JTMO - IF(JT.EQ.0) JT=1+INT((NQ-1)*PYR(0)) - CALL PYDCYK(KFL1(JT),0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 300 - MSTU(125)=MSTU(125)-1 - JTMO=0 - IF(MSTU(121).GT.0) JTMO=JT - KFL1(JT)=-KFL2 - 320 CONTINUE - 330 JT=2 - JT2=3 - JT3=4 - IF(NQ.EQ.4.AND.PYR(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 PYDCYK(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 PYDCYK(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)=PYMASS(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) - & .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)=(1D0-PQT)*PV(1,J) - 350 CONTINUE - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 - ND=NP-1 - MREM=1 - -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...Determine position of grandmother, number of sisters. - NM=0 - KFAS=0 - MSGN=0 - IF(MMAT.EQ.3) THEN - IM=K(IP,3) - IF(IM.LT.0.OR.IM.GE.IP) IM=0 - IF(IM.NE.0) KFAM=IABS(K(IM,2)) - IF(IM.NE.0) THEN - DO 360 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 - 360 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 - ENDIF - ENDIF - -C...Kinematics of one-particle decays. - IF(ND.EQ.1) THEN - DO 370 J=1,4 - P(N+1,J)=P(IP,J) - 370 CONTINUE - GOTO 630 - ENDIF - -C...Calculate maximum weight ND-particle decay. - PV(ND,5)=P(N+ND,5) - IF(ND.GE.3) THEN - WTMAX=1D0/WTCOR(ND-2) - PMAX=PV(1,5)-PS+P(N+ND,5) - PMIN=0D0 - DO 380 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)) - 380 CONTINUE - ENDIF - -C...Find virtual gamma mass in Dalitz decay. - 390 IF(ND.EQ.2) THEN - ELSEIF(MMAT.EQ.2) THEN - PMES=4D0*PMAS(11,1)**2 - PMRHO2=PMAS(131,1)**2 - PGRHO2=PMAS(131,2)**2 - 400 PMST=PMES*(P(IP,5)**2/PMES)**PYR(0) - WT=(1+0.5D0*PMES/PMST)*SQRT(MAX(0D0,1D0-PMES/PMST))* - & (1D0-PMST/P(IP,5)**2)**3*(1D0+PGRHO2/PMRHO2)/ - & ((1D0-PMST/PMRHO2)**2+PGRHO2/PMRHO2) - IF(WT.LT.PYR(0)) GOTO 400 - PV(2,5)=MAX(2.00001D0*PMAS(11,1),SQRT(PMST)) - -C...M-generator gives weight. If rejected, try again. - ELSE - 410 RORD(1)=1D0 - DO 440 IL1=2,ND-1 - RSAV=PYR(0) - DO 420 IL2=IL1-1,1,-1 - IF(RSAV.LE.RORD(IL2)) GOTO 430 - RORD(IL2+1)=RORD(IL2) - 420 CONTINUE - 430 RORD(IL2+1)=RSAV - 440 CONTINUE - RORD(ND)=0D0 - WT=1D0 - DO 450 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)) - 450 CONTINUE - IF(WT.LT.PYR(0)*WTMAX) GOTO 410 - ENDIF - -C...Perform two-particle decays in respective CM frame. - 460 DO 480 IL=1,ND-1 - PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) - UE(3)=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) - DO 470 J=1,3 - P(N+IL,J)=PA*UE(J) - PV(IL+1,J)=-PA*UE(J) - 470 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) - 480 CONTINUE - -C...Lorentz transform decay products to lab frame. - DO 490 J=1,4 - P(N+ND,J)=PV(ND,J) - 490 CONTINUE - DO 530 IL=ND-1,1,-1 - DO 500 J=1,3 - BE(J)=PV(IL,J)/PV(IL,4) - 500 CONTINUE - GA=PV(IL,4)/PV(IL,5) - DO 520 I=N+IL,N+ND - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 510 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) - 510 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 520 CONTINUE - 530 CONTINUE - -C...Check that no infinite loop in matrix element weight. - NTRY=NTRY+1 - IF(NTRY.GT.800) GOTO 560 - -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 - & +2D0*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.001D0).LT.PYR(0)) GOTO 390 - -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.5D0*PMES)*(FOUR12**2+FOUR13**2)+ - & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) - IF(WT.LT.PYR(0)*0.25D0*PMST*(P(IP,5)**2-PMST)**2) GOTO 460 - -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*(2D0*FOUR10*FOUR12*FOUR02- - & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) - HNUM=MAX(1D-6*PMS1**2*PMS0*PMS2,HNUM) - HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) - IF(HNUM.LT.PYR(0)*HDEN) GOTO 460 - -C...Matrix element for "onium" -> g + g + g or gamma + g + g. - ELSEIF(MMAT.EQ.4) THEN - HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 - HX2=2D0*FOUR(IP,N+2)/P(IP,5)**2 - HX3=2D0*FOUR(IP,N+3)/P(IP,5)**2 - WT=((1D0-HX1)/(HX2*HX3))**2+((1D0-HX2)/(HX1*HX3))**2+ - & ((1D0-HX3)/(HX1*HX2))**2 - IF(WT.LT.2D0*PYR(0)) GOTO 390 - IF(K(IP+1,2).EQ.22.AND.(1D0-HX1)*P(IP,5)**2.LT.4D0*PARJ(32)**2) - & GOTO 390 - -C...Effective matrix element for nu spectrum in tau -> nu + hadrons. - ELSEIF(MMAT.EQ.41) THEN - IF(MBST.EQ.0) HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 - IF(MBST.EQ.1) HX1=2D0*P(N+1,4)/P(IP,5) - HXM=MIN(0.75D0,2D0*(1D0-PS/P(IP,5))) - IF(HX1*(3D0-2D0*HX1).LT.PYR(0)*HXM*(3D0-2D0*HXM)) GOTO 390 - -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.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 - ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN - DO 550 J=1,4 - P(N+NP+1,J)=0D0 - DO 540 IS=N+3,N+NP - P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) - 540 CONTINUE - 550 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.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 - ENDIF - -C...Scale back energy and reattach spectator. - 560 IF(MREM.EQ.1) THEN - DO 570 J=1,5 - PV(1,J)=PV(1,J)/(1D0-PQT) - 570 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.AND.ND.EQ.3) THEN - MSTJ(93)=1 - PM2=PYMASS(K(N+2,2)) - MSTJ(93)=1 - PM3=PYMASS(K(N+3,2)) - IF(P(N+2,5)**2+P(N+3,5)**2+2D0*FOUR(N+2,N+3).GE. - & (PARJ(32)+PM2+PM3)**2) GOTO 630 - K(N+2,1)=1 - KFTEMP=K(N+2,2) - CALL PYKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) - IF(K(N+2,2).EQ.0) GOTO 260 - P(N+2,5)=PYMASS(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 460 - ELSEIF(MMAT.EQ.44) THEN - MSTJ(93)=1 - PM3=PYMASS(K(N+3,2)) - MSTJ(93)=1 - PM4=PYMASS(K(N+4,2)) - IF(P(N+3,5)**2+P(N+4,5)**2+2D0*FOUR(N+3,N+4).GE. - & (PARJ(32)+PM3+PM4)**2) GOTO 600 - K(N+3,1)=1 - KFTEMP=K(N+3,2) - CALL PYKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) - IF(K(N+3,2).EQ.0) GOTO 260 - P(N+3,5)=PYMASS(K(N+3,2)) - DO 580 J=1,3 - P(N+3,J)=P(N+3,J)+P(N+4,J) - 580 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-2D0*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)/(2D0*HF) - DO 590 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 - 590 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. - 600 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(0D0,P(N+1,5)**2+P(N+2,5)**2+2D0*FOUR(N+1,N+2))) - MSTJ(93)=1 - PM1=PYMASS(K(N+1,2)) - MSTJ(93)=1 - PM2=PYMASS(K(N+2,2)) - IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 610 - KFLDUM=INT(1.5D0+PYR(0)) - CALL PYKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) - CALL PYKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) - IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 - PSM=PYMASS(KF1)+PYMASS(KF2) - IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 610 - IF(MMAT.GE.43.AND.PMR.GT.0.2D0*PARJ(32)+PSM) GOTO 610 - IF(MMAT.EQ.48) GOTO 390 - IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260 - K(N+1,1)=1 - KFTEMP=K(N+1,2) - CALL PYKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) - IF(K(N+1,2).EQ.0) GOTO 260 - P(N+1,5)=PYMASS(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 460 - ENDIF - -C...Phase space decay of partons from W decay. - 610 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 620 J=1,5 - PV(1,J)=P(N+1,J)+P(N+2,J) - P(N+1,J)=P(N+3,J) - 620 CONTINUE - PV(1,5)=PMR - N=N+1 - NP=0 - NQ=2 - PS=0D0 - MSTJ(93)=2 - PSQ=PYMASS(KFLO(1)) - MSTJ(93)=2 - PSQ=PSQ+PYMASS(KFLO(2)) - MMAT=11 - GOTO 290 - ENDIF - -C...Boost back for rapidly moving particle. - 630 N=N+ND - IF(MBST.EQ.1) THEN - DO 640 J=1,3 - BE(J)=P(IP,J)/P(IP,4) - 640 CONTINUE - GA=P(IP,4)/P(IP,5) - DO 660 I=NSAV+1,N - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 650 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) - 650 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 660 CONTINUE - ENDIF - -C...Fill in position of decay vertex. - DO 680 I=NSAV+1,N - DO 670 J=1,4 - V(I,J)=VDCY(J) - 670 CONTINUE - V(I,5)=0D0 - 680 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).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).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=PYCOMP(K(NSAV+1,2)) - KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) - JCON=4 - IF(KQP.LT.0) JCON=5 - K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) - K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) - K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) - K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) - MSTJ(92)=NSAV+1 - ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN - K(NSAV+1,1)=3 - K(NSAV+3,1)=3 - K(NSAV+1,4)=MSTU(5)*(NSAV+3) - K(NSAV+1,5)=MSTU(5)*(NSAV+3) - K(NSAV+3,4)=MSTU(5)*(NSAV+1) - K(NSAV+3,5)=MSTU(5)*(NSAV+1) - MSTJ(92)=NSAV+1 - ENDIF - -C...Mark decayed particle; special option for B-Bbar 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********************************************************************* - -C...PYDIFF -C...Handles diffractive and elastic scattering. - - SUBROUTINE PYDIFF - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ - -C...Reset K, P and V vectors. Store incoming particles. - DO 110 JT=1,MSTP(126)+10 - I=MINT(83)+JT - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - N=MINT(84) - MINT(3)=0 - MINT(21)=0 - MINT(22)=0 - MINT(23)=0 - MINT(24)=0 - MINT(4)=4 - DO 130 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 120 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 120 CONTINUE - 130 CONTINUE - MINT(6)=2 - -C...Subprocess; kinematics. - SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4D0*VINT(63)*VINT(64) - PZ=SQRT(SQLAM)/(2D0*VINT(1)) - DO 200 JT=1,2 - I=MINT(83)+JT - PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2D0*VINT(1)) - KFH=MINT(102+JT) - -C...Elastically scattered particle. (Except elastic GVMD states.) - IF(MINT(16+JT).LE.0.AND.(MINT(10+JT).NE.22.OR. - & MINT(106+JT).NE.3)) THEN - N=N+1 - K(N,1)=1 - K(N,2)=KFH - K(N,3)=I+2 - P(N,3)=PZ*(-1)**(JT+1) - P(N,4)=PE - P(N,5)=SQRT(VINT(62+JT)) - -C...Decay rho from elastic scattering of gamma with sin**2(theta) -C...distribution of decay products (in rho rest frame). - IF(KFH.EQ.113.AND.MINT(10+JT).EQ.22.AND.MSTP(102).EQ.1) THEN - NSAV=N - DBETAZ=P(N,3)/SQRT(P(N,3)**2+P(N,5)**2) - P(N,3)=0D0 - P(N,4)=P(N,5) - CALL PYDECY(NSAV) - IF(N.EQ.NSAV+2.AND.IABS(K(NSAV+1,2)).EQ.211) THEN - PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) - CALL PYROBO(NSAV+1,NSAV+2,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) - CALL PYROBO(NSAV+1,NSAV+2,-THE,0D0,0D0,0D0,0D0) - 140 CTHE=2D0*PYR(0)-1D0 -C... Changing parameters for R_rho with values corresponding to W<7 (measured by -C... HERMES -C R_rho=1/eps * r0400/(1. - r0400) - PMVIRT=0.76849997 - R_rho=PARP(165)*(VINT(307)/(PMVIRT**2))**PARP(166) -C eps = (1. - VINT(309)) / (1.-VINT(309)+ -C $ (0.5*(VINT(309))**2.)) - BEAMAS=PYMASS(11) -C new epsilon (f_L/f_T) as used in pysigh.F with proton mass - eps=1D0/(1D0+(VINT(309)**2*(1D0-2D0*BEAMAS**2/ - & VINT(307)))/(2D0/(1D0+VINT(307)/VINT(309)**2/ - & VINT(290)**2)*(1D0-VINT(309)- - & (VINT(307)/4D0/VINT(290)**2)))) - r0400=eps*R_rho / ( 1. + eps * R_rho) - w_ang=0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0)*cthe**2.) - if( r0400 .le. 1.d0/3.d0 ) then - w_ang_max_x = 0.d0 - else - w_ang_max_x = 1.d0 - endif - w_ang_max= 0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0) - $ *w_ang_max_x**2.) - -C IF(1D0-CTHE**2.LT.PYR(0)) GOTO 140 - IF(PYR(0).gt.w_ang/w_ang_max) GOTO 140 - CALL PYROBO(NSAV+1,NSAV+2,ACOS(CTHE),PHI,0D0,0D0,0D0) - ENDIF - CALL PYROBO(NSAV,NSAV+2,0D0,0D0,0D0,0D0,DBETAZ) - ENDIF - -C...Diffracted particle: low-mass system to two particles. - ELSEIF(VINT(62+JT).LT.(VINT(66+JT)+PARP(103))**2) THEN - N=N+2 - K(N-1,1)=1 - K(N,1)=1 - K(N-1,3)=I+2 - K(N,3)=I+2 - PMMAS=SQRT(VINT(62+JT)) - NTRY=0 - 150 NTRY=NTRY+1 - IF(NTRY.LT.20) THEN - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,KFL1,KFL2) - CALL PYKFDI(KFL1,0,KFL3,KF1) - IF(KF1.EQ.0) GOTO 150 - CALL PYKFDI(KFL2,-KFL3,KFLDUM,KF2) - IF(KF2.EQ.0) GOTO 150 - ELSE - KF1=KFH - KF2=111 - ENDIF - PM1=PYMASS(KF1) - PM2=PYMASS(KF2) - IF(PM1+PM2+PARJ(64).GT.PMMAS) GOTO 150 - K(N-1,2)=KF1 - K(N,2)=KF2 - P(N-1,5)=PM1 - P(N,5)=PM2 - PZP=SQRT(MAX(0D0,(PMMAS**2-PM1**2-PM2**2)**2- - & 4D0*PM1**2*PM2**2))/(2D0*PMMAS) - P(N-1,3)=PZP - P(N,3)=-PZP - P(N-1,4)=SQRT(PM1**2+PZP**2) - P(N,4)=SQRT(PM2**2+PZP**2) - CALL PYROBO(N-1,N,ACOS(2D0*PYR(0)-1D0),PARU(2)*PYR(0), - & 0D0,0D0,0D0) - DBETAZ=PZ*(-1)**(JT+1)/SQRT(PZ**2+PMMAS**2) - CALL PYROBO(N-1,N,0D0,0D0,0D0,0D0,DBETAZ) - -C...Diffracted particle: valence quark kicked out. - ELSEIF(MSTP(101).EQ.1.OR.(MSTP(101).EQ.3.AND.PYR(0).LT. - & PARP(101))) THEN - N=N+2 - K(N-1,1)=2 - K(N,1)=1 - K(N-1,3)=I+2 - K(N,3)=I+2 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,K(N,2),K(N-1,2)) - P(N-1,5)=PYMASS(K(N-1,2)) - P(N,5)=PYMASS(K(N,2)) - SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- - & 4D0*P(N-1,5)**2*P(N,5)**2 - P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- - & P(N,5)**2))/(2D0*VINT(62+JT))*(-1)**(JT+1) - P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) - P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) - P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) - -C...Diffracted particle: gluon kicked out. - ELSE - N=N+3 - K(N-2,1)=2 - K(N-1,1)=2 - K(N,1)=1 - K(N-2,3)=I+2 - K(N-1,3)=I+2 - K(N,3)=I+2 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,K(N,2),K(N-2,2)) - K(N-1,2)=21 - P(N-2,5)=PYMASS(K(N-2,2)) - P(N-1,5)=0D0 - P(N,5)=PYMASS(K(N,2)) -C...Energy distribution for particle into two jets. - 160 IMB=1 - IF(MOD(KFH/1000,10).NE.0) IMB=2 - CHIK=PARP(92+2*IMB) - IF(MSTP(92).LE.1) THEN - IF(IMB.EQ.1) CHI=PYR(0) - IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) - ELSEIF(MSTP(92).EQ.2) THEN - CHI=1D0-PYR(0)**(1D0/(1D0+CHIK)) - ELSEIF(MSTP(92).EQ.3) THEN - CUT=2D0*0.3D0/VINT(1) - 170 CHI=PYR(0)**2 - IF((CHI**2/(CHI**2+CUT**2))**0.25D0*(1D0-CHI)**CHIK.LT. - & PYR(0)) GOTO 170 - ELSEIF(MSTP(92).EQ.4) THEN - CUT=2D0*0.3D0/VINT(1) - CUTR=(1D0+SQRT(1D0+CUT**2))/CUT - 180 CHIR=CUT*CUTR**PYR(0) - CHI=(CHIR**2-CUT**2)/(2D0*CHIR) - IF((1D0-CHI)**CHIK.LT.PYR(0)) GOTO 180 - ELSE - CUT=2D0*0.3D0/VINT(1) - CUTA=CUT**(1D0-PARP(98)) - CUTB=(1D0+CUT)**(1D0-PARP(98)) - 190 CHI=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) - IF(((CHI+CUT)**2/(2D0*(CHI**2+CUT**2)))** - & (0.5D0*PARP(98))*(1D0-CHI)**CHIK.LT.PYR(0)) GOTO 190 - ENDIF - IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1D0-P(N-2,5)**2/ - & VINT(62+JT)) GOTO 160 - SQM=P(N-2,5)**2/(1D0-CHI)+P(N,5)**2/CHI - PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ - & (2D0*VINT(62+JT)) - PEI=SQRT(PZI**2+SQM) - PQQP=(1D0-CHI)*(PEI+PZI) - P(N-2,3)=0.5D0*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) - P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) - P(N-1,4)=0.5D0*(VINT(62+JT)-SQM)/(PEI+PZI) - P(N-1,3)=P(N-1,4)*(-1)**JT - P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) - P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) - ENDIF - -C...Documentation lines. - K(I+2,1)=21 - IF(MINT(16+JT).EQ.0) K(I+2,2)=KFH - IF(MINT(16+JT).NE.0.OR.(MINT(10+JT).EQ.22.AND. - & MINT(106+JT).EQ.3)) K(I+2,2)=ISIGN(9900000,KFH)+10*(KFH/10) - K(I+2,3)=I - P(I+2,3)=PZ*(-1)**(JT+1) - P(I+2,4)=PE - P(I+2,5)=SQRT(VINT(62+JT)) - 200 CONTINUE - -C...Rotate outgoing partons/particles using cos(theta). - IF(VINT(23).LT.0.9D0) THEN - CALL PYROBO(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) - ELSE - CALL PYROBO(MINT(83)+3,N,ASIN(VINT(59)),VINT(24),0D0,0D0,0D0) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDISG -C...Set up a DIS process as gamma* + f -> f, with beam remnant -C...and showering added consecutively. Photon flux by the PYGAGA -C...routine (if at all). - - SUBROUTINE PYDISG - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION PMS(4) - -C...Choice of subprocess, number of documentation lines - IDOC=7 - MINT(3)=IDOC-6 - MINT(4)=IDOC - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IPU3=MINT(84)+3 - ISIDE=1 - IF(MINT(107).EQ.4) ISIDE=2 - -C...Reset K, P and V vectors. Store incoming particles - DO 110 JT=1,MSTP(126)+20 - I=MINT(83)+JT - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - DO 130 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 120 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 120 CONTINUE - 130 CONTINUE - MINT(6)=2 - -C...Store incoming partons in hadronic CM-frame - DO 140 JT=1,2 - I=MINT(84)+JT - K(I,1)=14 - K(I,2)=MINT(14+JT) - K(I,3)=MINT(83)+2+JT - 140 CONTINUE - IF(MINT(15).EQ.22) THEN - P(MINT(84)+1,3)=0.5D0*(VINT(1)+VINT(307)/VINT(1)) - P(MINT(84)+1,4)=0.5D0*(VINT(1)-VINT(307)/VINT(1)) - P(MINT(84)+1,5)=-SQRT(VINT(307)) - P(MINT(84)+2,3)=-0.5D0*VINT(307)/VINT(1) - P(MINT(84)+2,4)=0.5D0*VINT(307)/VINT(1) - KFRES=MINT(16) - ISIDE=2 - ELSE - P(MINT(84)+1,3)=0.5D0*VINT(308)/VINT(1) - P(MINT(84)+1,4)=0.5D0*VINT(308)/VINT(1) - P(MINT(84)+2,3)=-0.5D0*(VINT(1)+VINT(308)/VINT(1)) - P(MINT(84)+2,4)=0.5D0*(VINT(1)-VINT(308)/VINT(1)) - P(MINT(84)+1,5)=-SQRT(VINT(308)) - KFRES=MINT(15) - ISIDE=1 - ENDIF - SIDESG=(-1D0)**(ISIDE-1) - -C...Copy incoming partons to documentation lines. - DO 170 JT=1,2 - I1=MINT(83)+4+JT - I2=MINT(84)+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 150 J=1,5 - P(I1,J)=P(I2,J) - 150 CONTINUE - -C...Second copy for partons before ISR shower, since no such. - I1=MINT(83)+2+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 160 J=1,5 - P(I1,J)=P(I2,J) - 160 CONTINUE - 170 CONTINUE - -C...Define initial partons. - NTRY=0 - 180 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Scattered quark in hadronic CM frame. - I=MINT(83)+7 - K(IPU3,1)=3 - K(IPU3,2)=KFRES - K(IPU3,3)=I - P(IPU3,5)=PYMASS(KFRES) - P(IPU3,3)=P(IPU1,3)+P(IPU2,3) - P(IPU3,4)=P(IPU1,4)+P(IPU2,4) - P(IPU3,5)=0D0 - K(I,1)=21 - K(I,2)=KFRES - K(I,3)=MINT(83)+4+ISIDE - P(I,3)=P(IPU3,3) - P(I,4)=P(IPU3,4) - P(I,5)=P(IPU3,5) - N=IPU3 - MINT(21)=KFRES - MINT(22)=0 - -C...No primordial kT, or chosen according to truncated Gaussian or -C...exponential, or (for photon) predetermined or power law. - 190 IF(MINT(40+ISIDE).EQ.2.AND.MINT(10+ISIDE).NE.22) THEN - IF(MSTP(91).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(91).EQ.1) THEN - PT=PARP(91)*SQRT(-LOG(PYR(0))) - ELSE - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(92)*LOG(RPT1*RPT2) - ENDIF - IF(PT.GT.PARP(93)) GOTO 190 - ELSEIF(MINT(106+ISIDE).EQ.3) THEN - PTA=SQRT(VINT(282+ISIDE)) - PTB=0D0 - IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN - PTB=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PTB=-PARP(99)*LOG(RPT1*RPT2) - ENDIF - IF(PTB.GT.PARP(100)) GOTO 190 - PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) - IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) - ELSEIF(IABS(MINT(14+ISIDE)).LE.8.OR.MINT(14+ISIDE).EQ.21) THEN - IF(MSTP(93).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(93).EQ.1) THEN - PT=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(99)*LOG(RPT1*RPT2) - ELSEIF(MSTP(93).EQ.3) THEN - HA=PARP(99)**2 - HB=PARP(100)**2 - PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) - ELSE - HA=PARP(99)**2 - HB=PARP(100)**2 - IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) - PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) - ENDIF - IF(PT.GT.PARP(100)) GOTO 190 - ELSE - PT=0D0 - ENDIF - VINT(156+ISIDE)=PT - PHI=PARU(2)*PYR(0) - P(IPU3,1)=PT*COS(PHI) - P(IPU3,2)=PT*SIN(PHI) - P(IPU3,4)=SQRT(P(IPU3,5)**2+PT**2+P(IPU3,3)**2) - PMS(3-ISIDE)=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 - PCP=P(IPU3,4)+ABS(P(IPU3,3)) - -C...Find one or two beam remnants. - MINT(105)=MINT(102+ISIDE) - MINT(109)=MINT(106+ISIDE) - CALL PYSPLI(MINT(10+ISIDE),MINT(12+ISIDE),KFLCH,KFLSP) - IF(MINT(51).NE.0) THEN - MINT(51)=0 - GOTO 180 - ENDIF - -C...Store first remnant parton, with colour info and kinematics. - I=N+1 - K(I,1)=1 - K(I,2)=KFLSP - K(I,3)=MINT(83)+ISIDE - P(I,5)=PYMASS(K(I,2)) - KCOL=KCHG(PYCOMP(KFLSP),2) - IF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLSP))/2 - K(I,KFLS+3)=MSTU(5)*IPU3 - K(IPU3,6-KFLS)=MSTU(5)*I - ICOLR=I - ENDIF - IF(KFLCH.EQ.0) THEN - P(I,1)=-P(IPU3,1) - P(I,2)=-P(IPU3,2) - PMS(ISIDE)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - P(I,3)=-P(IPU3,3) - P(I,4)=SQRT(PMS(ISIDE)+P(I,3)**2) - PRP=P(I,4)+ABS(P(I,3)) - -C...When extra remnant parton or hadron: store extra remnant. - ELSE - I=I+1 - K(I,1)=1 - K(I,2)=KFLCH - K(I,3)=MINT(83)+ISIDE - P(I,5)=PYMASS(K(I,2)) - KCOL=KCHG(PYCOMP(KFLCH),2) - IF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLCH))/2 - K(I,KFLS+3)=MSTU(5)*IPU3 - K(IPU3,6-KFLS)=MSTU(5)*I - ICOLR=I - ENDIF - -C...Relative transverse momentum when two remnants. - LOOP=0 - 200 LOOP=LOOP+1 - CALL PYPTDI(1,P(I-1,1),P(I-1,2)) - P(I-1,1)=P(I-1,1)-0.5D0*P(IPU3,1) - P(I-1,2)=P(I-1,2)-0.5D0*P(IPU3,2) - PMS(3)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 - P(I,1)=-P(IPU3,1)-P(I-1,1) - P(I,2)=-P(IPU3,2)-P(I-1,2) - PMS(4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - -C...Relative distribution of energy for particle into jet plus particle. - IMB=1 - IF(MOD(MINT(10+ISIDE)/1000,10).NE.0) IMB=2 - IF(MSTP(94).LE.1) THEN - IF(IMB.EQ.1) CHI=PYR(0) - IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) - IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI - ELSEIF(MSTP(94).EQ.2) THEN - CHI=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) - IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI - ELSEIF(MSTP(94).EQ.3) THEN - CALL PYZDIS(1,0,PMS(4),ZZ) - CHI=ZZ - ELSE - CALL PYZDIS(1000,0,PMS(4),ZZ) - CHI=ZZ - ENDIF - -C...Construct total transverse mass; reject if too large. - CHI=MAX(1D-8,MIN(1D0-1D-8,CHI)) - PMS(ISIDE)=PMS(4)/CHI+PMS(3)/(1D0-CHI) - IF(PMS(ISIDE).GT.P(IPU3,4)**2) THEN - IF(LOOP.LT.10) GOTO 200 - GOTO 180 - ENDIF - VINT(158+ISIDE)=CHI - -C...Subdivide longitudinal momentum according to value selected above. - PRP=SQRT(PMS(ISIDE)+P(IPU3,3)**2)+ABS(P(IPU3,3)) - PW1=(1D0-CHI)*PRP - P(I-1,4)=0.5D0*(PW1+PMS(3)/PW1) - P(I-1,3)=0.5D0*(PW1-PMS(3)/PW1)*SIDESG - PW2=CHI*PRP - P(I,4)=0.5D0*(PW2+PMS(4)/PW2) - P(I,3)=0.5D0*(PW2-PMS(4)/PW2)*SIDESG - ENDIF - N=I - -C...Boost current and remnant systems to correct frame. - IF(SQRT(PMS(1))+SQRT(PMS(2)).GT.0.99D0*VINT(1)) GOTO 180 - DSQLAM=SQRT(MAX(0D0,(VINT(2)-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2))) - DRKC=(VINT(2)+PMS(3-ISIDE)-PMS(ISIDE)+DSQLAM)/ - &(2D0*VINT(1)*PCP) - DRKR=(VINT(2)+PMS(ISIDE)-PMS(3-ISIDE)+DSQLAM)/ - &(2D0*VINT(1)*PRP) - DBEC=-SIDESG*(DRKC**2-1D0)/(DRKC**2+1D0) - DBER=SIDESG*(DRKR**2-1D0)/(DRKR**2+1D0) - CALL PYROBO(IPU3,IPU3,0D0,0D0,0D0,0D0,DBEC) - CALL PYROBO(IPU3+1,N,0D0,0D0,0D0,0D0,DBER) - -C...Let current quark shower; recoil but no showering by colour partner. - QMAX=2D0*SQRT(VINT(309-ISIDE)) - MSTJ48=MSTJ(48) - MSTJ(48)=1 - PARJ86=PARJ(86) - PARJ(86)=0D0 - IF(MSTP(71).EQ.1) CALL PYSHOW(IPU3,ICOLR,QMAX) - MSTJ(48)=MSTJ48 - PARJ(86)=PARJ86 - - RETURN - END - -C********************************************************************* - -C...PYDOCU -C...Handles the documentation of the process in MSTI and PARI, -C...and also computes cross-sections based on accumulated statistics. - - SUBROUTINE PYDOCU - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYJETS/,/PYDAT1/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT5/ - -C...Calculate Monte Carlo estimates of cross-sections. - ISUB=MINT(1) - IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 - NGEN(0,3)=NGEN(0,3)+1 - XSEC(0,3)=0D0 - DO 100 I=1,500 - IF(I.EQ.96.OR.I.EQ.97) THEN - XSEC(I,3)=0D0 - ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. - & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN - XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* - & DBLE(NGEN(96,2))) - ELSEIF(MSUB(95).EQ.1.AND.I.GE.381.AND.I.LE.386) THEN - XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* - & DBLE(NGEN(96,2))) - ELSEIF(MSUB(I).EQ.0.OR.NGEN(I,1).EQ.0) THEN - XSEC(I,3)=0D0 - ELSEIF(NGEN(I,2).EQ.0) THEN - XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(DBLE(NGEN(I,1))* - & DBLE(NGEN(0,2))) - ELSE - XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(DBLE(NGEN(I,1))* - & DBLE(NGEN(I,2))) - ENDIF - XSEC(0,3)=XSEC(0,3)+XSEC(I,3) - 100 CONTINUE - -C...Rescale to known low-pT cross-section for standard QCD processes. - IF(MSUB(95).EQ.1) THEN - XSECH=XSEC(11,3)+XSEC(12,3)+XSEC(13,3)+XSEC(28,3)+XSEC(53,3)+ - & XSEC(68,3)+XSEC(95,3) - XSECW=XSEC(97,2)/MAX(1D0,DBLE(NGEN(97,1))) - IF(XSECH.GT.1D-20.AND.XSECW.GT.1D-20) THEN - FAC=XSECW/XSECH - XSEC(11,3)=FAC*XSEC(11,3) - XSEC(12,3)=FAC*XSEC(12,3) - XSEC(13,3)=FAC*XSEC(13,3) - XSEC(28,3)=FAC*XSEC(28,3) - XSEC(53,3)=FAC*XSEC(53,3) - XSEC(68,3)=FAC*XSEC(68,3) - XSEC(95,3)=FAC*XSEC(95,3) - XSEC(0,3)=XSEC(0,3)-XSECH+XSECW - ENDIF - ENDIF - -C...Save information for gamma-p and gamma-gamma. - IF(MINT(121).GT.1) THEN - IGA=MINT(122) - CALL PYSAVE(2,IGA) - CALL PYSAVE(5,0) - ENDIF - -C...Reset information on hard interaction. - DO 110 J=1,200 - MSTI(J)=0 - PARI(J)=0D0 - 110 CONTINUE - -C...Copy integer valued information from MINT into MSTI. - DO 120 J=1,32 - MSTI(J)=MINT(J) - 120 CONTINUE - IF(MINT(121).GT.1) MSTI(9)=MINT(122) - -C...Store cross-section variables in PARI. - PARI(1)=XSEC(0,3) - PARI(2)=XSEC(0,3)/MINT(5) - PARI(7)=VINT(97) - PARI(9)=VINT(99) - PARI(10)=VINT(100) - VINT(98)=VINT(98)+VINT(100) - IF(MSTP(142).EQ.1) PARI(2)=XSEC(0,3)/VINT(98) - -C...Store kinematics variables in PARI. - PARI(11)=VINT(1) - PARI(12)=VINT(2) - IF(ISUB.NE.95) THEN - DO 130 J=13,26 - PARI(J)=VINT(30+J) - 130 CONTINUE - PARI(31)=VINT(141) - PARI(32)=VINT(142) - PARI(33)=VINT(41) - PARI(34)=VINT(42) - PARI(35)=PARI(33)-PARI(34) - PARI(36)=VINT(21) - PARI(37)=VINT(22) - PARI(38)=VINT(26) - PARI(39)=VINT(157) - PARI(40)=VINT(158) - PARI(41)=VINT(23) - PARI(42)=2D0*VINT(47)/VINT(1) - ENDIF - -C...Store information on scattered partons in PARI. - IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN - DO 140 IS=7,8 - I=MINT(IS) - PARI(36+IS)=P(I,3)/VINT(1) - PARI(38+IS)=P(I,4)/VINT(1) - PR=MAX(1D-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) - PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ - & SQRT(PR),1D20)),P(I,3)) - PR=MAX(1D-20,P(I,1)**2+P(I,2)**2) - PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ - & SQRT(PR),1D20)),P(I,3)) - PARI(44+IS)=P(I,3)/SQRT(1D-20+P(I,1)**2+P(I,2)**2+P(I,3)**2) - PARI(46+IS)=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) - PARI(48+IS)=PYANGL(P(I,1),P(I,2)) - 140 CONTINUE - ENDIF - -C...Store sum up transverse and longitudinal momenta. - PARI(65)=2D0*PARI(17) - IF(ISUB.LE.90.OR.ISUB.GE.95) THEN - DO 150 I=MSTP(126)+1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 - PT=SQRT(P(I,1)**2+P(I,2)**2) - PARI(69)=PARI(69)+PT - IF(I.LE.MINT(52)) PARI(66)=PARI(66)+PT - IF(I.GT.MINT(52).AND.I.LE.MINT(53)) PARI(68)=PARI(68)+PT - 150 CONTINUE - PARI(67)=PARI(68) - PARI(71)=VINT(151) - PARI(72)=VINT(152) - PARI(73)=VINT(151) - PARI(74)=VINT(152) - ELSE - PARI(66)=PARI(65) - PARI(69)=PARI(65) - ENDIF - -C...Store various other pieces of information into PARI. - PARI(61)=VINT(148) - PARI(75)=VINT(155) - PARI(76)=VINT(156) - PARI(77)=VINT(159) - PARI(78)=VINT(160) - PARI(81)=VINT(138) - -C...Store information on lepton -> lepton + gamma in PYGAGA. - MSTI(71)=MINT(141) - MSTI(72)=MINT(142) - PARI(101)=VINT(301) - PARI(102)=VINT(302) - DO 160 I=103,114 - PARI(I)=VINT(I+202) - 160 CONTINUE - -C...Set information for PYTABU. - IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN - MSTU(161)=MINT(21) - MSTU(162)=0 - ELSEIF(ISET(ISUB).EQ.5) THEN - MSTU(161)=MINT(23) - MSTU(162)=0 - ELSE - MSTU(161)=MINT(21) - MSTU(162)=MINT(22) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDUMP -C...Dumps histogram contents on file for reading by other program. -C...Can also read back own dump. - - SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Local arrays and character variables. - DIMENSION IHI(*),ISS(100),VAL(5) - CHARACTER TITLE*60,FORMAT*13 - -C...Dump all histograms that have been booked, -C...including titles and ranges, one after the other. - IF(MDUMP.EQ.1) THEN - -C...Loop over histograms and find which are wanted and booked. - IF(NHI.LE.0) THEN - NW=IHIST(1) - ELSE - NW=NHI - ENDIF - DO 130 IW=1,NW - IF(NHI.EQ.0) THEN - ID=IW - ELSE - ID=IHI(IW) - ENDIF - IS=INDX(ID) - IF(IS.NE.0) THEN - -C...Write title, histogram size, filling statistics. - NX=NINT(BIN(IS+1)) - DO 100 IT=1,20 - IEQ=NINT(BIN(IS+8+NX+IT)) - TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)// - & CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256)) - 100 CONTINUE - WRITE(LFN,5100) ID,TITLE - WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3) - WRITE(LFN,5300) NINT(BIN(IS+5)),BIN(IS+6),BIN(IS+7), - & BIN(IS+8) - - -C...Write histogram contents, in groups of five. - DO 120 IXG=1,(NX+4)/5 - DO 110 IXV=1,5 - IX=5*IXG+IXV-5 - IF(IX.LE.NX) THEN - VAL(IXV)=BIN(IS+8+IX) - ELSE - VAL(IXV)=0D0 - ENDIF - 110 CONTINUE - WRITE(LFN,5400) (VAL(IXV),IXV=1,5) - 120 CONTINUE - -C...Go to next histogram; finish. - ELSEIF(NHI.GT.0) THEN - CALL PYERRM(8,'(PYDUMP:) unknown histogram number') - ENDIF - 130 CONTINUE - -C...Read back in histograms dumped MDUMP=1. - ELSEIF(MDUMP.EQ.2) THEN - -C...Read histogram number, title and range, and book. - 140 READ(LFN,5100,END=170) ID,TITLE - READ(LFN,5200) NX,XL,XU - CALL PYBOOK(ID,TITLE,NX,XL,XU) - IS=INDX(ID) - -C...Read filling statistics. - READ(LFN,5300) NENTRY,BIN(IS+6),BIN(IS+7),BIN(IS+8) - BIN(IS+5)=DBLE(NENTRY) - -C...Read histogram contents, in groups of five. - DO 160 IXG=1,(NX+4)/5 - READ(LFN,5400) (VAL(IXV),IXV=1,5) - DO 150 IXV=1,5 - IX=5*IXG+IXV-5 - IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV) - 150 CONTINUE - 160 CONTINUE - -C...Go to next histogram; finish. - GOTO 140 - 170 CONTINUE - -C...Write histogram contents in column format, -C...convenient e.g. for GNUPLOT input. - ELSEIF(MDUMP.EQ.3) THEN - -C...Find addresses to wanted histograms. - NSS=0 - IF(NHI.LE.0) THEN - NW=IHIST(1) - ELSE - NW=NHI - ENDIF - DO 180 IW=1,NW - IF(NHI.EQ.0) THEN - ID=IW - ELSE - ID=IHI(IW) - ENDIF - IS=INDX(ID) - IF(IS.NE.0.AND.NSS.LT.100) THEN - NSS=NSS+1 - ISS(NSS)=IS - ELSEIF(NSS.GE.100) THEN - CALL PYERRM(8,'(PYDUMP:) too many histograms requested') - ELSEIF(NHI.GT.0) THEN - CALL PYERRM(8,'(PYDUMP:) unknown histogram number') - ENDIF - 180 CONTINUE - -C...Check that they have common number of x bins. Fix format. - NX=NINT(BIN(ISS(1)+1)) - DO 190 IW=2,NSS - IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN - CALL PYERRM(8,'(PYDUMP:) different number of bins') - RETURN - ENDIF - 190 CONTINUE - FORMAT='(1P,000E12.4)' - WRITE(FORMAT(5:7),'(I3)') NSS+1 - -C...Write histogram contents; first column x values. - DO 200 IX=1,NX - X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4) - WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS) - 200 CONTINUE - - ENDIF - -C...Formats for output. - 5100 FORMAT(I5,5X,A60) - 5200 FORMAT(I5,1P,2D12.4) - 5300 FORMAT(I12,1P,3D12.4) - 5400 FORMAT(1P,5D12.4) - - RETURN - END - -C********************************************************************* - -C...PYEDIT -C...Performs global manipulations on the event record, in particular -C...to exclude unstable or undetectable partons/particles. - - SUBROUTINE PYEDIT(MEDIT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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).GE.21.AND.K(I,1).LE.40)) GOTO 110 - IF(MEDIT.EQ.1) THEN - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - ELSEIF(MEDIT.EQ.2) THEN - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - KC=PYCOMP(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.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) GOTO 110 - ELSEIF(MEDIT.EQ.5) THEN - IF(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.K(I,1).EQ.52) GOTO 110 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42.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.OR.K(I,1).EQ.51).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,1).EQ.52.OR.K(I,2).EQ.94)) GOTO 120 - IF(MEDIT.EQ.15.AND.K(I,1).GE.21.AND.K(I,1).LE.40) 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).GE.21.AND.K(I,1).LE.40).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.OR. - & K(IM,1).EQ.51).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,1).EQ.52.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.AND. - & K(I,1).NE.42.AND.K(I,1).NE.52) 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).AND.K(I,1).NE.42.AND. - & K(I,1).NE.52) 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 220 I=1,N - IF(K(I,1).LE.10.OR.(K(I,1).GE.21.AND.K(I,1).LE.50)) GOTO 220 - IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 220 -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 220 -C...Find daughters who point to documentation version of mother. - IM=K(I,3) - IF(IM.LE.0.OR.IM.GE.I) GOTO 220 - IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 220 - IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1D-2) GOTO 220 - DO 190 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 - 190 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - IF(K(I,4).NE.0) GOTO 220 -C...Find daughters who point to documentation daughters who, -C...in their turn, point to documentation mother. - ID1=IM - ID2=IM - DO 200 I1=IM+1,I-1 - IF(K(I1,3).EQ.IM.AND.K(I1,1).GE.21.AND.K(I1,1).LE.30) THEN - ID2=I1 - IF(ID1.EQ.IM) ID1=I1 - ENDIF - 200 CONTINUE - DO 210 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 - 210 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - 220 CONTINUE - -C...Save top entries at bottom of PYJETS commonblock. - ELSEIF(MEDIT.EQ.21) THEN - IF(2*N.GE.MSTU(4)) THEN - CALL PYERRM(11,'(PYEDIT:) no more memory left in PYJETS') - RETURN - ENDIF - DO 240 I=1,N - DO 230 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) - 230 CONTINUE - 240 CONTINUE - MSTU(32)=N - -C...Restore bottom entries of commonblock PYJETS to top. - ELSEIF(MEDIT.EQ.22) THEN - DO 260 I=1,MSTU(32) - DO 250 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) - 250 CONTINUE - 260 CONTINUE - N=MSTU(32) - -C...Mark primary entries at top of commonblock PYJETS as untreated. - ELSEIF(MEDIT.EQ.23) THEN - I1=0 - DO 270 I=1,N - KH=K(I,3) - IF(KH.GE.1) THEN - IF(K(KH,1).GE.21.AND.K(KH,1).LE.30) KH=0 - ENDIF - IF(KH.NE.0) GOTO 280 - I1=I1+1 - IF(K(I,1).GE.11.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 - IF(K(I,1).GE.51.AND.K(I,1).LE.60) K(I,1)=K(I,1)-10 - 270 CONTINUE - 280 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 PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61),1), - & P(MSTU(61),2)),0D0,0D0,0D0) - CALL PYROBO(1,N+MSTU(3),-PYANGL(P(MSTU(61),3), - & P(MSTU(61),1)),0D0,0D0,0D0,0D0) - CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(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 290 IS=1,2 - NS(IS)=0 - PTS(IS)=0D0 - PLS(IS)=0D0 - 290 CONTINUE - DO 300 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 300 - IF(MSTU(41).GE.2) THEN - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 300 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) - & .EQ.0) GOTO 300 - ENDIF - IS=2D0-SIGN(0.5D0,P(I,3)) - NS(IS)=NS(IS)+1 - PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) - 300 CONTINUE - IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) - & CALL PYROBO(1,N+MSTU(3),PARU(1),0D0,0D0,0D0,0D0) - -C...Rotate to put second largest jet into -z,+x quadrant. - DO 310 I=1,N - IF(P(I,3).GE.0D0) GOTO 310 - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 310 - IF(MSTU(41).GE.2) THEN - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 310 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) - & .EQ.0) GOTO 310 - ENDIF - IS=2D0-SIGN(0.5D0,P(I,1)) - PLS(IS)=PLS(IS)-P(I,3) - 310 CONTINUE - IF(PLS(2).GT.PLS(1)) CALL PYROBO(1,N+MSTU(3),0D0,PARU(1), - & 0D0,0D0,0D0) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYEEVT -C...Handles the generation of an e+e- annihilation jet event. - - SUBROUTINE PYEEVT(KFL,ECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Check input parameters. - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL PYERRM(16,'(PYEEVT:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02D0*PARF(100+MAX(1,KFL)) - IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02D0*PMAS(KFL,1) - IF(ECM.LT.ECMMIN) THEN - CALL PYERRM(16,'(PYEEVT:) 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 PYERRM(6, - & '(PYEEVT:) MSTJ(109) value requires MSTJ(110) = 1') - MSTJ(110)=1 - ENDIF - IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN - CALL PYERRM(6, - & '(PYEEVT:) 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 PYXTEE(KFL,ECM, - &XTOT) - IF(MSTJ(116).GE.3) MSTJ(116)=1 - PARJ(171)=0D0 - -C...Add initial e+e- to event record (documentation only). - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYEEVT:) caught in an infinite loop') - RETURN - ENDIF - MSTU(24)=0 - NC=0 - IF(MSTJ(115).GE.2) THEN - NC=NC+2 - CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) - K(NC-1,1)=21 - CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) - 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 PYRADK(ECM,MK,PAK, - &THEK,PHIK,ALPK) - IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2D0*PAK)) - IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN - NC=NC+1 - CALL PY1ENT(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 PY1ENT(NC,KF,ECMC,0D0,0D0) - K(NC,1)=21 - K(NC,3)=1 - MSTU(10)=MSTU10 - ENDIF - -C...Choice of flavour and jet configuration. - CALL PYXKFL(KFL,ECM,ECMC,KFLC) - IF(KFLC.EQ.0) GOTO 100 - CALL PYXJET(ECMC,NJET,CUT) - KFLN=21 - IF(NJET.EQ.4) CALL PYX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, - &X12,X14) - IF(NJET.EQ.3) CALL PYX3JT(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 PY2ENT(NC+1,KFLC,-KFLC,ECMC) - IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL PY2ENT(-(NC+1),KFLC,-KFLC, - &ECMC) - IF(NJET.EQ.3) CALL PY3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) - IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL PY4ENT(NC+1,KFLC,KFLN,KFLN, - &-KFLC,ECMC,X1,X2,X4,X12,X14) - IF(NJET.EQ.4.AND.KFLN.NE.21) CALL PY4ENT(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 PYXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) - CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) - CALL PYROBO(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 PYROBO(NMIN,N,0D0,-PHIK,0D0,0D0,0D0) - CALL PYROBO(NMIN,N,ALPK,0D0,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) - CALL PYROBO(NMIN,N,0D0,PHIK,0D0,0D0,0D0) - ENDIF - -C...Generate parton shower. Rearrange along strings and check. - IF(MSTJ(101).EQ.5) THEN - CALL PYSHOW(N-1,N,ECMC) - MSTJ14=MSTJ(14) - IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 - IF(MSTJ(105).GE.0) MSTU(28)=0 - CALL PYPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Fragmentation/decay generation. Information for PYTABU. - IF(MSTJ(105).EQ.1) CALL PYEXEC - MSTU(161)=KFLC - MSTU(162)=-KFLC - - RETURN - END - -C********************************************************************* - -C...PYEIGC -C...Finds eigenvalues of a general complex matrix -C -C THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF -C SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) -C TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) -C OF A COMPLEX GENERAL MATRIX. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX A=(AR,AI). -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX GENERAL MATRIX. -C -C MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF -C ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO -C ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. -C -C ON OUTPUT -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. -C -C IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR -C COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR COMQR -C AND COMQR2. THE NORMAL COMPLETION CODE IS ZERO. -C -C FV1, FV2, AND FV3 ARE TEMPORARY STORAGE ARRAYS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYEICG(NM,N,AR,AI,WR,WI,MATZ,ZR,ZI,FV1,FV2,FV3,IERR) - - INTEGER N,NM,IS1,IS2,IERR,MATZ - DOUBLE PRECISION AR(4,4),AI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), - X FV1(4),FV2(4),FV3(4) - IF (N .LE. NM) GOTO 100 - IERR = 10 * N - GOTO 120 -C - 100 CALL PYCBAL(NM,N,AR,AI,IS1,IS2,FV1) - CALL PYCRTH(NM,N,IS1,IS2,AR,AI,FV2,FV3) - IF (MATZ .NE. 0) GOTO 110 -C .......... FIND EIGENVALUES ONLY .......... - CALL PYCMQR(NM,N,IS1,IS2,AR,AI,WR,WI,IERR) - GOTO 120 -C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... - 110 CALL PYCMQ2(NM,N,IS1,IS2,FV2,FV3,AR,AI,WR,WI,ZR,ZI,IERR) - IF (IERR .NE. 0) GOTO 120 - CALL PYCBA2(NM,N,IS1,IS2,FV1,N,ZR,ZI) - 120 RETURN - END - -C********************************************************************* - -C...PYEIG4 -C...Finds eigenvalues and eigenvectors to a 4 * 4 matrix. -C...Specific application: mixing in neutralino sector. - - SUBROUTINE PYEIG4(A,W,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Arrays: in call and local. - DIMENSION A(4,4),W(4),Z(4,4),X(4),D(4,4),E(4) - -C...Coefficients of fourth-degree equation from matrix. -C...x**4 + b3 * x**3 + b2 * x**2 + b1 * x + b0 = 0. - B3=-(A(1,1)+A(2,2)+A(3,3)+A(4,4)) - B2=0D0 - DO 110 I=1,3 - DO 100 J=I+1,4 - B2=B2+A(I,I)*A(J,J)-A(I,J)*A(J,I) - 100 CONTINUE - 110 CONTINUE - B1=0D0 - B0=0D0 - DO 120 I=1,4 - I1=MOD(I,4)+1 - I2=MOD(I+1,4)+1 - I3=MOD(I+2,4)+1 - B1=B1+A(I,I)*(-A(I1,I1)*A(I2,I2)+A(I1,I2)*A(I2,I1)+ - & A(I1,I3)*A(I3,I1)+A(I2,I3)*A(I3,I2))- - & A(I,I1)*A(I1,I2)*A(I2,I)-A(I,I2)*A(I2,I1)*A(I1,I) - B0=B0+(-1D0)**(I+1)*A(1,I)*( - & A(2,I1)*(A(3,I2)*A(4,I3)-A(3,I3)*A(4,I2))+ - & A(2,I2)*(A(3,I3)*A(4,I1)-A(3,I1)*A(4,I3))+ - & A(2,I3)*(A(3,I1)*A(4,I2)-A(3,I2)*A(4,I1))) - 120 CONTINUE - -C...Coefficients of third-degree equation needed for -C...separation into two second-degree equations. -C...u**3 + c2 * u**2 + c1 * u + c0 = 0. - C2=-B2 - C1=B1*B3-4D0*B0 - C0=-B1**2-B0*B3**2+4D0*B0*B2 - CQ=C1/3D0-C2**2/9D0 - CR=C1*C2/6D0-C0/2D0-C2**3/27D0 - CQR=CQ**3+CR**2 - -C...Cases with one or three real roots. - IF(CQR.GE.0D0) THEN - S1=(CR+SQRT(CQR))**(1D0/3D0) - S2=(CR-SQRT(CQR))**(1D0/3D0) - U=S1+S2-C2/3D0 - ELSE - SABS=SQRT(-CQ) - THE=ACOS(CR/SABS**3)/3D0 - SRE=SABS*COS(THE) - U=2D0*SRE-C2/3D0 - ENDIF - -C...Find and solve two second-degree equations. - P1=B3/2D0-SQRT(B3**2/4D0+U-B2) - P2=B3/2D0+SQRT(B3**2/4D0+U-B2) - Q1=U/2D0+SQRT(U**2/4D0-B0) - Q2=U/2D0-SQRT(U**2/4D0-B0) - IF(ABS(P1*Q1+P2*Q2-B1).LT.ABS(P1*Q2+P2*Q1-B1)) THEN - QSAV=Q1 - Q1=Q2 - Q2=QSAV - ENDIF - X(1)=-P1/2D0+SQRT(P1**2/4D0-Q1) - X(2)=-P1/2D0-SQRT(P1**2/4D0-Q1) - X(3)=-P2/2D0+SQRT(P2**2/4D0-Q2) - X(4)=-P2/2D0-SQRT(P2**2/4D0-Q2) - -C...Order eigenvalues in asceding mass. - W(1)=X(1) - DO 150 I1=2,4 - DO 130 I2=I1-1,1,-1 - IF(ABS(X(I1)).GE.ABS(W(I2))) GOTO 140 - W(I2+1)=W(I2) - 130 CONTINUE - 140 W(I2+1)=X(I1) - 150 CONTINUE - -C...Find equation system for eigenvectors. - DO 250 I=1,4 - DO 170 J1=1,4 - D(J1,J1)=A(J1,J1)-W(I) - DO 160 J2=J1+1,4 - D(J1,J2)=A(J1,J2) - D(J2,J1)=A(J2,J1) - 160 CONTINUE - 170 CONTINUE - -C...Find largest element in matrix. - DAMAX=0D0 - DO 190 J1=1,4 - DO 180 J2=1,4 - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 180 - JA=J1 - JB=J2 - DAMAX=ABS(D(J1,J2)) - 180 CONTINUE - 190 CONTINUE - -C...Subtract others by multiple of row selected above. - DAMAX=0D0 - DO 210 J3=JA+1,JA+3 - J1=J3-4*((J3-1)/4) - RL=D(J1,JB)/D(JA,JB) - DO 200 J2=1,4 - D(J1,J2)=D(J1,J2)-RL*D(JA,J2) - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 200 - JC=J1 - JD=J2 - DAMAX=ABS(D(J1,J2)) - 200 CONTINUE - 210 CONTINUE - -C...Do one more subtraction of a row. - DAMAX=0D0 - DO 230 J3=JC+1,JC+3 - J1=J3-4*((J3-1)/4) - IF(J1.EQ.JA) GOTO 230 - RL=D(J1,JD)/D(JC,JD) - DO 220 J2=1,4 - IF(J2.EQ.JB) GOTO 220 - D(J1,J2)=D(J1,J2)-RL*D(JC,J2) - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 220 - JE=J1 - DAMAX=ABS(D(J1,J2)) - 220 CONTINUE - 230 CONTINUE - -C...Construct unnormalized eigenvector. - JF1=JD+1-4*(JD/4) - JF2=JD+2-4*((JD+1)/4) - IF(JF1.EQ.JB) JF1=JD+3-4*((JD+2)/4) - IF(JF2.EQ.JB) JF2=JD+3-4*((JD+2)/4) - E(JF1)=-D(JE,JF2) - E(JF2)=D(JE,JF1) - E(JD)=-(D(JC,JF1)*E(JF1)+D(JC,JF2)*E(JF2))/D(JC,JD) - E(JB)=-(D(JA,JF1)*E(JF1)+D(JA,JF2)*E(JF2)+D(JA,JD)*E(JD))/ - & D(JA,JB) - -C...Normalize and fill in final array. - EA=SQRT(E(1)**2+E(2)**2+E(3)**2+E(4)**2) - SGN=(-1D0)**INT(PYR(0)+0.5D0) - DO 240 J=1,4 - Z(I,J)=SGN*E(J)/EA - 240 CONTINUE - 250 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYERRM -C...Informs user of errors in program execution. - - SUBROUTINE PYERRM(MERR,CHMESS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local character variable. - 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 - IF(MSTU(29).EQ.0) 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 PYLIST(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',I9, - &' PYEXEC calls:'/5X,A) - 5100 FORMAT(/5X,'Error type',I2,' has occured after',I9, - &' PYEXEC 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',I9, - &' PYEXEC calls:'/5X,A/5X,'Execution will now be stopped!') - - RETURN - END - -C********************************************************************* - -C...PYEVNT -C...Administers the generation of a high-pT event via calls to -C...a number of subroutines. - - SUBROUTINE PYEVNT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT4/,/PYINT5/ -C...Local array. - DIMENSION VTX(4) - -C...Stop if no subprocesses on. - IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN - WRITE(MSTU(11),5100) - STOP - ENDIF - -C...Initial values for some counters. - N=0 - MINT(5)=MINT(5)+1 - MINT(7)=0 - MINT(8)=0 - MINT(83)=0 - MINT(84)=MSTP(126) - MSTU(24)=0 - MSTU70=0 - MSTJ14=MSTJ(14) - -C...If variable energies: redo incoming kinematics and cross-section. - MSTI(61)=0 - IF(MSTP(171).EQ.1) THEN - CALL PYINKI(1) - IF(MSTI(61).EQ.1) THEN - MINT(5)=MINT(5)-1 - RETURN - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(3,1) - CALL PYXTOT - ENDIF - -C...Loop over number of pileup events; check space left. - IF(MSTP(131).LE.0) THEN - NPILE=1 - ELSE - CALL PYPILE(2) - NPILE=MINT(81) - ENDIF - DO 250 IPILE=1,NPILE - IF(MINT(84)+100.GE.MSTU(4)) THEN - CALL PYERRM(11, - & '(PYEVNT:) no more space in PYJETS for pileup events') - IF(MSTU(21).GE.1) GOTO 260 - ENDIF - MINT(82)=IPILE - -C...Generate variables of hard scattering. - MINT(51)=0 - MSTI(52)=0 - 100 CONTINUE - IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 - MINT(31)=0 - MINT(51)=0 - MINT(57)=0 - CALL PYRAND - IF(MSTI(61).EQ.1) THEN - MINT(5)=MINT(5)-1 - RETURN - ENDIF - IF(MINT(51).EQ.2) RETURN - ISUB=MINT(1) - IF(MSTP(111).EQ.-1) GOTO 240 - - IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN -C...Hard scattering (including low-pT): -C...reconstruct kinematics and colour flow of hard scattering. - MINT31=MINT(31) - 110 MINT(31)=MINT31 - MINT(51)=0 - CALL PYSCAT - IF(MINT(51).EQ.1) GOTO 100 - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IF(ISUB.EQ.95) GOTO 120 - -C...Showering of initial state partons (optional). - NFIN=N - ALAMSV=PARJ(81) - PARJ(81)=PARP(72) - IF(MSTP(61).GE.1.AND.MINT(47).GE.2) CALL PYSSPA(IPU1,IPU2) - PARJ(81)=ALAMSV - IF(MINT(51).EQ.1) GOTO 100 - -C...Showering of final state partons (optional). - ALAMSV=PARJ(81) - PARJ(81)=PARP(72) - IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.2.AND.ISET(ISUB).LE.10) - & THEN - IPU3=MINT(84)+3 - IPU4=MINT(84)+4 - IF(ISET(ISUB).EQ.5) IPU4=-3 - QMAX=VINT(55) - IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55) - CALL PYSHOW(IPU3,IPU4,QMAX) - ELSEIF(ISET(ISUB).EQ.11) THEN - CALL PYADSH(NFIN) - ENDIF - PARJ(81)=ALAMSV - -C...Decay of final state resonances. - MINT(32)=0 - IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0) - IF(MINT(51).EQ.1) GOTO 100 - MINT(52)=N - -C...Multiple interactions. - IF(MSTP(81).GE.1.AND.MINT(50).EQ.1) CALL PYMULT(6) - MINT(53)=N - -C...Hadron remnants and primordial kT. - 120 CALL PYREMN(IPU1,IPU2) - IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO 110 - IF(MINT(51).EQ.1) GOTO 100 - - ELSEIF(ISUB.NE.99) THEN -C...Diffractive and elastic scattering. - CALL PYDIFF - - ELSE -C...DIS scattering (photon flux external). - CALL PYDISG - IF(MINT(51).EQ.1) GOTO 100 - ENDIF - -C...Check that no odd resonance left undecayed. - IF(MSTP(111).GE.1) THEN - NFIX=N - DO 130 I=MINT(84)+1,NFIX - IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. - & K(I,2).NE.22) THEN - KCA=PYCOMP(K(I,2)) - IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN - CALL PYRESD(I) - IF(MINT(51).EQ.1) GOTO 100 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - -C...Boost hadronic subsystem to overall rest frame. -C..(Only relevant when photon inside lepton beam.) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) - -C...Recalculate energies from momenta and masses (if desired). - IF(MSTP(113).GE.1) THEN - DO 140 I=MINT(83)+1,N - IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ - & P(I,2)**2+P(I,3)**2+P(I,5)**2) - 140 CONTINUE - NRECAL=N - ENDIF - -C...Rearrange partons along strings, check invariant mass cuts. - MSTU(28)=0 - IF(MSTP(111).LE.0) MSTJ(14)=-1 - CALL PYPREP(MINT(84)+1) - MSTJ(14)=MSTJ14 - IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 - IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN - DO 170 I=MINT(84)+1,N - IF(K(I,2).EQ.94) THEN - DO 160 I1=I+1,MIN(N,I+10) - IF(K(I1,3).EQ.I) THEN - K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5)) - IF(K(I1,3).EQ.0) THEN - DO 150 II=MINT(84)+1,I-1 - IF(K(II,2).EQ.K(I1,2)) THEN - IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR. - & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II - ENDIF - 150 CONTINUE - IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) - ENDIF - ENDIF - 160 CONTINUE - ENDIF - 170 CONTINUE - CALL PYEDIT(12) - CALL PYEDIT(14) - IF(MSTP(125).EQ.0) CALL PYEDIT(15) - IF(MSTP(125).EQ.0) MINT(4)=0 - DO 190 I=MINT(83)+1,N - IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN - DO 180 I1=I+1,N - IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1 - IF(K(I1,3).EQ.I) K(I,5)=I1 - 180 CONTINUE - ENDIF - 190 CONTINUE - ENDIF - -C...Introduce separators between sections in PYLIST event listing. - IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN - MSTU70=1 - MSTU(71)=N - ELSEIF(IPILE.EQ.1) THEN - MSTU70=3 - MSTU(71)=2 - MSTU(72)=MINT(4) - MSTU(73)=N - ENDIF - -C...Go back to lab frame (needed for vertices, also in fragmentation). - CALL PYFRAM(1) - -C...Set nonvanishing production vertex (optional). - IF(MSTP(151).EQ.1) THEN - DO 200 J=1,4 - VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* - & SIN(PARU(2)*PYR(0)) - 200 CONTINUE - DO 220 I=MINT(83)+1,N - DO 210 J=1,4 - V(I,J)=V(I,J)+VTX(J) - 210 CONTINUE - 220 CONTINUE - ENDIF - -C...Perform hadronization (if desired). - IF(MSTP(111).GE.1) THEN - CALL PYEXEC - IF(MSTU(24).NE.0) GOTO 100 - ENDIF - IF(MSTP(113).GE.1) THEN - DO 230 I=NRECAL,N - IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+ - & P(I,2)**2+P(I,3)**2+P(I,5)**2) - 230 CONTINUE - ENDIF - IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14) - -C...Store event information and calculate Monte Carlo estimates of -C...subprocess cross-sections. - 240 IF(IPILE.EQ.1) CALL PYDOCU - -C...Set counters for current pileup event and loop to next one. - MSTI(41)=IPILE - IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB - IF(MSTU70.LT.10) THEN - MSTU70=MSTU70+1 - MSTU(70+MSTU70)=N - ENDIF - MINT(83)=N - MINT(84)=N+MSTP(126) - IF(IPILE.LT.NPILE) CALL PYFRAM(2) - 250 CONTINUE - -C...Generic information on pileup events. Reconstruct missing history. - IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN - PARI(91)=VINT(132) - PARI(92)=VINT(133) - PARI(93)=VINT(134) - IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) - ENDIF - CALL PYEDIT(16) - -C...Transform to the desired coordinate frame. - 260 CALL PYFRAM(MSTP(124)) - MSTU(70)=MSTU70 - PARU(21)=VINT(1) - -C...Error messages - 5100 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution stopped.') - - RETURN - END - -C********************************************************************* - -C...PYEVWT -C...Dummy routine, which the user can replace in order to multiply the -C...standard PYTHIA differential cross-section by a process- and -C...kinematics-dependent factor WTXS. For MSTP(142)=1 this corresponds -C...to generation of weighted events, with weight 1/WTXS, while for -C...MSTP(142)=2 it corresponds to a modification of the underlying -C...physics. - - SUBROUTINE PYEVWT(WTXS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYINT1/,/PYINT2/ - -C...Set default weight for WTXS. - WTXS=1D0 - -C...Read out subprocess number. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - -C...Read out tau, y*, cos(theta), tau' (where defined, else =0). - TAU=VINT(21) - YST=VINT(22) - CTH=0D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) - TAUP=0D0 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) - -C...Read out x_1, x_2, x_F, shat, that, uhat, p_T^2. - X1=VINT(41) - X2=VINT(42) - XF=X1-X2 - SHAT=VINT(44) - THAT=VINT(45) - UHAT=VINT(46) - PT2=VINT(48) - -C...Modifications by user to be put here. - -C...Stop program if this routine is ever called. -C...You should not copy these lines to your own routine. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYEVWT routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYEXEC -C...Administrates the fragmentation and decay chain. - - SUBROUTINE PYEXEC - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYINT4/ -C...Local array. - DIMENSION PS(2,6),IJOIN(100) - -C...Initialize and reset. - MSTU(24)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - MSTU(29)=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)=0D0 - 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)+PYCHGE(K(I,2)) - 130 CONTINUE - PARU(21)=PS(1,4) - -C...Start by all decays of coloured resonances involved in shower. - NORIG=N - DO 140 I=1,NORIG - IF(K(I,1).EQ.3) THEN - KC=PYCOMP(K(I,2)) - IF(MWID(KC).NE.0.AND.KCHG(KC,2).NE.0) CALL PYRESD(I) - ENDIF - 140 CONTINUE - -C...Prepare system for subsequent fragmentation/decay. - CALL PYPREP(0) - -C...Loop through jet fragmentation and particle decays. - MBE=0 - 150 MBE=MBE+1 - IP=0 - 160 IP=IP+1 - KC=0 - IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=PYCOMP(K(IP,2)) - IF(KC.EQ.0) THEN - -C...Deal with any remaining undecayed resonance -C...(normally the task of PYEVNT, so seldom used). - ELSEIF(MWID(KC).NE.0) THEN - IBEG=IP - IF(KCHG(KC,2).NE.0.AND.K(I,1).NE.3) THEN - IBEG=IP+1 - 170 IBEG=IBEG-1 - IF(IBEG.GE.2.AND.K(IBEG,1).EQ.2) GOTO 170 - IF(K(IBEG,1).NE.2) IBEG=IBEG+1 - IEND=IP-1 - 180 IEND=IEND+1 - IF(IEND.LT.N.AND.K(IEND,1).EQ.2) GOTO 180 - IF(IEND.LT.N.AND.KCHG(PYCOMP(K(IEND,2)),2).EQ.0) GOTO 180 - NJOIN=0 - DO 190 I=IBEG,IEND - IF(KCHG(PYCOMP(K(IEND,2)),2).NE.0) THEN - NJOIN=NJOIN+1 - IJOIN(NJOIN)=I - ENDIF - 190 CONTINUE - ENDIF - CALL PYRESD(IP) - CALL PYPREP(IBEG) - -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 PYDECY(IP) - -C...Decay products may develop a shower. - IF(MSTJ(92).GT.0) THEN - IP1=MSTJ(92) - QMAX=SQRT(MAX(0D0,(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 PYSHOW(IP1,IP1+1,QMAX) - CALL PYPREP(IP1) - MSTJ(92)=0 - ELSEIF(MSTJ(92).LT.0) THEN - IP1=-MSTJ(92) - CALL PYSHOW(IP1,-3,P(IP,5)) - CALL PYPREP(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(PYCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) - ENDIF - ENDIF - IF(MFRAG.EQ.1) CALL PYSTRF(IP) - IF(MFRAG.EQ.2) CALL PYINDF(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 PYJETS 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 160 - ELSEIF(IP.LT.N) THEN - CALL PYERRM(11,'(PYEXEC:) no more memory left in PYJETS') - ENDIF - -C...Include simple Bose-Einstein effect parametrization if desired. - IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN - CALL PYBOEI(NSAV) - GOTO 150 - ENDIF - -C...Check that momentum, energy and charge were conserved. - DO 210 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 210 - DO 200 J=1,4 - PS(2,J)=PS(2,J)+P(I,J) - 200 CONTINUE - PS(2,6)=PS(2,6)+PYCHGE(K(I,2)) - 210 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)))/(1D0+ABS(PS(2,4))+ABS(PS(1,4))) - IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL PYERRM(15, - &'(PYEXEC:) four-momentum was not conserved') - IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1D0) CALL PYERRM(15, - &'(PYEXEC:) charge was not conserved') - - RETURN - END - -C********************************************************************* - -C...PYFACT -C...Multiplies histogram contents by factor. - - SUBROUTINE PYFACT(ID,F) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Find initial address in memory. Multiply all contents bins. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFACT:) not allowed histogram number') - IS=INDX(ID) - IF(IS.EQ.0) CALL PYERRM(28, - &'(PYFACT:) scaling unbooked histogram') - DO 100 IX=IS+6,IS+8+NINT(BIN(IS+1)) - BIN(IX)=F*BIN(IX) - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYFILL -C...Fills entry in histogram. - - SUBROUTINE PYFILL(ID,X,W) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Find initial address in memory. Increase number of entries. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFILL:) not allowed histogram number') - IS=INDX(ID) - IF(IS.EQ.0) CALL PYERRM(28, - &'(PYFILL:) filling unbooked histogram') - BIN(IS+5)=BIN(IS+5)+1D0 - -C...Find bin in x, including under/overflow, and fill. - IF(X.LT.BIN(IS+2)) THEN - BIN(IS+6)=BIN(IS+6)+W - ELSEIF(X.GE.BIN(IS+3)) THEN - BIN(IS+8)=BIN(IS+8)+W - ELSE - BIN(IS+7)=BIN(IS+7)+W - IX=(X-BIN(IS+2))/BIN(IS+4) - IX=MAX(0,MIN(NINT(BIN(IS+1))-1,IX)) - BIN(IS+9+IX)=BIN(IS+9+IX)+W - ENDIF - - RETURN - END - - - - - -C********************************************************************* - -C...PYFINT -C...Auxiliary routine to PYPOLE for SUSY Higgs calculations. - - FUNCTION PYFINT(A,B,C) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYINTS/XXM(20) - SAVE/PYINTS/ - -C...Local variables. - EXTERNAL PYFISB - DOUBLE PRECISION PYFISB - - XXM(1)=A - XXM(2)=B - XXM(3)=C - XLO=0D0 - XHI=1D0 - PYFINT = PYGAUS(PYFISB,XLO,XHI,1D-3) - - RETURN - END - -C********************************************************************* - -C...PYFISB -C...Auxiliary routine to PYFINT for SUSY Higgs calculations. - - FUNCTION PYFISB(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYINTS/XXM(20) - SAVE/PYINTS/ - - PYFISB = LOG(ABS(X*XXM(2)+(1-X)*XXM(3)-X*(1-X)*XXM(1))/ - &(X*(XXM(2)-XXM(3))+XXM(3))) - - RETURN - END - -C********************************************************************* - -C...PYFOWO -C...Calculates the first few Fox-Wolfram moments. - - SUBROUTINE PYFOWO(H10,H20,H30,H40) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Copy momenta for particles and calculate H0. - NP=0 - H0=0D0 - HD=0D0 - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 110 - ENDIF - IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYFOWO:) no more memory left in PYJETS') - H10=-1D0 - H20=-1D0 - H30=-1D0 - H40=-1D0 - 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 PYERRM(8,'(PYFOWO:) too few particles for analysis') - H10=-1D0 - H20=-1D0 - H30=-1D0 - H40=-1D0 - RETURN - ENDIF - -C...Calculate H1 - H4. - H10=0D0 - H20=0D0 - H30=0D0 - H40=0D0 - 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.5D0*CTHE**2-0.5D0) - H30=H30+P(I1,4)*P(I2,4)*(2.5D0*CTHE**3-1.5D0*CTHE) - H40=H40+P(I1,4)*P(I2,4)*(4.375D0*CTHE**4-3.75D0*CTHE**2+ - & 0.375D0) - 120 CONTINUE - 130 CONTINUE - -C...Calculate H1/H0 - H4/H0. Output. - MSTU(61)=N+1 - MSTU(62)=NP - H10=(HD+2D0*H10)/H0 - H20=(HD+2D0*H20)/H0 - H30=(HD+2D0*H30)/H0 - H40=(HD+2D0*H40)/H0 - - RETURN - END - -C********************************************************************* - -C...PYFRAM -C...Performs transformations between different coordinate frames. - - SUBROUTINE PYFRAM(IFRAME) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ - -C...Check that transformation can and should be done. - IF(IFRAME.EQ.1.OR.IFRAME.EQ.2.OR.(IFRAME.EQ.3.AND. - &MINT(91).EQ.1)) THEN - IF(IFRAME.EQ.MINT(6)) RETURN - ELSE - WRITE(MSTU(11),5000) IFRAME,MINT(6) - RETURN - ENDIF - - IF(MINT(6).EQ.1) THEN -C...Transform from fixed target or user specified frame to -C...overall CM frame. - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - ELSEIF(MINT(6).EQ.3) THEN -C...Transform from hadronic CM frame in DIS to overall CM frame. - CALL PYROBO(0,0,-VINT(221),-VINT(222),-VINT(223),-VINT(224), - & -VINT(225)) - ENDIF - - IF(IFRAME.EQ.1) THEN -C...Transform from overall CM frame to fixed target or user specified -C...frame. - CALL PYROBO(0,0,VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) - ELSEIF(IFRAME.EQ.3) THEN -C...Transform from overall CM frame to hadronic CM frame in DIS. - CALL PYROBO(0,0,0D0,0D0,VINT(223),VINT(224),VINT(225)) - CALL PYROBO(0,0,0D0,VINT(222),0D0,0D0,0D0) - CALL PYROBO(0,0,VINT(221),0D0,0D0,0D0,0D0) - ENDIF - -C...Set information about new frame. - MINT(6)=IFRAME - MSTI(6)=IFRAME - - 5000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X, - &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', - &1X,I5) - - RETURN - END -C********************************************************************* - -C...PYGAGA -C...For lepton beams it gives photon-hadron or photon-photon systems -C...to be treated with the ordinary machinery and combines this with a -C...description of the lepton -> lepton + photon branching. - - SUBROUTINE PYGAGA(IGAGA,WTGAGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - DOUBLE PRECISION minq2 - DOUBLE PRECISION rccorr,sigobs,sigtrue - DOUBLE PRECISION pyth_xsec - include "mcRadCor.inc" - include "mc_set.inc" - include "radgen.inc" - include "phiout.inc" - - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT5/ -C...Local variables and data statement. - DIMENSION PMS(2),XMIN(2),XMAX(2),Q2MIN(2),Q2MAX(2),PMC(3), - &X(2),Q2(2),Y(2),THETA(2),PHI(2),PT(2),BETA(3) - SAVE PMS,XMIN,XMAX,Q2MIN,Q2MAX,PMC,X,Q2,THETA,PHI,PT,W2MIN, - & YMIN,YMAX - DATA EPS/1D-4/ - -C...Initialize generation of photons inside leptons. - IF(IGAGA.EQ.1) THEN - -C...Save quantities on incoming lepton system. - VINT(301)=VINT(1) - VINT(302)=VINT(2) - PMS(1)=VINT(303)**2 - IF(MINT(141).EQ.0) PMS(1)=SIGN(VINT(3)**2,VINT(3)) - PMS(2)=VINT(304)**2 - IF(MINT(142).EQ.0) PMS(2)=SIGN(VINT(4)**2,VINT(4)) - PMC(3)=VINT(302)-PMS(1)-PMS(2) - W2MIN=MAX(CKIN(77),2D0*CKIN(3),2D0*CKIN(5))**2 - -C...Calculate range of x and Q2 values allowed in generation. - DO 100 I=1,2 - PMC(I)=VINT(302)+PMS(I)-PMS(3-I) - IF(MINT(140+I).NE.0) THEN - XMIN(I)=MAX(CKIN(59+2*I),EPS) - XMAX(I)=MIN(CKIN(60+2*I),1D0-2D0*VINT(301)*SQRT(PMS(I))/ - & PMC(I),1D0-EPS) - YMIN=MAX(CKIN(71+2*I),EPS) - YMAX=MIN(CKIN(72+2*I),1D0-EPS) - IF(CKIN(64+2*I).GT.0D0) XMIN(I)=MAX(XMIN(I), - & (YMIN*PMC(3)-CKIN(64+2*I))/PMC(I)) - XMAX(I)=MIN(XMAX(I),(YMAX*PMC(3)-CKIN(63+2*I))/PMC(I)) - THEMIN=MAX(CKIN(67+2*I),0D0) - THEMAX=MIN(CKIN(68+2*I),PARU(1)) - IF(CKIN(68+2*I).LT.0D0) THEMAX=PARU(1) - Q2MIN(I)=MAX(CKIN(63+2*I),XMIN(I)**2*PMS(I)/(1D0-XMIN(I))+ - & ((1D0-XMAX(I))*(VINT(302)-2D0*PMS(3-I))- - & 2D0*PMS(I)/(1D0-XMAX(I)))*SIN(THEMIN/2D0)**2,0D0) - Q2MAX(I)=XMAX(I)**2*PMS(I)/(1D0-XMAX(I))+ - & ((1D0-XMIN(I))*(VINT(302)-2D0*PMS(3-I))- - & 2D0*PMS(I)/(1D0-XMIN(I)))*SIN(THEMAX/2D0)**2 - IF(CKIN(64+2*I).GT.0D0) Q2MAX(I)=MIN(CKIN(64+2*I),Q2MAX(I)) -C...W limits when lepton on one side only. - IF(MINT(143-I).EQ.0) THEN - XMIN(I)=MAX(XMIN(I),(W2MIN-PMS(3-I))/PMC(I)) - IF(CKIN(78).GT.0D0) XMAX(I)=MIN(XMAX(I), - & (CKIN(78)**2-PMS(3-I))/PMC(I)) - ENDIF - ENDIF - 100 CONTINUE - -C...W limits when lepton on both sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - IF(CKIN(78).GT.0D0) XMAX(1)=MIN(XMAX(1), - & (CKIN(78)**2+PMC(3)-PMC(2)*XMIN(2))/PMC(1)) - IF(CKIN(78).GT.0D0) XMAX(2)=MIN(XMAX(2), - & (CKIN(78)**2+PMC(3)-PMC(1)*XMIN(1))/PMC(2)) - IF(IABS(MINT(141)).NE.IABS(MINT(142))) THEN - XMIN(1)=MAX(XMIN(1),(PMS(1)-PMS(2)+VINT(302)*(W2MIN- - & PMS(1)-PMS(2))/(PMC(2)*XMAX(2)+PMS(1)-PMS(2)))/PMC(1)) - XMIN(2)=MAX(XMIN(2),(PMS(2)-PMS(1)+VINT(302)*(W2MIN- - & PMS(1)-PMS(2))/(PMC(1)*XMAX(1)+PMS(2)-PMS(1)))/PMC(2)) - ELSE - XMIN(1)=MAX(XMIN(1),W2MIN/(VINT(302)*XMAX(2))) - XMIN(2)=MAX(XMIN(2),W2MIN/(VINT(302)*XMAX(1))) - ENDIF - ENDIF - -C...Q2 and W values and photon flux weight factors for initialization. - ELSEIF(IGAGA.EQ.2) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...W value for photon on one or both sides, and for processes -C...with gamma-gamma cross section peaked at small shat. - IF(MINT(141).NE.0.AND.MINT(142).EQ.0) THEN - VINT(2)=VINT(302)+PMS(1)-PMC(1)*(1D0-XMAX(1)) - ELSEIF(MINT(141).EQ.0.AND.MINT(142).NE.0) THEN - VINT(2)=VINT(302)+PMS(2)-PMC(2)*(1D0-XMAX(2)) - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN - VINT(2)=MAX(CKIN(77)**2,12D0*MAX(CKIN(3),CKIN(5))**2) - IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) - ELSE - VINT(2)=XMAX(1)*XMAX(2)*VINT(302) - IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) - ENDIF - VINT(1)=SQRT(MAX(0D0,VINT(2))) - -C...Upper estimate of photon flux weight factor. -C...Initialization Q2 scale. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 110 I=1,2 - IF(MINT(140+I).NE.0) THEN - IF(MSTP(199).EQ.1) then - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & (LOG(mcSet_YMax/mcSet_YMin))*(LOG(mcSet_Q2Max/mcSet_Q2Min)) - ELSE - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) - ENDIF - IF(ISUB.EQ.99.AND.MINT(106+I).EQ.4.AND.MINT(109-I).EQ.3) - & THEN - Q2INIT=5D0+Q2MIN(3-I) - ELSEIF(ISUB.EQ.99.AND.MINT(106+I).EQ.4) THEN - Q2INIT=PMAS(PYCOMP(113),1)**2+Q2MIN(3-I) - ELSEIF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - Q2INIT=MAX(CKIN(1),2D0*CKIN(3),2D0*CKIN(5))**2/3D0 - ELSEIF((ISUB.EQ.138.AND.I.EQ.2).OR. - & (ISUB.EQ.139.AND.I.EQ.1)) THEN - Q2INIT=VINT(2)/3D0 - ELSEIF(ISUB.EQ.140) THEN - Q2INIT=VINT(2)/2D0 - ELSE - Q2INIT=Q2MIN(I) - ENDIF - VINT(2+I)=-SQRT(MAX(Q2MIN(I),MIN(Q2MAX(I),Q2INIT))) - IF(MSTP(14).EQ.0.OR.(ISUB.GE.131.AND.ISUB.LE.140)) - & MINT(14+I)=22 - VINT(306+I)=VINT(2+I)**2 - ENDIF - 110 CONTINUE - VINT(320)=WTGAGA - -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - VINT(318)=VINT(317) - -C...Generate photons inside leptons and -C...calculate photon flux weight factors. - ELSEIF(IGAGA.EQ.3) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...Generate phase space point and check against cuts. - LOOP=0 - 120 LOOP=LOOP+1 - DO 130 I=1,2 - IF(MINT(140+I).NE.0) THEN -C...Pick x and Q2 - X(I)=XMIN(I)*(XMAX(I)/XMIN(I))**PYR(0) - Q2(I)=Q2MIN(I)*(Q2MAX(I)/Q2MIN(I))**PYR(0) -C...Cuts on internal consistency in x and Q2. - IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) GOTO 120 - IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- - & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) GOTO 120 -C...Cuts on y and theta. - Y(I)=(PMC(I)*X(I)+Q2(I))/PMC(3) - IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) GOTO 120 - RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ - & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) - THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) - IF(THETA(I).LT.CKIN(67+2*I)) GOTO 120 - IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) - & GOTO 120 - -C...Phi angle isotropic. Reconstruct pT. - PHI(I)=PARU(2)*PYR(0) - PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- - & PMS(I))*SIN(THETA(I)) - -C...Store info on variables selected, for documentation purposes. - VINT(2+I)=-SQRT(Q2(I)) - VINT(304+I)=X(I) - VINT(306+I)=Q2(I) - VINT(308+I)=Y(I) - VINT(310+I)=THETA(I) - VINT(312+I)=PHI(I) - ELSE - VINT(304+I)=1D0 - VINT(306+I)=0D0 - VINT(308+I)=1D0 - VINT(310+I)=0D0 - VINT(312+I)=0D0 - ENDIF - 130 CONTINUE - -C...Cut on W combines info from two sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- - & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* - & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* - & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) - IF(W2.LT.W2MIN) GOTO 120 - IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 120 - PMS1=-Q2(1) - PMS2=-Q2(2) - ELSEIF(MINT(141).NE.0) THEN - W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) - PMS1=-Q2(1) - PMS2=PMS(2) - ELSEIF(MINT(142).NE.0) THEN - W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) - PMS1=PMS(1) - PMS2=-Q2(2) - ENDIF - -C...Store kinematics info for photon(s) in subsystem cm frame. - VINT(2)=W2 - VINT(1)=SQRT(W2) - VINT(291)=0D0 - VINT(292)=0D0 - VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) - VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) - VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) - VINT(296)=0D0 - VINT(297)=0D0 - VINT(298)=-VINT(293) - VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) - VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) - -C...Assign weight for photon flux; different for transverse and -C...longitudinal photons. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 140 I=1,2 - IF(MINT(140+I).NE.0) THEN - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) - IF(MSTP(16).EQ.0) THEN - XY=X(I) - ELSE - WTGAGA=WTGAGA*X(I)/Y(I) - XY=Y(I) - ENDIF - WTGAGA1=WTGAGA - IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - pmass=PYMASS(2212) - WTGAGA=WTGAGA*(1D0/(1D0+(Q2(I)/XY**2/ - & VINT(290)**2))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2)))/ - & Q2(I)/XY**2/VINT(290)* - & (VINT(290)*XY-Q2(I)/2D0/pmass)*XY*Q2(I) - ELSE - WTGAGA=WTGAGA*(1D0-XY) - ENDIF - ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - emass=PYMASS(11) - pmass=PYMASS(2212) - tmp=0.5D0*((VINT(290)*XY-Q2(I)/2D0/ - & pmass)/Q2(I)/XY**2/VINT(290)* - & (XY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XY**2/VINT(290)**2)))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2))))* - & XY*Q2(I) - WTGAGA=WTGAGA*(0.5D0*((VINT(290)*XY-Q2(I)/2D0/ - & pmass)/Q2(I)/XY**2/VINT(290)* - & (XY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XY**2/VINT(290)**2)))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2))))* - & XY*Q2(I)) - WTGAGA1=WTGAGA1*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ELSE - WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ENDIF - IF(MINT(106+I).EQ.0) MINT(14+I)=22 - ENDIF - 140 CONTINUE - VINT(319)=WTGAGA - MINT(143)=LOOP - -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - -C...Generate photons inside leptons and -C...calculate photon flux weight factors. - ELSEIF(IGAGA.EQ.5) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...Generate phase space point and check against cuts. - LOOP=0 - 121 LOOP=LOOP+1 - DO 131 I=1,2 - IF(MINT(140+I).NE.0) THEN -C...Pick x and Q2 - MINT(199)=0 - geny=mcSet_YMin*(mcSet_YMax/mcSet_YMin)**PYR(0) - genQ2=mcSet_Q2Min*(mcSet_Q2Max/mcSet_Q2Min)**PYR(0) - gennu=geny*VINT(290) - genx = genQ2 / (2D0*gennu*PYMASS(2212)) - genW2 = PYMASS(2212)**2D0+(2D0*PYMASS(2212)*gennu)-genQ2 -C....Check to have sensible ranges for variables - geneprim = VINT(290) - gennu - genpprim = sngl(sqrt(dble(geneprim)**2-pymass(11)**2)) - minq2 = PMS(1) * geny**2 / (1.- geny) - if (genQ2.lt.minq2) then - GOTO 121 - endif - if (genQ2.gt.(2D0*gennu*PYMASS(2212))) then - GOTO 121 - endif - temp = (genQ2-minq2)/(4.*VINT(290)*geneprim) - if (temp.lt.0.or.temp.gt.1.) then - GOTO 121 - endif - if ((genW2.lt.CKIN(77)**2).or. - & (CKIN(78).gt.0.and.genW2.gt.CKIN(78)**2)) then - GOTO 121 - endif - genthe = 2.*asin(sqrt(temp)) - genphi=PARU(2)*PYR(0) - PHI(I)=dble(genphi) - - ppt=tan(dble(genthe)) - ppx=ppt*cos(PHI(I)) - ppy=ppt*sin(PHI(I)) - - ntries=0 - 122 if (qedrad.eq.1) then - call radgen_event - endif - if (qedrad.eq.0) then - Y(I)=dble(geny) - Q2(I)=dble(genq2) - elseif ((mcRadCor_EBrems.eq.mcRadCor_EBrems).and. - & (mcRadCor_ThetaBrems.eq.mcRadCor_ThetaBrems)) then - Y(I)=dble(mcRadCor_NuTrue)/VINT(290) - Q2(I)=dble(mcRadCor_Q2True) - else - write(*,*)"I go to 122 again" - write(*,*) mcRadCor_ThetaBrems,mcRadCor_EBrems,mcEvent_iEvent - GOTO 122 - endif - X(I)=((PMC(3)*Y(I))-Q2(I))/PMC(I) -C P.L. ...An event with W^2_T<4will be generated new by RADGEN at the -C ...same kinematic point, the number of tries needed by RADGEN is -C ...counted and saved in the variable rcweight! - IF (qedrad.ne.0) then - IF((mcradcor_cType.eq.'qela').or.(mcradcor_cType.eq.'elas')) then - GOTO 122 - ENDIF - IF(dble(mcRadCor_W2True).LT. - & (CKIN(77)**2-1.D-4*abs(CKIN(77)**2))) THEN - MINT(199)=MINT(199)+1 -C write(*,*) "W2true: ",mcRadCor_W2True,MINT(199) - GOTO 122 - ENDIF - ENDIF - ntries=ntries+1 - IF(ntries.ge.20) GOTO 121 - -C ...... New try to implement weights directly into Pythia - sigobs=0.0D0 - sigtrue=0.0D0 - rccorr=1.0D0 - if (qedrad.eq.1) then - call MKF2(dble(genq2),dble(genx), - + mcSet_TarA,mcSet_TarZ,py6f2,py6f1) - sigobs=pyth_xsec(dble(genx), dble(genq2),py6f1, py6f2) - IF(mcRadCor_EBrems.eq.0) THEN - IF (sig1g.gt.0.D0) then - rccorr=(tbor+tine)/sig1g/(DBLE(MINT(199))+1.0D0) - ELSE - rccorr=0.D0 - ENDIF - ELSEIF(mcRadCor_EBrems.gt.0) THEN - call MKF2(Q2(I),dble(mcRadCor_XTrue), - + mcSet_TarA,mcSet_TarZ,py6f2,py6f1) - sigtrue=pyth_xsec(dble(mcRadCor_XTrue),Q2(I),py6f1, py6f2) - IF ((sig1g.gt.0.D0).and.(sigtrue.gt.0.D0)) then - rccorr=(tbor+tine)/sig1g*sigobs/sigtrue/(DBLE(MINT(199))+1.0D0) - ELSE - rccorr=0.D0 - ENDIF - ENDIF - ENDIF - IF(X(I).GT.(XMAX(I)+1.D-4*abs(XMAX(I)))) THEN - GOTO 121 - ENDIF -C...Cuts on internal consistency in x and Q2. - IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) then - GOTO 121 - endif - IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- - & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) THEN - GOTO 121 - ENDIF -C...Cuts on y and theta. - IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) THEN - GOTO 121 - ENDIF - RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ - & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) - THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) - IF(THETA(I).LT.CKIN(67+2*I)) THEN - GOTO 121 - ENDIF - IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) - & GOTO 121 - -C...Phi angle isotropic. Reconstruct pT. - PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- - & PMS(I))*SIN(THETA(I)) -C ... try 'new' phi - IF ((qedrad.ne.0).and.(mcRadCor_EBrems.gt.0)) then - emom=sqrt(dble(geneprim)**2-pymass(11)**2) - PHI(I)=atan2((emom*ppy+dplabg(2)),(emom*ppx+dplabg(1))) - IF (PHI(I).lt.0) THEN - PHI(I)=PHI(I)+PARU(2) - ENDIF - ENDIF -C...Store info on variables selected, for documentation purposes. - VINT(2+I)=-SQRT(Q2(I)) - VINT(304+I)=X(I) - VINT(306+I)=Q2(I) - VINT(308+I)=Y(I) - VINT(310+I)=THETA(I) - VINT(312+I)=PHI(I) - ELSE - VINT(304+I)=1D0 - VINT(306+I)=0D0 - VINT(308+I)=1D0 - VINT(310+I)=0D0 - VINT(312+I)=0D0 - ENDIF - 131 CONTINUE - -C...Cut on W combines info from two sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- - & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* - & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* - & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) - IF(W2.LT.W2MIN) THEN - GOTO 121 - ENDIF - IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 121 - PMS1=-Q2(1) - PMS2=-Q2(2) - ELSEIF(MINT(141).NE.0) THEN - W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) - PMS1=-Q2(1) - PMS2=PMS(2) - ELSEIF(MINT(142).NE.0) THEN - W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) - PMS1=PMS(1) - PMS2=-Q2(2) - ENDIF - -C...Store kinematics info for photon(s) in subsystem cm frame. - VINT(2)=W2 - VINT(1)=SQRT(W2) - VINT(291)=0D0 - VINT(292)=0D0 - VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) - VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) - VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) - VINT(296)=0D0 - VINT(297)=0D0 - VINT(298)=-VINT(293) - VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) - VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) - -C...Assign weight for photon flux; different for transverse and -C...longitudinal photons. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 141 I=1,2 - IF(MINT(140+I).NE.0) THEN - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & (LOG(mcSet_YMax)-LOG(mcSet_YMin))* - & (LOG(mcSet_Q2Max)-LOG(mcSet_Q2Min)) - XY=Y(I) - IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - pmass=PYMASS(2212) - beam=VINT(290) - XXY=XY*VINT(290)/beam - WTGAGA=WTGAGA*(1D0/(1D0+(Q2(I)/XXY**2/beam**2))* - & (1D0-XXY-(Q2(I)/4D0/beam**2)))/ - & Q2(I)/XXY**2/beam* - & (beam*XXY-Q2(I)/2D0/pmass)*XXY*Q2(I) - ELSE - WTGAGA=WTGAGA*(1D0-XY) - ENDIF - ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - emass=PYMASS(11) - pmass=PYMASS(2212) - beam=VINT(290) - XXY=XY*VINT(290)/beam - WTGAGA=WTGAGA*(0.5D0*((beam*XXY-Q2(I)/2D0/ - & pmass)/Q2(I)/XXY**2/beam* - & (XXY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XXY**2/beam**2)))* - & (1D0-XXY-(Q2(I)/4D0/beam**2))))*XXY*Q2(I)) - ELSE - WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ENDIF - IF(MINT(106+I).EQ.0) MINT(14+I)=22 - ENDIF - 141 CONTINUE - WTGAGA=WTGAGA*rccorr - VINT(319)=WTGAGA - MINT(143)=LOOP -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - -C...Reconstruct kinematics of photons inside leptons. - ELSEIF(IGAGA.EQ.4) THEN - -C...Make place for incoming particles and scattered leptons. - MOVE=3 - IF(MINT(141).NE.0.AND.MINT(142).NE.0) MOVE=4 - MINT(4)=MINT(4)+MOVE - DO 160 I=MINT(84)-MOVE,MINT(83)+1,-1 - IF(K(I,1).EQ.21) THEN - DO 150 J=1,5 - K(I+MOVE,J)=K(I,J) - P(I+MOVE,J)=P(I,J) - V(I+MOVE,J)=V(I,J) - 150 CONTINUE - IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) - & K(I+MOVE,3)=K(I,3)+MOVE - IF(K(I,4).GT.MINT(83).AND.K(I,4).LE.MINT(84)) - & K(I+MOVE,4)=K(I,4)+MOVE - IF(K(I,5).GT.MINT(83).AND.K(I,5).LE.MINT(84)) - & K(I+MOVE,5)=K(I,5)+MOVE - ENDIF - 160 CONTINUE - DO 170 I=MINT(84)+1,N - IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) - & K(I,3)=K(I,3)+MOVE - 170 CONTINUE - -C...Fill in incoming particles. - DO 190 I=MINT(83)+1,MINT(83)+MOVE - DO 180 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 180 CONTINUE - 190 CONTINUE - DO 200 I=1,2 - K(MINT(83)+I,1)=21 - IF(MINT(140+I).NE.0) THEN - K(MINT(83)+I,2)=MINT(140+I) - P(MINT(83)+I,5)=VINT(302+I) - ELSE - K(MINT(83)+I,2)=MINT(10+I) - P(MINT(83)+I,5)=VINT(2+I) - ENDIF - P(MINT(83)+I,3)=0.5D0*SQRT((PMC(3)**2-4D0*PMS(1)*PMS(2))/ - & VINT(302))*(-1D0)**(I+1) - P(MINT(83)+I,4)=0.5D0*PMC(I)/VINT(301) - 200 CONTINUE - -C...New mother-daughter relations in documentation section. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+3 - K(MINT(83)+1,5)=MINT(83)+5 - K(MINT(83)+2,4)=MINT(83)+4 - K(MINT(83)+2,5)=MINT(83)+6 - K(MINT(83)+3,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+1 - K(MINT(83)+4,3)=MINT(83)+2 - K(MINT(83)+6,3)=MINT(83)+2 - ELSEIF(MINT(141).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+3 - K(MINT(83)+1,5)=MINT(83)+4 - K(MINT(83)+2,4)=MINT(83)+5 - K(MINT(83)+3,3)=MINT(83)+1 - K(MINT(83)+4,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+2 - ELSEIF(MINT(142).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+4 - K(MINT(83)+2,4)=MINT(83)+3 - K(MINT(83)+2,5)=MINT(83)+5 - K(MINT(83)+3,3)=MINT(83)+2 - K(MINT(83)+4,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+2 - ENDIF - -C...Fill scattered lepton(s). - DO 210 I=1,2 - IF(MINT(140+I).NE.0) THEN - LSC=MINT(83)+MIN(I+2,MOVE) - K(LSC,1)=21 - K(LSC,2)=MINT(140+I) - P(LSC,1)=PT(I)*COS(PHI(I)) - P(LSC,2)=PT(I)*SIN(PHI(I)) - P(LSC,4)=(1D0-X(I))*P(MINT(83)+I,4) - P(LSC,3)=SQRT(P(LSC,4)**2-PMS(I))*COS(THETA(I))* - & (-1D0)**(I-1) - P(LSC,5)=VINT(302+I) - ENDIF - 210 CONTINUE - -C...Find incoming four-vectors to subprocess. - K(N+1,1)=21 - IF(MINT(141).NE.0) THEN - DO 220 J=1,4 - P(N+1,J)=P(MINT(83)+1,J)-P(MINT(83)+3,J) - 220 CONTINUE - ELSE - DO 230 J=1,4 - P(N+1,J)=P(MINT(83)+1,J) - 230 CONTINUE - ENDIF - K(N+2,1)=21 - IF(MINT(142).NE.0) THEN - DO 240 J=1,4 - P(N+2,J)=P(MINT(83)+2,J)-P(MINT(83)+MOVE,J) - 240 CONTINUE - ELSE - DO 250 J=1,4 - P(N+2,J)=P(MINT(83)+2,J) - 250 CONTINUE - ENDIF - -C...Define boost and rotation between hadronic subsystem and -C...collision rest frame; boost hadronic subsystem to this frame. - DO 260 J=1,3 - BETA(J)=(P(N+1,J)+P(N+2,J))/(P(N+1,4)+P(N+2,4)) - 260 CONTINUE - CALL PYROBO(N+1,N+2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - BPHI=PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+2,0D0,-BPHI,0D0,0D0,0D0) - BTHETA=PYANGL(P(N+1,3),P(N+1,1)) - CALL PYROBO(MINT(83)+MOVE+1,N,BTHETA,BPHI,BETA(1),BETA(2), - & BETA(3)) - -C...Add on scattered leptons to final state. - DO 280 I=1,2 - IF(MINT(140+I).NE.0) THEN - LSC=MINT(83)+MIN(I+2,MOVE) - N=N+1 - DO 270 J=1,5 - K(N,J)=K(LSC,J) - P(N,J)=P(LSC,J) - V(N,J)=V(LSC,J) - 270 CONTINUE - K(N,1)=1 - K(N,3)=LSC - ENDIF - 280 CONTINUE - ENDIF - - 290 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYGAMM -C...Gives ordinary Gamma function Gamma(x) for positive, real arguments; -C...see M. Abramowitz, I. A. Stegun: Handbook of Mathematical Functions -C...(Dover, 1965) 6.1.36. - - FUNCTION PYGAMM(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local array and data. - DIMENSION B(8) - DATA B/-0.577191652D0,0.988205891D0,-0.897056937D0,0.918206857D0, - &-0.756704078D0,0.482199394D0,-0.193527818D0,0.035868343D0/ - - NX=INT(X) - DX=X-NX - - PYGAMM=1D0 - DXP=1D0 - DO 100 I=1,8 - DXP=DXP*DX - PYGAMM=PYGAMM+B(I)*DXP - 100 CONTINUE - IF(X.LT.1D0) THEN - PYGAMM=PYGAMM/X - ELSE - DO 110 IX=1,NX-1 - PYGAMM=(X-IX)*PYGAMM - 110 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYGANO -C...Evaluates the parton distributions of the anomalous photon, -C...inhomogeneously evolved from a scale P2 (where it vanishes) to Q2. -C...KF=0 gives the sum over (up to) 5 flavours, -C...KF<0 limits to flavours up to abs(KF), -C...KF>0 is for flavour KF only. -C...ALAM is the 4-flavour Lambda, which is automatically converted -C...to 3- and 5-flavour equivalents as needed. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local arrays and data. - DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - VXPGA(KFL)=0D0 - 100 CONTINUE - IF(Q2.LE.P2) RETURN - KFA=IABS(KF) - -C...Calculate Lambda; protect against unphysical Q2 and P2 input. - ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2D0/27D0))**2 - ALAMSQ(4)=ALAM**2 - ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2D0/23D0))**2 - P2EFF=MAX(P2,1.2D0*ALAMSQ(3)) - IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) - IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - XL=-LOG(X) - -C...Find number of flavours at lower and upper scale. - NFP=4 - IF(P2EFF.LT.PMC**2) NFP=3 - IF(P2EFF.GT.PMB**2) NFP=5 - NFQ=4 - IF(Q2EFF.LT.PMC**2) NFQ=3 - IF(Q2EFF.GT.PMB**2) NFQ=5 - -C...Define range of flavour loop. - IF(KF.EQ.0) THEN - KFLMN=1 - KFLMX=5 - ELSEIF(KF.LT.0) THEN - KFLMN=1 - KFLMX=KFA - ELSE - KFLMN=KFA - KFLMX=KFA - ENDIF - -C...Loop over flavours the photon can branch into. - DO 110 KFL=KFLMN,KFLMX - -C...Light flavours: calculate t range and (approximate) s range. - IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - IF(NFQ.GT.NFP) THEN - Q2DIV=PMB**2 - IF(NFQ.EQ.4) Q2DIV=PMC**2 - SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ - & LOG(P2EFF/ALAMSQ(NFQ-1))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) - ENDIF - IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN - Q2DIV=PMC**2 - SNF4=(6D0/(33D0-2D0*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ - & LOG(P2EFF/ALAMSQ(4))) - SNF3=(6D0/(33D0-2D0*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ - & LOG(P2EFF/ALAMSQ(3))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) - ENDIF - -C...u and s quark do not need a separate treatment when d has been done. - ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN - -C...Charm: as above, but only include range above c threshold. - ELSEIF(KFL.EQ.4) THEN - IF(Q2.LE.PMC**2) GOTO 110 - P2EFF=MAX(P2EFF,PMC**2) - Q2EFF=MAX(Q2EFF,P2EFF) - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN - Q2DIV=PMB**2 - SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ - & LOG(P2EFF/ALAMSQ(NFQ-1))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) - ENDIF - -C...Bottom: as above, but only include range above b threshold. - ELSEIF(KFL.EQ.5) THEN - IF(Q2.LE.PMB**2) GOTO 110 - P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - ENDIF - -C...Evaluate flavour-dependent prefactor (charge^2 etc.). - CHSQ=1D0/9D0 - IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4D0/9D0 - FAC=AEM2PI*2D0*CHSQ*TDIFF - -C...Evaluate parton distributions (normalized to unit momentum sum). - IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN - XVAL= ((1.5D0+2.49D0*S+26.9D0*S**2)/(1D0+32.3D0*S**2)*X**2 + - & (1.5D0-0.49D0*S+7.83D0*S**2)/(1D0+7.68D0*S**2)*(1D0-X)**2 + - & 1.5D0*S/(1D0-3.2D0*S+7D0*S**2)*X*(1D0-X)) * - & X**(1D0/(1D0+0.58D0*S)) * (1D0-X**2)**(2.5D0*S/(1D0+10D0*S)) - XGLU= 2D0*S/(1D0+4D0*S+7D0*S**2) * - & X**(-1.67D0*S/(1D0+2D0*S)) * (1D0-X**2)**(1.2D0*S) * - & ((4D0*X**2+7D0*X+4D0)*(1D0-X)/3D0 - 2D0*X*(1D0+X)*XL) - XSEA= 0.333D0*S**2/(1D0+4.90D0*S+4.69D0*S**2+21.4D0*S**3) * - & X**(-1.18D0*S/(1D0+1.22D0*S)) * (1D0-X)**(1.2D0*S) * - & ((8D0-73D0*X+62D0*X**2)*(1D0-X)/9D0 + - & (3D0-8D0*X**2/3D0)*X*XL + (2D0*X-1D0)*X*XL**2) - -C...Threshold factors for c and b sea. - SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) - XCHM=0D0 - IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - XCHM=XSEA*(1D0-(SCH/SLL)**3) - ENDIF - XBOT=0D0 - IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - XBOT=XSEA*(1D0-(SBT/SLL)**3) - ENDIF - ENDIF - -C...Add contribution of each valence flavour. - XPGA(0)=XPGA(0)+FAC*XGLU - XPGA(1)=XPGA(1)+FAC*XSEA - XPGA(2)=XPGA(2)+FAC*XSEA - XPGA(3)=XPGA(3)+FAC*XSEA - XPGA(4)=XPGA(4)+FAC*XCHM - XPGA(5)=XPGA(5)+FAC*XBOT - XPGA(KFL)=XPGA(KFL)+FAC*XVAL - VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL - 110 CONTINUE - DO 120 KFL=1,5 - XPGA(-KFL)=XPGA(KFL) - VXPGA(-KFL)=VXPGA(KFL) - 120 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGAU2 -C...Integration by adaptive Gaussian quadrature. -C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. -C...Carbon copy of PYGAUS, but avoids having to use it recursively. - - FUNCTION PYGAU2(F, A, B, EPS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local declarations. - EXTERNAL F - DOUBLE PRECISION F,W(12), X(12) - DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ - DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ - DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ - DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ - DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ - DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ - DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ - DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ - DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ - DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ - DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ - DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ - -C...The Gaussian quadrature algorithm. - H = 0D0 - IF(B .EQ. A) GOTO 140 - CONST = 5D-3 / ABS(B-A) - BB = A - 100 CONTINUE - AA = BB - BB = B - 110 CONTINUE - C1 = 0.5D0*(BB+AA) - C2 = 0.5D0*(BB-AA) - S8 = 0D0 - DO 120 I = 1, 4 - U = C2*X(I) - S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) - 120 CONTINUE - S16 = 0D0 - DO 130 I = 5, 12 - U = C2*X(I) - S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) - 130 CONTINUE - S16 = C2*S16 - IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN - H = H + S16 - IF(BB .NE. B) GOTO 100 - ELSE - BB = C1 - IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 - H = 0D0 - CALL PYERRM(18,'(PYGAU2:) too high accuracy required') - GOTO 140 - ENDIF - 140 CONTINUE - PYGAU2 = H - - RETURN - END - -C********************************************************************* - -C...PYGAUS -C...Integration by adaptive Gaussian quadrature. -C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. - - FUNCTION PYGAUS(F, A, B, EPS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local declarations. - EXTERNAL F - DOUBLE PRECISION F,W(12), X(12) - DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ - DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ - DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ - DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ - DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ - DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ - DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ - DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ - DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ - DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ - DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ - DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ - -C...The Gaussian quadrature algorithm. - H = 0D0 - IF(B .EQ. A) GOTO 140 - CONST = 5D-3 / ABS(B-A) - BB = A - 100 CONTINUE - AA = BB - BB = B - 110 CONTINUE - C1 = 0.5D0*(BB+AA) - C2 = 0.5D0*(BB-AA) - S8 = 0D0 - DO 120 I = 1, 4 - U = C2*X(I) - S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) - 120 CONTINUE - S16 = 0D0 - DO 130 I = 5, 12 - U = C2*X(I) - S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) - 130 CONTINUE - S16 = C2*S16 - IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN - H = H + S16 - IF(BB .NE. B) GOTO 100 - ELSE - BB = C1 - IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 - H = 0D0 - CALL PYERRM(18,'(PYGAUS:) too high accuracy required') - GOTO 140 - ENDIF - 140 CONTINUE - PYGAUS = H - - RETURN - END - -C********************************************************************* - -C...PYGBEH -C...Evaluates the Bethe-Heitler cross section for heavy flavour -C...production. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGBEH(KF,X,Q2,P2,PM2,XPBH) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local data. - DATA AEM2PI/0.0011614D0/ - -C...Reset output. - XPBH=0D0 - SIGBH=0D0 - -C...Check kinematics limits. - IF(X.GE.Q2/(4D0*PM2+Q2+P2)) RETURN - W2=Q2*(1D0-X)/X-P2 - BETA2=1D0-4D0*PM2/W2 - IF(BETA2.LT.1D-10) RETURN - BETA=SQRT(BETA2) - RMQ=4D0*PM2/Q2 - -C...Simple case: P2 = 0. - IF(P2.LT.1D-4) THEN - IF(BETA.LT.0.99D0) THEN - XBL=LOG((1D0+BETA)/(1D0-BETA)) - ELSE - XBL=LOG((1D0+BETA)**2*W2/(4D0*PM2)) - ENDIF - SIGBH=BETA*(8D0*X*(1D0-X)-1D0-RMQ*X*(1D0-X))+ - & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2) - -C...Complicated case: P2 > 0, based on approximation of -C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 - ELSE - RPQ=1D0-4D0*X**2*P2/Q2 - IF(RPQ.GT.1D-10) THEN - RPBE=SQRT(RPQ*BETA2) - IF(RPBE.LT.0.99D0) THEN - XBL=LOG((1D0+RPBE)/(1D0-RPBE)) - XBI=2D0*RPBE/(1D0-RPBE**2) - ELSE - RPBESN=4D0*PM2/W2+(4D0*X**2*P2/Q2)*BETA2 - XBL=LOG((1D0+RPBE)**2/RPBESN) - XBI=2D0*RPBE/RPBESN - ENDIF - SIGBH=BETA*(6D0*X*(1D0-X)-1D0)+ - & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2)+ - & XBI*(2D0*X/Q2)*(PM2*X*(2D0-RMQ)-P2*X) - ENDIF - ENDIF - -C...Multiply by charge-squared etc. to get parton distribution. - CHSQ=1D0/9D0 - IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4D0/9D0 - XPBH=3D0*CHSQ*AEM2PI*X*SIGBH - - RETURN - END - -C********************************************************************* - -C...PYGDIR -C...Evaluates the direct contribution, i.e. the C^gamma term, -C...as needed in MSbar parametrizations. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGDIR(X,Q2,P2,Q02,XPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local array and data. - DIMENSION XPGA(-6:6) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - 100 CONTINUE - -C...Evaluate common x-dependent expression. - XTMP = (X**2+(1D0-X)**2) * (-LOG(X)) - 1D0 - CGAM = 3D0*AEM2PI*X * (XTMP*(1D0+P2/(P2+Q02)) + 6D0*X*(1D0-X)) - -C...d, u, s part by simple charge factor. - XPGA(1)=(1D0/9D0)*CGAM - XPGA(2)=(4D0/9D0)*CGAM - XPGA(3)=(1D0/9D0)*CGAM - -C...Also fill for antiquarks. - DO 110 KF=1,5 - XPGA(-KF)=XPGA(KF) - 110 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGFXX -C...Auxiliary to PYRGHM. - - SUBROUTINE PYGFXX(MA,TANB,MQ,MUR,MD,MTOP,AT,AB,XMU,XMGL,VH, - * STOP1,STOP2,SBOT1,SBOT2,DELTAMT,DELTAMB) - IMPLICIT DOUBLE PRECISION(A-H,M,O-Z) - DIMENSION VH(2,2),VH3T(2,2),VH3B(2,2),AL(2,2) -C...Commonblocks. - INTEGER MSTU,MSTJ,KCHG - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - G(X,Y) = 2.D0 - (X+Y)/(X-Y)*DLOG(X/Y) - - T(X,Y,Z) = (X**2*Y**2*LOG(X**2/Y**2) + X**2*Z**2*LOG(Z**2/X**2) - * + Y**2*Z**2*LOG(Y**2/Z**2))/((X**2-Y**2)*(Y**2-Z**2)*(X**2-Z**2)) - - IF(DABS(XMU).LT.0.000001D0) XMU = 0.000001D0 - MQ2 = MQ**2 - MUR2 = MUR**2 - MD2 = MD**2 - TANBA = TANB - SINBA = TANBA/DSQRT(TANBA**2+1D0) - COSBA = SINBA/TANBA - - SINB = TANB/DSQRT(TANB**2+1D0) - COSB = SINB/TANB - - PI = PARU(1) - MZ = PMAS(23,1) - MW = PMAS(24,1) - SW = 1D0-MW**2/MZ**2 - V = 174.1D0 - - ALPHA3 = 0.12D0/(1D0+23/12D0/PI*0.12D0*LOG(MTOP**2/MZ**2)) - G2 = DSQRT(0.0336D0*4D0*PI) - G1 = DSQRT(0.0101D0*4D0*PI) - - IF(MQ.GT.MUR) MST = MQ - IF(MUR.GT.MQ.OR.MUR.EQ.MQ) MST = MUR - - MSUSYT = DSQRT(MST**2 + MTOP**2) - - IF(MQ.GT.MD) MSB = MQ - IF(MD.GT.MQ.OR.MD.EQ.MQ) MSB = MD - - MB = PYMRUN(5,MSB**2) - MSUSYB = DSQRT(MSB**2 + MB**2) - TT = LOG(MSUSYT**2/MTOP**2) - TB = LOG(MSUSYB**2/MTOP**2) - - RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) - HT = RMTOP/(V*SINB) - HTST = RMTOP/V - HB = MB/V/COSB - G32 = ALPHA3*4D0*PI - BT2 = -(8D0*G32 - 9D0*HT**2/2D0 - HB**2/2D0)/(4D0*PI)**2 - BB2 = -(8D0*G32 - 9D0*HB**2/2D0 - HT**2/2D0)/(4D0*PI)**2 - AL2 = 3D0/8D0/PI**2*HT**2 -C BT2ST = -(8.*G32 - 9.*HTST**2/2.)/(4.*PI)**2 -C ALST = 3./8./PI**2*HTST**2 - AL1 = 3D0/8D0/PI**2*HB**2 - - AL(1,1) = AL1 - AL(1,2) = (AL2+AL1)/2D0 - AL(2,1) = (AL2+AL1)/2D0 - AL(2,2) = AL2 - - IF(MA.GT.MTOP) THEN - VI = V*(1D0 + 3D0/32D0/PI**2*HTST**2* - * LOG(MTOP**2/MA**2)) - H1I = VI* COSBA - H2I = VI*SINBA - H1T = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYT**2))**.25D0 - H2T = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYT**2))**.25D0 - H1B = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYB**2))**.25D0 - H2B = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYB**2))**.25D0 - ELSE - VI = V - H1I = VI*COSB - H2I = VI*SINB - H1T=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYT**2))**.25D0 - H2T=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYT**2))**.25D0 - H1B=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYB**2))**.25D0 - H2B=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYB**2))**.25D0 - ENDIF - - TANBST = H2T/H1T - SINBT = TANBST/DSQRT(1D0+TANBST**2) - - TANBSB = H2B/H1B - SINBB = TANBSB/DSQRT(1D0+TANBSB**2) - COSBB = SINBB/TANBSB - - DELTAMT = 0D0 - DELTAMB = 0D0 - - MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) - MTOP2 = DSQRT(MTOP4) - MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) - * /(1D0+DELTAMB)**4 - MBOT2 = DSQRT(MBOT4) - - STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) - STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 - * + MTOP2*(AT-XMU/TANBST)**2) - IF(STOP22.LT.0.) GOTO 120 - SBOT12 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - SBOT22 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - IF(SBOT22.LT.0.) SBOT22 = 10000D0 - - STOP1 = DSQRT(STOP12) - STOP2 = DSQRT(STOP22) - SBOT1 = DSQRT(SBOT12) - SBOT2 = DSQRT(SBOT22) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE IS THE DEFINITION OF DELTAMB AND DELTAMT, WHICH -C ARE THE VERTEX CORRECTIONS TO THE BOTTOM AND TOP QUARK -C MASS, KEEPING THE DOMINANT QCD AND TOP YUKAWA COUPLING -C INDUCED CORRECTIONS. -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - X=SBOT1 - Y=SBOT2 - Z=XMGL - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - - T1=T(X,Y,Z) - X=STOP1 - Y=STOP2 - Z=XMU - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - T2=T(X,Y,Z) - DELTAMB = -2*ALPHA3/3D0/PI*XMGL*(AB-XMU*TANB)*T1 - * + HT**2/(4D0*PI)**2*(AT-XMU/TANB)*XMU*TANB*T2 - X=STOP1 - Y=STOP2 - Z=XMGL - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - T3=T(X,Y,Z) - DELTAMT = -2D0*ALPHA3/3D0/PI*(AT-XMU/TANB)*XMGL*T3 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE THE NEW VALUES OF THE TOP AND BOTTOM QUARK MASSES AT -C THE SCALE MS ARE DEFINED, TO BE USED IN THE EFFECTIVE -C POTENTIAL APPROXIMATION. THEY ARE JUST THE OLD ONES, BUT -C INCLUDING THE FINITE CORRECTIONS DELTAMT AND DELTAMB. -C THE DELTAMB CORRECTIONS CAN BECOME LARGE AND ARE RESUMMED -C TO ALL ORDERS, AS SUGGESTED IN THE TWO RECENT WORKS BY M. CARENA, -C S. MRENNA AND C.E.M. WAGNER, AS WELL AS IN THE WORK BY M. CARENA, -C D. GARCIA, U. NIERSTE AND C.E.M. WAGNER, TO APPEAR. THE TOP -C QUARK MASS CORRECTIONS ARE SMALL AND ARE KEPT IN THE PERTURBATIVE -C FORMULATION. THE FUNCTION T(X,Y,Z) IS NECESSARY FOR THE -C CALCULATION. THE ENTRIES ARE MASSES AND NOT THEIR SQUARES ! -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) - MTOP2 = DSQRT(MTOP4) - MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) - * /(1D0+DELTAMB)**4 - MBOT2 = DSQRT(MBOT4) - - STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) - STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 - * + MTOP2*(AT-XMU/TANBST)**2) - - IF(STOP22.LT.0.) GOTO 120 - SBOT12 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - SBOT22 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - IF(SBOT22.LT.0.) GOTO 120 - - - STOP1 = DSQRT(STOP12) - STOP2 = DSQRT(STOP22) - SBOT1 = DSQRT(SBOT12) - SBOT2 = DSQRT(SBOT22) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC D-TERMS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - STW=SW - - F1T=(MQ2-MUR2)/(STOP12-STOP22)*(.5D0-4D0/3D0*STW)* - * LOG(STOP1/STOP2) - * +(.5D0-2D0/3D0*STW)*LOG(STOP1*STOP2/(MQ2+MTOP2)) - * + 2D0/3D0*STW*LOG(STOP1*STOP2/(MUR2+MTOP2)) - - F1B=(MQ2-MD2)/(SBOT12-SBOT22)*(-.5D0+2D0/3D0*STW)* - * LOG(SBOT1/SBOT2) - * +(-.5D0+1D0/3D0*STW)*LOG(SBOT1*SBOT2/(MQ2+MBOT2)) - * - 1D0/3D0*STW*LOG(SBOT1*SBOT2/(MD2+MBOT2)) - - F2T=DSQRT(MTOP2)*(AT-XMU/TANBST)/(STOP12-STOP22)* - * (-.5D0*LOG(STOP12/STOP22) - * +(4D0/3D0*STW-.5D0)*(MQ2-MUR2)/(STOP12-STOP22)* - * G(STOP12,STOP22)) - - F2B=DSQRT(MBOT2)*(AB-XMU*TANBSB)/(SBOT12-SBOT22)* - * (.5D0*LOG(SBOT12/SBOT22) - * +(-2D0/3D0*STW+.5D0)*(MQ2-MD2)/(SBOT12-SBOT22)* - * G(SBOT12,SBOT22)) - - VH3B(1,1) = MBOT4/(COSBB**2)*(LOG(SBOT1**2*SBOT2**2/ - * (MQ2+MBOT2)/(MD2+MBOT2)) - * + 2D0*(AB*(AB-XMU*TANBSB)/(SBOT1**2-SBOT2**2))* - * LOG(SBOT1**2/SBOT2**2)) + - * MBOT4/(COSBB**2)*(AB*(AB-XMU*TANBSB)/ - * (SBOT1**2-SBOT2**2))**2*G(SBOT12,SBOT22) - - VH3T(1,1) = - * MTOP4/(SINBT**2)*(XMU*(-AT+XMU/TANBST)/(STOP1**2 - * -STOP2**2))**2*G(STOP12,STOP22) - - VH3B(1,1)=VH3B(1,1)+ - * MZ**2*(2*MBOT2*F1B-DSQRT(MBOT2)*AB*F2B) - - VH3T(1,1) = VH3T(1,1) + - * MZ**2*(DSQRT(MTOP2)*XMU/TANBST*F2T) - - VH3T(2,2) = MTOP4/(SINBT**2)*(LOG(STOP1**2*STOP2**2/ - * (MQ2+MTOP2)/(MUR2+MTOP2)) - * + 2D0*(AT*(AT-XMU/TANBST)/(STOP1**2-STOP2**2))* - * LOG(STOP1**2/STOP2**2)) + - * MTOP4/(SINBT**2)*(AT*(AT-XMU/TANBST)/ - * (STOP1**2-STOP2**2))**2*G(STOP12,STOP22) - - VH3B(2,2) = - * MBOT4/(COSBB**2)*(XMU*(-AB+XMU*TANBSB)/(SBOT1**2 - * -SBOT2**2))**2*G(SBOT12,SBOT22) - - VH3T(2,2)=VH3T(2,2)+ - * MZ**2*(-2*MTOP2*F1T+DSQRT(MTOP2)*AT*F2T) - VH3B(2,2) = VH3B(2,2) -MZ**2*DSQRT(MBOT2)*XMU*TANBSB*F2B - VH3T(1,2) = - - * MTOP4/(SINBT**2)*XMU*(AT-XMU/TANBST)/ - * (STOP1**2-STOP2**2)*(LOG(STOP1**2/STOP2**2) + AT* - * (AT - XMU/TANBST)/(STOP1**2-STOP2**2)*G(STOP12,STOP22)) - - VH3B(1,2) = - * - MBOT4/(COSBB**2)*XMU*(AB-XMU*TANBSB)/ - * (SBOT1**2-SBOT2**2)*(LOG(SBOT1**2/SBOT2**2) + AB* - * (AB - XMU*TANBSB)/(SBOT1**2-SBOT2**2)*G(SBOT12,SBOT22)) - - - VH3T(1,2)=VH3T(1,2) + - *MZ**2*(MTOP2/TANBST*F1T-DSQRT(MTOP2)*(AT/TANBST+XMU)/2D0*F2T) - - VH3B(1,2)=VH3B(1,2) + - *MZ**2*(-MBOT2*TANBSB*F1B+DSQRT(MBOT2)*(AB*TANBSB+XMU)/2D0*F2B) - - VH3T(2,1) = VH3T(1,2) - VH3B(2,1) = VH3B(1,2) - -C TQ = LOG((MQ2 + MTOP2)/MTOP2) -C TU = LOG((MUR2+MTOP2)/MTOP2) -C TQD = LOG((MQ2 + MB**2)/MB**2) -C TD = LOG((MD2+MB**2)/MB**2) - - DO 110 I = 1,2 - DO 100 J = 1,2 - VH(I,J) = - * 6D0/(8D0*PI**2*(H1T**2+H2T**2)) - * *VH3T(I,J)*0.5D0*(1D0-AL(I,J)*TT/2D0) + - * 6D0/(8D0*PI**2*(H1B**2+H2B**2)) - * *VH3B(I,J)*0.5D0*(1D0-AL(I,J)*TB/2D0) - 100 CONTINUE - 110 CONTINUE - - GOTO 150 - 120 DO 140 I =1,2 - DO 130 J = 1,2 - VH(I,J) = -1D15 - 130 CONTINUE - 140 CONTINUE - - - 150 RETURN - END - -C********************************************************************* - -C...PYGGAM -C...Constructs the F2 and parton distributions of the photon -C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. -C...For F2, c and b are included by the Bethe-Heitler formula; -C...in the 'MSbar' scheme additionally a Cgamma term is added. -C...Contains the SaS sets 1D, 1M, 2D and 2M. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - COMMON/PYINT9/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) - SAVE /PYINT8/,/PYINT9/ -C...Local arrays. - DIMENSION XPDFGM(-6:6),XPGA(-6:6), VXPGA(-6:6) -C...Charm and bottom masses (low to compensate for J/psi etc.). - DATA PMC/1.3D0/, PMB/4.6D0/ -C...alpha_em and alpha_em/(2*pi). - DATA AEM/0.007297D0/, AEM2PI/0.0011614D0/ -C...Lambda value for 4 flavours. - DATA ALAM/0.20D0/ -C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. - DATA FRACU/0.8D0/ -C...VMD couplings f_V**2/(4*pi). - DATA FRHO/2.20D0/, FOMEGA/23.6D0/, FPHI/18.4D0/ -C...Masses for rho (=omega) and phi. - DATA PMRHO/0.770D0/, PMPHI/1.020D0/ -C...Number of points in integration for IP2=1. - DATA NSTEP/100/ - -C...Reset output. - F2GM=0D0 - DO 100 KFL=-6,6 - XPDFGM(KFL)=0D0 - XPVMD(KFL)=0D0 - XPANL(KFL)=0D0 - XPANH(KFL)=0D0 - XPBEH(KFL)=0D0 - XPDIR(KFL)=0D0 - VXPVMD(KFL)=0D0 - VXPANL(KFL)=0D0 - VXPANH(KFL)=0D0 - VXPDGM(KFL)=0D0 - 100 CONTINUE - -C...Set Q0 cut-off parameter as function of set used. - IF(ISET.LE.2) THEN - Q0=0.6D0 - ELSE - Q0=2D0 - ENDIF - Q02=Q0**2 - -C...Scale choice for off-shell photon; common factors. - Q2A=Q2 - FACNOR=1D0 - IF(IP2.EQ.1) THEN - P2MX=P2+Q02 - Q2A=Q2+P2*Q02/MAX(Q02,Q2) - FACNOR=LOG(Q2/Q02)/NSTEP - ELSEIF(IP2.EQ.2) THEN - P2MX=MAX(P2,Q02) - ELSEIF(IP2.EQ.3) THEN - P2MX=P2+Q02 - Q2A=Q2+P2*Q02/MAX(Q02,Q2) - ELSEIF(IP2.EQ.4) THEN - P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - ELSEIF(IP2.EQ.5) THEN - P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=Q0*SQRT(P2MXA) - FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) - ELSEIF(IP2.EQ.6) THEN - P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) - ELSE - P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=Q0*SQRT(P2MXA) - P2MXB=P2MX - P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) - P2MXB=MAX(0D0,1D0-P2/Q2)*P2MXB+MIN(1D0,P2/Q2)*P2MXA - IF(ABS(Q2-Q02).GT.1D-6) THEN - FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) - ELSEIF(P2.LT.Q02) THEN - FACNOR=Q02**3/(Q02+P2)/(Q02**2-P2**2/2D0) - ELSE - FACNOR=1D0 - ENDIF - ENDIF - -C...Call VMD parametrization for d quark and use to give rho, omega, -C...phi. Note dipole dampening for off-shell photon. - CALL PYGVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - XFVAL=VXPGA(1) - XPGA(1)=XPGA(2) - XPGA(-1)=XPGA(-2) - FACUD=AEM*(1D0/FRHO+1D0/FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 - FACS=AEM*(1D0/FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 - DO 110 KFL=-5,5 - XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) - 110 CONTINUE - XPVMD(1)=XPVMD(1)+(1D0-FRACU)*FACUD*XFVAL - XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL - XPVMD(3)=XPVMD(3)+FACS*XFVAL - XPVMD(-1)=XPVMD(-1)+(1D0-FRACU)*FACUD*XFVAL - XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL - XPVMD(-3)=XPVMD(-3)+FACS*XFVAL - VXPVMD(1)=(1D0-FRACU)*FACUD*XFVAL - VXPVMD(2)=FRACU*FACUD*XFVAL - VXPVMD(3)=FACS*XFVAL - VXPVMD(-1)=(1D0-FRACU)*FACUD*XFVAL - VXPVMD(-2)=FRACU*FACUD*XFVAL - VXPVMD(-3)=FACS*XFVAL - - IF(IP2.NE.1) THEN -C...Anomalous parametrizations for different strategies -C...for off-shell photons; except full integration. - -C...Call anomalous parametrization for d + u + s. - CALL PYGANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 120 KFL=-5,5 - XPANL(KFL)=FACNOR*XPGA(KFL) - VXPANL(KFL)=FACNOR*VXPGA(KFL) - 120 CONTINUE - -C...Call anomalous parametrization for c and b. - CALL PYGANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 130 KFL=-5,5 - XPANH(KFL)=FACNOR*XPGA(KFL) - VXPANH(KFL)=FACNOR*VXPGA(KFL) - 130 CONTINUE - CALL PYGANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 140 KFL=-5,5 - XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) - VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) - 140 CONTINUE - - ELSE -C...Special option: loop over flavours and integrate over k2. - DO 170 KF=1,5 - DO 160 ISTEP=1,NSTEP - Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5D0)/NSTEP) - IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. - & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 - CALL PYGVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) - FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR - IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8D0/9D0) - IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2D0/9D0) - DO 150 KFL=-5,5 - IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) - IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) - IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) - IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) - 150 CONTINUE - 160 CONTINUE - 170 CONTINUE - ENDIF - -C...Call Bethe-Heitler term expression for charm and bottom. - CALL PYGBEH(4,X,Q2,P2,PMC**2,XPBH) - XPBEH(4)=XPBH - XPBEH(-4)=XPBH - CALL PYGBEH(5,X,Q2,P2,PMB**2,XPBH) - XPBEH(5)=XPBH - XPBEH(-5)=XPBH - -C...For MSbar subtraction call C^gamma term expression for d, u, s. - IF(ISET.EQ.2.OR.ISET.EQ.4) THEN - CALL PYGDIR(X,Q2,P2,Q02,XPGA) - DO 180 KFL=-5,5 - XPDIR(KFL)=XPGA(KFL) - 180 CONTINUE - ENDIF - -C...Store result in output array. - DO 190 KFL=-5,5 - CHSQ=1D0/9D0 - IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4D0/9D0 - XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) - IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 - XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) - VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) - 190 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGIVE -C...Sets values of commonblock variables. - - SUBROUTINE PYGIVE(CHIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYDATR/MRPY(6),RRPY(100) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/, - &/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, - &/PYINT5/,/PYINT6/,/PYINT7/,/PYINT8/,/PYMSSM/,/PYMSRV/,/PYTCSM/ -C...Local arrays and character variables. - CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, - &CHNEW2*28,CHNAM*6,CHVAR(54)*6,CHALP(2)*26,CHIND*8,CHINI*10, - &CHINR*16 - DIMENSION MSVAR(54,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','MRPY', - &'RRPY','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', - &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', - &'MWID','WIDS','NGEN','XSEC','PROC','SIGT','XPVMD','XPANL', - &'XPANH','XPBEH','XPDIR','IMSS','RMSS','RVLAM','RVLAMP','RVLAMB', - &'ITCM','RTCM'/ - DATA ((MSVAR(I,J),J=1,8),I=1,54)/ 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,4,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,8000,1,2,2*0, - &2,1,1,8000,4*0, 1,2,1,8000,1,5,2*0, 3,2,1,500,1,2,2*0, - &1,1,1,6,4*0, 2,1,1,100,4*0, - &1,7*0, 1,1,1,500,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,500,4*0, - &1,2,1,500,1,2,2*0, 2,2,1,500,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, - &1,1,1,500,4*0, 2,2,1,500,1,5,2*0, 1,2,0,500,1,3,2*0, - &2,2,0,500,1,3,2*0, 4,1,0,500,4*0, 2,3,0,6,0,6,0,5, - &2,1,-6,6,4*0, 2,1,-6,6,4*0, 2,1,-6,6,4*0, - &2,1,-6,6,4*0, 2,1,-6,6,4*0, 1,1,0,99,4*0, 2,1,0,99,4*0, - &2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, - &1,1,0,99,4*0, 2,1,0,99,4*0/ - DATA CHALP/'abcdefghijklmnopqrstuvwxyz', - &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - -C...Length of character variable. Subdivide it into instructions. - IF(MSTU(12).GE.1) CALL PYLIST(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...Peel off any text following exclamation mark. - LHIG2=LBIT - DO 140 LLOW2=LHIG2,1,-1 - IF(CHBIT(LLOW2:LLOW2).EQ.'!') LBIT=LLOW2-1 - 140 CONTINUE - IF(LBIT.EQ.0) RETURN - -C...Identify commonblock variable. - LNAM=1 - 150 LNAM=LNAM+1 - IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. - &LNAM.LE.6) GOTO 150 - CHNAM=CHBIT(1:LNAM-1)//' ' - DO 170 LCOM=1,LNAM-1 - DO 160 LALP=1,26 - IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= - & CHALP(2)(LALP:LALP) - 160 CONTINUE - 170 CONTINUE - IVAR=0 - DO 180 IV=1,54 - IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV - 180 CONTINUE - IF(IVAR.EQ.0) THEN - CALL PYERRM(18,'(PYGIVE:) 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 - 190 LIND=LIND+1 - IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 - 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.OR. - & IVAR.EQ.37)) THEN - CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) - READ(CHIND,'(I8)') KF - I1=PYCOMP(KF) - ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. - & 'c') THEN - CALL PYERRM(18,'(PYGIVE:) 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 - 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)') I2 - LNAM=LIND - IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 - NINDX=2 - ENDIF - IF(CHBIT(LNAM:LNAM).EQ.',') THEN - LIND=LNAM - 210 LIND=LIND+1 - IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 210 - 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 PYERRM(18,'(PYGIVE:) 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,I2)(1:8) - ELSEIF(IVAR.EQ.18) THEN - IOLD=MRPY(I1) - ELSEIF(IVAR.EQ.19) THEN - ROLD=RRPY(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 - IOLD=MWID(I1) - ELSEIF(IVAR.EQ.38) THEN - ROLD=WIDS(I1,I2) - ELSEIF(IVAR.EQ.39) THEN - IOLD=NGEN(I1,I2) - ELSEIF(IVAR.EQ.40) THEN - ROLD=XSEC(I1,I2) - ELSEIF(IVAR.EQ.41) THEN - CHOLD2=PROC(I1) - ELSEIF(IVAR.EQ.42) THEN - ROLD=SIGT(I1,I2,I3) - ELSEIF(IVAR.EQ.43) THEN - ROLD=XPVMD(I1) - ELSEIF(IVAR.EQ.44) THEN - ROLD=XPANL(I1) - ELSEIF(IVAR.EQ.45) THEN - ROLD=XPANH(I1) - ELSEIF(IVAR.EQ.46) THEN - ROLD=XPBEH(I1) - ELSEIF(IVAR.EQ.47) THEN - ROLD=XPDIR(I1) - ELSEIF(IVAR.EQ.48) THEN - IOLD=IMSS(I1) - ELSEIF(IVAR.EQ.49) THEN - ROLD=RMSS(I1) - ELSEIF(IVAR.EQ.50) THEN - ROLD=RVLAM(I1,I2,I3) - ELSEIF(IVAR.EQ.51) THEN - ROLD=RVLAMP(I1,I2,I3) - ELSEIF(IVAR.EQ.52) THEN - ROLD=RVLAMB(I1,I2,I3) - ELSEIF(IVAR.EQ.53) THEN - IOLD=ITCM(I1) - ELSEIF(IVAR.EQ.54) THEN - ROLD=RTCM(I1) - ENDIF - -C...Print current value of variable. Loop back. - IF(LNAM.GE.LBIT) THEN - CHBIT(LNAM:14)=' ' - CHBIT(15:60)=' has the value ' - IF(MSVAR(IVAR,1).EQ.1) THEN - WRITE(CHBIT(51:60),'(I10)') IOLD - ELSEIF(MSVAR(IVAR,1).EQ.2) THEN - WRITE(CHBIT(47:60),'(F14.5)') ROLD - ELSEIF(MSVAR(IVAR,1).EQ.3) THEN - CHBIT(53:60)=CHOLD - ELSE - CHBIT(33:60)=CHOLD - ENDIF - IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) - LLOW=LHIG - IF(LLOW.LT.LTOT) GOTO 120 - RETURN - ENDIF - -C...Read in new variable value. - IF(MSVAR(IVAR,1).EQ.1) THEN - CHINI=' ' - CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) - READ(CHINI,'(I10)') INEW - ELSEIF(MSVAR(IVAR,1).EQ.2) THEN - CHINR=' ' - CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) - READ(CHINR,*) 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,I2)=CHNEW - ELSEIF(IVAR.EQ.18) THEN - MRPY(I1)=INEW - ELSEIF(IVAR.EQ.19) THEN - RRPY(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 - MWID(I1)=INEW - ELSEIF(IVAR.EQ.38) THEN - WIDS(I1,I2)=RNEW - ELSEIF(IVAR.EQ.39) THEN - NGEN(I1,I2)=INEW - ELSEIF(IVAR.EQ.40) THEN - XSEC(I1,I2)=RNEW - ELSEIF(IVAR.EQ.41) THEN - PROC(I1)=CHNEW2 - ELSEIF(IVAR.EQ.42) THEN - SIGT(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.43) THEN - XPVMD(I1)=RNEW - ELSEIF(IVAR.EQ.44) THEN - XPANL(I1)=RNEW - ELSEIF(IVAR.EQ.45) THEN - XPANH(I1)=RNEW - ELSEIF(IVAR.EQ.46) THEN - XPBEH(I1)=RNEW - ELSEIF(IVAR.EQ.47) THEN - XPDIR(I1)=RNEW - ELSEIF(IVAR.EQ.48) THEN - IMSS(I1)=INEW - ELSEIF(IVAR.EQ.49) THEN - RMSS(I1)=RNEW - ELSEIF(IVAR.EQ.50) THEN - RVLAM(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.51) THEN - RVLAMP(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.52) THEN - RVLAMB(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.53) THEN - ITCM(I1)=INEW - ELSEIF(IVAR.EQ.54) THEN - RTCM(I1)=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********************************************************************* - -C...PYGLUI -C...Calculates gluino decay modes. - - SUBROUTINE PYGLUI(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -CC &SFMIX(16,4), -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ - DOUBLE PRECISION XMI,XMJ,XMF,AXMJ,AXMI - DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,S12MAX,S12MIN - DOUBLE PRECISION CA,CB,AL,AR,BL,BR - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,ILR,I,IKNT,IFL - DOUBLE PRECISION SR2 - DOUBLE PRECISION GAM - DOUBLE PRECISION PYALEM,PI,PYALPS,EI,T3I - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - INTEGER KFNCHI(4),KFCCHI(2) - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA PREC/1D-2/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - IF(KFIN.NE.KSUSY1+21) RETURN - KCIN=PYCOMP(KFIN) - - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - - XMI=PMAS(KCIN,1) - AXMI=ABS(XMI) - XMI2=XMI**2 - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=AXMI**3 - - XMI=SIGN(XMI,RMSS(3)) - -C...2-BODY DECAYS OF GLUINO -> GRAVITINO GLUON - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=21 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC - ENDIF - ENDIF - -C...2-BODY DECAYS OF GLUINO -> QUARK SQUARK - - DO 110 IFL=1,6 - DO 100 ILR=1,2 - XMJ=PMAS(PYCOMP(ILR*KSUSY1+IFL),1) - AXMJ=ABS(XMJ) - XMF=PMAS(IFL,1) - IF(AXMI.GE.AXMJ+XMF) THEN -C...Minus sign difference from gluino-quark-squark feynman rules - AL=SFMIX(IFL,1) - BL=-SFMIX(IFL,3) - AR=SFMIX(IFL,2) - BR=-SFMIX(IFL,4) -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - CA=AL - CB=BL -C...F2 -> F CHI - ELSE - CA=AR - CB=BR - ENDIF - LKNT=LKNT+1 - XMA2=XMJ**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=4D0/8D0*AS/4D0/XMI3*SQRT(XL)*((XMI2+XMB2-XMA2)* - & (CA**2+CB**2)-4D0*CA*CB*XMI*XMF) - IDLAM(LKNT,1)=ILR*KSUSY1+IFL - IDLAM(LKNT,2)=-IFL - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - 100 CONTINUE - 110 CONTINUE - -C...3-BODY DECAYS TO GAUGINO FERMION-FERMION -C...GLUINO -> NI Q QBAR - DO 170 IX=1,4 - XMJ=SMZ(IX) - AXMJ=ABS(XMJ) - IF(AXMI.GE.AXMJ) THEN - DO 120 I=1,4 - ZMIXC(IX,I)=DCMPLX(ZMIX(IX,I),ZMIXI(IX,I)) - 120 CONTINUE - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))/SR2 - ORPP=DCONJG(OLPP) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - IA=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) - XXC(7)=XXC(5) - XXC(8)=XXC(6) - XXC(9)=1D6 - XXC(10)=0D0 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(1)=0D0 - CXC(2)=-GLIJ - CXC(3)=0D0 - CXC(4)=DCONJG(GLIJ) - CXC(5)=0D0 - CXC(6)=GRIJ - CXC(7)=0D0 - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 130 - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - 130 CONTINUE - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - PMOLD=PMAS(PYCOMP(KSUSY1+5),1) - IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+5),1)+PMAS(5,1)) THEN - GOTO 140 - ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+5),1)+PMAS(5,1)) THEN - PMAS(PYCOMP(KSUSY1+5),1)=100D0*XMI - ENDIF - CALL PYTBBN(IX,100,-1D0/3D0,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - PMAS(PYCOMP(KSUSY1+5),1)=PMOLD - ENDIF -C...U-TYPE QUARKS - 140 CONTINUE - IA=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) -C IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 290 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(2)=-GLIJ - CXC(4)=DCONJG(GLIJ) - CXC(6)=GRIJ - CXC(8)=-DCONJG(GRIJ) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 150 - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - 150 CONTINUE -C...INCLUDE THE DECAY GLUINO -> NJ + T + T~ -C...IF THE DECAY GLUINO -> ST + T CANNOT OCCUR - XMF=PMAS(6,1) - IF(AXMI.GE.AXMJ+2D0*XMF) THEN - PMOLD=PMAS(PYCOMP(KSUSY1+6),1) - IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+6),1)+XMF) THEN - GOTO 160 - ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+6),1)+XMF) THEN - PMAS(PYCOMP(KSUSY1+6),1)=100D0*XMI - ENDIF - CALL PYTBBN(IX,100,2D0/3D0,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=6 - IDLAM(LKNT,3)=-6 - PMAS(PYCOMP(KSUSY1+6),1)=PMOLD - ENDIF - 160 CONTINUE - ENDIF - 170 CONTINUE - -C...GLUINO -> CI Q QBAR' - DO 210 IX=1,2 - XMJ=SMW(IX) - AXMJ=ABS(XMJ) - IF(AXMI.GE.AXMJ) THEN - DO 180 I=1,2 - VMIXC(IX,I)=DCMPLX(VMIX(IX,I),VMIXI(IX,I)) - UMIXC(IX,I)=DCMPLX(UMIX(IX,I),UMIXI(IX,I)) - 180 CONTINUE - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) - XXC(9)=1D6 - XXC(10)=0D0 - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) - ORPP=DCONJG(OLPP) - CXC(1)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX(0D0,0D0) - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - CXC(2)=UMIXC(IX,1)*OLPP/SR2 - CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 190 - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-2 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-4 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - 190 CONTINUE - - XMF=PMAS(6,1) - XMFP=PMAS(5,1) - IF(AXMI.GE.AXMJ+XMF+XMFP) THEN - IF(XMI.GT.MIN(PMAS(PYCOMP(KSUSY1+5),1)+XMFP, - $ PMAS(PYCOMP(KSUSY2+6),1)+XMF)) GOTO 200 - PMOLT2=PMAS(PYCOMP(KSUSY2+6),1) - PMOLB2=PMAS(PYCOMP(KSUSY2+5),1) - PMOLT1=PMAS(PYCOMP(KSUSY1+6),1) - PMOLB1=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GT.PMOLT2+XMF) PMAS(PYCOMP(KSUSY2+6),1)=100D0*AXMI - IF(XMI.GT.PMOLT1+XMF) PMAS(PYCOMP(KSUSY1+6),1)=100D0*AXMI - IF(XMI.GT.PMOLB2+XMFP) PMAS(PYCOMP(KSUSY2+5),1)=100D0*AXMI - IF(XMI.GT.PMOLB1+XMFP) PMAS(PYCOMP(KSUSY1+5),1)=100D0*AXMI - CALL PYTBBC(IX,100,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-6 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - PMAS(PYCOMP(KSUSY2+6),1)=PMOLT2 - PMAS(PYCOMP(KSUSY2+5),1)=PMOLB2 - PMAS(PYCOMP(KSUSY1+6),1)=PMOLT1 - PMAS(PYCOMP(KSUSY1+5),1)=PMOLB1 - ENDIF - 200 CONTINUE - ENDIF - 210 CONTINUE - -C...R-parity violating (3-body) decays. - CALL PYRVGL(KFIN,XLAM,IDLAM,LKNT) - - IKNT=LKNT - XLAM(0)=0D0 - DO 220 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 220 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYGRVD -C...Gives the GRV 94 D (DIS) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVD (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.34D0 - LAM2 = 0.248D0 * 0.248D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 2.484D0 + 0.116D0 * S + 0.093D0 * S2 - AKU = 0.563D0 - 0.025D0 * S - BKU = 0.054D0 + 0.154D0 * S - AU = -0.326D0 - 0.058D0 * S - 0.135D0 * S2 - BU = -3.322D0 + 8.259D0 * S - 3.119D0 * S2 + 0.291D0 * S3 - CU = 11.52D0 - 12.99D0 * S + 3.161D0 * S2 - DU = 2.808D0 + 1.400D0 * S - 0.557D0 * S2 + 0.119D0 * S3 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.156D0 - 0.017D0 * S - AKD = 0.299D0 - 0.022D0 * S - BKD = 0.259D0 - 0.015D0 * S - AD = 3.445D0 + 1.278D0 * S + 0.326D0 * S2 - BD = -6.934D0 + 37.45D0 * S - 18.95D0 * S2 + 1.463D0 * S3 - CD = 55.45D0 - 69.92D0 * S + 20.78D0 * S2 - DD = 3.577D0 + 1.441D0 * S - 0.683D0 * S2 + 0.179D0 * S3 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.099D0 + 0.019D0 * S + 0.002D0 * S2 - AKE = 0.419D0 - 0.013D0 * S - BKE = 1.064D0 - 0.038D0 * S - AE = -44.00D0 + 98.70D0 * S - 14.79D0 * S2 - BE = 28.59D0 - 40.94D0 * S - 13.66D0 * S2 + 2.523D0 * S3 - CE = 84.57D0 - 108.8D0 * S + 31.52D0 * S2 - DE = 7.469D0 + 2.480D0 * S - 0.866D0 * S2 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 1.215D0 - BEX = 0.466D0 - AKX = 0.326D0 + 0.150D0 * S - BKX = 0.956D0 + 0.405D0 * S - AGX = 0.272D0 - BGX = 3.794D0 - 2.359D0 * DS - CX = 2.014D0 - DX = 7.941D0 + 0.534D0 * DS - 0.940D0 * S + 0.410D0 * S2 - EX = 3.049D0 + 1.597D0 * S - ESX = 4.396D0 - 4.594D0 * DS + 3.268D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.175D0 - BES = 0.344D0 - AKS = 1.415D0 - 0.641D0 * DS - AS = 0.580D0 - 9.763D0 * DS + 6.795D0 * S - 0.558D0 * S2 - BS = 5.617D0 + 5.709D0 * DS - 3.972D0 * S - DST = 13.78D0 - 9.581D0 * S + 5.370D0 * S2 - 0.996D0 * S3 - EST = 4.546D0 + 0.372D0 * S2 - ESS = 5.053D0 - 1.070D0 * S + 0.805D0 * S2 - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.820D0 - ALC = 0.98D0 - BEC = 0D0 - AKC = -0.625D0 - 0.523D0 * S - AC = 0D0 - BC = 1.896D0 + 1.616D0 * S - DCT = 4.12D0 + 0.683D0 * S - ECT = 4.36D0 + 1.328D0 * S - ESC = 0.677D0 + 0.679D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.297D0 - ALB = 0.99D0 - BEB = 0D0 - AKB = - 0.193D0 * S - AB = 0D0 - BB = 0D0 - DBT = 3.447D0 + 0.927D0 * S - EBT = 4.68D0 + 1.259D0 * S - ESB = 1.892D0 + 2.199D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 1.258D0 - BEG = 1.846D0 - AKG = 2.423D0 - BKG = 2.427D0 + 1.311D0 * S - 0.153D0 * S2 - AG = 25.09D0 - 7.935D0 * S - BG = -14.84D0 - 124.3D0 * DS + 72.18D0 * S - CG = 590.3D0 - 173.8D0 * S - DG = 5.196D0 + 1.857D0 * S - EG = -1.648D0 + 3.988D0 * S - 0.432D0 * S2 - ESG = 3.232D0 - 0.542D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVL -C...Gives the GRV 94 L (leading order) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVL (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.23D0 - LAM2 = 0.2322D0 * 0.2322D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 2.284D0 + 0.802D0 * S + 0.055D0 * S2 - AKU = 0.590D0 - 0.024D0 * S - BKU = 0.131D0 + 0.063D0 * S - AU = -0.449D0 - 0.138D0 * S - 0.076D0 * S2 - BU = 0.213D0 + 2.669D0 * S - 0.728D0 * S2 - CU = 8.854D0 - 9.135D0 * S + 1.979D0 * S2 - DU = 2.997D0 + 0.753D0 * S - 0.076D0 * S2 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.371D0 + 0.083D0 * S + 0.039D0 * S2 - AKD = 0.376D0 - BKD = 0.486D0 + 0.062D0 * S - AD = -0.509D0 + 3.310D0 * S - 1.248D0 * S2 - BD = 12.41D0 - 10.52D0 * S + 2.267D0 * S2 - CD = 6.373D0 - 6.208D0 * S + 1.418D0 * S2 - DD = 3.691D0 + 0.799D0 * S - 0.071D0 * S2 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.082D0 + 0.014D0 * S + 0.008D0 * S2 - AKE = 0.409D0 - 0.005D0 * S - BKE = 0.799D0 + 0.071D0 * S - AE = -38.07D0 + 36.13D0 * S - 0.656D0 * S2 - BE = 90.31D0 - 74.15D0 * S + 7.645D0 * S2 - CE = 0.0D0 - DE = 7.486D0 + 1.217D0 * S - 0.159D0 * S2 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 1.451D0 - BEX = 0.271D0 - AKX = 0.410D0 - 0.232D0 * S - BKX = 0.534D0 - 0.457D0 * S - AGX = 0.890D0 - 0.140D0 * S - BGX = -0.981D0 - CX = 0.320D0 + 0.683D0 * S - DX = 4.752D0 + 1.164D0 * S + 0.286D0 * S2 - EX = 4.119D0 + 1.713D0 * S - ESX = 0.682D0 + 2.978D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.914D0 - BES = 0.577D0 - AKS = 1.798D0 - 0.596D0 * S - AS = -5.548D0 + 3.669D0 * DS - 0.616D0 * S - BS = 18.92D0 - 16.73D0 * DS + 5.168D0 * S - DST = 6.379D0 - 0.350D0 * S + 0.142D0 * S2 - EST = 3.981D0 + 1.638D0 * S - ESS = 6.402D0 - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.888D0 - ALC = 1.01D0 - BEC = 0.37D0 - AKC = 0D0 - AC = 0D0 - BC = 4.24D0 - 0.804D0 * S - DCT = 3.46D0 - 1.076D0 * S - ECT = 4.61D0 + 1.49D0 * S - ESC = 2.555D0 + 1.961D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.351D0 - ALB = 1.00D0 - BEB = 0.51D0 - AKB = 0D0 - AB = 0D0 - BB = 1.848D0 - DBT = 2.929D0 + 1.396D0 * S - EBT = 4.71D0 + 1.514D0 * S - ESB = 4.02D0 + 1.239D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 0.524D0 - BEG = 1.088D0 - AKG = 1.742D0 - 0.930D0 * S - BKG = - 0.399D0 * S2 - AG = 7.486D0 - 2.185D0 * S - BG = 16.69D0 - 22.74D0 * S + 5.779D0 * S2 - CG = -25.59D0 + 29.71D0 * S - 7.296D0 * S2 - DG = 2.792D0 + 2.215D0 * S + 0.422D0 * S2 - 0.104D0 * S3 - EG = 0.807D0 + 2.005D0 * S - ESG = 3.841D0 + 0.316D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, - & DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVM -C...Gives the GRV 94 M (MSbar) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVM (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.34D0 - LAM2 = 0.248D0 * 0.248D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 1.304D0 + 0.863D0 * S - AKU = 0.558D0 - 0.020D0 * S - BKU = 0.183D0 * S - AU = -0.113D0 + 0.283D0 * S - 0.321D0 * S2 - BU = 6.843D0 - 5.089D0 * S + 2.647D0 * S2 - 0.527D0 * S3 - CU = 7.771D0 - 10.09D0 * S + 2.630D0 * S2 - DU = 3.315D0 + 1.145D0 * S - 0.583D0 * S2 + 0.154D0 * S3 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.102D0 - 0.017D0 * S + 0.005D0 * S2 - AKD = 0.270D0 - 0.019D0 * S - BKD = 0.260D0 - AD = 2.393D0 + 6.228D0 * S - 0.881D0 * S2 - BD = 46.06D0 + 4.673D0 * S - 14.98D0 * S2 + 1.331D0 * S3 - CD = 17.83D0 - 53.47D0 * S + 21.24D0 * S2 - DD = 4.081D0 + 0.976D0 * S - 0.485D0 * S2 + 0.152D0 * S3 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.070D0 + 0.042D0 * S - 0.011D0 * S2 + 0.004D0 * S3 - AKE = 0.409D0 - 0.007D0 * S - BKE = 0.782D0 + 0.082D0 * S - AE = -29.65D0 + 26.49D0 * S + 5.429D0 * S2 - BE = 90.20D0 - 74.97D0 * S + 4.526D0 * S2 - CE = 0.0D0 - DE = 8.122D0 + 2.120D0 * S - 1.088D0 * S2 + 0.231D0 * S3 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 0.877D0 - BEX = 0.561D0 - AKX = 0.275D0 - BKX = 0.0D0 - AGX = 0.997D0 - BGX = 3.210D0 - 1.866D0 * S - CX = 7.300D0 - DX = 9.010D0 + 0.896D0 * DS + 0.222D0 * S2 - EX = 3.077D0 + 1.446D0 * S - ESX = 3.173D0 - 2.445D0 * DS + 2.207D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.756D0 - BES = 0.216D0 - AKS = 1.690D0 + 0.650D0 * DS - 0.922D0 * S - AS = -4.329D0 + 1.131D0 * S - BS = 9.568D0 - 1.744D0 * S - DST = 9.377D0 + 1.088D0 * DS - 1.320D0 * S + 0.130D0 * S2 - EST = 3.031D0 + 1.639D0 * S - ESS = 5.837D0 + 0.815D0 * S - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.820D0 - ALC = 0.98D0 - BEC = 0D0 - AKC = -0.625D0 - 0.523D0 * S - AC = 0D0 - BC = 1.896D0 + 1.616D0 * S - DCT = 4.12D0 + 0.683D0 * S - ECT = 4.36D0 + 1.328D0 * S - ESC = 0.677D0 + 0.679D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.297D0 - ALB = 0.99D0 - BEB = 0D0 - AKB = - 0.193D0 * S - AB = 0D0 - BB = 0D0 - DBT = 3.447D0 + 0.927D0 * S - EBT = 4.68D0 + 1.259D0 * S - ESB = 1.892D0 + 2.199D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 1.014D0 - BEG = 1.738D0 - AKG = 1.724D0 + 0.157D0 * S - BKG = 0.800D0 + 1.016D0 * S - AG = 7.517D0 - 2.547D0 * S - BG = 34.09D0 - 52.21D0 * DS + 17.47D0 * S - CG = 4.039D0 + 1.491D0 * S - DG = 3.404D0 + 0.830D0 * S - EG = -1.112D0 + 3.438D0 * S - 0.302D0 * S2 - ESG = 3.256D0 - 0.436D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVS -C...Auxiliary for the GRV 94 parton distribution functions -C...for s, c and b sea. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVS (X, S, STH, AL, BE, AK, AG, B, D, E, ES) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - IF(S.LE.STH) THEN - PYGRVS = 0D0 - ELSE - DX = SQRT (X) - LX = LOG (1D0/X) - PYGRVS = (S - STH)**AL / LX**AK * (1D0+ AG*DX + B*X) * - & (1D0- X)**D * EXP (-E + SQRT (ES * S**BE * LX)) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYGRVV -C...Auxiliary for the GRV 94 parton distribution functions -C...for u and d valence and d-u sea. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVV (X, N, AK, BK, A, B, C, D) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - DX = SQRT (X) - PYGRVV = N * X**AK * (1D0+ A*X**BK + X * (B + C*DX)) * - & (1D0- X)**D - - RETURN - END - -C********************************************************************* - -C...PYGRVW -C...Auxiliary for the GRV 94 parton distribution functions -C...for d+u sea and gluon. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVW (X, S, AL, BE, AK, BK, A, B, C, D, E, ES) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - LX = LOG (1D0/X) - PYGRVW = (X**AK * (A + X * (B + X*C)) * LX**BK + S**AL - & * EXP (-E + SQRT (ES * S**BE * LX))) * (1D0- X)**D - - RETURN - END - -C********************************************************************* - -C...PYGVMD -C...Evaluates the VMD parton distributions of a photon, -C...evolved homogeneously from an initial scale P2 to Q2. -C...Does not include dipole suppression factor. -C...ISET is parton distribution set, see above; -C...additionally ISET=0 is used for the evolution of an anomalous photon -C...which branched at a scale P2 and then evolved homogeneously to Q2. -C...ALAM is the 4-flavour Lambda, which is automatically converted -C...to 3- and 5-flavour equivalents as needed. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local arrays and data. - DIMENSION XPGA(-6:6), VXPGA(-6:6) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - VXPGA(KFL)=0D0 - 100 CONTINUE - KFA=IABS(KF) - -C...Calculate Lambda; protect against unphysical Q2 and P2 input. - ALAM3=ALAM*(PMC/ALAM)**(2D0/27D0) - ALAM5=ALAM*(ALAM/PMB)**(2D0/23D0) - P2EFF=MAX(P2,1.2D0*ALAM3**2) - IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) - IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - -C...Find number of flavours at lower and upper scale. - NFP=4 - IF(P2EFF.LT.PMC**2) NFP=3 - IF(P2EFF.GT.PMB**2) NFP=5 - NFQ=4 - IF(Q2EFF.LT.PMC**2) NFQ=3 - IF(Q2EFF.GT.PMB**2) NFQ=5 - -C...Find s as sum of 3-, 4- and 5-flavour parts. - S=0D0 - IF(NFP.EQ.3) THEN - Q2DIV=PMC**2 - IF(NFQ.EQ.3) Q2DIV=Q2EFF - S=S+(6D0/27D0)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) - ENDIF - IF(NFP.LE.4.AND.NFQ.GE.4) THEN - P2DIV=P2EFF - IF(NFP.EQ.3) P2DIV=PMC**2 - Q2DIV=Q2EFF - IF(NFQ.EQ.5) Q2DIV=PMB**2 - S=S+(6D0/25D0)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) - ENDIF - IF(NFQ.EQ.5) THEN - P2DIV=PMB**2 - IF(NFP.EQ.5) P2DIV=P2EFF - S=S+(6D0/23D0)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) - ENDIF - -C...Calculate frequent combinations of x and s. - X1=1D0-X - XL=-LOG(X) - S2=S**2 - S3=S**3 - S4=S**4 - -C...Evaluate homogeneous anomalous parton distributions below or -C...above threshold. - IF(ISET.EQ.0) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = X * 1.5D0 * (X**2+X1**2) - XGLU = 0D0 - XSEA = 0D0 - ELSE - XVAL = (1.5D0/(1D0-0.197D0*S+4.33D0*S2)*X**2 + - & (1.5D0+2.10D0*S)/(1D0+3.29D0*S)*X1**2 + - & 5.23D0*S/(1D0+1.17D0*S+19.9D0*S3)*X*X1) * - & X**(1D0/(1D0+1.5D0*S)) * (1D0-X**2)**(2.667D0*S) - XGLU = 4D0*S/(1D0+4.76D0*S+15.2D0*S2+29.3D0*S4) * - & X**(-2.03D0*S/(1D0+2.44D0*S)) * (X1*XL)**(1.333D0*S) * - & ((4D0*X**2+7D0*X+4D0)*X1/3D0 - 2D0*X*(1D0+X)*XL) - XSEA = S2/(1D0+4.54D0*S+8.19D0*S2+8.05D0*S3) * - & X**(-1.54D0*S/(1D0+1.29D0*S)) * X1**(2.667D0*S) * - & ((8D0-73D0*X+62D0*X**2)*X1/9D0 + (3D0-8D0*X**2/3D0)*X*XL + - & (2D0*X-1D0)*X*XL**2) - ENDIF - -C...Evaluate set 1D parton distributions below or above threshold. - ELSEIF(ISET.EQ.1) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 1.294D0 * X**0.80D0 * X1**0.76D0 - XGLU = 1.273D0 * X**0.40D0 * X1**1.76D0 - XSEA = 0.100D0 * X1**3.76D0 - ELSE - XVAL = 1.294D0/(1D0+0.252D0*S+3.079D0*S2) * - & X**(0.80D0-0.13D0*S) * X1**(0.76D0+0.667D0*S) * XL**(2D0*S) - XGLU = 7.90D0*S/(1D0+5.50D0*S) * EXP(-5.16D0*S) * - & X**(-1.90D0*S/(1D0+3.60D0*S)) * X1**1.30D0 * - & XL**(0.50D0+3D0*S) + 1.273D0 * EXP(-10D0*S) * - & X**0.40D0 * X1**(1.76D0+3D0*S) - XSEA = (0.1D0-0.397D0*S2+1.121D0*S3)/ - & (1D0+5.61D0*S2+5.26D0*S3) * X**(-7.32D0*S2/(1D0+10.3D0*S2)) * - & X1**((3.76D0+15D0*S+12D0*S2)/(1D0+4D0*S)) - XSEA0 = 0.100D0 * X1**3.76D0 - ENDIF - -C...Evaluate set 1M parton distributions below or above threshold. - ELSEIF(ISET.EQ.2) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 0.8477D0 * X**0.51D0 * X1**1.37D0 - XGLU = 3.42D0 * X**0.255D0 * X1**2.37D0 - XSEA = 0D0 - ELSE - XVAL = 0.8477D0/(1D0+1.37D0*S+2.18D0*S2+3.73D0*S3) * - & X**(0.51D0+0.21D0*S) * X1**1.37D0 * XL**(2.667D0*S) - XGLU = 24D0*S/(1D0+9.6D0*S+0.92D0*S2+14.34D0*S3) * - & EXP(-5.94D0*S) * X**((-0.013D0-1.80D0*S)/(1D0+3.14D0*S)) * - & X1**(2.37D0+0.4D0*S) * XL**(0.32D0+3.6D0*S) + 3.42D0 * - & EXP(-12D0*S) * X**0.255D0 * X1**(2.37D0+3D0*S) - XSEA = 0.842D0*S/(1D0+21.3D0*S-33.2D0*S2+229D0*S3) * - & X**((0.13D0-2.90D0*S)/(1D0+5.44D0*S)) * X1**(3.45D0+0.5D0*S) * - & XL**(2.8D0*S) - XSEA0 = 0D0 - ENDIF - -C...Evaluate set 2D parton distributions below or above threshold. - ELSEIF(ISET.EQ.3) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = X**0.46D0 * X1**0.64D0 + 0.76D0 * X - XGLU = 1.925D0 * X1**2 - XSEA = 0.242D0 * X1**4 - ELSE - XVAL = (1D0+0.186D0*S)/(1D0-0.209D0*S+1.495D0*S2) * - & X**(0.46D0+0.25D0*S) * - & X1**((0.64D0+0.14D0*S+5D0*S2)/(1D0+S)) * XL**(1.9D0*S) + - & (0.76D0+0.4D0*S) * X * X1**(2.667D0*S) - XGLU = (1.925D0+5.55D0*S+147D0*S2)/(1D0-3.59D0*S+3.32D0*S2) * - & EXP(-18.67D0*S) * - & X**((-5.81D0*S-5.34D0*S2)/(1D0+29D0*S-4.26D0*S2)) - & * X1**((2D0-5.9D0*S)/(1D0+1.7D0*S)) * - & XL**(9.3D0*S/(1D0+1.7D0*S)) - XSEA = (0.242D0-0.252D0*S+1.19D0*S2)/ - & (1D0-0.607D0*S+21.95D0*S2) * - & X**(-12.1D0*S2/(1D0+2.62D0*S+16.7D0*S2)) * X1**4 * XL**S - XSEA0 = 0.242D0 * X1**4 - ENDIF - -C...Evaluate set 2M parton distributions below or above threshold. - ELSEIF(ISET.EQ.4) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 1.168D0 * X**0.50D0 * X1**2.60D0 + 0.965D0 * X - XGLU = 1.808D0 * X1**2 - XSEA = 0.209D0 * X1**4 - ELSE - XVAL = (1.168D0+1.771D0*S+29.35D0*S2) * EXP(-5.776D0*S) * - & X**((0.5D0+0.208D0*S)/(1D0-0.794D0*S+1.516D0*S2)) * - & X1**((2.6D0+7.6D0*S)/(1D0+5D0*S)) * - & XL**(5.15D0*S/(1D0+2D0*S)) + - & (0.965D0+22.35D0*S)/(1D0+18.4D0*S) * X * X1**(2.667D0*S) - XGLU = (1.808D0+29.9D0*S)/(1D0+26.4D0*S) * EXP(-5.28D0*S) * - & X**((-5.35D0*S-10.11D0*S2)/(1D0+31.71D0*S)) * - & X1**((2D0-7.3D0*S+4D0*S2)/(1D0+2.5D0*S)) * - & XL**(10.9D0*S/(1D0+2.5D0*S)) - XSEA = (0.209D0+0.644D0*S2)/(1D0+0.319D0*S+17.6D0*S2) * - & X**((-0.373D0*S-7.71D0*S2)/(1D0+0.815D0*S+11.0D0*S2)) * - & X1**(4D0+S) * XL**(0.45D0*S) - XSEA0 = 0.209D0 * X1**4 - ENDIF - ENDIF - -C...Threshold factors for c and b sea. - SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) - XCHM=0D0 - IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - IF(ISET.EQ.0) THEN - XCHM=XSEA*(1D0-(SCH/SLL)**2) - ELSE - XCHM=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SCH/SLL) - ENDIF - ENDIF - XBOT=0D0 - IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - IF(ISET.EQ.0) THEN - XBOT=XSEA*(1D0-(SBT/SLL)**2) - ELSE - XBOT=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SBT/SLL) - ENDIF - ENDIF - -C...Fill parton distributions. - XPGA(0)=XGLU - XPGA(1)=XSEA - XPGA(2)=XSEA - XPGA(3)=XSEA - XPGA(4)=XCHM - XPGA(5)=XBOT - XPGA(KFA)=XPGA(KFA)+XVAL - DO 110 KFL=1,5 - XPGA(-KFL)=XPGA(KFL) - 110 CONTINUE - VXPGA(KFA)=XVAL - VXPGA(-KFA)=XVAL - - RETURN - END - -C********************************************************************* - -C...PYH2XX -C...Calculates the decay rate for a Higgs to an ino pair. - - FUNCTION PYH2XX(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Local variables. - DOUBLE PRECISION PYH2XX,XM1,XM2,XM3,GL,GR - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMK2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMK2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMK2) - PYH2XX=C1/4D0/XMI3*SQRT(XL) - &*(GX2*(XMI2-XMJ2-XMK2)- - &4D0*GLR*XM3*XM2) - IF(PYH2XX.LT.0D0) THEN - WRITE(MSTU(11),*) ' NEGATIVE WIDTH IN PYH2XX ' - WRITE(MSTU(11),*) XMI2,XMJ2,XMK2,GX2,GLR,XM1,XM2,XM3 - STOP - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYHEPC -C...Converts PYTHIA event record contents to or from -C...the standard event record commonblock. - - SUBROUTINE PYHEPC(MCONV) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...HEPEVT commonblock. - PARAMETER (NMXHEP=4000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) - DOUBLE PRECISION PHEP,VHEP - SAVE /HEPEVT/ - -C...Conversion from PYTHIA to standard, the easy part. - IF(MCONV.EQ.1) THEN - NEVHEP=0 - IF(N.GT.NMXHEP) CALL PYERRM(8, - & '(PYHEPC:) no more space in /HEPEVT/') - NHEP=MIN(N,NMXHEP) - DO 150 I=1,NHEP - ISTHEP(I)=0 - IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 - IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 - IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 - IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) - IDHEP(I)=K(I,2) - JMOHEP(1,I)=K(I,3) - JMOHEP(2,I)=0 - IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN - JDAHEP(1,I)=K(I,4) - JDAHEP(2,I)=K(I,5) - ELSE - JDAHEP(1,I)=0 - JDAHEP(2,I)=0 - ENDIF - DO 100 J=1,5 - PHEP(J,I)=P(I,J) - 100 CONTINUE - DO 110 J=1,4 - VHEP(J,I)=V(I,J) - 110 CONTINUE - -C...Check if new event (from pileup). - IF(I.EQ.1) THEN - INEW=1 - ELSE - IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I - ENDIF - -C...Fill in missing mother information. - IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN - IMO1=I-2 - 120 IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0) - & THEN - IMO1=IMO1-1 - GOTO 120 - ENDIF - JMOHEP(1,I)=IMO1 - JMOHEP(2,I)=IMO1+1 - ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN - I1=K(I,3)-1 - 130 I1=I1+1 - IF(I1.GE.I) CALL PYERRM(8, - & '(PYHEPC:) translation of inconsistent event history') - IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130 - KC=PYCOMP(K(I1,2)) - IF(I1.LT.I.AND.KC.EQ.0) GOTO 130 - IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130 - JMOHEP(2,I)=I1 - ELSEIF(K(I,2).EQ.94) THEN - NJET=2 - IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 - IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 - JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) - IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= - & MOD(K(I+1,4)/MSTU(5),MSTU(5)) - ENDIF - -C...Fill in missing daughter information. - IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN - DO 140 I1=JDAHEP(1,I),JDAHEP(2,I) - I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) - JDAHEP(1,I2)=I - 140 CONTINUE - ENDIF - IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150 - I1=JMOHEP(1,I) - IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150 - IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150 - IF(JDAHEP(1,I1).EQ.0) THEN - JDAHEP(1,I1)=I - ELSE - JDAHEP(2,I1)=I - ENDIF - 150 CONTINUE - DO 160 I=1,NHEP - IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160 - IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) - 160 CONTINUE - -C...Conversion from standard to PYTHIA, the easy part. - ELSE - IF(NHEP.GT.MSTU(4)) CALL PYERRM(8, - & '(PYHEPC:) no more space in /PYJETS/') - N=MIN(NHEP,MSTU(4)) - NKQ=0 - KQSUM=0 - DO 190 I=1,N - K(I,1)=0 - IF(ISTHEP(I).EQ.1) K(I,1)=1 - IF(ISTHEP(I).EQ.2) K(I,1)=11 - IF(ISTHEP(I).EQ.3) K(I,1)=21 - K(I,2)=IDHEP(I) - K(I,3)=JMOHEP(1,I) - K(I,4)=JDAHEP(1,I) - K(I,5)=JDAHEP(2,I) - DO 170 J=1,5 - P(I,J)=PHEP(J,I) - 170 CONTINUE - DO 180 J=1,4 - V(I,J)=VHEP(J,I) - 180 CONTINUE - V(I,5)=0D0 - IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN - I1=JDAHEP(1,I) - IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* - & PHEP(5,I)/PHEP(4,I) - ENDIF - -C...Fill in missing information on colour connection in jet systems. - IF(ISTHEP(I).EQ.1) THEN - KC=PYCOMP(K(I,2)) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.NE.0) NKQ=NKQ+1 - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(KQ.NE.0.AND.KQSUM.NE.0) THEN - K(I,1)=2 - ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN - IF(K(I+1,2).EQ.21) K(I,1)=2 - ENDIF - ENDIF - 190 CONTINUE - IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8, - & '(PYHEPC:) input parton configuration not colour singlet') - ENDIF - - END - -C********************************************************************* - -C...PYHEXT -C...Calculates the non-standard decay modes of the Higgs boson. -C... -C...Author: Stephen Mrenna -C...Last Update: April 2001 -C......Allow complex values for Z,U, and V - - SUBROUTINE PYHEXT(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP - COMPLEX*16 QIJ,RIJ,F21K,F12K - INTEGER KFIN - DOUBLE PRECISION XMI,XMJ,XMF,XMW,XMW2,XMZ,AXMJ,AXMI - DOUBLE PRECISION XMI2,XMI3,XMJ2 - DOUBLE PRECISION PYLAMF,XL,CF,EI - INTEGER IDU,IFL - DOUBLE PRECISION TANW,XW,AEM,C1,AS - DOUBLE PRECISION PYH2XX,GHLL,GHRR,GHLR - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IH,J,IJ,I,IKNT,IK - INTEGER ITH(4) - INTEGER KFNCHI(4),KFCCHI(2) - DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION BETA,ALFA - DOUBLE PRECISION CBETA,SBETA,GR,GL,TANB - DOUBLE PRECISION PYALEM - DOUBLE PRECISION AL,AR,ALR - DOUBLE PRECISION XMK,AXMK,COSA,SINA,CW,XML - DOUBLE PRECISION XMUZ,ATRIT,ATRIB,ATRIL - DOUBLE PRECISION XMJL,XMJR,XM1,XM2 - DATA ITH/25,35,36,37/ - DATA ETAH/1D0,1D0,-1D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=IKNT - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - CW=SQRT(1D0-XW) - -C...1 - 4 DEPENDING ON Higgs species. - IH=1 - IF(KFIN.EQ.ITH(2)) IH=2 - IF(KFIN.EQ.ITH(3)) IH=3 - IF(KFIN.EQ.ITH(4)) IH=4 - - XMI=PMAS(KFIN,1) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - - TANB=RMSS(5) - BETA=ATAN(TANB) - CBETA=COS(BETA) - SBETA=TANB*CBETA - ALFA=RMSS(18) - COSA=COS(ALFA) - SINA=SIN(ALFA) - ATRIT=RMSS(16) - ATRIB=RMSS(15) - ATRIL=RMSS(17) - XMUZ=-RMSS(4) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - - - IF(IH.EQ.4) GOTO 220 - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS -C...H0_K -> CHI0_I + CHI0_J - EH(2)=SINA - EH(1)=COSA - EH(3)=CBETA - DH(2)=COSA - DH(1)=-SINA - DH(3)=SBETA - DO 150 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - DO 140 IK=1,IJ - XMK=SMZ(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - QIJ=ZMIXC(IK,3)*ZMIXC(IJ,2)+ - & ZMIXC(IJ,3)*ZMIXC(IK,2)- - & TANW*(ZMIXC(IK,3)*ZMIXC(IJ,1)+ - & ZMIXC(IJ,3)*ZMIXC(IK,1)) - RIJ=ZMIXC(IK,4)*ZMIXC(IJ,2)+ - & ZMIXC(IJ,4)*ZMIXC(IK,2)- - & TANW*(ZMIXC(IK,4)*ZMIXC(IJ,1)+ - & ZMIXC(IJ,4)*ZMIXC(IK,1)) - F21K=0.5D0*DCONJG(QIJ*DH(IH)-RIJ*EH(IH)) - F12K=0.5D0*(QIJ*DH(IH)-RIJ*EH(IH)) -C...SIGN OF MASSES I,J - XML=XMK*ETAH(IH) - GX2=ABS(F12K)**2+ABS(F21K)**2 - GLR=DBLE(F12K*DCONJG(F21K)) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) - IF(IJ.EQ.IK) XLAM(LKNT)=XLAM(LKNT)*0.5D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=KFNCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 140 CONTINUE - 150 CONTINUE - -C...H0_K -> CHI+_I CHI-_J - DO 170 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - DO 160 IK=1,2 - XMK=SMW(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - OLPP=DCONJG(VMIXC(IJ,1)*UMIXC(IK,2)*DH(IH) + - & VMIXC(IJ,2)*UMIXC(IK,1)*EH(IH))/SR2 - ORPP=(VMIXC(IK,1)*UMIXC(IJ,2)*DH(IH) + - & VMIXC(IK,2)*UMIXC(IJ,1)*EH(IH))/SR2 - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XML=XMK*ETAH(IH) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-KFCCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 160 CONTINUE - 170 CONTINUE - -C...HIGGS TO SFERMION SFERMION - DO 200 IFL=1,16 - IF(IFL.GE.7.AND.IFL.LE.10) GOTO 200 - IJ=KSUSY1+IFL - XMJL=PMAS(PYCOMP(IJ),1) - XMJR=PMAS(PYCOMP(IJ+KSUSY1),1) - IF(AXMI.GE.2D0*MIN(XMJL,XMJR)) THEN - XMJ=XMJL - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJ2) - XMF=PMAS(IFL,1) - EI=KCHG(IFL,1)/3D0 - IDU=2-MOD(IFL,2) - - IF(IH.EQ.1) THEN - IF(IDU.EQ.1) THEN - GHLL=-XMZ/CW*(0.5D0+EI*XW)*SIN(ALFA+BETA)+ - & XMF**2/XMW*SINA/CBETA - GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)+ - & XMF**2/XMW*SINA/CBETA - IF(IFL.EQ.5) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- - & ATRIB*SINA) - ELSEIF(IFL.EQ.15) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- - & ATRIL*SINA) - ELSE - GHLR=0D0 - ENDIF - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*SIN(ALFA+BETA)- - & XMF**2/XMW*COSA/SBETA - GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)- - & XMF**2/XMW*COSA/SBETA - IF(IFL.EQ.6) THEN - GHLR=XMF/2D0/XMW/SBETA*(XMUZ*SINA- - & ATRIT*COSA) - ELSE - GHLR=0D0 - ENDIF - ENDIF - - ELSEIF(IH.EQ.2) THEN - IF(IDU.EQ.1) THEN - GHLL=XMZ/CW*(0.5D0+EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*COSA/CBETA - GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*COSA/CBETA - IF(IFL.EQ.5) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ - & ATRIB*COSA) - ELSEIF(IFL.EQ.15) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ - & ATRIL*COSA) - ELSE - GHLR=0D0 - ENDIF - ELSE - GHLL=-XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*SINA/SBETA - GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*SINA/SBETA - IF(IFL.EQ.6) THEN - GHLR=-XMF/2D0/XMW/SBETA*(XMUZ*COSA+ - & ATRIT*SINA) - ELSE - GHLR=0D0 - ENDIF - ENDIF - - ELSEIF(IH.EQ.3) THEN - GHLL=0D0 - GHRR=0D0 - GHLR=0D0 - IF(IDU.EQ.1) THEN - IF(IFL.EQ.5) THEN - GHLR=XMF/2D0/XMW*(ATRIB*TANB-XMUZ) - ELSEIF(IFL.EQ.15) THEN - GHLR=XMF/2D0/XMW*(ATRIL*TANB-XMUZ) - ENDIF - ELSE - IF(IFL.EQ.6) THEN - GHLR=XMF/2D0/XMW*(ATRIT/TANB-XMUZ) - ENDIF - ENDIF - ENDIF - IF(IH.EQ.3) GOTO 180 - - AL=SFMIX(IFL,1)**2 - AR=SFMIX(IFL,2)**2 - ALR=SFMIX(IFL,1)*SFMIX(IFL,2) - IF(IFL.LE.6) THEN - CF=3D0 - ELSE - CF=1D0 - ENDIF - - IF(AXMI.GE.2D0*XMJ) THEN - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR - & +2D0*GHLR*ALR)**2 - IDLAM(LKNT,1)=IJ - IDLAM(LKNT,2)=-IJ - IDLAM(LKNT,3)=0 - ENDIF - - IF(AXMI.GE.2D0*XMJR) THEN - LKNT=LKNT+1 - AL=SFMIX(IFL,3)**2 - AR=SFMIX(IFL,4)**2 - ALR=SFMIX(IFL,3)*SFMIX(IFL,4) - XMJ=XMJR - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJ2) - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR - & +2D0*GHLR*ALR)**2 - IDLAM(LKNT,1)=IJ+KSUSY1 - IDLAM(LKNT,2)=-(IJ+KSUSY1) - IDLAM(LKNT,3)=0 - ENDIF - 180 CONTINUE - - IF(AXMI.GE.XMJL+XMJR) THEN - LKNT=LKNT+1 - AL=SFMIX(IFL,1)*SFMIX(IFL,3) - AR=SFMIX(IFL,2)*SFMIX(IFL,4) - ALR=SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,2)*SFMIX(IFL,3) - XMJ=XMJR - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJL**2) - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR)**2 - IDLAM(LKNT,1)=IJ - IDLAM(LKNT,2)=-(IJ+KSUSY1) - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IJ - IDLAM(LKNT,2)=IJ+KSUSY1 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XLAM(LKNT-1) - ENDIF - ENDIF - 190 CONTINUE - 200 CONTINUE - 210 CONTINUE - - GOTO 270 - 220 CONTINUE - -C...H+ -> CHI+_I + CHI0_J - DO 240 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - DO 230 IK=1,2 - XMK=SMW(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - OLPP=CBETA*DCONJG(ZMIXC(IJ,4)*VMIXC(IK,1)+(ZMIXC(IJ,2)+ - & ZMIXC(IJ,1)*TANW)*VMIXC(IK,2)/SR2) - ORPP=SBETA*(ZMIXC(IJ,3)*UMIXC(IK,1)- - & (ZMIXC(IJ,2)+ZMIXC(IJ,1)*TANW)*UMIXC(IK,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,-XMK,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=KFCCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 230 CONTINUE - 240 CONTINUE - - GL=-XMW/SR2*(SIN(2D0*BETA)-PMAS(6,1)**2/TANB/XMW2) - GR=-PMAS(6,1)/SR2/XMW*(XMUZ-ATRIT/TANB) - AL=0D0 - AR=0D0 - CF=3D0 - -C...H+ -> T_1 B_1~ - XM1=PMAS(PYCOMP(KSUSY1+6),1) - XM2=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,1)*SFMIX(5,1)+GR*SFMIX(6,2)*SFMIX(5,1))**2 - IDLAM(LKNT,1)=KSUSY1+6 - IDLAM(LKNT,2)=-(KSUSY1+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_2 B_1~ - XM1=PMAS(PYCOMP(KSUSY2+6),1) - XM2=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,3)*SFMIX(5,1)+GR*SFMIX(6,4)*SFMIX(5,1))**2 - IDLAM(LKNT,1)=KSUSY2+6 - IDLAM(LKNT,2)=-(KSUSY1+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_1 B_2~ - XM1=PMAS(PYCOMP(KSUSY1+6),1) - XM2=PMAS(PYCOMP(KSUSY2+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,1)*SFMIX(5,3)+GR*SFMIX(6,2)*SFMIX(5,3))**2 - IDLAM(LKNT,1)=KSUSY1+6 - IDLAM(LKNT,2)=-(KSUSY2+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_2 B_2~ - XM1=PMAS(PYCOMP(KSUSY2+6),1) - XM2=PMAS(PYCOMP(KSUSY2+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,3)*SFMIX(5,3)+GR*SFMIX(6,4)*SFMIX(5,3))**2 - IDLAM(LKNT,1)=KSUSY2+6 - IDLAM(LKNT,2)=-(KSUSY2+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> UL DL~ - GL=-XMW/SR2*SIN(2D0*BETA) - DO 250 IJ=1,3,2 - XM1=PMAS(PYCOMP(KSUSY1+IJ),1) - XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 - IDLAM(LKNT,1)=-(KSUSY1+IJ) - IDLAM(LKNT,2)=KSUSY1+IJ+1 - IDLAM(LKNT,3)=0 - ENDIF - 250 CONTINUE - -C...H+ -> EL~ NUL - CF=1D0 - DO 260 IJ=11,13,2 - XM1=PMAS(PYCOMP(KSUSY1+IJ),1) - XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 - IDLAM(LKNT,1)=-(KSUSY1+IJ) - IDLAM(LKNT,2)=KSUSY1+IJ+1 - IDLAM(LKNT,3)=0 - ENDIF - 260 CONTINUE - -C...H+ -> TAU1 NUTAUL - XM1=PMAS(PYCOMP(KSUSY1+15),1) - XM2=PMAS(PYCOMP(KSUSY1+16),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,1)**2 - IDLAM(LKNT,1)=-(KSUSY1+15) - IDLAM(LKNT,2)= KSUSY1+16 - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> TAU2 NUTAUL - XM1=PMAS(PYCOMP(KSUSY2+15),1) - XM2=PMAS(PYCOMP(KSUSY1+16),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,3)**2 - IDLAM(LKNT,1)=-(KSUSY2+15) - IDLAM(LKNT,2)= KSUSY1+16 - IDLAM(LKNT,3)=0 - ENDIF - - 270 CONTINUE - IKNT=LKNT - XLAM(0)=0D0 - DO 280 I=1,IKNT - IF(XLAM(I).LE.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 280 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYHFTH -C...Gives threshold attractive/repulsive factor for heavy flavour -C...production. - - FUNCTION PYHFTH(SH,SQM,FRATT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ - -C...Value for alpha_strong. - IF(MSTP(35).LE.1) THEN - ALSSG=PARP(35) - ELSE - MST115=MSTU(115) - MSTU(115)=MSTP(36) - Q2BN=SQRT(MAX(1D0,SQM*((SQRT(SH)-2D0*SQRT(SQM))**2+ - & PARP(36)**2))) - ALSSG=PYALPS(Q2BN) - MSTU(115)=MST115 - ENDIF - -C...Evaluate attractive and repulsive factors. - XATTR=4D0*PARU(1)*ALSSG/(3D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) - FATTR=XATTR/(1D0-EXP(-MIN(50D0,XATTR))) - XREPU=PARU(1)*ALSSG/(6D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) - FREPU=XREPU/(EXP(MIN(50D0,XREPU))-1D0) - PYHFTH=FRATT*FATTR+(1D0-FRATT)*FREPU - VINT(138)=PYHFTH - - RETURN - END - -C********************************************************************* - -C...PYHGGM -C...Determines the Higgs boson mass spectrum using several inputs. - - SUBROUTINE PYHGGM(ALPHA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/ - -C...Local variables. - DOUBLE PRECISION AT,AB,XMU,TANB - DOUBLE PRECISION ALPHA - INTEGER IHOPT - DOUBLE PRECISION DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD - DOUBLE PRECISION DMU,DMH,DHM,DMHCH,DSA,DCA,DTANBA - DOUBLE PRECISION DMC,DMDR,DMHP,DHMP,DAMP - DOUBLE PRECISION DSTOP1,DSTOP2,DSBOT1,DSBOT2 - - IHOPT=IMSS(4) - IF(IHOPT.EQ.2) THEN - ALPHA=RMSS(18) - RETURN - ENDIF - AT=RMSS(16) - AB=RMSS(15) - DMGL=RMSS(3) - XMU=RMSS(4) - TANB=RMSS(5) - - DMA=RMSS(19) - DTANB=TANB - DMQ=RMSS(10) - DMUR=RMSS(12) - DMDR=RMSS(11) - DMTOP=PMAS(6,1) - DMC=PMAS(PYCOMP(KSUSY1+37),1) - DAU=AT - DAD=AB - DMU=XMU - RMSS(40)=0D0 - RMSS(41)=0D0 - - IF(IHOPT.EQ.0) THEN - CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, - & DMHCH,DSA,DCA,DTANBA) - ELSEIF(IHOPT.EQ.1) THEN - CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, - & DMHCH,DSA,DCA,DTANBA) - CALL PYPOLE(3,DMC,DMA,DTANB,DMQ,DMUR,DMDR,DMTOP,DAU,DAD,DMU, - & DMH,DMHP,DHM,DHMP,DAMP,DSA,DCA, - & DSTOP1,DSTOP2,DSBOT1,DSBOT2,DTANBA,DMGL,DDT,DDB) - RMSS(40)=DDT - RMSS(41)=DDB - DMH=DMHP - DHM=DHMP - DMA=DAMP - IF(ABS(PMAS(PYCOMP(1000006),1)-DSTOP2).GT.5D-1) THEN - WRITE(MSTU(11),*) ' STOP1 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' STOP1 MASSES = ', - & PMAS(PYCOMP(1000006),1),DSTOP2 - ENDIF - IF(ABS(PMAS(PYCOMP(2000006),1)-DSTOP1).GT.5D-1) THEN - WRITE(MSTU(11),*) ' STOP2 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' STOP2 MASSES = ', - & PMAS(PYCOMP(2000006),1),DSTOP1 - ENDIF - IF(ABS(PMAS(PYCOMP(1000005),1)-DSBOT2).GT.5D-1) THEN - WRITE(MSTU(11),*) ' SBOT1 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' SBOT1 MASSES = ', - & PMAS(PYCOMP(1000005),1),DSBOT2 - ENDIF - IF(ABS(PMAS(PYCOMP(2000005),1)-DSBOT1).GT.5D-1) THEN - WRITE(MSTU(11),*) ' SBOT2 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' SBOT2 MASSES = ', - & PMAS(PYCOMP(2000005),1),DSBOT1 - ENDIF - - ENDIF - - ALPHA=ACOS(DCA) - - PMAS(25,1)=DMH - PMAS(35,1)=DHM - PMAS(36,1)=DMA - PMAS(37,1)=DMHCH - - RETURN - END - -C********************************************************************* - -C...PYHIST -C...Prints and resets all histograms. - - SUBROUTINE PYHIST - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Loop over histograms, print and reset used ones. - DO 100 ID=1,IHIST(1) - IS=INDX(ID) - IF(IS.NE.0.AND.NINT(BIN(IS+5)).GT.0) THEN - CALL PYPLOT(ID) - CALL PYNULL(ID) - ENDIF - 100 CONTINUE - - RETURN - END - -C*********************************************************************** - -C...PYI3AU -C...Calculates real and imaginary parts of the auxiliary function I3; -C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, -C...Nucl. Phys. B297 (1988) 221. - - SUBROUTINE PYI3AU(EPS,RAT,Y3RE,Y3IM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - BE=0.5D0*(1D0+SQRT(1D0+RAT*EPS)) - IF(EPS.LT.1D0) GA=0.5D0*(1D0+SQRT(1D0-EPS)) - - IF(EPS.LT.0D0) THEN - IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ - & PYSPEN(0.25D0*(RAT+1D0)*EPS/(1D0+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((RAT+1D0)/RAT,0D0,1)+0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2- - & LOG(0.25D0*RAT*EPS)**2)+LOG(1D0-0.25D0*EPS)* - & LOG((1D0+0.25D0*(RAT-1D0)*EPS)/(1D0+0.25D0*RAT*EPS))+ - & LOG(-0.25D0*EPS)*LOG(0.25D0*RAT*EPS/(1D0+0.25D0*(RAT-1D0)* - & EPS)) - ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ - & PYSPEN((BE-1D0+0.25D0*EPS)/BE,0D0,1)- - & PYSPEN((BE-1D0+0.25D0*EPS)/(BE-1D0),0D0,1)+ - & 0.5D0*(LOG(BE)**2-LOG(BE-1D0)**2)+ - & LOG(1D0-0.25D0*EPS)*LOG((BE-0.25D0*EPS)/BE)+ - & LOG(-0.25D0*EPS)*LOG((BE-1D0)/(BE-0.25D0*EPS)) - ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ - & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(1D0+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(0.25D0*RAT*EPS),0D0,1)+ - & 0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-LOG(0.25D0*RAT*EPS)**2)+ - & LOG(GA)*LOG((GA+0.25D0*RAT*EPS)/(1D0+0.25D0*RAT*EPS))+ - & LOG(GA-1D0)*LOG(0.25D0*RAT*EPS/(GA+0.25D0*RAT*EPS)) - ELSE - F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- - & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN((BE-GA)/BE,0D0,1)- - & PYSPEN((BE-GA)/(BE-1D0),0D0,1)+0.5D0*(LOG(BE)**2- - & LOG(BE-1D0)**2)+LOG(GA)*LOG((GA+BE-1D0)/BE)+ - & LOG(GA-1D0)*LOG((BE-1D0)/(GA+BE-1D0)) - ENDIF - F3IM=0D0 - ELSEIF(EPS.LT.1D0) THEN - IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ - & PYSPEN((1D0-0.25D0*EPS)/(-0.25D0*(RAT+1D0)*EPS),0D0,1)- - & PYSPEN(1D0/(RAT+1D0),0D0,1)+LOG((1D0-0.25D0*EPS)/ - & (0.25D0*EPS))*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ - & (0.25D0*(RAT+1D0)*EPS)) - F3IM=-PARU(1)*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ - & (0.25D0*(RAT+1D0)*EPS)) - ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ - & PYSPEN((1D0-0.25D0*EPS)/(1D0-0.25D0*EPS-BE),0D0,1)- - & PYSPEN(-0.25D0*EPS/(1D0-0.25D0*EPS-BE),0D0,1)+ - & LOG((1D0-0.25D0*EPS)/(0.25D0*EPS))* - & LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) - F3IM=-PARU(1)*LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) - ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ - & PYSPEN(GA/(GA-1D0-0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((GA-1D0)/(GA-1D0-0.25D0*RAT*EPS),0D0,1)+ - & LOG(GA/(1D0-GA))*LOG((GA+0.25D0*RAT*EPS)/ - & (1D0+0.25D0*RAT*EPS-GA)) - F3IM=-PARU(1)*LOG((GA+0.25D0*RAT*EPS)/ - & (1D0+0.25D0*RAT*EPS-GA)) - ELSE - F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- - & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN(GA/(GA-BE),0D0,1)- - & PYSPEN((GA-1D0)/(GA-BE),0D0,1)+LOG(GA/(1D0-GA))* - & LOG((GA+BE-1D0)/(BE-GA)) - F3IM=-PARU(1)*LOG((GA+BE-1D0)/(BE-GA)) - ENDIF - ELSE - RSQ=EPS/(EPS-1D0+(2D0*BE-1D0)**2) - RCTHE=RSQ*(1D0-2D0*BE/EPS) - RSTHE=SQRT(MAX(0D0,RSQ-RCTHE**2)) - RCPHI=RSQ*(1D0+2D0*(BE-1D0)/EPS) - RSPHI=SQRT(MAX(0D0,RSQ-RCPHI**2)) - R=SQRT(RSQ) - THE=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCTHE/R))) - PHI=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCPHI/R))) - F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)- - & PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+ - & (PHI-THE)*(PHI+THE-PARU(1)) - F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)- - & PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2) - ENDIF - - Y3RE=2D0/(2D0*BE-1D0)*F3RE - Y3IM=2D0/(2D0*BE-1D0)*F3IM - - RETURN - END - -C********************************************************************* - -C...PYINBM -C...Identifies the two incoming particles and the choice of frame. - - SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ - -C...Local arrays, character variables and data. - CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26, - &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16 - DIMENSION LEN(3),KCDE(39),PM(2) - DATA CHALP/'abcdefghijklmnopqrstuvwxyz', - &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - DATA CHCDE/ 'e- ','e+ ','nu_e ', - &'nu_ebar ','mu- ','mu+ ','nu_mu ', - &'nu_mubar ','tau- ','tau+ ','nu_tau ', - &'nu_taubar ','pi+ ','pi- ','n0 ', - &'nbar0 ','p+ ','pbar- ','gamma ', - &'lambda0 ','sigma- ','sigma0 ','sigma+ ', - &'xi- ','xi0 ','omega- ','pi0 ', - &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ', - &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ', - &'k+ ','k- ','ks0 ','kl0 '/ - DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, - &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222, - &3312,3322,3334,111,110,990,6*22,321,-321,310,130/ - -C...Store initial energy. Default frame. - VINT(290)=WIN - MINT(111)=0 - -C...Special user process initialization; convert to normal input. - IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN - MINT(111)=11 - CALL PYNAME(IDBMUP(1),CHNAME) - CHBEAM=CHNAME(1:12) - CALL PYNAME(IDBMUP(2),CHNAME) - CHTARG=CHNAME(1:12) - ENDIF - -C...Convert character variables to lowercase and find their length. - CHCOM(1)=CHFRAM - CHCOM(2)=CHBEAM - CHCOM(3)=CHTARG - DO 130 I=1,3 - LEN(I)=12 - DO 110 LL=12,1,-1 - IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1 - DO 100 LA=1,26 - IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)= - & CHALP(1)(LA:LA) - 100 CONTINUE - 110 CONTINUE - CHIDNT(I)=CHCOM(I) - -C...Fix up bar, underscore and charge in particle name (if needed). - DO 120 LL=1,10 - IF(CHIDNT(I)(LL:LL).EQ.'~') THEN - CHTEMP=CHIDNT(I) - CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' ' - ENDIF - 120 CONTINUE - IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN - CHTEMP=CHIDNT(I) - CHIDNT(I)='nu_'//CHTEMP(3:7) - ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN - CHIDNT(I)(1:3)='n0 ' - ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN - CHIDNT(I)(1:5)='nbar0' - ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN - CHIDNT(I)(1:3)='p+ ' - ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR. - & CHIDNT(I)(1:2).EQ.'p-') THEN - CHIDNT(I)(1:5)='pbar-' - ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN - CHIDNT(I)(7:7)='0' - ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN - CHIDNT(I)(1:7)='reggeon' - ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN - CHIDNT(I)(1:7)='pomeron' - ENDIF - 130 CONTINUE - -C...Identify free initialization. - IF(CHCOM(1)(1:2).EQ.'no') THEN - MINT(65)=1 - RETURN - ENDIF - -C...Identify incoming beam and target particles. - DO 160 I=1,2 - DO 140 J=1,39 - IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J) - 140 CONTINUE - PM(I)=PYMASS(MINT(10+I)) - VINT(2+I)=PM(I) - MINT(140+I)=0 - IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN - CHTEMP=CHIDNT(I+1)(7:12)//' ' - DO 150 J=1,12 - IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J) - 150 CONTINUE - PM(I)=PYMASS(MINT(140+I)) - VINT(302+I)=PM(I) - ENDIF - 160 CONTINUE - IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2)) - IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3)) - IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) STOP - -C...Identify choice of frame and input energies. - CHINIT=' ' - -C...Events defined in the CM frame. - IF(CHCOM(1)(1:2).EQ.'cm') THEN - MINT(111)=1 - S=WIN**2 - IF(MSTP(122).GE.1) THEN - IF(CHCOM(2)(1:1).NE.'e') THEN - LOFFS=(31-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' collider'//' ' - ELSE - LOFFS=(30-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' collider'//' ' - ENDIF - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5300) WIN - ENDIF - -C...Events defined in fixed target frame. - ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN - MINT(111)=2 - S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2) - IF(MSTP(122).GE.1) THEN - LOFFS=(29-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' fixed target'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5400) WIN - WRITE(MSTU(11),5500) SQRT(S) - ENDIF - -C...Frame defined by user three-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN - MINT(111)=3 - P(1,5)=PM(1) - P(2,5)=PM(2) - P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by user four-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN - MINT(111)=4 - PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 - P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) - PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 - P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by user five-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN - MINT(111)=5 - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by HEPRUP common block. - ELSEIF(MINT(111).EQ.11) THEN - S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))- - & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Unknown frame. Error for too low CM energy. - ELSE - WRITE(MSTU(11),5800) CHFRAM(1:LEN(1)) - STOP - ENDIF - IF(S.LT.PARP(2)**2) THEN - WRITE(MSTU(11),5900) SQRT(S) - STOP - ENDIF - -C...Formats for initialization and error information. - 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/ - &1X,'Execution stopped!') - 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/ - &1X,'Execution stopped!') - 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I') - 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy', - &19X,'I'/1X,'I',76X,'I'/1X,78('=')) - 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I') - 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X, - &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('=')) - 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X, - &'pz (GeV/c)',6X,'E (GeV)',9X,'I') - 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I') - 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/ - &1X,'Execution stopped!') - 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ', - &'generation.'/1X,'Execution stopped!') - 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X, - &'GeV beam energies',13X,'I') - - RETURN - END - -C********************************************************************* - -C...PYINDF -C...Handles the fragmentation of a jet system (or a single -C...jet) according to independent fragmentation models. - - SUBROUTINE PYINDF(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), - &KFLO(2),PXO(2),PYO(2),WO(2) - -C.. MOPS error message - IF(MSTJ(12).GT.3) CALL PYERRM(9,'(PYINDF:) MSTJ(12)>3 options'// - &' are not treated as expected in independent fragmentation') - -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)=0D0 - 100 CONTINUE - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL PYERRM(12,'(PYINDF:) 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=PYCOMP(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 PYERRM(12,'(PYINDF:) 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 PYROBO(NSAV+1,NSAV+NJET,0D0,0D0,-DPS(1)/DPS(4), - & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) - ENDIF - PECM=0D0 - 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 PYERRM(14,'(PYINDF:) 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 PYPTDI(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(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - CALL PYPTDI(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(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - KFLO(2)=-KFLO(1) - CALL PYPTDI(0,PXO(1),PYO(1)) - PXO(2)=-PXO(1) - PYO(2)=-PYO(1) - WO(1)=WF*PYR(0)**(1D0/3D0) - 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 PYERRM(11,'(PYINDF:) no more memory left in PYJETS') - 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 PYKFDI(KFL1,0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 180 - IF(IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.IABS(KFL2).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 200 - ENDIF - -C...Find hadron mass. Generate four-momentum. - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(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 PYZDIS(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.5D0*(Z*W-PR/MAX(1D-4,Z*W)) - P(I,4)=0.5D0*(Z*W+PR/MAX(1D-4,Z*W)) - IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. - & P(I,3).LE.0.001D0) THEN - IF(W.GE.P(I,5)+0.5D0*PARJ(32)) GOTO 180 - P(I,3)=0.0001D0 - P(I,4)=SQRT(PR) - Z=P(I,4)/W - ENDIF - -C...Remaining flavour and momentum. - KFL1=-KFL2 - PX1=-PX2 - PY1=-PY2 - W=(1D0-Z)*W - DO 210 J=1,5 - V(I,J)=0D0 - 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.0D0) 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.1D0*PARJ(32) - IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 - -C...Rotate jet to new direction. - THE=PYANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) - PHI=PYANGL(P(IP1,1),P(IP1,2)) - MSTU(33)=1 - CALL PYROBO(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)))*PYR(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((2D0+PARJ(2))*PYR(0)) - IF(NFET.EQ.0) KFLF(2)=-KFLF(1) - IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2D0+PARJ(2))*PYR(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.(1D0+3D0*PARJ(4))*PYR(0).GT.1D0) - & KFLFC=KFLFC+ISIGN(2,KFLFC) - ELSE - KFLFC=KFLF(1) - ENDIF - CALL PYKFDI(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(PYR(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)=PYMASS(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)=0D0 - 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=0D0 - 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+1D0 - 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=1D0 - 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)=0D0 - 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=0D0 - DO 420 I=N+1,N+NJET - IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8D0*P(I,5)+0.2D0)) - 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)+(1D0/(P(IR2,5)*PSS)-1D0)* - & 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=0D0 - PES=0D0 - PQS=0D0 - 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=0D0 - PQS=0D0 - 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.2D-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)=0D0 - 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 PYROBO(NSAV+1,N,0D0,0D0,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********************************************************************* - -C...PYINIT -C...Initializes the generation procedure; finds maxima of the -C...differential cross-sections to be used for weighting. - - SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT5/ -C...Local arrays and character variables. - DIMENSION ALAMIN(20),NFIN(20) - CHARACTER*(*) FRAME,BEAM,TARGET - CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHLH(2)*6 - -C...Interface to PDFLIB. - COMMON/W50512/QCDL4,QCDL5 - SAVE /W50512/ - DOUBLE PRECISION VALUE(20),QCDL4,QCDL5 - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Data:Lambda and n_f values for parton distributions.. - DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2322D0,0.248D0,0.248D0, - &0.192D0,0.326D0,2*0.2D0,0.2D0,0.2D0,0.29D0,0.2D0,0.4D0,5*0.2D0/, - &NFIN/20*4/ - DATA CHLH/'lepton','hadron'/ - -C...Reset MINT and VINT arrays. Write headers. - MSTI(53)=0 - DO 100 J=1,400 - MINT(J)=0 - VINT(J)=0D0 - 100 CONTINUE - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) - -C...Reset processes that should not be on. - MSUB(96)=0 - MSUB(97)=0 - -C...Call user process initialization routine. - IF(FRAME(1:1).EQ.'u'.OR.FRAME(1:1).EQ.'U') THEN - MSEL=0 - CALL UPINIT - MSEL=0 - ENDIF - -C...Maximum 4 generations; set maximum number of allowed flavours. - MSTP(1)=MIN(4,MSTP(1)) - MSTU(114)=MIN(MSTU(114),2*MSTP(1)) - MSTP(58)=MIN(MSTP(58),2*MSTP(1)) - -C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton. - DO 120 I=-20,20 - VINT(180+I)=0D0 - IA=IABS(I) - IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN - DO 110 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110 - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)= - & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2) - 110 CONTINUE - ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN - VINT(180+I)=1D0 - ENDIF - 120 CONTINUE - -C...Initialize parton distributions: PDFLIB. - IF(MSTP(52).EQ.2) THEN - PARM(1)='NPTYPE' - VALUE(1)=1 - PARM(2)='NGROUP' - VALUE(2)=MSTP(51)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(51),1000) - PARM(4)='TMAS' - VALUE(4)=PMAS(6,1) - CALL PDFSET(PARM,VALUE) - MINT(93)=1000000+MSTP(51) - ENDIF - -C...Choose Lambda value to use in alpha-strong. - MSTU(111)=MSTP(2) - IF(MSTP(3).GE.2) THEN - ALAM=0.2D0 - NF=4 - IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN - ALAM=ALAMIN(MSTP(51)) - NF=NFIN(MSTP(51)) - ELSEIF(MSTP(52).EQ.2) THEN - ALAM=QCDL4 - NF=4 - ENDIF - PARP(1)=ALAM - PARP(61)=ALAM - PARP(72)=ALAM - PARU(112)=ALAM - MSTU(112)=NF - IF(MSTP(3).EQ.3) PARJ(81)=ALAM - ENDIF - -C...Initialize the SUSY generation: couplings, masses, -C...decay modes, branching ratios, and so on. - CALL PYMSIN -C...Initialize widths and partial widths for resonances. - CALL PYINRE -C...Set Z0 mass and width for e+e- routines. - PARJ(123)=PMAS(23,1) - PARJ(124)=PMAS(23,2) - -C...Identify beam and target particles and frame of process. - CHFRAM=FRAME//' ' - CHBEAM=BEAM//' ' - CHTARG=TARGET//' ' - CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) - IF(MINT(65).EQ.1) GOTO 170 - -C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives. -C...For e-gamma allow 2 alternatives. - MINT(121)=1 - IF(MSTP(14).EQ.10.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=6 - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).EQ.11.OR.IABS(MINT(12)).EQ.11)) MINT(121)=2 - ELSEIF(MSTP(14).EQ.20.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=9 - ELSEIF(MSTP(14).EQ.25.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=2 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=4 - ELSEIF(MSTP(14).EQ.30.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=4 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=13 - ENDIF - MINT(123)=MSTP(14) - IF((MSTP(14).EQ.10.OR.MSTP(14).EQ.20.OR.MSTP(14).EQ.25.OR. - &MSTP(14).EQ.30).AND.MSEL.NE.1.AND.MSEL.NE.2) MINT(123)=0 - IF(MSTP(14).GE.11.AND.MSTP(14).LE.19) THEN - IF(MSTP(14).EQ.11) MINT(123)=0 - IF(MSTP(14).EQ.12.OR.MSTP(14).EQ.14) MINT(123)=5 - IF(MSTP(14).EQ.13.OR.MSTP(14).EQ.17) MINT(123)=6 - IF(MSTP(14).EQ.15) MINT(123)=2 - IF(MSTP(14).EQ.16.OR.MSTP(14).EQ.18) MINT(123)=7 - IF(MSTP(14).EQ.19) MINT(123)=3 - ELSEIF(MSTP(14).GE.21.AND.MSTP(14).LE.24) THEN - IF(MSTP(14).EQ.21) MINT(123)=0 - IF(MSTP(14).EQ.22.OR.MSTP(14).EQ.23) MINT(123)=4 - IF(MSTP(14).EQ.24) MINT(123)=1 - ELSEIF(MSTP(14).GE.26.AND.MSTP(14).LE.29) THEN - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28) MINT(123)=8 - IF(MSTP(14).EQ.27.OR.MSTP(14).EQ.29) MINT(123)=9 - ENDIF - -C...Set up kinematics of process. - CALL PYINKI(0) - -C...Set up kinematics for photons inside leptons. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(1,WTGAGA) - -C...Precalculate flavour selection weights. - CALL PYKFIN - -C...Loop over gamma-p or gamma-gamma alternatives. - CKIN3=CKIN(3) - MSAV48=0 - DO 160 IGA=1,MINT(121) - CKIN(3)=CKIN3 - MINT(122)=IGA - -C...Select partonic subprocesses to be included in the simulation. - CALL PYINPR - MINT(101)=1 - MINT(102)=1 - MINT(103)=MINT(11) - MINT(104)=MINT(12) - -C...Count number of subprocesses on. - MINT(48)=0 - DO 130 ISUB=1,500 - IF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. - & MSUB(ISUB).EQ.1.AND.MINT(121).GT.1) THEN - MSUB(ISUB)=0 - ELSEIF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. - & MSUB(ISUB).EQ.1) THEN - WRITE(MSTU(11),5200) ISUB,CHLH(MINT(41)),CHLH(MINT(42)) - STOP - ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN - WRITE(MSTU(11),5300) ISUB - STOP - ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN - WRITE(MSTU(11),5400) ISUB - STOP - ELSEIF(MSUB(ISUB).EQ.1) THEN - MINT(48)=MINT(48)+1 - ENDIF - 130 CONTINUE - -C...Stop or raise warning flag if no subprocesses on. - IF(MINT(121).EQ.1.AND.MINT(48).EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5500) - STOP - ELSE - WRITE(MSTU(11),5700) - MSTI(53)=1 - ENDIF - ENDIF - MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) - MSAV48=MSAV48+MINT(48) - -C...Reset variables for cross-section calculation. - DO 150 I=0,500 - DO 140 J=1,3 - NGEN(I,J)=0 - XSEC(I,J)=0D0 - 140 CONTINUE - 150 CONTINUE - -C...Find parametrized total cross-sections. - CALL PYXTOT - VINT(318)=VINT(317) - -C...Maxima of differential cross-sections. - IF(MSTP(121).LE.1) CALL PYMAXI - -C...Initialize possibility of pileup events. - IF(MINT(121).GT.1) MSTP(131)=0 - IF(MSTP(131).NE.0) CALL PYPILE(1) - -C...Initialize multiple interactions with variable impact parameter. - IF(MINT(50).EQ.1) THEN - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - IF(MSTP(81).EQ.0.AND.CKIN(3).GT.PTMN) MSTP(82)=MIN(1,MSTP(82)) - IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) - & CALL PYMULT(1) - ENDIF - -C...Save results for gamma-p and gamma-gamma alternatives. - IF(MINT(121).GT.1) CALL PYSAVE(1,IGA) - 160 CONTINUE - -C...Initialization finished. - IF(MSAV48.EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5500) - STOP - ELSE - WRITE(MSTU(11),5700) - MSTI(53)=1 - ENDIF - ENDIF - 170 IF(MSTP(122).GE.1) WRITE(MSTU(11),5600) - -C...Formats for initialization information. - 5100 FORMAT('1',18('*'),1X,'PYINIT: initialization of PYTHIA ', - &'routines',1X,17('*')) - 5200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6, - &'-',A6,' interactions.'/1X,'Execution stopped!') - 5300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/ - &1X,'Execution stopped!') - 5400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/ - &1X,'Execution stopped!') - 5500 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution stopped.') - 5600 FORMAT(/1X,22('*'),1X,'PYINIT: initialization completed',1X, - &22('*')) - 5700 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution will stop if you try to generate events.') - - RETURN - END - -C********************************************************************* - -C...PYINKI -C...Sets up kinematics, including rotations and boosts to/from CM frame. - - SUBROUTINE PYINKI(MODKI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ - -C...Set initial flavour state. - N=2 - DO 100 I=1,2 - K(I,1)=1 - K(I,2)=MINT(10+I) - IF(MINT(140+I).NE.0) K(I,2)=MINT(140+I) - 100 CONTINUE - -C...Reset boost. Do kinematics for various cases. - DO 110 J=6,10 - VINT(J)=0D0 - 110 CONTINUE - -C...Set up kinematics for events defined in CM frame. - IF(MINT(111).EQ.1) THEN - WIN=VINT(290) - IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) - S=WIN**2 - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2D0*P(1,5)*P(2,5))**2)/ - & (4D0*S)) - P(2,3)=-P(1,3) - P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,3)**2+P(2,5)**2) - -C...Set up kinematics for fixed target events. - ELSEIF(MINT(111).EQ.2) THEN - WIN=VINT(290) - IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=WIN - P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) - P(2,3)=0D0 - P(2,4)=P(2,5) - S=P(1,5)**2+P(2,5)**2+2D0*P(2,4)*P(1,4) - VINT(10)=P(1,3)/(P(1,4)+P(2,4)) - CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) - -C...Set up kinematics for events in user-defined frame. - ELSEIF(MINT(111).EQ.3) THEN - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) - DO 120 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 120 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=P(1,5)**2+P(2,5)**2+2D0*(P(1,4)*P(2,4)-P(1,3)*P(2,3)) - -C...Set up kinematics for events with user-defined four-vectors. - ELSEIF(MINT(111).EQ.4) THEN - PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 - P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) - PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 - P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) - DO 130 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 130 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=(P(1,4)+P(2,4))**2 - -C...Set up kinematics for events with user-defined five-vectors. - ELSEIF(MINT(111).EQ.5) THEN - DO 140 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 140 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=(P(1,4)+P(2,4))**2 - -C...Set up kinematics for events with external user processes. - ELSEIF(MINT(111).EQ.11) THEN - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=SQRT(MAX(0D0,EBMUP(1)**2-P(1,5)**2)) - P(2,3)=-SQRT(MAX(0D0,EBMUP(2)**2-P(2,5)**2)) - P(1,4)=EBMUP(1) - P(2,4)=EBMUP(2) - VINT(10)=(P(1,3)+P(2,3))/(P(1,4)+P(2,4)) - CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) - S=(P(1,4)+P(2,4))**2 - ENDIF - -C...Return or error for too low CM energy. - IF(MODKI.EQ.1.AND.S.LT.PARP(2)**2) THEN - IF(MSTP(172).LE.1) THEN - CALL PYERRM(23, - & '(PYINKI:) too low invariant mass in this event') - ELSE - MSTI(61)=1 - RETURN - ENDIF - ENDIF - -C...Save information on incoming particles. - VINT(1)=SQRT(S) - VINT(2)=S - IF(MINT(111).GE.4) THEN - IF(MINT(141).EQ.0) THEN - VINT(3)=P(1,5) - IF(MINT(11).EQ.22.AND.P(1,5).LT.0) VINT(307)=P(1,5)**2 - ELSE - VINT(303)=P(1,5) - ENDIF - IF(MINT(142).EQ.0) THEN - VINT(4)=P(2,5) - IF(MINT(12).EQ.22.AND.P(2,5).LT.0) VINT(308)=P(2,5)**2 - ELSE - VINT(304)=P(2,5) - ENDIF - ENDIF - VINT(5)=P(1,3) - IF(MODKI.EQ.0) VINT(289)=S - DO 150 J=1,5 - V(1,J)=0D0 - V(2,J)=0D0 - VINT(290+J)=P(1,J) - VINT(295+J)=P(2,J) - 150 CONTINUE - -C...Store pT cut-off and related constants to be used in generation. - IF(MODKI.EQ.0) VINT(285)=CKIN(3) - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/S - VINT(154)=PTMN - - RETURN - END - -C********************************************************************* - -C...PYINOM -C...Finds the mass eigenstates and mixing matrices for neutralinos -C...and charginos. - - SUBROUTINE PYINOM - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION XMW,XMZ,XM(4) - DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),AI(4,4) - DOUBLE PRECISION WI(4),FV1(4),FV2(4),FV3(4) - DOUBLE PRECISION COSW,SINW - DOUBLE PRECISION XMU - DOUBLE PRECISION TANB,COSB,SINB - DOUBLE PRECISION XM1,XM2,XM3,BETA - DOUBLE PRECISION Q2,AEM,A1,A2,AQ,RM1,RM2 - DOUBLE PRECISION ARG,X0,X1,AX0,AX1,AT,BT - DOUBLE PRECISION Y0,Y1,AMGX0,AM1X0,AMGX1,AM1X1 - DOUBLE PRECISION ARGX0,AR1X0,ARGX1,AR1X1 - DOUBLE PRECISION PYALPS,PYALEM - DOUBLE PRECISION PYRNM3 - COMPLEX*16 CAR(4,4),CAI(4,4),CA1,CA2 - INTEGER IERR,INDEX(4),I,J,K,IOPT,ILR,KFNCHI(4) - DATA KFNCHI/1000022,1000023,1000025,1000035/ - - IOPT=IMSS(2) - IF(IMSS(1).EQ.2) THEN - IOPT=1 - ENDIF -C...M1, M2, AND M3 ARE INDEPENDENT - IF(IOPT.EQ.0) THEN - XM1=RMSS(1) - XM2=RMSS(2) - XM3=RMSS(3) - ELSEIF(IOPT.GE.1) THEN - Q2=PMAS(23,1)**2 - AEM=PYALEM(Q2) - A2=AEM/PARU(102) - A1=AEM/(1D0-PARU(102)) - XM1=RMSS(1) - XM2=RMSS(2) - IF(IMSS(1).EQ.2) XM1=RMSS(1)/RMSS(20)*A1*5D0/3D0 - IF(IOPT.EQ.1) THEN - XM2=XM1*A2/A1*3D0/5D0 - RMSS(2)=XM2 - ELSEIF(IOPT.EQ.3) THEN - XM1=XM2*5D0/3D0*A1/A2 - RMSS(1)=XM1 - ENDIF - XM3=PYRNM3(XM2/A2) - RMSS(3)=XM3 - IF(XM3.LE.0D0) THEN - WRITE(MSTU(11),*) ' ERROR WITH M3 = ',XM3 - STOP - ENDIF - ENDIF - -C...GLUINO MASS - IF(IMSS(3).EQ.1) THEN - PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3) - ELSE - AQ=0D0 - DO 110 I=1,4 - DO 100 ILR=1,2 - RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 - AQ=AQ+0.5D0*((2D0-RM1)*(RM1*LOG(RM1)-1D0) - & +(1D0-RM1)**2*LOG(ABS(1D0-RM1))) - 100 CONTINUE - 110 CONTINUE - - DO 130 I=5,6 - DO 120 ILR=1,2 - RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 - RM2=PMAS(I,1)**2/XM3**2 - ARG=(RM1-RM2-1D0)**2-4D0*RM2**2 - IF(ARG.GE.0D0) THEN - X0=0.5D0*(1D0+RM2-RM1-SQRT(ARG)) - AX0=ABS(X0) - X1=0.5D0*(1D0+RM2-RM1+SQRT(ARG)) - AX1=ABS(X1) - IF(X0.EQ.1D0) THEN - AT=-1D0 - BT=0.25D0 - ELSEIF(X0.EQ.0D0) THEN - AT=0D0 - BT=-0.25D0 - ELSE - AT=0.5D0*LOG(ABS(1D0-X0))*(1D0-X0**2)+ - & 0.5D0*X0**2*LOG(AX0) - BT=(-1D0-2D0*X0)/4D0 - ENDIF - IF(X1.EQ.1D0) THEN - AT=-1D0+AT - BT=0.25D0+BT - ELSEIF(X1.EQ.0D0) THEN - AT=0D0+AT - BT=-0.25D0+BT - ELSE - AT=0.5D0*LOG(ABS(1D0-X1))*(1D0-X1**2)+0.5D0* - & X1**2*LOG(AX1)+AT - BT=(-1D0-2D0*X1)/4D0+BT - ENDIF - AQ=AQ+AT+BT - ELSE - X0=0.5D0*(1D0+RM2-RM1) - Y0=-0.5D0*SQRT(-ARG) - AMGX0=SQRT(X0**2+Y0**2) - AM1X0=SQRT((1D0-X0)**2+Y0**2) - ARGX0=ATAN2(-X0,-Y0) - AR1X0=ATAN2(1D0-X0,Y0) - X1=X0 - Y1=-Y0 - AMGX1=AMGX0 - AM1X1=AM1X0 - ARGX1=ATAN2(-X1,-Y1) - AR1X1=ATAN2(1D0-X1,Y1) - AT=0.5D0*LOG(AM1X0)*(1D0-X0**2+3D0*Y0**2) - & +0.5D0*(X0**2-Y0**2)*LOG(AMGX0) - BT=(-1D0-2D0*X0)/4D0+X0*Y0*( AR1X0-ARGX0 ) - AT=AT+0.5D0*LOG(AM1X1)*(1D0-X1**2+3D0*Y1**2) - & +0.5D0*(X1**2-Y1**2)*LOG(AMGX1) - BT=BT+(-1D0-2D0*X1)/4D0+X1*Y1*( AR1X1-ARGX1 ) - AQ=AQ+AT+BT - ENDIF - 120 CONTINUE - 130 CONTINUE - PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3)*(1D0+PYALPS(XM3**2) - & /(2D0*PARU(2))*(15D0+AQ)) - ENDIF - -C...NEUTRALINO MASSES - DO 150 I=1,4 - DO 140 J=1,4 - AI(I,J)=0D0 - 140 CONTINUE - 150 CONTINUE - XMZ=PMAS(23,1) - XMW=PMAS(24,1) - XMU=RMSS(4) - SINW=SQRT(PARU(102)) - COSW=SQRT(1D0-PARU(102)) - TANB=RMSS(5) - BETA=ATAN(TANB) - COSB=COS(BETA) - SINB=TANB*COSB - -C... Definitions: -C... psi^0 =(-i bino^0, -i wino^0, h_d^0(=H_1^0), h_u^0(=H_2^0)) -C... => L_neutralino = -1/2*(psi^0)^T * [AR] * psi^0 + h.c. - AR(1,1) = XM1*COS(RMSS(30)) - AI(1,1) = XM1*SIN(RMSS(30)) - AR(2,2) = XM2*COS(RMSS(31)) - AI(2,2) = XM2*SIN(RMSS(31)) - AR(3,3) = 0D0 - AR(4,4) = 0D0 - AR(1,2) = 0D0 - AR(2,1) = 0D0 - AR(1,3) = -XMZ*SINW*COSB - AR(3,1) = AR(1,3) - AR(1,4) = XMZ*SINW*SINB - AR(4,1) = AR(1,4) - AR(2,3) = XMZ*COSW*COSB - AR(3,2) = AR(2,3) - AR(2,4) = -XMZ*COSW*SINB - AR(4,2) = AR(2,4) - AR(3,4) = -XMU*COS(RMSS(33)) - AI(3,4) = -XMU*SIN(RMSS(33)) - AR(4,3) = -XMU*COS(RMSS(33)) - AI(4,3) = -XMU*SIN(RMSS(33)) -C CALL PYEIG4(AR,WR,ZR) - CALL PYEICG(4,4,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - DO 160 I=1,4 - INDEX(I)=I - XM(I)=ABS(WR(I)) - 160 CONTINUE - DO 180 I=2,4 - K=I - DO 170 J=I-1,1,-1 - IF(XM(K).LT.XM(J)) THEN - ITMP=INDEX(J) - XTMP=XM(J) - INDEX(J)=INDEX(K) - XM(J)=XM(K) - INDEX(K)=ITMP - XM(K)=XTMP - K=K-1 - ELSE - GOTO 180 - ENDIF - 170 CONTINUE - 180 CONTINUE - - - DO 210 I=1,4 - K=INDEX(I) - SMZ(I)=WR(K) - PMAS(PYCOMP(KFNCHI(I)),1)=ABS(SMZ(I)) - S=0D0 - DO 190 J=1,4 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 190 CONTINUE - DO 200 J=1,4 - ZMIX(I,J)=ZR(J,K)/SQRT(S) - ZMIXI(I,J)=ZI(J,K)/SQRT(S) - IF(ABS(ZMIX(I,J)).LT.1D-6) ZMIX(I,J)=0D0 - IF(ABS(ZMIXI(I,J)).LT.1D-6) ZMIXI(I,J)=0D0 - 200 CONTINUE - 210 CONTINUE - -C...CHARGINO MASSES -C.....Find eigenvectors of X X^* - AI(1,1) = 0D0 - AI(2,2) = 0D0 - AR(1,1) = XM2**2+2D0*XMW**2*SINB**2 - AR(2,2) = XMU**2+2D0*XMW**2*COSB**2 - AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ - &XMU*COS(RMSS(33))*SINB) - AI(1,2) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*COSB- - &XMU*SIN(RMSS(33))*SINB) - AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ - &XMU*COS(RMSS(33))*SINB) - AI(2,1) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*COSB+ - &XMU*SIN(RMSS(33))*SINB) - CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - INDEX(1)=1 - INDEX(2)=2 - IF(WR(2).LT.WR(1)) THEN - INDEX(1)=2 - INDEX(2)=1 - ENDIF - - DO 240 I=1,2 - K=INDEX(I) - SMW(I)=SQRT(WR(K)) - S=0D0 - DO 220 J=1,2 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 220 CONTINUE - DO 230 J=1,2 - UMIX(I,J)=ZR(J,K)/SQRT(S) - UMIXI(I,J)=-ZI(J,K)/SQRT(S) - IF(ABS(UMIX(I,J)).LT.1D-6) UMIX(I,J)=0D0 - IF(ABS(UMIXI(I,J)).LT.1D-6) UMIXI(I,J)=0D0 - 230 CONTINUE - 240 CONTINUE - IF(ABS(SMW(1)).LT.ABS(SMZ(1))) THEN - SMW(1)=SIGN(ABS(SMZ(1))+2D0*PMAS(PYCOMP(111),1),SMW(1)) - ENDIF - PMAS(PYCOMP(KSUSY1+24),1)=SMW(1) - PMAS(PYCOMP(KSUSY1+37),1)=SMW(2) - -C.....Find eigenvectors of X^* X - AI(1,1) = 0D0 - AI(2,2) = 0D0 - AR(1,1) = XM2**2+2D0*XMW**2*COSB**2 - AR(2,2) = XMU**2+2D0*XMW**2*SINB**2 - AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ - &XMU*COS(RMSS(33))*COSB) - AI(1,2) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*SINB+ - &XMU*SIN(RMSS(33))*COSB) - AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ - &XMU*COS(RMSS(33))*COSB) - AI(2,1) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*SINB- - &XMU*SIN(RMSS(33))*COSB) - CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - INDEX(1)=1 - INDEX(2)=2 - IF(WR(2).LT.WR(1)) THEN - INDEX(1)=2 - INDEX(2)=1 - ENDIF - - DO 270 I=1,2 - K=INDEX(I) - S=0D0 - DO 250 J=1,2 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 250 CONTINUE - DO 260 J=1,2 - VMIX(I,J)=ZR(J,K)/SQRT(S) - VMIXI(I,J)=-ZI(J,K)/SQRT(S) - IF(ABS(VMIX(I,J)).LT.1D-6) VMIX(I,J)=0D0 - IF(ABS(VMIXI(I,J)).LT.1D-6) VMIXI(I,J)=0D0 - 260 CONTINUE - 270 CONTINUE - - - RETURN - END - -C********************************************************************* - -C...PYINPR -C...Selects partonic subprocesses to be included in the simulation. - - SUBROUTINE PYINPR - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks and character variables. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT6/ - CHARACTER CHIPR*10 - -C...Reset processes to be included. - IF(MSEL.NE.0) THEN - DO 100 I=1,500 - MSUB(I)=0 - 100 CONTINUE - ENDIF - -C...Set running pTmin scale. - IF(MSTP(82).LE.1) THEN - PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - -C...Begin by assuming incoming photon to enter subprocess. - IF(MINT(11).EQ.22) MINT(15)=22 - IF(MINT(12).EQ.22) MINT(16)=22 - -C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous. - IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN - MSUB(10)=1 - MINT(123)=MINT(122)+1 - -C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30 -C...allow mixture. -C...Here also set a few parameters otherwise normally not touched. - ELSEIF(MINT(121).GT.1) THEN - -C...Parton distributions dampened at small Q2; go to low energies, -C...alpha_s <1; no minimum pT cut-off a priori. - IF(MSTP(18).EQ.2) THEN - MSTP(57)=3 - PARP(2)=2D0 - PARU(115)=1D0 - CKIN(5)=0.2D0 - CKIN(6)=0.2D0 - ENDIF - -C...Define pT cut-off parameters and whether run involves low-pT. - PTMVMD=PTMRUN - VINT(154)=PTMVMD - PTMDIR=PTMVMD - IF(MSTP(18).EQ.2) PTMDIR=PARP(15) - PTMANO=PTMVMD - IF(MSTP(15).EQ.5) PTMANO=0.60D0+ - & 0.125D0*LOG(1D0+0.10D0*VINT(1))**2 - IPTL=1 - IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0 - IF(MSEL.EQ.2) IPTL=1 - -C...Set up for p/gamma * gamma; real or virtual photons. - IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND. - & MSTP(14).EQ.30)) THEN - -C...Set up for p/VMD * VMD. - IF(MINT(122).EQ.1) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for p/VMD * direct gamma. - ELSEIF(MINT(122).EQ.2) THEN - MINT(123)=0 - IF(MINT(121).EQ.6) MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for p/VMD * anomalous gamma. - ELSEIF(MINT(122).EQ.3) THEN - MINT(123)=3 - IF(MINT(121).EQ.6) MINT(123)=7 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for DIS * p. - ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR. - & IABS(MINT(12)).GT.100)) THEN - MINT(123)=8 - IF(IPTL.EQ.1) MSUB(99)=1 - -C...Set up for direct * direct gamma (switch off leptons). - ELSEIF(MINT(122).EQ.4) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 110 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * anomalous gamma. - ELSEIF(MINT(122).EQ.5) THEN - MINT(123)=6 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMANO - -C...Set up for anomalous * anomalous gamma. - ELSEIF(MINT(122).EQ.6) THEN - MINT(123)=3 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom. - ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - -C...Set up for direct * direct gamma (switch off leptons). - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 120 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * VMD and VMD * direct gamma. - ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN - MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * anomalous and anomalous * direct gamma. - ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN - MINT(123)=6 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMANO - -C...Set up for VMD*VMD. - ELSEIF(MINT(122).EQ.5) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for VMD * anomalous and anomalous * VMD gamma. - ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN - MINT(123)=7 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for anomalous * anomalous gamma. - ELSEIF(MINT(122).EQ.9) THEN - MINT(123)=3 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for DIS * VMD and VMD * DIS gamma. - ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN - MINT(123)=8 - IF(IPTL.EQ.1) MSUB(99)=1 - -C...Set up for DIS * anomalous and anomalous * DIS gamma. - ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN - MINT(123)=9 - IF(IPTL.EQ.1) MSUB(99)=1 - ENDIF - -C...Set up for gamma* * p; virtual photons = dir, res. - ELSEIF(MINT(121).EQ.2) THEN - -C...Set up for direct * p. - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for resolved * p. - ELSEIF(MINT(122).EQ.2) THEN - MINT(123)=1 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...Set up for gamma* * gamma*; virtual photons = dir, res. - ELSEIF(MINT(121).EQ.4) THEN - -C...Set up for direct * direct gamma (switch off leptons). - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 130 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * resolved and resolved * direct gamma. - ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN - MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for resolved * resolved gamma. - ELSEIF(MINT(122).EQ.4) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...End of special set up for gamma-p and gamma-gamma. - ENDIF - CKIN(1)=2D0*CKIN(3) - ENDIF - -C...Flavour information for individual beams. - DO 140 I=1,2 - MINT(40+I)=1 - IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2 - IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2 - MINT(44+I)=MINT(40+I) - IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR. - & IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3 - 140 CONTINUE - -C...If two real gammas, whereof one direct, pick the first. -C...For two virtual photons, keep requested order. - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR. - & MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR. - & MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN - MINT(42)=1 - MINT(46)=1 - ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2 - & .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4 - & .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN - MINT(42)=1 - MINT(46)=1 - ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN - MINT(42)=1 - MINT(46)=1 - ENDIF - ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN - IF(MINT(11).EQ.22) THEN - MINT(41)=1 - MINT(45)=1 - ELSE - MINT(42)=1 - MINT(46)=1 - ENDIF - ENDIF - IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26, - & '(PYINPR:) unallowed MSTP(14) code for single photon') - ENDIF - -C...Flavour information on combination of incoming particles. - MINT(43)=2*MINT(41)+MINT(42)-2 - MINT(44)=MINT(43) - IF(MINT(123).LE.0) THEN - IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2 - IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1 - ELSEIF(MINT(123).LE.3) THEN - IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2 - IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1 - ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - MINT(43)=4 - MINT(44)=1 - ENDIF - MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2 - IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5 - IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6 - IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7 - MINT(50)=0 - IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) MINT(50)=1 - MINT(107)=0 - MINT(108)=0 - IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12) - & MINT(107)=2 - IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13) - & MINT(107)=3 - IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4 - IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR. - & MINT(122).EQ.10) MINT(108)=2 - IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR. - & MINT(122).EQ.11) MINT(108)=3 - IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4 - ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN - IF(MINT(122).GE.3) MINT(107)=1 - IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1 - ELSEIF(MINT(121).EQ.2) THEN - IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1 - IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1 - ELSE - IF(MINT(11).EQ.22) THEN - MINT(107)=MINT(123) - IF(MINT(123).GE.4) MINT(107)=0 - IF(MINT(123).EQ.7) MINT(107)=2 - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4 - IF(MSTP(14).EQ.28) MINT(107)=2 - IF(MSTP(14).EQ.29) MINT(107)=3 - IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) - & MINT(107)=4 - ENDIF - IF(MINT(12).EQ.22) THEN - MINT(108)=MINT(123) - IF(MINT(123).GE.4) MINT(108)=MINT(123)-3 - IF(MINT(123).EQ.7) MINT(108)=3 - IF(MSTP(14).EQ.26) MINT(108)=2 - IF(MSTP(14).EQ.27) MINT(108)=3 - IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4 - IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) - & MINT(108)=4 - ENDIF - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR. - & MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN - MINTTP=MINT(107) - MINT(107)=MINT(108) - MINT(108)=MINTTP - ENDIF - ENDIF - IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 - IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 - -C...Select default processes according to incoming beams -C...(already done for gamma-p and gamma-gamma with -C...MSTP(14) = 10, 20, 25 or 30). - IF(MINT(121).GT.1) THEN - ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN - - IF(MINT(43).EQ.1) THEN -C...Lepton + lepton -> gamma/Z0 or W. - IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1 - IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1 - - ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND. - & (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN -C...Unresolved photon + lepton: Compton scattering. - MSUB(133)=1 - MSUB(134)=1 - - ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22 - & .OR.MINT(12).EQ.22)) THEN -C...DIS as pure gamma* + f -> f process. - MSUB(99)=1 - - ELSEIF(MINT(43).LE.3) THEN -C...Lepton + hadron: deep inelastic scattering. - MSUB(10)=1 - - ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND. - & MINT(12).EQ.22) THEN -C...Two unresolved photons: fermion pair production, -C...exclude lepton pairs. - DO 150 ISUB=137,140 - MSUB(ISUB)=1 - 150 CONTINUE - DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 160 CONTINUE - PTMDIR=PTMRUN - IF(MSTP(18).EQ.2) PTMDIR=PARP(15) - IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR - CKIN(1)=MAX(CKIN(1),2D0*CKIN(3)) - - ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22)) - & .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND. - & MINT(12).EQ.22)) THEN -C...Unresolved photon + hadron: photon-parton scattering. - DO 170 ISUB=131,136 - MSUB(ISUB)=1 - 170 CONTINUE - - ELSEIF(MSEL.EQ.1) THEN -C...High-pT QCD processes: - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - PTMN=PTMRUN - VINT(154)=PTMN - IF(CKIN(3).LT.PTMN) MSUB(95)=1 - IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0 - - ELSE -C...All QCD processes: - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - MSUB(95)=1 - ENDIF - - ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN -C...Heavy quark production. - MSUB(81)=1 - MSUB(82)=1 - MSUB(84)=1 - DO 180 J=1,MIN(8,MDCY(21,3)) - MDME(MDCY(21,2)+J-1,1)=0 - 180 CONTINUE - MDME(MDCY(21,2)+MSEL-1,1)=1 - MSUB(85)=1 - DO 190 J=1,MIN(12,MDCY(22,3)) - MDME(MDCY(22,2)+J-1,1)=0 - 190 CONTINUE - MDME(MDCY(22,2)+MSEL-1,1)=1 - - ELSEIF(MSEL.EQ.10) THEN -C...Prompt photon production: - MSUB(14)=1 - MSUB(18)=1 - MSUB(29)=1 - - ELSEIF(MSEL.EQ.11) THEN -C...Z0/gamma* production: - MSUB(1)=1 - - ELSEIF(MSEL.EQ.12) THEN -C...W+/- production: - MSUB(2)=1 - - ELSEIF(MSEL.EQ.13) THEN -C...Z0 + jet: - MSUB(15)=1 - MSUB(30)=1 - - ELSEIF(MSEL.EQ.14) THEN -C...W+/- + jet: - MSUB(16)=1 - MSUB(31)=1 - - ELSEIF(MSEL.EQ.15) THEN -C...Z0 & W+/- pair production: - MSUB(19)=1 - MSUB(20)=1 - MSUB(22)=1 - MSUB(23)=1 - MSUB(25)=1 - - ELSEIF(MSEL.EQ.16) THEN -C...h0 production: - MSUB(3)=1 - MSUB(102)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - - ELSEIF(MSEL.EQ.17) THEN -C...h0 & Z0 or W+/- pair production: - MSUB(24)=1 - MSUB(26)=1 - - ELSEIF(MSEL.EQ.18) THEN -C...h0 production; interesting processes in e+e-. - MSUB(24)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - - ELSEIF(MSEL.EQ.19) THEN -C...h0, H0 and A0 production; interesting processes in e+e-. - MSUB(24)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - MSUB(153)=1 - MSUB(171)=1 - MSUB(173)=1 - MSUB(174)=1 - MSUB(158)=1 - MSUB(176)=1 - MSUB(178)=1 - MSUB(179)=1 - - ELSEIF(MSEL.EQ.21) THEN -C...Z'0 production: - MSUB(141)=1 - - ELSEIF(MSEL.EQ.22) THEN -C...W'+/- production: - MSUB(142)=1 - - ELSEIF(MSEL.EQ.23) THEN -C...H+/- production: - MSUB(143)=1 - - ELSEIF(MSEL.EQ.24) THEN -C...R production: - MSUB(144)=1 - - ELSEIF(MSEL.EQ.25) THEN -C...LQ (leptoquark) production. - MSUB(145)=1 - MSUB(162)=1 - MSUB(163)=1 - MSUB(164)=1 - - ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN -C...Production of one heavy quark (W exchange): - MSUB(83)=1 - DO 200 J=1,MIN(8,MDCY(21,3)) - MDME(MDCY(21,2)+J-1,1)=0 - 200 CONTINUE - MDME(MDCY(21,2)+MSEL-31,1)=1 - -CMRENNA++Define SUSY alternatives. - ELSEIF(MSEL.EQ.39) THEN -C...Turn on all SUSY processes. - IF(MINT(43).EQ.4) THEN -C...Hadron-hadron processes. - DO 210 I=201,301 - IF(ISET(I).GE.0) MSUB(I)=1 - 210 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN -C...Lepton-lepton processes: QED production of squarks. - DO 220 I=201,214 - MSUB(I)=1 - 220 CONTINUE - MSUB(210)=0 - MSUB(211)=0 - MSUB(212)=0 - DO 230 I=216,228 - MSUB(I)=1 - 230 CONTINUE - DO 240 I=261,263 - MSUB(I)=1 - 240 CONTINUE - MSUB(277)=1 - MSUB(278)=1 - ENDIF - - ELSEIF(MSEL.EQ.40) THEN -C...Gluinos and squarks. - IF(MINT(43).EQ.4) THEN - MSUB(243)=1 - MSUB(244)=1 - MSUB(258)=1 - MSUB(259)=1 - MSUB(261)=1 - MSUB(262)=1 - MSUB(264)=1 - MSUB(265)=1 - DO 250 I=271,296 - MSUB(I)=1 - 250 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN - MSUB(277)=1 - MSUB(278)=1 - ENDIF - - ELSEIF(MSEL.EQ.41) THEN -C...Stop production. - MSUB(261)=1 - MSUB(262)=1 - MSUB(263)=1 - IF(MINT(43).EQ.4) THEN - MSUB(264)=1 - MSUB(265)=1 - ENDIF - - ELSEIF(MSEL.EQ.42) THEN -C...Slepton production. - DO 260 I=201,214 - MSUB(I)=1 - 260 CONTINUE - IF(MINT(43).NE.4) THEN - MSUB(210)=0 - MSUB(211)=0 - MSUB(212)=0 - ENDIF - - ELSEIF(MSEL.EQ.43) THEN -C...Neutralino/Chargino + Gluino/Squark. - IF(MINT(43).EQ.4) THEN - DO 270 I=237,242 - MSUB(I)=1 - 270 CONTINUE - DO 280 I=246,254 - MSUB(I)=1 - 280 CONTINUE - MSUB(256)=1 - ENDIF - - ELSEIF(MSEL.EQ.44) THEN -C...Neutralino/Chargino pair production. - IF(MINT(43).EQ.4) THEN - DO 290 I=216,236 - MSUB(I)=1 - 290 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN - DO 300 I=216,228 - MSUB(I)=1 - 300 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.45) THEN -C...Sbottom production. - MSUB(287)=1 - MSUB(288)=1 - IF(MINT(43).EQ.4) THEN - DO 310 I=281,296 - MSUB(I)=1 - 310 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.50) THEN -C...Pair production of technipions and gauge bosons. - DO 320 I=361,368 - MSUB(I)=1 - 320 CONTINUE - IF(MINT(43).EQ.4) THEN - DO 330 I=370,377 - MSUB(I)=1 - 330 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.51) THEN -C...QCD 2 -> 2 processes with compositeness/technicolor modifications. - DO 340 I=381,386 - MSUB(I)=1 - 340 CONTINUE - ENDIF - -C...Find heaviest new quark flavour allowed in processes 81-84. - KFLQM=1 - DO 350 I=1,MIN(8,MDCY(21,3)) - IDC=I+MDCY(21,2)-1 - IF(MDME(IDC,1).LE.0) GOTO 350 - KFLQM=I - 350 CONTINUE - IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9)) - &KFLQM=MSTP(7) - MINT(55)=KFLQM - KFPR(81,1)=KFLQM - KFPR(81,2)=KFLQM - KFPR(82,1)=KFLQM - KFPR(82,2)=KFLQM - KFPR(83,1)=KFLQM - KFPR(84,1)=KFLQM - KFPR(84,2)=KFLQM - -C...Find heaviest new fermion flavour allowed in process 85. - KFLFM=1 - DO 360 I=1,MIN(12,MDCY(22,3)) - IDC=I+MDCY(22,2)-1 - IF(MDME(IDC,1).LE.0) GOTO 360 - KFLFM=KFDP(IDC,1) - 360 CONTINUE - IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND. - &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7) - MINT(56)=KFLFM - KFPR(85,1)=KFLFM - KFPR(85,2)=KFLFM - -C...Import relevant information on external user processes. - IF(MINT(111).EQ.11) THEN - IPYPR=0 - DO 390 IUP=1,NPRUP -C...Find next empty PYTHIA process number slot and enable it. - 370 IPYPR=IPYPR+1 - IF(IPYPR.GT.500) CALL PYERRM(26, - & '(PYINPR.) no more empty slots for user processes') - IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370 - IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370 - ISET(IPYPR)=11 -C...Overwrite KFPR with references back to process number and ID. - KFPR(IPYPR,1)=IUP - KFPR(IPYPR,2)=LPRUP(IUP) -C...Process title. - WRITE(CHIPR,'(I10)') LPRUP(IUP) - ICHIN=1 - DO 380 ICH=1,9 - IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1 - 380 CONTINUE - PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' ' -C...Switch on process. - MSUB(IPYPR)=1 - 390 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYINRE -C...Calculates full and effective widths of gauge bosons, stores -C...masses and widths, rescales coefficients to be used for -C...resonance production generation. - - SUBROUTINE PYINRE - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/ -C...Local arrays and data. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),WDTPM(0:400), - &WDTEM(0:400,0:5),KCORD(500),PMORD(500) - -C...Born level couplings in MSSM Higgs doublet sector. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - IF(MSTP(4).EQ.2) THEN - TANBE=PARU(141) - RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2 - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SQMH=PMAS(25,1)**2 - SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH) - SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE)) - SQMHC=SQMA+SQMW - IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN - WRITE(MSTU(11),5000) - STOP - ENDIF - PMAS(35,1)=SQRT(SQMHP) - PMAS(36,1)=SQRT(SQMA) - PMAS(37,1)=SQRT(SQMHC) - ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)* - & (SQMA-SQMZ))) - BESU=ATAN(TANBE) - PARU(142)=1D0 - PARU(143)=1D0 - PARU(161)=-SIN(ALSU)/COS(BESU) - PARU(162)=COS(ALSU)/SIN(BESU) - PARU(163)=PARU(161) - PARU(164)=SIN(BESU-ALSU) - PARU(165)=PARU(164) - PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW - PARU(171)=COS(ALSU)/COS(BESU) - PARU(172)=SIN(ALSU)/SIN(BESU) - PARU(173)=PARU(171) - PARU(174)=COS(BESU-ALSU) - PARU(175)=PARU(174) - PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)* - & SIN(BESU+ALSU) - PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU) - PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW - PARU(181)=TANBE - PARU(182)=1D0/TANBE - PARU(183)=PARU(181) - PARU(184)=0D0 - PARU(185)=PARU(184) - PARU(186)=COS(BESU-ALSU) - PARU(187)=SIN(BESU-ALSU) - PARU(188)=PARU(186) - PARU(189)=PARU(187) - PARU(190)=0D0 - PARU(195)=COS(BESU-ALSU) - ENDIF - -C...Reset effective widths of gauge bosons. - DO 110 I=1,500 - DO 100 J=1,5 - WIDS(I,J)=1D0 - 100 CONTINUE - 110 CONTINUE - -C...Order resonances by increasing mass (except Z0 and W+/-). - NRES=0 - DO 140 KC=1,500 - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 140 - IF(MWID(KC).EQ.0) GOTO 140 - IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN - IF(MSTP(1).LE.3) GOTO 140 - ENDIF - IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN - IF(IMSS(1).LE.0) GOTO 140 - ENDIF - NRES=NRES+1 - PMRES=PMAS(KC,1) - IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0 - DO 120 I1=NRES-1,1,-1 - IF(PMRES.GE.PMORD(I1)) GOTO 130 - KCORD(I1+1)=KCORD(I1) - PMORD(I1+1)=PMORD(I1) - 120 CONTINUE - 130 KCORD(I1+1)=KC - PMORD(I1+1)=PMRES - 140 CONTINUE - -C...Loop over possible resonances. - DO 180 I=1,NRES - KC=KCORD(I) - KF=KCHG(KC,4) - -C...Check that no fourth generation channels on by mistake. - IF(MSTP(1).LE.3) THEN - DO 150 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - KFA1=IABS(KFDP(IDC,1)) - KFA2=IABS(KFDP(IDC,2)) - IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR. - & KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18) - & MDME(IDC,1)=-1 - 150 CONTINUE - ENDIF - -C...Check that no supersymmetric channels on by mistake. - IF(IMSS(1).LE.0) THEN - DO 160 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - KFA1S=IABS(KFDP(IDC,1))/KSUSY1 - KFA2S=IABS(KFDP(IDC,2))/KSUSY1 - IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2) - & MDME(IDC,1)=-1 - 160 CONTINUE - ENDIF - -C...Find mass and evaluate width. - PMR=PMAS(KC,1) - IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1 - IF(MWID(KC).EQ.3) MINT(63)=1 - CALL PYWIDT(KF,PMR**2,WDTP,WDTE) - MINT(51)=0 - -C...Evaluate suppression factors due to non-simulated channels. - IF(KCHG(KC,3).EQ.0) THEN - WDTP0I=0D0 - IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) - WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))**2+ - & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ - & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 - WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I - WIDS(KC,3)=0D0 - WIDS(KC,4)=0D0 - WIDS(KC,5)=0D0 - ELSE - IF(MWID(KC).EQ.3) MINT(63)=1 - CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM) - MINT(51)=0 - WDTP0I=0D0 - IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) - WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+ - & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+ - & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+ - & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))*WDTP0I**2 - WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I - WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))*WDTP0I - WIDS(KC,4)=((WDTE(0,1)+WDTE(0,2))**2+ - & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ - & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 - WIDS(KC,5)=((WDTEM(0,1)+WDTEM(0,3))**2+ - & 2D0*(WDTEM(0,1)+WDTEM(0,3))*(WDTEM(0,4)+WDTEM(0,5))+ - & 2D0*WDTEM(0,4)*WDTEM(0,5))*WDTP0I**2 - ENDIF - -C...Set resonance widths and branching ratios; -C...also on/off switch for decays. - IF(MWID(KC).EQ.1.OR.MWID(KC).EQ.3) THEN - PMAS(KC,2)=WDTP(0) - PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2)) - IF(MSTP(41).EQ.0.OR.MSTP(41).EQ.1) MDCY(KC,1)=MSTP(41) - DO 170 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - BRAT(IDC)=0D0 - IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0) - 170 CONTINUE - ENDIF - 180 CONTINUE - -C...Flavours of leptoquark: redefine charge and name. - KFLQQ=KFDP(MDCY(42,2),1) - KFLQL=KFDP(MDCY(42,2),2) - KCHG(42,1)=KCHG(PYCOMP(KFLQQ),1)*ISIGN(1,KFLQQ)+ - &KCHG(PYCOMP(KFLQL),1)*ISIGN(1,KFLQL) - LL=1 - IF(IABS(KFLQL).EQ.13) LL=2 - IF(IABS(KFLQL).EQ.15) LL=3 - CHAF(42,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)// - &CHAF(IABS(KFLQL),1)(1:LL)//' ' - CHAF(42,2)=CHAF(42,2)(1:4+LL)//'bar ' - -C...Special cases in treatment of gamma*/Z0: redefine process name. - IF(MSTP(43).EQ.1) THEN - PROC(1)='f + fbar -> gamma*' - PROC(15)='f + fbar -> g + gamma*' - PROC(19)='f + fbar -> gamma + gamma*' - PROC(30)='f + g -> f + gamma*' - PROC(35)='f + gamma -> f + gamma*' - ELSEIF(MSTP(43).EQ.2) THEN - PROC(1)='f + fbar -> Z0' - PROC(15)='f + fbar -> g + Z0' - PROC(19)='f + fbar -> gamma + Z0' - PROC(30)='f + g -> f + Z0' - PROC(35)='f + gamma -> f + Z0' - ELSEIF(MSTP(43).EQ.3) THEN - PROC(1)='f + fbar -> gamma*/Z0' - PROC(15)='f + fbar -> g + gamma*/Z0' - PROC(19)='f+ fbar -> gamma + gamma*/Z0' - PROC(30)='f + g -> f + gamma*/Z0' - PROC(35)='f + gamma -> f + gamma*/Z0' - ENDIF - -C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name. - IF(MSTP(44).EQ.1) THEN - PROC(141)='f + fbar -> gamma*' - ELSEIF(MSTP(44).EQ.2) THEN - PROC(141)='f + fbar -> Z0' - ELSEIF(MSTP(44).EQ.3) THEN - PROC(141)='f + fbar -> Z''0' - ELSEIF(MSTP(44).EQ.4) THEN - PROC(141)='f + fbar -> gamma*/Z0' - ELSEIF(MSTP(44).EQ.5) THEN - PROC(141)='f + fbar -> gamma*/Z''0' - ELSEIF(MSTP(44).EQ.6) THEN - PROC(141)='f + fbar -> Z0/Z''0' - ELSEIF(MSTP(44).EQ.7) THEN - PROC(141)='f + fbar -> gamma*/Z0/Z''0' - ENDIF - -C...Special cases in treatment of WW -> WW: redefine process name. - IF(MSTP(45).EQ.1) THEN - PROC(77)='W+ + W+ -> W+ + W+' - ELSEIF(MSTP(45).EQ.2) THEN - PROC(77)='W+ + W- -> W+ + W-' - ELSEIF(MSTP(45).EQ.3) THEN - PROC(77)='W+/- + W+/- -> W+/- + W+/-' - ENDIF - -C...Format for error information. - 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ', - &'combination'/1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYJMAS -C...Determines, approximately, the two jet masses that minimize -C...the sum m_H^2 + m_L^2, a la Clavelli and Wyler. - - SUBROUTINE PYJMAS(PMH,PML) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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)=0D0 - 100 CONTINUE - DO 110 J2=1,4 - PS(J1,J2)=0D0 - 110 CONTINUE - 120 CONTINUE - PSS=0D0 - PIMASS=PMAS(PYCOMP(211),1) - -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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 170 - ENDIF - IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYJMAS:) no more memory left in PYJETS') - PMH=-2D0 - PML=-2D0 - 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)=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS - 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 PYERRM(8,'(PYJMAS:) too few particles for analysis') - PMH=-1D0 - PML=-1D0 - RETURN - ENDIF - PARU(61)=SQRT(MAX(0D0,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)/3D0-1D0/9D0 - SR=-0.5D0*(SQ+1D0/9D0+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)+1D0/27D0 - SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) - SMA=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-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=0D0 - 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=0D0 - 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.0D0) 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(1D-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ - &MAX(1D-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=0D0 - 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=2D0*(P(I,5)**2-PPS) - IF(K(I,3).EQ.2) PMDI=2D0*(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(0D0,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) - PS(2,5)=SQRT(MAX(0D0,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********************************************************************* - -C...PYJOIN -C...Connects a sequence of partons with colour flow indices, -C...as required for subsequent shower evolution (or other operations). - - SUBROUTINE PYJOIN(NJOIN,IJOIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local array. - 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=PYCOMP(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.5D0+PYR(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 PYERRM(12, - &'(PYJOIN:) given entries can not be joined by one string') - - RETURN - END - -C********************************************************************* - -C...PYJURF -C...From three given input vectors in PJU the boost VJU from -C...the "lab frame" to the junction rest frame is constructed. - - SUBROUTINE PYJURF(PJU,VJU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Input, output and local arrays. - DIMENSION PJU(3,5),VJU(5),PSUM(5),A(3,3),PENEW(3),PCM(5,5) - DATA TWOPI/6.283186D0/ - -C...Calculate masses and other invariants. - DO 100 J=1,4 - PSUM(J)=PJU(1,J)+PJU(2,J)+PJU(3,J) - 100 CONTINUE - PSUM2=PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2 - PSUM(5)=SQRT(PSUM2) - DO 120 I=1,3 - DO 110 J=1,3 - A(I,J)=PJU(I,4)*PJU(J,4)-PJU(I,1)*PJU(J,1)- - & PJU(I,2)*PJU(J,2)-PJU(I,3)*PJU(J,3) - 110 CONTINUE - 120 CONTINUE - -C...Pick I to be most massive parton and J to be the one closest to I. - ITRY=0 - I=1 - IF(A(2,2).GT.A(1,1)) I=2 - IF(A(3,3).GT.MAX(A(1,1),A(2,2))) I=3 - 130 ITRY=ITRY+1 - J=1+MOD(I,3) - K=1+MOD(J,3) - IF(A(I,K)**2*A(J,J).LT.A(I,J)**2*A(K,K)) THEN - K=1+MOD(I,3) - J=1+MOD(K,3) - ENDIF - PMI2=A(I,I) - PMJ2=A(J,J) - PMK2=A(K,K) - AIJ=A(I,J) - AIK=A(I,K) - AJK=A(J,K) - -C...Trivial find new parton energies if all three partons are massless. - IF(PMI2.LT.1D-4) THEN - PEI=SQRT(2D0*AIK*AIJ/(3D0*AJK)) - PEJ=SQRT(2D0*AJK*AIJ/(3D0*AIK)) - PEK=SQRT(2D0*AIK*AJK/(3D0*AIJ)) - -C...Else find momentum range for parton I and values at extremes. - ELSE - PAIMIN=0D0 - PEIMIN=SQRT(PMI2) - PEJMIN=AIJ/PEIMIN - PEKMIN=AIK/PEIMIN - PAJMIN=SQRT(MAX(0D0,PEJMIN**2-PMJ2)) - PAKMIN=SQRT(MAX(0D0,PEKMIN**2-PMK2)) - FMIN=PEJMIN*PEKMIN+0.5D0*PAJMIN*PAKMIN-AJK - PEIMAX=(AIJ+AIK)/SQRT(PMJ2+PMK2+2D0*AJK) - IF(PMJ2.GT.1D-4) PEIMAX=AIJ/SQRT(PMJ2) - PAIMAX=SQRT(MAX(0D0,PEIMAX**2-PMI2)) - HI=PEIMAX**2-0.25D0*PAIMAX**2 - PAJMAX=(PEIMAX*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))- - & 0.5D0*PAIMAX*AIJ)/HI - PAKMAX=(PEIMAX*SQRT(MAX(0D0,AIK**2-PMK2*HI))- - & 0.5D0*PAIMAX*AIK)/HI - PEJMAX=SQRT(PAJMAX**2+PMJ2) - PEKMAX=SQRT(PAKMAX**2+PMK2) - FMAX=PEJMAX*PEKMAX+0.5D0*PAJMAX*PAKMAX-AJK - -C...If unexpected values at upper endpoint then pick another parton. - IF(FMAX.GT.0D0.AND.ITRY.LE.2) THEN - I1=1+MOD(I,3) - IF(A(I1,I1).GE.1D-4) THEN - I=I1 - GOTO 130 - ENDIF - ITRY=ITRY+1 - I1=1+MOD(I,3) - IF(ITRY.LE.2.AND.A(I1,I1).GE.1D-4) THEN - I=I1 - GOTO 130 - ENDIF - ENDIF - -C..Start binary + linear search to find solution inside range. - ITER=0 - ITMIN=0 - ITMAX=0 - PAI=0.5D0*(PAIMIN+PAIMAX) - 140 ITER=ITER+1 - -C...Derive momentum of other two partons and distance to root. - PEI=SQRT(PAI**2+PMI2) - HI=PEI**2-0.25D0*PAI**2 - PAJ=(PEI*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))-0.5D0*PAI*AIJ)/HI - PEJ=SQRT(PAJ**2+PMJ2) - PAK=(PEI*SQRT(MAX(0D0,AIK**2-PMK2*HI))-0.5D0*PAI*AIK)/HI - PEK=SQRT(PAK**2+PMK2) - FNOW=PEJ*PEK+0.5D0*PAJ*PAK-AJK - -C...Pick next I momentum to explore, hopefully closer to root. - IF(FNOW.GT.0D0) THEN - PAIMIN=PAI - FMIN=FNOW - ITMIN=ITMIN+1 - ELSE - PAIMAX=PAI - FMAX=FNOW - ITMAX=ITMAX+1 - ENDIF - IF((ITER.LT.10.OR.ITMIN.LE.1.OR.ITMAX.LE.1).AND.ITER.LT.20) - & THEN - PAI=0.5D0*(PAIMIN+PAIMAX) - GOTO 140 - ELSEIF(ITER.LT.40.AND.FMIN.GT.0D0.AND.FMAX.LT.0D0.AND. - & ABS(FNOW).GT.1D-12*PSUM2) THEN - PAI=PAIMIN+(PAIMAX-PAIMIN)*FMIN/(FMIN-FMAX) - GOTO 140 - ENDIF - ENDIF - -C...Now know energies in junction rest frame. - PENEW(I)=PEI - PENEW(J)=PEJ - PENEW(K)=PEK - -C...Boost (copy of) partons to their rest frame. - VXCM=-PSUM(1)/PSUM(5) - VYCM=-PSUM(2)/PSUM(5) - VZCM=-PSUM(3)/PSUM(5) - GAMCM=SQRT(1D0+VXCM**2+VYCM**2+VZCM**2) - DO 150 I=1,3 - FAC1=PJU(I,1)*VXCM+PJU(I,2)*VYCM+PJU(I,3)*VZCM - FAC2=FAC1/(1D0+GAMCM)+PJU(I,4) - PCM(I,1)=PJU(I,1)+FAC2*VXCM - PCM(I,2)=PJU(I,2)+FAC2*VYCM - PCM(I,3)=PJU(I,3)+FAC2*VZCM - PCM(I,4)=PJU(I,4)*GAMCM+FAC1 - PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) - 150 CONTINUE - -C...Construct difference vectors and boost to junction rest frame. - DO 160 J=1,3 - PCM(4,J)=PCM(1,J)/PCM(1,4)-PCM(2,J)/PCM(2,4) - PCM(5,J)=PCM(1,J)/PCM(1,4)-PCM(3,J)/PCM(3,4) - 160 CONTINUE - PCM(4,4)=PENEW(1)/PCM(1,4)-PENEW(2)/PCM(2,4) - PCM(5,4)=PENEW(1)/PCM(1,4)-PENEW(3)/PCM(3,4) - PCM4S=PCM(4,1)**2+PCM(4,2)**2+PCM(4,3)**2 - PCM5S=PCM(5,1)**2+PCM(5,2)**2+PCM(5,3)**2 - PCM45=PCM(4,1)*PCM(5,1)+PCM(4,2)*PCM(5,2)+PCM(4,3)*PCM(5,3) - C4=(PCM5S*PCM(4,4)-PCM45*PCM(5,4))/(PCM4S*PCM5S-PCM45**2) - C5=(PCM4S*PCM(5,4)-PCM45*PCM(4,4))/(PCM4S*PCM5S-PCM45**2) - VXJU=C4*PCM(4,1)+C5*PCM(5,1) - VYJU=C4*PCM(4,2)+C5*PCM(5,2) - VZJU=C4*PCM(4,3)+C5*PCM(5,3) - GAMJU=SQRT(1D0+VXJU**2+VYJU**2+VZJU**2) - -C...Add two boosts, giving final result. - FCM=(VXJU*VXCM+VYJU*VYCM+VZJU*VZCM)/(1+GAMCM)+GAMJU - VJU(1)=VXJU+FCM*VXCM - VJU(2)=VYJU+FCM*VYCM - VJU(3)=VZJU+FCM*VZCM - VJU(4)=SQRT(1D0+VJU(1)**2+VJU(2)**2+VJU(3)**2) - VJU(5)=1D0 - -C...In case of error in reconstruction: revert to CM frame of system. - CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ - &(PCM(1,5)*PCM(2,5)) - CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ - &(PCM(1,5)*PCM(3,5)) - CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ - &(PCM(2,5)*PCM(3,5)) - ERRCCM=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 - ERRTCM=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) - DO 170 I=1,3 - FAC1=PJU(I,1)*VJU(1)+PJU(I,2)*VJU(2)+PJU(I,3)*VJU(3) - FAC2=FAC1/(1D0+VJU(4))+PJU(I,4) - PCM(I,1)=PJU(I,1)+FAC2*VJU(1) - PCM(I,2)=PJU(I,2)+FAC2*VJU(2) - PCM(I,3)=PJU(I,3)+FAC2*VJU(3) - PCM(I,4)=PJU(I,4)*VJU(4)+FAC1 - PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) - 170 CONTINUE - CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ - &(PCM(1,5)*PCM(2,5)) - CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ - &(PCM(1,5)*PCM(3,5)) - CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ - &(PCM(2,5)*PCM(3,5)) - ERRCJU=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 - ERRTJU=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) - IF(ERRCJU+ERRTJU.GT.ERRCCM+ERRTCM) THEN - VJU(1)=VXCM - VJU(2)=VYCM - VJU(3)=VZCM - VJU(4)=GAMCM - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYKCUT -C...Dummy routine, which the user can replace in order to make cuts on -C...the kinematics on the parton level before the matrix elements are -C...evaluated and the event is generated. The cross-section estimates -C...will automatically take these cuts into account, so the given -C...values are for the allowed phase space region only. MCUT=0 means -C...that the event has passed the cuts, MCUT=1 that it has failed. - - SUBROUTINE PYKCUT(MCUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYINT1/,/PYINT2/ - -C...Set default value (accepting event) for MCUT. - MCUT=0 - -C...Read out subprocess number. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - -C...Read out tau, y*, cos(theta), tau' (where defined, else =0). - TAU=VINT(21) - YST=VINT(22) - CTH=0D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) - TAUP=0D0 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) - -C...Calculate x_1, x_2, x_F. - IF(ISTSB.LE.2.OR.ISTSB.GE.5) THEN - X1=SQRT(TAU)*EXP(YST) - X2=SQRT(TAU)*EXP(-YST) - ELSE - X1=SQRT(TAUP)*EXP(YST) - X2=SQRT(TAUP)*EXP(-YST) - ENDIF - XF=X1-X2 - -C...Calculate shat, that, uhat, p_T^2. - SHAT=TAU*VINT(2) - SQM3=VINT(63) - SQM4=VINT(64) - RM3=SQM3/SHAT - RM4=SQM4/SHAT - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - RPTS=4D0*VINT(71)**2/SHAT - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=2D0*RM3*RM4 - RSQM=1D0+RM34 - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - THAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) - UHAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - PT2=MAX(VINT(71)**2,0.25D0*SHAT*BE34**2*(1D0-CTH**2)) - -C...Decisions by user to be put here. - -C...Stop program if this routine is ever called. -C...You should not copy these lines to your own routine. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYKCUT routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYK -C...Provides various integer-valued event related data. - - FUNCTION PYK(I,J) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Default value. For I=0 number of entries, number of stable entries -C...or 3 times total charge. - PYK=0 - IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN - ELSEIF(I.EQ.0.AND.J.EQ.1) THEN - PYK=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) PYK=PYK+1 - IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+ - & PYCHGE(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 - PYK=K(I,J) - ELSEIF(J.EQ.6) THEN - PYK=PYCHGE(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) PYK=1 - IF(J.EQ.8) PYK=PYK*K(I,2) - ELSEIF(J.LE.12) THEN - KFA=IABS(K(I,2)) - KC=PYCOMP(KFA) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2) - IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) PYK=K(I,2) - IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) PYK=K(I,2) - IF(J.EQ.11) PYK=KC - IF(J.EQ.12) PYK=KQ*ISIGN(1,K(I,2)) - -C...Heaviest flavour in hadron/diquark. - ELSEIF(J.EQ.13) THEN - KFA=IABS(K(I,2)) - PYK=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) - IF(KFA.LT.10) PYK=KFA - IF(MOD(KFA/1000,10).NE.0) PYK=MOD(KFA/1000,10) - PYK=PYK*ISIGN(1,K(I,2)) - -C...Particle history: generation, ancestor, rank. - ELSEIF(J.LE.15) THEN - I2=I - I1=I - 110 PYK=PYK+1 - I2=I1 - I1=K(I1,3) - IF(I1.GT.0) THEN - IF(K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 - ENDIF - IF(J.EQ.15) PYK=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) PYK=PYK+1 - 130 CONTINUE - ELSE - I3=I2 - 140 PYK=PYK+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 PYK=PYK+1 - I3=I1 - I1=K(I1,3) - I0=MAX(1,I1) - KC=PYCOMP(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(PYK.EQ.1) PYK=-1 - IF(PYK.GT.1) PYK=0 - RETURN - ENDIF - IF(KCHG(KC,2).EQ.0) GOTO 150 - IF(K(I1,1).NE.12) PYK=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) PYK=0 - K3P=K(I3+1,3) - IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) PYK=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) PYK=MAX(0,K(I,5)-K(I,4)+1) - IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) PYK=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) PYK=MOD(K(I,4)/MSTU(5),MSTU(5)) - IF(J.EQ.20) PYK=MOD(K(I,5)/MSTU(5),MSTU(5)) - IF(J.EQ.21) PYK=MOD(K(I,4),MSTU(5)) - IF(J.EQ.22) PYK=MOD(K(I,5),MSTU(5)) - ELSE - ENDIF - - RETURN - END - -C******************************************************************** - -C...PYKFDI -C...Generates a new flavour pair and combines off a hadron - - SUBROUTINE PYKFDI(KFL1,KFL2,KFL3,KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION PD(7) - - IF(MSTU(123).EQ.0.AND.MSTJ(12).GE.0) CALL PYKFIN - -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 - IF(MSTJ(12).GE.5) CALL PYERRM(29, - & '(PYKFDI:) Sorry, option MSTJ(15)=1 not available' // - & ' together with MSTJ(12)>=5 modification') - KTAB1=-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - KFL1S=MOD(KF1A,10) - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) - & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A - KTAB2=0 - IF(KF2A.NE.0) THEN - KTAB2=-1 - IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A - KFL2A=MOD(KF2A/1000,10) - KFL2B=MOD(KF2A/100,10) - KFL2S=MOD(KF2A,10) - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) - & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 - ENDIF - IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140 - ENDIF - -C.. Recognize rank 0 diquark case - 100 IRANK=1 - KFDIQ=MAX(KF1A,KF2A) - IF(KFDIQ.GT.10.AND.KFDIQ.LT.10000) IRANK=0 - -C.. Join two flavours to meson or baryon. Test for popcorn. - IF(KF2A.GT.0)THEN - MBARY=0 - IF(KFDIQ.GT.10) THEN - IF(IRANK.EQ.0.AND.MSTJ(12).LT.5) - & CALL PYNMES(KFDIQ) - IF(MSTU(121).NE.0) THEN - MSTU(121)=0 - RETURN - ENDIF - MBARY=2 - ENDIF - KFQOLD=KF1A - KFQVER=KF2A - GOTO 130 - ENDIF - -C.. Separate incoming flavours, curtain flavour consistency check - KFIN=KFL1 - KFQOLD=KF1A - KFQPOP=KF1A/10000 - IF(KF1A.GT.10)THEN - KFIN=-KFL1 - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - IF(IRANK.EQ.0)THEN - QAWT=1D0 - IF(KFL1A.GE.3) QAWT=PARF(136+KFL1A/4) - IF(KFL1B.GE.3) QAWT=QAWT/PARF(136+KFL1B/4) - KFQPOP=KFL1A+(KFL1B-KFL1A)*INT(1D0/(QAWT+1D0)+PYR(0)) - ENDIF - IF(KFQPOP.NE.KFL1B.AND.KFQPOP.NE.KFL1A) THEN - MSTU(121)=0 - RETURN - ENDIF - KFQOLD=KFL1A+KFL1B-KFQPOP - ENDIF - -C...Meson/baryon choice. Set number of mesons if starting a popcorn -C...system. - 110 MBARY=0 - IF(KF1A.LE.10.AND.MSTJ(12).GT.0)THEN - IF(MSTU(121).EQ.-1.OR.(1D0+PARJ(1))*PYR(0).GT.1D0)THEN - MBARY=1 - CALL PYNMES(0) - ENDIF - ELSEIF(KF1A.GT.10)THEN - MBARY=2 - IF(IRANK.EQ.0) CALL PYNMES(KF1A) - IF(MSTU(121).GT.0) MBARY=-1 - ENDIF - -C..x->H+q: Choose single vertex quark. Jump to form hadron. - IF(MBARY.EQ.0.OR.MBARY.EQ.2)THEN - KFQVER=1+INT((2D0+PARJ(2))*PYR(0)) - KFL3=ISIGN(KFQVER,-KFIN) - GOTO 130 - ENDIF - -C..x->H+qq: (IDW=proper PARF position for diquark weights) - IDW=160 - IF(MBARY.EQ.1)THEN - IF(MSTU(121).EQ.0) IDW=150 - SQWT=PARF(IDW+1) - IF(MSTU(121).GT.0) SQWT=SQWT*PARF(135)*PARF(138)**MSTU(121) - KFQPOP=1+INT((2D0+SQWT)*PYR(0)) -C.. Shift to s-curtain parameters if needed - IF(KFQPOP.GE.3.AND.MSTJ(12).GE.5)THEN - PARF(194)=PARF(138)*PARF(139) - PARF(193)=PARJ(8)+PARJ(9) - ENDIF - ENDIF - -C.. x->H+qq: Get vertex quark - IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN - IDW=MSTU(122) - MSTU(121)=MSTU(121)-1 - IF(IDW.EQ.170) THEN - IF(MSTU(121).EQ.0)THEN - IPOS=3*MIN(KFQPOP-1,2)+MIN(KFQOLD-1,2) - ELSE - IPOS=3*3+3*MAX(0,MIN(KFQPOP-2,1))+MIN(KFQOLD-1,2) - ENDIF - ELSE - IF(MSTU(121).EQ.0)THEN - IPOS=3*5+5*MIN(KFQPOP-1,3)+MIN(KFQOLD-1,4) - ELSE - IPOS=3*5+5*4+MIN(KFQOLD-1,4) - ENDIF - ENDIF - IPOS=200+30*IPOS+1 - - IMES=-1 - RMES=PYR(0)*PARF(194) - 120 IMES=IMES+1 - RMES=RMES-PARF(IPOS+IMES) - IF(IMES.EQ.30) THEN - MSTU(121)=-1 - KF=-111 - RETURN - ENDIF - IF(RMES.GT.0D0) GOTO 120 - KMUL=IMES/5 - KFJ=2*KMUL+1 - IF(KMUL.EQ.2) KFJ=10003 - IF(KMUL.EQ.3) KFJ=10001 - IF(KMUL.EQ.4) KFJ=20003 - IF(KMUL.EQ.5) KFJ=5 - IDIAG=0 - KFQVER=MOD(IMES,5)+1 - IF(KFQVER.GE.KFQOLD) KFQVER=KFQVER+1 - IF(KFQVER.GT.3)THEN - IDIAG=KFQVER-3 - KFQVER=KFQOLD - ENDIF - ELSE - IF(MBARY.EQ.-1) IDW=170 - SQWT=PARF(IDW+2) - IF(KFQPOP.EQ.3) SQWT=PARF(IDW+3) - IF(KFQPOP.GT.3) SQWT=PARF(IDW+3)*(1D0/PARF(IDW+5)+1D0)/2D0 - KFQVER=MIN(3,1+INT((2D0+SQWT)*PYR(0))) - IF(KFQPOP.LT.3.AND.KFQVER.LT.3)THEN - KFQVER=KFQPOP - IF(PYR(0).GT.PARF(IDW+4)) KFQVER=3-KFQPOP - ENDIF - ENDIF - -C..x->H+qq: form outgoing diquark with KFQPOP flag at 10000-pos - KFLDS=3 - IF(KFQPOP.NE.KFQVER)THEN - SWT=PARF(IDW+7) - IF(KFQVER.EQ.3) SWT=PARF(IDW+6) - IF(KFQPOP.GE.3) SWT=PARF(IDW+5) - IF((1D0+SWT)*PYR(0).LT.1D0) KFLDS=1 - ENDIF - KFDIQ=900*MAX(KFQVER,KFQPOP)+100*(KFQVER+KFQPOP)+KFLDS - & +10000*KFQPOP - KFL3=ISIGN(KFDIQ,KFIN) - -C..x->M+y: flavour for meson. - 130 IF(MBARY.LE.0)THEN - KFLA=MAX(KFQOLD,KFQVER) - KFLB=MIN(KFQOLD,KFQVER) - KFS=ISIGN(1,KFL1) - IF(KFLA.NE.KFQOLD) KFS=-KFS -C... Form meson, with spin and flavour mixing for diagonal states. - IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN - IF(IDIAG.GT.0) KF=110*IDIAG+KFJ - IF(IDIAG.EQ.0) KF=(100*KFLA+10*KFLB+KFJ)*KFS*(-1)**KFLA - RETURN - ENDIF - IF(KFLA.LE.2) KMUL=INT(PARJ(11)+PYR(0)) - IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+PYR(0)) - IF(KFLA.GE.4) KMUL=INT(PARJ(13)+PYR(0)) - IF(KMUL.EQ.0.AND.PARJ(14).GT.0D0)THEN - IF(PYR(0).LT.PARJ(14)) KMUL=2 - ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0D0)THEN - RMUL=PYR(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=PYR(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'. -C..Allow shift to qq->B+q in old version (set IRANK to 0) - IF(KF.EQ.221.OR.KF.EQ.331)THEN - IF(PYR(0).GT.PARJ(25+KF/300))THEN - IF(KF2A.GT.0) GOTO 130 - IF(MSTJ(12).LT.4) IRANK=0 - GOTO 110 - ENDIF - ENDIF - MSTU(121)=0 - -C.. x->B+y: Flavour for baryon - ELSE - KFLA=KFQVER - IF(KF1A.LE.10) KFLA=KFQOLD - KFLB=MOD(KFDIQ/1000,10) - KFLC=MOD(KFDIQ/100,10) - KFLDS=MOD(KFDIQ,10) - KFLD=MAX(KFLA,KFLB,KFLC) - KFLF=MIN(KFLA,KFLB,KFLC) - KFLE=KFLA+KFLB+KFLC-KFLD-KFLF - -C... SU(6) factors for formation of baryon. - KBARY=3 - KDMAX=5 - KFLG=KFLB - IF(KFLB.NE.KFLC)THEN - KBARY=2*KFLDS-1 - KDMAX=1+KFLDS/2 - IF(KFLB.GT.2) KDMAX=KDMAX+2 - ENDIF - IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC)THEN - KBARY=KBARY+1 - KFLG=KFLA - ENDIF - - SU6MAX=PARF(140+KDMAX) - SU6DEC=PARJ(18) - SU6S =PARF(146) - IF(MSTJ(12).GE.5.AND.IRANK.EQ.0) THEN - SU6MAX=1D0 - SU6DEC=1D0 - SU6S =1D0 - ENDIF - SU6OCT=PARF(60+KBARY) - IF(KFLG.GT.MAX(KFLA+KFLB-KFLG,2))THEN - SU6OCT=SU6OCT*4*SU6S/(3*SU6S+1) - IF(KBARY.EQ.2) SU6OCT=PARF(60+KBARY)*4/(3*SU6S+1) - ELSE - IF(KBARY.EQ.6) SU6OCT=SU6OCT*(3+SU6S)/(3*SU6S+1) - ENDIF - SU6WT=SU6OCT+SU6DEC*PARF(70+KBARY) - -C.. SU(6) test. Old options enforce new baryon if q->B+qq is rejected. - IF(SU6WT.LT.PYR(0)*SU6MAX.AND.KF2A.EQ.0)THEN - MSTU(121)=0 - IF(MSTJ(12).LE.2.AND.MBARY.EQ.1) MSTU(121)=-1 - GOTO 110 - ENDIF - -C.. Form baryon. Distinguish Lambda- and Sigmalike baryons. - KSIG=1 - KFLS=2 - IF(SU6WT*PYR(0).GT.SU6OCT) KFLS=4 - IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF)THEN - KSIG=KFLDS/3 - IF(KFLA.NE.KFLD) KSIG=INT(3*SU6S/(3*SU6S+KFLDS**2)+PYR(0)) - ENDIF - KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) - IF(KSIG.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) - ENDIF - RETURN - -C...Use tabulated probabilities to select new flavour and hadron. - 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0) THEN - KT3L=1 - KT3U=22 - ELSE - KT3L=KTAB2 - KT3U=KTAB2 - ENDIF - RFL=0D0 - DO 160 KTS=0,2 - DO 150 KT3=KT3L,KT3U - RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) - 150 CONTINUE - 160 CONTINUE - RFL=PYR(0)*RFL - DO 180 KTS=0,2 - KTABS=KTS - DO 170 KT3=KT3L,KT3U - KTAB3=KT3 - RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) - IF(RFL.LE.0D0) GOTO 190 - 170 CONTINUE - 180 CONTINUE - 190 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=PYR(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 PYERRM(2,'(PYKFDI:) 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=PYCOMP(KF) - IF(KC.EQ.0) THEN - CALL PYERRM(2,'(PYKFDI:) user-defined flavour probabilities '// - & 'failed') - GOTO 100 - ENDIF - - RETURN - END - -C*************************************************************** - -C...PYKFIN -C...Precalculates a set of diquark and popcorn weights. - - SUBROUTINE PYKFIN - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - DIMENSION SU6(12),SU6M(7),QBB(7),QBM(7),DMB(14) - - - MSTU(123)=1 -C..Diquark indices for dimensional variables - IUD1=1 - IUU1=2 - IUS0=3 - ISU0=4 - IUS1=5 - ISU1=6 - ISS1=7 - -C.. *** SU(6) factors ** -C..Modify with decuplet- (and Sigma/Lambda-) suppression. - PARF(146)=1D0 - IF(MSTJ(12).GE.5) PARF(146)=3D0*PARJ(18)/(2D0*PARJ(18)+1D0) - IF(PARJ(18).LT.1D0-1D-5.AND.MSTJ(12).LT.5) CALL PYERRM(9, - & '(PYKFIN:) PARJ(18)<1 combined with 0 B+B+.. - DO 120 I=1,7 - QBB(I)=QBB(I)*QBM(I) - 120 CONTINUE - - IF(MSTJ(12).GE.5)THEN -C..New version: tau for rank 0 diquark. - DMB(7+ISU0)=EXP(-PARJ(10)*PMUS0) - DMB(7+IUS0)=PARJ(2)*DMB(7+ISU0) - DMB(7+ISS1)=6D0*PARJ(2)*EXP(-PARJ(10)*PMSS1)*DMB(7+ISU0) - DMB(7+IUU1)=6D0*EXP(-PARJ(10)*PMUD1) - DMB(7+ISU1)=3D0*EXP(-PARJ(10)*PMUS1)*DMB(7+ISU0) - DMB(7+IUS1)=PARJ(2)*DMB(7+ISU1) - DMB(7+IUD1)=DMB(7+IUU1)/2D0 - -C..New version: curtain flavour ratios. -C.. s/u for q->B+M+... -C.. s/u for rank 0 diquark: su -> ...M+B+... -C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... - WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) - PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU - WU=1D0+DMB(7+IUD1)+DMB(7+IUS0)+DMB(7+IUS1)+DMB(7+IUU1) - PARF(136)=(2D0*(DMB(7+ISU0)+DMB(7+ISU1))+DMB(7+ISS1))/WU - PARF(137)=(DMB(7+ISU0)+DMB(7+ISU1))* - & (2D0+DMB(7+ISS1)/(2D0*DMB(7+ISU1)))/WU - ELSE -C..Old version: reset unused rank 0 diquark weights and -C.. unused diquark SU(6) survival weights - DO 130 I=1,7 - IF(MSTJ(12).LT.3) DMB(I)=1D0 - DMB(7+I)=1D0 - 130 CONTINUE - -C..Old version: Shuffle PARJ(7) into tau - QBM(IUS0)=QBM(IUS0)*PARJ(7) - QBM(ISS1)=QBM(ISS1)*PARJ(7) - QBM(IUS1)=QBM(IUS1)*PARJ(7) - -C..Old version: curtain flavour ratios. -C.. s/u for q->B+M+... -C.. s/u for rank 0 diquark: su -> ...M+B+... -C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... - WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) - PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU - PARF(136)=PARF(135)*PARJ(6)*QBM(ISU0)/QBM(IUS0) - PARF(137)=(1D0+QBM(IUD1))*(2D0+QBM(IUS0))/WU - ENDIF - -C..Combine diquark SU(6) survival, SU(6)max, tau and T into factors for: -C.. rank0 D->M+B+..; D->M+B+..; q->B+M+..; q->B+B.. - DO 140 I=1,7 - DMB(7+I)=DMB(7+I)*DMB(I) - DMB(I)=DMB(I)*QBM(I) - QBM(I)=QBM(I)*SU6M(I)/SU6MUD - QBB(I)=QBB(I)*SU6M(I)/SU6MUD - 140 CONTINUE - -C.. *** Popcorn factors *** - - IF(MSTJ(12).LT.5)THEN -C.. Old version: Resulting popcorn weights. - PARF(138)=PARJ(6) - WS=PARF(135)*PARF(138) - WQ=WU*PARJ(5)/3D0 - PARF(132)=WQ*QBM(IUD1)/QBB(IUD1) - PARF(133)=WQ* - & (QBM(IUS1)/QBB(IUS1)+WS*QBM(ISU1)/QBB(ISU1))/2D0 - PARF(134)=WQ*WS*QBM(ISS1)/QBB(ISS1) - PARF(131)=WQ*(1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)+ - & WS*(QBM(ISU0)+QBM(ISU1)+QBM(ISS1)/2D0))/ - & (1D0+QBB(IUD1)+QBB(IUU1)+ - & 2D0*(QBB(IUS0)+QBB(IUS1))+QBB(ISS1)/2D0) - ELSE -C..New version: Store weights for popcorn mesons, -C..get prel. popcorn weights. - DO 150 IPOS=201,1400 - PARF(IPOS)=0D0 - 150 CONTINUE - DO 160 I=138,140 - PARF(I)=0D0 - 160 CONTINUE - IPOS=200 - PARF(193)=PARJ(8) - DO 240 MR=0,7,7 - IF(MR.EQ.7) PARF(193)=PARJ(10) - SQWT=2D0*(DMB(MR+IUS0)+DMB(MR+IUS1))/ - & (1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) - QQWT=DMB(MR+IUU1)/(1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) - DO 230 NMES=0,1 - IF(NMES.EQ.1) SQWT=PARJ(2) - DO 220 KFQPOP=1,4 - IF(MR.EQ.0.AND.KFQPOP.GT.3) GOTO 220 - IF(NMES.EQ.0.AND.KFQPOP.GE.3)THEN - SQWT=DMB(MR+ISS1)/(DMB(MR+ISU0)+DMB(MR+ISU1)) - QQWT=0.5D0 - IF(MR.EQ.0) PARF(193)=PARJ(8)+PARJ(9) - IF(KFQPOP.EQ.4) SQWT=SQWT*(1D0/DMB(7+ISU1)+1D0)/2D0 - ENDIF - DO 210 KFQOLD =1,5 - IF(MR.EQ.0.AND.KFQOLD.GT.3) GOTO 210 - IF(NMES.EQ.1) THEN - IF(MR.EQ.0.AND.KFQPOP.EQ.1) GOTO 210 - IF(MR.EQ.7.AND.KFQPOP.NE.1) GOTO 210 - ENDIF - WTTOT=0D0 - WTFAIL=0D0 - DO 190 KMUL=0,5 - PJWT=PARJ(12+KMUL) - IF(KMUL.EQ.0) PJWT=1D0-PARJ(14) - IF(KMUL.EQ.1) PJWT=1D0-PARJ(15)-PARJ(16)-PARJ(17) - IF(PJWT.LE.0D0) GOTO 190 - IF(PJWT.GT.1D0) PJWT=1D0 - IMES=5*KMUL - IMIX=2*KFQOLD+10*KMUL - KFJ=2*KMUL+1 - IF(KMUL.EQ.2) KFJ=10003 - IF(KMUL.EQ.3) KFJ=10001 - IF(KMUL.EQ.4) KFJ=20003 - IF(KMUL.EQ.5) KFJ=5 - DO 180 KFQVER =1,3 - KFLA=MAX(KFQOLD,KFQVER) - KFLB=MIN(KFQOLD,KFQVER) - SWT=PARJ(11+KFLA/3+KFLA/4) - IF(KMUL.EQ.0.OR.KMUL.EQ.2) SWT=1D0-SWT - SWT=SWT*PJWT - QWT=SQWT/(2D0+SQWT) - IF(KFQVER.LT.3)THEN - IF(KFQVER.EQ.KFQPOP) QWT=(1D0-QWT)*QQWT - IF(KFQVER.NE.KFQPOP) QWT=(1D0-QWT)*(1D0-QQWT) - ENDIF - IF(KFQVER.NE.KFQOLD)THEN - IMES=IMES+1 - KFM=100*KFLA+10*KFLB+KFJ - PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PARF(IPOS+IMES)=QWT*SWT*EXP(-PARF(193)*PMM) - WTTOT=WTTOT+PARF(IPOS+IMES) - ELSE - DO 170 ID=3,5 - IF(ID.EQ.3) DWT=1D0-PARF(IMIX-1) - IF(ID.EQ.4) DWT=PARF(IMIX-1)-PARF(IMIX) - IF(ID.EQ.5) DWT=PARF(IMIX) - KFM=110*(ID-2)+KFJ - PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PARF(IPOS+5*KMUL+ID)=QWT*SWT*DWT*EXP(-PARF(193)*PMM) - IF(KMUL.EQ.0.AND.ID.GT.3) THEN - WTFAIL=WTFAIL+QWT*SWT*DWT*(1D0-PARJ(21+ID)) - PARF(IPOS+5*KMUL+ID)= - & PARF(IPOS+5*KMUL+ID)*PARJ(21+ID) - ENDIF - WTTOT=WTTOT+PARF(IPOS+5*KMUL+ID) - 170 CONTINUE - ENDIF - 180 CONTINUE - 190 CONTINUE - DO 200 IMES=1,30 - PARF(IPOS+IMES)=PARF(IPOS+IMES)/(1D0-WTFAIL) - 200 CONTINUE - IF(MR.EQ.7) PARF(140)= - & MAX(PARF(140),WTTOT/(1D0-WTFAIL)) - IF(MR.EQ.0) PARF(139-KFQPOP/3)= - & MAX(PARF(139-KFQPOP/3),WTTOT/(1D0-WTFAIL)) - IPOS=IPOS+30 - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - 240 CONTINUE - IF(PARF(139).GT.1D-10) PARF(138)=PARF(138)/PARF(139) - MSTU(121)=0 - - ENDIF - -C..Recombine diquark weights to flavour and spin ratios - PARF(151)=(2D0*(QBB(ISU0)+QBB(ISU1))+QBB(ISS1))/ - & (1D0+QBB(IUD1)+QBB(IUU1)+QBB(IUS0)+QBB(IUS1)) - PARF(152)=2D0*(QBB(IUS0)+QBB(IUS1))/(1D0+QBB(IUD1)+QBB(IUU1)) - PARF(153)=QBB(ISS1)/(QBB(ISU0)+QBB(ISU1)) - PARF(154)=QBB(IUU1)/(1D0+QBB(IUD1)+QBB(IUU1)) - PARF(155)=QBB(ISU1)/QBB(ISU0) - PARF(156)=QBB(IUS1)/QBB(IUS0) - PARF(157)=QBB(IUD1) - - PARF(161)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/ - & (1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)) - PARF(162)=2D0*(QBM(IUS0)+QBM(IUS1))/(1D0+QBM(IUD1)+QBM(IUU1)) - PARF(163)=QBM(ISS1)/(QBM(ISU0)+QBM(ISU1)) - PARF(164)=QBM(IUU1)/(1D0+QBM(IUD1)+QBM(IUU1)) - PARF(165)=QBM(ISU1)/QBM(ISU0) - PARF(166)=QBM(IUS1)/QBM(IUS0) - PARF(167)=QBM(IUD1) - - PARF(171)=(2D0*(DMB(ISU0)+DMB(ISU1))+DMB(ISS1))/ - & (1D0+DMB(IUD1)+DMB(IUU1)+DMB(IUS0)+DMB(IUS1)) - PARF(172)=2D0*(DMB(IUS0)+DMB(IUS1))/(1D0+DMB(IUD1)+DMB(IUU1)) - PARF(173)=DMB(ISS1)/(DMB(ISU0)+DMB(ISU1)) - PARF(174)=DMB(IUU1)/(1D0+DMB(IUD1)+DMB(IUU1)) - PARF(175)=DMB(ISU1)/DMB(ISU0) - PARF(176)=DMB(IUS1)/DMB(IUS0) - PARF(177)=DMB(IUD1) - - PARF(185)=DMB(7+ISU1)/DMB(7+ISU0) - PARF(186)=DMB(7+IUS1)/DMB(7+IUS0) - PARF(187)=DMB(7+IUD1) - - RETURN - END - -C*********************************************************************** - -C...PYKLIM -C...Checks generated variables against pre-set kinematical limits; -C...also calculates limits on variables used in generation. - - SUBROUTINE PYKLIM(ILIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/ - -C...Common kinematical expressions. - MINT(51)=0 - ISUB=MINT(1) - ISTSB=ISET(ISUB) - IF(ISUB.EQ.96) GOTO 100 - SQM3=VINT(63) - SQM4=VINT(64) - IF(ILIM.NE.0) THEN - IF(ABS(SQM3).LT.1D-4.AND.ABS(SQM4).LT.1D-4) THEN - CKIN09=MAX(CKIN(9),CKIN(13)) - CKIN10=MIN(CKIN(10),CKIN(14)) - CKIN11=MAX(CKIN(11),CKIN(15)) - CKIN12=MIN(CKIN(12),CKIN(16)) - ELSE - CKIN09=MAX(CKIN(9),MIN(0D0,CKIN(13))) - CKIN10=MIN(CKIN(10),MAX(0D0,CKIN(14))) - CKIN11=MAX(CKIN(11),MIN(0D0,CKIN(15))) - CKIN12=MIN(CKIN(12),MAX(0D0,CKIN(16))) - ENDIF - ENDIF - IF(ILIM.NE.1) THEN - TAU=VINT(21) - RM3=SQM3/(TAU*VINT(2)) - RM4=SQM4/(TAU*VINT(2)) - BE34=SQRT(MAX(1D-20,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - ENDIF - PTHMIN=CKIN(3) - IF(MIN(SQM3,SQM4).LT.CKIN(6)**2.AND.ISTSB.NE.1.AND.ISTSB.NE.3) - &PTHMIN=MAX(CKIN(3),CKIN(5)) - - IF(ILIM.EQ.0) THEN -C...Check generated values of tau, y*, cos(theta-hat), and tau' against -C...pre-set kinematical limits. - YST=VINT(22) - CTH=VINT(23) - TAUP=VINT(26) - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP - X1=SQRT(TAUE)*EXP(YST) - X2=SQRT(TAUE)*EXP(-YST) - XF=X1-X2 - IF(MINT(47).NE.1) THEN - IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1 - IF(CKIN(2).GE.0D0.AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1 - IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1 - IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1 - ENDIF - IF(MINT(45).NE.1) THEN - IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1 - ENDIF - IF(MINT(46).NE.1) THEN - IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1 - ENDIF - IF(MINT(45).EQ.2) THEN - IF(X1.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 - ENDIF - IF(MINT(46).EQ.2) THEN - IF(X2.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 - ENDIF - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - PTH=0.5D0*BE34*SQRT(TAU*VINT(2)*MAX(0D0,1D0-CTH**2)) - EXPY3=MAX(1D-20,(1D0+RM3-RM4+BE34*CTH)/ - & MAX(1D-20,(1D0+RM3-RM4-BE34*CTH))) - EXPY4=MAX(1D-20,(1D0-RM3+RM4-BE34*CTH)/ - & MAX(1D-20,(1D0-RM3+RM4+BE34*CTH))) - Y3=YST+0.5D0*LOG(EXPY3) - Y4=YST+0.5D0*LOG(EXPY4) - YLARGE=MAX(Y3,Y4) - YSMALL=MIN(Y3,Y4) - ETALAR=20D0 - ETASMA=-20D0 - STH=SQRT(MAX(0D0,1D0-CTH**2)) - EXSQ3=SQRT(MAX(1D-20,((1D0+RM3-RM4)*COSH(YST)+BE34*SINH(YST)* - & CTH)**2-4D0*RM3)) - EXSQ4=SQRT(MAX(1D-20,((1D0-RM3+RM4)*COSH(YST)-BE34*SINH(YST)* - & CTH)**2-4D0*RM4)) - IF(STH.GE.1D-10) THEN - EXPET3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+EXSQ3)/ - & (BE34*STH) - EXPET4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+EXSQ4)/ - & (BE34*STH) - ETA3=LOG(MIN(1D10,MAX(1D-10,EXPET3))) - ETA4=LOG(MIN(1D10,MAX(1D-10,EXPET4))) - ETALAR=MAX(ETA3,ETA4) - ETASMA=MIN(ETA3,ETA4) - ENDIF - CTS3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/EXSQ3 - CTS4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/EXSQ4 - CTSLAR=MIN(1D0,MAX(-1D0,CTS3,CTS4)) - CTSSMA=MAX(-1D0,MIN(1D0,CTS3,CTS4)) - SH=TAU*VINT(2) - RPTS=4D0*VINT(71)**2/SH - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=MAX(1D-20,2D0*RM3*RM4) - IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) - & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - THA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) - UHA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - IF(PTH.LT.PTHMIN) MINT(51)=1 - IF(CKIN(4).GE.0D0.AND.PTH.GT.CKIN(4)) MINT(51)=1 - IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1 - IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1 - IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1 - IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1 - IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1 - IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1 - IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1 - IF(THA.LT.CKIN(35)) MINT(51)=1 - IF(CKIN(36).GE.0D0.AND.THA.GT.CKIN(36)) MINT(51)=1 - IF(UHA.LT.CKIN(37)) MINT(51)=1 - IF(CKIN(38).GE.0D0.AND.UHA.GT.CKIN(38)) MINT(51)=1 - ENDIF - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1 - IF(CKIN(32).GE.0D0.AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1 - ENDIF - -C...Additional cuts on W2 (approximately) in DIS. - IF(ISUB.EQ.10.AND.MINT(43).GE.2) THEN - XBJ=X2 - IF(IABS(MINT(12)).LT.20) XBJ=X1 - Q2BJ=THA - W2BJ=Q2BJ*(1D0-XBJ)/XBJ - IF(W2BJ.LT.CKIN(39)) MINT(51)=1 - IF(CKIN(40).GT.0D0.AND.W2BJ.GT.CKIN(40)) MINT(51)=1 - ENDIF - - ELSEIF(ILIM.EQ.1) THEN -C...Calculate limits on tau -C...0) due to definition - TAUMN0=0D0 - TAUMX0=1D0 -C...1) due to limits on subsystem mass - TAUMN1=CKIN(1)**2/VINT(2) - TAUMX1=1D0 - IF(CKIN(2).GE.0D0) TAUMX1=CKIN(2)**2/VINT(2) -C...2) due to limits on pT-hat (and non-overlapping rapidity intervals) - TM3=SQRT(SQM3+PTHMIN**2) - TM4=SQRT(SQM4+PTHMIN**2) - YDCOSH=1D0 - IF(CKIN09.GT.CKIN12) YDCOSH=COSH(CKIN09-CKIN12) - TAUMN2=(TM3**2+2D0*TM3*TM4*YDCOSH+TM4**2)/VINT(2) - TAUMX2=1D0 -C...3) due to limits on pT-hat and cos(theta-hat) - CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2) - CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2) - TAUMN3=0D0 - IF(CKIN(27)*CKIN(28).GT.0D0) TAUMN3= - & (SQRT(SQM3+PTHMIN**2/(1D0-CTH2MN))+ - & SQRT(SQM4+PTHMIN**2/(1D0-CTH2MN)))**2/VINT(2) - TAUMX3=1D0 - IF(CKIN(4).GE.0D0.AND.CTH2MX.LT.1D0) TAUMX3= - & (SQRT(SQM3+CKIN(4)**2/(1D0-CTH2MX))+ - & SQRT(SQM4+CKIN(4)**2/(1D0-CTH2MX)))**2/VINT(2) -C...4) due to limits on x1 and x2 - TAUMN4=CKIN(21)*CKIN(23) - TAUMX4=CKIN(22)*CKIN(24) -C...5) due to limits on xF - TAUMN5=0D0 - TAUMX5=MAX(1D0-CKIN(25),1D0+CKIN(26)) -C...6) due to limits on that and uhat - TAUMN6=(SQM3+SQM4+CKIN(35)+CKIN(37))/VINT(2) - TAUMX6=1D0 - IF(CKIN(36).GT.0D0.AND.CKIN(38).GT.0D0) TAUMX6= - & (SQM3+SQM4+CKIN(36)+CKIN(38))/VINT(2) - -C...Net effect of all separate limits. - VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5,TAUMN6) - VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5,TAUMX6) - IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN - VINT(11)=1D0-1D-9 - VINT(31)=1D0+1D-9 - ELSEIF(MINT(47).EQ.5) THEN - VINT(31)=MIN(VINT(31),1D0-2D-10) - ELSEIF(MINT(47).GE.6) THEN - VINT(31)=MIN(VINT(31),1D0-1D-10) - ENDIF - IF(VINT(31).LE.VINT(11)) MINT(51)=1 - - ELSEIF(ILIM.EQ.2) THEN -C...Calculate limits on y* - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) - TAURT=SQRT(TAUE) -C...0) due to kinematics - YSTMN0=LOG(TAURT) - YSTMX0=-YSTMN0 -C...1) due to explicit limits - YSTMN1=CKIN(7) - YSTMX1=CKIN(8) -C...2) due to limits on x1 - YSTMN2=LOG(MAX(TAUE,CKIN(21))/TAURT) - YSTMX2=LOG(MAX(TAUE,CKIN(22))/TAURT) -C...3) due to limits on x2 - YSTMN3=-LOG(MAX(TAUE,CKIN(24))/TAURT) - YSTMX3=-LOG(MAX(TAUE,CKIN(23))/TAURT) -C...4) due to limits on xF - YEPMN4=0.5D0*ABS(CKIN(25))/TAURT - YSTMN4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMN4**2)+YEPMN4)),CKIN(25)) - YEPMX4=0.5D0*ABS(CKIN(26))/TAURT - YSTMX4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMX4**2)+YEPMX4)),CKIN(26)) -C...5) due to simultaneous limits on y-large and y-small - YEPSMN=(RM3-RM4)*SINH(CKIN09-CKIN11) - YEPSMX=(RM3-RM4)*SINH(CKIN10-CKIN12) - YDIFMN=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMN**2)-YEPSMN))) - YDIFMX=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMX**2)-YEPSMX))) - YSTMN5=0.5D0*(CKIN09+CKIN11-YDIFMN) - YSTMX5=0.5D0*(CKIN10+CKIN12+YDIFMX) -C...6) due to simultaneous limits on cos(theta-hat) and y-large or -C... y-small - CTHLIM=SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAUE*VINT(2)))) - RZMN=BE34*MAX(CKIN(27),-CTHLIM) - RZMX=BE34*MIN(CKIN(28),CTHLIM) - YEX3MX=(1D0+RM3-RM4+RZMX)/MAX(1D-10,1D0+RM3-RM4-RZMX) - YEX4MX=(1D0+RM4-RM3-RZMN)/MAX(1D-10,1D0+RM4-RM3+RZMN) - YEX3MN=MAX(1D-10,1D0+RM3-RM4+RZMN)/(1D0+RM3-RM4-RZMN) - YEX4MN=MAX(1D-10,1D0+RM4-RM3-RZMX)/(1D0+RM4-RM3+RZMX) - YSTMN6=CKIN09-0.5D0*LOG(MAX(YEX3MX,YEX4MX)) - YSTMX6=CKIN12-0.5D0*LOG(MIN(YEX3MN,YEX4MN)) - -C...Net effect of all separate limits. - VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6) - VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6) - IF(MINT(47).EQ.1) THEN - VINT(12)=-1D-9 - VINT(32)=1D-9 - ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN - VINT(12)=(1D0-1D-9)*YSTMX0 - VINT(32)=(1D0+1D-9)*YSTMX0 - ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN - VINT(12)=-(1D0+1D-9)*YSTMX0 - VINT(32)=-(1D0-1D-9)*YSTMX0 - ELSEIF(MINT(47).EQ.5) THEN - YSTEE=LOG((1D0-1D-10)/TAURT) - VINT(12)=MAX(VINT(12),-YSTEE) - VINT(32)=MIN(VINT(32),YSTEE) - ENDIF - IF(VINT(32).LE.VINT(12)) MINT(51)=1 - - ELSEIF(ILIM.EQ.3) THEN -C...Calculate limits on cos(theta-hat) - YST=VINT(22) -C...0) due to definition - CTNMN0=-1D0 - CTNMX0=0D0 - CTPMN0=0D0 - CTPMX0=1D0 -C...1) due to explicit limits - CTNMN1=MIN(0D0,CKIN(27)) - CTNMX1=MIN(0D0,CKIN(28)) - CTPMN1=MAX(0D0,CKIN(27)) - CTPMX1=MAX(0D0,CKIN(28)) -C...2) due to limits on pT-hat - CTNMN2=-SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAU*VINT(2)))) - CTPMX2=-CTNMN2 - CTNMX2=0D0 - CTPMN2=0D0 - IF(CKIN(4).GE.0D0) THEN - CTNMX2=-SQRT(MAX(0D0,1D0-4D0*CKIN(4)**2/ - & (BE34**2*TAU*VINT(2)))) - CTPMN2=-CTNMX2 - ENDIF -C...3) due to limits on y-large and y-small - CTNMN3=MIN(0D0,MAX((1D0+RM3-RM4)/BE34*TANH(CKIN11-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN10-YST))) - CTNMX3=MIN(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN12-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN09-YST)) - CTPMN3=MAX(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN09-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN12-YST)) - CTPMX3=MAX(0D0,MIN((1D0+RM3-RM4)/BE34*TANH(CKIN10-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN11-YST))) -C...4) due to limits on that - CTNMN4=-1D0 - CTNMX4=0D0 - CTPMN4=0D0 - CTPMX4=1D0 - SH=TAU*VINT(2) - IF(CKIN(35).GT.0D0) THEN - CTLIM=(1D0-RM3-RM4-2D0*CKIN(35)/SH)/BE34 - IF(CTLIM.GT.0D0) THEN - CTPMX4=CTLIM - ELSE - CTPMX4=0D0 - CTNMX4=CTLIM - ENDIF - ENDIF - IF(CKIN(36).GT.0D0) THEN - CTLIM=(1D0-RM3-RM4-2D0*CKIN(36)/SH)/BE34 - IF(CTLIM.LT.0D0) THEN - CTNMN4=CTLIM - ELSE - CTNMN4=0D0 - CTPMN4=CTLIM - ENDIF - ENDIF -C...5) due to limits on uhat - CTNMN5=-1D0 - CTNMX5=0D0 - CTPMN5=0D0 - CTPMX5=1D0 - IF(CKIN(37).GT.0D0) THEN - CTLIM=(2D0*CKIN(37)/SH-(1D0-RM3-RM4))/BE34 - IF(CTLIM.LT.0D0) THEN - CTNMN5=CTLIM - ELSE - CTNMN5=0D0 - CTPMN5=CTLIM - ENDIF - ENDIF - IF(CKIN(38).GT.0D0) THEN - CTLIM=(2D0*CKIN(38)/SH-(1D0-RM3-RM4))/BE34 - IF(CTLIM.GT.0D0) THEN - CTPMX5=CTLIM - ELSE - CTPMX5=0D0 - CTNMX5=CTLIM - ENDIF - ENDIF - -C...Net effect of all separate limits. - VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3,CTNMN4,CTNMN5) - VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3,CTNMX4,CTNMX5) - VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3,CTPMN4,CTPMN5) - VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3,CTPMX4,CTPMX5) - IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1 - - ELSEIF(ILIM.EQ.4) THEN -C...Calculate limits on tau' -C...0) due to kinematics - TAPMN0=TAU - IF(ISTSB.EQ.5.AND.VINT(201).GT.0D0) THEN - PQRAT=(VINT(201)+VINT(206))/VINT(1) - TAPMN0=(SQRT(TAU)+PQRAT)**2 - ENDIF - TAPMX0=1D0 -C...1) due to explicit limits - TAPMN1=CKIN(31)**2/VINT(2) - TAPMX1=1D0 - IF(CKIN(32).GE.0D0) TAPMX1=CKIN(32)**2/VINT(2) - -C...Net effect of all separate limits. - VINT(16)=MAX(TAPMN0,TAPMN1) - VINT(36)=MIN(TAPMX0,TAPMX1) - IF(MINT(47).EQ.1) THEN - VINT(16)=1D0-1D-9 - VINT(36)=1D0+1D-9 - ELSEIF(MINT(47).EQ.5) THEN - VINT(36)=MIN(VINT(36),1D0-2D-10) - ELSEIF(MINT(47).EQ.6.OR.MINT(47).EQ.7) THEN - VINT(36)=MIN(VINT(36),1D0-1D-10) - ENDIF - IF(VINT(36).LE.VINT(16)) MINT(51)=1 - - ENDIF - RETURN - -C...Special case for low-pT and multiple interactions: -C...effective kinematical limits for tau, y*, cos(theta-hat). - 100 IF(ILIM.EQ.0) THEN - ELSEIF(ILIM.EQ.1) THEN - IF(MSTP(82).LE.1) THEN - VINT(11)=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ - & VINT(2) - ELSE - VINT(11)=(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/VINT(2) - ENDIF - VINT(31)=1D0 - ELSEIF(ILIM.EQ.2) THEN - VINT(12)=0.5D0*LOG(VINT(21)) - VINT(32)=-VINT(12) - ELSEIF(ILIM.EQ.3) THEN - IF(MSTP(82).LE.1) THEN - ST2EFF=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ - & (VINT(21)*VINT(2)) - ELSE - ST2EFF=0.01D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ - & (VINT(21)*VINT(2)) - ENDIF - VINT(13)=-SQRT(MAX(0D0,1D0-ST2EFF)) - VINT(33)=0D0 - VINT(14)=0D0 - VINT(34)=-VINT(13) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYKMAP -C...Maps a uniform distribution into a distribution of a kinematical -C...variable according to one of the possibilities allowed. It is -C...assumed that kinematical limits have been set by a PYKLIM call. - - SUBROUTINE PYKMAP(IVAR,MVAR,VVAR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Convert VVAR to tau variable. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - IF(IVAR.EQ.1) THEN - TAUMIN=VINT(11) - TAUMAX=VINT(31) - IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN - TAURE=VINT(73) - GAMRE=VINT(74) - ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN - TAURE=VINT(75) - GAMRE=VINT(76) - ENDIF - IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN - TAU=1D0 - ELSEIF(MVAR.EQ.1) THEN - TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR - ELSEIF(MVAR.EQ.2) THEN - TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR) - ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN - RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX - TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN) - ELSEIF(MVAR.EQ.4.OR.MVAR.EQ.6) THEN - AUPP=ATAN((TAUMAX-TAURE)/GAMRE) - ALOW=ATAN((TAUMIN-TAURE)/GAMRE) - TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR) - ELSEIF(MINT(47).EQ.5) THEN - AUPP=LOG(MAX(2D-10,1D0-TAUMAX)) - ALOW=LOG(MAX(2D-10,1D0-TAUMIN)) - TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ELSE - AUPP=LOG(MAX(1D-10,1D0-TAUMAX)) - ALOW=LOG(MAX(1D-10,1D0-TAUMIN)) - TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ENDIF - VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU)) - -C...Convert VVAR to y* variable. - ELSEIF(IVAR.EQ.2) THEN - YSTMIN=VINT(12) - YSTMAX=VINT(32) - TAUE=VINT(21) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) - IF(MINT(47).EQ.1) THEN - YST=0D0 - ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN - YST=-0.5D0*LOG(TAUE) - ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN - YST=0.5D0*LOG(TAUE) - ELSEIF(MVAR.EQ.1) THEN - YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR) - ELSEIF(MVAR.EQ.2) THEN - YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1D0-VVAR) - ELSEIF(MVAR.EQ.3) THEN - AUPP=ATAN(EXP(YSTMAX)) - ALOW=ATAN(EXP(YSTMIN)) - YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR)) - ELSEIF(MVAR.EQ.4) THEN - YST0=-0.5D0*LOG(TAUE) - AUPP=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)) - ALOW=LOG(MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - YST=YST0-LOG(1D0+EXP(ALOW+VVAR*(AUPP-ALOW))) - ELSE - YST0=-0.5D0*LOG(TAUE) - AUPP=LOG(MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - ALOW=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)) - YST=LOG(1D0+EXP(AUPP+VVAR*(ALOW-AUPP)))-YST0 - ENDIF - VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST)) - -C...Convert VVAR to cos(theta-hat) variable. - ELSEIF(IVAR.EQ.3) THEN - RM34=MAX(1D-20,2D0*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2) - RSQM=1D0+RM34 - IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) - & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) - CTNMIN=VINT(13) - CTNMAX=VINT(33) - CTPMIN=VINT(14) - CTPMAX=VINT(34) - IF(MVAR.EQ.1) THEN - ANEG=CTNMAX-CTNMIN - APOS=CTPMAX-CTPMIN - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP - ENDIF - ELSEIF(MVAR.EQ.2) THEN - RMNMIN=MAX(RM34,RSQM-CTNMIN) - RMNMAX=MAX(RM34,RSQM-CTNMAX) - RMPMIN=MAX(RM34,RSQM-CTPMIN) - RMPMAX=MAX(RM34,RSQM-CTPMAX) - ANEG=LOG(RMNMIN/RMNMAX) - APOS=LOG(RMPMIN/RMPMAX) - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP - ENDIF - ELSEIF(MVAR.EQ.3) THEN - RMNMIN=MAX(RM34,RSQM+CTNMIN) - RMNMAX=MAX(RM34,RSQM+CTNMAX) - RMPMIN=MAX(RM34,RSQM+CTPMIN) - RMPMAX=MAX(RM34,RSQM+CTPMAX) - ANEG=LOG(RMNMAX/RMNMIN) - APOS=LOG(RMPMAX/RMPMIN) - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM - ENDIF - ELSEIF(MVAR.EQ.4) THEN - RMNMIN=MAX(RM34,RSQM-CTNMIN) - RMNMAX=MAX(RM34,RSQM-CTNMAX) - RMPMIN=MAX(RM34,RSQM-CTPMIN) - RMPMAX=MAX(RM34,RSQM-CTPMAX) - ANEG=1D0/RMNMAX-1D0/RMNMIN - APOS=1D0/RMPMAX-1D0/RMPMIN - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RSQM-1D0/(1D0/RMNMIN+ANEG*VCTN) - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RSQM-1D0/(1D0/RMPMIN+APOS*VCTP) - ENDIF - ELSEIF(MVAR.EQ.5) THEN - RMNMIN=MAX(RM34,RSQM+CTNMIN) - RMNMAX=MAX(RM34,RSQM+CTNMAX) - RMPMIN=MAX(RM34,RSQM+CTPMIN) - RMPMAX=MAX(RM34,RSQM+CTPMAX) - ANEG=1D0/RMNMIN-1D0/RMNMAX - APOS=1D0/RMPMIN-1D0/RMPMAX - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=1D0/(1D0/RMNMIN-ANEG*VCTN)-RSQM - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=1D0/(1D0/RMPMIN-APOS*VCTP)-RSQM - ENDIF - ENDIF - IF(CTH.LT.0D0) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH)) - IF(CTH.GT.0D0) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH)) - VINT(23)=CTH - -C...Convert VVAR to tau' variable. - ELSEIF(IVAR.EQ.4) THEN - TAU=VINT(21) - TAUPMN=VINT(16) - TAUPMX=VINT(36) - IF(MINT(47).EQ.1) THEN - TAUP=1D0 - ELSEIF(MVAR.EQ.1) THEN - TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR - ELSEIF(MVAR.EQ.2) THEN - AUPP=(1D0-TAU/TAUPMX)**4 - ALOW=(1D0-TAU/TAUPMN)**4 - TAUP=TAU/MAX(1D-10,1D0-(ALOW+(AUPP-ALOW)*VVAR)**0.25D0) - ELSEIF(MINT(47).EQ.5) THEN - AUPP=LOG(MAX(2D-10,1D0-TAUPMX)) - ALOW=LOG(MAX(2D-10,1D0-TAUPMN)) - TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ELSE - AUPP=LOG(MAX(1D-10,1D0-TAUPMX)) - ALOW=LOG(MAX(1D-10,1D0-TAUPMN)) - TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ENDIF - VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP)) - -C...Selection of extra variables needed in 2 -> 3 process: -C...pT1, pT2, phi1, phi2, y3 for three outgoing particles. -C...Since no options are available, the functions of PYKLIM -C...and PYKMAP are joint for these choices. - ELSEIF(IVAR.EQ.5) THEN - -C...Read out total energy and particle masses. - MINT(51)=0 - MPTPK=1 - IF(ISUB.EQ.123.OR.ISUB.EQ.124.OR.ISUB.EQ.173.OR.ISUB.EQ.174 - & .OR.ISUB.EQ.178.OR.ISUB.EQ.179.OR.ISUB.EQ.351.OR.ISUB.EQ.352) - & MPTPK=2 - SHP=VINT(26)*VINT(2) - SHPR=SQRT(SHP) - PM1=VINT(201) - PM2=VINT(206) - PM3=SQRT(VINT(21))*VINT(1) - IF(PM1+PM2+PM3.GT.0.9999D0*SHPR) THEN - MINT(51)=1 - RETURN - ENDIF - PMRS1=VINT(204)**2 - PMRS2=VINT(209)**2 - -C...Specify coefficients of pT choice; upper and lower limits. - IF(MPTPK.EQ.1) THEN - HWT1=0.4D0 - HWT2=0.4D0 - ELSE - HWT1=0.05D0 - HWT2=0.05D0 - ENDIF - HWT3=1D0-HWT1-HWT2 - PTSMX1=((SHP-PM1**2-(PM2+PM3)**2)**2-(2D0*PM1*(PM2+PM3))**2)/ - & (4D0*SHP) - IF(CKIN(52).GT.0D0) PTSMX1=MIN(PTSMX1,CKIN(52)**2) - PTSMN1=CKIN(51)**2 - PTSMX2=((SHP-PM2**2-(PM1+PM3)**2)**2-(2D0*PM2*(PM1+PM3))**2)/ - & (4D0*SHP) - IF(CKIN(54).GT.0D0) PTSMX2=MIN(PTSMX2,CKIN(54)**2) - PTSMN2=CKIN(53)**2 - -C...Select transverse momenta according to -C...dp_T^2 * (a + b/(M^2 + p_T^2) + c/(M^2 + p_T^2)^2). - HMX=PMRS1+PTSMX1 - HMN=PMRS1+PTSMN1 - IF(HMX.LT.1.0001D0*HMN) THEN - MINT(51)=1 - RETURN - ENDIF - HDE=PTSMX1-PTSMN1 - RPT=PYR(0) - IF(RPT.LT.HWT1) THEN - PTS1=PTSMN1+PYR(0)*HDE - ELSEIF(RPT.LT.HWT1+HWT2) THEN - PTS1=MAX(PTSMN1,HMN*(HMX/HMN)**PYR(0)-PMRS1) - ELSE - PTS1=MAX(PTSMN1,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS1) - ENDIF - WTPTS1=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS1+PTS1))+ - & HWT3*HMN*HMX/(PMRS1+PTS1)**2) - HMX=PMRS2+PTSMX2 - HMN=PMRS2+PTSMN2 - IF(HMX.LT.1.0001D0*HMN) THEN - MINT(51)=1 - RETURN - ENDIF - HDE=PTSMX2-PTSMN2 - RPT=PYR(0) - IF(RPT.LT.HWT1) THEN - PTS2=PTSMN2+PYR(0)*HDE - ELSEIF(RPT.LT.HWT1+HWT2) THEN - PTS2=MAX(PTSMN2,HMN*(HMX/HMN)**PYR(0)-PMRS2) - ELSE - PTS2=MAX(PTSMN2,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS2) - ENDIF - WTPTS2=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS2+PTS2))+ - & HWT3*HMN*HMX/(PMRS2+PTS2)**2) - -C...Select azimuthal angles and check pT choice. - PHI1=PARU(2)*PYR(0) - PHI2=PARU(2)*PYR(0) - PHIR=PHI2-PHI1 - PTS3=MAX(0D0,PTS1+PTS2+2D0*SQRT(PTS1*PTS2)*COS(PHIR)) - IF(PTS3.LT.CKIN(55)**2.OR.(CKIN(56).GT.0D0.AND.PTS3.GT. - & CKIN(56)**2)) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Calculate transverse masses and check phase space not closed. - PMS1=PM1**2+PTS1 - PMS2=PM2**2+PTS2 - PMS3=PM3**2+PTS3 - PMT1=SQRT(PMS1) - PMT2=SQRT(PMS2) - PMT3=SQRT(PMS3) - PM12=(PMT1+PMT2)**2 - IF(PMT1+PMT2+PMT3.GT.0.9999D0*SHPR) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Select rapidity for particle 3 and check phase space not closed. - Y3MAX=LOG((SHP+PMS3-PM12+SQRT(MAX(0D0,(SHP-PMS3-PM12)**2- - & 4D0*PMS3*PM12)))/(2D0*SHPR*PMT3)) - IF(Y3MAX.LT.1D-6) THEN - MINT(51)=1 - RETURN - ENDIF - Y3=(2D0*PYR(0)-1D0)*0.999999D0*Y3MAX - PZ3=PMT3*SINH(Y3) - PE3=PMT3*COSH(Y3) - -C...Find momentum transfers in two mirror solutions (in 1-2 frame). - PZ12=-PZ3 - PE12=SHPR-PE3 - PMS12=PE12**2-PZ12**2 - SQL12=SQRT(MAX(0D0,(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2)) - IF(SQL12.LT.1D-6*SHP) THEN - MINT(51)=1 - RETURN - ENDIF - PMM1=PMS12+PMS1-PMS2 - PMM2=PMS12+PMS2-PMS1 - TFAC=-SHPR/(2D0*PMS12) - T1P=TFAC*(PE12-PZ12)*(PMM1-SQL12) - T1N=TFAC*(PE12-PZ12)*(PMM1+SQL12) - T2P=TFAC*(PE12+PZ12)*(PMM2-SQL12) - T2N=TFAC*(PE12+PZ12)*(PMM2+SQL12) - -C...Construct relative mirror weights and make choice. - IF(MPTPK.EQ.1.OR.ISUB.EQ.351.OR.ISUB.EQ.352) THEN - WTPU=1D0 - WTNU=1D0 - ELSE - WTPU=1D0/((T1P-PMRS1)*(T2P-PMRS2))**2 - WTNU=1D0/((T1N-PMRS1)*(T2N-PMRS2))**2 - ENDIF - WTP=WTPU/(WTPU+WTNU) - WTN=WTNU/(WTPU+WTNU) - EPS=1D0 - IF(WTN.GT.PYR(0)) EPS=-1D0 - -C...Store result of variable choice and associated weights. - VINT(202)=PTS1 - VINT(207)=PTS2 - VINT(203)=PHI1 - VINT(208)=PHI2 - VINT(205)=WTPTS1 - VINT(210)=WTPTS2 - VINT(211)=Y3 - VINT(212)=Y3MAX - VINT(213)=EPS - IF(EPS.GT.0D0) THEN - VINT(214)=1D0/WTP - VINT(215)=T1P - VINT(216)=T2P - ELSE - VINT(214)=1D0/WTN - VINT(215)=T1N - VINT(216)=T2N - ENDIF - VINT(217)=-0.5D0*TFAC*(PE12-PZ12)*(PMM2+EPS*SQL12) - VINT(218)=-0.5D0*TFAC*(PE12+PZ12)*(PMM1+EPS*SQL12) - VINT(219)=0.5D0*(PMS12-PTS3) - VINT(220)=SQL12 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYLAMF -C...The standard lambda function. - - FUNCTION PYLAMF(X,Y,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYLAMF,X,Y,Z - - PYLAMF=(X-(Y+Z))**2-4D0*Y*Z - IF(PYLAMF.LT.0D0) PYLAMF=0D0 - - RETURN - END - -C********************************************************************* - -C...PYLDCM -C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 -C...processes. - - SUBROUTINE PYLDCM(A,N,NP,INDX,D) - IMPLICIT NONE - INTEGER N,NP,INDX(N) - REAL*8 D,TINY - COMPLEX*16 A(NP,NP) - PARAMETER (TINY=1.0D-20) - INTEGER I,IMAX,J,K - REAL*8 AAMAX,VV(6),DUM - COMPLEX*16 SUM,DUMC - - D=1D0 - DO 110 I=1,N - AAMAX=0D0 - DO 100 J=1,N - IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) - 100 CONTINUE - IF (AAMAX.EQ.0D0) print*, 'SINGULAR MATRIX IN PYLDCM' - VV(I)=1D0/AAMAX - 110 CONTINUE - DO 180 J=1,N - DO 130 I=1,J-1 - SUM=A(I,J) - DO 120 K=1,I-1 - SUM=SUM-A(I,K)*A(K,J) - 120 CONTINUE - A(I,J)=SUM - 130 CONTINUE - AAMAX=0D0 - DO 150 I=J,N - SUM=A(I,J) - DO 140 K=1,J-1 - SUM=SUM-A(I,K)*A(K,J) - 140 CONTINUE - A(I,J)=SUM - DUM=VV(I)*ABS(SUM) - IF (DUM.GE.AAMAX) THEN - IMAX=I - AAMAX=DUM - ENDIF - 150 CONTINUE - IF (J.NE.IMAX)THEN - DO 160 K=1,N - DUMC=A(IMAX,K) - A(IMAX,K)=A(J,K) - A(J,K)=DUMC - 160 CONTINUE - D=-D - VV(IMAX)=VV(J) - ENDIF - INDX(J)=IMAX - IF(ABS(A(J,J)).EQ.0D0) A(J,J)=DCMPLX(TINY,0D0) - IF(J.NE.N)THEN - DO 170 I=J+1,N - A(I,J)=A(I,J)/A(J,J) - 170 CONTINUE - ENDIF - 180 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYLIST -C...Gives program heading, or lists an event, or particle -C...data, or current parameter values. - - SUBROUTINE PYLIST(MLIST) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...HEPEVT commonblock. - PARAMETER (NMXHEP=4000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) - DOUBLE PRECISION PHEP,VHEP - SAVE /HEPEVT/ - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays, character variables and data. - 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 PYLOGO - 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) GOTO 120 - IF(MSTU(15).EQ.0.AND.K(I,1).LE.0) GOTO 120 - IF(MSTU(15).EQ.1.AND.K(I,1).LT.0) GOTO 120 - -C...Get particle name, pad it and check it is not too long. - CALL PYNAME(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=PYCOMP(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 - IF((K(I,1).EQ.41.OR.K(I,1).EQ.51).AND.LEN+2*LDL+3.LE.LMX) - & CHAC(LMX-1:LMX-1)='I' - -C...Write data for particle/jet. - IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999D0) 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.99999D0) 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.OR.K(I,1).EQ.42.OR.K(I,1).EQ.52)) 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)=PYP(0,J) - 130 CONTINUE - IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999D0) THEN - WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) - ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999D0) 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...Simple listing of HEPEVT entries (mainly for test purposes). - ELSEIF(MLIST.EQ.5) THEN - WRITE(MSTU(11),7500) - DO 140 I=1,NHEP - IF(ISTHEP(I).EQ.0) GOTO 140 - WRITE(MSTU(11),7600) I,ISTHEP(I),IDHEP(I),JMOHEP(1,I), - & JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),(PHEP(J,I),J=1,5) - 140 CONTINUE - - -C...Simple listing of user-process entries (mainly for test purposes). - ELSEIF(MLIST.EQ.7) THEN - WRITE(MSTU(11),7300) - DO 150 I=1,NUP - WRITE(MSTU(11),7400) I,ISTUP(I),IDUP(I),MOTHUP(1,I), - & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5) - 150 CONTINUE - -C...Give simple list of KF codes defined in program. - ELSEIF(MLIST.EQ.11) THEN - WRITE(MSTU(11),6600) - DO 160 KF=1,80 - CALL PYNAME(KF,CHAP) - CALL PYNAME(-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 - 160 CONTINUE - DO 190 KFLS=1,3,2 - DO 180 KFLA=1,5 - DO 170 KFLB=1,KFLA-(3-KFLS)/2 - KF=1000*KFLA+100*KFLB+KFLS - CALL PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 170 CONTINUE - 180 CONTINUE - 190 CONTINUE - DO 220 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 210 KFLB=1,5 - DO 200 KFLC=1,KFLB-1 - KF=10000*KFLR+100*KFLB+10*KFLC+KFLS - CALL PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - IF(KF.EQ.311) THEN - KFK=130 - CALL PYNAME(KFK,CHAP) - WRITE(MSTU(11),6700) KFK,CHAP - KFK=310 - CALL PYNAME(KFK,CHAP) - WRITE(MSTU(11),6700) KFK,CHAP - ENDIF - 200 CONTINUE - KF=10000*KFLR+110*KFLB+KFLS - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - 210 CONTINUE - 220 CONTINUE - KF=100443 - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - KF=100553 - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - DO 260 KFLSP=1,3 - KFLS=2+2*(KFLSP/3) - DO 250 KFLA=1,5 - DO 240 KFLB=1,KFLA - DO 230 KFLC=1,KFLB - IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) - & GOTO 230 - IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 230 - 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 PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 230 CONTINUE - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - DO 270 KC=1,500 - KF=KCHG(KC,4) - IF(KF.LT.1000000) GOTO 270 - CALL PYNAME(KF,CHAP) - CALL PYNAME(-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 - 270 CONTINUE - -C...List parton/particle data table. Check whether to be listed. - ELSEIF(MLIST.EQ.12) THEN - WRITE(MSTU(11),6800) - DO 300 KC=1,MSTU(6) - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 300 - IF(KF.LT.MSTU(1).OR.(MSTU(2).GT.0.AND.KF.GT.MSTU(2))) - & GOTO 300 - -C...Find particle name and mass. Print information. - CALL PYNAME(KF,CHAP) - IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 300 - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,(KCHG(KC,J1),J1=1,3), - & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) - -C...Particle decay: channel number, branching ratios, matrix element, -C...decay products. - DO 290 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - DO 280 J=1,5 - CALL PYNAME(KFDP(IDC,J),CHAD(J)) - 280 CONTINUE - WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), - & (CHAD(J),J=1,5) - 290 CONTINUE - 300 CONTINUE - -C...List parameter value table. - ELSEIF(MLIST.EQ.13) THEN - WRITE(MSTU(11),7100) - DO 310 I=1,200 - WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) - 310 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,1X,A12,1X,I2,I8,1X,I4,5F9.3) - 5500 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.2) - 5600 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.1) - 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),5F13.5) - 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,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,I9,4X,A16,6X,I9,4X,A16) - 6800 FORMAT(///30X,'Particle/parton data table'//8X,'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,I9,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), - &1X,1P,E13.5,3X,I2) - 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F10.6,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) - 7300 FORMAT(/10X,'Event listing of user process at input (simplified)' - &//' I IST ID Mothers Colours p_x p_y p_z', - &' E m') - 7400 FORMAT(1X,I3,I3,I8,2I4,2I5,5F9.3) - 7500 FORMAT(/10X,'Event listing of HEPEVT common block (simplified)' - &//' I IST ID Mothers Daughters p_x p_y p_z', - &' E m') - 7600 FORMAT(1X,I4,I2,I8,4I5,5F9.3) - - RETURN - END - -C********************************************************************* - -C...PYLOGO -C...Writes a logo for the program. - - SUBROUTINE PYLOGO - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter for length of information block. - PARAMETER (IREFER=24) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYDAT1/,/PYPARS/ -C...Local arrays and character variables. - INTEGER IDATI(6) - CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(2*IREFER)*36, LINE*79, - &VERS*1, SUBV*3, DATE*2, YEAR*4, HOUR*2, MINU*2, SECO*2 - -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,19)/ - &' *......* ', - &' *:::!!:::::::::::* ', - &' *::::::!!::::::::::::::* ', - &' *::::::::!!::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *::::::::!!::::::::::::::::*! ', - &' *::::::!!::::::::::::::* !! ', - &' !! *:::!!:::::::::::* !! ', - &' !! !* -><- * !! ', - &' !! !! !! ', - &' !! !! !! ', - &' !! !! ', - &' !! lh !! ', - &' !! !! ', - &' !! hh !! ', - &' !! ll !! ', - &' !! !! ', - &' !! '/ - DATA (LOGO(J),J=20,38)/ - &'Welcome to the Lund Monte Carlo!', - &' ', - &'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', - &' ', - &'This is PYTHIA version x.xxx ', - &'Last date of change: xx xxx 200x', - &' ', - &'Now is xx xxx 200x at xx:xx:xx ', - &' ', - &'Disclaimer: this program comes ', - &'without any guarantees. Beware ', - &'of errors and use common sense ', - &'when interpreting results. ', - &' ', - &'Copyright T. Sjostrand (2004) '/ - DATA (REFER(J),J=1,18)/ - &'An archive of program versions and d', - &'ocumentation is found on the web: ', - &'http://www.thep.lu.se/~torbjorn/Pyth', - &'ia.html ', - &' ', - &' ', - &'When you cite this program, currentl', - &'y the official reference is ', - &'T. Sjostrand, P. Eden, C. Friberg, L', - &'. Lonnblad, G. Miu, S. Mrenna and ', - &'E. Norrbin, Computer Physics Commun.', - &' 135 (2001) 238. ', - &'The large manual is ', - &' ', - &'T. Sjostrand, L. Lonnblad and S. Mre', - &'nna, LU TP 01-21 [hep-ph/0108264]. ', - &'Also remember that the program, to a', - &' large extent, represents original '/ - DATA (REFER(J),J=19,36)/ - &'physics research. Other publications', - &' of special relevance to your ', - &'studies may therefore deserve separa', - &'te mention. ', - &' ', - &' ', - &'Main author: Torbjorn Sjostrand; Dep', - &'artment of Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 48 16; e-ma', - &'il: torbjorn@thep.lu.se ', - &'Author: Leif Lonnblad; Department of', - &' Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 77 80; e-ma', - &'il: leif@thep.lu.se '/ - DATA (REFER(J),J=37,2*IREFER)/ - &'Author: Stephen Mrenna; Computing Di', - &'vision, Simulations Group, ', - &' Fermi National Accelerator Laborat', - &'ory, MS 234, Batavia, IL 60510, USA;', - &' phone: + 1 - 630 - 840 - 2556; e-m', - &'ail: mrenna@fnal.gov ', - &'Author: Peter Skands; Department of ', - &'Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 31 92; e-ma', - &'il: zeiler@thep.lu.se '/ - -C...Check that PYDATA linked. - IF(MSTP(183)/10.NE.199.AND.MSTP(183)/10.NE.200) THEN - WRITE(*,'(1X,A)') - & 'Error: PYDATA has not been linked.' - WRITE(*,'(1X,A)') 'Execution stopped!' - STOP - -C...Write current version number and current date+time. - ELSE - WRITE(VERS,'(I1)') MSTP(181) - LOGO(28)(24:24)=VERS - WRITE(SUBV,'(I3)') MSTP(182) - LOGO(28)(26:28)=SUBV - IF(MSTP(182).LT.100) LOGO(28)(26:26)='0' - WRITE(DATE,'(I2)') MSTP(185) - LOGO(29)(22:23)=DATE - LOGO(29)(25:27)=MONTH(MSTP(184)) - WRITE(YEAR,'(I4)') MSTP(183) - LOGO(29)(29:32)=YEAR - CALL PYTIME(IDATI) - IF(IDATI(1).LE.0) THEN - LOGO(31)=' ' - ELSE - WRITE(DATE,'(I2)') IDATI(3) - LOGO(31)(8:9)=DATE - LOGO(31)(11:13)=MONTH(MAX(1,MIN(12,IDATI(2)))) - WRITE(YEAR,'(I4)') IDATI(1) - LOGO(31)(15:18)=YEAR - WRITE(HOUR,'(I2)') IDATI(4) - LOGO(31)(23:24)=HOUR - WRITE(MINU,'(I2)') IDATI(5) - LOGO(31)(26:27)=MINU - IF(IDATI(5).LT.10) LOGO(31)(26:26)='0' - WRITE(SECO,'(I2)') IDATI(6) - LOGO(31)(29:30)=SECO - IF(IDATI(6).LT.10) LOGO(31)(29:29)='0' - ENDIF - ENDIF - -C...Loop over lines in header. Define page feed and side borders. - DO 100 ILIN=1,29+IREFER - 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.GE.28+IREFER) THEN - LINE(4:77)='***********************************************'// - & '***************************' - ELSEIF(ILIN.GE.6.AND.ILIN.LE.24) THEN - LINE(6:37)=LOGO(ILIN-5) - LINE(44:75)=LOGO(ILIN+14) - ELSEIF(ILIN.GE.26.AND.ILIN.LE.25+IREFER) THEN - LINE(5:40)=REFER(2*ILIN-51) - LINE(41:76)=REFER(2*ILIN-50) - ENDIF - -C...Write lines to appropriate unit. - WRITE(MSTU(11),'(A79)') LINE - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYMAEL -C...Auxiliary to PYSHOW. -C...Matrix elements for gluon (or photon) emission from -C...a two-body state; to be used by the parton shower routine. -C...Here X_i = 2 E_i/E_cm, R_i = m_i/E_cm and -C...1/sigma_0 d(sigma)/d(x_1)d(x_2) = -C... = (alpha-strong/2 pi) * CF * PYMAEL, -C...i.e. normalization is such that one recovers the familiar -C...(X1**2+X2**2)/((1-X1)*(1-X2)) for the massless case. -C...Coupling structure: -C...NI = 6- 9 : eikonal soft-gluon expression (spin-independent) -C... = 11-14 : V -> q qbar (V = vector/axial vector colour singlet) -C... = 16-19 : q -> q V -C... = 21-24 : S -> q qbar (S = scalar/pseudoscalar colour singlet) -C... = 26-29 : q -> q S -C... = 31-34 : V -> ~q ~qbar (~q = squark) -C... = 36-39 : ~q -> ~q V -C... = 41-44 : S -> ~q ~qbar -C... = 46-49 : ~q -> ~q S -C... = 51-54 : chi -> q ~qbar (chi = neutralino/chargino) -C... = 56-59 : ~q -> q chi -C... = 61-64 : q -> ~q chi -C... = 66-69 : ~g -> q ~qbar -C... = 71-74 : ~q -> q ~g -C... = 76-79 : q -> ~q ~g -C... = 81-84 : (9/4)*(eikonal) for gg -> ~g ~g -C...Note that the order of the decay products is important. -C...In each set of four, the variants are ordered as: -C...ICOMBI = 1 : pure non-gamma5, i.e. vector/scalar/... -C... = 2 : pure gamma5, i.e. axial vector/pseudoscalar/.... -C... = 3 : mixture alpha*(ICOMBI=1) + (1-alpha)*(ICOMBI=2) -C... = 4 : mixture (ICOMBI=1) +- (ICOMBI=2) - - FUNCTION PYMAEL(NI,X1,X2,R1,R2,ALPHA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Check input values. Return zero outside allowed phase space. - PYMAEL=0D0 - IF(X1.LE.2D0*R1.OR.X1.GE.1D0+R1**2-R2**2) RETURN - IF(X2.LE.2D0*R2.OR.X2.GE.1D0+R2**2-R1**2) RETURN - IF(X1+X2.LE.1D0+(R1+R2)**2) RETURN - IF((2D0-2D0*X1-2D0*X2+X1*X2+2D0*R1**2+2D0*R2**2)**2.GE. - &(X1**2-4D0*R1**2)*(X2**2-4D0*R2**2)) RETURN - ALPCOR=MAX(0D0,MIN(1D0,ALPHA)) - -C...Initial values and flags. - ICLASS=NI/5 - ICOMBI=NI-5*ICLASS - ISSET1=0 - ISSET2=0 - ISSET4=0 - -C... Phase space. - PS=SQRT((1D0-(R1+R2)**2)*(1D0-(R1-R2)**2)) - -C...Eikonal expression; also acts as default. - IF(ICLASS.LE.1.OR.ICLASS.GE.17.OR.ICOMBI.EQ.0) THEN - RLO=PS - IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN - ANUM=0D0 - ELSEIF(ICOMBI.EQ.2) THEN - ANUM=(2D0-X1-X2)**2 - ELSEIF(ICOMBI.EQ.3) THEN - ANUM=ALPCOR*(2D0-X1-X2)**2 - ELSE - ANUM=0.5D0*(2D0-X1-X2)**2 - ENDIF - RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ - & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- - & R1**2/(1D0+R2**2-R1**2-X2)**2- - & R2**2/(1D0+R1**2-R2**2-X1)**2) - ICOMBI=0 - -C...V -> q qbar (V = gamma*/Z0/W+-/...). - ELSEIF(ICLASS.EQ.2) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(2-R1**2-R1**4+6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 - RFO1=-1.D0*(3+6*R1**2+R1**4-6*R1*R2+6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2+6*R1*R2**3+R2**4-3*X1+6*R1*R2*X1 - & +2*R2**2*X1+X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2) - & +6*R1*R2*(2-X1-X2)-R2**2*(2-X1-X2)-2*X1*(2-X1-X2) - & -5*R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) - & -3*(2-X1-X2)**2-3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2 - & +2*X1*(2-X1-X2)**2+(2-X1-X2)**3-X2)/ - & (-1+R1**2-R2**2+X2)**2 - RFO1=RFO1-2*(-3+R1**2-6*R1*R2+6*R1**3*R2+3*R2**2-4*R1**2*R2**2 - & +6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 - & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)+3*R1*R2*(2-X1 - & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) - & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2+R1*R2*(2 - & -X1-X2)**2+X1*(2-X1-X2)**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO1=RFO1-1.D0*(-1+2*R1**2+R1**4+6*R1*R2+6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2+6*R1*R2**3+R2**4-X1-2*R1**2*X1-6*R1*R2*X1 - & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2 - & -X1-X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2* - & (2-X1-X2)+X2)/(-1-R1**2+R2**2+X1)**2 - RFO1=RFO1/2.D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(2-R1**2-R1**4-6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 - RFO2=-1*(3+6*R1**2+R1**4+6*R1*R2-6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2-6*R1*R2**3+R2**4-3*X1-6*R1*R2*X1+2*R2**2*X1 - & +X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2)-6*R1*R2*(2-X1-X2) - & -R2**2*(2-X1-X2)-2*X1*(2-X1-X2)-5*R1**2*X1*(2-X1-X2) - & +R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2)-3*(2-X1-X2)**2 - & -3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2+2*X1*(2-X1-X2)**2 - & +(2-X1-X2)**3-X2)/(-1+R1**2-R2**2+X2)**2 - RFO2=RFO2-2*(-3+R1**2+6*R1*R2-6*R1**3*R2+3*R2**2-4*R1**2*R2**2 - & -6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 - & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)-3*R1*R2*(2-X1 - & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) - & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2-R1*R2*(2 - & -X1-X2)**2+X1*(2-X1-X2)**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO2=RFO2-1*(-1+2*R1**2+R1**4-6*R1*R2-6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2-6*R1*R2**3+R2**4-X1-2*R1**2*X1+6*R1*R2*X1 - & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2-X1 - & -X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) - & +X2)/(-1-R1**2+R2**2+X1)**2 - RFO2=RFO2/2.D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(2D0-R1**2-R1**4-R2**2+2D0*R1**2*R2**2-R2**4)/2D0 - RFO4=(1-R1**4+6*R1**2*R2**2-R2**4+X1+3*R1**2*X1-9*R2**2*X1 - & -3*X1**2-R1**2*X1**2+3*R2**2*X1**2+X1**3-X2-R1**2*X2 - & +R2**2*X2-R1**2*X1*X2+R2**2*X1*X2+X1**2*X2)/ - & (-1-R1**2+R2**2+X1)**2 - RFO4=RFO4 - & -2*(1+R1**2+R2**2-4*R1**2*R2**2+R1**2*X1+2*R2**2*X1-X1**2 - & -R2**2*X1**2+2*R1**2*X2+R2**2*X2-3*X1*X2+X1**2*X2-X2**2 - & -R1**2*X2**2+X1*X2**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO4=RFO4+(1-R1**4+6*R1**2*R2**2-R2**4-X1+R1**2*X1-R2**2*X1+X2 - & -9*R1**2*X2+3*R2**2*X2+R1**2*X1*X2-R2**2*X1*X2-3*X2**2 - & +3*R1**2*X2**2-R2**2*X2**2+X1*X2**2+X2**3)/ - & (-1+R1**2-R2**2+X2)**2 - RFO4=RFO4/2.D0 - ISSET4=1 - ENDIF - -C...q -> q V. - ELSEIF(ICLASS.EQ.3) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4+R2**2-6D0*R1*R2**2 - & +R1**2*R2**2-2D0*R2**4) - RFO1=2*(-1+R1-2*R1**2+2*R1**3-R1**4+R1**5-R2**2+R1*R2**2 - & -5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4+2*X1-2*R1*X1 - & +2*R1**2*X1-2*R1**3*X1+2*R2**2*X1+5*R1*R2**2*X1 - & +R1**2*R2**2*X1+2*R2**4*X1-X1**2+R1*X1**2-R2**2*X1**2+3*X2 - & +4*R1**2*X2+R1**4*X2+2*R2**2*X2+2*R1**2*R2**2*X2-4*X1*X2 - & -2*R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-2*X2**2 - & -2*R1**2*X2**2+X1*X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) - RFO1=RFO1+(2*R2**2+6*R1*R2**2-6*R1**2*R2**2+6*R1**3*R2**2 - & +2*R2**4+6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 - & -R1**4*X2-3*R2**2*X2-6*R1*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO1=RFO1+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4 - & +9*X1+10*R1**2*X1+R1**4*X1-3*R2**2*X1+6*R1*R2**2*X1 - & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 - & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2+6*R1*R2**2*X2 - & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-2+X1+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-2D0*R1**2+R1**4+R2**2+6D0*R1*R2**2 - & +R1**2*R2**2-2D0*R2**4) - RFO2=2*(1+R1+2*R1**2+2*R1**3+R1**4+R1**5+R2**2+R1*R2**2 - & +5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4-2*X1-2*R1*X1 - & -2*R1**2*X1-2*R1**3*X1-2*R2**2*X1+5*R1*R2**2*X1 - & -R1**2*R2**2*X1-2*R2**4*X1+X1**2+R1*X1**2+R2**2*X1**2-3*X2 - & -4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2+4*X1*X2 - & +2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2+2*R1**2*X2**2 - & -X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - RFO2=RFO2+(2*R2**2-6*R1*R2**2-6*R1**2*R2**2-6*R1**3*R2**2 - & +2*R2**4-6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 - & -R1**4*X2-3*R2**2*X2+6*R1*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO2=RFO2+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 - & +10*R1**2*X1+R1**4*X1-3*R2**2*X1-6*R1*R2**2*X1 - & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 - & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2-6*R1*R2**2*X2 - & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 - & +X1*X2**2)/(-2+X1+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1.D0-2.D0*R1**2+R1**4+R2**2+R1**2*R2**2-2.D0*R2**4) - RFO4=2*(1+2*R1**2+R1**4+R2**2+5*R1**2*R2**2-2*X1-2*R1**2*X1 - & -2*R2**2*X1-R1**2*R2**2*X1-2*R2**4*X1+X1**2+R2**2*X1**2 - & -3*X2-4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2 - & +4*X1*X2+2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2 - & +2*R1**2*X2**2-X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - RFO4=RFO4+(2*R2**2-6*R1**2*R2**2+2*R2**4-R2**2*X1+R1**2*R2**2*X1 - & -R2**4*X1+X2-R1**4*X2-3*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO4=RFO4+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 - & +10*R1**2*X1+R1**4*X1-3*R2**2*X1+R1**2*R2**2*X1-2*R2**4*X1 - & -6*X1**2-2*R1**2*X1**2+X1**3+7*X2+8*R1**2*X2+R1**4*X2 - & -7*R2**2*X2+R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 - & +X1*X2**2)/(2-X1-X2)**2 - ISSET4=1 - ENDIF - -C...S -> q qbar (S = h0/H0/A0/H+-/...). - ELSEIF(ICLASS.EQ.4) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2-R2**2-2D0*R1*R2) - RFO1=-(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -2*(R1**2+R1**4-2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4-R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2-R2**2+2D0*R1*R2) - RFO2=-(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +2*(-R1**2-R1**4-2*R1**3*R2-R2**2+6*R1**2*R2**2 - & -2*R1*R2**3-R2**4+R1**2*X1+R1*R2*X1-2*R2**2*X1 - & -2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2-R2**2) - RFO4=-(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 - & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -2*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 - & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1 - & +X2+3*R1**2*X2-R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...q -> q S. - ELSEIF(ICLASS.EQ.5) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=(4-4*R1**2+4*R2**2-3*X1-2*R1*X1+R1**2*X1-R2**2*X1-5*X2 - & -2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3-R1-5*R1**2-R1**3+3*R2**2+R1*R2**2-2*X1-R1*X1 - & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) - RFO2=(4-4*R1**2+4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2 - & +2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3+R1-5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1 - & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0+R1**2-R2**2) - RFO4=(4-4*R1**2+4*R2**2-3*X1+R1**2*X1-R2**2*X1-5*X2+R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2+2*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...V -> ~q ~qbar (~q = squark). - ELSEIF(ICLASS.EQ.6) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) - RFO1=2D0*3D0+(1+R1**2+R2**2-X1)*(4*R1**2-X1**2)/ - & (-1-R1**2+R2**2+X1)**2 - & -2D0*(-1-3*R1**2-R2**2+X1+X1**2/2+X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1) - & +(1+R1**2+R2**2-X2)*(4*R2**2-X2**2) - & /(-1+R1**2-R2**2+X2)**2 - & -2D0*(-1-R1**2-3*R2**2+X1+X2-X1*X2/2+X2**2/2)/ - & (-1+R1**2-R2**2+X2) - & -(-4*R1**2-4*R1**4-4*R2**2-8*R1**2*R2**2-4*R2**4+2*X1 - & +6*R1**2*X1+6*R2**2*X1-2*X1**2+2*X2+6*R1**2*X2+6*R2**2*X2 - & -4*X1*X2-2*R1**2*X1*X2-2*R2**2*X1*X2+X1**2*X2-2*X2**2 - & +X1*X2**2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - ISSET1=1 - -C...~q -> ~q V. - ELSEIF(ICLASS.EQ.7) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) - RFO1=16*R2**2+8*(4*R2**2+2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2 - & -2*X2**2)/(3*(-1+R1**2-R2**2+X2))+8*(1+R1**2+R2**2-X2)* - & (4*R2**2-X2**2)/(3*(-1+R1**2-R2**2+X2)**2)+8*(X1+X2)* - & (-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 - & +2*R1**2*X1+2*R2**2*X1-X1**2+2*X2+2*R1**2*X2+2*R2**2*X2 - & -2*X1*X2-X2**2)/(3*(-2+X1+X2)**2)+8*(-1-R1**2+R2**2-X1)* - & (2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2-X2**2)/ - & (3*(-1+R1**2-R2**2+X2)*(-2+X1+X2))+8*(1+2*R1**2+R1**4 - & +2*R2**2-2*R1**2*R2**2+R2**4-2*X1-2*R1**2*X1-4*R2**2*X1 - & +X1**2-3*X2-3*R1**2*X2-3*R2**2*X2+3*X1*X2+2*X2**2)/ - & (3*(-2+X1+X2)) - RFO1=3D0*RFO1/8D0 - ISSET1=1 - -C...S -> ~q ~qbar. - ELSEIF(ICLASS.EQ.8) THEN - RLO1=PS - RFO1=(-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 - & +2*R1**2*X1+2*R2**2*X1-X1**2-R2**2*X1**2+2*X2+2*R1**2*X2 - & +2*R2**2*X2-3*X1*X2-R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-X2**2 - & -R1**2*X2**2+X1*X2**2)/ - & (1+R1**2-R2**2-X1)**2/(-1+R1**2-R2**2+X2)**2 - RFO1=2D0*RFO1 - ISSET1=1 - -C...~q -> ~q S. - ELSEIF(ICLASS.EQ.9) THEN - RLO1=PS - RFO1=(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(1+R1**2-R2**2+X1)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - & -(X1+X2)/(-2+X1+X2)**2 - ISSET1=1 - -C...chi -> q ~qbar (chi = neutralino/chargino). - ELSEIF(ICLASS.EQ.10) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=(2*R1+X1)*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 - & +2*(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1 - & -R1**2*X1/2-R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-2D0*R1+R1**2-R2**2) - RFO2=(2*R1-X1)*(1+R1**2+R2**2-X1)/(-1-R1**2+R2**2+X1)**2 - & +2*(-1-R1**2+2*R1**3-R2**2+2*R1*R2**2+3*X1/2-R1*X1 - & -R1**2*X1/2-R2**2*X1/2+X2-R1*X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1+R1**2-R2**2) - RFO4=X1*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 - & +2D0*(-1-R1**2-R2**2+3*X1/2-R1**2*X1/2-R2**2*X1/2 - & +X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...~q -> q chi. - ELSEIF(ICLASS.EQ.11) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-(R1+R2)**2) - RFO1=(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 - & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 - & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-(R1-R2)**2) - RFO2=(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/ - & (-2+X1+X2)**2 - & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3+R2**4 - & +X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2-R2**2) - RFO4=(1+R1**2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 - & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2 - & +3*R1**2*X2-R2**2*X2-X1*X2)/ - & (-1+R1**2-R2**2+X2)**2 - & -(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 - & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET4=1 - ENDIF - -C...q -> ~q chi. - ELSEIF(ICLASS.EQ.12) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) - RFO1=(2*R2+X2)*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1-2*R2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2-2*R2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2+R2+R1**2*R2-R2**2-R2**3+X1 - & +R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET1=1 - END IF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) - RFO2=(2*R2-X2)*(1+R1**2+R2**2-X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 - & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET2=1 - END IF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2+R2**2) - RFO4=X2*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2 - & +R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET4=1 - END IF - -C...~g -> q ~qbar. - ELSEIF(ICLASS.EQ.13) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=4*(2*R1+X1)*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2) - & -(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1-R1**2*X1/2 - & -R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/(3*(-1-R1**2+R2**2 - & +X1)*(-1+R1**2-R2**2+X2))-3*(-1+R1-R1**2-R1**3-R2**2 - & +R1*R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+3*(4-4*R1**2+4*R2**2-3*X1 - & -2*R1*X1+R1**2*X1-R2**2*X1-5*X2-2*R1*X2+R1**2*X2-R2**2*X2 - & +X1*X2+X2**2)/(-2+X1+X2)**2+3*(3-R1-5*R1**2-R1**3+3*R2**2 - & +R1*R2**2-2*X1-R1*X1+R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2 - & +X1*X2+X2**2)/((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2-2*R1 - & -6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1-R2**2*X1 - & -3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO1=3D0*RFO1/4D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) - RFO2=4*(2*R1-X1)*(1+R1**2+R2**2-X1)/(3*(-1-R1**2+R2**2+X1)**2) - & -3*(-1-R1-R1**2+R1**3-R2**2-R1*R2**2+2*X1+R2**2*X1-X1**2/2 - & +X2-R1*X2+R1**2*X2-X1*X2/2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - & +(2+2*R1**2-4*R1**3+2*R2**2-4*R1*R2**2-3*X1+2*R1*X1 - & +R1**2*X1+R2**2*X1-2*X2+2*R1*X2-2*R1**2*X2+X1*X2)/ - & (6*(-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+3*(4-4*R1**2 - & +4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2+2*R1*X2 - & +R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2+3*(3+R1 - & -5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1+R1**2*X1-4*X2 - & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2+2*R1-6*R1**2+2*R1**3 - & +2*R2**2+2*R1*R2**2-X1+R1**2*X1-R2**2*X1-3*X2-2*R1*X2 - & +3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO2=3D0*RFO2/4D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0+R1**2-R2**2) - RFO4=8*X1*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2)-6*(-1 - & -R1**2-R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1**2*X2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+(2+2*R1**2+2*R2**2-3*X1 - & +R1**2*X1+R2**2*X1-2*X2-2*R1**2*X2+X1*X2)/(3*(-1-R1**2 - & +R2**2+X1)*(-1+R1**2-R2**2+X2))+6*(4-4*R1**2+4*R2**2-3*X1 - & +R1**2*X1-R2**2*X1-5*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-2+X1+X2)**2+6*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2 - & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+8*(2-6*R1**2+2*R2**2-X1 - & +R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO4=3D0*RFO4/8D0 - ISSET4=1 - ENDIF - -C...~q -> q ~g. - ELSEIF(ICLASS.EQ.14) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1-R1**2-R2**2-2D0*R1*R2) - RFO1=64*(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) - & -16*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-16*(R1**2+R1**4 - & -2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3+R2**4 - & -R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2-R2**2*X2 - & -X1*X2)/((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) - & -64*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1+R1**4-2*R1*R2+2*R1**3*R2-2*R2**2-2*R1*R2**3-R2**4 - & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2-2*R1*R2*X2 - & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) - RFO1=RFO1 - & +8*(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 - & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO1=9D0*RFO1/64D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1-R1**2-R2**2+2D0*R1*R2) - RFO2=64*(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) - & -16*(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-64*(-1+R1**4 - & +2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3+R2**4+X1 - & -R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2-R2**2*X2 - & -X1*X2)/(9*(-1+R1**2-R2**2+X2)**2)+16*(-R1**2-R1**4 - & -2*R1**3*R2-R2**2+6*R1**2*R2**2-2*R1*R2**3-R2**4+R1**2*X1 - & +R1*R2*X1-2*R2**2*X1-2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) - RFO2=RFO2 - & +8*(-1+R1**4+2*R1*R2-2*R1**3*R2-2*R2**2+2*R1*R2**3-R2**4 - & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2+2*R1*R2*X2 - & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) - & +8*(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3 - & +R2**4+X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2 - & -2*R2**2*X2+X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO2=9D0*RFO2/64D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1-R1**2-R2**2) - RFO4=128*(1+R1**2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2)-32*(-1 - & +R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 - & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -32*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 - & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))-128*(-1+R1**4 - & -6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2 - & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +16*(-1+R1**4-2*R2**2-R2**4-2*R1**2*X1+2*R2**2*X1+X1**2 - & +X2-3*R1**2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-2+X1+ X2)) - RFO4=RFO4+16*(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 - & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ - & (9*(1-R1**2+R2**2-X2)*(-2+X1+X2)) - RFO4=9D0*RFO4/128D0 - ISSET4=1 - ENDIF - -C...q -> ~q ~g. - ELSEIF(ICLASS.EQ.15) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) - RFO1=32*(2*R2+X2)*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1-R1**2-2*R1**2*R2-R2**2-2*R2**3+X1+R2*X1+R2**2*X1 - & +3*X2/2-R1**2*X2/2+R2*X2-R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2-2*R2 - & -2*R1**2*R2-6*R2**2-2*R2**3-3*X1-R1**2*X1+2*R2*X1 - & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)**2+32*(4+4*R1**2-4*R2**2-5*X1 - & -R1**2*X1-2*R2*X1+R2**2*X1+X1**2-3*X2-R1**2*X2-2*R2*X2 - & +R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) - RFO1=RFO1+8*(3+3*R1**2-R2+R1**2*R2-5*R2**2-R2**3-4*X1-R1**2*X1 - & +2*R2**2*X1+X1**2-2*X2-R2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+8*(-1-R1**2+R2+R1**2*R2 - & -R2**2-R2**3+X1+R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 - & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO1=9D0*RFO1/32D0 - ISSET1=1 - END IF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) - RFO2=32*(2*R2-X2)*(1+R1**2+R2**2-X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1-R1**2+2*R1**2*R2-R2**2+2*R2**3+X1-R2*X1+R2**2*X1 - & +3*X2/2-R1**2*X2/2-R2*X2-R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2+2*R2 - & +2*R1**2*R2-6*R2**2+2*R2**3-3*X1-R1**2*X1-2*R2*X1 - & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)**2+8*(3+3*R1**2+R2-R1**2*R2-5*R2**2 - & +R2**3-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2*X2+R2**2*X2 - & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - RFO2=RFO2+32*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1 - & +X1**2-3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ - & (9*(-2+X1+X2)**2)+8*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 - & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO2=9D0*RFO2/32D0 - ISSET2=1 - END IF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2+R2**2) - RFO4=64*X2*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +16*(-1-R1**2-R2**2+X1+R2**2*X1+3*X2/2-R1**2*X2/2 - & -R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+16*(3+3*R1**2 - & -5*R2**2-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2**2*X2 - & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - & +64*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2-3*X2 - & -R1**2*X2+R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) - RFO4=RFO4+16*(2+2*R1**2-6*R2**2-3*X1-R1**2*X1+3*R2**2*X1+X1**2 - & -X2-R1**2*X2+R2**2*X2+X1*X2)/(-1-R1**2+R2**2+X1)**2 - & +16*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 - & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO4=9D0*RFO4/64D0 - ISSET4=1 - END IF - -C...g -> ~g ~g. Use (9/4)*eikonal. May be changed in the future. - ELSEIF(ICLASS.EQ.16) THEN - RLO=PS - IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN - ANUM=0D0 - ELSEIF(ICOMBI.EQ.2) THEN - ANUM=(2D0-X1-X2)**2 - ELSEIF(ICOMBI.EQ.3) THEN - ANUM=ALPCOR*(2D0-X1-X2)**2 - ELSE - ANUM=0.5D0*(2D0-X1-X2)**2 - ENDIF - RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ - & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- - & R1**2/(1D0+R2**2-R1**2-X2)**2- - & R2**2/(1D0+R1**2-R2**2-X1)**2) - RFO=9D0*RFO/4D0 - ICOMBI=0 - ENDIF - -C...Find relevant LO and FO expression. - IF(ICOMBI.EQ.0) THEN - ELSEIF(ICOMBI.EQ.1.AND.ISSET1.EQ.1) THEN - RLO=RLO1 - RFO=RFO1 - ELSEIF(ICOMBI.EQ.2.AND.ISSET2.EQ.1) THEN - RLO=RLO2 - RFO=RFO2 - ELSEIF(ICOMBI.EQ.3.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN - RLO=ALPCOR*RLO1+(1D0-ALPCOR)*RLO2 - RFO=ALPCOR*RFO1+(1D0-ALPCOR)*RFO2 - ELSEIF(ISSET4.EQ.1) THEN - RLO=RLO4 - RFO=RFO4 - ELSEIF(ICOMBI.EQ.4.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN - RLO=0.5D0*(RLO1+RLO2) - RFO=0.5D0*(RFO1+RFO2) - ELSEIF(ISSET1.EQ.1) THEN - RLO=RLO1 - RFO=RFO1 - ELSE - CALL PYERRM(16,'(PYMAEL:) not implemented ME code') - RLO=1D0 - RFO=0D0 - ENDIF - -C...Output. - PYMAEL=RFO/RLO - - RETURN - END - -C********************************************************************* - -C...PYMASS -C...Gives the mass of a particle/parton. - - FUNCTION PYMASS(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Reset variables. Compressed code. Special case for popcorn diquarks. - PYMASS=0D0 - KFA=IABS(KF) - KC=PYCOMP(KF) - IF(KC.EQ.0) THEN - MSTJ(93)=0 - RETURN - ENDIF - -C...Guarantee use of constituent masses for internal checks. - IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND. - &(KFA.LE.10.OR.MOD(KFA/10,10).EQ.0)) THEN - IF(KFA.LE.5) THEN - PYMASS=PARF(100+KFA) - IF(MSTJ(93).EQ.2) PYMASS=MAX(0D0,PYMASS-PARF(121)) - ELSEIF(KFA.LE.10) THEN - PYMASS=PMAS(KFA,1) - ELSEIF(MSTJ(93).EQ.1) THEN - PYMASS=PARF(100+MOD(KFA/1000,10))+PARF(100+MOD(KFA/100,10)) - ELSE - PYMASS=MAX(0D0,PMAS(KC,1)-PARF(122)-2D0*PARF(112)/3D0) - ENDIF - -C...Other masses can be read directly off table. - ELSE - PYMASS=PMAS(KC,1) - 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.1D-4) THEN - IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN - PYMASS=PYMASS+0.5D0*PMAS(KC,2)*TAN((2D0*PYR(0)-1D0)* - & ATAN(2D0*PMAS(KC,3)/PMAS(KC,2))) - ELSE - PM0=PYMASS - PMLOW=ATAN((MAX(0D0,PM0-PMAS(KC,3))**2-PM0**2)/ - & (PM0*PMAS(KC,2))) - PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) - PYMASS=SQRT(MAX(0D0,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ - & (PMUPP-PMLOW)*PYR(0)))) - ENDIF - ENDIF - MSTJ(93)=0 - - RETURN - END - -C********************************************************************* - -C...PYMAXI -C...Finds optimal set of coefficients for kinematical variable selection -C...and the maximum of the part of the differential cross-section used -C...in the event weighting. - - SUBROUTINE PYMAXI - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/ -C...Local arrays, character variables and data. - CHARACTER CVAR(4)*4 - DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500), - &NAREL(7),WTREL(7),WTMAT(7,7),WTRELN(7),COEFU(7),COEFO(7), - &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2) - DATA CVAR/'tau ','tau''','y* ','cth '/ - DATA SIGSSM/3*0D0/ - -C...Initial values and loop over subprocesses. - NPOSI=0 - VINT(143)=1D0 - VINT(144)=1D0 - XSEC(0,1)=0D0 - DO 460 ISUB=1,500 - MINT(1)=ISUB - MINT(51)=0 - -C...Find maximum weight factors for photon flux. - IF(MSUB(ISUB).EQ.1.OR.(ISUB.GE.91.AND.ISUB.LE.100)) THEN - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(2,WTGAGA) - ENDIF - -C...Select subprocess to study: skip cases not applicable. - IF(ISET(ISUB).EQ.11) THEN - IF(MSUB(ISUB).NE.1) GOTO 460 -C...User process intialization: cross section model dependent. - IF(IABS(IDWTUP).EQ.1) THEN - IF(IDWTUP.GT.0.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') - XSEC(ISUB,1)=1.00000001D-9*ABS(XMAXUP(KFPR(ISUB,1))) - ELSE - IF((IDWTUP.EQ.2.OR.IDWTUP.EQ.3).AND. - & XSECUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XSECUP for user process') - IF(IDWTUP.EQ.2.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') - XSEC(ISUB,1)=1.00000001D-9*ABS(XSECUP(KFPR(ISUB,1))) - ENDIF - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - NPOSI=NPOSI+1 - GOTO 450 - ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN - CALL PYSIGH(NCHN,SIGS) - XSEC(ISUB,1)=SIGS - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - IF(MSUB(ISUB).NE.1) GOTO 460 - NPOSI=NPOSI+1 - GOTO 450 - ELSEIF(ISUB.EQ.99.AND.MSUB(ISUB).EQ.1) THEN - CALL PYSIGH(NCHN,SIGS) - XSEC(ISUB,1)=SIGS - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - IF(XSEC(ISUB,1).EQ.0D0) THEN - MSUB(ISUB)=0 - ELSE - NPOSI=NPOSI+1 - ENDIF - GOTO 450 - ELSEIF(ISUB.EQ.96) THEN - IF(MINT(50).EQ.0) GOTO 460 - IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) - & GOTO 460 - IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460 - ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR. - & ISUB.EQ.53.OR.ISUB.EQ.68) THEN - IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 - ELSEIF(ISUB.GE.381.AND.ISUB.LE.386) THEN - IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 - ELSE - IF(MSUB(ISUB).NE.1) GOTO 460 - ENDIF - ISTSB=ISET(ISUB) - IF(ISUB.EQ.96) ISTSB=2 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5000) ISUB - MWTXS=0 - IF(MSTP(142).GE.1.AND.ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+ - & MSUB(94)+MSUB(95).EQ.0) MWTXS=1 - -C...Find resonances (explicit or implicit in cross-section). - MINT(72)=0 - KFR1=0 - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - KFR1=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165 - & .OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN - KFR1=23 - ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172 - & .OR.ISUB.EQ.177) THEN - KFR1=24 - ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN - KFR1=25 - IF(MSTP(46).EQ.5) THEN - KFR1=89 - PMAS(89,1)=PARP(45) - PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) - ENDIF - ELSEIF(ISUB.EQ.194) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.EQ.195) THEN - KFR1=KTECHN+213 - ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN - KFR1=KTECHN+213 - ENDIF - CKMX=CKIN(2) - IF(CKMX.LE.0D0) CKMX=VINT(1) - KCR1=PYCOMP(KFR1) - IF(KFR1.NE.0) THEN - IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. - & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 - ENDIF - IF(KFR1.NE.0) THEN - TAUR1=PMAS(KCR1,1)**2/VINT(2) - IF(KFR1.EQ.KTECHN+113) THEN - CALL PYTECM(S1,S2) - TAUR1=S1/VINT(2) - ENDIF - GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - KFR2=0 - IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) - $ THEN - KFR2=23 - IF(ISUB.EQ.194) THEN - KFR2=KTECHN+223 - ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN - KFR2=KTECHN+223 - ENDIF - KCR2=PYCOMP(KFR2) - TAUR2=PMAS(KCR2,1)**2/VINT(2) - IF(KFR2.EQ.KTECHN+223) THEN - CALL PYTECM(S1,S2) - TAUR2=S2/VINT(2) - ENDIF - GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) - IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. - & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 - IF(KFR2.NE.0.AND.KFR1.NE.0) THEN - MINT(72)=2 - MINT(74)=KFR2 - VINT(75)=TAUR2 - VINT(76)=GAMR2 - ELSEIF(KFR2.NE.0) THEN - KFR1=KFR2 - TAUR1=TAUR2 - GAMR1=GAMR2 - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - KFR2=0 - ENDIF - ENDIF - -C...Find product masses and minimum pT of process. - SQM3=0D0 - SQM4=0D0 - MINT(71)=0 - VINT(71)=CKIN(3) - VINT(80)=1D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - NBW=0 - DO 110 I=1,2 - PMMN(I)=0D0 - IF(KFPR(ISUB,I).EQ.0) THEN - ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. - & PARP(41)) THEN - IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - ELSE - NBW=NBW+1 -C...This prevents SUSY/t particles from becoming too light. - KFLW=KFPR(ISUB,I) - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - KCW=PYCOMP(KFLW) - PMMN(I)=PMAS(KCW,1) - DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 100 CONTINUE - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - ENDIF - 110 CONTINUE - IF(NBW.GE.1) THEN - CKIN41=CKIN(41) - CKIN43=CKIN(43) - CKIN(41)=MAX(PMMN(1),CKIN(41)) - CKIN(43)=MAX(PMMN(2),CKIN(43)) - CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) - CKIN(41)=CKIN41 - CKIN(43)=CKIN43 - IF(MINT(51).EQ.1) THEN - WRITE(MSTU(11),5100) ISUB - MSUB(ISUB)=0 - GOTO 460 - ENDIF - SQM3=PQM3**2 - SQM4=PQM4**2 - ENDIF - IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1 - IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) - IF(ISUB.EQ.96.AND.MSTP(82).LE.1) THEN - VINT(71)=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSEIF(ISUB.EQ.96) THEN - VINT(71)=0.08D0*PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - ENDIF - VINT(63)=SQM3 - VINT(64)=SQM4 - -C...Prepare for additional variable choices in 2 -> 3. - IF(ISTSB.EQ.5) THEN - VINT(201)=0D0 - IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) - VINT(206)=VINT(201) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) - VINT(204)=PMAS(23,1) - IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) - IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182 - & .OR.ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) - & VINT(204)=VINT(201) - VINT(209)=VINT(204) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) - ENDIF - -C...Number of points for each variable: tau, tau', y*, cos(theta-hat). - NPTS(1)=2+2*MINT(72) - IF(MINT(47).EQ.1) THEN - IF(ISTSB.EQ.1.OR.ISTSB.EQ.2) NPTS(1)=1 - ELSEIF(MINT(47).GE.5) THEN - IF(ISTSB.LE.2.OR.ISTSB.GT.5) NPTS(1)=NPTS(1)+1 - ENDIF - NPTS(2)=1 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - IF(MINT(47).GE.2) NPTS(2)=2 - IF(MINT(47).GE.5) NPTS(2)=3 - ENDIF - NPTS(3)=1 - IF(MINT(47).EQ.4.OR.MINT(47).EQ.5) THEN - NPTS(3)=3 - IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1 - IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1 - ENDIF - NPTS(4)=1 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5 - NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) - -C...Reset coefficients of cross-section weighting. - DO 120 J=1,20 - COEF(ISUB,J)=0D0 - 120 CONTINUE - COEF(ISUB,1)=1D0 - COEF(ISUB,8)=0.5D0 - COEF(ISUB,9)=0.5D0 - COEF(ISUB,13)=1D0 - COEF(ISUB,18)=1D0 - MCTH=0 - MTAUP=0 - METAUP=0 - VINT(23)=0D0 - VINT(26)=0D0 - SIGSAM=0D0 - -C...Find limits and select tau, y*, cos(theta-hat) and tau' values, -C...in grid of phase space points. - CALL PYKLIM(1) - METAU=MINT(51) - NACC=0 - DO 150 ITRY=1,NTRY - MINT(51)=0 - IF(METAU.EQ.1) GOTO 150 - IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN - MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4)) - IF(MTAU.GT.2+2*MINT(72)) MTAU=7 - RTAU=0.5D0 -C...Special case when both resonances have same mass, -C...as is often the case in process 194. - IF(MINT(72).EQ.2) THEN - IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT. - & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN - IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN - RTAU=0.4D0 - ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN - RTAU=0.6D0 - ENDIF - ENDIF - ENDIF - CALL PYKMAP(1,MTAU,RTAU) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) - METAUP=MINT(51) - ENDIF - IF(METAUP.EQ.1) GOTO 150 - IF(ISTSB.GE.3.AND.ISTSB.LE.5.AND.MOD(ITRY-1,NPTS(3)*NPTS(4)) - & .EQ.0) THEN - MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2)) - CALL PYKMAP(4,MTAUP,0.5D0) - ENDIF - IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) THEN - CALL PYKLIM(2) - MEYST=MINT(51) - ENDIF - IF(MEYST.EQ.1) GOTO 150 - IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN - MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3)) - IF(MYST.EQ.4.AND.MINT(45).NE.3) MYST=5 - CALL PYKMAP(2,MYST,0.5D0) - CALL PYKLIM(3) - MECTH=MINT(51) - ENDIF - IF(MECTH.EQ.1) GOTO 150 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - MCTH=1+MOD(ITRY-1,NPTS(4)) - CALL PYKMAP(3,MCTH,0.5D0) - ENDIF - IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2) - -C...Store position and limits. - MINT(51)=0 - CALL PYKLIM(0) - IF(MINT(51).EQ.1) GOTO 150 - NACC=NACC+1 - MVARPT(NACC,1)=MTAU - MVARPT(NACC,2)=MTAUP - MVARPT(NACC,3)=MYST - MVARPT(NACC,4)=MCTH - DO 130 J=1,30 - VINTPT(NACC,J)=VINT(10+J) - 130 CONTINUE - -C...Normal case: calculate cross-section. - IF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - -C..2 -> 3: find highest value out of a number of tries. - ELSE - SIGS=0D0 - DO 140 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 140 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 140 CONTINUE - ENDIF - -C...Store cross-section. - SIGSPT(NACC)=SIGS - IF(SIGS.GT.SIGSAM) SIGSAM=SIGS - IF(MSTP(122).GE.2) WRITE(MSTU(11),5200) MTAU,MYST,MCTH,MTAUP, - & VINT(21),VINT(22),VINT(23),VINT(26),SIGS - 150 CONTINUE - IF(NACC.EQ.0) THEN - WRITE(MSTU(11),5100) ISUB - MSUB(ISUB)=0 - GOTO 460 - ELSEIF(SIGSAM.EQ.0D0) THEN - WRITE(MSTU(11),5300) ISUB - MSUB(ISUB)=0 - GOTO 460 - ENDIF - IF(ISUB.NE.96) NPOSI=NPOSI+1 - -C...Calculate integrals in tau over maximal phase space limits. - TAUMIN=VINT(11) - TAUMAX=VINT(31) - ATAU1=LOG(TAUMAX/TAUMIN) - IF(NPTS(1).GE.2) THEN - ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) - ENDIF - IF(NPTS(1).GE.4) THEN - ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 - ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ - & GAMR1 - ENDIF - IF(NPTS(1).GE.6) THEN - ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 - ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ - & GAMR2 - ENDIF - IF(NPTS(1).GT.2+2*MINT(72)) THEN - ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) - ENDIF - -C...Reset. Sum up cross-sections in points calculated. - DO 320 IVAR=1,4 - IF(NPTS(IVAR).EQ.1) GOTO 320 - IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 320 - NBIN=NPTS(IVAR) - DO 170 J1=1,NBIN - NAREL(J1)=0 - WTREL(J1)=0D0 - COEFU(J1)=0D0 - DO 160 J2=1,NBIN - WTMAT(J1,J2)=0D0 - 160 CONTINUE - 170 CONTINUE - DO 180 IACC=1,NACC - IBIN=MVARPT(IACC,IVAR) - IF(IVAR.EQ.1.AND.IBIN.EQ.7) IBIN=3+2*MINT(72) - IF(IVAR.EQ.3.AND.IBIN.EQ.5.AND.MINT(45).NE.3) IBIN=4 - NAREL(IBIN)=NAREL(IBIN)+1 - WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC) - -C...Sum up tau cross-section pieces in points used. - IF(IVAR.EQ.1) THEN - TAU=VINTPT(IACC,11) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU - IF(NBIN.GE.4) THEN - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/ - & ((TAU-TAUR1)**2+GAMR1**2) - ENDIF - IF(NBIN.GE.6) THEN - WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2) - WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/ - & ((TAU-TAUR2)**2+GAMR2**2) - ENDIF - IF(NBIN.GT.2+2*MINT(72)) THEN - WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(ATAU1/ATAU7)* - & TAU/MAX(2D-10,1D0-TAU) - ENDIF - -C...Sum up tau' cross-section pieces in points used. - ELSEIF(IVAR.EQ.2) THEN - TAU=VINTPT(IACC,11) - TAUP=VINTPT(IACC,16) - TAUPMN=VINTPT(IACC,6) - TAUPMX=VINTPT(IACC,26) - ATAUP1=LOG(TAUPMX/TAUPMN) - ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)* - & (1D0-TAU/TAUP)**3/TAUP - IF(NBIN.GE.3) THEN - ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAUP1/ATAUP3)* - & TAUP/MAX(2D-10,1D0-TAUP) - ENDIF - -C...Sum up y* cross-section pieces in points used. - ELSEIF(IVAR.EQ.3) THEN - YST=VINTPT(IACC,12) - YSTMIN=VINTPT(IACC,2) - YSTMAX=VINTPT(IACC,22) - AYST0=YSTMAX-YSTMIN - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST2=AYST1 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN) - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST2)*(YSTMAX-YST) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST) - IF(MINT(45).EQ.3) THEN - TAUE=VINTPT(IACC,11) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) - YST0=-0.5D0*LOG(TAUE) - AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ - & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(AYST0/AYST4)/ - & MAX(1D-10,1D0-EXP(YST-YST0)) - ENDIF - IF(MINT(46).EQ.3) THEN - TAUE=VINTPT(IACC,11) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) - YST0=-0.5D0*LOG(TAUE) - AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ - & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(AYST0/AYST5)/ - & MAX(1D-10,1D0-EXP(-YST-YST0)) - ENDIF - -C...Sum up cos(theta-hat) cross-section pieces in points used. - ELSE - RM34=MAX(1D-20,2D0*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2) - RSQM=1D0+RM34 - CTHMAX=SQRT(1D0-4D0*VINT(71)**2/(TAUMAX*VINT(2))) - CTHMIN=-CTHMAX - IF(CTHMAX.GT.0.9999D0) RM34=MAX(RM34,2D0*VINT(71)**2/ - & (TAUMAX*VINT(2))) - ACTH1=CTHMAX-CTHMIN - ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX)) - ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN)) - ACTH4=1D0/MAX(RM34,RSQM-CTHMAX)-1D0/MAX(RM34,RSQM-CTHMIN) - ACTH5=1D0/MAX(RM34,RSQM+CTHMIN)-1D0/MAX(RM34,RSQM+CTHMAX) - CTH=VINTPT(IACC,13) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/ - & MAX(RM34,RSQM-CTH) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/ - & MAX(RM34,RSQM+CTH) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/ - & MAX(RM34,RSQM-CTH)**2 - WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/ - & MAX(RM34,RSQM+CTH)**2 - ENDIF - 180 CONTINUE - -C...Check that equation system solvable. - IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR) - MSOLV=1 - WTRELS=0D0 - DO 190 IBIN=1,NBIN - IF(MSTP(122).GE.2) WRITE(MSTU(11),5500) (WTMAT(IBIN,IRED), - & IRED=1,NBIN),WTREL(IBIN) - IF(NAREL(IBIN).EQ.0) MSOLV=0 - WTRELS=WTRELS+WTREL(IBIN) - 190 CONTINUE - IF(ABS(WTRELS).LT.1D-20) MSOLV=0 - -C...Solve to find relative importance of cross-section pieces. - IF(MSOLV.EQ.1) THEN - DO 200 IBIN=1,NBIN - WTRELN(IBIN)=MAX(0.1D0,WTREL(IBIN)/WTRELS) - 200 CONTINUE - DO 230 IRED=1,NBIN-1 - DO 220 IBIN=IRED+1,NBIN - IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN - MSOLV=0 - GOTO 260 - ENDIF - RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) - WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED) - DO 210 ICOE=IRED,NBIN - WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE) - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - DO 250 IRED=NBIN,1,-1 - DO 240 ICOE=IRED+1,NBIN - WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE) - 240 CONTINUE - COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) - 250 CONTINUE - ENDIF - -C...Share evenly if failure. - 260 IF(MSOLV.EQ.0) THEN - DO 270 IBIN=1,NBIN - COEFU(IBIN)=1D0 - WTRELN(IBIN)=0.1D0 - IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0, - & WTREL(IBIN)/WTRELS) - 270 CONTINUE - ENDIF - -C...Normalize coefficients, with piece shared democratically. - COEFSU=0D0 - WTRELS=0D0 - DO 280 IBIN=1,NBIN - COEFU(IBIN)=MAX(0D0,COEFU(IBIN)) - COEFSU=COEFSU+COEFU(IBIN) - WTRELS=WTRELS+WTRELN(IBIN) - 280 CONTINUE - IF(COEFSU.GT.0D0) THEN - DO 290 IBIN=1,NBIN - COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0* - & (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS) - 290 CONTINUE - ELSE - DO 300 IBIN=1,NBIN - COEFO(IBIN)=1D0/NBIN - 300 CONTINUE - ENDIF - IF(IVAR.EQ.1) IOFF=0 - IF(IVAR.EQ.2) IOFF=17 - IF(IVAR.EQ.3) IOFF=7 - IF(IVAR.EQ.4) IOFF=12 - DO 310 IBIN=1,NBIN - ICOF=IOFF+IBIN - IF(IVAR.EQ.1.AND.IBIN.GT.2+2*MINT(72)) ICOF=7 - IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1 - COEF(ISUB,ICOF)=COEFO(IBIN) - 310 CONTINUE - IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR), - & (COEFO(IBIN),IBIN=1,NBIN) - 320 CONTINUE - -C...Find two most promising maxima among points previously determined. - DO 330 J=1,4 - IACCMX(J)=0 - SIGSMX(J)=0D0 - 330 CONTINUE - NMAX=0 - DO 390 IACC=1,NACC - DO 340 J=1,30 - VINT(10+J)=VINTPT(IACC,J) - 340 CONTINUE - IF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - ELSE - SIGS=0D0 - DO 350 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 350 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 350 CONTINUE - ENDIF - IEQ=0 - DO 360 IMV=1,NMAX - IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV - 360 CONTINUE - IF(IEQ.EQ.0) THEN - DO 370 IMV=NMAX,1,-1 - IIN=IMV+1 - IF(SIGS.LE.SIGSMX(IMV)) GOTO 380 - IACCMX(IMV+1)=IACCMX(IMV) - SIGSMX(IMV+1)=SIGSMX(IMV) - 370 CONTINUE - IIN=1 - 380 IACCMX(IIN)=IACC - SIGSMX(IIN)=SIGS - IF(NMAX.LE.1) NMAX=NMAX+1 - ENDIF - 390 CONTINUE - -C...Read out starting position for search. - IF(MSTP(122).GE.2) WRITE(MSTU(11),5700) - SIGSAM=SIGSMX(1) - DO 440 IMAX=1,NMAX - IACC=IACCMX(IMAX) - MTAU=MVARPT(IACC,1) - MTAUP=MVARPT(IACC,2) - MYST=MVARPT(IACC,3) - MCTH=MVARPT(IACC,4) - VTAU=0.5D0 - VYST=0.5D0 - VCTH=0.5D0 - VTAUP=0.5D0 - -C...Starting point and step size in parameter space. - DO 430 IRPT=1,2 - DO 420 IVAR=1,4 - IF(NPTS(IVAR).EQ.1) GOTO 420 - IF(IVAR.EQ.1) VVAR=VTAU - IF(IVAR.EQ.2) VVAR=VTAUP - IF(IVAR.EQ.3) VVAR=VYST - IF(IVAR.EQ.4) VVAR=VCTH - IF(IVAR.EQ.1) MVAR=MTAU - IF(IVAR.EQ.2) MVAR=MTAUP - IF(IVAR.EQ.3) MVAR=MYST - IF(IVAR.EQ.4) MVAR=MCTH - IF(IRPT.EQ.1) VDEL=0.1D0 - IF(IRPT.EQ.2) VDEL=MAX(0.01D0,MIN(0.05D0,VVAR-0.02D0, - & 0.98D0-VVAR)) - IF(IRPT.EQ.1) VMAR=0.02D0 - IF(IRPT.EQ.2) VMAR=0.002D0 - IMOV0=1 - IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0 - DO 410 IMOV=IMOV0,8 - -C...Define new point in parameter space. - IF(IMOV.EQ.0) THEN - INEW=2 - VNEW=VVAR - ELSEIF(IMOV.EQ.1) THEN - INEW=3 - VNEW=VVAR+VDEL - ELSEIF(IMOV.EQ.2) THEN - INEW=1 - VNEW=VVAR-VDEL - ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND. - & VVAR+2D0*VDEL.LT.1D0-VMAR) THEN - VVAR=VVAR+VDEL - SIGSSM(1)=SIGSSM(2) - SIGSSM(2)=SIGSSM(3) - INEW=3 - VNEW=VVAR+VDEL - ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND. - & VVAR-2D0*VDEL.GT.VMAR) THEN - VVAR=VVAR-VDEL - SIGSSM(3)=SIGSSM(2) - SIGSSM(2)=SIGSSM(1) - INEW=1 - VNEW=VVAR-VDEL - ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN - VDEL=0.5D0*VDEL - VVAR=VVAR+VDEL - SIGSSM(1)=SIGSSM(2) - INEW=2 - VNEW=VVAR - ELSE - VDEL=0.5D0*VDEL - VVAR=VVAR-VDEL - SIGSSM(3)=SIGSSM(2) - INEW=2 - VNEW=VVAR - ENDIF - -C...Convert to relevant variables and find derived new limits. - ILERR=0 - IF(IVAR.EQ.1) THEN - VTAU=VNEW - CALL PYKMAP(1,MTAU,VTAU) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - CALL PYKLIM(4) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - ENDIF - IF(IVAR.LE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5.AND. - & ILERR.EQ.0) THEN - IF(IVAR.EQ.2) VTAUP=VNEW - CALL PYKMAP(4,MTAUP,VTAUP) - ENDIF - IF(IVAR.LE.2.AND.ILERR.EQ.0) THEN - CALL PYKLIM(2) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - IF(IVAR.LE.3.AND.ILERR.EQ.0) THEN - IF(IVAR.EQ.3) VYST=VNEW - CALL PYKMAP(2,MYST,VYST) - CALL PYKLIM(3) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - IF((ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6).AND. - & ILERR.EQ.0) THEN - IF(IVAR.EQ.4) VCTH=VNEW - CALL PYKMAP(3,MCTH,VCTH) - ENDIF - IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) - -C...Evaluate cross-section. Save new maximum. Final maximum. - IF(ILERR.NE.0) THEN - SIGS=0. - ELSEIF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - ELSE - SIGS=0D0 - DO 400 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 400 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 400 CONTINUE - ENDIF - SIGSSM(INEW)=SIGS - IF(SIGS.GT.SIGSAM) SIGSAM=SIGS - IF(MSTP(122).GE.2) WRITE(MSTU(11),5800) IMAX,IVAR,MVAR, - & IMOV,VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS - 410 CONTINUE - 420 CONTINUE - 430 CONTINUE - 440 CONTINUE - IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM - XSEC(ISUB,1)=1.05D0*SIGSAM - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - 450 CONTINUE - IF(MSTP(173).EQ.1.AND.ISUB.NE.96) XSEC(ISUB,1)= - & PARP(174)*XSEC(ISUB,1) - IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1) - 460 CONTINUE - MINT(51)=0 - -C...Print summary table. - IF(MINT(121).EQ.1.AND.NPOSI.EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5900) - STOP - ELSE - WRITE(MSTU(11),6400) - MSTI(53)=1 - ENDIF - ENDIF - IF(MSTP(122).GE.1) THEN - WRITE(MSTU(11),6000) - WRITE(MSTU(11),6100) - DO 470 ISUB=1,500 - IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 470 - IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 470 - IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 470 - IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 470 - IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13 - & .OR.ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 470 - IF(MSUB(95).EQ.1.AND.ISUB.GE.381.AND.ISUB.LE.386) GOTO 470 - WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1) - 470 CONTINUE - WRITE(MSTU(11),6300) - ENDIF - -C...Format statements for maximization results. - 5000 FORMAT(/1X,'Coefficient optimization and maximum search for ', - &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X, - &'cth',9X,'tau''',7X,'sigma') - 5100 FORMAT(1X,'Warning: requested subprocess ',I3,' has no allowed ', - &'phase space.'/1X,'Process switched off!') - 5200 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,D12.4) - 5300 FORMAT(1X,'Warning: requested subprocess ',I3,' has vanishing ', - &'cross-section.'/1X,'Process switched off!') - 5400 FORMAT(1X,'Coefficients of equation system to be solved for ',A4) - 5500 FORMAT(1X,1P,8D11.3) - 5600 FORMAT(1X,'Result for ',A4,':',7F9.4) - 5700 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ', - &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma') - 5800 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,D12.4) - 5900 FORMAT(1X,'Error: no requested process has non-vanishing ', - &'cross-section.'/1X,'Execution stopped!') - 6000 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ', - &'cross-section maximum search',1X,8('*')) - 6100 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ', - &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I', - &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I') - 6200 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,D12.4,3X,'I') - 6300 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('=')) - 6400 FORMAT(1X,'Error: no requested process has non-vanishing ', - &'cross-section.'/ - &1X,'Execution will stop if you try to generate events.') - - RETURN - END - -C********************************************************************* - -C...PYMEMX -C...Generates maximum ME weight in some initial-state showers. -C...Inparameter MECOR: kind of hard scattering process -C...Outparameter WTFF: maximum weight for fermion -> fermion -C... WTGF: maximum weight for gluon/photon -> fermion -C... WTFG: maximum weight for fermion -> gluon/photon -C... WTGG: maximum weight for gluon -> gluon - - SUBROUTINE PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Default maximum weight. - WTFF=1D0 - WTGF=1D0 - WTFG=1D0 - WTGG=1D0 - -C...Select maximum weight by process. - IF(MECOR.EQ.1) THEN - WTFF=1D0 - WTGF=3D0 - ELSEIF(MECOR.EQ.2) THEN - WTFG=1D0 - WTGG=1D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMEWT -C...Calculates actual ME weight in some initial-state showers. -C...Inparameter MECOR: kind of hard scattering process -C... IFLCB: flavour combination of branching, -C... 1 for fermion -> fermion, -C... 2 for gluon/photon -> fermion -C... 3 for fermion -> gluon/photon, -C... 4 for gluon -> gluon -C... Q2: Q2 value of shower branching -C... Z: Z value of branching -C...In+outparameter PHIBR: azimuthal angle of branching -C...Outparameter WTME: actual ME weight - - SUBROUTINE PYMEWT(MECOR,IFLCB,Q2,Z,PHIBR,WTME) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Default output. - WTME=1D0 - -C...Define kinematics of shower branching in Mandelstam variables. - SQM=VINT(44) - SH=SQM/Z - TH=-Q2 - UH=Q2-SQM*(1D0-Z)/Z - -C...Matrix-element corrections for f + fbar -> s-channel vector boson. - IF(MECOR.EQ.1) THEN - IF(IFLCB.EQ.1) THEN - WTME=(TH**2+UH**2+2D0*SQM*SH)/(SH**2+SQM**2) - ELSEIF(IFLCB.EQ.2) THEN - WTME=(SH**2+UH**2+2D0*SQM*TH)/((SH-SQM)**2+SQM**2) - ENDIF - -C...Matrix-element corrections for g + g -> Higgs (h0, H0, A0). - ELSEIF(MECOR.EQ.2) THEN - IF(IFLCB.EQ.3) THEN - WTME=(SH**2+UH**2)/(SH**2+(SH-SQM)**2) - ELSEIF(IFLCB.EQ.4) THEN - WTME=0.5D0*(SH**4+UH**4+TH**4+SQM**4)/(SH**2-SQM*(SH-SQM))**2 - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMRUN -C...Gives the running, current-algebra mass of a d, u, s, c or b quark, -C...for Higgs couplings. Everything else sent on to PYMASS. - - FUNCTION PYMRUN(KF,Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/ - -C...Most masses not handled here. - KFA=IABS(KF) - IF(KFA.EQ.0.OR.KFA.GT.6) THEN - PYMRUN=PYMASS(KF) - -C...Current-algebra masses, but no Q2 dependence. - ELSEIF(MSTP(37).NE.1.OR.MSTP(2).LE.0) THEN - PYMRUN=PARF(90+KFA) - -C...Running current-algebra masses. - ELSE - AS=PYALPS(Q2) - PYMRUN=PARF(90+KFA)* - & (LOG(MAX(4D0,PARP(37)**2*PARF(90+KFA)**2/PARU(117)**2))/ - & LOG(MAX(4D0,Q2/PARU(117)**2)))**(12D0/(33D0-2D0*MSTU(118))) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMSIN -C...Initializes supersymmetry: finds sparticle masses and -C...branching ratios and stores this information. -C...AUTHOR: STEPHEN MRENNA -C...Baryon- and lepton-number violating parameters by P. Z. Skands. - - SUBROUTINE PYMSIN - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYHTRI/HHH(7) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT4/,/PYMSSM/, - &/PYMSRV/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION ALFA,BETA - DOUBLE PRECISION TANB,AL,BE,COSA,COSB,SINA,SINB,XW - INTEGER I,J,J1,I1,K1 - INTEGER KC,LKNT,IDLAM(400,3) - DOUBLE PRECISION XLAM(0:400) - DOUBLE PRECISION WDTP(0:400),WDTE(0:400,0:5) - DOUBLE PRECISION XARG,COS2B,XMW2,XMZ2 - DOUBLE PRECISION DELM,XMDIF - DOUBLE PRECISION DX,DY,DS,DMU2,DMA2,DQ2,DU2,DD2,DL2,DE2,DHU2,DHD2 - DOUBLE PRECISION ARG,SGNMU,R - INTEGER IMSSM - INTEGER IRPRTY - INTEGER KFSUSY(36),MWIDSU(36),MDCYSU(36) - SAVE MWIDSU,MDCYSU - DATA KFSUSY/ - &1000001,2000001,1000002,2000002,1000003,2000003, - &1000004,2000004,1000005,2000005,1000006,2000006, - &1000011,2000011,1000012,2000012,1000013,2000013, - &1000014,2000014,1000015,2000015,1000016,2000016, - &1000021,1000022,1000023,1000025,1000035,1000024, - &1000037,1000039, 25, 35, 36, 37/ - DATA INIT/0/ - -C...Do nothing if SUSY not requested. - IMSSM=IMSS(1) - IF(IMSSM.EQ.0) RETURN - -C...Save copy of MWID(KC) and MDCY(KC,1) values before -C...they are set to zero for the LSP. - IF(INIT.EQ.0) THEN - INIT=1 - DO 100 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - MWIDSU(I)=MWID(KC) - MDCYSU(I)=MDCY(KC,1) - 100 CONTINUE - ENDIF - -C...Restore MWID(KC) and MDCY(KC,1) values previously zeroed for LSP. - DO 110 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - IF(MDCY(KC,1).EQ.0.AND.MDCYSU(I).NE.0) THEN - MWID(KC)=MWIDSU(I) - MDCY(KC,1)=MDCYSU(I) - ENDIF - 110 CONTINUE - -C...First part of routine: set masses and couplings. - -C...Reset mixing values in sfermion sector to pure left/right. - DO 120 I=1,16 - SFMIX(I,1)=1D0 - SFMIX(I,4)=1D0 - SFMIX(I,2)=0D0 - SFMIX(I,3)=0D0 - 120 CONTINUE - -C...Common couplings. - TANB=RMSS(5) - BETA=ATAN(TANB) - COSB=COS(BETA) - SINB=TANB*COSB - COS2B=COS(2D0*BETA) - ALFA=RMSS(18) - XMW2=PMAS(24,1)**2 - XMZ2=PMAS(23,1)**2 - XW=PARU(102) - -C...Define sparticle masses for a general MSSM simulation. - IF(IMSSM.EQ.1) THEN - IF(IMSS(9).EQ.0) RMSS(22)=RMSS(9) - DO 130 I=1,5,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(RMSS(8)**2-(2D0*XMW2+XMZ2)*COS2B/6D0) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(RMSS(9)**2+(XMW2-XMZ2)*COS2B/3D0) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(RMSS(8)**2+(4D0*XMW2-XMZ2)*COS2B/6D0) - KC=PYCOMP(KSUSY2+I+1) - PMAS(KC,1)=SQRT(RMSS(22)**2-(XMW2-XMZ2)*COS2B*2D0/3D0) - 130 CONTINUE - XARG=RMSS(6)**2-PMAS(24,1)**2*ABS(COS(2D0*BETA)) - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - XARG=SQRT(XARG) - ENDIF - DO 140 I=11,15,2 - PMAS(PYCOMP(KSUSY1+I),1)=RMSS(6) - PMAS(PYCOMP(KSUSY2+I),1)=RMSS(7) - PMAS(PYCOMP(KSUSY1+I+1),1)=XARG - PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 - 140 CONTINUE - IF(IMSS(8).EQ.1) THEN - RMSS(13)=RMSS(6) - RMSS(14)=RMSS(7) - ENDIF - -C...Alternatively derive masses from SUGRA relations. - ELSEIF(IMSSM.EQ.2) THEN - CALL PYAPPS -C...Or use ISASUSY - ELSEIF(IMSSM.EQ.12) THEN - CALL PYSUGI - ALFA=RMSS(18) - GOTO 170 - ENDIF - -C...Add in extra D-term contributions. - IF(IMSS(7).EQ.1) THEN - R=0.43D0 - DX=RMSS(23) - DY=RMSS(24) - DS=RMSS(25) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) 'C NEW DTERMS ADDED TO SCALAR MASSES ' - WRITE(MSTU(11),*) 'C IN A U(B-L) THEORY ' - WRITE(MSTU(11),*) 'C DX = ',DX - WRITE(MSTU(11),*) 'C DY = ',DY - WRITE(MSTU(11),*) 'C DS = ',DS - WRITE(MSTU(11),*) 'C ' - DY=R*DY-4D0/33D0*(1D0-R)*DX+(1D0-R)/33D0*DS - WRITE(MSTU(11),*) 'C DY AT THE WEAK SCALE = ',DY - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - DQ2=DY/6D0-DX/3D0-DS/3D0 - DU2=-2D0*DY/3D0-DX/3D0-DS/3D0 - DD2=DY/3D0+DX-2D0*DS/3D0 - DL2=-DY/2D0+DX-2D0*DS/3D0 - DE2=DY-DX/3D0-DS/3D0 - DHU2=DY/2D0+2D0*DX/3D0+2D0*DS/3D0 - DHD2=-DY/2D0-2D0*DX/3D0+DS - DMU2=(-DY/2D0-2D0/3D0*DX+(COSB**2-2D0*SINB**2/3D0)*DS) - & /ABS(COS2B) - DMA2 = 2D0*DMU2+DHU2+DHD2 - DO 150 I=1,5,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DD2) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) - KC=PYCOMP(KSUSY2+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DU2) - 150 CONTINUE - DO 160 I=11,15,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DE2) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) - 160 CONTINUE - IF(RMSS(4)**2+DMU2.LT.0D0) THEN - WRITE(MSTU(11),*) ' MU2 DRIVEN NEGATIVE ' - STOP - ENDIF - SGNMU=SIGN(1D0,RMSS(4)) - RMSS(4)=SGNMU*SQRT(RMSS(4)**2+DMU2) - ARG=RMSS(10)**2*SIGN(1D0,RMSS(10))+DQ2 - RMSS(10)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(11)**2*SIGN(1D0,RMSS(11))+DD2 - RMSS(11)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(12)**2*SIGN(1D0,RMSS(12))+DU2 - RMSS(12)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(13)**2*SIGN(1D0,RMSS(13))+DL2 - RMSS(13)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(14)**2*SIGN(1D0,RMSS(14))+DE2 - RMSS(14)=SIGN(SQRT(ABS(ARG)),ARG) - IF( RMSS(19)**2 + DMA2 .LE. 50D0 ) THEN - WRITE(MSTU(11),*) ' MA DRIVEN TOO LOW ' - STOP - ENDIF - RMSS(19)=SQRT(RMSS(19)**2+DMA2) - RMSS(6)=SQRT(RMSS(6)**2+DL2) - RMSS(7)=SQRT(RMSS(7)**2+DE2) - WRITE(MSTU(11),*) ' MTL = ',RMSS(10) - WRITE(MSTU(11),*) ' MBR = ',RMSS(11) - WRITE(MSTU(11),*) ' MTR = ',RMSS(12) - WRITE(MSTU(11),*) ' SEL = ',RMSS(6),RMSS(13) - WRITE(MSTU(11),*) ' SER = ',RMSS(7),RMSS(14) - ENDIF - -C...Fix the third generation sfermions. - CALL PYTHRG - -C...Fix the neutralino--chargino--gluino sector. - CALL PYINOM - -C...Fix the Higgs sector. - CALL PYHGGM(ALFA) - -C...Choose the Gunion-Haber convention. - ALFA=-ALFA - RMSS(18)=ALFA - -C...Print information on mass parameters. - IF(IMSSM.EQ.2.AND.MSTP(122).GT.0) THEN - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) ' USING APPROXIMATE SUGRA RELATIONS ' - WRITE(MSTU(11),*) ' M0 = ',RMSS(8) - WRITE(MSTU(11),*) ' M1/2=',RMSS(1) - WRITE(MSTU(11),*) ' TANB=',RMSS(5) - WRITE(MSTU(11),*) ' MU = ',RMSS(4) - WRITE(MSTU(11),*) ' AT = ',RMSS(16) - WRITE(MSTU(11),*) ' MA = ',RMSS(19) - WRITE(MSTU(11),*) ' MTOP=',PMAS(6,1) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - ENDIF - IF(IMSS(20).EQ.1) THEN - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) ' DEBUG MODE ' - WRITE(MSTU(11),*) ' UMIX = ',UMIX(1,1),UMIX(1,2), - & UMIX(2,1),UMIX(2,2) - WRITE(MSTU(11),*) ' UMIXI = ',UMIXI(1,1),UMIXI(1,2), - & UMIXI(2,1),UMIXI(2,2) - WRITE(MSTU(11),*) ' VMIX = ',VMIX(1,1),VMIX(1,2), - & VMIX(2,1),VMIX(2,2) - WRITE(MSTU(11),*) ' VMIXI = ',VMIXI(1,1),VMIXI(1,2), - & VMIXI(2,1),VMIXI(2,2) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(1,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(1,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(2,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(2,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(3,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(3,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(4,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(4,I),I=1,4) - WRITE(MSTU(11),*) ' ALFA = ',ALFA - WRITE(MSTU(11),*) ' BETA = ',BETA - WRITE(MSTU(11),*) ' STOP = ',(SFMIX(6,I),I=1,4) - WRITE(MSTU(11),*) ' SBOT = ',(SFMIX(5,I),I=1,4) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - ENDIF - -C...Set up the Higgs couplings - needed here since initialization -C...in PYINRE did not yet occur when PYWIDT is called below. - 170 AL=ALFA - BE=BETA - SINA=SIN(AL) - COSA=COS(AL) - COSB=COS(BE) - SINB=TANB*COSB - SBMA=SIN(BE-AL) - SAPB=SIN(AL+BE) - CAPB=COS(AL+BE) - CBMA=COS(BE-AL) - C2A=COS(2D0*AL) - C2B=COSB**2-SINB**2 -C...tanb (used for H+) - PARU(141)=TANB - -C...Firstly: h -C...Coupling to d-type quarks - PARU(161)=SINA/COSB -C...Coupling to u-type quarks - PARU(162)=-COSA/SINB -C...Coupling to leptons - PARU(163)=PARU(161) -C...Coupling to Z - PARU(164)=SBMA -C...Coupling to W - PARU(165)=PARU(164) - -C...Secondly: H -C...Coupling to d-type quarks - PARU(171)=-COSA/COSB -C...Coupling to u-type quarks - PARU(172)=-SINA/SINB -C...Coupling to leptons - PARU(173)=PARU(171) -C...Coupling to Z - PARU(174)=CBMA -C...Coupling to W - PARU(175)=PARU(174) -C...Coupling to h - IF(IMSS(4).EQ.2) THEN - PARU(176)=COS(2D0*AL)*COS(BE+AL)-2D0*SIN(2D0*AL)*SIN(BE+AL) - ELSE - HHH(3)=HHH(3)+HHH(4)+HHH(5) - PARU(176)=-3D0/HHH(1)*(HHH(1)*SINA**2*COSB*COSA+ - 1 HHH(2)*COSA**2*SINB*SINA+HHH(3)*(SINA**3*SINB+COSA**3*COSB- - 2 2D0/3D0*CBMA)-HHH(6)*SINA*(COSB*C2A+COSA*CAPB)+ - 3 HHH(7)*COSA*(SINB*C2A+SINA*CAPB)) - ENDIF -C...Coupling to H+ -C...Define later - IF(IMSS(4).EQ.2) THEN - PARU(168)=-SBMA-COS(2D0*BE)*SAPB/2D0/(1D0-XW) - ELSE - PARU(168)=1D0/HHH(1)*(HHH(1)*SINB**2*COSB*SINA- - 1 HHH(2)*COSB**2*SINB*COSA-HHH(3)*(SINB**3*COSA-COSB**3*SINA)+ - 2 2D0*HHH(5)*SBMA-HHH(6)*SINB*(COSB*SAPB+SINA*C2B)- - 3 HHH(7)*COSB*(COSA*C2B-SINB*SAPB)-(HHH(5)-HHH(4))*SBMA) - ENDIF -C...Coupling to A - IF(IMSS(4).EQ.2) THEN - PARU(177)=COS(2D0*BE)*COS(BE+AL) - ELSE - PARU(177)=-1D0/HHH(1)*(HHH(1)*SINB**2*COSB*COSA+ - 1 HHH(2)*COSB**2*SINB*SINA+HHH(3)*(SINB**3*SINA+COSB**3*COSA)- - 2 2D0*HHH(5)*CBMA-HHH(6)*SINB*(COSB*CAPB+COSA*C2B)+ - 3 HHH(7)*COSB*(SINB*CAPB+SINA*C2B)) - ENDIF -C...Coupling to H+ - IF(IMSS(4).EQ.2) THEN - PARU(178)=PARU(177) - ELSE - PARU(178)=PARU(177)-(HHH(5)-HHH(4))/HHH(1)*CBMA - ENDIF -C...Thirdly, A -C...Coupling to d-type quarks - PARU(181)=TANB -C...Coupling to u-type quarks - PARU(182)=1D0/PARU(181) -C...Coupling to leptons - PARU(183)=PARU(181) - PARU(184)=0D0 - PARU(185)=0D0 -C...Coupling to Z h - PARU(186)=COS(BE-AL) -C...Coupling to Z H - PARU(187)=SIN(BE-AL) - PARU(188)=0D0 - PARU(189)=0D0 - PARU(190)=0D0 - -C...Finally: H+ -C...Coupling to W h - PARU(195)=COS(BE-AL) - -C...Tell that all Higgs couplings have been set. - MSTP(4)=1 - -C...Set R-Violating couplings. -C...Set lambda couplings to common value or "natural values". - IF ((IMSS(51).NE.3).AND.(IMSS(51).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 200 IRK=1,3 - DO 190 IRI=1,3 - DO 180 IRJ=1,3 - IF (IRI.NE.IRJ) THEN - IF (IRI.LT.IRJ) THEN - RVLAM(IRI,IRJ,IRK)=RMSS(51) - IF (IMSS(51).EQ.2) RVLAM(IRI,IRJ,IRK)=RMSS(51)* - & SQRT(PMAS(9+2*IRI,1)*PMAS(9+2*IRJ,1)* - & PMAS(9+2*IRK,1)*VIR3) - ELSE - RVLAM(IRI,IRJ,IRK)=-RVLAM(IRJ,IRI,IRK) - ENDIF - ELSE - RVLAM(IRI,IRJ,IRK)=0D0 - ENDIF - 180 CONTINUE - 190 CONTINUE - 200 CONTINUE - ENDIF -C...Set lambda' couplings to common value or "natural values". - IF ((IMSS(52).NE.3).AND.(IMSS(52).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 230 IRI=1,3 - DO 220 IRJ=1,3 - DO 210 IRK=1,3 - RVLAMP(IRI,IRJ,IRK)=RMSS(52) - IF (IMSS(52).EQ.2) RVLAMP(IRI,IRJ,IRK)=RMSS(52)* - & SQRT(PMAS(9+2*IRI,1)*0.5D0*(PMAS(2*IRJ,1)+ - & PMAS(2*IRJ-1,1))*PMAS(2*IRK-1,1)*VIR3) - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - ENDIF -C...Set lambda'' couplings to common value or "natural values". - IF ((IMSS(53).NE.3).AND.(IMSS(53).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 260 IRI=1,3 - DO 250 IRJ=1,3 - DO 240 IRK=1,3 - IF (IRJ.NE.IRK) THEN - IF (IRJ.LT.IRK) THEN - RVLAMB(IRI,IRJ,IRK)=RMSS(53) - IF (IMSS(53).EQ.2) RVLAMB(IRI,IRJ,IRK)= - & RMSS(53)*SQRT(PMAS(2*IRI,1)*PMAS(2*IRJ-1,1)* - & PMAS(2*IRK-1,1)*VIR3) - ELSE - RVLAMB(IRI,IRJ,IRK)=-RVLAMB(IRI,IRK,IRJ) - ENDIF - ELSE - RVLAMB(IRI,IRJ,IRK) = 0D0 - ENDIF - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - ENDIF - -C...Antisymmetrize couplings set by user - IF (IMSS(51).EQ.3.OR.IMSS(53).EQ.3) THEN - DO 290 IRI=1,3 - DO 280 IRJ=1,3 - DO 270 IRK=1,3 - IF (RVLAM(IRI,IRJ,IRK).NE.-RVLAM(IRJ,IRI,IRK)) THEN - RVLAM(IRJ,IRI,IRK)=-RVLAM(IRI,IRJ,IRK) - IF (IRI.EQ.IRJ) RVLAM(IRI,IRJ,IRK)=0D0 - ENDIF - IF (RVLAMB(IRI,IRJ,IRK).NE.-RVLAMB(IRI,IRK,IRJ)) THEN - RVLAMB(IRI,IRK,IRJ)=-RVLAMB(IRI,IRJ,IRK) - IF (IRJ.EQ.IRK) RVLAMB(IRI,IRJ,IRK)=0D0 - ENDIF - 270 CONTINUE - 280 CONTINUE - 290 CONTINUE - ENDIF - -C...Second part of routine: set decay modes and branching ratios. - -C...Allow chi10 -> gravitino + gamma or not. - KC=PYCOMP(KSUSY1+39) - IF( IMSS(11) .NE. 0 ) THEN - PMAS(KC,1)=RMSS(21)/1000000000D0 - PMAS(KC,2)=0.0001D0 - IRPRTY=0 - WRITE(MSTU(11),*) ' ALLOWING DECAYS TO GRAVITINOS ' - ELSE IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - IRPRTY=0 - IF (IMSS(51).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY LLE DECAYS' - IF (IMSS(52).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY LQD DECAYS' - IF (IMSS(53).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY UDD DECAYS' - IF (IMSS(53).GE.1.AND.IMSS(52).GE.1) WRITE(MSTU(11),*) - & ' --- Warning: R-Violating couplings possibly', - & ' incompatible with proton decay' - ELSE - PMAS(KC,1)=9999D0 - IRPRTY=1 - ENDIF - -C...Loop over sparticle and Higgs species. - PMCHI1=PMAS(PYCOMP(KSUSY1+22),1) -C...Find the LSP or NLSP for a gravitino LSP - ILSP=0 - PMLSP=1D20 - DO 300 I=1,36 - KF=KFSUSY(I) - IF(KF.EQ.1000039) GOTO 300 - KC=PYCOMP(KF) - IF(PMAS(KC,1).LT.PMLSP) THEN - ILSP=I - PMLSP=PMAS(KC,1) - ENDIF - 300 CONTINUE - DO 370 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - LKNT=0 - -C...Sfermion decays. - IF(I.LE.24) THEN -C...First check to see if sneutrino is lighter than chi10. - IF((I.EQ.15.OR.I.EQ.19.OR.I.EQ.23).AND. - & PMAS(KC,1).LT.PMCHI1) THEN - ELSE - CALL PYSFDC(KF,XLAM,IDLAM,LKNT) - ENDIF - -C...Gluino decays. - ELSEIF(I.EQ.25) THEN - CALL PYGLUI(KF,XLAM,IDLAM,LKNT) - IF(I.EQ.ILSP.AND.IRPRTY.EQ.1) LKNT=0 - -C...Neutralino decays. - ELSEIF(I.GE.26.AND.I.LE.29) THEN - CALL PYNJDC(KF,XLAM,IDLAM,LKNT) -C...chi10 stable or chi10 -> gravitino + gamma. - IF(I.EQ.26.AND.IRPRTY.EQ.1) THEN - PMAS(KC,2)=1D-6 - MDCY(KC,1)=0 - MWID(KC)=0 - ENDIF - -C...Chargino decays. - ELSEIF(I.GE.30.AND.I.LE.31) THEN - CALL PYCJDC(KF,XLAM,IDLAM,LKNT) - -C...Gravitino is stable. - ELSEIF(I.EQ.32) THEN - MDCY(KC,1)=0 - MWID(KC)=0 - -C...Higgs decays. - ELSEIF(I.GE.33.AND.I.LE.36) THEN -C...Calculate decays to non-SUSY particles. - CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) - LKNT=0 - DO 310 I1=0,100 - XLAM(I1)=0D0 - 310 CONTINUE - DO 330 I1=1,MDCY(KC,3) - K1=MDCY(KC,2)+I1-1 - IF(IABS(KFDP(K1,1)).GT.KSUSY1.OR. - & IABS(KFDP(K1,2)).GT.KSUSY1) GOTO 330 - XLAM(I1)=WDTP(I1) - XLAM(0)=XLAM(0)+XLAM(I1) - DO 320 J1=1,3 - IDLAM(I1,J1)=KFDP(K1,J1) - 320 CONTINUE - LKNT=LKNT+1 - 330 CONTINUE -C...Add the decays to SUSY particles. - CALL PYHEXT(KF,XLAM,IDLAM,LKNT) - ENDIF -C...Zero the branching ratios for use in loop mode -C...thanks to K. Matchev (FNAL) - DO 340 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - BRAT(IDC)=0D0 - 340 CONTINUE - -C...Set stable particles. - IF(LKNT.EQ.0) THEN - MDCY(KC,1)=0 - MWID(KC)=0 - PMAS(KC,2)=1D-6 - PMAS(KC,3)=1D-5 - PMAS(KC,4)=0D0 - -C...Store branching ratios in the standard tables. - ELSE - IDC=MDCY(KC,2)+MDCY(KC,3)-1 - DELM=1D6 - DO 360 IL=1,LKNT - IDCSV=IDC - 350 IDC=IDC+1 - BRAT(IDC)=0D0 - IF(IDC.EQ.MDCY(KC,2)+MDCY(KC,3)) IDC=MDCY(KC,2) - IF(IDLAM(IL,1).EQ.KFDP(IDC,1).AND.IDLAM(IL,2).EQ. - & KFDP(IDC,2).AND.IDLAM(IL,3).EQ.KFDP(IDC,3)) THEN - BRAT(IDC)=XLAM(IL)/XLAM(0) - XMDIF=PMAS(KC,1) - IF(MDME(IDC,1).GE.1) THEN - XMDIF=XMDIF-PMAS(PYCOMP(KFDP(IDC,1)),1)- - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) XMDIF=XMDIF- - & PMAS(PYCOMP(KFDP(IDC,3)),1) - ENDIF - IF(I.LE.32) THEN - IF(XMDIF.GE.0D0) THEN - DELM=MIN(DELM,XMDIF) - ELSE - WRITE(MSTU(11),*) ' ERROR WITH DELM ',DELM,XMDIF - WRITE(MSTU(11),*) ' KF = ',KF - WRITE(MSTU(11),*) ' KF(decay) = ',(KFDP(IDC,J),J=1,3) - ENDIF - ENDIF - GOTO 360 - ELSEIF(IDC.EQ.IDCSV) THEN - WRITE(MSTU(11),*) ' Error in PYMSIN: SUSY decay ', - & 'channel not recognized:' - WRITE(MSTU(11),*) KF,' -> ',(IDLAM(I,J),J=1,3) - GOTO 360 - ELSE - GOTO 350 - ENDIF - 360 CONTINUE - -C...Store width, cutoff and lifetime. - PMAS(KC,2)=XLAM(0) - IF(PMAS(KC,2).LT.0.1D0*DELM) THEN - PMAS(KC,3)=PMAS(KC,2)*10D0 - ELSE - PMAS(KC,3)=0.95D0*DELM - ENDIF - IF(PMAS(KC,2).NE.0D0) THEN - PMAS(KC,4)=PARU(3)/PMAS(KC,2)*1D-12 - ENDIF - ENDIF - 370 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYMULT -C...Initializes treatment of multiple interactions, selects kinematics -C...of hardest interaction if low-pT physics included in run, and -C...generates all non-hardest interactions. - - SUBROUTINE PYMULT(MMUL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80) - SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM - -C...Initialization of multiple interaction treatment. - IF(MMUL.EQ.1) THEN - IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) - ISUB=96 - MINT(1)=96 - VINT(63)=0D0 - VINT(64)=0D0 - VINT(143)=1D0 - VINT(144)=1D0 - -C...Loop over phase space points: xT2 choice in 20 bins. - 100 SIGSUM=0D0 - DO 120 IXT2=1,20 - NMUL(IXT2)=MSTP(83) - SIGM(IXT2)=0D0 - DO 110 ITRY=1,MSTP(83) - RSCA=0.05D0*((21-IXT2)-PYR(0)) - XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) - XT2=MAX(0.01D0*VINT(149),XT2) - VINT(25)=XT2 - -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - -C...Calculate differential cross-section. - VINT(71)=0.5D0*VINT(1)*SQRT(XT2) - CALL PYSIGH(NCHN,SIGS) - SIGM(IXT2)=SIGM(IXT2)+SIGS - 110 CONTINUE - SIGSUM=SIGSUM+SIGM(IXT2) - 120 CONTINUE - SIGSUM=SIGSUM/(20D0*MSTP(83)) - -C...Reject result if sigma(parton-parton) is smaller than hadronic one. - IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) - & PARP(82)*(VINT(1)/PARP(89))**PARP(90),SIGSUM - PARP(82)=0.9D0*PARP(82) - VINT(149)=4D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ - & VINT(2) - GOTO 100 - ENDIF - IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) - & PARP(82)*(VINT(1)/PARP(89))**PARP(90), SIGSUM - -C...Start iteration to find k factor. - YKE=SIGSUM/MAX(1D-10,SIGT(0,0,5)) - SO=0.5D0 - XI=0D0 - YI=0D0 - XF=0D0 - YF=0D0 - XK=0.5D0 - IIT=0 - 130 IF(IIT.EQ.0) THEN - XK=2D0*XK - ELSEIF(IIT.EQ.1) THEN - XK=0.5D0*XK - ELSE - XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) - ENDIF - -C...Evaluate overlap integrals. - IF(MSTP(82).EQ.2) THEN - SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) - SOP=SP/PARU(1) - ELSE - IF(MSTP(82).EQ.3) DELTAB=0.02D0 - IF(MSTP(82).EQ.4) DELTAB=MIN(0.01D0,0.05D0*PARP(84)) - SP=0D0 - SOP=0D0 - B=-0.5D0*DELTAB - 140 B=B+DELTAB - IF(MSTP(82).EQ.3) THEN - OV=EXP(-B**2)/PARU(2) - ELSE - CQ2=PARP(84)**2 - OV=((1D0-PARP(83))**2*EXP(-MIN(50D0,B**2))+ - & 2D0*PARP(83)*(1D0-PARP(83))*2D0/(1D0+CQ2)* - & EXP(-MIN(50D0,B**2*2D0/(1D0+CQ2)))+ - & PARP(83)**2/CQ2*EXP(-MIN(50D0,B**2/CQ2)))/PARU(2) - ENDIF - PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) - SP=SP+PARU(2)*B*DELTAB*PACC - SOP=SOP+PARU(2)*B*DELTAB*OV*PACC - IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 - ENDIF - YK=PARU(1)*XK*SO/SP - -C...Continue iteration until convergence. - IF(YK.LT.YKE) THEN - XI=XK - YI=YK - IF(IIT.EQ.1) IIT=2 - ELSE - XF=XK - YF=YK - IF(IIT.EQ.0) IIT=1 - ENDIF - IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 - -C...Store some results for subsequent use. - VINT(145)=SIGSUM - VINT(146)=SOP/SO - VINT(147)=SOP/SP - -C...Initialize iteration in xT2 for hardest interaction. - ELSEIF(MMUL.EQ.2) THEN - IF(MSTP(82).LE.0) THEN - ELSEIF(MSTP(82).EQ.1) THEN - XT2=1D0 - SIGRAT=XSEC(96,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* - & VINT(317)/(VINT(318)*VINT(320)) - XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) - ELSEIF(MSTP(82).EQ.2) THEN - XT2=1D0 - XT2FAC=VINT(146)*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* - & VINT(149)*(1D0+VINT(149)) - ELSE - XC2=4D0*CKIN(3)**2/VINT(2) - IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 - ENDIF - - ELSEIF(MMUL.EQ.3) THEN -C...Low-pT or multiple interactions (first semihard interaction): -C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) -C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). - ISUB=MINT(1) - IF(MSTP(82).LE.0) THEN - XT2=0D0 - ELSEIF(MSTP(82).EQ.1) THEN - XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) - ELSEIF(MSTP(82).EQ.2) THEN - IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ - & VINT(149)))).GT.PYR(0)) XT2=1D0 - IF(XT2.GE.1D0) THEN - XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- - & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- - & VINT(149) - ELSE - XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* - & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- - & VINT(149) - ENDIF - XT2=MAX(0.01D0*VINT(149),XT2) - ELSE - XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- - & PYR(0)*(1D0-XC2))-VINT(149) - XT2=MAX(0.01D0*VINT(149),XT2) - ENDIF - VINT(25)=XT2 - -C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. - IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN - IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-MINT(143) - IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-MINT(143) - ISUB=95 - MINT(1)=ISUB - VINT(21)=0.01D0*VINT(149) - VINT(22)=0D0 - VINT(23)=0D0 - VINT(25)=0.01D0*VINT(149) - - ELSE -C...Multiple interactions (first semihard interaction). -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - ENDIF - VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) - -C...Store results of cross-section calculation. - ELSEIF(MMUL.EQ.4) THEN - ISUB=MINT(1) - XTS=VINT(25) - IF(ISET(ISUB).EQ.1) XTS=VINT(21) - IF(ISET(ISUB).EQ.2) - & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) - RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ - & (XTS+VINT(149)))) - IRBIN=INT(1D0+20D0*RBIN) - IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN - NMUL(IRBIN)=NMUL(IRBIN)+1 - SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) - ENDIF - -C...Choose impact parameter. - ELSEIF(MMUL.EQ.5) THEN - ISUB=MINT(1) - 150 IF(MSTP(82).EQ.3) THEN - VINT(148)=PYR(0)/(PARU(2)*VINT(147)) - ELSE - RTYPE=PYR(0) - CQ2=PARP(84)**2 - IF(RTYPE.LT.(1D0-PARP(83))**2) THEN - B2=-LOG(PYR(0)) - ELSEIF(RTYPE.LT.1D0-PARP(83)**2) THEN - B2=-0.5D0*(1D0+CQ2)*LOG(PYR(0)) - ELSE - B2=-CQ2*LOG(PYR(0)) - ENDIF - VINT(148)=((1D0-PARP(83))**2*EXP(-MIN(50D0,B2))+2D0*PARP(83)* - & (1D0-PARP(83))*2D0/(1D0+CQ2)*EXP(-MIN(50D0,B2*2D0/(1D0+CQ2)))+ - & PARP(83)**2/CQ2*EXP(-MIN(50D0,B2/CQ2)))/(PARU(2)*VINT(147)) - ENDIF - -C...Multiple interactions (variable impact parameter) : reject with -C...probability exp(-overlap*cross-section above pT/normalization). - RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) - SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) - DO 160 IBIN=IRBIN+1,20 - RNCOR=RNCOR+NMUL(IBIN) - SIGCOR=SIGCOR+SIGM(IBIN) - 160 CONTINUE - SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) - IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) - VINT(150)=EXP(-MIN(50D0,VINT(146)*VINT(148)* - & SIGABV/MAX(1D-10,SIGT(0,0,5)))) - IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUB.NE.11.AND. - & ISUB.NE.12.AND.ISUB.NE.13.AND.ISUB.NE.28.AND.ISUB.NE.53 - & .AND.ISUB.NE.68.AND.ISUB.NE.95.AND.ISUB.NE.96)) THEN - IF(VINT(150).LT.PYR(0)) GOTO 150 - VINT(150)=1D0 - ENDIF - -C...Generate additional multiple semihard interactions. - ELSEIF(MMUL.EQ.6) THEN - ISUBSV=MINT(1) - DO 170 J=11,80 - VINTSV(J)=VINT(J) - 170 CONTINUE - ISUB=96 - MINT(1)=96 - VINT(151)=0D0 - VINT(152)=0D0 - -C...Reconstruct strings in hard scattering. - NMAX=MINT(84)+4 - IF(ISET(ISUBSV).EQ.1) NMAX=MINT(84)+2 - IF(ISET(ISUBSV).EQ.11) NMAX=MINT(84)+2+MINT(3) - NSTR=0 - DO 190 I=MINT(84)+1,NMAX - KCS=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) - IF(KCS.EQ.0) GOTO 190 - DO 180 J=1,4 - IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 180 - IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 180 - IF(J.LE.2) THEN - IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) - ELSE - IST=MOD(K(I,J+1),MSTU(5)) - ENDIF - IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 180 - IF(KCHG(PYCOMP(K(IST,2)),2).EQ.0) GOTO 180 - NSTR=NSTR+1 - IF(J.EQ.1.OR.J.EQ.4) THEN - KSTR(NSTR,1)=I - KSTR(NSTR,2)=IST - ELSE - KSTR(NSTR,1)=IST - KSTR(NSTR,2)=I - ENDIF - 180 CONTINUE - 190 CONTINUE - -C...Set up starting values for iteration in xT2. - IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUBSV.NE.11.AND. - & ISUBSV.NE.12.AND.ISUBSV.NE.13.AND.ISUBSV.NE.28.AND. - & ISUBSV.NE.53.AND.ISUBSV.NE.68.AND.ISUBSV.NE.95.AND. - & ISUBSV.NE.96)) THEN - XT2=(1D0-VINT(141))*(1D0-VINT(142)) - ELSE - XT2=VINT(25) - IF(ISET(ISUBSV).EQ.1) XT2=VINT(21) - IF(ISET(ISUBSV).EQ.2) - & XT2=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) - IF(ISET(ISUBSV).GE.3.AND.ISET(ISUBSV).LE.5) XT2=VINT(26) - ENDIF - IF(MSTP(82).LE.1) THEN - SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* - & VINT(317)/(VINT(318)*VINT(320)) - XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) - ELSE - XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/ - & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) - ENDIF - VINT(63)=0D0 - VINT(64)=0D0 - VINT(143)=1D0-VINT(141) - VINT(144)=1D0-VINT(142) - -C...Iterate downwards in xT2. - 200 IF(MSTP(82).LE.1) THEN - XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) - IF(XT2.LT.VINT(149)) GOTO 250 - ELSE - IF(XT2.LE.0.01001D0*VINT(149)) GOTO 250 - XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* - & LOG(PYR(0)))-VINT(149) - IF(XT2.LE.0D0) GOTO 250 - XT2=MAX(0.01D0*VINT(149),XT2) - ENDIF - VINT(25)=XT2 - -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - -C...Check that x not used up. Accept or reject kinematical variables. - X1M=SQRT(TAU)*EXP(VINT(22)) - X2M=SQRT(TAU)*EXP(-VINT(22)) - IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 200 - VINT(71)=0.5D0*VINT(1)*SQRT(XT2) - CALL PYSIGH(NCHN,SIGS) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) - IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 200 - -C...Reset K, P and V vectors. Select some variables. - DO 220 I=N+1,N+2 - DO 210 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 210 CONTINUE - 220 CONTINUE - RFLAV=PYR(0) - PT=0.5D0*VINT(1)*SQRT(XT2) - PHI=PARU(2)*PYR(0) - CTH=VINT(23) - -C...Add first parton to event record. - K(N+1,1)=3 - K(N+1,2)=21 - IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= - & 1+INT((2D0+PARJ(2))*PYR(0)) - P(N+1,1)=PT*COS(PHI) - P(N+1,2)=PT*SIN(PHI) - P(N+1,3)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)-VINT(42)*(1D0-CTH)) - P(N+1,4)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)+VINT(42)*(1D0-CTH)) - P(N+1,5)=0D0 - -C...Add second parton to event record. - K(N+2,1)=3 - K(N+2,2)=21 - IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) - P(N+2,1)=-P(N+1,1) - P(N+2,2)=-P(N+1,2) - P(N+2,3)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)-VINT(42)*(1D0+CTH)) - P(N+2,4)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)+VINT(42)*(1D0+CTH)) - P(N+2,5)=0D0 - - IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN -C....Choose relevant string pieces to place gluons on. - DO 240 I=N+1,N+2 - DMIN=1D8 - DO 230 ISTR=1,NSTR - I1=KSTR(ISTR,1) - I2=KSTR(ISTR,2) - DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- - & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- - & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1D0,P(I1,4)*P(I2,4)- - & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) - IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN - DMIN=DIST - IST1=I1 - IST2=I2 - ISTM=ISTR - ENDIF - 230 CONTINUE - -C....Colour flow adjustments, new string pieces. - IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ - & MOD(K(IST1,4),MSTU(5)) - IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= - & MSTU(5)*(K(IST1,5)/MSTU(5))+I - K(I,5)=MSTU(5)*IST1 - K(I,4)=MSTU(5)*IST2 - IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ - & MOD(K(IST2,5),MSTU(5)) - IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= - & MSTU(5)*(K(IST2,4)/MSTU(5))+I - KSTR(ISTM,2)=I - KSTR(NSTR+1,1)=I - KSTR(NSTR+1,2)=IST2 - NSTR=NSTR+1 - 240 CONTINUE - -C...String drawing and colour flow for gluon loop. - ELSEIF(K(N+1,2).EQ.21) THEN - K(N+1,4)=MSTU(5)*(N+2) - K(N+1,5)=MSTU(5)*(N+2) - K(N+2,4)=MSTU(5)*(N+1) - K(N+2,5)=MSTU(5)*(N+1) - KSTR(NSTR+1,1)=N+1 - KSTR(NSTR+1,2)=N+2 - KSTR(NSTR+2,1)=N+2 - KSTR(NSTR+2,2)=N+1 - NSTR=NSTR+2 - -C...String drawing and colour flow for qqbar pair. - ELSE - K(N+1,4)=MSTU(5)*(N+2) - K(N+2,5)=MSTU(5)*(N+1) - KSTR(NSTR+1,1)=N+1 - KSTR(NSTR+1,2)=N+2 - NSTR=NSTR+1 - ENDIF - -C...Update remaining energy; iterate. - N=N+2 - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYMULT:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - MINT(31)=MINT(31)+1 - VINT(151)=VINT(151)+VINT(41) - VINT(152)=VINT(152)+VINT(42) - VINT(143)=VINT(143)-VINT(41) - VINT(144)=VINT(144)-VINT(42) - IF(MINT(31).LT.240) GOTO 200 - 250 CONTINUE - MINT(1)=ISUBSV - DO 260 J=11,80 - VINT(J)=VINTSV(J) - 260 CONTINUE - ENDIF - -C...Format statements for printout. - 5000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter', - &'actions for MSTP(82) =',I2,' ******') - 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, - &D9.2,' mb: rejected') - 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, - &D9.2,' mb: accepted') - - RETURN - END - -C********************************************************************* - -C...PYNAME -C...Gives the particle/parton name as a character string. - - SUBROUTINE PYNAME(KF,CHAU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - SAVE /PYDAT1/,/PYDAT2/,/PYDAT4/ -C...Local character variable. - CHARACTER CHAU*16 - -C...Read out code with distinction particle/antiparticle. - CHAU=' ' - KC=PYCOMP(KF) - IF(KC.NE.0) CHAU=CHAF(KC,(3-ISIGN(1,KF))/2) - - - RETURN - END - -C********************************************************************* - -C...PYNJDC -C...Calculates decay widths for the neutralinos (admixtures of -C...Bino, W3-ino, Higgs1-ino, Higgs2-ino) - -C...Input: KCIN = KF code for particle -C...Output: XLAM = widths -C... IDLAM = KF codes for decay particles -C... IKNT = number of decay channels defined -C...AUTHOR: STEPHEN MRENNA -C...Last change: -C...10-15-95: force decay chi^0_2 -> chi^0_1 + gamma -C...when CHIGAMMA .NE. 0 -C...10 FEB 96: Calculate this decay for small tan(beta) - - SUBROUTINE PYNJDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) -c COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), -c &SFMIX(16,4) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ - COMPLEX*16 QIJ,RIJ,F21K,F12K,CAL,CAR,CBL,CBR,CA,CB - INTEGER KFIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, - &XMZ,XMZ2,AXMJ,AXMI - DOUBLE PRECISION S12MIN,S12MAX - DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2 - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I - DOUBLE PRECISION PYX2XH,PYX2XG - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,IH,J,IJ,I,IKNT,FID - INTEGER ITH(3),KF1,KF2 - INTEGER ITHC - DOUBLE PRECISION DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA - DOUBLE PRECISION GAMCON,XMT1,XMT2 - DOUBLE PRECISION PYALEM,PI,PYALPS - DOUBLE PRECISION RAT1,RAT2 - DOUBLE PRECISION T3T,FCOL - DOUBLE PRECISION ALFA,BETA,TANB - DOUBLE PRECISION PYXXGA - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - INTEGER KFNCHI(4),KFCCHI(2) - DATA ITH/25,35,36/ - DATA ITHC/37/ - DATA PREC/1D-2/ - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XMZ2=XMZ**2 - XW=1D0-XMW2/XMZ2 - XW1=1D0-XW - TANW = SQRT(XW/XW1) - -C...IX IS 1 - 4 DEPENDING ON SEQUENCE NUMBER - IX=1 - IF(KFIN.EQ.KFNCHI(2)) IX=2 - IF(KFIN.EQ.KFNCHI(3)) IX=3 - IF(KFIN.EQ.KFNCHI(4)) IX=4 - - XMI=SMZ(IX) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - - TANB=RMSS(5) - BETA=ATAN(TANB) - ALFA=RMSS(18) - CBETA=COS(BETA) - SBETA=TANB*CBETA - CALFA=COS(ALFA) - SALFA=SIN(ALFA) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS - IF(IX.EQ.1.AND.IMSS(11).EQ.0) GOTO 300 - -C...FORCE CHI0_2 -> CHI0_1 + GAMMA - IF(IX.EQ.2 .AND. IMSS(10).NE.0 ) THEN - XMJ=SMZ(1) - AXMJ=ABS(XMJ) - LKNT=LKNT+1 - GAMCON=AEM**3/8D0/PI/XMW2/XW - XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 - XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 - XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) - IDLAM(LKNT,1)=KSUSY1+22 - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - WRITE(MSTU(11),*) 'FORCED N2 -> N1 + GAMMA ',XLAM(LKNT) - GOTO 340 - ENDIF - -C...GRAVITINO DECAY MODES - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - SINW=SQRT(XW) - COSW=SQRT(1D0-XW) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR+PMAS(22,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*ABS(ZMIXC(IX,1)*COSW+ZMIXC(IX,2)*SINW)**2 - ENDIF - IF(AXMI.GT.XMGR+XMZ) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,1)*SINW-ZMIXC(IX,2)*COSW)**2 + - $ .5D0*ABS(ZMIXC(IX,3)*CBETA-ZMIXC(IX,4)*SBETA)**2)* - & (1D0-XMZ2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(25,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=25 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SALFA-ZMIXC(IX,4)*CALFA)**2)* - $ .5D0*(1D0-PMAS(25,1)**2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(35,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=35 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*CALFA+ZMIXC(IX,4)*SALFA)**2)* - $ .5D0*(1D0-PMAS(35,1)**2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(36,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=36 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SBETA+ZMIXC(IX,4)*CBETA)**2)* - $ .5D0*(1D0-PMAS(36,1)**2/XMI2)**4 - ENDIF - IF(IX.EQ.1) GOTO 300 - ENDIF - - DO 220 IJ=1,IX-1 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - -C...CHI0_I -> CHI0_J + GAMMA - IF(AXMI.GE.AXMJ.AND.SBETA/CBETA.LE.2D0) THEN - RAT1=ABS(ZMIXC(IJ,1))**2+ABS(ZMIXC(IJ,2))**2 - RAT1=RAT1/( 1D-6+ABS(ZMIXC(IX,3))**2+ABS(ZMIXC(IX,4))**2 ) - RAT2=ABS(ZMIXC(IX,1))**2+ABS(ZMIXC(IX,2))**2 - RAT2=RAT2/( 1D-6+ABS(ZMIXC(IJ,3))**2+ABS(ZMIXC(IJ,4))**2 ) - IF((RAT1.GT. 0.90D0 .AND. RAT1.LT. 1.10D0) .OR. - & (RAT2.GT. 0.90D0 .AND. RAT2.LT. 1.10D0)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - GAMCON=AEM**3/8D0/PI/XMW2/XW - XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 - XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 - XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) - ENDIF - ENDIF - -C...CHI0_I -> CHI0_J + Z0 - IF(AXMI.GE.AXMJ+XMZ) THEN - LKNT=LKNT+1 - OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- - & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 - ORPP=-DCONJG(OLPP) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - ELSEIF(AXMI.GE.AXMJ) THEN - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(9)=XMZ - XXC(10)=PMAS(23,2) - OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- - & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 - ORPP=DCONJG(OLPP) -C...CHARGED LEPTONS - FID=11 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=FID - IDLAM(LKNT,3)=-FID - IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-13 - ENDIF - ENDIF - 140 CONTINUE - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-15 - ENDIF - -C...NEUTRINOS - 150 CONTINUE - FID=12 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF( XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=12 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=14 - IDLAM(LKNT,3)=-14 - 160 CONTINUE - - IF(PMAS(PYCOMP(KSUSY1+16),1).NE.PMAS(PYCOMP(KSUSY1+12),1)) - & THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - ELSE - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - ENDIF - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=16 - IDLAM(LKNT,3)=-16 -C...D-TYPE QUARKS - 170 CONTINUE - FID=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF( XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - 180 CONTINUE - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF - -C...U-TYPE QUARKS - 190 CONTINUE - FID=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 200 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 200 CONTINUE - ENDIF - -C...CHI0_I -> CHI0_J + H0_K - EH(1)=SIN(ALFA) - EH(2)=COS(ALFA) - EH(3)=-SIN(BETA) - DH(1)=COS(ALFA) - DH(2)=-SIN(ALFA) - DH(3)=COS(BETA) - QIJ=ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,2))+ - & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,2)- - & TANW*(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,1))+ - & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,1)) - RIJ=DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,2)+ - & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,2))- - & TANW*(DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,1)+ - & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,1))) - DO 210 IH=1,3 - XMH=PMAS(ITH(IH),1) - XMH2=XMH**2 - IF(AXMI.GE.AXMJ+XMH) THEN - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMJ2,XMH2) - F21K=0.5D0*(QIJ*EH(IH)+RIJ*DH(IH)) - F12K=F21K -C...SIGN OF MASSES I,J - XMK=XMJ - IF(IH.EQ.3) XMK=-XMK - GX2=ABS(F21K)**2+ABS(F12K)**2 - GLR=DBLE(F21K*DCONJG(F12K)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=ITH(IH) - IDLAM(LKNT,3)=0 - ENDIF - 210 CONTINUE - 220 CONTINUE - -C...CHI0_I -> CHI+_J + W- - DO 260 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - IF(AXMI.GE.AXMJ+XMW) THEN - LKNT=LKNT+1 - CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- - & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)/SR2) - CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ - & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))/SR2) - GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 - GLR=DBLE(CXC(1)*DCONJG(CXC(3))) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-24 - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-KFCCHI(IJ) - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - RT2I = 1D0/SQRT(2D0) - CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- - & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)*RT2I)*RT2I - CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ - & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))*RT2I)*RT2I - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - IA=11 - JA=12 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* - & TANW+ZMIXC(IX,2)*T3J)*RT2I - CXC(4)=-DCONJG(UMIXC(IJ,1))*( - & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I)*RT2I - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(9)=PMAS(24,1) - XXC(10)=PMAS(24,2) - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 230 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=11 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-14 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - ENDIF - 230 CONTINUE - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) - ENDIF - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-16 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - -C...NOW, DO THE QUARKS - 240 CONTINUE - IA=1 - JA=2 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* - & TANW+ZMIXC(IX,2)*T3J) - CXC(4)=-DCONJG(UMIXC(IJ,1))*( - & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I) - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+JA),1) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(2,1)+PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-2 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-4 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - ENDIF - 250 CONTINUE - ENDIF - 260 CONTINUE - 270 CONTINUE - -C...CHI0_I -> CHI+_I + H- - DO 280 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - XMHP=PMAS(ITHC,1) - IF(AXMI.GE.AXMJ+XMHP) THEN - LKNT=LKNT+1 - OLPP=CBETA*(ZMIXC(IX,4)*DCONJG(VMIXC(IJ,1))+(ZMIXC(IX,2)+ - & ZMIXC(IX,1)*TANW)*DCONJG(VMIXC(IJ,2))/SR2) - ORPP=SBETA*(DCONJG(ZMIXC(IX,3))*UMIXC(IJ,1)- - & (DCONJG(ZMIXC(IX,2))+DCONJG(ZMIXC(IX,1))*TANW)* - & UMIXC(IJ,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-ITHC - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ELSE - - ENDIF - 280 CONTINUE - -C...2-BODY DECAYS TO FERMION SFERMION - DO 290 J=1,16 - IF(J.GE.7.AND.J.LE.10) GOTO 290 - KF1=KSUSY1+J - KF2=KSUSY2+J - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - XMF=PMAS(J,1) - IF(J.LE.6) THEN - FCOL=3D0 - ELSE - FCOL=1D0 - ENDIF - - EI=KCHG(J,1)/3D0 - T3T=SIGN(1D0,EI) - IF(J.EQ.12.OR.J.EQ.14.OR.J.EQ.16) T3T=1D0 - IF(MOD(J,2).EQ.0) THEN - CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) - CAL=XMF*ZMIXC(IX,4)/XMW/SBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ELSE - CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) - CAL=XMF*ZMIXC(IX,3)/XMW/CBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ENDIF - -C...D~ D_L - IF(AXMI.GE.XMF+XMSF1) THEN - LKNT=LKNT+1 - XMA2=XMSF1**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - CA=CAL*SFMIX(J,1)+CAR*SFMIX(J,2) - CB=CBL*SFMIX(J,1)+CBR*SFMIX(J,2) - XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=-J - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - -C...D~ D_R - IF(AXMI.GE.XMF+XMSF2) THEN - LKNT=LKNT+1 - XMA2=XMSF2**2 - XMB2=XMF**2 - CA=CAL*SFMIX(J,3)+CAR*SFMIX(J,4) - CB=CBL*SFMIX(J,3)+CBR*SFMIX(J,4) - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=-J - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - 290 CONTINUE - 300 CONTINUE -C...3-BODY DECAY TO Q Q~ GLUINO - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - IF(AXMI.GE.XMJ) THEN - RT2I = 1D0/SQRT(2D0) - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))*RT2I - ORPP=DCONJG(OLPP) - AXMJ=ABS(XMJ) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - FID=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 310 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - XXC(9)=1D6 - XXC(10)=0D0 - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(1)=0D0 - CXC(2)=-GLIJ - CXC(3)=0D0 - CXC(4)=DCONJG(GLIJ) - CXC(5)=0D0 - CXC(6)=GRIJ - CXC(7)=0D0 - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 -C...ALL QUARKS BUT T - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - 310 CONTINUE - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 320 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF -C...U-TYPE QUARKS - 320 CONTINUE - FID=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 330 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(2)=-GLIJ - CXC(4)=DCONJG(GLIJ) - CXC(6)=GRIJ - CXC(8)=-DCONJG(GRIJ) - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 330 CONTINUE - ENDIF - -C...R-violating decay modes (SKANDS). - CALL PYRVNE(KFIN,XLAM,IDLAM,LKNT) - - 340 IKNT=LKNT - XLAM(0)=0D0 - DO 350 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 350 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYNMES -C...Generates number of popcorn mesons and stores some relevant -C...parameters. - - SUBROUTINE PYNMES(KFDIQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - MSTU(121)=0 - IF(MSTJ(12).LT.2) RETURN - -C..Old version: Get 1 or 0 popcorn mesons - IF(MSTJ(12).LT.5)THEN - POPWT=PARF(131) - IF(KFDIQ.NE.0) THEN - KFDIQA=IABS(KFDIQ) - KFA=MOD(KFDIQA/1000,10) - KFB=MOD(KFDIQA/100,10) - KFS=MOD(KFDIQA,10) - POPWT=PARF(132) - IF(KFA.EQ.3) POPWT=PARF(133) - IF(KFB.EQ.3) POPWT=PARF(134) - IF(KFS.EQ.1) POPWT=POPWT*SQRT(PARJ(4)) - ENDIF - MSTU(121)=INT(POPWT/(1D0+POPWT)+PYR(0)) - RETURN - ENDIF - -C..New version: Store popcorn- or rank 0 diquark parameters - MSTU(122)=170 - PARF(193)=PARJ(8) - PARF(194)=PARF(139) - IF(KFDIQ.NE.0) THEN - MSTU(122)=180 - PARF(193)=PARJ(10) - PARF(194)=PARF(140) - ENDIF - IF(PARF(194).LT.1D-5.OR.PARF(194).GT.1D0-1D-5) THEN - IF(PARF(194).GT.1D0-1D-5) CALL PYERRM(9, - & '(PYNMES:) Neglecting too large popcorn possibility') - RETURN - ENDIF - -C..New version: Get number of popcorn mesons - 100 RTST=PYR(0) - MSTU(121)=-1 - 110 MSTU(121)=MSTU(121)+1 - RTST=RTST/PARF(194) - IF(RTST.LT.1D0) GOTO 110 - IF(KFDIQ.EQ.0.AND.PYR(0)*(2D0+PARF(135)*PARF(161)).GT. - & (2D0+PARF(135)*PARF(161)*PARF(138)**MSTU(121))) GOTO 100 - RETURN - END - -C********************************************************************* - -C...PYNULL -C...Resets bin contents of a histogram. - - SUBROUTINE PYNULL(ID) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - - IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN - IS=INDX(ID) - IF(IS.EQ.0) RETURN - DO 100 IX=IS+5,IS+8+NINT(BIN(IS+1)) - BIN(IX)=0D0 - 100 CONTINUE - - RETURN - END - -C*********************************************************************** - -C...PYOFSH -C...Calculates partial width and differential cross-section maxima -C...of channels/processes not allowed on mass-shell, and selects -C...masses in such channels/processes. - - SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT5/ -C...Local arrays. - DIMENSION KFD(2),MBW(2),PMD(2),PGD(2),PMG(2),PML(2),PMU(2), - &PMH(2),ATL(2),ATU(2),ATH(2),RMG(2),INX1(100),XPT1(100), - &FPT1(100),INX2(100),XPT2(100),FPT2(100),WDTP(0:400), - &WDTE(0:400,0:5) - -C...Find if particles equal, maximum mass, matrix elements, etc. - MINT(51)=0 - ISUB=MINT(1) - KFD(1)=IABS(KFD1) - KFD(2)=IABS(KFD2) - MEQL=0 - IF(KFD(1).EQ.KFD(2)) MEQL=1 - MLM=0 - IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0)) - IF(MOFSH.LE.2.OR.MOFSH.EQ.5) THEN - NOFF=44 - PMMX=PMMO - ELSE - NOFF=40 - PMMX=VINT(1) - IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1)) - ENDIF - MMED=0 - IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND. - &(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1 - IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR. - &KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2 - IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR. - &KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3 - LOOP=1 - -C...Find where Breit-Wigners are required, else select discrete masses. - 100 DO 110 I=1,2 - KFCA=PYCOMP(KFD(I)) - IF(KFCA.GT.0) THEN - PMD(I)=PMAS(KFCA,1) - PGD(I)=PMAS(KFCA,2) - ELSE - PMD(I)=0D0 - PGD(I)=0D0 - ENDIF - IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN - MBW(I)=0 - PMG(I)=PMD(I) - RMG(I)=(PMG(I)/PMMX)**2 - ELSE - MBW(I)=1 - ENDIF - 110 CONTINUE - -C...Find allowed mass range and Breit-Wigner parameters. - DO 120 I=1,2 - IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN - PML(I)=PARP(42) - PMU(I)=PMMX-PARP(42) - IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - ELSEIF(MBW(I).EQ.1.AND.MOFSH.NE.5) THEN - ILM=I - IF(MLM.EQ.2) ILM=3-I - PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42)) - IF(MBW(3-I).EQ.0) THEN - PMU(I)=PMMX-PMD(3-I) - ELSE - PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42)) - ENDIF - IF(CKIN(NOFF+2*ILM).GT.CKIN(NOFF+2*ILM-1)) PMU(I)= - & MIN(PMU(I),CKIN(NOFF+2*ILM)) - IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) - IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - IF(MBW(I).EQ.1) THEN - ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* - & PGD(I))) - ENDIF - ELSEIF(MBW(I).EQ.1.AND.MOFSH.EQ.5) THEN - ILM=I - IF(MLM.EQ.2) ILM=3-I - PML(I)=MAX(CKIN(48+I),PARP(42)) - PMU(I)=PMMX-MAX(CKIN(51-I),PARP(42)) - IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) - IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) - IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - IF(MBW(I).EQ.1) THEN - ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* - & PGD(I))) - ENDIF - ENDIF - 120 CONTINUE - IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0)) - &THEN - CALL PYERRM(3,'(PYOFSH:) no allowed decay product masses') - MINT(51)=1 - RETURN - ENDIF - -C...Calculation of partial width of resonance. - IF(MOFSH.EQ.1) THEN - -C..If only one integration, pick that to be the inner. - IF(MBW(1).EQ.0) THEN - PM2=PMD(1) - PMD(1)=PMD(2) - PGD(1)=PGD(2) - PML(1)=PML(2) - PMU(1)=PMU(2) - ELSEIF(MBW(2).EQ.0) THEN - PM2=PMD(2) - ENDIF - -C...Start outer loop of integration. - IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) - ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) - NPT2=1 - XPT2(1)=1D0 - INX2(1)=0 - FMAX2=0D0 - ENDIF - 130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2)) - PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S)))) - ENDIF - RM2=(PM2/PMMX)**2 - -C...Start inner loop of integration. - PML1=PML(1) - PMU1=MIN(PMU(1),PMMX-PM2) - IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2) - ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1))) - ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1))) - IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN - FUNC2=0D0 - GOTO 180 - ENDIF - NPT1=1 - XPT1(1)=1D0 - INX1(1)=0 - FMAX1=0D0 - 140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1)) - PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S)))) - RM1=(PM1/PMMX)**2 - -C...Evaluate function value - inner loop. - FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2) - IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+ - & RM2**2+10D0*RM1*RM2) - IF(FUNC1.GT.FMAX1) FMAX1=FUNC1 - FPT1(NPT1)=FUNC1 - -C...Go to next position in inner loop. - IF(NPT1.EQ.1) THEN - NPT1=NPT1+1 - XPT1(NPT1)=0D0 - INX1(NPT1)=1 - GOTO 140 - ELSEIF(NPT1.LE.8) THEN - NPT1=NPT1+1 - IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1 - ISH1=ISH1+1 - XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) - INX1(NPT1)=INX1(ISH1) - INX1(ISH1)=NPT1 - GOTO 140 - ELSEIF(NPT1.LT.100) THEN - ISN1=ISH1 - 150 ISH1=ISH1+1 - IF(ISH1.GT.NPT1) ISH1=2 - IF(ISH1.EQ.ISN1) GOTO 160 - DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1))) - IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150 - NPT1=NPT1+1 - XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) - INX1(NPT1)=INX1(ISH1) - INX1(ISH1)=NPT1 - GOTO 140 - ENDIF - -C...Calculate integral over inner loop. - 160 FSUM1=0D0 - DO 170 IPT1=2,NPT1 - FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))* - & (XPT1(INX1(IPT1))-XPT1(IPT1)) - 170 CONTINUE - FUNC2=FSUM1*(ATU1-ATL1)/PARU(1) - 180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - IF(FUNC2.GT.FMAX2) FMAX2=FUNC2 - FPT2(NPT2)=FUNC2 - -C...Go to next position in outer loop. - IF(NPT2.EQ.1) THEN - NPT2=NPT2+1 - XPT2(NPT2)=0D0 - INX2(NPT2)=1 - GOTO 130 - ELSEIF(NPT2.LE.8) THEN - NPT2=NPT2+1 - IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1 - ISH2=ISH2+1 - XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) - INX2(NPT2)=INX2(ISH2) - INX2(ISH2)=NPT2 - GOTO 130 - ELSEIF(NPT2.LT.100) THEN - ISN2=ISH2 - 190 ISH2=ISH2+1 - IF(ISH2.GT.NPT2) ISH2=2 - IF(ISH2.EQ.ISN2) GOTO 200 - DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2))) - IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190 - NPT2=NPT2+1 - XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) - INX2(NPT2)=INX2(ISH2) - INX2(ISH2)=NPT2 - GOTO 130 - ENDIF - -C...Calculate integral over outer loop. - 200 FSUM2=0D0 - DO 210 IPT2=2,NPT2 - FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))* - & (XPT2(INX2(IPT2))-XPT2(IPT2)) - 210 CONTINUE - FSUM2=FSUM2*(ATU2-ATL2)/PARU(1) - IF(MEQL.EQ.1) FSUM2=2D0*FSUM2 - ELSE - FSUM2=FUNC2 - ENDIF - -C...Save result; second integration for user-selected mass range. - IF(LOOP.EQ.1) WIDW=FSUM2 - WID2=FSUM2 - IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47) - & .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN - LOOP=2 - GOTO 100 - ENDIF - RET1=WIDW - RET2=WID2/WIDW - -C...Select two decay product masses of a resonance. - ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.5) THEN - 220 DO 230 I=1,2 - IF(MBW(I).EQ.0) GOTO 230 - PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)* - & (ATU(I)-ATL(I))) - PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW)))) - RMG(I)=(PMG(I)/PMMX)**2 - 230 CONTINUE - IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. - & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220 - -C...Weight with matrix element (if none known, use beta factor). - FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2))) - IF(MMED.EQ.1) THEN - WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2)) - ELSEIF(MMED.EQ.2) THEN - WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+ - & RMG(2)**2+10D0*RMG(1)*RMG(2)) - ELSEIF(MMED.EQ.3) THEN - WTBE=FLAM*(RMG(1)+FLAM**2/12D0) - ELSE - WTBE=FLAM - ENDIF - IF(WTBE.LT.PYR(0)) GOTO 220 - RET1=PMG(1) - RET2=PMG(2) - -C...Find suitable set of masses for initialization of 2 -> 2 processes. - ELSEIF(MOFSH.EQ.3) THEN - IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN - PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1))) - PMG(2)=PMD(2) - ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN - PMG(1)=PMD(1) - PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2))) - ELSE - IDIV=-1 - 240 IDIV=IDIV+1 - PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1))) - PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2))) - IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240 - ENDIF - RET1=PMG(1) - RET2=PMG(2) - -C...Evaluate importance of excluded tails of Breit-Wigners. - IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) - & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 - IF(MEQL.LE.1) THEN - VINT(80)=1D0 - DO 250 I=1,2 - IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/ - & PARU(1) - 250 CONTINUE - ELSE - VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))* - & (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2))) - ENDIF - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND. - & MSTP(43).NE.2) VINT(80)=2D0*VINT(80) - IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80) - IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) - -C...Pick one particle to be the lighter (if improves efficiency). - ELSEIF(MOFSH.EQ.4) THEN - IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) - & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 - 260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0)) - -C...Select two masses according to Breit-Wigner + flat in s + 1/s. - DO 270 I=1,2 - IF(MBW(I).EQ.0) GOTO 270 - PMV=PMU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) - ATV=ATU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) - RBR=PYR(0) - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. - & ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR - IF(RBR.LT.0.8D0) THEN - PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I))) - PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR)))) - ELSEIF(RBR.LT.0.9D0) THEN - PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2))) - ELSEIF(RBR.LT.1.5D0) THEN - PMG(I)=PML(I)*(PMV/PML(I))**PYR(0) - ELSE - PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)* - & (PMV**2-PML(I)**2)))) - ENDIF - 270 CONTINUE - IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. - & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN - IF(MINT(48).EQ.1.AND.MSTP(171).EQ.0) THEN - NGEN(0,1)=NGEN(0,1)+1 - NGEN(MINT(1),1)=NGEN(MINT(1),1)+1 - GOTO 260 - ELSE - MINT(51)=1 - RETURN - ENDIF - ENDIF - RET1=PMG(1) - RET2=PMG(2) - -C...Give weight for selected mass distribution. - VINT(80)=1D0 - DO 280 I=1,2 - IF(MBW(I).EQ.0) GOTO 280 - PMV=PMU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) - ATV=ATU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) - F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+ - & (PMD(I)*PGD(I))**2)/PARU(1) - F1=1D0 - F2=1D0/PMG(I)**2 - F3=1D0/PMG(I)**4 - FI0=(ATV-ATL(I))/PARU(1) - FI1=PMV**2-PML(I)**2 - FI2=2D0*LOG(PMV/PML(I)) - FI3=1D0/PML(I)**2-1D0/PMV**2 - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. - & ISUB.EQ.35).AND.MSTP(43).NE.2) THEN - VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+ - & 5D0*F3/FI3)) - ELSE - VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) - ENDIF - VINT(80)=VINT(80)*FI0 - 280 CONTINUE - IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYONIA -C...Generates Upsilon and toponium decays into three gluons -C...or two gluons and a photon. - - SUBROUTINE PYONIA(KFL,ECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Printout. Check input parameters. - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL PYERRM(16,'(PYONIA:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(ECM.LT.PARJ(127)+2.02D0*PARF(101)) THEN - CALL PYERRM(16,'(PYONIA:) 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 PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) - K(NC-1,1)=21 - CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) - 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 PY1ENT(NC,KF,ECM,0D0,0D0) - 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=PYR(0) - X2=PYR(0) - X3=2D0-X1-X2 - IF(X3.GE.1D0.OR.((1D0-X1)/(X2*X3))**2+((1D0-X2)/(X1*X3))**2+ - &((1D0-X3)/(X1*X2))**2.LE.2D0*PYR(0)) GOTO 100 - NTRY=NTRY+1 - NJET=3 - IF(MSTJ(101).LE.4) CALL PY3ENT(NC+1,21,21,21,ECM,X1,X3) - IF(MSTJ(101).GE.5) CALL PY3ENT(-(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=0D0 - IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3D0 - RGAM=7.2D0*QF**2*PARU(101)/PYALPS(ECM**2) - MK=0 - ECMC=ECM - IF(PYR(0).GT.RGAM/(1D0+RGAM)) THEN - IF(1D0-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) - & NJET=2 - IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL PY2ENT(NC+1,21,21,ECM) - IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL PY2ENT(-(NC+1),21,21,ECM) - ELSE - MK=1 - ECMC=SQRT(1D0-X1)*ECM - IF(ECMC.LT.2D0*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.4D0*PARJ(127)) THEN - MSTU10=MSTU(10) - MSTU(10)=1 - P(NC+2,5)=ECMC - CALL PY1ENT(NC+2,83,0.5D0*(X2+X3)*ECM,PARU(1),0D0) - 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(2D0) - HF1=1D0-PARJ(131)*PARJ(132) - HF3=PARJ(133)**2 - CT13=(X1*X3-2D0*X1-2D0*X3+2D0)/(X1*X3) - ST13=SQRT(1D0-CT13**2) - SIGL=0.5D0*X3**2*((1D0-X2)**2+(1D0-X3)**2)*ST13**2 - SIGU=(X1*(1D0-X1))**2+(X2*(1D0-X2))**2+(X3*(1D0-X3))**2-SIGL - SIGT=0.5D0*SIGL - SIGI=(SIGL*CT13/ST13+0.5D0*X1*X3*(1D0-X2)**2*ST13)/SQ2 - SIGMAX=(2D0*HF1+HF3)*ABS(SIGU)+2D0*(HF1+HF3)*ABS(SIGL)+2D0*(HF1+ - & 2D0*HF3)*ABS(SIGT)+2D0*SQ2*(HF1+2D0*HF3)*ABS(SIGI) - -C...Angular orientation of event. - 120 CHI=PARU(2)*PYR(0) - CTHE=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2D0*CHI) - S2CHI=SIN(2D0*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2D0*(PHI-PARJ(134))) - S2PHI=SIN(2D0*(PHI-PARJ(134))) - SIG=((1D0+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2D0*(STHE**2*HF1- - & STHE**2*C2PHI*HF3)*SIGL+2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)* - & C2CHI*C2PHI-2D0*CTHE*S2CHI*S2PHI)*HF3)*SIGT- - & 2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE* - & (CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI - IF(SIG.LT.SIGMAX*PYR(0)) GOTO 120 - CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) - CALL PYROBO(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 PYSHOW(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 PYPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Generate fragmentation. Information for PYTABU: - IF(MSTJ(105).EQ.1) CALL PYEXEC - MSTU(161)=110*KFLC+3 - MSTU(162)=0 - - RETURN - END - -C********************************************************************* - -C...PYOPER -C...Performs operations between histograms. - - SUBROUTINE PYOPER(ID1,OPER,ID2,ID3,F1,F2) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Character variable. - CHARACTER OPER*(*) - -C...Find initial addresses in memory, and histogram size. - IF(ID1.LE.0.OR.ID1.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFACT:) not allowed histogram number') - IS1=INDX(ID1) - IS2=INDX(MIN(IHIST(1),MAX(1,ID2))) - IS3=INDX(MIN(IHIST(1),MAX(1,ID3))) - NX=NINT(BIN(IS3+1)) - IF(OPER.EQ.'M'.AND.ID3.EQ.0) NX=NINT(BIN(IS2+1)) - -C...Update info on number of histogram entries. - IF(OPER.EQ.'+'.OR.OPER.EQ.'-'.OR.OPER.EQ.'*'.OR.OPER.EQ.'/') THEN - BIN(IS3+5)=BIN(IS1+5)+BIN(IS2+5) - ELSEIF(OPER.EQ.'A'.OR.OPER.EQ.'S'.OR.OPER.EQ.'L') THEN - BIN(IS3+5)=BIN(IS1+5) - ENDIF - -C...Operations on pair of histograms: addition, subtraction, -C...multiplication, division. - IF(OPER.EQ.'+') THEN - DO 100 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)+F2*BIN(IS2+IX) - 100 CONTINUE - ELSEIF(OPER.EQ.'-') THEN - DO 110 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)-F2*BIN(IS2+IX) - 110 CONTINUE - ELSEIF(OPER.EQ.'*') THEN - DO 120 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)*F2*BIN(IS2+IX) - 120 CONTINUE - ELSEIF(OPER.EQ.'/') THEN - DO 130 IX=6,8+NX - FA2=F2*BIN(IS2+IX) - IF(ABS(FA2).LE.1D-20) THEN - BIN(IS3+IX)=0D0 - ELSE - BIN(IS3+IX)=F1*BIN(IS1+IX)/FA2 - ENDIF - 130 CONTINUE - -C...Operations on single histogram: multiplication+addition, -C...square root+addition, logarithm+addition. - ELSEIF(OPER.EQ.'A') THEN - DO 140 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)+F2 - 140 CONTINUE - ELSEIF(OPER.EQ.'S') THEN - DO 150 IX=6,8+NX - BIN(IS3+IX)=F1*SQRT(MAX(0D0,BIN(IS1+IX)))+F2 - 150 CONTINUE - ELSEIF(OPER.EQ.'L') THEN - ZMIN=1D20 - DO 160 IX=9,8+NX - IF(BIN(IS1+IX).LT.ZMIN.AND.BIN(IS1+IX).GT.1D-20) - & ZMIN=0.8D0*BIN(IS1+IX) - 160 CONTINUE - DO 170 IX=6,8+NX - BIN(IS3+IX)=F1*LOG10(MAX(ZMIN,BIN(IS1+IX)))+F2 - 170 CONTINUE - -C...Operation on two or three histograms: average and -C...standard deviation. - ELSEIF(OPER.EQ.'M') THEN - DO 180 IX=6,8+NX - IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN - BIN(IS2+IX)=0D0 - ELSE - BIN(IS2+IX)=BIN(IS2+IX)/BIN(IS1+IX) - ENDIF - IF(ID3.NE.0) THEN - IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN - BIN(IS3+IX)=0D0 - ELSE - BIN(IS3+IX)=SQRT(MAX(0D0,BIN(IS3+IX)/BIN(IS1+IX)- - & BIN(IS2+IX)**2)) - ENDIF - ENDIF - BIN(IS1+IX)=F1*BIN(IS1+IX) - 180 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDEL -C...Gives electron (or muon, or tau) parton distribution. - - SUBROUTINE PYPDEL(KFA,X,Q2,XPEL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6) - -C...Interface to PDFLIB. - COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX - SAVE /W50513/ - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, - &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Some common constants. - DO 100 KFL=-25,25 - XPEL(KFL)=0D0 - 100 CONTINUE - AEM=PARU(101) - PME=PMAS(11,1) - IF(KFA.EQ.13) PME=PMAS(13,1) - IF(KFA.EQ.15) PME=PMAS(15,1) - XL=LOG(MAX(1D-10,X)) - X1L=LOG(MAX(1D-10,1D0-X)) - HLE=LOG(MAX(3D0,Q2/PME**2)) - HBE2=(AEM/PARU(1))*(HLE-1D0) - -C...Electron inside electron, see R. Kleiss et al., in Z physics at -C...LEP 1, CERN 89-08, p. 34 - IF(MSTP(59).LE.1) THEN - HDE=1D0+(AEM/PARU(1))*(1.5D0*HLE+1.289868D0)+(AEM/PARU(1))**2* - & (-2.164868D0*HLE**2+9.840808D0*HLE-10.130464D0) - HEE=HBE2*(1D0-X)**(HBE2-1D0)*SQRT(MAX(0D0,HDE))- - & 0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*(-4D0*X1L+3D0*XL)- - & 4D0*XL/(1D0-X)-5D0-X) - ELSE - HEE=HBE2*(1D0-X)**(HBE2-1D0)*EXP(0.172784D0*HBE2)/ - & PYGAMM(1D0+HBE2)-0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)* - & (-4D0*X1L+3D0*XL)-4D0*XL/(1D0-X)-5D0-X) - ENDIF -C...Zero distribution for very large x and rescale it for intermediate. - IF(X.GT.1D0-1D-10) THEN - HEE=0D0 - ELSEIF(X.GT.1D0-1D-7) THEN - HEE=HEE*1000D0**HBE2/(1000D0**HBE2-1D0) - ENDIF - XPEL(KFA)=X*HEE - -C...Photon and (transverse) W- inside electron. - AEMP=PYALEM(PME*SQRT(MAX(0D0,Q2)))/PARU(2) - IF(MSTP(13).LE.1) THEN - HLG=HLE - ELSE - HLG=LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-X)/X**2)) - ENDIF - XPEL(22)=AEMP*HLG*(1D0+(1D0-X)**2) - HLW=LOG(1D0+Q2/PMAS(24,1)**2)/(4D0*PARU(102)) - XPEL(-24)=AEMP*HLW*(1D0+(1D0-X)**2) - -C...Electron or positron inside photon inside electron. - IF(KFA.EQ.11.AND.MSTP(12).EQ.1) THEN - XFSEA=0.5D0*(AEMP*(HLE-1D0))**2*(4D0/3D0+X-X**2-4D0*X**3/3D0+ - & 2D0*X*(1D0+X)*XL) - XPEL(11)=XPEL(11)+XFSEA - XPEL(-11)=XFSEA - -C...Initialize PDFLIB photon parton distributions. - IF(MSTP(56).EQ.2) THEN - PARM(1)='NPTYPE' - VALUE(1)=3 - PARM(2)='NGROUP' - VALUE(2)=MSTP(55)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(55),1000) - IF(MINT(93).NE.3000000+MSTP(55)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=3000000+MSTP(55) - ENDIF - ENDIF - -C...Quarks and gluons inside photon inside electron: -C...numerical convolution required. - DO 110 KFL=0,6 - SXP(KFL)=0D0 - 110 CONTINUE - SUMXPP=0D0 - ITER=-1 - 120 ITER=ITER+1 - SUMXP=SUMXPP - NSTP=2**(ITER-1) - IF(ITER.EQ.0) NSTP=2 - DO 130 KFL=0,6 - SXP(KFL)=0.5D0*SXP(KFL) - 130 CONTINUE - WTSTP=0.5D0/NSTP - IF(ITER.EQ.0) WTSTP=0.5D0 -C...Pick grid of x_{gamma} values logarithmically even. - DO 150 ISTP=1,NSTP - IF(ITER.EQ.0) THEN - XLE=XL*(ISTP-1) - ELSE - XLE=XL*(ISTP-0.5D0)/NSTP - ENDIF - XE=MIN(1D0-1D-10,EXP(XLE)) - XG=MIN(1D0-1D-10,X/XE) -C...Evaluate photon inside electron parton distribution for convolution. - XPGP=1D0+(1D0-XE)**2 - IF(MSTP(13).LE.1) THEN - XPGP=XPGP*HLE - ELSE - XPGP=XPGP*LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-XE)/XE**2)) - ENDIF -C...Evaluate photon parton distributions for convolution. - IF(MSTP(56).EQ.1) THEN - IF(MSTP(55).EQ.1) THEN - CALL PYPDGA(XG,Q2,XPGA) - ELSEIF(MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.7) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) - VINT(231)=P2MX - ELSEIF(MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.11) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) - VINT(231)=P2MX - ENDIF - DO 140 KFL=0,5 - SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL) - 140 CONTINUE - ELSEIF(MSTP(56).EQ.2) THEN -C...Call PDFLIB parton distributions. - XX=XG - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - SXP(0)=SXP(0)+WTSTP*XPGP*GLU - SXP(1)=SXP(1)+WTSTP*XPGP*DNV - SXP(2)=SXP(2)+WTSTP*XPGP*UPV - SXP(3)=SXP(3)+WTSTP*XPGP*STR - SXP(4)=SXP(4)+WTSTP*XPGP*CHM - SXP(5)=SXP(5)+WTSTP*XPGP*BOT - SXP(6)=SXP(6)+WTSTP*XPGP*TOP - ENDIF - 150 CONTINUE - SUMXPP=SXP(0)+2D0*SXP(1)+2D0*SXP(2) - IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT. - & PARP(14)*(SUMXPP+SUMXP))) GOTO 120 - -C...Put convolution into output arrays. - FCONV=AEMP*(-XL) - XPEL(0)=FCONV*SXP(0) - DO 160 KFL=1,6 - XPEL(KFL)=FCONV*SXP(KFL) - XPEL(-KFL)=XPEL(KFL) - 160 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDFL -C...Gives proton parton distribution at small x and/or Q^2 according to -C...correct limiting behaviour. - - SUBROUTINE PYPDFL(KF,X,Q2,XPQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPQ(-25:25),XPA(-25:25),XPB(-25:25),WTSB(-3:3) - DATA RMR/0.92D0/,RMP/0.38D0/,WTSB/0.5D0,1D0,1D0,5D0,1D0,1D0,0.5D0/ - -C...Send everything but protons/neutrons/VMD pions directly to PYPDFU. - MINT(92)=0 - KFA=IABS(KF) - IACC=0 - IF((KFA.EQ.2212.OR.KFA.EQ.2112).AND.MSTP(57).GE.2) IACC=1 - IF(KFA.EQ.211.AND.MSTP(57).GE.3) IACC=1 - IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND.MSTP(57).GE.3) IACC=1 - IF(IACC.EQ.0) THEN - CALL PYPDFU(KF,X,Q2,XPQ) - RETURN - ENDIF - -C...Reset. Check x. - DO 100 KFL=-25,25 - XPQ(KFL)=0D0 - 100 CONTINUE - IF(X.LE.0D0.OR.X.GE.1D0) THEN - WRITE(MSTU(11),5000) X - RETURN - ENDIF - -C...Define valence content. - KFC=KF - NV1=2 - NV2=1 - IF(KF.EQ.2212) THEN - KFV1=2 - KFV2=1 - ELSEIF(KF.EQ.-2212) THEN - KFV1=-2 - KFV2=-1 - ELSEIF(KF.EQ.2112) THEN - KFV1=1 - KFV2=2 - ELSEIF(KF.EQ.-2112) THEN - KFV1=-1 - KFV2=-2 - ELSEIF(KF.EQ.211) THEN - NV1=1 - KFV1=2 - KFV2=-1 - ELSEIF(KF.EQ.-211) THEN - NV1=1 - KFV1=-2 - KFV2=1 - ELSEIF(MINT(105).LE.223) THEN - KFV1=1 - WTV1=0.2D0 - KFV2=2 - WTV2=0.8D0 - ELSEIF(MINT(105).EQ.333) THEN - KFV1=3 - WTV1=1.0D0 - KFV2=1 - WTV2=0.0D0 - ELSEIF(MINT(105).EQ.443) THEN - KFV1=4 - WTV1=1.0D0 - KFV2=1 - WTV2=0.0D0 - ENDIF - -C...Do naive evaluation and find min Q^2, boundary Q^2 and x_0. - CALL PYPDFU(KFC,X,Q2,XPA) - Q2MN=MAX(3D0,VINT(231)) - Q2B=2D0+0.052D0**2*EXP(3.56D0*SQRT(MAX(0D0,-LOG(3D0*X)))) - XMN=EXP(-(LOG((Q2MN-2D0)/0.052D0**2)/3.56D0)**2)/3D0 - -C...Large Q2 and large x: naive call is enough. - IF(Q2.GT.Q2MN.AND.Q2.GT.Q2B) THEN - DO 110 KFL=-25,25 - XPQ(KFL)=XPA(KFL) - 110 CONTINUE - MINT(92)=1 - -C...Small Q2 and large x: dampen boundary value. - ELSEIF(X.GT.XMN) THEN - -C...Evaluate at boundary and define dampening factors. - CALL PYPDFU(KFC,X,Q2MN,XPA) - FV=(Q2*(Q2MN+RMR)/(Q2MN*(Q2+RMR)))**(0.55D0*(1D0-X)/(1D0-XMN)) - FS=(Q2*(Q2MN+RMP)/(Q2MN*(Q2+RMP)))**1.08D0 - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFV1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFV2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) - XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) - XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) - XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) - ENDIF - -C...Dampen valence and sea separately. Put back together. - DO 120 KFL=-25,25 - XPQ(KFL)=FS*XPA(KFL) - 120 CONTINUE - IF(KFA.NE.22) THEN - XPQ(KFV1)=XPQ(KFV1)+FV*XFV1 - XPQ(KFV2)=XPQ(KFV2)+FV*XFV2 - ELSE - XPQ(KFV1)=XPQ(KFV1)+FV*WTV1*VINT(232) - XPQ(-KFV1)=XPQ(-KFV1)+FV*WTV1*VINT(232) - XPQ(KFV2)=XPQ(KFV2)+FV*WTV2*VINT(232) - XPQ(-KFV2)=XPQ(-KFV2)+FV*WTV2*VINT(232) - ENDIF - MINT(92)=2 - -C...Large Q2 and small x: interpolate behaviour. - ELSEIF(Q2.GT.Q2MN) THEN - -C...Evaluate at extremes and define coefficients for interpolation. - CALL PYPDFU(KFC,XMN,Q2MN,XPA) - VI232A=VINT(232) - CALL PYPDFU(KFC,X,Q2B,XPB) - VI232B=VINT(232) - FLA=LOG(Q2B/Q2)/LOG(Q2B/Q2MN) - FVA=(X/XMN)**0.45D0*FLA - FSA=(X/XMN)**(-0.08D0)*FLA - FB=1D0-FLA - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFVA1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFVA2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - XFVB1=XPB(KFV1)-XPB(-KFV1) - XPB(KFV1)=XPB(-KFV1) - XFVB2=XPB(KFV2)-XPB(-KFV2) - XPB(KFV2)=XPB(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VI232A - XPA(-KFV1)=XPA(-KFV1)-WTV1*VI232A - XPA(KFV2)=XPA(KFV2)-WTV2*VI232A - XPA(-KFV2)=XPA(-KFV2)-WTV2*VI232A - XPB(KFV1)=XPB(KFV1)-WTV1*VI232B - XPB(-KFV1)=XPB(-KFV1)-WTV1*VI232B - XPB(KFV2)=XPB(KFV2)-WTV2*VI232B - XPB(-KFV2)=XPB(-KFV2)-WTV2*VI232B - ENDIF - -C...Interpolate for valence and sea. Put back together. - DO 130 KFL=-25,25 - XPQ(KFL)=FSA*XPA(KFL)+FB*XPB(KFL) - 130 CONTINUE - IF(KFA.NE.22) THEN - XPQ(KFV1)=XPQ(KFV1)+(FVA*XFVA1+FB*XFVB1) - XPQ(KFV2)=XPQ(KFV2)+(FVA*XFVA2+FB*XFVB2) - ELSE - XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VI232A+FB*VI232B) - XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VI232A+FB*VI232B) - XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VI232A+FB*VI232B) - XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VI232A+FB*VI232B) - ENDIF - MINT(92)=3 - -C...Small Q2 and small x: dampen boundary value and add term. - ELSE - -C...Evaluate at boundary and define dampening factors. - CALL PYPDFU(KFC,XMN,Q2MN,XPA) - FB=(XMN-X)*(Q2MN-Q2)/(XMN*Q2MN) - FA=1D0-FB - FVC=(X/XMN)**0.45D0*(Q2/(Q2+RMR))**0.55D0 - FVA=FVC*FA*((Q2MN+RMR)/Q2MN)**0.55D0 - FVB=FVC*FB*1.10D0*XMN**0.45D0*0.11D0 - FSC=(X/XMN)**(-0.08D0)*(Q2/(Q2+RMP))**1.08D0 - FSA=FSC*FA*((Q2MN+RMP)/Q2MN)**1.08D0 - FSB=FSC*FB*0.21D0*XMN**(-0.08D0)*0.21D0 - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFV1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFV2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) - XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) - XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) - XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) - ENDIF - -C...Dampen valence and sea separately. Add constant terms. -C...Put back together. - DO 140 KFL=-25,25 - XPQ(KFL)=FSA*XPA(KFL) - 140 CONTINUE - IF(KFA.NE.22) THEN - DO 150 KFL=-3,3 - XPQ(KFL)=XPQ(KFL)+FSB*WTSB(KFL) - 150 CONTINUE - XPQ(KFV1)=XPQ(KFV1)+(FVA*XFV1+FVB*NV1) - XPQ(KFV2)=XPQ(KFV2)+(FVA*XFV2+FVB*NV2) - ELSE - DO 160 KFL=-3,3 - XPQ(KFL)=XPQ(KFL)+VINT(281)*FSB*WTSB(KFL) - 160 CONTINUE - XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) - ENDIF - XPQ(21)=XPQ(0) - MINT(92)=4 - ENDIF - -C...Format for error printout. - 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) - - RETURN - END - -C********************************************************************* - -C...PYPDFU -C...Gives electron, muon, tau, photon, pi+, neutron, proton and hyperon -C...parton distributions according to a few different parametrizations. -C...Note that what is coded is x times the probability distribution, -C...i.e. xq(x,Q2) etc. - - SUBROUTINE PYPDFU(KF,X,Q2,XPQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT8/ -C...Local arrays. - DIMENSION XPQ(-25:25),XPEL(-25:25),XPGA(-6:6),VXPGA(-6:6), - &XPPI(-6:6),XPPR(-6:6) - -C...Interface to PDFLIB. - COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX - SAVE /W50513/ - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, - &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Data related to Schuler-Sjostrand photon distributions. - DATA ALAMGA/0.2D0/, PMCGA/1.3D0/, PMBGA/4.6D0/ - -C...Reset parton distributions. - MINT(92)=0 - DO 100 KFL=-25,25 - XPQ(KFL)=0D0 - 100 CONTINUE - -C...Check x and particle species. - IF(X.LE.0D0.OR.X.GE.1D0) THEN - WRITE(MSTU(11),5000) X - RETURN - ENDIF - KFA=IABS(KF) - IF(KFA.NE.11.AND.KFA.NE.13.AND.KFA.NE.15.AND.KFA.NE.22.AND. - &KFA.NE.211.AND.KFA.NE.2112.AND.KFA.NE.2212.AND.KFA.NE.3122.AND. - &KFA.NE.3112.AND.KFA.NE.3212.AND.KFA.NE.3222.AND.KFA.NE.3312.AND. - &KFA.NE.3322.AND.KFA.NE.3334.AND.KFA.NE.111.AND.KFA.NE.321.AND. - &KFA.NE.310.AND.KFA.NE.130) THEN - WRITE(MSTU(11),5100) KF - RETURN - ENDIF - -C...Electron (or muon or tau) parton distribution call. - IF(KFA.EQ.11.OR.KFA.EQ.13.OR.KFA.EQ.15) THEN - CALL PYPDEL(KFA,X,Q2,XPEL) - DO 110 KFL=-25,25 - XPQ(KFL)=XPEL(KFL) - 110 CONTINUE - -C...Photon parton distribution call (VDM+anomalous). - ELSEIF(KFA.EQ.22.AND.MINT(109).LE.1) THEN - IF(MSTP(56).EQ.1.AND.MSTP(55).EQ.1) THEN - CALL PYPDGA(X,Q2,XPGA) - DO 120 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 120 CONTINUE - ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.7) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 130 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 130 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.11) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 140 KFL=-6,6 - XPQ(KFL)=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) - 140 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=3 - PARM(2)='NGROUP' - VALUE(2)=MSTP(55)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(55),1000) - IF(MINT(93).NE.3000000+MSTP(55)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=3000000+MSTP(55) - ENDIF - XX=X - QQ2=MAX(0D0,Q2MIN,Q2) - IF(MSTP(57).EQ.0) QQ2=Q2MIN - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - IP2=MSTP(60) - IF(MSTP(55).EQ.5004) THEN - IF(5D0*P2.LT.QQ2.AND. - & QQ2.GT.0.6D0.AND.QQ2.LT.5D4.AND. - & P2.GE.0D0.AND.P2.LT.10D0.AND. - & XX.GT.1D-4.AND.XX.LT.1D0) THEN - CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - & BOT,TOP,GLU) - ELSE - UPV=0D0 - DNV=0D0 - USEA=0D0 - DSEA=0D0 - STR=0D0 - CHM=0D0 - BOT=0D0 - TOP=0D0 - GLU=0D0 - ENDIF - ELSE - IF(P2.LT.QQ2) THEN - CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - & BOT,TOP,GLU) - ELSE - UPV=0D0 - DNV=0D0 - USEA=0D0 - DSEA=0D0 - STR=0D0 - CHM=0D0 - BOT=0D0 - TOP=0D0 - GLU=0D0 - ENDIF - ENDIF - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DNV - XPQ(-1)=DNV - XPQ(2)=UPV - XPQ(-2)=UPV - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(56),MSTP(55) - ENDIF - -C...Pion/gammaVDM parton distribution call. - ELSEIF(KFA.EQ.211.OR.KFA.EQ.111.OR.KFA.EQ.321.OR.KFA.EQ.130.OR. - &KFA.EQ.310.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN - IF(KFA.EQ.22.AND.MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND. - & MSTP(55).LE.12) THEN - ISET=1+MOD(MSTP(55)-1,4) - Q2MX=Q2 - P2MX=0.36D0 - IF(ISET.GE.3) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(ISET,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 150 KFL=-6,6 - XPQ(KFL)=XPVMD(KFL) - 150 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(54).EQ.1.AND.MSTP(53).GE.1.AND.MSTP(53).LE.3) THEN - CALL PYPDPI(X,Q2,XPPI) - DO 160 KFL=-6,6 - XPQ(KFL)=XPPI(KFL) - 160 CONTINUE - ELSEIF(MSTP(54).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=2 - PARM(2)='NGROUP' - VALUE(2)=MSTP(53)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(53),1000) - IF(MINT(93).NE.2000000+MSTP(53)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=2000000+MSTP(53) - ENDIF - XX=X - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DSEA - XPQ(-1)=UPV+DSEA - XPQ(2)=UPV+USEA - XPQ(-2)=USEA - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(54),MSTP(53) - ENDIF - -C...Anomalous photon parton distribution call. - ELSEIF(KFA.EQ.22.AND.MINT(109).EQ.3) THEN - Q2MX=Q2 - P2MX=PARP(15)**2 - IF(MSTP(56).EQ.1.AND.MSTP(55).LE.8) THEN - IF(MSTP(55).EQ.5.OR.MSTP(55).EQ.6) P2MX=0.36D0 - IF(MSTP(55).EQ.7.OR.MSTP(55).EQ.8) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GM,XPGA) - DO 170 KFL=-6,6 - XPQ(KFL)=XPANL(KFL)+XPANH(KFL) - 170 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.1) THEN - IF(MSTP(55).EQ.9.OR.MSTP(55).EQ.10) P2MX=0.36D0 - IF(MSTP(55).EQ.11.OR.MSTP(55).EQ.12) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GM,XPGA) - DO 180 KFL=-6,6 - XPQ(KFL)=MAX(0D0,XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)) - 180 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.2) THEN - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGANO(0,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA) - DO 190 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 190 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(55).GE.1.AND.MSTP(55).LE.5) THEN - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGVMD(0,MSTP(55),X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) - DO 200 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 200 CONTINUE - VINT(231)=P2MX - ELSE - 210 RKF=11D0*PYR(0) - KFR=1 - IF(RKF.GT.1D0) KFR=2 - IF(RKF.GT.5D0) KFR=3 - IF(RKF.GT.6D0) KFR=4 - IF(RKF.GT.10D0) KFR=5 - IF(KFR.EQ.4.AND.Q2.LT.PMCGA**2) GOTO 210 - IF(KFR.EQ.5.AND.Q2.LT.PMBGA**2) GOTO 210 - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGVMD(0,KFR,X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) - DO 220 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 220 CONTINUE - VINT(231)=P2MX - ENDIF - -C...Proton parton distribution call. - ELSE - IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN - CALL PYPDPR(X,Q2,XPPR) - DO 230 KFL=-6,6 - XPQ(KFL)=XPPR(KFL) - 230 CONTINUE - ELSEIF(MSTP(52).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=1 - PARM(2)='NGROUP' - VALUE(2)=MSTP(51)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(51),1000) - IF(MINT(93).NE.1000000+MSTP(51)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=1000000+MSTP(51) - ENDIF - XX=X - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DNV+DSEA - XPQ(-1)=DSEA - XPQ(2)=UPV+USEA - XPQ(-2)=USEA - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(52),MSTP(51) - ENDIF - ENDIF - -C...Isospin average for pi0/gammaVDM. - IF(KFA.EQ.111.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN - IF(KFA.EQ.22.AND.MSTP(55).GE.5.AND.MSTP(55).LE.12) THEN - XPV=XPQ(2)-XPQ(1) - XPQ(2)=XPQ(1) - XPQ(-2)=XPQ(-1) - ELSE - XPS=0.5D0*(XPQ(1)+XPQ(-2)) - XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS - XPQ(2)=XPS - XPQ(-1)=XPS - ENDIF - IF(KFA.EQ.22.AND.MINT(105).LE.223) THEN - XPQ(1)=XPQ(1)+0.2D0*XPV - XPQ(-1)=XPQ(-1)+0.2D0*XPV - XPQ(2)=XPQ(2)+0.8D0*XPV - XPQ(-2)=XPQ(-2)+0.8D0*XPV - ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.333) THEN - XPQ(3)=XPQ(3)+XPV - XPQ(-3)=XPQ(-3)+XPV - ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.443) THEN - XPQ(4)=XPQ(4)+XPV - XPQ(-4)=XPQ(-4)+XPV - IF(MSTP(55).GE.9) THEN - DO 240 KFL=-6,6 - XPQ(KFL)=0D0 - 240 CONTINUE - ENDIF - ELSE - XPQ(1)=XPQ(1)+0.5D0*XPV - XPQ(-1)=XPQ(-1)+0.5D0*XPV - XPQ(2)=XPQ(2)+0.5D0*XPV - XPQ(-2)=XPQ(-2)+0.5D0*XPV - ENDIF - -C...Rescale for gammaVDM by effective gamma -> rho coupling. -C+++Do not rescale? - IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND..NOT.(MSTP(56).EQ.1 - & .AND.MSTP(55).GE.5.AND.MSTP(55).LE.12)) THEN - DO 250 KFL=-6,6 - XPQ(KFL)=VINT(281)*XPQ(KFL) - 250 CONTINUE - VINT(232)=VINT(281)*XPV - ENDIF - -C...Simple recipes for kaons. - ELSEIF(KFA.EQ.321) THEN - XPQ(-3)=XPQ(-3)+XPQ(-1)-XPQ(1) - XPQ(-1)=XPQ(1) - ELSEIF(KFA.EQ.130.OR.KFA.EQ.310) THEN - XPS=0.5D0*(XPQ(1)+XPQ(-2)) - XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS - XPQ(2)=XPS - XPQ(-1)=XPS - XPQ(1)=XPQ(1)+0.5D0*XPV - XPQ(-1)=XPQ(-1)+0.5D0*XPV - XPQ(3)=XPQ(3)+0.5D0*XPV - XPQ(-3)=XPQ(-3)+0.5D0*XPV - -C...Isospin conjugation for neutron. - ELSEIF(KFA.EQ.2112) THEN - XPS=XPQ(1) - XPQ(1)=XPQ(2) - XPQ(2)=XPS - XPS=XPQ(-1) - XPQ(-1)=XPQ(-2) - XPQ(-2)=XPS - -C...Simple recipes for hyperon (average valence parton distribution). - ELSEIF(KFA.EQ.3122.OR.KFA.EQ.3112.OR.KFA.EQ.3212.OR.KFA.EQ.3222 - & .OR.KFA.EQ.3312.OR.KFA.EQ.3322.OR.KFA.EQ.3334) THEN - XPVAL=(XPQ(1)+XPQ(2)-XPQ(-1)-XPQ(-2))/3D0 - XPSEA=0.5D0*(XPQ(-1)+XPQ(-2)) - XPQ(1)=XPSEA - XPQ(2)=XPSEA - XPQ(-1)=XPSEA - XPQ(-2)=XPSEA - XPQ(KFA/1000)=XPQ(KFA/1000)+XPVAL - XPQ(MOD(KFA/100,10))=XPQ(MOD(KFA/100,10))+XPVAL - XPQ(MOD(KFA/10,10))=XPQ(MOD(KFA/10,10))+XPVAL - ENDIF - -C...Charge conjugation for antiparticle. - IF(KF.LT.0) THEN - DO 260 KFL=1,25 - IF(KFL.EQ.21.OR.KFL.EQ.22.OR.KFL.EQ.23.OR.KFL.EQ.25) GOTO 260 - XPS=XPQ(KFL) - XPQ(KFL)=XPQ(-KFL) - XPQ(-KFL)=XPS - 260 CONTINUE - ENDIF - -C...Allow gluon also in position 21. - XPQ(21)=XPQ(0) - -C...Check positivity and reset above maximum allowed flavour. - DO 270 KFL=-25,25 - XPQ(KFL)=MAX(0D0,XPQ(KFL)) - IF(IABS(KFL).GT.MSTP(58).AND.IABS(KFL).LE.8) XPQ(KFL)=0D0 - 270 CONTINUE - -C...Formats for error printouts. - 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) - 5100 FORMAT(' Error: illegal particle code for parton distribution;', - &' KF =',I5) - 5200 FORMAT(' Error: unknown parton distribution; KF, library, set =', - &3I5) - - RETURN - END - -C********************************************************************* - -C...PYPDGA -C...Gives photon parton distribution. - - SUBROUTINE PYPDGA(X,Q2,XPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPGA(-6:6),DGAG(4,3),DGBG(4,3),DGCG(4,3),DGAN(4,3), - &DGBN(4,3),DGCN(4,3),DGDN(4,3),DGEN(4,3),DGAS(4,3),DGBS(4,3), - &DGCS(4,3),DGDS(4,3),DGES(4,3) - -C...The following data lines are coefficients needed in the -C...Drees and Grassie photon parton distribution parametrization. - DATA DGAG/-.207D0,.6158D0,1.074D0,0.D0,.8926D-2,.6594D0, - &.4766D0,.1975D-1,.03197D0,1.018D0,.2461D0,.2707D-1/ - DATA DGBG/-.1987D0,.6257D0,8.352D0,5.024D0,.5085D-1,.2774D0, - &-.3906D0,-.3212D0,-.618D-2,.9476D0,-.6094D0,-.1067D-1/ - DATA DGCG/5.119D0,-.2752D0,-6.993D0,2.298D0,-.2313D0,.1382D0, - &6.542D0,.5162D0,-.1216D0,.9047D0,2.653D0,.2003D-2/ - DATA DGAN/2.285D0,-.1526D-1,1330.D0,4.219D0,-.3711D0,1.061D0, - &4.758D0,-.1503D-1,15.8D0,-.9464D0,-.5D0,-.2118D0/ - DATA DGBN/6.073D0,-.8132D0,-41.31D0,3.165D0,-.1717D0,.7815D0, - &1.535D0,.7067D-2,2.742D0,-.7332D0,.7148D0,3.287D0/ - DATA DGCN/-.4202D0,.1778D-1,.9216D0,.18D0,.8766D-1,.2197D-1, - &.1096D0,.204D0,.2917D-1,.4657D-1,.1785D0,.4811D-1/ - DATA DGDN/-.8083D-1,.6346D0,1.208D0,.203D0,-.8915D0,.2857D0, - &2.973D0,.1185D0,-.342D-1,.7196D0,.7338D0,.8139D-1/ - DATA DGEN/.5526D-1,1.136D0,.9512D0,.1163D-1,-.1816D0,.5866D0, - &2.421D0,.4059D0,-.2302D-1,.9229D0,.5873D0,-.79D-4/ - DATA DGAS/16.69D0,-.7916D0,1099.D0,4.428D0,-.1207D0,1.071D0, - &1.977D0,-.8625D-2,6.734D0,-1.008D0,-.8594D-1,.7625D-1/ - DATA DGBS/.176D0,.4794D-1,1.047D0,.25D-1,25.D0,-1.648D0, - &-.1563D-1,6.438D0,59.88D0,-2.983D0,4.48D0,.9686D0/ - DATA DGCS/-.208D-1,.3386D-2,4.853D0,.8404D0,-.123D-1,1.162D0, - &.4824D0,-.11D-1,-.3226D-2,.8432D0,.3616D0,.1383D-2/ - DATA DGDS/-.1685D-1,1.353D0,1.426D0,1.239D0,-.9194D-1,.7912D0, - &.6397D0,2.327D0,-.3321D-1,.9475D0,-.3198D0,.2132D-1/ - DATA DGES/-.1986D0,1.1D0,1.136D0,-.2779D0,.2015D-1,.9869D0, - &-.7036D-1,.1694D-1,.1059D0,.6954D0,-.6663D0,.3683D0/ - -C...Photon parton distribution from Drees and Grassie. -C...Allowed variable range: 1 GeV^2 < Q^2 < 10000 GeV^2. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - 100 CONTINUE - VINT(231)=1D0 - IF(MSTP(57).LE.0) THEN - T=LOG(1D0/0.16D0) - ELSE - T=LOG(MIN(1D4,MAX(1D0,Q2))/0.16D0) - ENDIF - X1=1D0-X - NF=3 - IF(Q2.GT.25D0) NF=4 - IF(Q2.GT.300D0) NF=5 - NFE=NF-2 - AEM=PARU(101) - -C...Evaluate gluon content. - DGA=DGAG(1,NFE)*T**DGAG(2,NFE)+DGAG(3,NFE)*T**(-DGAG(4,NFE)) - DGB=DGBG(1,NFE)*T**DGBG(2,NFE)+DGBG(3,NFE)*T**(-DGBG(4,NFE)) - DGC=DGCG(1,NFE)*T**DGCG(2,NFE)+DGCG(3,NFE)*T**(-DGCG(4,NFE)) - XPGL=DGA*X**DGB*X1**DGC - -C...Evaluate up- and down-type quark content. - DGA=DGAN(1,NFE)*T**DGAN(2,NFE)+DGAN(3,NFE)*T**(-DGAN(4,NFE)) - DGB=DGBN(1,NFE)*T**DGBN(2,NFE)+DGBN(3,NFE)*T**(-DGBN(4,NFE)) - DGC=DGCN(1,NFE)*T**DGCN(2,NFE)+DGCN(3,NFE)*T**(-DGCN(4,NFE)) - DGD=DGDN(1,NFE)*T**DGDN(2,NFE)+DGDN(3,NFE)*T**(-DGDN(4,NFE)) - DGE=DGEN(1,NFE)*T**DGEN(2,NFE)+DGEN(3,NFE)*T**(-DGEN(4,NFE)) - XPQN=X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE - DGA=DGAS(1,NFE)*T**DGAS(2,NFE)+DGAS(3,NFE)*T**(-DGAS(4,NFE)) - DGB=DGBS(1,NFE)*T**DGBS(2,NFE)+DGBS(3,NFE)*T**(-DGBS(4,NFE)) - DGC=DGCS(1,NFE)*T**DGCS(2,NFE)+DGCS(3,NFE)*T**(-DGCS(4,NFE)) - DGD=DGDS(1,NFE)*T**DGDS(2,NFE)+DGDS(3,NFE)*T**(-DGDS(4,NFE)) - DGE=DGES(1,NFE)*T**DGES(2,NFE)+DGES(3,NFE)*T**(-DGES(4,NFE)) - DGF=9D0 - IF(NF.EQ.4) DGF=10D0 - IF(NF.EQ.5) DGF=55D0/6D0 - XPQS=DGF*X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE - IF(NF.LE.3) THEN - XPQU=(XPQS+9D0*XPQN)/6D0 - XPQD=(XPQS-4.5D0*XPQN)/6D0 - ELSEIF(NF.EQ.4) THEN - XPQU=(XPQS+6D0*XPQN)/8D0 - XPQD=(XPQS-6D0*XPQN)/8D0 - ELSE - XPQU=(XPQS+7.5D0*XPQN)/10D0 - XPQD=(XPQS-5D0*XPQN)/10D0 - ENDIF - -C...Put into output arrays. - XPGA(0)=AEM*XPGL - XPGA(1)=AEM*XPQD - XPGA(2)=AEM*XPQU - XPGA(3)=AEM*XPQD - IF(NF.GE.4) XPGA(4)=AEM*XPQU - IF(NF.GE.5) XPGA(5)=AEM*XPQD - DO 110 KFL=1,6 - XPGA(-KFL)=XPGA(KFL) - 110 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYPDPI -C...Gives pi+ parton distribution according to two different -C...parametrizations. - - SUBROUTINE PYPDPI(X,Q2,XPPI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPPI(-6:6),COW(3,5,4,2),XQ(9),TS(6) - -C...The following data lines are coefficients needed in the -C...Owens pion parton distribution parametrizations, see below. -C...Expansion coefficients for up and down valence quark distributions. - DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/ - &4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ - DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/ - &4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ -C...Expansion coefficients for gluon distribution. - DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/ - &8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00, - &-1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01, - &1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/ - DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/ - &7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00, - &-9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00, - &5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/ -C...Expansion coefficients for (up+down+strange) quark sea distribution. - DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/ - &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, - &-2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00, - &1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/ - DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/ - &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, - &-1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01, - &-1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/ -C...Expansion coefficients for charm quark sea distribution. - DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/ - &0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00, - &7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00, - &-6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/ - DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/ - &0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00, - &6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01, - &-4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/ - -C...Euler's beta function, requires ordinary Gamma function - EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) - -C...Reset output array. - DO 100 KFL=-6,6 - XPPI(KFL)=0D0 - 100 CONTINUE - - IF(MSTP(53).LE.2) THEN -C...Pion parton distributions from Owens. -C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2. - -C...Determine set, Lambda and s expansion variable. - NSET=MSTP(53) - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.4D0 - VINT(231)=4D0 - IF(MSTP(57).LE.0) THEN - SD=0D0 - ELSE - Q2IN=MIN(2D3,MAX(4D0,Q2)) - SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) - ENDIF - -C...Calculate parton distributions. - DO 120 KFL=1,4 - DO 110 IS=1,5 - TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+ - & COW(3,IS,KFL,NSET)*SD**2 - 110 CONTINUE - IF(KFL.EQ.1) THEN - XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)/EULBET(TS(1),TS(2)+1D0) - ELSE - XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ - & TS(5)*X**2) - ENDIF - 120 CONTINUE - -C...Put into output array. - XPPI(0)=XQ(2) - XPPI(1)=XQ(3)/6D0 - XPPI(2)=XQ(1)+XQ(3)/6D0 - XPPI(3)=XQ(3)/6D0 - XPPI(4)=XQ(4) - XPPI(-1)=XQ(1)+XQ(3)/6D0 - XPPI(-2)=XQ(3)/6D0 - XPPI(-3)=XQ(3)/6D0 - XPPI(-4)=XQ(4) - -C...Leading order pion parton distributions from Glueck, Reya and Vogt. -C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and -C...10^-5 < x < 1. - ELSE - -C...Determine s expansion variable and some x expressions. - VINT(231)=0.25D0 - IF(MSTP(57).LE.0) THEN - SD=0D0 - ELSE - Q2IN=MIN(1D8,MAX(0.25D0,Q2)) - SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) - ENDIF - SD2=SD**2 - XL=-LOG(X) - XS=SQRT(X) - -C...Evaluate valence, gluon and sea distributions. - XFVAL=(0.519D0+0.180D0*SD-0.011D0*SD2)*X**(0.499D0-0.027D0*SD)* - & (1D0+(0.381D0-0.419D0*SD)*XS)*(1D0-X)**(0.367D0+0.563D0*SD) - XFGLU=(X**(0.482D0+0.341D0*SQRT(SD))*((0.678D0+0.877D0* - & SD-0.175D0*SD2)+ - & (0.338D0-1.597D0*SD)*XS+(-0.233D0*SD+0.406D0*SD2)*X)+ - & SD**0.599D0*EXP(-(0.618D0+2.070D0*SD)+SQRT(3.676D0*SD**1.263D0* - & XL)))* - & (1D0-X)**(0.390D0+1.053D0*SD) - XFSEA=SD**0.55D0*(1D0-0.748D0*XS+(0.313D0+0.935D0*SD)*X)*(1D0- - & X)**3.359D0* - & EXP(-(4.433D0+1.301D0*SD)+SQRT((9.30D0-0.887D0*SD)*SD**0.56D0* - & XL))/ - & XL**(2.538D0-0.763D0*SD) - IF(SD.LE.0.888D0) THEN - XFCHM=0D0 - ELSE - XFCHM=(SD-0.888D0)**1.02D0*(1D0+1.008D0*X)*(1D0-X)**(1.208D0+ - & 0.771D0*SD)* - & EXP(-(4.40D0+1.493D0*SD)+SQRT((2.032D0+1.901D0*SD)*SD**0.39D0* - & XL)) - ENDIF - IF(SD.LE.1.351D0) THEN - XFBOT=0D0 - ELSE - XFBOT=(SD-1.351D0)**1.03D0*(1D0-X)**(0.697D0+0.855D0*SD)* - & EXP(-(4.51D0+1.490D0*SD)+SQRT((3.056D0+1.694D0*SD)*SD**0.39D0* - & XL)) - ENDIF - -C...Put into output array. - XPPI(0)=XFGLU - XPPI(1)=XFSEA - XPPI(2)=XFSEA - XPPI(3)=XFSEA - XPPI(4)=XFCHM - XPPI(5)=XFBOT - DO 130 KFL=1,5 - XPPI(-KFL)=XPPI(KFL) - 130 CONTINUE - XPPI(2)=XPPI(2)+XFVAL - XPPI(-1)=XPPI(-1)+XFVAL - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDPO -C...Auxiliary to PYPDPR. Gives proton parton distributions according to -C...a few older parametrizations, now obsolete but convenient for -C...backwards checks. - - SUBROUTINE PYPDPO(X,Q2,XPPR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ - DIMENSION XPPR(-6:6),XQ(9),TX(6),TT(6),TS(6),NEHLQ(8,2), - &CEHLQ(6,6,2,8,2),CDO(3,6,5,2) - - -C...The following data lines are coefficients needed in the -C...Eichten, Hinchliffe, Lane, Quigg proton structure function -C...parametrizations, see below. -C...Powers of 1-x in different cases. - DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ -C...Expansion coefficients for up valence quark distribution. - DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 7.677D-01,-2.087D-01,-3.303D-01,-2.517D-02,-1.570D-02,-1.000D-04, - 2-5.326D-01,-2.661D-01, 3.201D-01, 1.192D-01, 2.434D-02, 7.620D-03, - 3 2.162D-01, 1.881D-01,-8.375D-02,-6.515D-02,-1.743D-02,-5.040D-03, - 4-9.211D-02,-9.952D-02, 1.373D-02, 2.506D-02, 8.770D-03, 2.550D-03, - 5 3.670D-02, 4.409D-02, 9.600D-04,-7.960D-03,-3.420D-03,-1.050D-03, - 6-1.549D-02,-2.026D-02,-3.060D-03, 2.220D-03, 1.240D-03, 4.100D-04, - 1 2.395D-01, 2.905D-01, 9.778D-02, 2.149D-02, 3.440D-03, 5.000D-04, - 2 1.751D-02,-6.090D-03,-2.687D-02,-1.916D-02,-7.970D-03,-2.750D-03, - 3-5.760D-03,-5.040D-03, 1.080D-03, 2.490D-03, 1.530D-03, 7.500D-04, - 4 1.740D-03, 1.960D-03, 3.000D-04,-3.400D-04,-2.900D-04,-1.800D-04, - 5-5.300D-04,-6.400D-04,-1.700D-04, 4.000D-05, 6.000D-05, 4.000D-05, - 6 1.700D-04, 2.200D-04, 8.000D-05, 1.000D-05,-1.000D-05,-1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 7.237D-01,-2.189D-01,-2.995D-01,-1.909D-02,-1.477D-02, 2.500D-04, - 2-5.314D-01,-2.425D-01, 3.283D-01, 1.119D-01, 2.223D-02, 7.070D-03, - 3 2.289D-01, 1.890D-01,-9.859D-02,-6.900D-02,-1.747D-02,-5.080D-03, - 4-1.041D-01,-1.084D-01, 2.108D-02, 2.975D-02, 9.830D-03, 2.830D-03, - 5 4.394D-02, 5.116D-02,-1.410D-03,-1.055D-02,-4.230D-03,-1.270D-03, - 6-1.991D-02,-2.539D-02,-2.780D-03, 3.430D-03, 1.720D-03, 5.500D-04, - 1 2.410D-01, 2.884D-01, 9.369D-02, 1.900D-02, 2.530D-03, 2.400D-04, - 2 1.765D-02,-9.220D-03,-3.037D-02,-2.085D-02,-8.440D-03,-2.810D-03, - 3-6.450D-03,-5.260D-03, 1.720D-03, 3.110D-03, 1.830D-03, 8.700D-04, - 4 2.120D-03, 2.320D-03, 2.600D-04,-4.900D-04,-3.900D-04,-2.300D-04, - 5-6.900D-04,-8.200D-04,-2.000D-04, 7.000D-05, 9.000D-05, 6.000D-05, - 6 2.400D-04, 3.100D-04, 1.100D-04, 0.000D+00,-2.000D-05,-2.000D-05/ -C...Expansion coefficients for down valence quark distribution. - DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 3.813D-01,-8.090D-02,-1.634D-01,-2.185D-02,-8.430D-03,-6.200D-04, - 2-2.948D-01,-1.435D-01, 1.665D-01, 6.638D-02, 1.473D-02, 4.080D-03, - 3 1.252D-01, 1.042D-01,-4.722D-02,-3.683D-02,-1.038D-02,-2.860D-03, - 4-5.478D-02,-5.678D-02, 8.900D-03, 1.484D-02, 5.340D-03, 1.520D-03, - 5 2.220D-02, 2.567D-02,-3.000D-05,-4.970D-03,-2.160D-03,-6.500D-04, - 6-9.530D-03,-1.204D-02,-1.510D-03, 1.510D-03, 8.300D-04, 2.700D-04, - 1 1.261D-01, 1.354D-01, 3.958D-02, 8.240D-03, 1.660D-03, 4.500D-04, - 2 3.890D-03,-1.159D-02,-1.625D-02,-9.610D-03,-3.710D-03,-1.260D-03, - 3-1.910D-03,-5.600D-04, 1.590D-03, 1.590D-03, 8.400D-04, 3.900D-04, - 4 6.400D-04, 4.900D-04,-1.500D-04,-2.900D-04,-1.800D-04,-1.000D-04, - 5-2.000D-04,-1.900D-04, 0.000D+00, 6.000D-05, 4.000D-05, 3.000D-05, - 6 7.000D-05, 8.000D-05, 2.000D-05,-1.000D-05,-1.000D-05,-1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 3.578D-01,-8.622D-02,-1.480D-01,-1.840D-02,-7.820D-03,-4.500D-04, - 2-2.925D-01,-1.304D-01, 1.696D-01, 6.243D-02, 1.353D-02, 3.750D-03, - 3 1.318D-01, 1.041D-01,-5.486D-02,-3.872D-02,-1.038D-02,-2.850D-03, - 4-6.162D-02,-6.143D-02, 1.303D-02, 1.740D-02, 5.940D-03, 1.670D-03, - 5 2.643D-02, 2.957D-02,-1.490D-03,-6.450D-03,-2.630D-03,-7.700D-04, - 6-1.218D-02,-1.497D-02,-1.260D-03, 2.240D-03, 1.120D-03, 3.500D-04, - 1 1.263D-01, 1.334D-01, 3.732D-02, 7.070D-03, 1.260D-03, 3.400D-04, - 2 3.660D-03,-1.357D-02,-1.795D-02,-1.031D-02,-3.880D-03,-1.280D-03, - 3-2.100D-03,-3.600D-04, 2.050D-03, 1.920D-03, 9.800D-04, 4.400D-04, - 4 7.700D-04, 5.400D-04,-2.400D-04,-3.900D-04,-2.400D-04,-1.300D-04, - 5-2.600D-04,-2.300D-04, 2.000D-05, 9.000D-05, 6.000D-05, 4.000D-05, - 6 9.000D-05, 1.000D-04, 2.000D-05,-2.000D-05,-2.000D-05,-1.000D-05/ -C...Expansion coefficients for up and down sea quark distributions. - DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 6.870D-02,-6.861D-02, 2.973D-02,-5.400D-03, 3.780D-03,-9.700D-04, - 2-1.802D-02, 1.400D-04, 6.490D-03,-8.540D-03, 1.220D-03,-1.750D-03, - 3-4.650D-03, 1.480D-03,-5.930D-03, 6.000D-04,-1.030D-03,-8.000D-05, - 4 6.440D-03, 2.570D-03, 2.830D-03, 1.150D-03, 7.100D-04, 3.300D-04, - 5-3.930D-03,-2.540D-03,-1.160D-03,-7.700D-04,-3.600D-04,-1.900D-04, - 6 2.340D-03, 1.930D-03, 5.300D-04, 3.700D-04, 1.600D-04, 9.000D-05, - 1 1.014D+00,-1.106D+00, 3.374D-01,-7.444D-02, 8.850D-03,-8.700D-04, - 2 9.233D-01,-1.285D+00, 4.475D-01,-9.786D-02, 1.419D-02,-1.120D-03, - 3 4.888D-02,-1.271D-01, 8.606D-02,-2.608D-02, 4.780D-03,-6.000D-04, - 4-2.691D-02, 4.887D-02,-1.771D-02, 1.620D-03, 2.500D-04,-6.000D-05, - 5 7.040D-03,-1.113D-02, 1.590D-03, 7.000D-04,-2.000D-04, 0.000D+00, - 6-1.710D-03, 2.290D-03, 3.800D-04,-3.500D-04, 4.000D-05, 1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 1.008D-01,-7.100D-02, 1.973D-02,-5.710D-03, 2.930D-03,-9.900D-04, - 2-5.271D-02,-1.823D-02, 1.792D-02,-6.580D-03, 1.750D-03,-1.550D-03, - 3 1.220D-02, 1.763D-02,-8.690D-03,-8.800D-04,-1.160D-03,-2.100D-04, - 4-1.190D-03,-7.180D-03, 2.360D-03, 1.890D-03, 7.700D-04, 4.100D-04, - 5-9.100D-04, 2.040D-03,-3.100D-04,-1.050D-03,-4.000D-04,-2.400D-04, - 6 1.190D-03,-1.700D-04,-2.000D-04, 4.200D-04, 1.700D-04, 1.000D-04, - 1 1.081D+00,-1.189D+00, 3.868D-01,-8.617D-02, 1.115D-02,-1.180D-03, - 2 9.917D-01,-1.396D+00, 4.998D-01,-1.159D-01, 1.674D-02,-1.720D-03, - 3 5.099D-02,-1.338D-01, 9.173D-02,-2.885D-02, 5.890D-03,-6.500D-04, - 4-3.178D-02, 5.703D-02,-2.070D-02, 2.440D-03, 1.100D-04,-9.000D-05, - 5 8.970D-03,-1.392D-02, 2.050D-03, 6.500D-04,-2.300D-04, 2.000D-05, - 6-2.340D-03, 3.010D-03, 5.000D-04,-3.900D-04, 6.000D-05, 1.000D-05/ -C...Expansion coefficients for gluon distribution. - DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.482D-01,-9.578D-01, 1.009D-01,-1.051D-01, 3.456D-02,-3.054D-02, - 2-9.627D-01, 5.379D-01, 3.368D-01,-9.525D-02, 1.488D-02,-2.051D-02, - 3 4.300D-01,-8.306D-02,-3.372D-01, 4.902D-02,-9.160D-03, 1.041D-02, - 4-1.925D-01,-1.790D-02, 2.183D-01, 7.490D-03, 4.140D-03,-1.860D-03, - 5 8.183D-02, 1.926D-02,-1.072D-01,-1.944D-02,-2.770D-03,-5.200D-04, - 6-3.884D-02,-1.234D-02, 5.410D-02, 1.879D-02, 3.350D-03, 1.040D-03, - 1 2.948D+01,-3.902D+01, 1.464D+01,-3.335D+00, 5.054D-01,-5.915D-02, - 2 2.559D+01,-3.955D+01, 1.661D+01,-4.299D+00, 6.904D-01,-8.243D-02, - 3-1.663D+00, 1.176D+00, 1.118D+00,-7.099D-01, 1.948D-01,-2.404D-02, - 4-2.168D-01, 8.170D-01,-7.169D-01, 1.851D-01,-1.924D-02,-3.250D-03, - 5 2.088D-01,-4.355D-01, 2.239D-01,-2.446D-02,-3.620D-03, 1.910D-03, - 6-9.097D-02, 1.601D-01,-5.681D-02,-2.500D-03, 2.580D-03,-4.700D-04/ - DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 2.367D+00, 4.453D-01, 3.660D-01, 9.467D-02, 1.341D-01, 1.661D-02, - 2-3.170D+00,-1.795D+00, 3.313D-02,-2.874D-01,-9.827D-02,-7.119D-02, - 3 1.823D+00, 1.457D+00,-2.465D-01, 3.739D-02, 6.090D-03, 1.814D-02, - 4-1.033D+00,-9.827D-01, 2.136D-01, 1.169D-01, 5.001D-02, 1.684D-02, - 5 5.133D-01, 5.259D-01,-1.173D-01,-1.139D-01,-4.988D-02,-2.021D-02, - 6-2.881D-01,-3.145D-01, 5.667D-02, 9.161D-02, 4.568D-02, 1.951D-02, - 1 3.036D+01,-4.062D+01, 1.578D+01,-3.699D+00, 6.020D-01,-7.031D-02, - 2 2.700D+01,-4.167D+01, 1.770D+01,-4.804D+00, 7.862D-01,-1.060D-01, - 3-1.909D+00, 1.357D+00, 1.127D+00,-7.181D-01, 2.232D-01,-2.481D-02, - 4-2.488D-01, 9.781D-01,-8.127D-01, 2.094D-01,-2.997D-02,-4.710D-03, - 5 2.506D-01,-5.427D-01, 2.672D-01,-3.103D-02,-1.800D-03, 2.870D-03, - 6-1.128D-01, 2.087D-01,-6.972D-02,-2.480D-03, 2.630D-03,-8.400D-04/ -C...Expansion coefficients for strange sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.968D-02,-4.173D-02, 2.102D-02,-3.270D-03, 3.240D-03,-6.700D-04, - 2-6.150D-03,-1.294D-02, 6.740D-03,-6.890D-03, 9.000D-04,-1.510D-03, - 3-8.580D-03, 5.050D-03,-4.900D-03,-1.600D-04,-9.400D-04,-1.500D-04, - 4 7.840D-03, 1.510D-03, 2.220D-03, 1.400D-03, 7.000D-04, 3.500D-04, - 5-4.410D-03,-2.220D-03,-8.900D-04,-8.500D-04,-3.600D-04,-2.000D-04, - 6 2.520D-03, 1.840D-03, 4.100D-04, 3.900D-04, 1.600D-04, 9.000D-05, - 1 9.235D-01,-1.085D+00, 3.464D-01,-7.210D-02, 9.140D-03,-9.100D-04, - 2 9.315D-01,-1.274D+00, 4.512D-01,-9.775D-02, 1.380D-02,-1.310D-03, - 3 4.739D-02,-1.296D-01, 8.482D-02,-2.642D-02, 4.760D-03,-5.700D-04, - 4-2.653D-02, 4.953D-02,-1.735D-02, 1.750D-03, 2.800D-04,-6.000D-05, - 5 6.940D-03,-1.132D-02, 1.480D-03, 6.500D-04,-2.100D-04, 0.000D+00, - 6-1.680D-03, 2.340D-03, 4.200D-04,-3.400D-04, 5.000D-05, 1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 6.478D-02,-4.537D-02, 1.643D-02,-3.490D-03, 2.710D-03,-6.700D-04, - 2-2.223D-02,-2.126D-02, 1.247D-02,-6.290D-03, 1.120D-03,-1.440D-03, - 3-1.340D-03, 1.362D-02,-6.130D-03,-7.900D-04,-9.000D-04,-2.000D-04, - 4 5.080D-03,-3.610D-03, 1.700D-03, 1.830D-03, 6.800D-04, 4.000D-04, - 5-3.580D-03, 6.000D-05,-2.600D-04,-1.050D-03,-3.800D-04,-2.300D-04, - 6 2.420D-03, 9.300D-04,-1.000D-04, 4.500D-04, 1.700D-04, 1.100D-04, - 1 9.868D-01,-1.171D+00, 3.940D-01,-8.459D-02, 1.124D-02,-1.250D-03, - 2 1.001D+00,-1.383D+00, 5.044D-01,-1.152D-01, 1.658D-02,-1.830D-03, - 3 4.928D-02,-1.368D-01, 9.021D-02,-2.935D-02, 5.800D-03,-6.600D-04, - 4-3.133D-02, 5.785D-02,-2.023D-02, 2.630D-03, 1.600D-04,-8.000D-05, - 5 8.840D-03,-1.416D-02, 1.900D-03, 5.800D-04,-2.500D-04, 1.000D-05, - 6-2.300D-03, 3.080D-03, 5.500D-04,-3.700D-04, 7.000D-05, 1.000D-05/ -C...Expansion coefficients for charm sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.270D-03,-1.817D-02, 9.590D-03,-6.390D-03, 1.690D-03,-1.540D-03, - 2 5.710D-03,-1.188D-02, 6.090D-03,-4.650D-03, 1.240D-03,-1.310D-03, - 3-3.960D-03, 7.100D-03,-3.590D-03, 1.840D-03,-3.900D-04, 3.400D-04, - 4 1.120D-03,-1.960D-03, 1.120D-03,-4.800D-04, 1.000D-04,-4.000D-05, - 5 4.000D-05,-3.000D-05,-1.800D-04, 9.000D-05,-5.000D-05,-2.000D-05, - 6-4.200D-04, 7.300D-04,-1.600D-04, 5.000D-05, 5.000D-05, 5.000D-05, - 1 8.098D-01,-1.042D+00, 3.398D-01,-6.824D-02, 8.760D-03,-9.000D-04, - 2 8.961D-01,-1.217D+00, 4.339D-01,-9.287D-02, 1.304D-02,-1.290D-03, - 3 3.058D-02,-1.040D-01, 7.604D-02,-2.415D-02, 4.600D-03,-5.000D-04, - 4-2.451D-02, 4.432D-02,-1.651D-02, 1.430D-03, 1.200D-04,-1.000D-04, - 5 1.122D-02,-1.457D-02, 2.680D-03, 5.800D-04,-1.200D-04, 3.000D-05, - 6-7.730D-03, 7.330D-03,-7.600D-04,-2.400D-04, 1.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.980D-03,-1.945D-02, 1.055D-02,-6.870D-03, 1.860D-03,-1.560D-03, - 2 5.700D-03,-1.203D-02, 6.250D-03,-4.860D-03, 1.310D-03,-1.370D-03, - 3-4.490D-03, 7.990D-03,-4.170D-03, 2.050D-03,-4.400D-04, 3.300D-04, - 4 1.470D-03,-2.480D-03, 1.460D-03,-5.700D-04, 1.200D-04,-1.000D-05, - 5-9.000D-05, 1.500D-04,-3.200D-04, 1.200D-04,-6.000D-05,-4.000D-05, - 6-4.200D-04, 7.600D-04,-1.400D-04, 4.000D-05, 7.000D-05, 5.000D-05, - 1 8.698D-01,-1.131D+00, 3.836D-01,-8.111D-02, 1.048D-02,-1.300D-03, - 2 9.626D-01,-1.321D+00, 4.854D-01,-1.091D-01, 1.583D-02,-1.700D-03, - 3 3.057D-02,-1.088D-01, 8.022D-02,-2.676D-02, 5.590D-03,-5.600D-04, - 4-2.845D-02, 5.164D-02,-1.918D-02, 2.210D-03,-4.000D-05,-1.500D-04, - 5 1.311D-02,-1.751D-02, 3.310D-03, 5.100D-04,-1.200D-04, 5.000D-05, - 6-8.590D-03, 8.380D-03,-9.200D-04,-2.600D-04, 1.000D-05,-1.000D-05/ -C...Expansion coefficients for bottom sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.010D-03,-1.401D-02, 7.150D-03,-4.130D-03, 1.260D-03,-1.040D-03, - 2 6.280D-03,-9.320D-03, 4.780D-03,-2.890D-03, 9.100D-04,-8.200D-04, - 3-2.930D-03, 4.090D-03,-1.890D-03, 7.600D-04,-2.300D-04, 1.400D-04, - 4 3.900D-04,-1.200D-03, 4.400D-04,-2.500D-04, 2.000D-05,-2.000D-05, - 5 2.600D-04, 1.400D-04,-8.000D-05, 1.000D-04, 1.000D-05, 1.000D-05, - 6-2.600D-04, 3.200D-04, 1.000D-05,-1.000D-05, 1.000D-05,-1.000D-05, - 1 8.029D-01,-1.075D+00, 3.792D-01,-7.843D-02, 1.007D-02,-1.090D-03, - 2 7.903D-01,-1.099D+00, 4.153D-01,-9.301D-02, 1.317D-02,-1.410D-03, - 3-1.704D-02,-1.130D-02, 2.882D-02,-1.341D-02, 3.040D-03,-3.600D-04, - 4-7.200D-04, 7.230D-03,-5.160D-03, 1.080D-03,-5.000D-05,-4.000D-05, - 5 3.050D-03,-4.610D-03, 1.660D-03,-1.300D-04,-1.000D-05, 1.000D-05, - 6-4.360D-03, 5.230D-03,-1.610D-03, 2.000D-04,-2.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 8.980D-03,-1.459D-02, 7.510D-03,-4.410D-03, 1.310D-03,-1.070D-03, - 2 5.970D-03,-9.440D-03, 4.800D-03,-3.020D-03, 9.100D-04,-8.500D-04, - 3-3.050D-03, 4.440D-03,-2.100D-03, 8.500D-04,-2.400D-04, 1.400D-04, - 4 5.300D-04,-1.300D-03, 5.600D-04,-2.700D-04, 3.000D-05,-2.000D-05, - 5 2.000D-04, 1.400D-04,-1.100D-04, 1.000D-04, 0.000D+00, 0.000D+00, - 6-2.600D-04, 3.200D-04, 0.000D+00,-3.000D-05, 1.000D-05,-1.000D-05, - 1 8.672D-01,-1.174D+00, 4.265D-01,-9.252D-02, 1.244D-02,-1.460D-03, - 2 8.500D-01,-1.194D+00, 4.630D-01,-1.083D-01, 1.614D-02,-1.830D-03, - 3-2.241D-02,-5.630D-03, 2.815D-02,-1.425D-02, 3.520D-03,-4.300D-04, - 4-7.300D-04, 8.030D-03,-5.780D-03, 1.380D-03,-1.300D-04,-4.000D-05, - 5 3.460D-03,-5.380D-03, 1.960D-03,-2.100D-04, 1.000D-05, 1.000D-05, - 6-4.850D-03, 5.950D-03,-1.890D-03, 2.600D-04,-3.000D-05, 0.000D+00/ -C...Expansion coefficients for top sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.410D-03,-7.480D-03, 3.770D-03,-2.580D-03, 7.300D-04,-7.100D-04, - 2 3.840D-03,-6.050D-03, 3.030D-03,-2.030D-03, 5.800D-04,-5.900D-04, - 3-8.800D-04, 1.660D-03,-7.500D-04, 4.700D-04,-1.000D-04, 1.000D-04, - 4-8.000D-05,-1.500D-04, 1.200D-04,-9.000D-05, 3.000D-05, 0.000D+00, - 5 1.300D-04,-2.200D-04,-2.000D-05,-2.000D-05,-2.000D-05,-2.000D-05, - 6-7.000D-05, 1.900D-04,-4.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, - 1 6.623D-01,-9.248D-01, 3.519D-01,-7.930D-02, 1.110D-02,-1.180D-03, - 2 6.380D-01,-9.062D-01, 3.582D-01,-8.479D-02, 1.265D-02,-1.390D-03, - 3-2.581D-02, 2.125D-02, 4.190D-03,-4.980D-03, 1.490D-03,-2.100D-04, - 4 7.100D-04, 5.300D-04,-1.270D-03, 3.900D-04,-5.000D-05,-1.000D-05, - 5 3.850D-03,-5.060D-03, 1.860D-03,-3.500D-04, 4.000D-05, 0.000D+00, - 6-3.530D-03, 4.460D-03,-1.500D-03, 2.700D-04,-3.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.260D-03,-7.530D-03, 3.830D-03,-2.680D-03, 7.600D-04,-7.300D-04, - 2 3.640D-03,-6.050D-03, 3.030D-03,-2.090D-03, 5.900D-04,-6.000D-04, - 3-9.200D-04, 1.710D-03,-8.200D-04, 5.000D-04,-1.200D-04, 1.000D-04, - 4-5.000D-05,-1.600D-04, 1.300D-04,-9.000D-05, 3.000D-05, 0.000D+00, - 5 1.300D-04,-2.100D-04,-1.000D-05,-2.000D-05,-2.000D-05,-1.000D-05, - 6-8.000D-05, 1.800D-04,-5.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, - 1 7.146D-01,-1.007D+00, 3.932D-01,-9.246D-02, 1.366D-02,-1.540D-03, - 2 6.856D-01,-9.828D-01, 3.977D-01,-9.795D-02, 1.540D-02,-1.790D-03, - 3-3.053D-02, 2.758D-02, 2.150D-03,-4.880D-03, 1.640D-03,-2.500D-04, - 4 9.200D-04, 4.200D-04,-1.340D-03, 4.600D-04,-8.000D-05,-1.000D-05, - 5 4.230D-03,-5.660D-03, 2.140D-03,-4.300D-04, 6.000D-05, 0.000D+00, - 6-3.890D-03, 5.000D-03,-1.740D-03, 3.300D-04,-4.000D-05, 0.000D+00/ - -C...The following data lines are coefficients needed in the -C...Duke, Owens proton structure function parametrizations, see below. -C...Expansion coefficients for (up+down) valence quark distribution. - DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/ - 1 4.190D-01, 3.460D+00, 4.400D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 4.000D-03, 7.240D-01,-4.860D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 3-7.000D-03,-6.600D-02, 1.330D+00, 0.000D+00, 0.000D+00, 0.000D+00/ - DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/ - 1 3.740D-01, 3.330D+00, 6.030D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 1.400D-02, 7.530D-01,-6.220D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 3 0.000D+00,-7.600D-02, 1.560D+00, 0.000D+00, 0.000D+00, 0.000D+00/ -C...Expansion coefficients for down valence quark distribution. - DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/ - 1 7.630D-01, 4.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-2.370D-01, 6.270D-01,-4.210D-01, 0.000D+00, 0.000D+00, 0.000D+00, - 3 2.600D-02,-1.900D-02, 3.300D-02, 0.000D+00, 0.000D+00, 0.000D+00/ - DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/ - 1 7.610D-01, 3.830D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-2.320D-01, 6.270D-01,-4.180D-01, 0.000D+00, 0.000D+00, 0.000D+00, - 3 2.300D-02,-1.900D-02, 3.600D-02, 0.000D+00, 0.000D+00, 0.000D+00/ -C...Expansion coefficients for (up+down+strange) sea quark distribution. - DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/ - 1 1.265D+00, 0.000D+00, 8.050D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-1.132D+00,-3.720D-01, 1.590D+00, 6.310D+00,-1.050D+01, 1.470D+01, - 3 2.930D-01,-2.900D-02,-1.530D-01,-2.730D-01,-3.170D+00, 9.800D+00/ - DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/ - 1 1.670D+00, 0.000D+00, 9.150D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-1.920D+00,-2.730D-01, 5.300D-01, 1.570D+01,-1.010D+02, 2.230D+02, - 3 5.820D-01,-1.640D-01,-7.630D-01,-2.830D+00, 4.470D+01,-1.170D+02/ -C...Expansion coefficients for charm sea quark distribution. - DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/ - 1 0.000D+00,-3.600D-02, 6.350D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 1.350D-01,-2.220D-01, 3.260D+00,-3.030D+00, 1.740D+01,-1.790D+01, - 3-7.500D-02,-5.800D-02,-9.090D-01, 1.500D+00,-1.130D+01, 1.560D+01/ - DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/ - 1 0.000D+00,-1.200D-01, 3.510D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 6.700D-02,-2.330D-01, 3.660D+00,-4.740D-01, 9.500D+00,-1.660D+01, - 3-3.100D-02,-2.300D-02,-4.530D-01, 3.580D-01,-5.430D+00, 1.550D+01/ -C...Expansion coefficients for gluon distribution. - DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/ - 1 1.560D+00, 0.000D+00, 6.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, - 2-1.710D+00,-9.490D-01, 1.440D+00,-7.190D+00,-1.650D+01, 1.530D+01, - 3 6.380D-01, 3.250D-01,-1.050D+00, 2.550D-01, 1.090D+01,-1.010D+01/ - DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/ - 1 8.790D-01, 0.000D+00, 4.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, - 2-9.710D-01,-1.160D+00, 1.230D+00,-5.640D+00,-7.540D+00,-5.960D-01, - 3 4.340D-01, 4.760D-01,-2.540D-01,-8.170D-01, 5.500D+00, 1.260D-01/ - -C...Euler's beta function, requires ordinary Gamma function - EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) - -C...Leading order proton parton distributions from Glueck, Reya and -C...Vogt. Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and -C...10^-5 < x < 1. - IF(MSTP(51).EQ.11) THEN - -C...Determine s expansion variable and some x expressions. - Q2IN=MIN(1D8,MAX(0.25D0,Q2)) - SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) - SD2=SD**2 - XL=-LOG(X) - XS=SQRT(X) - -C...Evaluate valence, gluon and sea distributions. - XFVUD=(0.663D0+0.191D0*SD-0.041D0*SD2+0.031D0*SD**3)* - & X**0.326D0*(1D0+(-1.97D0+6.74D0*SD-1.96D0*SD2)*XS+ - & (24.4D0-20.7D0*SD+4.08D0*SD2)*X)* - & (1D0-X)**(2.86D0+0.70D0*SD-0.02D0*SD2) - XFVDD=(0.579D0+0.283D0*SD+0.047D0*SD2)*X**(0.523D0-0.015D0*SD)* - & (1D0+(2.22D0-0.59D0*SD-0.27D0*SD2)*XS+(5.95D0-6.19D0*SD+ - & 1.55D0*SD2)*X)*(1D0-X)**(3.57D0+0.94D0*SD-0.16D0*SD2) - XFGLU=(X**(1.00D0-0.17D0*SD)*((4.879D0*SD-1.383D0*SD2)+ - & (25.92D0-28.97D0*SD+5.596D0*SD2)*X+(-25.69D0+23.68D0*SD- - & 1.975D0*SD2)*X**2)+SD**0.558D0*EXP(-(0.595D0+2.138D0*SD)+ - & SQRT(4.066D0*SD**1.218D0*XL)))* - & (1D0-X)**(2.537D0+1.718D0*SD+0.353D0*SD2) - XFSEA=(X**(0.412D0-0.171D0*SD)*(0.363D0-1.196D0*X+(1.029D0+ - & 1.785D0*SD-0.459D0*SD2)*X**2)*XL**(0.566D0-0.496D0*SD)+ - & SD**1.396D0*EXP(-(3.838D0+1.944D0*SD)+SQRT(2.845D0*SD**1.331D0* - & XL)))*(1D0-X)**(4.696D0+2.109D0*SD) - XFSTR=SD**0.803D0*(1D0+(-3.055D0+1.024D0*SD**0.67D0)*XS+ - & (27.4D0-20.0D0*SD**0.154D0)*X)*(1D0-X)**6.22D0* - & EXP(-(4.33D0+1.408D0*SD)+SQRT((8.27D0-0.437D0*SD)* - & SD**0.563D0*XL))/XL**(2.082D0-0.577D0*SD) - IF(SD.LE.0.888D0) THEN - XFCHM=0D0 - ELSE - XFCHM=(SD-0.888D0)**1.01D0*(1.+(4.24D0-0.804D0*SD)*X)* - & (1D0-X)**(3.46D0+1.076D0*SD)*EXP(-(4.61D0+1.49D0*SD)+ - & SQRT((2.555D0+1.961D0*SD)*SD**0.37D0*XL)) - ENDIF - IF(SD.LE.1.351D0) THEN - XFBOT=0D0 - ELSE - XFBOT=(SD-1.351D0)*(1D0+1.848D0*X)*(1D0-X)**(2.929D0+ - & 1.396D0*SD)*EXP(-(4.71D0+1.514D0*SD)+ - & SQRT((4.02D0+1.239D0*SD)*SD**0.51D0*XL)) - ENDIF - -C...Put into output array. - XPPR(0)=XFGLU - XPPR(1)=XFVDD+XFSEA - XPPR(2)=XFVUD-XFVDD+XFSEA - XPPR(3)=XFSTR - XPPR(4)=XFCHM - XPPR(5)=XFBOT - XPPR(-1)=XFSEA - XPPR(-2)=XFSEA - XPPR(-3)=XFSTR - XPPR(-4)=XFCHM - XPPR(-5)=XFBOT - -C...Proton parton distributions from Eichten, Hinchliffe, Lane, Quigg. -C...Allowed variable range: 5 GeV^2 < Q^2 < 1E8 GeV^2; 1E-4 < x < 1 - ELSEIF(MSTP(51).EQ.12.OR.MSTP(51).EQ.13) THEN - -C...Determine set, Lambda and x and t expansion variables. - NSET=MSTP(51)-11 - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.29D0 - TMIN=LOG(5D0/ALAM**2) - TMAX=LOG(1D8/ALAM**2) - T=LOG(MAX(1D0,Q2/ALAM**2)) - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - NX=1 - IF(X.LE.0.1D0) NX=2 - IF(NX.EQ.1) VX=(2D0*X-1.1D0)/0.9D0 - IF(NX.EQ.2) VX=MAX(-1D0,(2D0*LOG(X)+11.51293D0)/6.90776D0) - -C...Chebyshev polynomials for x and t expansion. - TX(1)=1D0 - TX(2)=VX - TX(3)=2D0*VX**2-1D0 - TX(4)=4D0*VX**3-3D0*VX - TX(5)=8D0*VX**4-8D0*VX**2+1D0 - TX(6)=16D0*VX**5-20D0*VX**3+5D0*VX - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - -C...Calculate structure functions. - DO 120 KFL=1,6 - XQSUM=0D0 - DO 110 IT=1,6 - DO 100 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT) - 100 CONTINUE - 110 CONTINUE - XQ(KFL)=XQSUM*(1D0-X)**NEHLQ(KFL,NSET) - 120 CONTINUE - -C...Put into output array. - XPPR(0)=XQ(4) - XPPR(1)=XQ(2)+XQ(3) - XPPR(2)=XQ(1)+XQ(3) - XPPR(3)=XQ(5) - XPPR(4)=XQ(6) - XPPR(-1)=XQ(3) - XPPR(-2)=XQ(3) - XPPR(-3)=XQ(5) - XPPR(-4)=XQ(6) - -C...Special expansion for bottom (threshold effects). - IF(MSTP(58).GE.5) THEN - IF(NSET.EQ.1) TMIN=8.1905D0 - IF(NSET.EQ.2) TMIN=7.4474D0 - IF(T.GT.TMIN) THEN - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - XQSUM=0D0 - DO 140 IT=1,6 - DO 130 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT) - 130 CONTINUE - 140 CONTINUE - XPPR(5)=XQSUM*(1D0-X)**NEHLQ(7,NSET) - XPPR(-5)=XPPR(5) - ENDIF - ENDIF - -C...Special expansion for top (threshold effects). - IF(MSTP(58).GE.6) THEN - IF(NSET.EQ.1) TMIN=11.5528D0 - IF(NSET.EQ.2) TMIN=10.8097D0 - TMIN=TMIN+2D0*LOG(PMAS(6,1)/30D0) - TMAX=TMAX+2D0*LOG(PMAS(6,1)/30D0) - IF(T.GT.TMIN) THEN - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - XQSUM=0D0 - DO 160 IT=1,6 - DO 150 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT) - 150 CONTINUE - 160 CONTINUE - XPPR(6)=XQSUM*(1D0-X)**NEHLQ(8,NSET) - XPPR(-6)=XPPR(6) - ENDIF - ENDIF - -C...Proton parton distributions from Duke, Owens. -C...Allowed variable range: 4 GeV^2 < Q^2 < approx 1E6 GeV^2. - ELSEIF(MSTP(51).EQ.14.OR.MSTP(51).EQ.15) THEN - -C...Determine set, Lambda and s expansion parameter. - NSET=MSTP(51)-13 - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.4D0 - Q2IN=MIN(1D6,MAX(4D0,Q2)) - SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) - -C...Calculate structure functions. - DO 180 KFL=1,5 - DO 170 IS=1,6 - TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+ - & CDO(3,IS,KFL,NSET)*SD**2 - 170 CONTINUE - IF(KFL.LE.2) THEN - XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)*(1D0+TS(3)*X)/(EULBET(TS(1), - & TS(2)+1D0)*(1D0+TS(3)*TS(1)/(TS(1)+TS(2)+1D0))) - ELSE - XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ - & TS(5)*X**2+TS(6)*X**3) - ENDIF - 180 CONTINUE - -C...Put into output arrays. - XPPR(0)=XQ(5) - XPPR(1)=XQ(2)+XQ(3)/6D0 - XPPR(2)=3D0*XQ(1)-XQ(2)+XQ(3)/6D0 - XPPR(3)=XQ(3)/6D0 - XPPR(4)=XQ(4) - XPPR(-1)=XQ(3)/6D0 - XPPR(-2)=XQ(3)/6D0 - XPPR(-3)=XQ(3)/6D0 - XPPR(-4)=XQ(4) - - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDPR -C...Gives proton parton distributions according to a few different -C...parametrizations. - - SUBROUTINE PYPDPR(X,Q2,XPPR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Arrays and data. - DIMENSION XPPR(-6:6),Q2MIN(16) - DATA Q2MIN/ 2.56D0, 2.56D0, 2.56D0, 0.4D0, 0.4D0, 0.4D0, - &1.0D0, 1.0D0, 2*0D0, 0.25D0, 5D0, 5D0, 4D0, 4D0, 0D0/ - -C...Reset output array. - DO 100 KFL=-6,6 - XPPR(KFL)=0D0 - 100 CONTINUE - -C...Common preliminaries. - NSET=MAX(1,MIN(16,MSTP(51))) - IF(NSET.EQ.9.OR.NSET.EQ.10) NSET=6 - VINT(231)=Q2MIN(NSET) - IF(MSTP(57).EQ.0) THEN - Q2L=Q2MIN(NSET) - ELSE - Q2L=MAX(Q2MIN(NSET),Q2) - ENDIF - - IF(NSET.GE.1.AND.NSET.LE.3) THEN -C...Interface to the CTEQ 3 parton distributions. - QRT=SQRT(MAX(1D0,Q2L)) - -C...Loop over flavours. - DO 110 I=-6,6 - IF(I.LE.0) THEN - XPPR(I)=PYCTEQ(NSET,I,X,QRT) - ELSEIF(I.LE.2) THEN - XPPR(I)=PYCTEQ(NSET,I,X,QRT)+XPPR(-I) - ELSE - XPPR(I)=XPPR(-I) - ENDIF - 110 CONTINUE - - ELSEIF(NSET.GE.4.AND.NSET.LE.6) THEN -C...Interface to the GRV 94 distributions. - IF(NSET.EQ.4) THEN - CALL PYGRVL (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ELSEIF(NSET.EQ.5) THEN - CALL PYGRVM (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ELSE - CALL PYGRVD (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ENDIF - -C...Put into output array. - XPPR(0)=GL - XPPR(-1)=0.5D0*(UDB+DEL) - XPPR(-2)=0.5D0*(UDB-DEL) - XPPR(-3)=SB - XPPR(-4)=CHM - XPPR(-5)=BOT - XPPR(1)=DV+XPPR(-1) - XPPR(2)=UV+XPPR(-2) - XPPR(3)=SB - XPPR(4)=CHM - XPPR(5)=BOT - - ELSEIF(NSET.EQ.7) THEN -C...Interface to the CTEQ 5L parton distributions. -C...Range of validity 10^-6 < x < 1, 1 < Q < 10^4 extended by -C...freezing x*f(x,Q2) at borders. - QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) - XIN=MAX(1D-6,MIN(1D0,X)) - -C...Loop over flavours (with u <-> d notation mismatch). - SUMUDB=PYCT5L(-1,XIN,QRT) - RATUDB=PYCT5L(-2,XIN,QRT) - DO 120 I=-5,2 - IF(I.EQ.1) THEN - XPPR(I)=XIN*PYCT5L(2,XIN,QRT) - ELSEIF(I.EQ.2) THEN - XPPR(I)=XIN*PYCT5L(1,XIN,QRT) - ELSEIF(I.EQ.-1) THEN - XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) - ELSEIF(I.EQ.-2) THEN - XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) - ELSE - XPPR(I)=XIN*PYCT5L(I,XIN,QRT) - IF(I.LT.0) XPPR(-I)=XPPR(I) - ENDIF - 120 CONTINUE - - ELSEIF(NSET.EQ.8) THEN -C...Interface to the CTEQ 5M1 parton distributions. - QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) - XIN=MAX(1D-6,MIN(1D0,X)) - -C...Loop over flavours (with u <-> d notation mismatch). - SUMUDB=PYCT5M(-1,XIN,QRT) - RATUDB=PYCT5M(-2,XIN,QRT) - DO 130 I=-5,2 - IF(I.EQ.1) THEN - XPPR(I)=XIN*PYCT5M(2,XIN,QRT) - ELSEIF(I.EQ.2) THEN - XPPR(I)=XIN*PYCT5M(1,XIN,QRT) - ELSEIF(I.EQ.-1) THEN - XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) - ELSEIF(I.EQ.-2) THEN - XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) - ELSE - XPPR(I)=XIN*PYCT5M(I,XIN,QRT) - IF(I.LT.0) XPPR(-I)=XPPR(I) - ENDIF - 130 CONTINUE - - ELSEIF(NSET.GE.11.AND.NSET.LE.15) THEN -C...GRV92LO, EHLQ1, EHLQ2, DO1 AND DO2 distributions: -C...obsolete but offers backwards compatibility. - CALL PYPDPO(X,Q2L,XPPR) - -C...Symmetric choice for debugging only - ELSEIF(NSET.EQ.16) THEN - XPPR(0)=.5D0/X - XPPR(1)=.05D0/X - XPPR(2)=.05D0/X - XPPR(3)=.05D0/X - XPPR(4)=.05D0/X - XPPR(5)=.05D0/X - XPPR(-1)=.05D0/X - XPPR(-2)=.05D0/X - XPPR(-3)=.05D0/X - XPPR(-4)=.05D0/X - XPPR(-5)=.05D0/X - - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYP -C...Provides various real-valued event related data. - - FUNCTION PYP(I,J) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local array. - DIMENSION PSUM(4) - -C...Set default value. For I = 0 sum of momenta or charges, -C...or invariant mass of system. - PYP=0D0 - 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) PYP=PYP+P(I1,J) - 100 CONTINUE - ELSEIF(I.EQ.0.AND.J.EQ.5) THEN - DO 120 J1=1,4 - PSUM(J1)=0D0 - 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 - PYP=SQRT(MAX(0D0,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) PYP=PYP+PYCHGE(K(I1,2))/3D0 - 130 CONTINUE - ELSEIF(I.EQ.0) THEN - -C...Direct readout of P matrix. - ELSEIF(J.LE.5) THEN - PYP=P(I,J) - -C...Charge, total momentum, transverse momentum, transverse mass. - ELSEIF(J.LE.12) THEN - IF(J.EQ.6) PYP=PYCHGE(K(I,2))/3D0 - IF(J.EQ.7.OR.J.EQ.8) PYP=P(I,1)**2+P(I,2)**2+P(I,3)**2 - IF(J.EQ.9.OR.J.EQ.10) PYP=P(I,1)**2+P(I,2)**2 - IF(J.EQ.11.OR.J.EQ.12) PYP=P(I,5)**2+P(I,1)**2+P(I,2)**2 - IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PYP=SQRT(PYP) - -C...Theta and phi angle in radians or degrees. - ELSEIF(J.LE.16) THEN - IF(J.LE.14) PYP=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) - IF(J.GE.15) PYP=PYANGL(P(I,1),P(I,2)) - IF(J.EQ.14.OR.J.EQ.16) PYP=PYP*180D0/PARU(1) - -C...True rapidity, rapidity with pion mass, pseudorapidity. - ELSEIF(J.LE.19) THEN - PMR=0D0 - IF(J.EQ.17) PMR=P(I,5) - IF(J.EQ.18) PMR=PYMASS(211) - PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2) - PYP=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), - & 1D20)),P(I,3)) - -C...Energy and momentum fractions (only to be used in CM frame). - ELSEIF(J.LE.25) THEN - IF(J.EQ.20) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) - IF(J.EQ.21) PYP=2D0*P(I,3)/PARU(21) - IF(J.EQ.22) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) - IF(J.EQ.23) PYP=2D0*P(I,4)/PARU(21) - IF(J.EQ.24) PYP=(P(I,4)+P(I,3))/PARU(21) - IF(J.EQ.25) PYP=(P(I,4)-P(I,3))/PARU(21) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPILE -C...Initializes multiplicity distribution and selects mutliplicity -C...of pileup events, i.e. several events occuring at the same -C...beam crossing. - - SUBROUTINE PYPILE(MPILE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION WTI(0:200) - SAVE IMIN,IMAX,WTI,WTS - -C...Sum of allowed cross-sections for pileup events. - IF(MPILE.EQ.1) THEN - VINT(131)=SIGT(0,0,5) - IF(MSTP(132).GE.2) VINT(131)=VINT(131)+SIGT(0,0,4) - IF(MSTP(132).GE.3) VINT(131)=VINT(131)+SIGT(0,0,2)+SIGT(0,0,3) - IF(MSTP(132).GE.4) VINT(131)=VINT(131)+SIGT(0,0,1) - IF(MSTP(133).LE.0) RETURN - -C...Initialize multiplicity distribution at maximum. - XNAVE=VINT(131)*PARP(131) - IF(XNAVE.GT.120D0) WRITE(MSTU(11),5000) XNAVE - INAVE=MAX(1,MIN(200,NINT(XNAVE))) - WTI(INAVE)=1D0 - WTS=WTI(INAVE) - WTN=WTI(INAVE)*INAVE - -C...Find shape of multiplicity distribution below maximum. - IMIN=INAVE - DO 100 I=INAVE-1,1,-1 - IF(MSTP(133).EQ.1) WTI(I)=WTI(I+1)*(I+1)/XNAVE - IF(MSTP(133).GE.2) WTI(I)=WTI(I+1)*I/XNAVE - IF(WTI(I).LT.1D-6) GOTO 110 - WTS=WTS+WTI(I) - WTN=WTN+WTI(I)*I - IMIN=I - 100 CONTINUE - -C...Find shape of multiplicity distribution above maximum. - 110 IMAX=INAVE - DO 120 I=INAVE+1,200 - IF(MSTP(133).EQ.1) WTI(I)=WTI(I-1)*XNAVE/I - IF(MSTP(133).GE.2) WTI(I)=WTI(I-1)*XNAVE/(I-1) - IF(WTI(I).LT.1D-6) GOTO 130 - WTS=WTS+WTI(I) - WTN=WTN+WTI(I)*I - IMAX=I - 120 CONTINUE - 130 VINT(132)=XNAVE - VINT(133)=WTN/WTS - IF(MSTP(133).EQ.1.AND.IMIN.EQ.1) VINT(134)= - & WTS/(WTS+WTI(1)/XNAVE) - IF(MSTP(133).EQ.1.AND.IMIN.GT.1) VINT(134)=1D0 - IF(MSTP(133).GE.2) VINT(134)=XNAVE - -C...Pick multiplicity of pileup events. - ELSE - IF(MSTP(133).LE.0) THEN - MINT(81)=MAX(1,MSTP(134)) - ELSE - WTR=WTS*PYR(0) - DO 140 I=IMIN,IMAX - MINT(81)=I - WTR=WTR-WTI(I) - IF(WTR.LE.0D0) GOTO 150 - 140 CONTINUE - 150 CONTINUE - ENDIF - ENDIF - -C...Format statement for error message. - 5000 FORMAT(1X,'Warning: requested average number of events per bunch', - &'crossing too large, ',1P,D12.4) - - RETURN - END - -C********************************************************************* - -C...PYPLOT -C...Prints a histogram (but does not reset it). - - SUBROUTINE PYPLOT(ID) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYDAT1/,/PYBINS/ -C...Local arrays and character variables. - DIMENSION IDATI(6), IROW(100), IFRA(100), DYAC(10) - CHARACTER TITLE*60, OUT*100, CHA(0:11)*1 - -C...Steps in histogram scale. Character sequence. - DATA DYAC/.04,.05,.06,.08,.10,.12,.15,.20,.25,.30/ - DATA CHA/'0','1','2','3','4','5','6','7','8','9','X','-'/ - -C...Find initial address in memory; skip if empty histogram. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN - IS=INDX(ID) - IF(IS.EQ.0) RETURN - IF(NINT(BIN(IS+5)).LE.0) THEN - WRITE(MSTU(11),5000) ID - RETURN - ENDIF - -C...Number of histogram lines and x bins. - LIN=IHIST(3)-18 - NX=NINT(BIN(IS+1)) - -C...Extract title by conversion from double precision via integer. - DO 100 IT=1,20 - IEQ=NINT(BIN(IS+8+NX+IT)) - TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//CHAR(MOD(IEQ,256**2)/256) - & //CHAR(MOD(IEQ,256)) - 100 CONTINUE - -C...Find time; print title. - CALL PYTIME(IDATI) - IF(IDATI(1).GT.0) THEN - WRITE(MSTU(11),5100) ID, TITLE, (IDATI(J),J=1,5) - ELSE - WRITE(MSTU(11),5200) ID, TITLE - ENDIF - -C...Find minimum and maximum bin content. - YMIN=BIN(IS+9) - YMAX=BIN(IS+9) - DO 110 IX=IS+10,IS+8+NX - IF(BIN(IX).LT.YMIN) YMIN=BIN(IX) - IF(BIN(IX).GT.YMAX) YMAX=BIN(IX) - 110 CONTINUE - -C...Determine scale and step size for y axis. - IF(YMAX-YMIN.GT.LIN*DYAC(1)*1D-9) THEN - IF(YMIN.GT.0D0.AND.YMIN.LT.0.1D0*YMAX) YMIN=0D0 - IF(YMAX.LT.0D0.AND.YMAX.GT.0.1D0*YMIN) YMAX=0D0 - IPOT=INT(LOG10(YMAX-YMIN)+10D0)-10 - IF(YMAX-YMIN.LT.LIN*DYAC(1)*10D0**IPOT) IPOT=IPOT-1 - IF(YMAX-YMIN.GT.LIN*DYAC(10)*10D0**IPOT) IPOT=IPOT+1 - DELY=DYAC(1) - DO 120 IDEL=1,9 - IF(YMAX-YMIN.GE.LIN*DYAC(IDEL)*10D0**IPOT) DELY=DYAC(IDEL+1) - 120 CONTINUE - DY=DELY*10D0**IPOT - -C...Convert bin contents to integer form; fractional fill in top row. - DO 130 IX=1,NX - CTA=ABS(BIN(IS+8+IX))/DY - IROW(IX)=SIGN(CTA+0.95D0,BIN(IS+8+IX)) - IFRA(IX)=10D0*(CTA+1.05D0-DBLE(INT(CTA+0.95D0))) - 130 CONTINUE - IRMI=SIGN(ABS(YMIN)/DY+0.95D0,YMIN) - IRMA=SIGN(ABS(YMAX)/DY+0.95D0,YMAX) - -C...Print histogram row by row. - DO 150 IR=IRMA,IRMI,-1 - IF(IR.EQ.0) GOTO 150 - OUT=' ' - DO 140 IX=1,NX - IF(IR.EQ.IROW(IX)) OUT(IX:IX)=CHA(IFRA(IX)) - IF(IR*(IROW(IX)-IR).GT.0) OUT(IX:IX)=CHA(10) - 140 CONTINUE - WRITE(MSTU(11),5300) IR*DELY, IPOT, OUT - 150 CONTINUE - -C...Print sign and value of bin contents. - IPOT=INT(LOG10(MAX(YMAX,-YMIN))+10.0001D0)-10 - OUT=' ' - DO 160 IX=1,NX - IF(BIN(IS+8+IX).LT.-10D0**(IPOT-4)) OUT(IX:IX)=CHA(11) - IROW(IX)=NINT(10D0**(3-IPOT)*ABS(BIN(IS+8+IX))) - 160 CONTINUE - WRITE(MSTU(11),5400) OUT - DO 180 IR=4,1,-1 - DO 170 IX=1,NX - OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) - 170 CONTINUE - WRITE(MSTU(11),5500) IPOT+IR-4, OUT - 180 CONTINUE - -C...Print sign and value of lower bin edge. - IPOT=INT(LOG10(MAX(-BIN(IS+2),BIN(IS+3)-BIN(IS+4)))+ - & 10.0001D0)-10 - OUT=' ' - DO 190 IX=1,NX - IF(BIN(IS+2)+(IX-1)*BIN(IS+4).LT.-10D0**(IPOT-3)) - & OUT(IX:IX)=CHA(11) - IROW(IX)=NINT(10D0**(2-IPOT)*ABS(BIN(IS+2)+(IX-1)*BIN(IS+4))) - 190 CONTINUE - WRITE(MSTU(11),5600) OUT - DO 210 IR=3,1,-1 - DO 200 IX=1,NX - OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) - 200 CONTINUE - WRITE(MSTU(11),5500) IPOT+IR-3, OUT - 210 CONTINUE - ENDIF - -C...Calculate and print statistics. - CSUM=0D0 - CXSUM=0D0 - CXXSUM=0D0 - DO 220 IX=1,NX - CTA=ABS(BIN(IS+8+IX)) - X=BIN(IS+2)+(IX-0.5D0)*BIN(IS+4) - CSUM=CSUM+CTA - CXSUM=CXSUM+CTA*X - CXXSUM=CXXSUM+CTA*X**2 - 220 CONTINUE - XMEAN=CXSUM/MAX(CSUM,1D-20) - XRMS=SQRT(MAX(0D0,CXXSUM/MAX(CSUM,1D-20)-XMEAN**2)) - WRITE(MSTU(11),5700) NINT(BIN(IS+5)),XMEAN,BIN(IS+6), - &BIN(IS+2),BIN(IS+7),XRMS,BIN(IS+8),BIN(IS+3) - -C...Formats for output. - 5000 FORMAT(/5X,'Histogram no',I5,' : no entries') - 5100 FORMAT('1'/5X,'Histogram no',I5,6X,A60,5X,I4,'-',I2,'-',I2,1X, - &I2,':',I2/) - 5200 FORMAT('1'/5X,'Histogram no',I5,6X,A60/) - 5300 FORMAT(2X,F7.2,'*10**',I2,3X,A100) - 5400 FORMAT(/8X,'Contents',3X,A100) - 5500 FORMAT(9X,'*10**',I2,3X,A100) - 5600 FORMAT(/8X,'Low edge',3X,A100) - 5700 FORMAT(/5X,'Entries =',I12,1P,6X,'Mean =',D12.4,6X,'Underflow =' - &,D12.4,6X,'Low edge =',D12.4/5X,'All chan =',D12.4,6X, - &'Rms =',D12.4,6X,'Overflow =',D12.4,6X,'High edge =',D12.4) - - RETURN - END - -C********************************************************************* - -C...PYPOLE -C...This subroutine computes the CP-even higgs and CP-odd pole -c...Higgs masses and mixing angles. - -C...Program based on the work by M. Carena, M. Quiros -C...and C.E.M. Wagner, "Effective potential methods and -C...the Higgs mass spectrum in the MSSM", CERN-TH/95-157 - -C...Inputs: IHIGGS(explained below),MCHI,MA,TANB,MQ,MUR,MDR,MTOP, -C...AT,AB,MU -C...where MCHI is the largest chargino mass, MA is the running -C...CP-odd higgs mass, TANB is the value of the ratio of vacuum -C...expectaion values at the scale MTOP, MQ is the third generation -C...left handed squark mass parameter, MUR is the third generation -C...right handed stop mass parameter, MDR is the third generation -C...right handed sbottom mass parameter, MTOP is the pole top quark -C...mass; AT,AB are the soft supersymmetry breaking trilinear -C...couplings of the stop and sbottoms, respectively, and MU is the -C...supersymmetric mass parameter - -C...The parameter IHIGGS=0,1,2,3 corresponds to the number of -C...Higgses whose pole mass is computed. If IHIGGS=0 only running -C...masses are given, what makes the running of the program -c...much faster and it is quite generally a good approximation -c...(for a theoretical discussion see ref. above). If IHIGGS=1, -C...only the pole mass for H is computed. If IHIGGS=2, then h and H, -c...and if IHIGGS=3, then h,H,A polarizations are computed - -C...Output: MH and MHP which are the lightest CP-even Higgs running -C...and pole masses, respectively; HM and HMP are the heaviest CP-even -C...Higgs running and pole masses, repectively; SA and CA are the -C...SIN(ALPHA) and COS(ALPHA) where ALPHA is the Higgs mixing angle -C...AMP is the CP-odd Higgs pole mass. STOP1,STOP2,SBOT1 and SBOT2 -C...are the stop and sbottom mass eigenvalues. Finally, TANBA is -C...the value of TANB at the CP-odd Higgs mass scale - -C...This subroutine makes use of CERN library subroutine -C...integration package, which makes the computation of the -C...pole Higgs masses somewhat faster. We thank P. Janot for this -C...improvement. Those who are not able to call the CERN -C...libraries, please use the subroutine SUBHPOLE2.F, which -C...although somewhat slower, gives identical results - - SUBROUTINE PYPOLE(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,XMU, - &XMH,XMHP,HM,HMP,AMP,SA,CA,STOP1,STOP2,SBOT1,SBOT2,TANBA,XMG,DT,DB) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Parameters. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DIMENSION DELTA(2,2),COUPT(2,2),T(2,2),SSTOP2(2), - &SSBOT2(2),B(2,2),COUPB(2,2), - &HCOUPT(2,2),HCOUPB(2,2), - &ACOUPT(2,2),ACOUPB(2,2),PR(3), POLAR(3) - - DELTA(1,1) = 1D0 - DELTA(2,2) = 1D0 - DELTA(1,2) = 0D0 - DELTA(2,1) = 0D0 - V = 174.1D0 - XMZ=91.18D0 - PI=PARU(1) - RXMT=PYMRUN(6,XMT**2) - CALL PYRGHM(XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB, - &XMU,XMH,HM,XMCH,SA,CA,SAB,CAB,TANBA,XMG,DT,DB) - - SINB = TANB/(TANB**2+1D0)**0.5D0 - COSB = 1D0/(TANB**2+1D0)**0.5D0 - COS2B = SINB**2 - COSB**2 - SINBPA = SINB*CA + COSB*SA - COSBPA = COSB*CA - SINB*SA - RMBOT = PYMRUN(5,XMT**2) - XMQ2 = XMQ**2 - XMUR2 = XMUR**2 - IF(XMUR.LT.0D0) XMUR2=-XMUR2 - XMDR2 = XMDR**2 - XMST11 = RXMT**2 + XMQ2 - 0.35D0*XMZ**2*COS2B - XMST22 = RXMT**2 + XMUR2 - 0.15D0*XMZ**2*COS2B - IF(XMST11.LT.0D0) GOTO 500 - IF(XMST22.LT.0D0) GOTO 500 - XMSB11 = RMBOT**2 + XMQ2 + 0.42D0*XMZ**2*COS2B - XMSB22 = RMBOT**2 + XMDR2 + 0.08D0*XMZ**2*COS2B - IF(XMSB11.LT.0D0) GOTO 500 - IF(XMSB22.LT.0D0) GOTO 500 -C WMST11 = RXMT**2 + XMQ2 -C WMST22 = RXMT**2 + XMUR2 - XMST12 = RXMT*(AT - XMU/TANB) - XMSB12 = RMBOT*(AB - XMU*TANB) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...STOP EIGENVALUES CALCULATION -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - STOP12 = 0.5D0*(XMST11+XMST22) + - &0.5D0*((XMST11+XMST22)**2 - - &4D0*(XMST11*XMST22 - XMST12**2))**0.5D0 - STOP22 = 0.5D0*(XMST11+XMST22) - - &0.5D0*((XMST11+XMST22)**2 - 4D0*(XMST11*XMST22 - - &XMST12**2))**0.5D0 - - IF(STOP22.LT.0D0) GOTO 500 - SSTOP2(1) = STOP12 - SSTOP2(2) = STOP22 - STOP1 = STOP12**0.5D0 - STOP2 = STOP22**0.5D0 -C STOP1W = STOP1 -C STOP2W = STOP2 - - IF(XMST12.EQ.0D0) XST11 = 1D0 - IF(XMST12.EQ.0D0) XST12 = 0D0 - IF(XMST12.EQ.0D0) XST21 = 0D0 - IF(XMST12.EQ.0D0) XST22 = 1D0 - - IF(XMST12.EQ.0D0) GOTO 110 - - 100 XST11 = XMST12/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 - XST12 = - (XMST11-STOP12)/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 - XST21 = XMST12/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 - XST22 = - (XMST11-STOP22)/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 - - 110 T(1,1) = XST11 - T(2,2) = XST22 - T(1,2) = XST12 - T(2,1) = XST21 - - SBOT12 = 0.5D0*(XMSB11+XMSB22) + - &0.5D0*((XMSB11+XMSB22)**2 - - &4D0*(XMSB11*XMSB22 - XMSB12**2))**0.5D0 - SBOT22 = 0.5D0*(XMSB11+XMSB22) - - &0.5D0*((XMSB11+XMSB22)**2 - 4D0*(XMSB11*XMSB22 - - &XMSB12**2))**0.5D0 - IF(SBOT22.LT.0D0) GOTO 500 - SBOT1 = SBOT12**0.5D0 - SBOT2 = SBOT22**0.5D0 - - SSBOT2(1) = SBOT12 - SSBOT2(2) = SBOT22 - - IF(XMSB12.EQ.0D0) XSB11 = 1D0 - IF(XMSB12.EQ.0D0) XSB12 = 0D0 - IF(XMSB12.EQ.0D0) XSB21 = 0D0 - IF(XMSB12.EQ.0D0) XSB22 = 1D0 - - IF(XMSB12.EQ.0D0) GOTO 130 - - 120 XSB11 = XMSB12/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 - XSB12 = - (XMSB11-SBOT12)/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 - XSB21 = XMSB12/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 - XSB22 = - (XMSB11-SBOT22)/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 - - 130 B(1,1) = XSB11 - B(2,2) = XSB22 - B(1,2) = XSB12 - B(2,1) = XSB21 - - - SINT = 0.2320D0 - SQR = DSQRT(2D0) - VP = 174.1D0*SQR - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...STARTING OF LIGHT HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.0) GOTO 490 - - DO 150 I = 1,2 - DO 140 J = 1,2 - COUPT(I,J) = - & SINT*XMZ**2*2D0*SQR/174.1D0/3D0*SINBPA*(DELTA(I,J) + - & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) - & -RXMT**2/174.1D0**2*VP/SINB*CA*DELTA(I,J) - & -RXMT/VP/SINB*(AT*CA + XMU*SA)*(T(1,I)*T(2,J) + - & T(1,J)*T(2,I)) - 140 CONTINUE - 150 CONTINUE - - - DO 170 I = 1,2 - DO 160 J = 1,2 - COUPB(I,J) = - & -SINT*XMZ**2*2D0*SQR/174.1D0/6D0*SINBPA*(DELTA(I,J) + - & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) - & +RMBOT**2/174.1D0**2*VP/COSB*SA*DELTA(I,J) - & +RMBOT/VP/COSB*(AB*SA + XMU*CA)*(B(1,I)*B(2,J) + - & B(1,J)*B(2,I)) - 160 CONTINUE - 170 CONTINUE - - PRUN = XMH - EPS = 1D-4*PRUN - ITER = 0 - 180 ITER = ITER + 1 - DO 230 I3 = 1,3 - - PR(I3)=PRUN+(I3-2)*EPS/2 - P2=PR(I3)**2 - POLT = 0D0 - DO 200 I = 1,2 - DO 190 J = 1,2 - POLT = POLT + COUPT(I,J)**2*3D0* - & PYFINT(P2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 190 CONTINUE - 200 CONTINUE - - POLB = 0D0 - DO 220 I = 1,2 - DO 210 J = 1,2 - POLB = POLB + COUPB(I,J)**2*3D0* - & PYFINT(P2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 210 CONTINUE - 220 CONTINUE -C RXMT2 = RXMT**2 - XMT2=XMT**2 - - POLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & CA**2/SINB**2 * - & (-2D0*XMT**2+0.5D0*P2)* - & PYFINT(P2,XMT2,XMT2) - - POL = POLT + POLB + POLTT - POLAR(I3) = P2 - XMH**2 - POL - 230 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - P2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 240 - GOTO 180 - 240 CONTINUE - - XMHP = DSQRT(P2) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...END OF LIGHT HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - 250 IF(IHIGGS.EQ.1) GOTO 490 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C... STARTING OF HEAVY HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 270 I = 1,2 - DO 260 J = 1,2 - HCOUPT(I,J) = - & -SINT*XMZ**2*2D0*SQR/174.1D0/3D0*COSBPA*(DELTA(I,J) + - & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) - & -RXMT**2/174.1D0**2*VP/SINB*SA*DELTA(I,J) - & -RXMT/VP/SINB*(AT*SA - XMU*CA)*(T(1,I)*T(2,J) + - & T(1,J)*T(2,I)) - 260 CONTINUE - 270 CONTINUE - - DO 290 I = 1,2 - DO 280 J = 1,2 - HCOUPB(I,J) = - & SINT*XMZ**2*2D0*SQR/174.1D0/6D0*COSBPA*(DELTA(I,J) + - & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) - & -RMBOT**2/174.1D0**2*VP/COSB*CA*DELTA(I,J) - & -RMBOT/VP/COSB*(AB*CA - XMU*SA)*(B(1,I)*B(2,J) + - & B(1,J)*B(2,I)) - HCOUPB(I,J)=0D0 - 280 CONTINUE - 290 CONTINUE - - PRUN = HM - EPS = 1D-4*PRUN - ITER = 0 - 300 ITER = ITER + 1 - DO 350 I3 = 1,3 - PR(I3)=PRUN+(I3-2)*EPS/2 - HP2=PR(I3)**2 - - HPOLT = 0D0 - DO 320 I = 1,2 - DO 310 J = 1,2 - HPOLT = HPOLT + HCOUPT(I,J)**2*3D0* - & PYFINT(HP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 310 CONTINUE - 320 CONTINUE - - HPOLB = 0D0 - DO 340 I = 1,2 - DO 330 J = 1,2 - HPOLB = HPOLB + HCOUPB(I,J)**2*3D0* - & PYFINT(HP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 330 CONTINUE - 340 CONTINUE - -C RXMT2 = RXMT**2 - XMT2 = XMT**2 - - HPOLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & SA**2/SINB**2 * - & (-2D0*XMT**2+0.5D0*HP2)* - & PYFINT(HP2,XMT2,XMT2) - - HPOL = HPOLT + HPOLB + HPOLTT - POLAR(I3) =HP2-HM**2-HPOL - 350 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - HP2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 360 - GOTO 300 - 360 CONTINUE - - - 370 CONTINUE - HMP = HP2**0.5D0 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C... END OF HEAVY HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.2) GOTO 490 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...BEGINNING OF PSEUDOSCALAR HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 390 I = 1,2 - DO 380 J = 1,2 - ACOUPT(I,J) = - & -RXMT/VP/SINB*(AT*COSB + XMU*SINB)* - & (T(1,I)*T(2,J) -T(1,J)*T(2,I)) - 380 CONTINUE - 390 CONTINUE - DO 410 I = 1,2 - DO 400 J = 1,2 - ACOUPB(I,J) = - & RMBOT/VP/COSB*(AB*SINB + XMU*COSB)* - & (B(1,I)*B(2,J) -B(1,J)*B(2,I)) - 400 CONTINUE - 410 CONTINUE - - PRUN = XMA - EPS = 1D-4*PRUN - ITER = 0 - 420 ITER = ITER + 1 - DO 470 I3 = 1,3 - PR(I3)=PRUN+(I3-2)*EPS/2 - AP2=PR(I3)**2 - APOLT = 0D0 - DO 440 I = 1,2 - DO 430 J = 1,2 - APOLT = APOLT + ACOUPT(I,J)**2*3D0* - & PYFINT(AP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 430 CONTINUE - 440 CONTINUE - APOLB = 0D0 - DO 460 I = 1,2 - DO 450 J = 1,2 - APOLB = APOLB + ACOUPB(I,J)**2*3D0* - & PYFINT(AP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 450 CONTINUE - 460 CONTINUE -C RXMT2 = RXMT**2 - XMT2=XMT**2 - APOLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & COSB**2/SINB**2 * - & (-0.5D0*AP2)* - & PYFINT(AP2,XMT2,XMT2) - APOL = APOLT + APOLB + APOLTT - POLAR(I3) = AP2 - XMA**2 -APOL - 470 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - AP2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 480 - GOTO 420 - 480 CONTINUE - - AMP = DSQRT(AP2) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...END OF PSEUDOSCALAR HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.3) GOTO 490 - - 490 CONTINUE - RETURN - 500 CONTINUE - WRITE(MSTU(11),*) ' EXITING IN PYPOLE ' - WRITE(MSTU(11),*) ' XMST11,XMST22 = ',XMST11,XMST22 - WRITE(MSTU(11),*) ' XMSB11,XMSB22 = ',XMSB11,XMSB22 - WRITE(MSTU(11),*) ' STOP22,SBOT22 = ',STOP22,SBOT22 - STOP - END - -C********************************************************************* - -C...PYPREP -C...Rearranges partons along strings. -C...Special considerations for systems with junctions, with -C...possibility of junction-antijunction annihilation. -C...Allows small systems to collapse into one or two particles. -C...Checks flavours and colour singlet invariant masses. - - SUBROUTINE PYPREP(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays. - DIMENSION DPS(5),DPC(5),UE(3),PG(5),E1(3),E2(3),E3(3),E4(3), - &ECL(3),IJUNC(10,0:4),IPIECE(30,0:4),KFEND(4),KFQ(4), - &IJUR(4),PJU(4,6),IRNG(4,2),TJJ(2,5),T(5),PUL(3,5), - &IJCP(0:6),TJUOLD(5) - -C...Function to give four-product. - 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) - -C...Rearrange parton shower product listing along strings: begin loop. - NOLD=N - I1=N - NJUNC=0 - NPIECE=0 - NJJSTR=0 - MSTU32=MSTU(32)+1 - DO 170 MQGST=1,3 - DO 160 I=MAX(1,IP),N - -C...Special treatment for junctions - IF(K(I,1).EQ.42) THEN -C...First, just store positions - IF (MQGST.EQ.1) THEN - NJUNC=NJUNC+1 - IJUNC(NJUNC,0)=I - IJUNC(NJUNC,4)=0 -C...Then look for junction-junction strings (not detected in the -C...main search below). - ELSE IF (MQGST.EQ.2.AND.NPIECE.NE.3*NJUNC) THEN - IF (NJJSTR.EQ.0) THEN - NJJSTR = (3*NJUNC-NPIECE)/2 - ENDIF -C...Check how many already identified strings end on this junction - ILC=0 - DO 100 J=1,NPIECE - IF (IPIECE(J,4).EQ.I) ILC=ILC+1 - 100 CONTINUE -C...If only 2, third one must be to another junction - IF (ILC.EQ.2) THEN -C...The colour information in the junction is unreadable for the -C...colour space search further down in this routine, so we must -C...start on the colour mother of this junction and then "artificially" -C...prevent the colour mother from connecting here again. - IA=MOD(K(I,4),MSTU(5)) - KCS=4 - IF (MOD(MOD(K(I,4)/MSTU(5),MSTU(5)),2).EQ.1) KCS=5 - K(IA,KCS) = K(IA,KCS) + MSTU(5)**2 - K(I,KCS) = K(I,KCS) + 2*MSTU(5)**2 - I1BEG = I1 - NSTP = 0 - GOTO 150 - ELSE IF (ILC.NE.3) THEN -C...This could happen if 2 legs of a junction connect to other -C...junctions. - CALL PYERRM(12, - & '(PYPREP:) Too many junction-junction strings.') - ENDIF - ENDIF - ENDIF - -C...Look for coloured string endpoint, or (later) leftover gluon. - IF(K(I,1).NE.3) GOTO 160 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 160 - KQ=KCHG(KC,2) - IF(KQ.EQ.0.OR.(MQGST.LE.2.AND.KQ.EQ.2)) GOTO 160 - -C...Pick up loose string end. - KCS=4 - IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 - IA=I - IB=I - I1BEG=I1 - NSTP=0 - 110 NSTP=NSTP+1 - IF(NSTP.GT.4*N) THEN - CALL PYERRM(14,'(PYPREP:) caught in infinite loop') - RETURN - ENDIF - -C...Copy undecayed parton. Finished if reached string endpoint. - IF(K(IA,1).EQ.3) THEN - IF(I1.GE.MSTU(4)-MSTU32-5) THEN - CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') - RETURN - ENDIF - I1=I1+1 - K(I1,1)=2 - IF(NSTP.GE.2.AND.KCHG(PYCOMP(K(IA,2)),2).NE.2) K(I1,1)=1 - K(I1,2)=K(IA,2) - K(I1,3)=IA - K(I1,4)=0 - K(I1,5)=0 - DO 120 J=1,5 - P(I1,J)=P(IA,J) - V(I1,J)=V(IA,J) - 120 CONTINUE - K(IA,1)=K(IA,1)+10 - IF(K(I1,1).EQ.1) GOTO 160 - ENDIF - -C...Also finished (for now) if reached junction; then copy to end. - IF(K(IA,1).EQ.42) THEN - NCOPY=I1-I1BEG - IF(I1.GE.MSTU(4)-MSTU32-NCOPY-5) THEN - CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') - RETURN - ENDIF - IF (MQGST.LE.2.AND.NCOPY.NE.0) THEN - DO 140 ICOPY=1,NCOPY - DO 130 J=1,5 - K(MSTU(4)-MSTU32-ICOPY,J)=K(I1BEG+ICOPY,J) - P(MSTU(4)-MSTU32-ICOPY,J)=P(I1BEG+ICOPY,J) - V(MSTU(4)-MSTU32-ICOPY,J)=V(I1BEG+ICOPY,J) - 130 CONTINUE - 140 CONTINUE - ENDIF - NPIECE=NPIECE+1 - IPIECE(NPIECE,0)=I - IPIECE(NPIECE,1)=MSTU32+1 - IPIECE(NPIECE,2)=MSTU32+NCOPY - IPIECE(NPIECE,3)=IB - IPIECE(NPIECE,4)=IA - MSTU32=MSTU32+NCOPY - I1=I1BEG - GOTO 160 - ENDIF - -C...GOTO next parton in colour space. - 150 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 PYERRM(12,'(PYPREP:) 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 110 - K(I1,1)=1 - 160 CONTINUE - 170 CONTINUE - -C...Junction systems remain. - IJU=0 - IJUS=0 - IJUCNT=0 - MREV=0 - IJJSTR=0 - 180 IJUCNT=IJUCNT+1 - IF (IJUCNT.LE.NJUNC) THEN -C...If we are not processing a j-j string, treat this junction as new. - IF (IJJSTR.EQ.0) THEN - IJU=IJUNC(IJUCNT,0) - MREV=0 -C...If junction has already been read, ignore it. - IF (IJUNC(IJUCNT,4).EQ.1) GOTO 180 -C...If we are on a j-j string, goto second j-j junction. - ELSE - IJUCNT=IJUCNT-1 - IJU=IJUS - ENDIF -C...Mark selected junction read. - DO 190 J=1,NJUNC - IF (IJUNC(J,0).EQ.IJU) IJUNC(J,4)=1 - 190 CONTINUE - -C...Determine junction type - ITJUNC = MOD(K(IJU,4)/MSTU(5),MSTU(5)) -C...Type 1 and 2 junctions: ~chi -> q q q, ~chi -> qbar,qbar,qbar -C...Type 3 and 4 junctions: ~qbar -> q q , ~q -> qbar qbar -C...Type 5 and 6 junctions: ~g -> q q q, ~g -> qbar qbar qbar - IF (ITJUNC.GE.1.AND.ITJUNC.LE.6) THEN - IHK=0 - 200 IHK=IHK+1 -C...Find which quarks belong to given junction. - IF(IHK.EQ.1) IEND=MOD(K(IJU,5),MSTU(5)) - IF(IHK.EQ.2) IEND=MOD(K(IJU,5)/MSTU(5),MSTU(5)) -C...IHK = 3 is special. Either normal string piece, or j-j string. - IF(IHK.EQ.3) THEN - IEND=MOD(K(IJU,4),MSTU(5)) - IF (MREV.NE.1) THEN - DO 210 IPC=1,NPIECE -C...If there is a j-j string starting on the present junction which has -C...zero length, insert next junction immediately. - IF (IPIECE(IPC,0).EQ.IJU.AND.K(IPIECE(IPC,4),1) - & .EQ.42.AND.IPIECE(IPC,1)-1-IPIECE(IPC,2).EQ.0) THEN - IJJSTR = 1 - GOTO 250 - ENDIF - 210 CONTINUE - MREV = 1 -C...If MREV is 1 and IHK is 3 we are finished with this system. - ELSE - MREV=0 - GOTO 180 - ENDIF - ENDIF - -C...If we've gotten this far, then either IHK < 3, or -C...an interjunction string exists, or just a third normal string. - IJUNC(IJUCNT,IHK)=0 - IJJSTR = 0 -C..Order pieces belonging to this junction. Also look for j-j. - DO 220 IPC=1,NPIECE - IF (IPIECE(IPC,3).EQ.IEND) IJUNC(IJUCNT,IHK)=IPC - IF (IHK.EQ.3.AND.IPIECE(IPC,0).EQ.IJUNC(IJUCNT,0) - & .AND.K(IPIECE(IPC,4),1).EQ.42) THEN - IJUNC(IJUCNT,IHK)=IPC - IJJSTR = 1 - MREV = 0 - ENDIF - 220 CONTINUE -C...Copy back chains in proper order. MREV=0/1 : descending/ascending - IPC=IJUNC(IJUCNT,IHK) - DO 240 ICP=IPIECE(IPC,1+MREV),IPIECE(IPC,2-MREV),1-2*MREV - I1=I1+1 - DO 230 J=1,5 - K(I1,J)=K(MSTU(4)-ICP,J) - P(I1,J)=P(MSTU(4)-ICP,J) - V(I1,J)=V(MSTU(4)-ICP,J) - 230 CONTINUE - 240 CONTINUE - K(I1,1)=2 -C...Mark last quark. - IF (MREV.EQ.1.AND.IHK.GE.2) K(I1,1)=1 -C...Do not insert junctions at wrong places. - IF(IHK.LT.2.OR.MREV.NE.0) GOTO 270 -C...Insert junction. - 250 IJUS = IJU - IF (IHK.EQ.3) THEN -C...Shift to end junction if a j-j string has been processed. - IF (IJJSTR.NE.0) IJUS = IPIECE(IPC,4) - MREV= 1 - ENDIF - I1=I1+1 - DO 260 J=1,5 - K(I1,J)=0 - P(I1,J)=0. - V(I1,J)=0. - 260 CONTINUE - K(I1,1)=41 - K(IJUS,1)=K(IJUS,1)+10 - K(I1,2)=K(IJUS,2) - K(I1,3)=K(IJUS,3) - 270 IF (IHK.LT.3) GOTO 200 - ELSE - CALL PYERRM(12,'(PYPREP:) Unknown junction type') - ENDIF - IF (IJUCNT.NE.NJUNC) GOTO 180 - ENDIF - N=I1 - -C...Rearrange three strings from junction, e.g. in case one has been -C...shortened by shower, so the last is the largest-energy one. - IF(NJUNC.GE.1) THEN -C...Find systems with exactly one junction. - MJUN1=0 - NBEG=NOLD+1 - DO 380 I=NOLD+1,N - IF(K(I,1).NE.1.AND.K(I,1).NE.41) THEN - ELSEIF(K(I,1).EQ.41) THEN - MJUN1=MJUN1+1 - ELSEIF(K(I,1).EQ.1.AND.MJUN1.NE.1) THEN - MJUN1=0 - NBEG=I+1 - ELSE - NEND=I -C...Sum up energy-momentum in each junction string. - DO 280 J=1,5 - PJU(1,J)=0D0 - PJU(2,J)=0D0 - PJU(3,J)=0D0 - 280 CONTINUE - NJU=0 - DO 300 I1=NBEG,NEND - IF(K(I1,2).NE.21) THEN - NJU=NJU+1 - IJUR(NJU)=I1 - ENDIF - DO 290 J=1,5 - PJU(MIN(NJU,3),J)=PJU(MIN(NJU,3),J)+P(I1,J) - 290 CONTINUE - 300 CONTINUE -C...Find which of them has highest energy (minus mass) in rest frame. - DO 310 J=1,5 - PJU(4,J)=PJU(1,J)+PJU(2,J)+PJU(3,J) - 310 CONTINUE - PMJU=SQRT(MAX(0D0,PJU(4,4)**2-PJU(4,1)**2-PJU(4,2)**2- - & PJU(4,3)**2)) - DO 320 I2=1,3 - PJU(I2,6)=(PJU(4,4)*PJU(I2,4)-PJU(4,1)*PJU(I2,1)- - & PJU(4,2)*PJU(I2,2)-PJU(4,3)*PJU(I2,3))/PMJU-PJU(I2,5) - 320 CONTINUE - IF(PJU(3,6).LT.MIN(PJU(1,6),PJU(2,6))) THEN -C...Decide how to rearrange so that new last has highest energy. - IF(PJU(1,6).LT.PJU(2,6)) THEN - IRNG(1,1)=IJUR(1) - IRNG(1,2)=IJUR(2)-1 - IRNG(2,1)=IJUR(4) - IRNG(2,2)=IJUR(3)+1 - IRNG(4,1)=IJUR(3)-1 - IRNG(4,2)=IJUR(2) - ELSE - IRNG(1,1)=IJUR(4) - IRNG(1,2)=IJUR(3)+1 - IRNG(2,1)=IJUR(2) - IRNG(2,2)=IJUR(3)-1 - IRNG(4,1)=IJUR(2)-1 - IRNG(4,2)=IJUR(1) - ENDIF - IRNG(3,1)=IJUR(3) - IRNG(3,2)=IJUR(3) -C...Copy in correct order below bottom of current event record. - I2=N - DO 350 II=1,4 - DO 340 I1=IRNG(II,1),IRNG(II,2), - & ISIGN(1,IRNG(II,2)-IRNG(II,1)) - I2=I2+1 - DO 330 J=1,5 - K(I2,J)=K(I1,J) - P(I2,J)=P(I1,J) - V(I2,J)=V(I1,J) - 330 CONTINUE - IF(K(I2,1).EQ.1) K(I2,1)=2 - 340 CONTINUE - 350 CONTINUE - K(I2,1)=1 -C...Copy back up, overwriting but now in correct order. - DO 370 I1=NBEG,NEND - I2=I1-NBEG+N+1 - DO 360 J=1,5 - K(I1,J)=K(I2,J) - P(I1,J)=P(I2,J) - V(I1,J)=V(I2,J) - 360 CONTINUE - 370 CONTINUE - ENDIF - MJUN1=0 - NBEG=I+1 - ENDIF - 380 CONTINUE -C++SKANDS -C...Check whether q-q-j-j-qbar-qbar systems should be collapsed -C...to two q-qbar systems. -C...(MSTJ(19)=1 forces q-q-j-j-qbar-qbar.) - IF (MSTJ(19).NE.1) THEN - MJUN1 = 0 - JJGLUE = 0 - NBEG = NOLD+1 -C...Force collapse when MSTJ(19)=2. - IF (MSTJ(19).EQ.2) THEN - DELMJJ = 1D9 - DELMQQ = 0D0 - ENDIF -C...Find systems with exactly two junctions. - DO 610 I=NOLD+1,N -C...Count junctions - IF (K(I,1).EQ.41) THEN - MJUN1 = MJUN1+1 -C...Check for interjunction gluons - IF (MJUN1.EQ.2.AND.K(I-1,1).NE.41) THEN - JJGLUE = 1 - ENDIF - ELSEIF(K(I,1).EQ.1.AND.(MJUN1.NE.2)) THEN -C...If end of system reached with either zero or one junction, restart -C...with next system. - MJUN1 = 0 - JJGLUE = 0 - NBEG = I+1 - ELSEIF(K(I,1).EQ.1) THEN -C...If end of system reached with exactly two junctions, compute string -C...length measure for the (q-q-j-j-qbar-qbar) topology and compare with -C...length measure for the (q-qbar)(q-qbar) topology. - NEND=I -C...Loop down through chain. - ISID=0 - DO 390 I1=NBEG,NEND -C...Store string piece division locations in event record - IF (K(I1,2).NE.21) THEN - ISID = ISID+1 - IJCP(ISID) = I1 - ENDIF - 390 CONTINUE -C...Randomly choose between (1,3)(2,4) and (1,4)(2,3) topologies. - ISW=0 - IF (PYR(0).LT.0.5D0) ISW=1 -C...Randomly choose which qqbar string gets the jj gluons. - IGS=1 - IF (PYR(0).GT.0.5D0) IGS=2 -C...Only compute string lengths when no topology forced. - IF (MSTJ(19).EQ.0) THEN -C...Repeat following for each junction - DO 480 IJU=1,2 -C...Initialize iterative procedure for finding JRF - IJRFIT=0 - DO 400 IX=1,3 - TJUOLD(IX)=0D0 - 400 CONTINUE - TJUOLD(4)=1D0 -C...Start iteration. Sum up momenta in string pieces - 410 DO 450 IJS=1,3 -C...JD=-1 for first junction, +1 for second junction. -C...Find out where piece starts and ends and which direction to go. - JD=2*IJU-3 - IF (IJS.LE.2) THEN - IA = IJCP((IJU-1)*7 - JD*(IJS+1)) + JD - IB = IJCP((IJU-1)*7 - JD*IJS) - ELSEIF (IJS.EQ.3) THEN - JD =-JD - IA = IJCP((IJU-1)*7 + JD*(IJS)) + JD - IB = IJCP((IJU-1)*7 + JD*(IJS+3)) - ENDIF -C...Initialize junction pull 4-vector. - DO 420 J=1,5 - PUL(IJS,J)=0D0 - 420 CONTINUE -C...Initialize weight - PWT = 0D0 - PWTOLD = 0D0 -C...Sum up (weighted) momenta along each string piece - DO 440 ISP=IA,IB,JD -C...If present parton not last in chain - IF (ISP.NE.IA.AND.ISP.NE.IB) THEN -C...If last parton was a junction, store present weight - IF (K(ISP-JD,2).EQ.88) THEN - PWTOLD = PWT -C...If last parton was a quark, reset to stored weight. - ELSEIF (K(ISP-JD,2).NE.21) THEN - PWT = PWTOLD - ENDIF - ENDIF -C...Skip next parton if weight already large - IF (PWT.GT.10D0) GOTO 440 -C...Compute momentum in TJUOLD frame: - TDP=TJUOLD(1)*P(ISP,1)+TJUOLD(2)*P(ISP,2)+TJUOLD(3 - & )*P(ISP,3) - BFC=TDP/(1D0+TJUOLD(4))+P(ISP,4) - DO 430 J=1,3 - TMP=P(ISP,J)+TJUOLD(J)*BFC - PUL(IJS,J)=PUL(IJS,J)+TMP*EXP(-PWT) - 430 CONTINUE -C...Boosted energy - TMP=TJUOLD(4)*P(ISP,4)+TDP - PUL(IJS,4)=PUL(IJS,J)+TMP*EXP(-PWT) -C...Update weight - PWT=PWT+TMP/PARJ(48) -C...Put |p| rather than m in 5th slot - PUL(IJS,5)=SQRT(PUL(IJS,1)**2+PUL(IJS,2)**2 - & +PUL(IJS,3)**2) - 440 CONTINUE - 450 CONTINUE -C...Compute boost - IJRFIT=IJRFIT+1 - CALL PYJURF(PUL,T) -C...Combine new boost (T) with old boost (TJUOLD) - TMP=T(1)*TJUOLD(1)+T(2)*TJUOLD(2)+T(3)*TJUOLD(3) - DO 460 IX=1,3 - TJUOLD(IX)=T(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+T(4 - & )) - 460 CONTINUE - TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3) - & **2) -C...If last boost small, accept JRF, else iterate. -C...Also prevent possibility of infinite loop. - IF (ABS((T(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. - & IJRFIT.LT.MSTJ(18))THEN - GOTO 410 - ELSEIF (IJRFIT.GE.MSTJ(18)) THEN - CALL PYERRM(1,'(PYPREP:) failed to converge on JRF') - ENDIF -C...Store final boost, with change of sign since TJJ motion vector. - DO 470 IX=1,3 - TJJ(IJU,IX)=-TJUOLD(IX) - 470 CONTINUE - TJJ(IJU,4)=SQRT(1D0+TJJ(IJU,1)**2+TJJ(IJU,2)**2 - & +TJJ(IJU,3)**2) - 480 CONTINUE -C...String length measure for (q-qbar)(q-qbar) topology. -C...Note only momenta of nearest partons used (since rest of system -C...identical). - IF (JJGLUE.EQ.0) THEN - DELMQQ=4D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1)*FOUR(IJCP(3) - & -1,IJCP(5-ISW)+1) - ELSE -C...Put jj gluons on selected string (IGS selected randomly above). - IF (IGS.EQ.1) THEN - DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 - & ,IJCP(4+ISW)+1)*FOUR(IJCP(3)-1,IJCP(5-ISW)+1) - ELSE - DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1) - & *FOUR(IJCP(3)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 - & ,IJCP(5-ISW)+1) - ENDIF - ENDIF -C...String length measure for q-q-j-j-q-q topology. - T1G1=0D0 - T2G2=0D0 - T1T2=0D0 - T1P1=0D0 - T1P2=0D0 - T2P3=0D0 - T2P4=0D0 - ISGN=-1 -C...Note only momenta of nearest partons used (since rest of system -C...identical). - DO 490 IX=1,4 - IF (IX.EQ.4) ISGN=1 - T1P1=T1P1+ISGN*TJJ(1,IX)*P(IJCP(2)-1,IX) - T1P2=T1P2+ISGN*TJJ(1,IX)*P(IJCP(3)-1,IX) - T2P3=T2P3+ISGN*TJJ(2,IX)*P(IJCP(4)+1,IX) - T2P4=T2P4+ISGN*TJJ(2,IX)*P(IJCP(5)+1,IX) - IF (JJGLUE.EQ.0) THEN -C...Junction motion vector dot product gives length when inter-junction -C...gluons absent. - T1T2=T1T2+ISGN*TJJ(1,IX)*TJJ(2,IX) - ELSE -C...Junction motion vector dot products with gluon momenta give length -C...when inter-junction gluons present. - T1G1=T1G1+ISGN*TJJ(1,IX)*P(IJCP(3)+1,IX) - T2G2=T2G2+ISGN*TJJ(2,IX)*P(IJCP(4)-1,IX) - ENDIF - 490 CONTINUE - DELMJJ=16D0*T1P1*T1P2*T2P3*T2P4 - IF (JJGLUE.EQ.0) THEN - DELMJJ=DELMJJ*(T1T2+SQRT(T1T2**2-1)) - ELSE - DELMJJ=DELMJJ*4D0*T1G1*T2G2 - ENDIF - ENDIF -C...If delmjj > delmqq collapse string system to q-qbar q-qbar -C...(Always the case for MSTJ(19)=2 due to initialization above) - IF (DELMJJ.GT.DELMQQ) THEN -C...Put new system at end of event record - NCOP=N - DO 560 IST=1,2 - DO 510 ICOP=IJCP(IST),IJCP(IST+1)-1 - NCOP=NCOP+1 - DO 500 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 500 CONTINUE - 510 CONTINUE - IF (JJGLUE.NE.0.AND.IST.EQ.IGS) THEN -C...Insert inter-junction gluon string piece (reversed) - NJJGL=0 - DO 530 ICOP=IJCP(4)-1,IJCP(3)+1,-1 - NJJGL=NJJGL+1 - NCOP=NCOP+1 - DO 520 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 520 CONTINUE - 530 CONTINUE - ENDIF - IFC=-2*IST+3 - DO 550 ICOP=IJCP(IST+IFC*ISW+3)+1,IJCP(IST+IFC*ISW+4) - NCOP=NCOP+1 - DO 540 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 540 CONTINUE - 550 CONTINUE - K(NCOP,1)=1 - 560 CONTINUE -C...Copy system back in right order - DO 580 ICOP=NBEG,NEND-2 - DO 570 IX=1,5 - P(ICOP,IX)=P(N+ICOP-NBEG+1,IX) - K(ICOP,IX)=K(N+ICOP-NBEG+1,IX) - 570 CONTINUE - 580 CONTINUE -C...Shift down rest of event record - DO 600 ICOP=NEND+1,N - DO 590 IX=1,5 - P(ICOP-2,IX)=P(ICOP,IX) - K(ICOP-2,IX)=K(ICOP,IX) - 590 CONTINUE - 600 CONTINUE -C...Update length of event record. - N=N-2 - ENDIF - MJUN1=0 - NBEG=I+1 - ENDIF - 610 CONTINUE - ENDIF - ENDIF - -C...Done if no checks on small-mass systems. - IF(MSTJ(14).LT.0) RETURN - IF(MSTJ(14).EQ.0) GOTO 1050 - -C...Find lowest-mass colour singlet jet system. - NS=N - 620 NSIN=N-NS - PDMIN=1D0+PARJ(32) - IC=0 - DO 680 I=MAX(1,IP),N - 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 630 J=1,4 - DPS(J)=P(I,J) - 630 CONTINUE - MSTJ(93)=1 - DPS(5)=PYMASS(K(I,2)) - ELSEIF(K(I,1).EQ.2.AND.K(I,2).NE.21) THEN - DO 640 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 640 CONTINUE - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - ELSEIF(K(I,1).EQ.2) THEN - DO 650 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 650 CONTINUE - ELSEIF(IC.NE.0.AND.KCHG(PYCOMP(K(I,2)),2).NE.0) THEN - DO 660 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 660 CONTINUE - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))- - & DPS(5) - IF(PD.LT.PDMIN) THEN - PDMIN=PD - DO 670 J=1,5 - DPC(J)=DPS(J) - 670 CONTINUE - IC1=IC - IC2=I - ENDIF - IC=0 - ELSE - NSIN=NSIN+1 - ENDIF - 680 CONTINUE - -C...Done if lowest-mass system above threshold for string frag. - IF(PDMIN.GE.PARJ(32)) GOTO 1050 - -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 - 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...Set up history, assuming cluster -> 2 hadrons. - NBODY=2 - K(N+1,4)=N+2 - K(N+1,5)=N+3 - 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 - V(N+1,5)=0D0 - V(N+2,5)=0D0 - V(N+3,5)=0D0 - -C...Find total flavour content - complicated by presence of junctions. - NQ=0 - NDIQ=0 - DO 690 I=IC1,IC2 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.K(I,2).NE.21) THEN - NQ=NQ+1 - KFQ(NQ)=K(I,2) - IF(IABS(K(I,2)).GT.1000) NDIQ=NDIQ+1 - ENDIF - 690 CONTINUE - -C...If several diquarks, split up one to give even number of flavours. - IF(NQ.EQ.3.AND.NDIQ.GE.2) THEN - I1=3 - IF(IABS(KFQ(3)).LT.1000) I1=1 - KFQ(4)=ISIGN(MOD(IABS(KFQ(I1))/100,10),KFQ(I1)) - KFQ(I1)=KFQ(I1)/1000 - NQ=4 - NDIQ=NDIQ-1 - ENDIF - -C...If four quark ends, join two to diquark. - IF(NQ.EQ.4.AND.NDIQ.EQ.0) THEN - I1=1 - I2=2 - IF(KFQ(I1)*KFQ(I2).LT.0) I2=3 - IF(I2.EQ.3.AND.KFQ(I1)*KFQ(I2).LT.0) I2=4 - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 - KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ - & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) - KFQ(I2)=KFQ(4) - NQ=3 - NDIQ=1 - ENDIF - -C...If two quark ends, plus quark or diquark, join quarks to diquark. - IF(NQ.EQ.3) THEN - I1=1 - I2=2 - IF(IABS(KFQ(I1)).GT.1000) I1=3 - IF(IABS(KFQ(I2)).GT.1000) I2=3 - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 - KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ - & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) - KFQ(I2)=KFQ(3) - NQ=2 - NDIQ=NDIQ+1 - ENDIF - -C...Form two particles from flavours of lowest-mass system, if feasible. - NTRY = 0 - 700 NTRY = NTRY + 1 - -C...Open string with two specified endpoint flavours. - IF(NQ.EQ.2) THEN - KC1=PYCOMP(KFQ(1)) - KC2=PYCOMP(KFQ(2)) - IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 1050 - KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) - KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) - IF(KQ1+KQ2.NE.0) GOTO 1050 -C...Start with qq, if there is one. Only allow for rank 1 popcorn meson - 710 K1=KFQ(1) - IF(IABS(KFQ(2)).GT.1000) K1=KFQ(2) - MSTU(125)=0 - CALL PYDCYK(K1,0,KFLN,K(N+2,2)) - CALL PYDCYK(KFQ(1)+KFQ(2)-K1,-KFLN,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 710 - -C...Open string with four specified flavours. - ELSEIF(NQ.EQ.4) THEN - KC1=PYCOMP(KFQ(1)) - KC2=PYCOMP(KFQ(2)) - KC3=PYCOMP(KFQ(3)) - KC4=PYCOMP(KFQ(4)) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) GOTO 1050 - KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) - KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) - KQ3=KCHG(KC3,2)*ISIGN(1,KFQ(3)) - KQ4=KCHG(KC4,2)*ISIGN(1,KFQ(4)) - IF(KQ1+KQ2+KQ3+KQ4.NE.0) GOTO 1050 -C...Combine flavours pairwise to form two hadrons. - 720 I1=1 - I2=2 - IF(KQ1*KQ2.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. - & IABS(KFQ(2)).GT.1000)) I2=3 - IF(I2.EQ.3.AND.(KQ1*KQ3.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. - & IABS(KFQ(3)).GT.1000))) I2=4 - I3=3 - IF(I2.EQ.3) I3=2 - I4=10-I1-I2-I3 - CALL PYDCYK(KFQ(I1),KFQ(I2),KFLDMP,K(N+2,2)) - CALL PYDCYK(KFQ(I3),KFQ(I4),KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 720 - -C...Closed string. - ELSE - IF(IABS(K(IC2,2)).NE.21) GOTO 1050 -C...No room for popcorn mesons in closed string -> 2 hadrons. - MSTU(125)=0 - 730 CALL PYDCYK(1+INT((2D0+PARJ(2))*PYR(0)),0,KFLN,KFDMP) - CALL PYDCYK(KFLN,0,KFLM,K(N+2,2)) - CALL PYDCYK(-KFLN,-KFLM,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 730 - ENDIF - P(N+2,5)=PYMASS(K(N+2,2)) - P(N+3,5)=PYMASS(K(N+3,2)) - -C...If it does not work: try again (a number of times), give up (if no -C...place to shuffle momentum or too many flavours), or form one hadron. - IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) THEN - IF(NTRY.LT.MSTJ(17).OR.(NQ.EQ.4.AND.NTRY.LT.5*MSTJ(17))) THEN - GOTO 700 - ELSEIF(NSIN.EQ.1.OR.NQ.EQ.4) THEN - GOTO 1050 - ELSE - GOTO 800 - END IF - END IF - -C...Perform two-particle decay of jet system. -C...First step: find reference axis in decaying system rest frame. -C...(Borrow slot N+2 for temporary direction.) - DO 740 J=1,4 - P(N+2,J)=P(IC1,J) - 740 CONTINUE - DO 760 I=IC1+1,IC2-1 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. - & KCHG(PYCOMP(K(I,2)),2).NE.0) THEN - FRAC1=FOUR(IC2,I)/(FOUR(IC1,I)+FOUR(IC2,I)) - DO 750 J=1,4 - P(N+2,J)=P(N+2,J)+FRAC1*P(I,J) - 750 CONTINUE - ENDIF - 760 CONTINUE - CALL PYROBO(N+2,N+2,0D0,0D0,-DPC(1)/DPC(4),-DPC(2)/DPC(4), - &-DPC(3)/DPC(4)) - THE1=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) - PHI1=PYANGL(P(N+2,1),P(N+2,2)) - -C...Second step: generate isotropic/anisotropic decay. - PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- - &(P(N+2,5)-P(N+3,5))**2))/(2D0*PECM) - 770 UE(3)=PYR(0) - IF(PARJ(21).LE.0.01D0) UE(3)=1D0 - PT2=(1D0-UE(3)**2)*PA**2 - IF(MSTJ(16).LE.0) THEN - PREV=0.5D0 - ELSE - IF(EXP(-PT2/(2D0*MAX(0.01D0,PARJ(21))**2)).LT.PYR(0)) GOTO 770 - PR1=P(N+2,5)**2+PT2 - PR2=P(N+3,5)**2+PT2 - ALAMBD=SQRT(MAX(0D0,(PECM**2-PR1-PR2)**2-4D0*PR1*PR2)) - PREVCF=PARJ(42) - IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) - PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*ALAMBD*PARJ(40)))) - ENDIF - IF(PYR(0).LT.PREV) UE(3)=-UE(3) - PHI=PARU(2)*PYR(0) - UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) - DO 780 J=1,3 - P(N+2,J)=PA*UE(J) - P(N+3,J)=-PA*UE(J) - 780 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) - -C...Third step: move back to event frame and set production vertex. - CALL PYROBO(N+2,N+3,THE1,PHI1,DPC(1)/DPC(4),DPC(2)/DPC(4), - &DPC(3)/DPC(4)) - DO 790 J=1,4 - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - V(N+3,J)=V(IC2,J) - 790 CONTINUE - N=N+3 - GOTO 1030 - -C...Else form one particle, if possible. - 800 NBODY=1 - K(N+1,5)=N+2 - DO 810 J=1,4 - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - 810 CONTINUE - -C...Select hadron flavour from available quark flavours. - 820 IF(NQ.EQ.2.AND.IABS(KFQ(1)).GT.100.AND.IABS(KFQ(2)).GT.100) THEN - GOTO 1050 - ELSEIF(NQ.EQ.2) THEN - CALL PYKFDI(KFQ(1),KFQ(2),KFLDMP,K(N+2,2)) - ELSE - KFLN=1+INT((2D0+PARJ(2))*PYR(0)) - CALL PYKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) - ENDIF - IF(K(N+2,2).EQ.0) GOTO 820 - P(N+2,5)=PYMASS(K(N+2,2)) - -C...Use old algorithm for E/p conservation? (EN) - IF (MSTJ(16).LE.0) GOTO 990 - -C...Find the string piece closest to the cluster by a loop -C...over the undecayed partons not in present cluster. (EN) - DGLOMI=1D30 - IBEG=0 - I0=0 - NJUNC=0 - DO 850 I1=MAX(1,IP),N-1 - IF(K(I,1).EQ.1) NJUNC=0 - IF(K(I,1).EQ.41) NJUNC=NJUNC+1 - IF(I1.GE.IC1-1.AND.I1.LE.IC2) THEN - I0=0 - ELSEIF(K(I1,1).EQ.2) THEN - IF(I0.EQ.0) I0=I1 - I2=I1 - 830 I2=I2+1 - IF(K(I2,1).EQ.41) GOTO 850 - IF(K(I2,1).GT.10) GOTO 830 - IF(KCHG(PYCOMP(K(I2,2)),2).EQ.0) GOTO 830 - IF(K(I1,2).EQ.21.AND.K(I2,2).NE.21.AND.K(I2,1).NE.1.AND. - & NJUNC.EQ.0) GOTO 850 - IF(K(I1,2).NE.21.AND.K(I2,2).EQ.21.AND.NJUNC.NE.0) GOTO 850 - -C...Define velocity vectors e1, e2, ecl and differences e3, e4. - DO 840 J=1,3 - E1(J)=P(I1,J)/P(I1,4) - E2(J)=P(I2,J)/P(I2,4) - ECL(J)=P(N+1,J)/P(N+1,4) - E3(J)=E2(J)-E1(J) - E4(J)=ECL(J)-E1(J) - 840 CONTINUE - -C...Calculate minimal D=(e4-alpha*e3)**2 for 0 0: emit a 'gluon' (EN) - IF (P(N+1,5).GE.P(N+2,5)) THEN - -C...Construct 'gluon' that is needed to put hadron on the mass shell. - FRAC=P(N+2,5)/P(N+1,5) - DO 860 J=1,5 - P(N+2,J)=FRAC*P(N+1,J) - PG(J)=(1D0-FRAC)*P(N+1,J) - 860 CONTINUE - -C... Copy string with new gluon put in. - N=N+2 - I=IBEG-1 - 870 I=I+1 - IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 870 - IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 870 - N=N+1 - DO 880 J=1,5 - K(N,J)=K(I,J) - P(N,J)=P(I,J) - V(N,J)=V(I,J) - 880 CONTINUE - K(I,1)=K(I,1)+10 - K(I,4)=N - K(I,5)=N - K(N,3)=I - IF(I.EQ.IPCS) THEN - N=N+1 - DO 890 J=1,5 - K(N,J)=K(N-1,J) - P(N,J)=PG(J) - V(N,J)=V(N-1,J) - 890 CONTINUE - K(N,2)=21 - K(N,3)=NSAV+1 - ENDIF - IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 870 - GOTO 1030 - -C...Delta_m = m_clus - m_had < 0: have to absorb a 'gluon' instead, -C...from string piece endpoints. - ELSE - -C...Begin by copying string that should give energy to cluster. - N=N+2 - I=IBEG-1 - 900 I=I+1 - IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 900 - IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 900 - N=N+1 - DO 910 J=1,5 - K(N,J)=K(I,J) - P(N,J)=P(I,J) - V(N,J)=V(I,J) - 910 CONTINUE - K(I,1)=K(I,1)+10 - K(I,4)=N - K(I,5)=N - K(N,3)=I - IF(I.EQ.IPCS) I1=N - IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 900 - I2=I1+1 - -C...Set initial Phad. - DO 920 J=1,4 - P(NSAV+2,J)=P(NSAV+1,J) - 920 CONTINUE - -C...Calculate Pg, a part of which will be added to Phad later. (EN) - 930 IF(MSTJ(16).EQ.1) THEN - ALPHA=1D0 - BETA=1D0 - ELSE - ALPHA=FOUR(NSAV+1,I2)/FOUR(I1,I2) - BETA=FOUR(NSAV+1,I1)/FOUR(I1,I2) - ENDIF - DO 940 J=1,4 - PG(J)=ALPHA*P(I1,J)+BETA*P(I2,J) - 940 CONTINUE - PG(5)=SQRT(MAX(1D-20,PG(4)**2-PG(1)**2-PG(2)**2-PG(3)**2)) - -C..Solve 2nd order equation, use the best (smallest) solution. (EN) - PMSCOL=P(NSAV+2,4)**2-P(NSAV+2,1)**2-P(NSAV+2,2)**2- - & P(NSAV+2,3)**2 - PCLPG=(P(NSAV+2,4)*PG(4)-P(NSAV+2,1)*PG(1)- - & P(NSAV+2,2)*PG(2)-P(NSAV+2,3)*PG(3))/PG(5)**2 - DELTA=SQRT(PCLPG**2+(P(NSAV+2,5)**2-PMSCOL)/PG(5)**2)-PCLPG - -C...If all gluon energy eaten, zero it and take a step back. - ITER=0 - IF(DELTA*ALPHA.GT.1D0.AND.I1.GT.NSAV+3) THEN - ITER=1 - DO 950 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+P(I1,J) - P(I1,J)=0D0 - 950 CONTINUE - P(I1,5)=0D0 - K(I1,1)=K(I1,1)+10 - I1=I1-1 - IF(K(I1,1).EQ.41) ITER=-1 - ENDIF - IF(DELTA*BETA.GT.1D0.AND.I2.LT.N) THEN - ITER=1 - DO 960 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+P(I2,J) - P(I2,J)=0D0 - 960 CONTINUE - P(I2,5)=0D0 - K(I2,1)=K(I2,1)+10 - I2=I2+1 - IF(K(I2,1).EQ.41) ITER=-1 - ENDIF - IF(ITER.EQ.1) GOTO 930 - -C...If also all endpoint energy eaten, revert to old procedure. - IF((1D0-DELTA*ALPHA)*P(I1,4).LT.P(I1,5).OR. - & (1D0-DELTA*BETA)*P(I2,4).LT.P(I2,5).OR.ITER.EQ.-1) THEN - DO 970 I=NSAV+3,N - IM=K(I,3) - K(IM,1)=K(IM,1)-10 - K(IM,4)=0 - K(IM,5)=0 - 970 CONTINUE - N=NSAV - GOTO 990 - ENDIF - -C... Construct the collapsed hadron and modified string partons. - DO 980 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+DELTA*PG(J) - P(I1,J)=(1D0-DELTA*ALPHA)*P(I1,J) - P(I2,J)=(1D0-DELTA*BETA)*P(I2,J) - 980 CONTINUE - P(I1,5)=(1D0-DELTA*ALPHA)*P(I1,5) - P(I2,5)=(1D0-DELTA*BETA)*P(I2,5) - -C...Finished with string collapse in new scheme. - GOTO 1030 - ENDIF - -C... Use old algorithm; by choice or when in trouble. - 990 CONTINUE -C...Find parton/particle which combines to largest extra mass. - IR=0 - HA=0D0 - HSM=0D0 - DO 1010 MCOMB=1,3 - IF(IR.NE.0) GOTO 1010 - DO 1000 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 1000 - IF(MCOMB.EQ.1) KCI=PYCOMP(K(I,2)) - IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 1000 - IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 1000 - IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) - & GOTO 1000 - HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) - HSR=2D0*HCR+PECM**2-P(N+2,5)**2-2D0*P(N+2,5)*P(I,5) - IF(HSR.GT.HSM) THEN - IR=I - HA=HCR - HSM=HSR - ENDIF - 1000 CONTINUE - 1010 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.5D0*(HB*SQRT(MAX(0D0,((HB+HC)**2-4D0*(HB+HD)*P(N+2,5)**2)/ - & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) - HK1=(0.5D0*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB - DO 1020 J=1,4 - P(N+2,J)=(1D0+HK1)*DPC(J)-HK2*P(IR,J) - P(IR,J)=(1D0+HK2)*P(IR,J)-HK1*DPC(J) - 1020 CONTINUE - N=N+2 - ELSE - CALL PYERRM(3,'(PYPREP:) no match for collapsing cluster') - RETURN - ENDIF - -C...Mark collapsed system and store daughter pointers. Iterate. - 1030 DO 1040 I=IC1,IC2 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. - & KCHG(PYCOMP(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)=NSAV+1+NBODY - ENDIF - ENDIF - IF(K(I,1).EQ.41) K(I,1)=K(I,1)+10 - 1040 CONTINUE - IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 620 - -C...Check flavours and invariant masses in parton systems. - 1050 NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 1060 J=1,5 - DPS(J)=0D0 - 1060 CONTINUE - DO 1090 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 1090 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 1090 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0) GOTO 1090 - NP=NP+1 - IF(KQ.NE.2) THEN - KFN=KFN+1 - KQS=KQS+KQ - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - ENDIF - DO 1070 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 1070 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 - & PYERRM(2,'(PYPREP:) unphysical flavour combination') - IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. - & (0.9D0*PARJ(32)+DPS(5))**2) CALL PYERRM(3, - & '(PYPREP:) too small mass in jet system') - NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 1080 J=1,5 - DPS(J)=0D0 - 1080 CONTINUE - ENDIF - 1090 CONTINUE - - RETURN - END - - -C********************************************************************* - -C...PYPTDI -C...Generates transverse momentum according to a Gaussian. - - SUBROUTINE PYPTDI(KFL,PX,PY) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Generate p_T and azimuthal angle, gives p_x and p_y. - KFLA=IABS(KFL) - PT=PARJ(21)*SQRT(-LOG(MAX(1D-10,PYR(0)))) - IF(PARJ(23).GT.PYR(0)) PT=PARJ(24)*PT - IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT - IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0D0 - PHI=PARU(2)*PYR(0) - PX=PT*COS(PHI) - PY=PT*SIN(PHI) - - RETURN - END - -C*********************************************************************** - -C...PYQQBH -C...Calculates the matrix element for the processes -C...g + g or q + qbar -> Q + Qbar + H (normally with Q = t). -C...REDUCE output and part of the rest courtesy Z. Kunszt, see -C...Z. Kunszt, Nucl. Phys. B247 (1984) 339. - - SUBROUTINE PYQQBH(WTQQBH) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/ -C...Local arrays and function. - DIMENSION PP(15,4),CLR(8,8),FM(10,10),RM(8,8),DX(8) - DOT(I,J)=PP(I,4)*PP(J,4)-PP(I,1)*PP(J,1)-PP(I,2)*PP(J,2)- - &PP(I,3)*PP(J,3) - -C...Mass parameters. - WTQQBH=0D0 - ISUB=MINT(1) - SHPR=SQRT(VINT(26))*VINT(1) - PQ=PMAS(PYCOMP(KFPR(ISUB,2)),1) - PH=SQRT(VINT(21))*VINT(1) - SPQ=PQ**2 - SPH=PH**2 - -C...Set up outgoing kinematics: 1=t, 2=tbar, 3=H. - DO 100 I=1,2 - PT=SQRT(MAX(0D0,VINT(197+5*I))) - PP(I,1)=PT*COS(VINT(198+5*I)) - PP(I,2)=PT*SIN(VINT(198+5*I)) - 100 CONTINUE - PP(3,1)=-PP(1,1)-PP(2,1) - PP(3,2)=-PP(1,2)-PP(2,2) - PMS1=SPQ+PP(1,1)**2+PP(1,2)**2 - PMS2=SPQ+PP(2,1)**2+PP(2,2)**2 - PMS3=SPH+PP(3,1)**2+PP(3,2)**2 - PMT3=SQRT(PMS3) - PP(3,3)=PMT3*SINH(VINT(211)) - PP(3,4)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-PP(3,4))**2-PP(3,3)**2 - PP(1,3)=(-PP(3,3)*(PMS12+PMS1-PMS2)+ - &VINT(213)*(SHPR-PP(3,4))*VINT(220))/(2D0*PMS12) - PP(2,3)=-PP(1,3)-PP(3,3) - PP(1,4)=SQRT(PMS1+PP(1,3)**2) - PP(2,4)=SQRT(PMS2+PP(2,3)**2) - -C...Set up incoming kinematics and derived momentum combinations. - DO 110 I=4,5 - PP(I,1)=0D0 - PP(I,2)=0D0 - PP(I,3)=-0.5D0*SHPR*(-1)**I - PP(I,4)=-0.5D0*SHPR - 110 CONTINUE - DO 120 J=1,4 - PP(6,J)=PP(1,J)+PP(2,J) - PP(7,J)=PP(1,J)+PP(3,J) - PP(8,J)=PP(1,J)+PP(4,J) - PP(9,J)=PP(1,J)+PP(5,J) - PP(10,J)=-PP(2,J)-PP(3,J) - PP(11,J)=-PP(2,J)-PP(4,J) - PP(12,J)=-PP(2,J)-PP(5,J) - PP(13,J)=-PP(4,J)-PP(5,J) - 120 CONTINUE - -C...Derived kinematics invariants. - X1=DOT(1,2) - X2=DOT(1,3) - X3=DOT(1,4) - X4=DOT(1,5) - X5=DOT(2,3) - X6=DOT(2,4) - X7=DOT(2,5) - X8=DOT(3,4) - X9=DOT(3,5) - X10=DOT(4,5) - -C...Propagators. - SS1=DOT(7,7)-SPQ - SS2=DOT(8,8)-SPQ - SS3=DOT(9,9)-SPQ - SS4=DOT(10,10)-SPQ - SS5=DOT(11,11)-SPQ - SS6=DOT(12,12)-SPQ - SS7=DOT(13,13) - DX(1)=SS1*SS6 - DX(2)=SS2*SS6 - DX(3)=SS2*SS4 - DX(4)=SS1*SS5 - DX(5)=SS3*SS5 - DX(6)=SS3*SS4 - DX(7)=SS7*SS1 - DX(8)=SS7*SS4 - -C...Define colour coefficients for g + g -> Q + Qbar + H. - IF(ISUB.EQ.121.OR.ISUB.EQ.181.OR.ISUB.EQ.186) THEN - DO 140 I=1,3 - DO 130 J=1,3 - CLR(I,J)=16D0/3D0 - CLR(I+3,J+3)=16D0/3D0 - CLR(I,J+3)=-2D0/3D0 - CLR(I+3,J)=-2D0/3D0 - 130 CONTINUE - 140 CONTINUE - DO 160 L=1,2 - DO 150 I=1,3 - CLR(I,6+L)=-6D0 - CLR(I+3,6+L)=6D0 - CLR(6+L,I)=-6D0 - CLR(6+L,I+3)=6D0 - 150 CONTINUE - 160 CONTINUE - DO 180 K1=1,2 - DO 170 K2=1,2 - CLR(6+K1,6+K2)=12D0 - 170 CONTINUE - 180 CONTINUE - -C...Evaluate matrix elements for g + g -> Q + Qbar + H. - FM(1,1)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X4+X9+2* - & X7+X5)+8*PQ**2*PH**2*(-X1-X4+2*X7)+16*PQ**2*(X2*X9+4*X2* - & X7+X2*X5-2*X4*X7-2*X9*X7)+8*PH**2*X4*X7-16*X2*X9*X7 - FM(1,2)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10+X9-X8+2 - & *X7-4*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X4-2*X2*X10+X2*X7-2* - & X2*X6-2*X3*X7+2*X4*X7+4*X10*X7-X9*X7-X8*X7)+16*X2*X7*(X4+ - & X10) - FM(1,3)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-2*X3-4* - & X4-8*X10+X9+X8-2*X7-4*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X4+X10 - & +X6)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 - & -4*X2*X4-5*X2*X10+X2*X8-X2*X7-3*X2*X6+X2*X5+X3*X9+2*X3*X7 - & -X3*X5+X4*X8+2*X4*X6-3*X4*X5-5*X10*X5+X9*X8+X9*X6+X9*X5+ - & X8*X7-4*X6*X5+X5**2)-(16*X2*X5)*(X1+X4+X10+X6) - FM(1,4)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1+X2-X3-X4+X10- - & X9-X8+2*X7+2*X6-X5)+4*PQ**2*PH**2*(X1+X3+X4+X10+2*X7+2*X6 - & )+8*PQ**2*(4*X1*X10+4*X1*X7+4*X1*X6+2*X2*X10-X2*X9-X2*X8+ - & 4*X2*X7+4*X2*X6-X2*X5+4*X10*X5+4*X7*X5+4*X6*X5)-(8*PH**2* - & X1)*(X10+X7+X6)+16*X2*X5*(X10+X7+X6) - FM(1,5)=8*PQ**4*(-2*X1-2*X4+X10-X9)+4*PQ**2*(4*X1**2-2*X1* - & X2+8*X1*X3+6*X1*X10-2*X1*X9+4*X1*X8+4*X1*X7+4*X1*X6+2*X1* - & X5+X2*X10+4*X3*X4-X3*X9+2*X3*X7+3*X4*X8-2*X4*X6+2*X4*X5-4 - & *X10*X7+3*X10*X5-3*X9*X6+3*X8*X7-4*X7**2+4*X7*X5)+8*(X1** - & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5-X1*X4* - & X8-X1*X4*X5+X1*X10*X9+X1*X9*X7+X1*X9*X6-X1*X8*X7-X2*X3*X7 - & +X2*X4*X6-X2*X10*X7-X2*X7**2+X3*X7*X5-X4*X10*X5-X4*X7*X5- - & X4*X6*X5) - FM(1,6)=16*PQ**4*(-4*X1-X4+X9-X7)+4*PQ**2*PH**2*(-2*X1-X4- - & X7)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X4-3*X1*X9-2*X1*X7-3* - & X1*X5-2*X2*X4-2*X7*X5)-8*PH**2*X4*X7+8*(-X1*X2*X9-2*X1*X2 - & *X5-X1*X9**2-X1*X9*X5+X2**2*X7-X2*X4*X5+X2*X9*X7-X2*X7*X5 - & +X4*X9*X5+X4*X5**2) - FM(1,7)=8*PQ**4*(2*X3+X4+3*X10+X9+2*X8+3*X7+6*X6)+2*PQ**2* - & PH**2*(-2*X3-X4+3*X10+3*X7+6*X6)+4*PQ**2*(4*X1*X10+4*X1* - & X7+8*X1*X6+6*X2*X10+X2*X9+2*X2*X8+6*X2*X7+12*X2*X6-8*X3* - & X7+4*X4*X7+4*X4*X6+4*X10*X5+4*X9*X7+4*X9*X6-8*X8*X7+4*X7* - & X5+8*X6*X5)+4*PH**2*(-X1*X10-X1*X7-2*X1*X6+2*X3*X7-X4*X7- - & X4*X6)+8*X2*(X10*X5+X9*X7+X9*X6-2*X8*X7+X7*X5+2*X6*X5) - FM(1,8)=8*PQ**4*(2*X3+X4+3*X10+2*X9+X8+3*X7+6*X6)+2*PQ**2* - & PH**2*(-2*X3-X4+2*X10+X7+2*X6)+4*PQ**2*(4*X1*X10-2*X1*X9+ - & 2*X1*X8+4*X1*X7+8*X1*X6+5*X2*X10+2*X2*X9+X2*X8+4*X2*X7+8* - & X2*X6-X3*X9-8*X3*X7+2*X3*X5+2*X4*X9-X4*X8+4*X4*X7+4*X4*X6 - & +4*X4*X5+5*X10*X5+X9**2-X9*X8+2*X9*X7+5*X9*X6+X9*X5-7*X8* - & X7+2*X8*X5+2*X7*X5+10*X6*X5)+2*PH**2*(-X1*X10+X3*X7-2*X4* - & X7+X4*X6)+4*(-X1*X9**2+X1*X9*X8-2*X1*X9*X5-X1*X8*X5+2*X2* - & X10*X5+X2*X9*X7+X2*X9*X6-2*X2*X8*X7+3*X2*X6*X5+X3*X9*X5+ - & X3*X5**2+X4*X9*X5-2*X4*X8*X5+2*X4*X5**2) - FM(2,2)=16*PQ**6+16*PQ**4*(-X1+X3-X4-X10+X7-X6)+16*PQ**2*( - & X3*X10+X3*X7+X3*X6+X4*X7+X10*X7)-16*X3*X10*X7 - FM(2,3)=16*PQ**6+8*PQ**4*(-2*X1+X2+2*X3-4*X4-4*X10-X9+X8-2 - & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5+4*X3*X10-X3*X9-X3*X8-2*X3* - & X7+2*X3*X6+X3*X5-2*X4*X5-2*X10*X5-2*X6*X5)+16*X3*X5*(X10+ - & X6) - FM(2,4)=8*PQ**4*(-2*X1-2*X3+X10-X8)+4*PQ**2*(4*X1**2-2*X1* - & X2+8*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+4*X1*X7+4*X1*X6+2*X1* - & X5+X2*X10+4*X3*X4+3*X3*X9-2*X3*X7+2*X3*X5-X4*X8+2*X4*X6-4 - & *X10*X6+3*X10*X5+3*X9*X6-3*X8*X7-4*X6**2+4*X6*X5)+8*(-X1 - & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9-X1*X3*X5+X1*X4 - & *X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X1*X8*X6+X2*X3* - & X7-X2*X4*X6-X2*X10*X6-X2*X6**2-X3*X10*X5-X3*X7*X5-X3*X6* - & X5+X4*X6*X5) - FM(2,5)=16*PQ**4*X10+8*PQ**2*(2*X1**2+2*X1*X3+2*X1*X4+2*X1 - & *X10+2*X1*X7+2*X1*X6+X3*X7+X4*X6)+8*(-2*X1**3-2*X1**2*X3- - & 2*X1**2*X4-2*X1**2*X10-2*X1**2*X7-2*X1**2*X6-2*X1*X3*X4- - & X1*X3*X10-2*X1*X3*X6-X1*X4*X10-2*X1*X4*X7-X1*X10**2-X1* - & X10*X7-X1*X10*X6-2*X1*X7*X6+X3**2*X7-X3*X4*X7-X3*X4*X6+X3 - & *X10*X7+X3*X7**2-X3*X7*X6+X4**2*X6+X4*X10*X6-X4*X7*X6+X4* - & X6**2) - FM(2,6)=8*PQ**4*(-2*X1+X10-X9-2*X7)+4*PQ**2*(4*X1**2+2*X1* - & X2+4*X1*X3+4*X1*X4+6*X1*X10-2*X1*X9+4*X1*X8+8*X1*X6-2*X1* - & X5+4*X2*X4+3*X2*X10+2*X2*X7-3*X3*X9-2*X3*X7-4*X4**2-4*X4* - & X10+3*X4*X8+2*X4*X6+X10*X5-X9*X6+3*X8*X7+4*X7*X6)+8*(X1** - & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5+X1*X4* - & X9-X1*X4*X8-X1*X4*X5+X1*X10*X9+X1*X9*X6-X1*X8*X7-X2*X3*X7 - & -X2*X4*X7+X2*X4*X6-X2*X10*X7+X3*X7*X5-X4**2*X5-X4*X10*X5- - & X4*X6*X5) - FM(2,7)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- - & 2*X1*X4-2*X1*X10+X1*X9-X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* - & X4+3*X2*X10+X2*X7+2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9-2*X3* - & X7-4*X3*X6-X3*X5-6*X4**2-6*X4*X10-3*X4*X9-X4*X8-4*X4*X7-2 - & *X4*X6-2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+X10*X5 - & +X9*X7-2*X8*X7-2*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( - & -X1**2*X9+X1**2*X8-2*X1*X2*X10-3*X1*X2*X7-3*X1*X2*X6+X1* - & X3*X9-X1*X3*X5+X1*X4*X9+X1*X4*X8+X1*X4*X5+X1*X10*X9+X1* - & X10*X8-X1*X9*X6+X1*X8*X6+X2*X3*X7-3*X2*X4*X7-X2*X4*X6-3* - & X2*X10*X7-3*X2*X10*X6-3*X2*X7*X6-3*X2*X6**2-2*X3*X4*X5-X3 - & *X10*X5-X3*X6*X5-X4**2*X5-X4*X10*X5+X4*X6*X5) - FM(2,8)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- - & 2*X1*X4-2*X1*X10-X1*X9+X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* - & X4+X2*X10-X2*X7-2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9+X3*X8-2* - & X3*X7-4*X3*X6+X3*X5-6*X4**2-6*X4*X10-2*X4*X9-4*X4*X7-2*X4 - & *X6+2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+3*X10*X5- - & X9*X6-2*X8*X7-3*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( - & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6-3*X1*X3*X5+X1*X4*X9- - & X1*X4*X8-3*X1*X4*X5+X1*X10*X9+X1*X10*X8-2*X1*X10*X5+X1*X9 - & *X6+X1*X8*X7+X1*X8*X6-X2*X4*X7+X2*X4*X6-X2*X10*X7-X2*X10* - & X6-2*X2*X7*X6-X2*X6**2-3*X3*X4*X5-3*X3*X10*X5+X3*X7*X5-3* - & X3*X6*X5-3*X4**2*X5-3*X4*X10*X5-X4*X6*X5) - FM(3,3)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X3+X8+X6 - & +2*X5)+8*PQ**2*PH**2*(-X1+2*X3-X6)+16*PQ**2*(X2*X5-2*X3* - & X8-2*X3*X6+4*X3*X5+X8*X5)+8*PH**2*X3*X6-16*X3*X8*X5 - FM(3,4)=16*PQ**4*(-4*X1-X3+X8-X6)+4*PQ**2*PH**2*(-2*X1-X3- - & X6)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X3-3*X1*X8-2*X1*X6-3* - & X1*X5-2*X2*X3-2*X6*X5)-8*PH**2*X3*X6+8*(-X1*X2*X8-2*X1*X2 - & *X5-X1*X8**2-X1*X8*X5+X2**2*X6-X2*X3*X5+X2*X8*X6-X2*X6*X5 - & +X3*X8*X5+X3*X5**2) - FM(3,5)=8*PQ**4*(-2*X1+X10-X8-2*X6)+4*PQ**2*(4*X1**2+2*X1* - & X2+4*X1*X3+4*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+8*X1*X7-2*X1* - & X5+4*X2*X3+3*X2*X10+2*X2*X6-4*X3**2-4*X3*X10+3*X3*X9+2*X3 - & *X7-3*X4*X8-2*X4*X6+X10*X5+3*X9*X6-X8*X7+4*X7*X6)+8*(-X1 - & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9+X1*X3*X8-X1*X3 - & *X5+X1*X4*X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X2*X3* - & X7-X2*X3*X6-X2*X4*X6-X2*X10*X6-X3**2*X5-X3*X10*X5-X3*X7* - & X5+X4*X6*X5) - FM(3,6)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1-X2+2*X3+2*X4+ - & X10-X9-X8-X7-X6+X5)+4*PQ**2*PH**2*(X1+2*X3+2*X4+X10+X7+X6 - & )+8*PQ**2*(4*X1*X3+4*X1*X4+4*X1*X10+4*X2*X3+4*X2*X4+4*X2* - & X10-X2*X5+4*X3*X5+4*X4*X5+2*X10*X5-X9*X5-X8*X5)-(8*PH**2* - & X1)*(X3+X4+X10)+16*X2*X5*(X3+X4+X10) - FM(3,7)=8*PQ**4*(3*X3+6*X4+3*X10+X9+2*X8+2*X7+X6)+2*PQ**2* - & PH**2*(X3+2*X4+2*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+4* - & X1*X10+2*X1*X9-2*X1*X8+2*X2*X3+10*X2*X4+5*X2*X10+2*X2*X9+ - & X2*X8+2*X2*X7+4*X2*X6-7*X3*X9+2*X3*X8-8*X3*X7+4*X3*X6+4* - & X3*X5+5*X4*X8+4*X4*X6+8*X4*X5+5*X10*X5-X9*X8-X9*X6+X9*X5+ - & X8**2-X8*X7+2*X8*X6+2*X8*X5)+2*PH**2*(-X1*X10+X3*X7-2*X3* - & X6+X4*X6)+4*(-X1*X2*X9-2*X1*X2*X8+X1*X9*X8-X1*X8**2+X2**2 - & *X7+2*X2**2*X6+3*X2*X4*X5+2*X2*X10*X5-2*X2*X9*X6+X2*X8*X7 - & +X2*X8*X6-2*X3*X9*X5+X3*X8*X5+X4*X8*X5) - FM(3,8)=8*PQ**4*(3*X3+6*X4+3*X10+2*X9+X8+2*X7+X6)+2*PQ**2* - & PH**2*(3*X3+6*X4+3*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+ - & 4*X1*X10+4*X2*X3+8*X2*X4+4*X2*X10-8*X3*X9+4*X3*X8-8*X3*X7 - & +4*X3*X6+6*X3*X5+4*X4*X8+4*X4*X6+12*X4*X5+6*X10*X5+2*X9* - & X5+X8*X5)+4*PH**2*(-X1*X3-2*X1*X4-X1*X10+2*X3*X7-X3*X6-X4 - & *X6)+8*X5*(X2*X3+2*X2*X4+X2*X10-2*X3*X9+X3*X8+X4*X8) - FM(4,4)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X3+X8+2* - & X6+X5)+8*PQ**2*PH**2*(-X1-X3+2*X6)+16*PQ**2*(X2*X8+4*X2* - & X6+X2*X5-2*X3*X6-2*X8*X6)+8*PH**2*X3*X6-16*X2*X8*X6 - FM(4,5)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10-X9+X8-4 - & *X7+2*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X3-2*X2*X10-2*X2*X7+ - & X2*X6+2*X3*X6-2*X4*X6+4*X10*X6-X9*X6-X8*X6)+16*X2*X6*(X3+ - & X10) - FM(4,6)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-4*X3-2* - & X4-8*X10+X9+X8-4*X7-2*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X3+X10 - & +X7)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 - & -4*X2*X3-5*X2*X10+X2*X9-3*X2*X7-X2*X6+X2*X5+X3*X9+2*X3*X7 - & -3*X3*X5+X4*X8+2*X4*X6-X4*X5-5*X10*X5+X9*X8+X9*X6+X8*X7+ - & X8*X5-4*X7*X5+X5**2)-(16*X2*X5)*(X1+X3+X10+X7) - FM(4,7)=8*PQ**4*(-X3-2*X4-3*X10-2*X9-X8-6*X7-3*X6)+2*PQ**2 - & *PH**2*(X3+2*X4-3*X10-6*X7-3*X6)+4*PQ**2*(-4*X1*X10-8*X1* - & X7-4*X1*X6-6*X2*X10-2*X2*X9-X2*X8-12*X2*X7-6*X2*X6-4*X3* - & X7-4*X3*X6+8*X4*X6-4*X10*X5+8*X9*X6-4*X8*X7-4*X8*X6-8*X7* - & X5-4*X6*X5)+4*PH**2*(X1*X10+2*X1*X7+X1*X6+X3*X7+X3*X6-2* - & X4*X6)+8*X2*(-X10*X5+2*X9*X6-X8*X7-X8*X6-2*X7*X5-X6*X5) - FM(4,8)=8*PQ**4*(-X3-2*X4-3*X10-X9-2*X8-6*X7-3*X6)+2*PQ**2 - & *PH**2*(X3+2*X4-2*X10-2*X7-X6)+4*PQ**2*(-4*X1*X10-2*X1*X9 - & +2*X1*X8-8*X1*X7-4*X1*X6-5*X2*X10-X2*X9-2*X2*X8-8*X2*X7-4 - & *X2*X6+X3*X9-2*X3*X8-4*X3*X7-4*X3*X6-4*X3*X5+X4*X8+8*X4* - & X6-2*X4*X5-5*X10*X5+X9*X8+7*X9*X6-2*X9*X5-X8**2-5*X8*X7-2 - & *X8*X6-X8*X5-10*X7*X5-2*X6*X5)+2*PH**2*(X1*X10-X3*X7+2*X3 - & *X6-X4*X6)+4*(-X1*X9*X8+X1*X9*X5+X1*X8**2+2*X1*X8*X5-2*X2 - & *X10*X5+2*X2*X9*X6-X2*X8*X7-X2*X8*X6-3*X2*X7*X5+2*X3*X9* - & X5-X3*X8*X5-2*X3*X5**2-X4*X8*X5-X4*X5**2) - FM(5,5)=16*PQ**6+16*PQ**4*(-X1-X3+X4-X10-X7+X6)+16*PQ**2*( - & X3*X6+X4*X10+X4*X7+X4*X6+X10*X6)-16*X4*X10*X6 - FM(5,6)=16*PQ**6+8*PQ**4*(-2*X1+X2-4*X3+2*X4-4*X10+X9-X8-2 - & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5-2*X3*X5+4*X4*X10-X4*X9-X4* - & X8+2*X4*X7-2*X4*X6+X4*X5-2*X10*X5-2*X7*X5)+16*X4*X5*(X10+ - & X7) - FM(5,7)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ - & 4*X1*X4+2*X1*X10+X1*X9-X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* - & X4-3*X2*X10-2*X2*X7-X2*X6+6*X3**2+6*X3*X4+6*X3*X10+X3*X9+ - & 3*X3*X8+2*X3*X7+4*X3*X6+2*X3*X5+6*X4*X10+2*X4*X8+4*X4*X7+ - & 2*X4*X6+X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-X10*X5+ - & 2*X9*X7+2*X9*X6-X8*X6+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*(- - & X1**2*X9+X1**2*X8+2*X1*X2*X10+3*X1*X2*X7+3*X1*X2*X6-X1*X3 - & *X9-X1*X3*X8-X1*X3*X5-X1*X4*X8+X1*X4*X5-X1*X10*X9-X1*X10* - & X8-X1*X9*X7+X1*X8*X7+X2*X3*X7+3*X2*X3*X6-X2*X4*X6+3*X2* - & X10*X7+3*X2*X10*X6+3*X2*X7**2+3*X2*X7*X6+X3**2*X5+2*X3*X4 - & *X5+X3*X10*X5-X3*X7*X5+X4*X10*X5+X4*X7*X5) - FM(5,8)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ - & 4*X1*X4+2*X1*X10-X1*X9+X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* - & X4-X2*X10+2*X2*X7+X2*X6+6*X3**2+6*X3*X4+6*X3*X10+2*X3*X8+ - & 2*X3*X7+4*X3*X6-2*X3*X5+6*X4*X10-X4*X9+2*X4*X8+4*X4*X7+2* - & X4*X6-X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-3*X10*X5+ - & 3*X9*X7+2*X9*X6+X8*X7+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*( - & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9-X1*X3*X8+3* - & X1*X3*X5+3*X1*X4*X5-X1*X10*X9-X1*X10*X8+2*X1*X10*X5-X1*X9 - & *X7-X1*X9*X6-X1*X8*X7-X2*X3*X7+X2*X3*X6+X2*X10*X7+X2*X10* - & X6+X2*X7**2+2*X2*X7*X6+3*X3**2*X5+3*X3*X4*X5+3*X3*X10*X5+ - & X3*X7*X5+3*X4*X10*X5+3*X4*X7*X5-X4*X6*X5) - FM(6,6)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X4+X9+X7 - & +2*X5)+8*PQ**2*PH**2*(-X1+2*X4-X7)+16*PQ**2*(X2*X5-2*X4* - & X9-2*X4*X7+4*X4*X5+X9*X5)+8*PH**2*X4*X7-16*X4*X9*X5 - FM(6,7)=8*PQ**4*(-6*X3-3*X4-3*X10-2*X9-X8-X7-2*X6)+2*PQ**2 - & *PH**2*(-2*X3-X4-2*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1*X4 - & -4*X1*X10+2*X1*X9-2*X1*X8-10*X2*X3-2*X2*X4-5*X2*X10-X2*X9 - & -2*X2*X8-4*X2*X7-2*X2*X6-5*X3*X9-4*X3*X7-8*X3*X5-2*X4*X9+ - & 7*X4*X8-4*X4*X7+8*X4*X6-4*X4*X5-5*X10*X5-X9**2+X9*X8-2*X9 - & *X7+X9*X6-2*X9*X5+X8*X7-X8*X5)+2*PH**2*(X1*X10-X3*X7+2*X4 - & *X7-X4*X6)+4*(2*X1*X2*X9+X1*X2*X8+X1*X9**2-X1*X9*X8-2*X2 - & **2*X7-X2**2*X6-3*X2*X3*X5-2*X2*X10*X5-X2*X9*X7-X2*X9*X6+ - & 2*X2*X8*X7-X3*X9*X5-X4*X9*X5+2*X4*X8*X5) - FM(6,8)=8*PQ**4*(-6*X3-3*X4-3*X10-X9-2*X8-X7-2*X6)+2*PQ**2 - & *PH**2*(-6*X3-3*X4-3*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1* - & X4-4*X1*X10-8*X2*X3-4*X2*X4-4*X2*X10-4*X3*X9-4*X3*X7-12* - & X3*X5-4*X4*X9+8*X4*X8-4*X4*X7+8*X4*X6-6*X4*X5-6*X10*X5-X9 - & *X5-2*X8*X5)+4*PH**2*(2*X1*X3+X1*X4+X1*X10+X3*X7+X4*X7-2* - & X4*X6)+8*X5*(-2*X2*X3-X2*X4-X2*X10-X3*X9-X4*X9+2*X4*X8) - FM(7,7)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+9* - & X2*X10+7*X3*X7+2*X3*X6+2*X4*X7+7*X4*X6+X10*X5+2*X9*X7+7* - & X9*X6+7*X8*X7+2*X8*X6)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2 - & *X4*X7-7*X4*X6)+4*X2*(X10*X5+2*X9*X7+7*X9*X6+7*X8*X7+2*X8 - & *X6) - FM(7,8)=72*PQ**4*X10+2*PQ**2*PH**2*X10+4*PQ**2*(2*X1*X10+ - & 10*X2*X10+7*X3*X9+2*X3*X8+14*X3*X7+4*X3*X6+2*X4*X9+7*X4* - & X8+4*X4*X7+14*X4*X6+10*X10*X5+X9**2+7*X9*X8+2*X9*X7+7*X9* - & X6+X8**2+7*X8*X7+2*X8*X6)+2*PH**2*(7*X1*X10-7*X3*X7-2*X3* - & X6-2*X4*X7-7*X4*X6)+2*(-2*X1*X9**2-14*X1*X9*X8-2*X1*X8**2 - & +2*X2*X10*X5+2*X2*X9*X7+7*X2*X9*X6+7*X2*X8*X7+2*X2*X8*X6+ - & 7*X3*X9*X5+2*X3*X8*X5+2*X4*X9*X5+7*X4*X8*X5) - FM(8,8)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+X2 - & *X10+7*X3*X9+2*X3*X8+7*X3*X7+2*X3*X6+2*X4*X9+7*X4*X8+2*X4 - & *X7+7*X4*X6+9*X10*X5)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2* - & X4*X7-7*X4*X6)+4*X5*(X2*X10+7*X3*X9+2*X3*X8+2*X4*X9+7*X4* - & X8) - FM(9,9)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ - & X3*X7+X4*X6-X10*X5+X9*X6+X8*X7)+PH**2*(X1*X10-X3*X7-X4*X6 - & )+2*X2*(-X10*X5+X9*X6+X8*X7) - FM(9,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* - & X10+2*X3*X9+2*X3*X7+2*X4*X6-2*X10*X5+X9*X8+2*X8*X7)+PH**2 - & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X8*X7+X3* - & X9*X5) - FMXX=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* - & X10+2*X4*X8+2*X4*X6+2*X3*X7-2*X10*X5+X9*X8+2*X9*X6)+PH**2 - & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X9*X6+X4* - & X8*X5) - FM(9,10)=0.5D0*(FMXX+FM(9,10)) - FM(10,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ - & X3*X7+X4*X6-X10*X5+X9*X3+X8*X4)+PH**2*(X1*X10-X3*X7-X4*X6 - & )+2*X5*(-X10*X2+X9*X3+X8*X4) - -C...Repackage matrix elements. - DO 200 I=1,8 - DO 190 J=I,8 - RM(I,J)=FM(I,J) - 190 CONTINUE - 200 CONTINUE - RM(7,7)=FM(7,7)-2D0*FM(9,9) - RM(7,8)=FM(7,8)-2D0*FM(9,10) - RM(8,8)=FM(8,8)-2D0*FM(10,10) - -C...Produce final result: matrix elements * colours * propagators. - DO 220 I=1,8 - DO 210 J=I,8 - FAC=8D0 - IF(I.EQ.J)FAC=4D0 - WTQQBH=WTQQBH+RM(I,J)*FAC*CLR(I,J)/(DX(I)*DX(J)) - 210 CONTINUE - 220 CONTINUE - WTQQBH=-WTQQBH/256D0 - - ELSE -C...Evaluate matrix elements for q + qbar -> Q + Qbar + H. - A11=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X2*X10+X3 - & *X7+X4*X6+X9*X6+X8*X7)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X2)*(X9 - & *X6+X8*X7) - A12=-8D0*PQ**4*X10+4D0*PQ**2*(-X2*X10-X3*X9-2D0*X3*X7-X4*X8- - & 2D0*X4*X6-X10*X5-X9*X8-X9*X6-X8*X7)+2D0*PH**2*(-X1*X10+X3*X7 - & +X4*X6)+2D0*(2D0*X1*X9*X8-X2*X9*X6-X2*X8*X7-X3*X9*X5-X4*X8* - & X5) - A22=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X3*X9+X3* - & X7+X4*X8+X4*X6+X10*X5)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X5)*(X3 - & *X9+X4*X8) - -C...Produce final result: matrix elements * propagators. - A11=A11/DX(7)**2 - A12=A12/(DX(7)*DX(8)) - A22=A22/DX(8)**2 - WTQQBH=-(A11+A22+2D0*A12)*8D0/9D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRADK -C...Generates initial state photon radiation. - - SUBROUTINE PYRADK(ECM,MK,PAK,THEK,PHIK,ALPK) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Function: cumulative hard photon spectrum in QFD case. - FXK(XX)=2D0*LOG(XX)+PARJ(161)*LOG(1D0-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=0D0 - IF(PARJ(160).LT.PYR(0)) RETURN - MK=1 - -C...Photon energy range. Find photon momentum in QED case. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) - IF(MSTJ(102).LE.1) THEN - 100 XK=1D0/(1D0+(1D0/XKL-1D0)*((1D0/XKU-1D0)/(1D0/XKL-1D0))**PYR(0)) - IF(1D0+(1D0-XK)**2.LT.2D0*PYR(0)) GOTO 100 - -C...Ditto in QFD case, by numerical inversion of integrated spectrum. - ELSE - SZM=1D0-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - FXKL=FXK(XKL) - FXKU=FXK(XKU) - FXKD=1D-4*(FXKU-FXKL) - FXKR=FXKL+PYR(0)*(FXKU-FXKL) - NXK=0 - 110 NXK=NXK+1 - XK=0.5D0*(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.5D0*ECM*XK - -C...Photon polar and azimuthal angle. - PME=2D0*(PYMASS(11)/ECM)**2 - 120 CTHM=PME*(2D0/PME)**PYR(0) - IF(1D0-(XK**2*CTHM*(1D0-0.5D0*CTHM)+2D0*(1D0-XK)*PME/MAX(PME, - &CTHM*(1D0-0.5D0*CTHM)))/(1D0+(1D0-XK)**2).LT.PYR(0)) GOTO 120 - CTHE=1D0-CTHM - IF(PYR(0).GT.0.5D0) CTHE=-CTHE - STHE=SQRT(MAX(0D0,(CTHM-PME)*(2D0-CTHM))) - THEK=PYANGL(CTHE,STHE) - PHIK=PARU(2)*PYR(0) - -C...Rotation angle for hadronic system. - SGN=1D0 - IF(0.5D0*(2D0-XK*(1D0-CTHE))**2/((2D0-XK)**2+(XK*CTHE)**2).GT. - &PYR(0)) SGN=-1D0 - ALPK=ASIN(SGN*STHE*(XK-SGN*(2D0*SQRT(1D0-XK)-2D0+XK)*CTHE)/ - &(2D0-XK*(1D0-SGN*CTHE))) - - RETURN - END - -C********************************************************************* - -C...PYRAND -C...Generates quantities characterizing the high-pT scattering at the -C...parton level according to the matrix elements. Chooses incoming, -C...reacting partons, their momentum fractions and one of the possible -C...subprocesses. - - SUBROUTINE PYRAND - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process initialization and event commonblocks. - 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) - 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 /HEPRUP/,/HEPEUP/ - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYMSSM/ -C...Local arrays. - DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4),PMMN(2) - -C...Parameters and data used in elastic/diffractive treatment. - DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/, - &SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ - -C...Initial values, specifically for (first) semihard interaction. - MINT(10)=0 - MINT(17)=0 - MINT(18)=0 - VINT(97)=1D0 - VINT(143)=1D0 - VINT(144)=1D0 - VINT(157)=0D0 - VINT(158)=0D0 - MFAIL=0 - IF(MSTP(171).EQ.1.AND.MSTP(172).EQ.2) MFAIL=1 - ISUB=0 - ISTSB=0 - LOOP=0 - 100 LOOP=LOOP+1 - MINT(51)=0 - MINT(143)=1 - -C...Start by assuming incoming photon is entering subprocess. - IF(MINT(11).EQ.22) THEN - MINT(15)=22 - VINT(307)=VINT(3)**2 - ENDIF - IF(MINT(12).EQ.22) THEN - MINT(16)=22 - VINT(308)=VINT(4)**2 - ENDIF - MINT(103)=MINT(11) - MINT(104)=MINT(12) - -C...Choice of process type - first event of pileup. - INMULT=0 - IF(MINT(82).EQ.1.AND.ISUB.GE.91.AND.ISUB.LE.96) THEN - ELSEIF(MINT(82).EQ.1) THEN - -C...For gamma-p or gamma-gamma first pick between alternatives. - IGA=0 - IF(MINT(121).GT.1) CALL PYSAVE(4,IGA) - MINT(122)=IGA - -C...For real gamma + gamma with different nature, flip at random. - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. - & MSTP(14).LE.10.AND.PYR(0).GT.0.5D0) THEN - MINTSV=MINT(41) - MINT(41)=MINT(42) - MINT(42)=MINTSV - MINTSV=MINT(45) - MINT(45)=MINT(46) - MINT(46)=MINTSV - MINTSV=MINT(107) - MINT(107)=MINT(108) - MINT(108)=MINTSV - IF(MINT(47).EQ.2.OR.MINT(47).EQ.3) MINT(47)=5-MINT(47) - ENDIF - -C...Pick process type, possibly by user process machinery. -C...(If the latter, also event will be picked here.) - IF(MINT(111).EQ.11.AND.IABS(IDWTUP).EQ.2.AND.LOOP.GE.2) THEN - CALL UPEVNT - CALL PYUPRE - ELSEIF(MINT(111).EQ.11.AND.IABS(IDWTUP).GE.3) THEN - CALL UPEVNT - CALL PYUPRE - ISUB=0 - 110 ISUB=ISUB+1 - IF((ISET(ISUB).NE.11.OR.KFPR(ISUB,2).NE.IDPRUP).AND. - & ISUB.LT.500) GOTO 110 - ELSE - RSUB=XSEC(0,1)*PYR(0) - DO 120 I=1,500 - IF(MSUB(I).NE.1) GOTO 120 - ISUB=I - RSUB=RSUB-XSEC(I,1) - IF(RSUB.LE.0D0) GOTO 130 - 120 CONTINUE - 130 IF(ISUB.EQ.95) ISUB=96 - IF(ISUB.EQ.96) INMULT=1 - IF(ISET(ISUB).EQ.11) THEN - IDPRUP=KFPR(ISUB,2) - CALL UPEVNT - CALL PYUPRE - ENDIF - ENDIF - -C...Choice of inclusive process type - pileup events. - ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN - RSUB=VINT(131)*PYR(0) - ISUB=96 - IF(RSUB.GT.SIGT(0,0,5)) ISUB=94 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)) ISUB=93 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)) ISUB=92 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)+SIGT(0,0,2)) - & ISUB=91 - IF(ISUB.EQ.96) INMULT=1 - ENDIF - -C...Choice of photon energy and flux factor inside lepton. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN - IF (MSTP(199).EQ.1) THEN - CALL PYGAGA(5,WTGAGA) - ELSE - CALL PYGAGA(3,WTGAGA) - ENDIF - IF(ISUB.GE.131.AND.ISUB.LE.140) THEN - CKIN(3)=MAX(VINT(285),VINT(154)) - CKIN(1)=2D0*CKIN(3) - ENDIF -C...When necessary set direct/resolved photon by hand. - ELSEIF(MINT(15).EQ.22.OR.MINT(16).EQ.22) THEN - IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 - IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 - ENDIF - -C...Restrict direct*resolved processes to pTmin >= Q, -C...to avoid doublecounting with DIS. - IF(MSTP(18).EQ.3.AND.ISUB.GE.131.AND.ISUB.LE.136) THEN - IF(MINT(15).EQ.22) THEN - CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(3))) - ELSE - CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(4))) - ENDIF - CKIN(1)=2D0*CKIN(3) - ENDIF - -C...Set up for multiple interactions. - IF(INMULT.EQ.1) CALL PYMULT(2) - -C...Loopback point for minimum bias in photon physics. - LOOP2=0 - 140 LOOP2=LOOP2+1 - IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+MINT(143) - IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+MINT(143) - IF(ISUB.EQ.96.AND.LOOP2.EQ.1.AND.MINT(82).EQ.1) - &NGEN(97,1)=NGEN(97,1)+MINT(143) - MINT(1)=ISUB - ISTSB=ISET(ISUB) - -C...Random choice of flavour for some SUSY processes. - IF(ISUB.GE.201.AND.ISUB.LE.301) THEN -C...~e_L ~nu_e or ~mu_L ~nu_mu. - IF(ISUB.EQ.210) THEN - KFPR(ISUB,1)=KSUSY1+11+2*INT(0.5D0+PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1)+1 -C...~nu_e ~nu_e(bar) or ~nu_mu ~nu_mu(bar). - ELSEIF(ISUB.EQ.213) THEN - KFPR(ISUB,1)=KSUSY1+12+2*INT(0.5D0+PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) -C...~q ~chi/~g; ~q = ~d, ~u, ~s, ~c or ~b. - ELSEIF(ISUB.GE.246.AND.ISUB.LE.259) THEN - IF(ISUB.GE.258) THEN - RKF=4D0 - ELSE - RKF=5D0 - ENDIF - IF(MOD(ISUB,2).EQ.0) THEN - KFPR(ISUB,1)=KSUSY1+1+INT(RKF*PYR(0)) - ELSE - KFPR(ISUB,1)=KSUSY2+1+INT(RKF*PYR(0)) - ENDIF -C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.GE.271.AND.ISUB.LE.276) THEN - IF(ISUB.EQ.271.OR.ISUB.EQ.274) THEN - KSU1=KSUSY1 - KSU2=KSUSY1 - ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.275) THEN - KSU1=KSUSY2 - KSU2=KSUSY2 - ELSEIF(PYR(0).LT.0.5D0) THEN - KSU1=KSUSY1 - KSU2=KSUSY2 - ELSE - KSU1=KSUSY2 - KSU2=KSUSY1 - ENDIF - KFPR(ISUB,1)=KSU1+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KSU2+1+INT(4D0*PYR(0)) -C...~q ~q(bar); ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.279) THEN - KFPR(ISUB,1)=KSUSY1+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.280) THEN - KFPR(ISUB,1)=KSUSY2+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) -C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.GE.281.AND.ISUB.LE.286) THEN - IF(ISUB.EQ.281.OR.ISUB.EQ.284) THEN - KSU1=KSUSY1 - KSU2=KSUSY1 - ELSEIF(ISUB.EQ.282.OR.ISUB.EQ.285) THEN - KSU1=KSUSY2 - KSU2=KSUSY2 - ELSEIF(PYR(0).LT.0.5D0) THEN - KSU1=KSUSY1 - KSU2=KSUSY2 - ELSE - KSU1=KSUSY2 - KSU2=KSUSY1 - ENDIF - IF(ISUB.EQ.281.OR.ISUB.LE.283) THEN - RKF=5D0 - ELSE - RKF=4D0 - ENDIF - KFPR(ISUB,2)=KSU2+1+INT(RKF*PYR(0)) - ENDIF - ENDIF - -C...Find resonances (explicit or implicit in cross-section). - MINT(72)=0 - KFR1=0 - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - KFR1=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165.OR. - & ISUB.EQ.171.OR.ISUB.EQ.176) THEN - KFR1=23 - ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172.OR. - & ISUB.EQ.177) THEN - KFR1=24 - ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN - KFR1=25 - IF(MSTP(46).EQ.5) THEN - KFR1=89 - PMAS(89,1)=PARP(45) - PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) - ENDIF - ELSEIF(ISUB.EQ.194) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.EQ.195) THEN - KFR1=KTECHN+213 - ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN - KFR1=KTECHN+213 - ENDIF - CKMX=CKIN(2) - IF(CKMX.LE.0D0) CKMX=VINT(1) - KCR1=PYCOMP(KFR1) - IF(KFR1.NE.0) THEN - IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. - & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 - ENDIF - IF(KFR1.NE.0) THEN - TAUR1=PMAS(KCR1,1)**2/VINT(2) - IF(KFR1.EQ.KTECHN+113) THEN - CALL PYTECM(S1,S2) - TAUR1=S1/VINT(2) - ENDIF - GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) - $THEN - KFR2=23 - IF(ISUB.EQ.194) THEN - KFR2=KTECHN+223 - ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN - KFR2=KTECHN+223 - ENDIF - KCR2=PYCOMP(KFR2) - TAUR2=PMAS(KCR2,1)**2/VINT(2) - IF(KFR2.EQ.KTECHN+223) THEN - CALL PYTECM(S1,S2) - TAUR2=S2/VINT(2) - ENDIF - GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) - IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. - & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 - IF(KFR2.NE.0.AND.KFR1.NE.0) THEN - MINT(72)=2 - MINT(74)=KFR2 - VINT(75)=TAUR2 - VINT(76)=GAMR2 - ELSEIF(KFR2.NE.0) THEN - KFR1=KFR2 - TAUR1=TAUR2 - GAMR1=GAMR2 - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - ENDIF - -C...Find product masses and minimum pT of process, -C...optionally with broadening according to a truncated Breit-Wigner. - VINT(63)=0D0 - VINT(64)=0D0 - MINT(71)=0 - VINT(71)=CKIN(3) - IF(MINT(82).GE.2) VINT(71)=0D0 - VINT(80)=1D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - NBW=0 - DO 160 I=1,2 - PMMN(I)=0D0 - IF(KFPR(ISUB,I).EQ.0) THEN - ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. - & PARP(41)) THEN - VINT(62+I)=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - ELSE - NBW=NBW+1 -C...This prevents SUSY/t particles from becoming too light. - KFLW=KFPR(ISUB,I) - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - KCW=PYCOMP(KFLW) - PMMN(I)=PMAS(KCW,1) - DO 150 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 150 CONTINUE - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - ENDIF - 160 CONTINUE - IF(NBW.GE.1) THEN - CKIN41=CKIN(41) - CKIN43=CKIN(43) - CKIN(41)=MAX(PMMN(1),CKIN(41)) - CKIN(43)=MAX(PMMN(2),CKIN(43)) - CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) - CKIN(41)=CKIN41 - CKIN(43)=CKIN43 - IF(MINT(51).EQ.1) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - VINT(63)=PQM3**2 - VINT(64)=PQM4**2 - ENDIF - IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1 - IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) - ENDIF - -C...Prepare for additional variable choices in 2 -> 3. - IF(ISTSB.EQ.5) THEN - VINT(201)=0D0 - IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) - VINT(206)=VINT(201) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) - VINT(204)=PMAS(23,1) - IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) - IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. - & ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) - & VINT(204)=VINT(201) - VINT(209)=VINT(204) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) - ENDIF - -C...Select incoming VDM particle (rho/omega/phi/J/psi). - IF(ISTSB.NE.0.AND.(MINT(101).GE.2.OR.MINT(102).GE.2).AND. - &(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7)) THEN - VRN=PYR(0)*SIGT(0,0,5) - IF(MINT(101).LE.1) THEN - I1MN=0 - I1MX=0 - ELSE - I1MN=1 - I1MX=MINT(101) - ENDIF - IF(MINT(102).LE.1) THEN - I2MN=0 - I2MX=0 - ELSE - I2MN=1 - I2MX=MINT(102) - ENDIF - DO 180 I1=I1MN,I1MX - KFV1=110*I1+3 - DO 170 I2=I2MN,I2MX - KFV2=110*I2+3 - VRN=VRN-SIGT(I1,I2,5) - IF(VRN.LE.0D0) GOTO 190 - 170 CONTINUE - 180 CONTINUE - 190 IF(MINT(101).GE.2) MINT(103)=KFV1 - IF(MINT(102).GE.2) MINT(104)=KFV2 - ENDIF - - IF(ISTSB.EQ.0) THEN -C...Elastic scattering or single or double diffractive scattering. - -C...Select incoming particle (rho/omega/phi/J/psi for VDM) and mass. - MINT(103)=MINT(11) - MINT(104)=MINT(12) - PMM(1)=VINT(3) - PMM(2)=VINT(4) - IF(MINT(101).GE.2.OR.MINT(102).GE.2) THEN - JJ=ISUB-90 - VRN=PYR(0)*SIGT(0,0,JJ) - IF(MINT(101).LE.1) THEN - I1MN=0 - I1MX=0 - ELSE - I1MN=1 - I1MX=MINT(101) - ENDIF - IF(MINT(102).LE.1) THEN - I2MN=0 - I2MX=0 - ELSE - I2MN=1 - I2MX=MINT(102) - ENDIF - DO 210 I1=I1MN,I1MX - KFV1=110*I1+3 - DO 200 I2=I2MN,I2MX - KFV2=110*I2+3 - VRN=VRN-SIGT(I1,I2,JJ) - IF(VRN.LE.0D0) GOTO 220 - 200 CONTINUE - 210 CONTINUE - 220 IF(MINT(101).GE.2) THEN - MINT(103)=KFV1 - PMM(1)=PYMASS(KFV1) - ENDIF - IF(MINT(102).GE.2) THEN - MINT(104)=KFV2 - PMM(2)=PYMASS(KFV2) - ENDIF - ENDIF - VINT(67)=PMM(1) - VINT(68)=PMM(2) - -C...Select mass for GVMD states (rejecting previous assignment). - Q0S=4D0*PARP(15)**2 - Q1S=4D0*VINT(154)**2 - LOOP3=0 - 230 LOOP3=LOOP3+1 - DO 240 JT=1,2 - IF(MINT(106+JT).EQ.3) THEN - PS=VINT(2+JT)**2 - PMM(JT)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - IF(MINT(102+JT).GE.333) PMM(JT)=PMM(JT)- - & PMAS(PYCOMP(113),1)+PMAS(PYCOMP(MINT(102+JT)),1) - ENDIF - 240 CONTINUE - IF(PMM(1)+PMM(2)+PARP(104).GE.VINT(1)) THEN - IF(LOOP3.LT.100.AND.(MINT(107).EQ.3.OR.MINT(108).EQ.3)) - & GOTO 230 - GOTO 100 - ENDIF - -C...Side/sides of diffractive system. - MINT(17)=0 - MINT(18)=0 - IF(ISUB.EQ.92.OR.ISUB.EQ.94) MINT(17)=1 - IF(ISUB.EQ.93.OR.ISUB.EQ.94) MINT(18)=1 - -C...Find masses of particles and minimal masses of diffractive states. - DO 250 JT=1,2 - PDIF(JT)=PMM(JT) - VINT(68+JT)=PDIF(JT) - IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102) - 250 CONTINUE - SH=VINT(2) - SQM1=PMM(1)**2 - SQM2=PMM(2)**2 - SQM3=PDIF(1)**2 - SQM4=PDIF(2)**2 - SMRES1=(PMM(1)+PMRC)**2 - SMRES2=(PMM(2)+PMRC)**2 - -C...Find elastic slope and lower limit diffractive slope. - IHA=MAX(2,IABS(MINT(103))/110) - IF(IHA.GE.5) IHA=1 - IHB=MAX(2,IABS(MINT(104))/110) - IF(IHB.GE.5) IHB=1 - IF(ISUB.EQ.91) THEN - BMN=2D0*BHAD(IHA)+2D0*BHAD(IHB)+4D0*SH**EPS-4.2D0 - ELSEIF(ISUB.EQ.92) THEN - BMN=MAX(2D0,2D0*BHAD(IHB)) - ELSEIF(ISUB.EQ.93) THEN - BMN=MAX(2D0,2D0*BHAD(IHA)) - ELSEIF(ISUB.EQ.94) THEN - BMN=2D0*ALP*4D0 - ENDIF - -C...Determine maximum possible t range and coefficient of generation. - SQLA12=(SH-SQM1-SQM2)**2-4D0*SQM1*SQM2 - SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 - THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH - THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH - THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* - & (SQM1*SQM4-SQM2*SQM3)/SH - THL=-0.5D0*(THA+THB) - THU=THC/THL - THRND=EXP(MAX(-50D0,BMN*(THL-THU)))-1D0 - -C...Select diffractive mass/masses according to dm^2/m^2. - LOOP3=0 - 260 LOOP3=LOOP3+1 - DO 270 JT=1,2 - IF(MINT(16+JT).EQ.0) THEN - PDIF(2+JT)=PDIF(JT) - ELSE - PMMIN=PDIF(JT) - PMMAX=MAX(VINT(2+JT),VINT(1)-PDIF(3-JT)) - PDIF(2+JT)=PMMIN*(PMMAX/PMMIN)**PYR(0) - ENDIF - 270 CONTINUE - SQM3=PDIF(3)**2 - SQM4=PDIF(4)**2 - -C..Additional mass factors, including resonance enhancement. - IF(PDIF(3)+PDIF(4).GE.VINT(1)) THEN - IF(LOOP3.LT.100) GOTO 260 - GOTO 100 - ENDIF - IF(ISUB.EQ.92) THEN - FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3)) - IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 - ELSEIF(ISUB.EQ.93) THEN - FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4)) - IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 - ELSEIF(ISUB.EQ.94) THEN - FDD=(1D0-(PDIF(3)+PDIF(4))**2/SH)*(SH*SMP/ - & (SH*SMP+SQM3*SQM4))*(1D0+CRES*SMRES1/(SMRES1+SQM3))* - & (1D0+CRES*SMRES2/(SMRES2+SQM4)) - IF(FDD.LT.PYR(0)*(1D0+CRES)**2) GOTO 260 - ENDIF - -C...Select t according to exp(Bmn*t) and correct to right slope. - TH=THU+LOG(1D0+THRND*PYR(0))/BMN - IF(ISUB.GE.92) THEN - IF(ISUB.EQ.92) THEN - BADD=2D0*ALP*LOG(SH/SQM3) - IF(BHAD(IHB).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHB)-2D0) - ELSEIF(ISUB.EQ.93) THEN - BADD=2D0*ALP*LOG(SH/SQM4) - IF(BHAD(IHA).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHA)-2D0) - ELSEIF(ISUB.EQ.94) THEN - BADD=2D0*ALP*(LOG(EXP(4D0)+SH/(ALP*SQM3*SQM4))-4D0) - ENDIF - IF(EXP(MAX(-50D0,BADD*(TH-THU))).LT.PYR(0)) GOTO 260 - ENDIF - -C...Check whether m^2 and t choices are consistent. - SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 - THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH - THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH - IF(THB.LE.1D-8) GOTO 260 - THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* - & (SQM1*SQM4-SQM2*SQM3)/SH - THLM=-0.5D0*(THA+THB) - THUM=THC/THLM - IF(TH.LT.THLM.OR.TH.GT.THUM) GOTO 260 - -C...Information to output. - VINT(21)=1D0 - VINT(22)=0D0 - VINT(23)=MIN(1D0,MAX(-1D0,(THA+2D0*TH)/THB)) - VINT(45)=TH - VINT(59)=2D0*SQRT(MAX(0D0,-(THC+THA*TH+TH**2)))/THB - VINT(63)=PDIF(3)**2 - VINT(64)=PDIF(4)**2 - VINT(283)=PMM(1)**2/4D0 - VINT(284)=PMM(2)**2/4D0 - -C...Note: in the following, by In is meant the integral over the -C...quantity multiplying coefficient cn. -C...Choose tau according to h1(tau)/tau, where -C...h1(tau) = c1 + I1/I2*c2*1/tau + I1/I3*c3*1/(tau+tau_R) + -C...I1/I4*c4*tau/((s*tau-m^2)^2+(m*Gamma)^2) + -C...I1/I5*c5*1/(tau+tau_R') + -C...I1/I6*c6*tau/((s*tau-m'^2)^2+(m'*Gamma')^2) + -C...I1/I7*c7*tau/(1.-tau), and -C...c1 + c2 + c3 + c4 + c5 + c6 + c7 = 1. - ELSEIF(ISTSB.GE.1.AND.ISTSB.LE.5) THEN - CALL PYKLIM(1) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RTAU=PYR(0) - MTAU=1 - IF(RTAU.GT.COEF(ISUB,1)) MTAU=2 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)) - & MTAU=5 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ - & COEF(ISUB,5)) MTAU=6 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ - & COEF(ISUB,5)+COEF(ISUB,6)) MTAU=7 - CALL PYKMAP(1,MTAU,PYR(0)) - -C...2 -> 3, 4 processes: -C...Choose tau' according to h4(tau,tau')/tau', where -C...h4(tau,tau') = c1 + I1/I2*c2*(1 - tau/tau')^3/tau' + -C...I1/I3*c3*1/(1 - tau'), and c1 + c2 + c3 = 1. - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - CALL PYKLIM(4) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RTAUP=PYR(0) - MTAUP=1 - IF(RTAUP.GT.COEF(ISUB,18)) MTAUP=2 - IF(RTAUP.GT.COEF(ISUB,18)+COEF(ISUB,19)) MTAUP=3 - CALL PYKMAP(4,MTAUP,PYR(0)) - ENDIF - -C...Choose y* according to h2(y*), where -C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) + -C...I0/I3*c3*1/cosh(y*) + I0/I4*c4*1/(1-exp(y*-y*max)) + -C...I0/I5*c5*1/(1-exp(-y*-y*min)), I0 = y*max-y*min, -C...and c1 + c2 + c3 + c4 + c5 = 1. - CALL PYKLIM(2) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)) MYST=4 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)+ - & COEF(ISUB,11)) MYST=5 - CALL PYKMAP(2,MYST,PYR(0)) - -C...2 -> 2 processes: -C...Choose cos(theta-hat) (cth) according to h3(cth), where -C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) + -C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2, -C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products), -C...and c0 + c1 + c2 + c3 + c4 = 1. - CALL PYKLIM(3) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - RCTH=PYR(0) - MCTH=1 - IF(RCTH.GT.COEF(ISUB,13)) MCTH=2 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)) MCTH=3 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)) MCTH=4 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)+ - & COEF(ISUB,16)) MCTH=5 - CALL PYKMAP(3,MCTH,PYR(0)) - ENDIF - -C...2 -> 3 : select pT1, phi1, pT2, phi2, y3 for 3 outgoing. - IF(ISTSB.EQ.5) THEN - CALL PYKMAP(5,0,0D0) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - -C...DIS as f + gamma* -> f process: set dummy values. - ELSEIF(ISTSB.EQ.8) THEN - VINT(21)=0.9D0 - VINT(22)=0D0 - VINT(23)=0D0 - VINT(47)=0D0 - VINT(48)=0D0 - -C...Low-pT or multiple interactions (first semihard interaction). - ELSEIF(ISTSB.EQ.9) THEN - CALL PYMULT(3) - ISUB=MINT(1) - -C...Study user-defined process: kinematics plus weight. - ELSEIF(ISTSB.EQ.11) THEN - IF(IDWTUP.GT.0.AND.XWGTUP.LT.0D0) CALL - & PYERRM(26,'(PYRAND:) Negative XWGTUP for user process') - MSTI(51)=0 - IF(NUP.LE.0) THEN - MINT(51)=2 - MSTI(51)=1 - IF(MINT(82).EQ.1) THEN - NGEN(0,1)=NGEN(0,1)-1 - NGEN(ISUB,1)=NGEN(ISUB,1)-1 - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - -C...Extract cross section event weight. - IF(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.4) THEN - SIGS=1D-9*XWGTUP - ELSE - SIGS=1D-9*XSECUP(KFPR(ISUB,1)) - ENDIF - IF(IABS(IDWTUP).GE.1.AND.IABS(IDWTUP).LE.3) THEN - VINT(97)=SIGN(1D0,XWGTUP) - ELSE - VINT(97)=1D-9*XWGTUP - ENDIF - -C...Construct 'trivial' kinematical variables needed. - KFL1=IDUP(1) - KFL2=IDUP(2) - VINT(41)=PUP(4,1)/EBMUP(1) - VINT(42)=PUP(4,2)/EBMUP(2) - VINT(21)=VINT(41)*VINT(42) - VINT(22)=0.5D0*LOG(VINT(41)/VINT(42)) - VINT(44)=VINT(21)*VINT(2) - VINT(43)=SQRT(MAX(0D0,VINT(44))) - VINT(55)=SCALUP - IF(SCALUP.LE.0D0) VINT(55)=VINT(43) - VINT(56)=VINT(55)**2 - VINT(57)=AQEDUP - VINT(58)=AQCDUP - -C...Construct other kinematical variables needed (approximately). - VINT(23)=0D0 - VINT(26)=VINT(21) - VINT(45)=-0.5D0*VINT(44) - VINT(46)=-0.5D0*VINT(44) - VINT(49)=VINT(43) - VINT(50)=VINT(44) - VINT(51)=VINT(55) - VINT(52)=VINT(56) - VINT(53)=VINT(55) - VINT(54)=VINT(56) - VINT(25)=0D0 - VINT(48)=0D0 - IF(ISTUP(1).NE.-1.OR.ISTUP(2).NE.-1) CALL PYERRM(26, - & '(PYRAND:) unacceptable ISTUP code for incoming particles') - DO 280 IUP=3,NUP - IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) CALL PYERRM(26, - & '(PYRAND:) unacceptable ISTUP code for particles') - IF(ISTUP(IUP).EQ.1) VINT(25)=VINT(25)+2D0*(PUP(5,IUP)**2+ - & PUP(1,IUP)**2+PUP(2,IUP)**2)/VINT(2) - IF(ISTUP(IUP).EQ.1) VINT(48)=VINT(48)+0.5D0*(PUP(1,IUP)**2+ - & PUP(2,IUP)**2) - 280 CONTINUE - VINT(47)=SQRT(VINT(48)) - ENDIF - -C...Choose azimuthal angle. - VINT(24)=0D0 - IF(ISTSB.NE.11) VINT(24)=PARU(2)*PYR(0) - -C...Check against user cuts on kinematics at parton level. - MINT(51)=0 - IF((ISUB.LE.90.OR.ISUB.GT.100).AND.ISTSB.LE.10) CALL PYKLIM(0) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - IF(MINT(82).EQ.1.AND.MSTP(141).GE.1.AND.ISTSB.LE.10) THEN - MCUT=0 - IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0) - & CALL PYKCUT(MCUT) - IF(MCUT.NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - -C...Calculate differential cross-section for different subprocesses. - IF(ISTSB.LE.10) CALL PYSIGH(NCHN,SIGS) - SIGSOR=SIGS - SIGLPT=SIGT(0,0,5)*VINT(315)*VINT(316) - -C...Multiply cross section by lepton -> photon flux factor. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN - SIGS=WTGAGA*SIGS - DO 290 ICHN=1,NCHN - SIGH(ICHN)=WTGAGA*SIGH(ICHN) - 290 CONTINUE - SIGLPT=WTGAGA*SIGLPT - ENDIF - -C...Multiply cross-section by user-defined weights. - IF(MSTP(173).EQ.1) THEN - SIGS=PARP(173)*SIGS - DO 300 ICHN=1,NCHN - SIGH(ICHN)=PARP(173)*SIGH(ICHN) - 300 CONTINUE - SIGLPT=PARP(173)*SIGLPT - ENDIF - WTXS=1D0 - SIGSWT=SIGS - VINT(99)=1D0 - VINT(100)=1D0 - IF(MINT(82).EQ.1.AND.MSTP(142).GE.1) THEN - IF(ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+ - & MSUB(95).EQ.0) CALL PYEVWT(WTXS) - SIGSWT=WTXS*SIGS - VINT(99)=WTXS - IF(MSTP(142).EQ.1) VINT(100)=1D0/WTXS - ENDIF - -C...Calculations for Monte Carlo estimate of all cross-sections. - IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN - IF(MSTP(142).LE.1) THEN - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS - ELSE - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGSWT - ENDIF - ELSEIF(MINT(82).EQ.1) THEN - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS - ENDIF - IF((ISUB.EQ.95.OR.ISUB.EQ.96).AND.LOOP2.EQ.1.AND. - &MINT(82).EQ.1) XSEC(97,2)=XSEC(97,2)+SIGLPT - -C...Multiple interactions: store results of cross-section calculation. - IF(MINT(50).EQ.1.AND.MSTP(82).GE.3) THEN - VINT(153)=SIGSOR - CALL PYMULT(4) - ENDIF - -C...Ratio of actual to maximum cross section. - IF(ISTSB.NE.11) THEN - VIOL=SIGSWT/XSEC(ISUB,1) - IF(ISUB.EQ.96.AND.MSTP(173).EQ.1) VIOL=VIOL/PARP(174) - ELSEIF(IDWTUP.EQ.1.OR.IDWTUP.EQ.2) THEN - VIOL=XWGTUP/XMAXUP(KFPR(ISUB,1)) - ELSEIF(IDWTUP.EQ.-1.OR.IDWTUP.EQ.-2) THEN - VIOL=ABS(XWGTUP)/ABS(XMAXUP(KFPR(ISUB,1))) - ELSE - VIOL=1D0 - ENDIF - -C...Check that weight not negative. - IF(MSTP(123).LE.0) THEN - IF(VIOL.LT.-1D-3) THEN - WRITE(MSTU(11),5000) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - STOP - ENDIF - ELSE - IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN - VINT(109)=VIOL - WRITE(MSTU(11),5200) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - ENDIF - ENDIF - -C...Weighting using estimate of maximum of differential cross-section. - IF(MFAIL.EQ.0.AND.ISUB.NE.95.AND.ISUB.NE.96) THEN - IF(VIOL.LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(ISUB.GE.91.AND.ISUB.LE.94) ISUB=0 - GOTO 100 - ENDIF - ELSEIF(MFAIL.EQ.0) THEN - RATND=SIGLPT/XSEC(95,1) - VIOL=VIOL/RATND - IF(LOOP2.EQ.1.AND.RATND.LT.PYR(0)) THEN - IF(VIOL.GT.PYR(0).AND.MINT(82).EQ.1.AND.MSUB(95).EQ.1.AND. - & (ISUB.LE.90.OR.ISUB.GE.95)) NGEN(95,1)=NGEN(95,1)+MINT(143) - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - ISUB=0 - GOTO 100 - ENDIF - IF(VIOL.LT.PYR(0)) THEN - GOTO 140 - ENDIF - ELSEIF(ISUB.NE.95.AND.ISUB.NE.96) THEN - IF(VIOL.LT.PYR(0)) THEN - MSTI(61)=1 - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - ELSE - RATND=SIGLPT/XSEC(95,1) - IF(LOOP.EQ.1.AND.RATND.LT.PYR(0)) THEN - MSTI(61)=1 - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - VIOL=VIOL/RATND - IF(VIOL.LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - GOTO 100 - ENDIF - ENDIF - -C...Check for possible violation of estimated maximum of differential -C...cross-section used in weighting. - IF(MSTP(123).LE.0) THEN - IF(VIOL.GT.1D0) THEN - WRITE(MSTU(11),5300) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - STOP - ENDIF - ELSEIF(MSTP(123).EQ.1) THEN - IF(VIOL.GT.VINT(108)) THEN - VINT(108)=VIOL - IF(VIOL.GT.1.0001D0) THEN - MINT(10)=1 - WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - ENDIF - ENDIF - ELSEIF(VIOL.GT.VINT(108)) THEN - VINT(108)=VIOL - IF(VIOL.GT.1D0) THEN - MINT(10)=1 - WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 - IF(ISTSB.EQ.11.AND.(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.2)) - & THEN - XMAXUP(KFPR(ISUB,1))=VIOL*XMAXUP(KFPR(ISUB,1)) - IF(KFPR(ISUB,1).LE.9) THEN - WRITE(MSTU(11),5800) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ELSEIF(KFPR(ISUB,1).LE.99) THEN - WRITE(MSTU(11),5900) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ELSE - WRITE(MSTU(11),6000) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ENDIF - ENDIF - IF(ISTSB.NE.11.OR.IABS(IDWTUP).EQ.1) THEN - XDIF=XSEC(ISUB,1)*(VIOL-1D0) - XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF - IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) - & XSEC(0,1)=XSEC(0,1)+XDIF - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - IF(ISUB.LE.9) THEN - WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1) - ELSEIF(ISUB.LE.99) THEN - WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1) - ELSE - WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1) - ENDIF - ENDIF - VINT(108)=1D0 - ENDIF - ENDIF - -C...Multiple interactions: choose impact parameter. - VINT(148)=1D0 - IF(MINT(50).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND. - &MSTP(82).GE.3) THEN - CALL PYMULT(5) - IF(VINT(150).LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - IF(MINT(82).EQ.1) NGEN(0,2)=NGEN(0,2)+1 - IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN - IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+MINT(143) - IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1 - ENDIF - IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1 - -C...Choose flavour of reacting partons (and subprocess). - IF(ISTSB.GE.11) GOTO 320 - RSIGS=SIGS*PYR(0) - QT2=VINT(48) - RQQBAR=PARP(87)*(1D0-(QT2/(QT2+(PARP(88)*PARP(82)* - &(VINT(1)/PARP(89))**PARP(90))**2))**2) - IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. - &PYR(0).GT.RQQBAR)) THEN - DO 310 ICHN=1,NCHN - KFL1=ISIG(ICHN,1) - KFL2=ISIG(ICHN,2) - MINT(2)=ISIG(ICHN,3) - RSIGS=RSIGS-SIGH(ICHN) - IF(RSIGS.LE.0D0) GOTO 320 - 310 CONTINUE - -C...Multiple interactions: choose qqbar preferentially at small pT. - ELSEIF(ISUB.EQ.96) THEN - MINT(105)=MINT(103) - MINT(109)=MINT(107) - CALL PYSPLI(MINT(11),21,KFL1,KFLDUM) - MINT(105)=MINT(104) - MINT(109)=MINT(108) - CALL PYSPLI(MINT(12),21,KFL2,KFLDUM) - MINT(1)=11 - MINT(2)=1 - IF(KFL1.EQ.KFL2.AND.PYR(0).LT.0.5D0) MINT(2)=2 - -C...Low-pT: choose string drawing configuration. - ELSE - KFL1=21 - KFL2=21 - RSIGS=6D0*PYR(0) - MINT(2)=1 - IF(RSIGS.GT.1D0) MINT(2)=2 - IF(RSIGS.GT.2D0) MINT(2)=3 - ENDIF - -C...Reassign QCD process. Partons before initial state radiation. - 320 IF(MINT(2).GT.10) THEN - MINT(1)=MINT(2)/10 - MINT(2)=MOD(MINT(2),10) - ENDIF - IF(MINT(82).EQ.1.AND.MSTP(111).GE.0) NGEN(MINT(1),2)= - &NGEN(MINT(1),2)+1 - MINT(15)=KFL1 - MINT(16)=KFL2 - MINT(13)=MINT(15) - MINT(14)=MINT(16) - VINT(141)=VINT(41) - VINT(142)=VINT(42) - VINT(151)=0D0 - VINT(152)=0D0 - -C...Calculate x value of photon for parton inside photon inside e. - DO 350 JT=1,2 - MINT(18+JT)=0 - VINT(154+JT)=0D0 - MSPLI=0 - IF(JT.EQ.1.AND.MINT(43).LE.2) MSPLI=1 - IF(JT.EQ.2.AND.MOD(MINT(43),2).EQ.1) MSPLI=1 - IF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) MSPLI=MSPLI+1 - IF(MSPLI.EQ.2) THEN - KFLH=MINT(14+JT) - XHRD=VINT(140+JT) - Q2HRD=VINT(54) - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(22,XHRD,Q2HRD,XPQ) - ELSE - CALL PYPDFL(22,XHRD,Q2HRD,XPQ) - ENDIF - WTMX=4D0*XPQ(KFLH) - IF(MSTP(13).EQ.2) THEN - Q2PMS=Q2HRD/PMAS(11,1)**2 - WTMX=WTMX*LOG(MAX(2D0,Q2PMS*(1D0-XHRD)/XHRD**2)) - ENDIF - 330 XE=XHRD**PYR(0) - XG=MIN(1D0-1D-10,XHRD/XE) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(22,XG,Q2HRD,XPQ) - ELSE - CALL PYPDFL(22,XG,Q2HRD,XPQ) - ENDIF - WT=(1D0+(1D0-XE)**2)*XPQ(KFLH) - IF(MSTP(13).EQ.2) WT=WT*LOG(MAX(2D0,Q2PMS*(1D0-XE)/XE**2)) - IF(WT.LT.PYR(0)*WTMX) GOTO 330 - MINT(18+JT)=1 - VINT(154+JT)=XE - DO 340 KFLS=-25,25 - XSFX(JT,KFLS)=XPQ(KFLS) - 340 CONTINUE - ENDIF - 350 CONTINUE - -C...Pick scale where photon is resolved. - Q0S=PARP(15)**2 - Q1S=VINT(154)**2 - VINT(283)=0D0 - IF(MINT(107).EQ.3) THEN - IF(MSTP(66).EQ.1) THEN - VINT(283)=Q0S*(VINT(54)/Q0S)**PYR(0) - ELSEIF(MSTP(66).EQ.2) THEN - PS=VINT(3)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - VINT(283)=Q2INT*(VINT(54)/Q2INT)**PYR(0) - ELSEIF(MSTP(66).EQ.3) THEN - VINT(283)=Q0S*(Q1S/Q0S)**PYR(0) - ELSEIF(MSTP(66).GE.4) THEN - PS=0.25D0*VINT(3)**2 - VINT(283)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - ENDIF - ENDIF - VINT(284)=0D0 - IF(MINT(108).EQ.3) THEN - IF(MSTP(66).EQ.1) THEN - VINT(284)=Q0S*(VINT(54)/Q0S)**PYR(0) - ELSEIF(MSTP(66).EQ.2) THEN - PS=VINT(4)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - VINT(284)=Q2INT*(VINT(54)/Q2INT)**PYR(0) - ELSEIF(MSTP(66).EQ.3) THEN - VINT(284)=Q0S*(Q1S/Q0S)**PYR(0) - ELSEIF(MSTP(66).GE.4) THEN - PS=0.25D0*VINT(4)**2 - VINT(284)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - ENDIF - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - -C...Format statements for differential cross-section maximum violations. - 5000 FORMAT(/1X,'Error: negative cross-section fraction',1P,D11.3,1X, - &'in event',1X,I7,'D0'/1X,'Execution stopped!') - 5100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau =',1P, - &D11.3,', y* =',D11.3,', cthe = ',0P,F11.7,', tau'' =',1P,D11.3) - 5200 FORMAT(/1X,'Warning: negative cross-section fraction',1P,D11.3,1X, - &'in event',1X,I7) - 5300 FORMAT(/1X,'Error: maximum violated by',1P,D11.3,1X, - &'in event',1X,I7,'D0'/1X,'Execution stopped!') - 5400 FORMAT(/1X,'Advisory warning: maximum violated by',1P,D11.3,1X, - &'in event',1X,I7) - 5500 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,D11.3) - 5600 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,D11.3) - 5700 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,D11.3) - 5800 FORMAT(1X,'XMAXUP(',I1,') increased to',1P,D11.3) - 5900 FORMAT(1X,'XMAXUP(',I2,') increased to',1P,D11.3) - 6000 FORMAT(1X,'XMAXUP(',I3,') increased to',1P,D11.3) - - RETURN - END - -C*********************************************************************** - -C...PYRECO -C...Handles the possibility of colour reconnection in W+W- events, -C...Based on the main scenarios of the Sjostrand and Khoze study: -C...I, II, II', intermediate and instantaneous; plus one model -C...along the lines of the Gustafson and Hakkinen: GH. -C...Note: also handles Z0 Z0 and W-W+ events, but notation below -C...is as if first resonance is W+ and second W-. - - SUBROUTINE PYRECO(IW1,IW2,NSD1,NAFT1) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter value; number of points in MC integration. - PARAMETER (NPT=100) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION NBEG(2),NEND(2),INP(50),INM(50),BEWW(3),XP(3),XM(3), - &V1(3),V2(3),BETP(50,4),DIRP(50,3),BETM(50,4),DIRM(50,3), - &XD(4),XB(4),IAP(NPT),IAM(NPT),WTA(NPT),V1P(3),V2P(3),V1M(3), - &V2M(3),Q(4,3),XPP(3),XMM(3),IPC(20),IMC(20),TC(0:20),TPC(20), - &TMC(20),IJOIN(100) - -C...Functions to give four-product and to do determinants. - 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) - DETER(I,J,L)=Q(I,1)*Q(J,2)*Q(L,3)-Q(I,1)*Q(L,2)*Q(J,3)+ - &Q(J,1)*Q(L,2)*Q(I,3)-Q(J,1)*Q(I,2)*Q(L,3)+ - &Q(L,1)*Q(I,2)*Q(J,3)-Q(L,1)*Q(J,2)*Q(I,3) - -C...Only allow fraction of recoupling for GH, intermediate and -C...instantaneous. - IF(MSTP(115).EQ.5.OR.MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN - IF(PYR(0).GT.PARP(120)) RETURN - ENDIF - ISUB=MINT(1) - -C...Common part for scenarios I, II, II', and GH. - IF(MSTP(115).EQ.1.OR.MSTP(115).EQ.2.OR.MSTP(115).EQ.3.OR. - &MSTP(115).EQ.5) THEN - -C...Read out frequently-used parameters. - PI=PARU(1) - HBAR=PARU(3) - PMW=PMAS(24,1) - IF(ISUB.EQ.22) PMW=PMAS(23,1) - PGW=PMAS(24,2) - IF(ISUB.EQ.22) PGW=PMAS(23,2) - TFRAG=PARP(115) - RHAD=PARP(116) - FACT=PARP(117) - BLOWR=PARP(118) - BLOWT=PARP(119) - -C...Find range of decay products of the W's. -C...Background: the W's are stored in IW1 and IW2. -C...Their direct decay products in NSD1+1 through NSD1+4. -C...Products after shower (if any) in NSD1+5 through NAFT1 -C...for first W and in NAFT1+1 through N for the second. - IF(NAFT1.GT.NSD1+4) THEN - NBEG(1)=NSD1+5 - NEND(1)=NAFT1 - ELSE - NBEG(1)=NSD1+1 - NEND(1)=NSD1+2 - ENDIF - IF(N.GT.NAFT1) THEN - NBEG(2)=NAFT1+1 - NEND(2)=N - ELSE - NBEG(2)=NSD1+3 - NEND(2)=NSD1+4 - ENDIF - -C...Rearrange parton shower products along strings. - NOLD=N - CALL PYPREP(NSD1+1) - -C...Find partons pointing back to W+ and W-; store them with quark -C...end of string first. - NNP=0 - NNM=0 - ISGP=0 - ISGM=0 - DO 120 I=NOLD+1,N - IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 120 - IF(IABS(K(I,2)).GE.22) GOTO 120 - IF(K(I,3).GE.NBEG(1).AND.K(I,3).LE.NEND(1)) THEN - IF(ISGP.EQ.0) ISGP=ISIGN(1,K(I,2)) - NNP=NNP+1 - IF(ISGP.EQ.1) THEN - INP(NNP)=I - ELSE - DO 100 I1=NNP,2,-1 - INP(I1)=INP(I1-1) - 100 CONTINUE - INP(1)=I - ENDIF - IF(K(I,1).EQ.1) ISGP=0 - ELSEIF(K(I,3).GE.NBEG(2).AND.K(I,3).LE.NEND(2)) THEN - IF(ISGM.EQ.0) ISGM=ISIGN(1,K(I,2)) - NNM=NNM+1 - IF(ISGM.EQ.1) THEN - INM(NNM)=I - ELSE - DO 110 I1=NNM,2,-1 - INM(I1)=INM(I1-1) - 110 CONTINUE - INM(1)=I - ENDIF - IF(K(I,1).EQ.1) ISGM=0 - ENDIF - 120 CONTINUE - -C...Boost to W+W- rest frame (not strictly needed). - DO 130 J=1,3 - BEWW(J)=(P(IW1,J)+P(IW2,J))/(P(IW1,4)+P(IW2,4)) - 130 CONTINUE - CALL PYROBO(IW1,IW1,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - CALL PYROBO(IW2,IW2,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - CALL PYROBO(NOLD+1,N,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - -C...Select decay vertices of W+ and W-. - TP=HBAR*(-LOG(PYR(0)))*P(IW1,4)/ - & SQRT((P(IW1,5)**2-PMW**2)**2+(P(IW1,5)**2*PGW/PMW)**2) - TM=HBAR*(-LOG(PYR(0)))*P(IW2,4)/ - & SQRT((P(IW2,5)**2-PMW**2)**2+(P(IW2,5)**2*PGW/PMW)**2) - GTMAX=MAX(TP,TM) - DO 140 J=1,3 - XP(J)=TP*P(IW1,J)/P(IW1,4) - XM(J)=TM*P(IW2,J)/P(IW2,4) - 140 CONTINUE - -C...Begin scenario I specifics. - IF(MSTP(115).EQ.1) THEN - -C...Reconstruct velocity and direction of W+ string pieces. - DO 170 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 170 - I1=INP(IIP) - I2=INP(IIP+1) - P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) - P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) - DO 150 J=1,3 - V1(J)=P(I1,J)/P1A - V2(J)=P(I2,J)/P2A - BETP(IIP,J)=0.5D0*(V1(J)+V2(J)) - DIRP(IIP,J)=V1(J)-V2(J) - 150 CONTINUE - BETP(IIP,4)=1D0/SQRT(1D0-BETP(IIP,1)**2-BETP(IIP,2)**2- - & BETP(IIP,3)**2) - DIRL=SQRT(DIRP(IIP,1)**2+DIRP(IIP,2)**2+DIRP(IIP,3)**2) - DO 160 J=1,3 - DIRP(IIP,J)=DIRP(IIP,J)/DIRL - 160 CONTINUE - 170 CONTINUE - -C...Reconstruct velocity and direction of W- string pieces. - DO 200 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 200 - I1=INM(IIM) - I2=INM(IIM+1) - P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) - P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) - DO 180 J=1,3 - V1(J)=P(I1,J)/P1A - V2(J)=P(I2,J)/P2A - BETM(IIM,J)=0.5D0*(V1(J)+V2(J)) - DIRM(IIM,J)=V1(J)-V2(J) - 180 CONTINUE - BETM(IIM,4)=1D0/SQRT(1D0-BETM(IIM,1)**2-BETM(IIM,2)**2- - & BETM(IIM,3)**2) - DIRL=SQRT(DIRM(IIM,1)**2+DIRM(IIM,2)**2+DIRM(IIM,3)**2) - DO 190 J=1,3 - DIRM(IIM,J)=DIRM(IIM,J)/DIRL - 190 CONTINUE - 200 CONTINUE - -C...Loop over number of space-time points. - NACC=0 - SUM=0D0 - DO 250 IPT=1,NPT - -C...Pick x,y,z,t Gaussian (width RHAD and TFRAG, respectively). - R=SQRT(-LOG(PYR(0))) - PHI=2D0*PI*PYR(0) - X=BLOWR*RHAD*R*COS(PHI) - Y=BLOWR*RHAD*R*SIN(PHI) - R=SQRT(-LOG(PYR(0))) - PHI=2D0*PI*PYR(0) - Z=BLOWR*RHAD*R*COS(PHI) - T=GTMAX+BLOWT*SQRT(0.5D0)*TFRAG*R*ABS(SIN(PHI)) - -C...Reject impossible points. Weight for sample distribution. - IF(T**2-X**2-Y**2-Z**2.LT.0D0) GOTO 250 - WTSMP=EXP(-(X**2+Y**2+Z**2)/(BLOWR*RHAD)**2)* - & EXP(-2D0*(T-GTMAX)**2/(BLOWT*TFRAG)**2) - -C...Loop over W+ string pieces and find one with largest weight. - IMAXP=0 - WTMAXP=1D-10 - XD(1)=X-XP(1) - XD(2)=Y-XP(2) - XD(3)=Z-XP(3) - XD(4)=T-TP - DO 220 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 220 - BED=BETP(IIP,1)*XD(1)+BETP(IIP,2)*XD(2)+BETP(IIP,3)*XD(3) - BEDG=BETP(IIP,4)*(BETP(IIP,4)*BED/(1D0+BETP(IIP,4))-XD(4)) - DO 210 J=1,3 - XB(J)=XD(J)+BEDG*BETP(IIP,J) - 210 CONTINUE - XB(4)=BETP(IIP,4)*(XD(4)-BED) - SR2=XB(1)**2+XB(2)**2+XB(3)**2 - SZ2=(DIRP(IIP,1)*XB(1)+DIRP(IIP,2)*XB(2)+ - & DIRP(IIP,3)*XB(3))**2 - WTP=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ - & TFRAG**2) - IF(XB(4)-SQRT(SR2).LT.0D0) WTP=0D0 - IF(WTP.GT.WTMAXP) THEN - IMAXP=IIP - WTMAXP=WTP - ENDIF - 220 CONTINUE - -C...Loop over W- string pieces and find one with largest weight. - IMAXM=0 - WTMAXM=1D-10 - XD(1)=X-XM(1) - XD(2)=Y-XM(2) - XD(3)=Z-XM(3) - XD(4)=T-TM - DO 240 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 240 - BED=BETM(IIM,1)*XD(1)+BETM(IIM,2)*XD(2)+BETM(IIM,3)*XD(3) - BEDG=BETM(IIM,4)*(BETM(IIM,4)*BED/(1D0+BETM(IIM,4))-XD(4)) - DO 230 J=1,3 - XB(J)=XD(J)+BEDG*BETM(IIM,J) - 230 CONTINUE - XB(4)=BETM(IIM,4)*(XD(4)-BED) - SR2=XB(1)**2+XB(2)**2+XB(3)**2 - SZ2=(DIRM(IIM,1)*XB(1)+DIRM(IIM,2)*XB(2)+ - & DIRM(IIM,3)*XB(3))**2 - WTM=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ - & TFRAG**2) - IF(XB(4)-SQRT(SR2).LT.0D0) WTM=0D0 - IF(WTM.GT.WTMAXM) THEN - IMAXM=IIM - WTMAXM=WTM - ENDIF - 240 CONTINUE - -C...Result of integration. - WT=0D0 - IF(IMAXP.NE.0.AND.IMAXM.NE.0) THEN - WT=WTMAXP*WTMAXM/WTSMP - SUM=SUM+WT - NACC=NACC+1 - IAP(NACC)=IMAXP - IAM(NACC)=IMAXM - WTA(NACC)=WT - ENDIF - 250 CONTINUE - RES=BLOWR**3*BLOWT*SUM/NPT - -C...Decide whether to reconnect and, if so, where. - IACC=0 - PREC=1D0-EXP(-FACT*RES) - IF(PREC.GT.PYR(0)) THEN - RSUM=PYR(0)*SUM - DO 260 IA=1,NACC - IACC=IA - RSUM=RSUM-WTA(IA) - IF(RSUM.LE.0D0) GOTO 270 - 260 CONTINUE - 270 IIP=IAP(IACC) - IIM=IAM(IACC) - ENDIF - -C...Begin scenario II and II' specifics. - ELSEIF(MSTP(115).EQ.2.OR.MSTP(115).EQ.3) THEN - -C...Loop through all string pieces, one from W+ and one from W-. - NCROSS=0 - TC(0)=0D0 - DO 340 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 340 - I1P=INP(IIP) - I2P=INP(IIP+1) - DO 330 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 330 - I1M=INM(IIM) - I2M=INM(IIM+1) - -C...Find endpoint velocity vectors. - DO 280 J=1,3 - V1P(J)=P(I1P,J)/P(I1P,4) - V2P(J)=P(I2P,J)/P(I2P,4) - V1M(J)=P(I1M,J)/P(I1M,4) - V2M(J)=P(I2M,J)/P(I2M,4) - 280 CONTINUE - -C...Define q matrix and find t. - DO 290 J=1,3 - Q(1,J)=V2P(J)-V1P(J) - Q(2,J)=-(V2M(J)-V1M(J)) - Q(3,J)=XP(J)-XM(J)-TP*V1P(J)+TM*V1M(J) - Q(4,J)=V1P(J)-V1M(J) - 290 CONTINUE - T=-DETER(1,2,3)/DETER(1,2,4) - -C...Find alpha and beta; i.e. coordinates of crossing point. - S11=Q(1,1)*(T-TP) - S12=Q(2,1)*(T-TM) - S13=Q(3,1)+Q(4,1)*T - S21=Q(1,2)*(T-TP) - S22=Q(2,2)*(T-TM) - S23=Q(3,2)+Q(4,2)*T - DEN=S11*S22-S12*S21 - ALP=(S12*S23-S22*S13)/DEN - BET=(S21*S13-S11*S23)/DEN - -C...Check if solution acceptable. - IANSW=1 - IF(T.LT.GTMAX) IANSW=0 - IF(ALP.LT.0D0.OR.ALP.GT.1D0) IANSW=0 - IF(BET.LT.0D0.OR.BET.GT.1D0) IANSW=0 - -C...Find point of crossing and check that not inconsistent. - DO 300 J=1,3 - XPP(J)=XP(J)+(V1P(J)+ALP*(V2P(J)-V1P(J)))*(T-TP) - XMM(J)=XM(J)+(V1M(J)+BET*(V2M(J)-V1M(J)))*(T-TM) - 300 CONTINUE - D2PM=(XPP(1)-XMM(1))**2+(XPP(2)-XMM(2))**2+ - & (XPP(3)-XMM(3))**2 - D2P=XPP(1)**2+XPP(2)**2+XPP(3)**2 - D2M=XMM(1)**2+XMM(2)**2+XMM(3)**2 - IF(D2PM.GT.1D-4*(D2P+D2M)) IANSW=-1 - -C...Find string eigentimes at crossing. - IF(IANSW.EQ.1) THEN - TAUP=SQRT(MAX(0D0,(T-TP)**2-(XPP(1)-XP(1))**2- - & (XPP(2)-XP(2))**2-(XPP(3)-XP(3))**2)) - TAUM=SQRT(MAX(0D0,(T-TM)**2-(XMM(1)-XM(1))**2- - & (XMM(2)-XM(2))**2-(XMM(3)-XM(3))**2)) - ELSE - TAUP=0D0 - TAUM=0D0 - ENDIF - -C...Order crossings by time. End loop over crossings. - IF(IANSW.EQ.1.AND.NCROSS.LT.20) THEN - NCROSS=NCROSS+1 - DO 310 I1=NCROSS,1,-1 - IF(T.GT.TC(I1-1).OR.I1.EQ.1) THEN - IPC(I1)=IIP - IMC(I1)=IIM - TC(I1)=T - TPC(I1)=TAUP - TMC(I1)=TAUM - GOTO 320 - ELSE - IPC(I1)=IPC(I1-1) - IMC(I1)=IMC(I1-1) - TC(I1)=TC(I1-1) - TPC(I1)=TPC(I1-1) - TMC(I1)=TMC(I1-1) - ENDIF - 310 CONTINUE - 320 CONTINUE - ENDIF - 330 CONTINUE - 340 CONTINUE - -C...Loop over crossings; find first (if any) acceptable one. - IACC=0 - IF(NCROSS.GE.1) THEN - DO 350 IC=1,NCROSS - PNFRAG=EXP(-(TPC(IC)**2+TMC(IC)**2)/TFRAG**2) - IF(PNFRAG.GT.PYR(0)) THEN -C...Scenario II: only compare with fragmentation time. - IF(MSTP(115).EQ.2) THEN - IACC=IC - IIP=IPC(IACC) - IIM=IMC(IACC) - GOTO 360 -C...Scenario II': also require that string length decreases. - ELSE - IIP=IPC(IC) - IIM=IMC(IC) - I1P=INP(IIP) - I2P=INP(IIP+1) - I1M=INM(IIM) - I2M=INM(IIM+1) - ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) - ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) - IF(ELNEW.LT.ELOLD) THEN - IACC=IC - IIP=IPC(IACC) - IIM=IMC(IACC) - GOTO 360 - ENDIF - ENDIF - ENDIF - 350 CONTINUE - 360 CONTINUE - ENDIF - -C...Begin scenario GH specifics. - ELSEIF(MSTP(115).EQ.5) THEN - -C...Loop through all string pieces, one from W+ and one from W-. - IACC=0 - ELMIN=1D0 - DO 380 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 380 - I1P=INP(IIP) - I2P=INP(IIP+1) - DO 370 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 370 - I1M=INM(IIM) - I2M=INM(IIM+1) - -C...Look for largest decrease of (exponent of) Lambda measure. - ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) - ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) - ELDIF=ELNEW/MAX(1D-10,ELOLD) - IF(ELDIF.LT.ELMIN) THEN - IACC=IIP+IIM - ELMIN=ELDIF - IPC(1)=IIP - IMC(1)=IIM - ENDIF - 370 CONTINUE - 380 CONTINUE - IIP=IPC(1) - IIM=IMC(1) - ENDIF - -C...Common for scenarios I, II, II' and GH: reconnect strings. - IF(IACC.NE.0) THEN - MINT(32)=1 - NJOIN=0 - DO 390 IS=1,NNP+NNM - NJOIN=NJOIN+1 - IF(IS.LE.IIP) THEN - I=INP(IS) - ELSEIF(IS.LE.IIP+NNM-IIM) THEN - I=INM(IS-IIP+IIM) - ELSEIF(IS.LE.IIP+NNM) THEN - I=INM(IS-IIP-NNM+IIM) - ELSE - I=INP(IS-NNM) - ENDIF - IJOIN(NJOIN)=I - IF(K(I,2).LT.0) THEN - CALL PYJOIN(NJOIN,IJOIN) - NJOIN=0 - ENDIF - 390 CONTINUE - -C...Restore original event record if no reconnection. - ELSE - DO 400 I=NSD1+1,NOLD - IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN - K(I,4)=MOD(K(I,4),MSTU(5)**2) - K(I,5)=MOD(K(I,5),MSTU(5)**2) - ENDIF - 400 CONTINUE - DO 410 I=NOLD+1,N - K(K(I,3),1)=3 - 410 CONTINUE - N=NOLD - ENDIF - -C...Boost back system. - CALL PYROBO(IW1,IW1,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) - CALL PYROBO(IW2,IW2,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) - IF(N.GT.NOLD) CALL PYROBO(NOLD+1,N,0D0,0D0, - & BEWW(1),BEWW(2),BEWW(3)) - -C...Common part for intermediate and instantaneous scenarios. - ELSEIF(MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN - MINT(32)=1 - -C...Remove old shower products and reset showering ones. - N=NSD1+4 - DO 420 I=NSD1+1,NSD1+4 - K(I,1)=3 - K(I,4)=MOD(K(I,4),MSTU(5)**2) - K(I,5)=MOD(K(I,5),MSTU(5)**2) - 420 CONTINUE - -C...Identify quark-antiquark pairs. - IQ1=NSD1+1 - IQ2=NSD1+2 - IQ3=NSD1+3 - IF(K(IQ1,2)*K(IQ3,2).LT.0) IQ3=NSD1+4 - IQ4=2*NSD1+7-IQ3 - -C...Reconnect strings. - IJOIN(1)=IQ1 - IJOIN(2)=IQ4 - CALL PYJOIN(2,IJOIN) - IJOIN(1)=IQ3 - IJOIN(2)=IQ2 - CALL PYJOIN(2,IJOIN) - -C...Do new parton showers in intermediate scenario. - IF(MSTP(71).GE.1.AND.MSTP(115).EQ.11) THEN - MSTJ50=MSTJ(50) - MSTJ(50)=0 - CALL PYSHOW(IQ1,IQ2,P(IW1,5)) - CALL PYSHOW(IQ3,IQ4,P(IW2,5)) - MSTJ(50)=MSTJ50 - -C...Do new parton showers in instantaneous scenario. - ELSEIF(MSTP(71).GE.1.AND.MSTP(115).EQ.12) THEN - PPM2=(P(IQ1,4)+P(IQ4,4))**2-(P(IQ1,1)+P(IQ4,1))**2- - & (P(IQ1,2)+P(IQ4,2))**2-(P(IQ1,3)+P(IQ4,3))**2 - PPM=SQRT(MAX(0D0,PPM2)) - CALL PYSHOW(IQ1,IQ4,PPM) - PPM2=(P(IQ3,4)+P(IQ2,4))**2-(P(IQ3,1)+P(IQ2,1))**2- - & (P(IQ3,2)+P(IQ2,2))**2-(P(IQ3,3)+P(IQ2,3))**2 - PPM=SQRT(MAX(0D0,PPM2)) - CALL PYSHOW(IQ3,IQ2,PPM) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYREMN -C...Adds on target remnants (one or two from each side) and -C...includes primordial kT for hadron beams. - - SUBROUTINE PYREMN(IPU1,IPU2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(0:6),IS(2),ISN(2),ROBO(5), - &PSYS(0:2,5),PMIN(0:2),QOLD(4),QNEW(4),DBE(3),PSUM(4) - -C...Find event type and remaining energy. - ISUB=MINT(1) - NS=N - IF(MINT(50).EQ.0.OR.MSTP(81).LE.0) THEN - VINT(143)=1D0-VINT(141) - VINT(144)=1D0-VINT(142) - ENDIF - -C...Define initial partons. - NTRY=0 - 100 NTRY=NTRY+1 - DO 130 JT=1,2 - I=MINT(83)+JT+2 - IF(JT.EQ.1) IPU=IPU1 - IF(JT.EQ.2) IPU=IPU2 - K(I,1)=21 - K(I,2)=K(IPU,2) - K(I,3)=I-2 - PMS(JT)=0D0 - VINT(156+JT)=0D0 - VINT(158+JT)=0D0 - IF(MINT(47).EQ.1) THEN - DO 110 J=1,5 - P(I,J)=P(I-2,J) - 110 CONTINUE - ELSEIF(ISUB.EQ.95) THEN - K(I,2)=21 - ELSE - P(I,5)=P(IPU,5) - -C...No primordial kT, or chosen according to truncated Gaussian or -C...exponential, or (for photon) predetermined or power law. - 120 IF(MINT(40+JT).EQ.2.AND.MINT(10+JT).NE.22) THEN - IF(MSTP(91).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(91).EQ.1) THEN - PT=PARP(91)*SQRT(-LOG(PYR(0))) - ELSE - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(92)*LOG(RPT1*RPT2) - ENDIF - IF(PT.GT.PARP(93)) GOTO 120 - ELSEIF(MINT(106+JT).EQ.3) THEN - PTA=SQRT(VINT(282+JT)) - PTB=0D0 - IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN - PTB=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PTB=-PARP(99)*LOG(RPT1*RPT2) - ENDIF - IF(PTB.GT.PARP(100)) GOTO 120 - PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) - PT=PT*0.8D0**MINT(57) - IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) - ELSEIF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) THEN - IF(MSTP(93).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(93).EQ.1) THEN - PT=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(99)*LOG(RPT1*RPT2) - ELSEIF(MSTP(93).EQ.3) THEN - HA=PARP(99)**2 - HB=PARP(100)**2 - PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) - ELSE - HA=PARP(99)**2 - HB=PARP(100)**2 - IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) - PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) - ENDIF - IF(PT.GT.PARP(100)) GOTO 120 - ELSE - PT=0D0 - ENDIF - VINT(156+JT)=PT - PHI=PARU(2)*PYR(0) - P(I,1)=PT*COS(PHI) - P(I,2)=PT*SIN(PHI) - PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - ENDIF - 130 CONTINUE - IF(MINT(47).EQ.1) RETURN - -C...Kinematics construction for initial partons. - I1=MINT(83)+3 - I2=MINT(83)+4 - IF(ISUB.EQ.95) THEN - SHS=0D0 - SHR=0D0 - ELSE - SHS=VINT(141)*VINT(142)*VINT(2)+(P(I1,1)+P(I2,1))**2+ - & (P(I1,2)+P(I2,2))**2 - SHR=SQRT(MAX(0D0,SHS)) - IF((SHS-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2).LE.0D0) GOTO 100 - P(I1,4)=0.5D0*(SHR+(PMS(1)-PMS(2))/SHR) - P(I1,3)=SQRT(MAX(0D0,P(I1,4)**2-PMS(1))) - P(I2,4)=SHR-P(I1,4) - P(I2,3)=-P(I1,3) - -C...Transform partons to overall CM-frame. - ROBO(3)=(P(I1,1)+P(I2,1))/SHR - ROBO(4)=(P(I1,2)+P(I2,2))/SHR - CALL PYROBO(I1,I2,0D0,0D0,-ROBO(3),-ROBO(4),0D0) - ROBO(2)=PYANGL(P(I1,1),P(I1,2)) - CALL PYROBO(I1,I2,0D0,-ROBO(2),0D0,0D0,0D0) - ROBO(1)=PYANGL(P(I1,3),P(I1,1)) - CALL PYROBO(I1,I2,-ROBO(1),0D0,0D0,0D0,0D0) - CALL PYROBO(I2+1,MINT(52),0D0,-ROBO(2),0D0,0D0,0D0) - CALL PYROBO(I1,MINT(52),ROBO(1),ROBO(2),ROBO(3),ROBO(4),0D0) - ROBO(5)=(VINT(141)-VINT(142))/(VINT(141)+VINT(142)) - CALL PYROBO(I1,MINT(52),0D0,0D0,0D0,0D0,ROBO(5)) - ENDIF - -C...Optionally fix up x and Q2 definitions for leptoproduction. - IDISXQ=0 - IF((MINT(43).EQ.2.OR.MINT(43).EQ.3).AND.((ISUB.EQ.10.AND. - &MSTP(23).GE.1).OR.(ISUB.EQ.83.AND.MSTP(23).GE.2))) IDISXQ=1 - IF(IDISXQ.EQ.1) THEN - -C...Find where incoming and outgoing leptons/partons are sitting. - LESD=1 - IF(MINT(42).EQ.1) LESD=2 - LPIN=MINT(83)+3-LESD - LEIN=MINT(84)+LESD - LQIN=MINT(84)+3-LESD - LEOUT=MINT(84)+2+LESD - LQOUT=MINT(84)+5-LESD - IF(K(LEIN,3).GT.LEIN) LEIN=K(LEIN,3) - IF(K(LQIN,3).GT.LQIN) LQIN=K(LQIN,3) - LSCMS=0 - DO 140 I=MINT(84)+5,N - IF(K(I,2).EQ.94) THEN - LSCMS=I - LEOUT=I+LESD - LQOUT=I+3-LESD - ENDIF - 140 CONTINUE - LQBG=IPU1 - IF(LESD.EQ.1) LQBG=IPU2 - -C...Calculate actual and wanted momentum transfer. - XNOM=VINT(43-LESD) - Q2NOM=-VINT(45) - HPK=2D0*(P(LPIN,4)*P(LEIN,4)-P(LPIN,1)*P(LEIN,1)- - & P(LPIN,2)*P(LEIN,2)-P(LPIN,3)*P(LEIN,3))* - & (P(MINT(83)+LESD,4)*VINT(40+LESD)/P(LEIN,4)) - HPT2=MAX(0D0,Q2NOM*(1D0-Q2NOM/(XNOM*HPK))) - FAC=SQRT(HPT2/(P(LEOUT,1)**2+P(LEOUT,2)**2)) - P(N+1,1)=FAC*P(LEOUT,1) - P(N+1,2)=FAC*P(LEOUT,2) - P(N+1,3)=0.25D0*((HPK-Q2NOM/XNOM)/P(LPIN,4)- - & Q2NOM/(P(MINT(83)+LESD,4)*VINT(40+LESD)))*(-1)**(LESD+1) - P(N+1,4)=SQRT(P(LEOUT,5)**2+P(N+1,1)**2+P(N+1,2)**2+ - & P(N+1,3)**2) - DO 150 J=1,4 - QOLD(J)=P(LEIN,J)-P(LEOUT,J) - QNEW(J)=P(LEIN,J)-P(N+1,J) - 150 CONTINUE - -C...Boost outgoing electron and daughters. - IF(LSCMS.EQ.0) THEN - DO 160 J=1,4 - P(LEOUT,J)=P(N+1,J) - 160 CONTINUE - ELSE - DO 170 J=1,3 - P(N+2,J)=(P(N+1,J)-P(LEOUT,J))/(P(N+1,4)+P(LEOUT,4)) - 170 CONTINUE - PINV=2D0/(1D0+P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2) - DO 180 J=1,3 - DBE(J)=PINV*P(N+2,J) - 180 CONTINUE - DO 200 I=LSCMS+1,N - IORIG=I - 190 IORIG=K(IORIG,3) - IF(IORIG.GT.LEOUT) GOTO 190 - IF(I.EQ.LEOUT.OR.IORIG.EQ.LEOUT) - & CALL PYROBO(I,I,0D0,0D0,DBE(1),DBE(2),DBE(3)) - 200 CONTINUE - ENDIF - -C...Copy shower initiator and all outgoing partons. - NCOP=N+1 - K(NCOP,3)=LQBG - DO 210 J=1,5 - P(NCOP,J)=P(LQBG,J) - 210 CONTINUE - DO 240 I=MINT(84)+1,N - ICOP=0 - IF(K(I,1).GT.10) GOTO 240 - IF(I.EQ.LQBG.OR.I.EQ.LQOUT) THEN - ICOP=I - ELSE - IORIG=I - 220 IORIG=K(IORIG,3) - IF(IORIG.EQ.LQBG.OR.IORIG.EQ.LQOUT) THEN - ICOP=IORIG - ELSEIF(IORIG.GT.MINT(84).AND.IORIG.LE.N) THEN - GOTO 220 - ENDIF - ENDIF - IF(ICOP.NE.0) THEN - NCOP=NCOP+1 - K(NCOP,3)=I - DO 230 J=1,5 - P(NCOP,J)=P(I,J) - 230 CONTINUE - ENDIF - 240 CONTINUE - -C...Calculate relative rescaling factors. - SLC=3-2*LESD - PLCSUM=0D0 - DO 250 I=N+2,NCOP - PLCSUM=PLCSUM+(P(I,4)+SLC*P(I,3)) - 250 CONTINUE - DO 260 I=N+2,NCOP - V(I,1)=(P(I,4)+SLC*P(I,3))/PLCSUM - 260 CONTINUE - -C...Transfer extra three-momentum of current. - DO 280 I=N+2,NCOP - DO 270 J=1,3 - P(I,J)=P(I,J)+V(I,1)*(QNEW(J)-QOLD(J)) - 270 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 280 CONTINUE - -C...Iterate change of initiator momentum to get energy right. - ITER=0 - 290 ITER=ITER+1 - PEEX=-P(N+1,4)-QNEW(4) - PEMV=-P(N+1,3)/P(N+1,4) - DO 300 I=N+2,NCOP - PEEX=PEEX+P(I,4) - PEMV=PEMV+V(I,1)*P(I,3)/P(I,4) - 300 CONTINUE - IF(ABS(PEMV).LT.1D-10) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - PZCH=-PEEX/PEMV - P(N+1,3)=P(N+1,3)+PZCH - P(N+1,4)=SQRT(P(N+1,5)**2+P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) - DO 310 I=N+2,NCOP - P(I,3)=P(I,3)+V(I,1)*PZCH - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 310 CONTINUE - IF(ITER.LT.10.AND.ABS(PEEX).GT.1D-6*P(N+1,4)) GOTO 290 - -C...Modify momenta in event record. - HBE=2D0*(P(N+1,4)+P(LQBG,4))*(P(N+1,3)-P(LQBG,3))/ - & ((P(N+1,4)+P(LQBG,4))**2+(P(N+1,3)-P(LQBG,3))**2) - IF(ABS(HBE).GE.1D0) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - I=MINT(83)+5-LESD - CALL PYROBO(I,I,0D0,0D0,0D0,0D0,HBE) - DO 330 I=N+1,NCOP - ICOP=K(I,3) - DO 320 J=1,4 - P(ICOP,J)=P(I,J) - 320 CONTINUE - 330 CONTINUE - ENDIF - -C...Check minimum invariant mass of remnant system(s). - PSYS(0,4)=P(I1,4)+P(I2,4)+0.5D0*VINT(1)*(VINT(151)+VINT(152)) - PSYS(0,3)=P(I1,3)+P(I2,3)+0.5D0*VINT(1)*(VINT(151)-VINT(152)) - PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) - PMIN(0)=SQRT(PMS(0)) - DO 340 JT=1,2 - PSYS(JT,4)=0.5D0*VINT(1)*VINT(142+JT) - PSYS(JT,3)=PSYS(JT,4)*(-1)**(JT-1) - PMIN(JT)=0D0 - IF(MINT(44+JT).EQ.1) GOTO 340 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) - IF(MINT(51).NE.0) THEN - MINT(57)=MINT(57)+1 - RETURN - ENDIF - IF(KFLCH(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLCH(JT)) - IF(KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLSP(JT)) - IF(KFLCH(JT)*KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+0.5D0*PARP(111) - PMIN(JT)=SQRT(PMIN(JT)**2+P(MINT(83)+JT+2,1)**2+ - & P(MINT(83)+JT+2,2)**2) - 340 CONTINUE - IF(PMIN(0)+PMIN(1)+PMIN(2).GT.VINT(1).OR.(MINT(45).GE.2.AND. - &PMIN(1).GT.PSYS(1,4)).OR.(MINT(46).GE.2.AND.PMIN(2).GT. - &PSYS(2,4))) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - -C...Loop over two remnants; skip if none there. - I=NS - DO 410 JT=1,2 - ISN(JT)=0 - IF(MINT(44+JT).EQ.1) GOTO 410 - IF(JT.EQ.1) IPU=IPU1 - IF(JT.EQ.2) IPU=IPU2 - -C...Store first remnant parton. - I=I+1 - IS(JT)=I - ISN(JT)=1 - DO 350 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 350 CONTINUE - K(I,1)=1 - K(I,2)=KFLSP(JT) - K(I,3)=MINT(83)+JT - P(I,5)=PYMASS(K(I,2)) - -C...First parton colour connections and kinematics. - KCOL=KCHG(PYCOMP(KFLSP(JT)),2) - IF(KCOL.EQ.2) THEN - K(I,1)=3 - K(I,4)=MSTU(5)*IPU+IPU - K(I,5)=MSTU(5)*IPU+IPU - K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I - K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I - ELSEIF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLSP(JT)))/2 - K(I,KFLS+3)=IPU - K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I - ENDIF - IF(KFLCH(JT).EQ.0) THEN - P(I,1)=-P(MINT(83)+JT+2,1) - P(I,2)=-P(MINT(83)+JT+2,2) - PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) - P(I,3)=PSYS(JT,3) - P(I,4)=PSYS(JT,4) - -C...When extra remnant parton or hadron: store extra remnant. - ELSE - I=I+1 - ISN(JT)=2 - DO 360 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 360 CONTINUE - K(I,1)=1 - K(I,2)=KFLCH(JT) - K(I,3)=MINT(83)+JT - P(I,5)=PYMASS(K(I,2)) - -C...Find parton colour connections of extra remnant. - KCOL=KCHG(PYCOMP(KFLCH(JT)),2) - IF(KCOL.EQ.2) THEN - K(I,1)=3 - K(I,4)=MSTU(5)*IPU+IPU - K(I,5)=MSTU(5)*IPU+IPU - K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I - K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I - ELSEIF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLCH(JT)))/2 - K(I,KFLS+3)=IPU - K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I - ENDIF - -C...Relative transverse momentum when two remnants. - LOOP=0 - 370 LOOP=LOOP+1 - CALL PYPTDI(1,P(I-1,1),P(I-1,2)) - IF(IABS(MINT(10+JT)).LT.20) THEN - P(I-1,1)=0D0 - P(I-1,2)=0D0 - ELSE - P(I-1,1)=P(I-1,1)-0.5D0*P(MINT(83)+JT+2,1) - P(I-1,2)=P(I-1,2)-0.5D0*P(MINT(83)+JT+2,2) - ENDIF - PMS(JT+2)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 - P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) - P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) - PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - -C...Meson or baryon; photon as meson. For splitup below. - IMB=1 - IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 - -C***Relative distribution for electron into two electrons. Temporary! - IF(IABS(MINT(10+JT)).LT.20.AND.MINT(14+JT).EQ.-MINT(10+JT)) - & THEN - CHI(JT)=PYR(0) - -C...Relative distribution of electron energy into electron plus parton. - ELSEIF(IABS(MINT(10+JT)).LT.20) THEN - XHRD=VINT(140+JT) - XE=VINT(154+JT) - CHI(JT)=(XE-XHRD)/(1D0-XHRD) - -C...Relative distribution of energy for particle into two jets. - ELSEIF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN - CHIK=PARP(92+2*IMB) - IF(MSTP(92).LE.1) THEN - IF(IMB.EQ.1) CHI(JT)=PYR(0) - IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) - ELSEIF(MSTP(92).EQ.2) THEN - CHI(JT)=1D0-PYR(0)**(1D0/(1D0+CHIK)) - ELSEIF(MSTP(92).EQ.3) THEN - CUT=2D0*0.3D0/VINT(1) - 380 CHI(JT)=PYR(0)**2 - IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25D0* - & (1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 380 - ELSEIF(MSTP(92).EQ.4) THEN - CUT=2D0*0.3D0/VINT(1) - CUTR=(1D0+SQRT(1D0+CUT**2))/CUT - 390 CHIR=CUT*CUTR**PYR(0) - CHI(JT)=(CHIR**2-CUT**2)/(2D0*CHIR) - IF((1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 390 - ELSE - CUT=2D0*0.3D0/VINT(1) - CUTA=CUT**(1D0-PARP(98)) - CUTB=(1D0+CUT)**(1D0-PARP(98)) - 400 CHI(JT)=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) - IF(((CHI(JT)+CUT)**2/(2D0*(CHI(JT)**2+CUT**2)))** - & (0.5D0*PARP(98))*(1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 400 - ENDIF - -C...Relative distribution of energy for particle into jet plus particle. - ELSE - IF(MSTP(94).LE.1) THEN - IF(IMB.EQ.1) CHI(JT)=PYR(0) - IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) - IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) - ELSEIF(MSTP(94).EQ.2) THEN - CHI(JT)=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) - IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) - ELSEIF(MSTP(94).EQ.3) THEN - CALL PYZDIS(1,0,PMS(JT+4),ZZ) - CHI(JT)=ZZ - ELSE - CALL PYZDIS(1000,0,PMS(JT+4),ZZ) - CHI(JT)=ZZ - ENDIF - ENDIF - -C...Construct total transverse mass; reject if too large. - CHI(JT)=MAX(1D-8,MIN(1D0-1D-8,CHI(JT))) - PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1D0-CHI(JT)) - IF(PMS(JT).GT.PSYS(JT,4)**2) THEN - IF(LOOP.LT.100) THEN - GOTO 370 - ELSE - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - ENDIF - PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) - VINT(158+JT)=CHI(JT) - -C...Subdivide longitudinal momentum according to value selected above. - PW1=CHI(JT)*(PSYS(JT,4)+ABS(PSYS(JT,3))) - P(IS(JT)+1,4)=0.5D0*(PW1+PMS(JT+4)/PW1) - P(IS(JT)+1,3)=0.5D0*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) - P(IS(JT),4)=PSYS(JT,4)-P(IS(JT)+1,4) - P(IS(JT),3)=PSYS(JT,3)-P(IS(JT)+1,3) - ENDIF - 410 CONTINUE - N=I - -C...Check if longitudinal boosts needed - if so pick two systems. - PDEV=ABS(PSYS(0,4)+PSYS(1,4)+PSYS(2,4)-VINT(1))+ - &ABS(PSYS(0,3)+PSYS(1,3)+PSYS(2,3)) - IF(PDEV.LE.1D-6*VINT(1)) RETURN - IF(ISN(1).EQ.0) THEN - IR=0 - IL=2 - ELSEIF(ISN(2).EQ.0) THEN - IR=1 - IL=0 - ELSEIF(VINT(143).GT.0.2D0.AND.VINT(144).GT.0.2D0) THEN - IR=1 - IL=2 - ELSEIF(VINT(143).GT.0.2D0) THEN - IR=1 - IL=0 - ELSEIF(VINT(144).GT.0.2D0) THEN - IR=0 - IL=2 - ELSEIF(PMS(1)/PSYS(1,4)**2.GT.PMS(2)/PSYS(2,4)**2) THEN - IR=1 - IL=0 - ELSE - IR=0 - IL=2 - ENDIF - IG=3-IR-IL - -C...E+-pL wanted for system to be modified. - IF((IG.EQ.1.AND.ISN(1).EQ.0).OR.(IG.EQ.2.AND.ISN(2).EQ.0)) THEN - PPB=VINT(1) - PNB=VINT(1) - ELSE - PPB=VINT(1)-(PSYS(IG,4)+PSYS(IG,3)) - PNB=VINT(1)-(PSYS(IG,4)-PSYS(IG,3)) - ENDIF - -C...To keep x and Q2 in leptoproduction: do not count scattered lepton. - IF(IDISXQ.EQ.1.AND.IG.NE.0) THEN - PPB=PPB-(PSYS(0,4)+PSYS(0,3)) - PNB=PNB-(PSYS(0,4)-PSYS(0,3)) - DO 420 J=1,4 - PSYS(0,J)=0D0 - 420 CONTINUE - DO 450 I=MINT(84)+1,NS - IF(K(I,1).GT.10) GOTO 450 - INCL=0 - IORIG=I - 430 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 430 - IF(INCL.EQ.0) GOTO 450 - DO 440 J=1,4 - PSYS(0,J)=PSYS(0,J)+P(I,J) - 440 CONTINUE - 450 CONTINUE - PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) - PPB=PPB+(PSYS(0,4)+PSYS(0,3)) - PNB=PNB+(PSYS(0,4)-PSYS(0,3)) - ENDIF - -C...Construct longitudinal boosts. - DPMTB=PPB*PNB - DPMTR=PMS(IR) - DPMTL=PMS(IL) - DSQLAM=SQRT(MAX(0D0,(DPMTB-DPMTR-DPMTL)**2-4D0*DPMTR*DPMTL)) - IF(DSQLAM.LE.1D-6*DPMTB) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - DSQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) - DRKR=(DPMTB+DPMTR-DPMTL+DSQLAM*DSQSGN)/ - &(2D0*(PSYS(IR,4)+PSYS(IR,3))*PNB) - DRKL=(DPMTB+DPMTL-DPMTR+DSQLAM*DSQSGN)/ - &(2D0*(PSYS(IL,4)-PSYS(IL,3))*PPB) - DBER=(DRKR**2-1D0)/(DRKR**2+1D0) - DBEL=-(DRKL**2-1D0)/(DRKL**2+1D0) - -C...Perform longitudinal boosts. - IF(IR.EQ.1.AND.ISN(1).EQ.1.AND.DBER.LE.-0.99999999D0) THEN - P(IS(1),3)=0D0 - P(IS(1),4)=SQRT(P(IS(1),5)**2+P(IS(1),1)**2+P(IS(1),2)**2) - ELSEIF(IR.EQ.1) THEN - CALL PYROBO(IS(1),IS(1)+ISN(1)-1,0D0,0D0,0D0,0D0,DBER) - ELSEIF(IDISXQ.EQ.1) THEN - DO 470 I=I1,NS - INCL=0 - IORIG=I - 460 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 460 - IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBER) - 470 CONTINUE - ELSE - CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBER) - ENDIF - IF(IL.EQ.2.AND.ISN(2).EQ.1.AND.DBEL.GE.0.99999999D0) THEN - P(IS(2),3)=0D0 - P(IS(2),4)=SQRT(P(IS(2),5)**2+P(IS(2),1)**2+P(IS(2),2)**2) - ELSEIF(IL.EQ.2) THEN - CALL PYROBO(IS(2),IS(2)+ISN(2)-1,0D0,0D0,0D0,0D0,DBEL) - ELSEIF(IDISXQ.EQ.1) THEN - DO 490 I=I1,NS - INCL=0 - IORIG=I - 480 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 480 - IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBEL) - 490 CONTINUE - ELSE - CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBEL) - ENDIF - -C...Final check that energy-momentum conservation worked. - PESUM=0D0 - PZSUM=0D0 - DO 500 I=MINT(84)+1,N - IF(K(I,1).GT.10) GOTO 500 - PESUM=PESUM+P(I,4) - PZSUM=PZSUM+P(I,3) - 500 CONTINUE - PDEV=ABS(PESUM-VINT(1))+ABS(PZSUM) - IF(PDEV.GT.1D-4*VINT(1)) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - -C...Calculate rotation and boost from overall CM frame to -C...hadronic CM frame in leptoproduction. - MINT(91)=0 - IF(MINT(82).EQ.1.AND.(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN - MINT(91)=1 - LESD=1 - IF(MINT(42).EQ.1) LESD=2 - LPIN=MINT(83)+3-LESD - -C...Sum upp momenta of everything not lepton or photon to define boost. - DO 510 J=1,4 - PSUM(J)=0D0 - 510 CONTINUE - DO 530 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 530 - IF(IABS(K(I,2)).GE.11.AND.IABS(K(I,2)).LE.20) GOTO 530 - IF(K(I,2).EQ.22) GOTO 530 - DO 520 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 520 CONTINUE - 530 CONTINUE - VINT(223)=-PSUM(1)/PSUM(4) - VINT(224)=-PSUM(2)/PSUM(4) - VINT(225)=-PSUM(3)/PSUM(4) - -C...Boost incoming hadron to hadronic CM frame to determine rotations. - K(N+1,1)=1 - DO 540 J=1,5 - P(N+1,J)=P(LPIN,J) - V(N+1,J)=V(LPIN,J) - 540 CONTINUE - CALL PYROBO(N+1,N+1,0D0,0D0,VINT(223),VINT(224),VINT(225)) - VINT(222)=-PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+1,0D0,VINT(222),0D0,0D0,0D0) - IF(LESD.EQ.2) THEN - VINT(221)=-PYANGL(P(N+1,3),P(N+1,1)) - ELSE - VINT(221)=PYANGL(-P(N+1,3),P(N+1,1)) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRESD -C...Allows resonances to decay (including parton showers for hadronic -C...channels). - - SUBROUTINE PYRESD(IRES) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT4/ -C...Local arrays and complex and character variables. - DIMENSION IREF(50,8),KDCY(3),KFL1(3),KFL2(3),KFL3(3),KEQL(3), - &KCQM(3),KCQ1(3),KCQ2(3),KCQ3(3),NSD(3),PMMN(3),ILIN(6), - &HGZ(3,3),COUP(6,4),CORL(2,2,2),PK(6,4),PKK(6,6),CTHE(3), - &PHI(3),WDTP(0:400),WDTE(0:400,0:5),DPMO(5),XM(5),VDCY(4), - &ITJUNC(3),CTM2(3) - COMPLEX FGK,HA(6,6),HC(6,6) - REAL TIR,UIR - CHARACTER CODE*9,MASS*9 - -C...The F, Xi and Xj functions of Gunion and Kunszt -C...(Phys. Rev. D33, 665, plus errata from the authors). - FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)* - &HC(I1,I4)+HA(I3,I5)*HC(I3,I4)) - DIGK(DT,DU)=-4D0*D34*D56+DT*(3D0*DT+4D0*DU)+DT**2*(DT*DU/ - &(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+2D0*(D34/D56+D56/D34)) - DJGK(DT,DU)=8D0*(D34+D56)**2-8D0*(D34+D56)*(DT+DU)-6D0*DT*DU- - &2D0*DT*DU*(DT*DU/(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+ - &2D0*(D34/D56+D56/D34)) - -C...Some general constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - SQMZ=PMAS(23,1)**2 - - GMMZ=PMAS(23,1)*PMAS(23,2) - SQMW=PMAS(24,1)**2 - GMMW=PMAS(24,1)*PMAS(24,2) - SH=VINT(44) - -C...Boost and rotate to rest frame of incoming partons, -C...to get proper amount of smearing of decay angles. - IBST=0 - IF(IRES.EQ.0) THEN - IBST=1 - ETOTIN=P(MINT(84)+1,4)+P(MINT(84)+2,4) - BEXIN=(P(MINT(84)+1,1)+P(MINT(84)+2,1))/ETOTIN - BEYIN=(P(MINT(84)+1,2)+P(MINT(84)+2,2))/ETOTIN - BEZIN=(P(MINT(84)+1,3)+P(MINT(84)+2,3))/ETOTIN - CALL PYROBO(MINT(83)+7,N,0D0,0D0,-BEXIN,-BEYIN,-BEZIN) - PHIIN=PYANGL(P(MINT(84)+1,1),P(MINT(84)+1,2)) - CALL PYROBO(MINT(83)+7,N,0D0,-PHIIN,0D0,0D0,0D0) - THEIN=PYANGL(P(MINT(84)+1,3),P(MINT(84)+1,1)) - CALL PYROBO(MINT(83)+7,N,-THEIN,0D0,0D0,0D0,0D0) - ENDIF - -C...Reset original resonance configuration. - DO 100 JT=1,8 - IREF(1,JT)=0 - 100 CONTINUE - -C...Define initial one, two or three objects for subprocess. - IHDEC=0 - IF(IRES.EQ.0) THEN - ISUB=MINT(1) - IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN - IREF(1,1)=MINT(84)+2+ISET(ISUB) - IREF(1,4)=MINT(83)+6+ISET(ISUB) - JTMAX=1 - ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN - IREF(1,1)=MINT(84)+1+ISET(ISUB) - IREF(1,2)=MINT(84)+2+ISET(ISUB) - IREF(1,4)=MINT(83)+5+ISET(ISUB) - IREF(1,5)=MINT(83)+6+ISET(ISUB) - JTMAX=2 - ELSEIF(ISET(ISUB).EQ.5) THEN - IREF(1,1)=MINT(84)+3 - IREF(1,2)=MINT(84)+4 - IREF(1,3)=MINT(84)+5 - IREF(1,4)=MINT(83)+7 - IREF(1,5)=MINT(83)+8 - IREF(1,6)=MINT(83)+9 - JTMAX=3 - ENDIF - -C...Define original resonance for odd cases. - ELSE - ISUB=0 - IF(K(IRES,2).EQ.25.OR.K(IRES,2).EQ.35.OR.K(IRES,2).EQ.36) - & IHDEC=1 - IF(IHDEC.EQ.1) ISUB=3 - IREF(1,1)=IRES - IREF(1,4)=K(IRES,3) - IRESTM=IRES - IF(IREF(1,4).GT.MINT(84)) THEN - 103 ITMPMO=IREF(1,4) - IF(K(ITMPMO,2).EQ.94) THEN - IREF(1,4)=K(ITMPMO,3)+(IRESTM-ITMPMO-1) - IF(K(IREF(1,4),3).LE.MINT(84)) IREF(1,4)=K(IREF(1,4),3) - ELSEIF(K(ITMPMO,2).EQ.K(IRES,2)) THEN - IRESTM=ITMPMO - IREF(1,4)=K(ITMPMO,3) - GOTO 103 - ENDIF - ENDIF - IF(IREF(1,4).GT.MINT(84)) THEN - EMATCH=1D10 - IREF14=IREF(1,4) - DO 106 II=MINT(83)+7,MINT(83)+MINT(4) - IF(K(II,2).EQ.K(IRES,2).AND.ABS(P(II,4)-P(IREF14,4)).LT. - & EMATCH) THEN - IREF(1,4)=II - EMATCH=ABS(P(II,4)-P(IREF14,4)) - ENDIF - 106 CONTINUE - ENDIF - JTMAX=1 - ENDIF - -C...Check if initial resonance has been moved (in resonance + jet). - DO 120 JT=1,3 - IF(IREF(1,JT).GT.0) THEN - IF(K(IREF(1,JT),1).GT.10) THEN - KFA=IABS(K(IREF(1,JT),2)) - IF(KFA.GE.6.AND.KCHG(PYCOMP(KFA),2).NE.0) THEN - KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) - KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) - DO 110 I=IREF(1,JT)+1,N - IF(K(I,2).EQ.K(IREF(1,JT),2).AND.(I.EQ.KDA1.OR. - & I.EQ.KDA2)) THEN - IREF(1,JT)=I - KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) - KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) - ENDIF - 110 CONTINUE - ELSE - KDA=MOD(K(IREF(1,JT),4),MSTU(5)) - IF(MWID(PYCOMP(KFA)).NE.0.AND.KDA.GT.1) IREF(1,JT)=KDA - ENDIF - ENDIF - ENDIF - 120 CONTINUE - -C.....Set decay vertex for initial resonances - DO 140 JT=1,JTMAX - DO 130 I=1,4 - V(IREF(1,JT),I)=0D0 - 130 CONTINUE - 140 CONTINUE - -C...Loop over decay history. - NP=1 - IP=0 - 150 IP=IP+1 - NINH=0 - JTMAX=2 - IF(IREF(IP,2).EQ.0) JTMAX=1 - IF(IREF(IP,3).NE.0) JTMAX=3 - IT4=0 - NSAV=N - -C...Check for Higgs which appears as decay product of user-process. - IF(ISUB.EQ.0) THEN - IHDEC=0 - IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) - & .EQ.36) IHDEC=1 - IF(IHDEC.EQ.1) ISUB=3 - ENDIF - -C...Start treatment of one, two or three resonances in parallel. - 160 N=NSAV - DO 320 JT=1,JTMAX - ID=IREF(IP,JT) - KDCY(JT)=0 - KFL1(JT)=0 - KFL2(JT)=0 - KFL3(JT)=0 - KEQL(JT)=0 - NSD(JT)=ID - ITJUNC(JT)=0 - -C...Check whether particle can/is allowed to decay. - IF(ID.EQ.0) GOTO 310 - KFA=IABS(K(ID,2)) - KCA=PYCOMP(KFA) - IF(MWID(KCA).EQ.0) GOTO 310 - IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 310 - IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. - & KFA.EQ.18) IT4=IT4+1 - K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5)) - K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5)) - -C...Choose lifetime and determine decay vertex. - IF(K(ID,1).EQ.5) THEN - V(ID,5)=0D0 - ELSEIF(K(ID,1).NE.4) THEN - V(ID,5)=-PMAS(KCA,4)*LOG(PYR(0)) - ENDIF - DO 170 J=1,4 - VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) - 170 CONTINUE - -C...Determine whether decay allowed or not. - MOUT=0 - IF(MSTJ(22).EQ.2) THEN - IF(PMAS(KCA,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(ID,1).NE.5) THEN - K(ID,1)=4 - GOTO 310 - ENDIF - -C...Info for selection of decay channel: sign, pairings. - IF(KCHG(KCA,3).EQ.0) THEN - IPM=2 - ELSE - IPM=(5-ISIGN(1,K(ID,2)))/2 - ENDIF - KFB=0 - IF(JTMAX.EQ.2) THEN - KFB=IABS(K(IREF(IP,3-JT),2)) - ELSEIF(JTMAX.EQ.3) THEN - JT2=JT+1-3*(JT/3) - KFB=IABS(K(IREF(IP,JT2),2)) - IF(KFB.NE.KFA) THEN - JT2=JT+2-3*((JT+1)/3) - KFB=IABS(K(IREF(IP,JT2),2)) - ENDIF - ENDIF - -C...Select decay channel. - IF(ISUB.EQ.1.OR.ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR. - & ISUB.EQ.30.OR.ISUB.EQ.35.OR.ISUB.EQ.141) MINT(61)=1 - CALL PYWIDT(KFA,P(ID,5)**2,WDTP,WDTE) - WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) - IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5) - IF(WDTE0S.LE.0D0) GOTO 310 - RKFL=WDTE0S*PYR(0) - IDL=0 - 180 IDL=IDL+1 - IDC=IDL+MDCY(KCA,2)-1 - RKFL=RKFL-(WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4)) - IF(KFB.EQ.KFA) RKFL=RKFL-WDTE(IDL,5) - IF(IDL.LT.MDCY(KCA,3).AND.RKFL.GT.0D0) GOTO 180 - -C...Read out flavours and colour charges of decay channel chosen. - KCQM(JT)=KCHG(KCA,2)*ISIGN(1,K(ID,2)) - IF(KCQM(JT).EQ.-2) KCQM(JT)=2 - KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2)) - KFC1A=PYCOMP(IABS(KFL1(JT))) - IF(KCHG(KFC1A,3).EQ.0) KFL1(JT)=IABS(KFL1(JT)) - KCQ1(JT)=KCHG(KFC1A,2)*ISIGN(1,KFL1(JT)) - IF(KCQ1(JT).EQ.-2) KCQ1(JT)=2 - KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2)) - KFC2A=PYCOMP(IABS(KFL2(JT))) - IF(KCHG(KFC2A,3).EQ.0) KFL2(JT)=IABS(KFL2(JT)) - KCQ2(JT)=KCHG(KFC2A,2)*ISIGN(1,KFL2(JT)) - IF(KCQ2(JT).EQ.-2) KCQ2(JT)=2 - KFL3(JT)=KFDP(IDC,3)*ISIGN(1,K(ID,2)) - KCQ3(JT)=0 - IF(KFL3(JT).NE.0) THEN - KFC3A=PYCOMP(IABS(KFL3(JT))) - IF(KCHG(KFC3A,3).EQ.0) KFL3(JT)=IABS(KFL3(JT)) - KCQ3(JT)=KCHG(KFC3A,2)*ISIGN(1,KFL3(JT)) - IF(KCQ3(JT).EQ.-2) KCQ3(JT)=2 - ENDIF - -C...Set/save further info on channel. - KDCY(JT)=1 - IF(KFB.EQ.KFA) KEQL(JT)=MDME(IDC,1) - NSD(JT)=N - HGZ(JT,1)=VINT(111) - HGZ(JT,2)=VINT(112) - HGZ(JT,3)=VINT(114) - JTZ=JT - -C...Select masses; to begin with assume resonances narrow. - DO 200 I=1,3 - P(N+I,5)=0D0 - PMMN(I)=0D0 - IF(I.EQ.1) THEN - KFLW=IABS(KFL1(JT)) - KCW=KFC1A - ELSEIF(I.EQ.2) THEN - KFLW=IABS(KFL2(JT)) - KCW=KFC2A - ELSEIF(I.EQ.3) THEN - IF(KFL3(JT).EQ.0) GOTO 200 - KFLW=IABS(KFL3(JT)) - KCW=KFC3A - ENDIF - P(N+I,5)=PMAS(KCW,1) -CMRENNA++ -C...This prevents SUSY/t particles from becoming too light. - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - PMMN(I)=PMAS(KCW,1) - DO 190 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 190 CONTINUE -CMRENNA-- - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - 200 CONTINUE - -C...Check which two out of three are widest. - IWID1=1 - IWID2=2 - PWID1=PMAS(KFC1A,2) - PWID2=PMAS(KFC2A,2) - KFLW1=IABS(KFL1(JT)) - KFLW2=IABS(KFL2(JT)) - IF(KFL3(JT).NE.0) THEN - PWID3=PMAS(KFC3A,2) - IF(PWID3.GT.PWID1.AND.PWID2.GE.PWID1) THEN - IWID1=3 - PWID1=PWID3 - KFLW1=IABS(KFL3(JT)) - ELSEIF(PWID3.GT.PWID2) THEN - IWID2=3 - PWID2=PWID3 - KFLW2=IABS(KFL3(JT)) - ENDIF - ENDIF - -C...If all narrow then only check that masses consistent. - IF(MSTP(42).LE.0.OR.(PWID1.LT.PARP(41).AND. - & PWID2.LT.PARP(41))) THEN -CMRENNA++ -C....Handle near degeneracy cases. - IF(KFA/KSUSY1.EQ.1.OR.KFA/KSUSY1.EQ.2) THEN - IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN - P(N+1,5)=P(ID,5)-P(N+2,5)-0.5D0 - IF(P(N+1,5).LT.0D0) P(N+1,5)=0D0 - ENDIF - ENDIF -CMRENNA-- - IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN - CALL PYERRM(13,'(PYRESD:) daughter masses too large') - MINT(51)=1 - GOTO 700 - ELSEIF(P(N+1,5)+P(N+2,5)+P(N+3,5)+PARJ(64).GT.P(ID,5)) THEN - CALL PYERRM(3,'(PYRESD:) daughter masses too large') - MINT(51)=1 - GOTO 700 - ENDIF - -C...For three wide resonances select narrower of three -C...according to BW decoupled from rest. - ELSE - PMTOT=P(ID,5) - IF(KFL3(JT).NE.0) THEN - IWID3=6-IWID1-IWID2 - KFLW3=IABS(KFL1(JT))+IABS(KFL2(JT))+IABS(KFL3(JT))- - & KFLW1-KFLW2 - LOOP=0 - 210 LOOP=LOOP+1 - P(N+IWID3,5)=PYMASS(KFLW3) - IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 210 - PMTOT=PMTOT-P(N+IWID3,5) - ENDIF -C...Select other two correlated within remaining phase space. - IF(IP.EQ.1) THEN - CKIN45=CKIN(45) - CKIN47=CKIN(47) - CKIN(45)=MAX(PMMN(IWID1),CKIN(45)) - CKIN(47)=MAX(PMMN(IWID2),CKIN(47)) - CALL PYOFSH(2,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), - & P(N+IWID2,5)) - CKIN(45)=CKIN45 - CKIN(47)=CKIN47 - ELSE - CKIN(49)=PMMN(IWID1) - CKIN(50)=PMMN(IWID2) - CALL PYOFSH(5,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), - & P(N+IWID2,5)) - CKIN(49)=0D0 - CKIN(50)=0D0 - ENDIF - IF(MINT(51).EQ.1) GOTO 700 - ENDIF - -C...Begin fill decay products, with colour flow for coloured objects. - MSTU10=MSTU(10) - MSTU(10)=1 - MSTU(19)=1 - -CMRENNA++ -C...1) Three-body decays of SUSY particles (plus special case top). - IF(KFL3(JT).NE.0) THEN - DO 230 I=N+1,N+3 - DO 220 J=1,5 - K(I,J)=0 - V(I,J)=0D0 - 220 CONTINUE - 230 CONTINUE - K(N+1,1)=1 - K(N+1,2)=KFL1(JT) - K(N+2,1)=1 - K(N+2,2)=KFL2(JT) - K(N+3,1)=1 - K(N+3,2)=KFL3(JT) - IDIN=ID - CALL PYTBDY(IDIN) - -C...Set colour flow for t -> W + b + Z. - IF(KFA.EQ.6) THEN - K(N+2,1)=3 - ISID=4 - IF(KCQM(JT).EQ.-1) ISID=5 - IDAU=N+2 - K(ID,ISID)=K(ID,ISID)+IDAU - K(IDAU,ISID)=MSTU(5)*ID - -C...Set colour flow in three-body decays - programmed as special cases. - ELSEIF(KFC2A.LE.6) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+2,ISID)=MSTU(5)*(N+3) - K(N+3,9-ISID)=MSTU(5)*(N+2) - ENDIF - IF(KFL1(JT).EQ.KSUSY1+21) THEN - K(N+1,1)=3 - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+1,ISID)=MSTU(5)*(N+2) - K(N+1,9-ISID)=MSTU(5)*(N+3) - K(N+2,ISID)=MSTU(5)*(N+1) - K(N+3,9-ISID)=MSTU(5)*(N+1) - ENDIF - IF(KFA.EQ.KSUSY1+21) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(ID,ISID)=K(ID,ISID)+(N+2) - K(ID,9-ISID)=K(ID,9-ISID)+(N+3) - K(N+2,ISID)=MSTU(5)*ID - K(N+3,9-ISID)=MSTU(5)*ID - ENDIF -CMRENNA-- - - IF(KFA.GE.KSUSY1+22.AND.KFA.LE.KSUSY1+37.AND. - & IABS(KCQ2(JT)).EQ.1) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+2,ISID)=MSTU(5)*(N+3) - K(N+3,9-ISID)=MSTU(5)*(N+2) - ENDIF - -C...Set colour flow in three-body decays with baryon number violation. -C...Neutralino and chargino decays first. - KCQSUM=KCQ1(JT)+KCQ2(JT)+KCQ3(JT) - IF(KCQM(JT).EQ.0.AND.IABS(KCQSUM).EQ.3) THEN - ITJUNC(JT)=(1+(1-KCQ1(JT))/2) - K(N+4,4)=ITJUNC(JT)*MSTU(5) -C...Insert junction to keep track of colours. - IF(KCQ1(JT).NE.0) K(N+1,1)=3 - IF(KCQ2(JT).NE.0) K(N+2,1)=3 - IF(KCQ3(JT).NE.0) K(N+3,1)=3 -C...Set special junction codes: - K(N+4,1)=42 - K(N+4,2)=88 - -C...Order decay products by invariant mass. (will be used in PYSTRF). - PM12=P(N+1,4)*P(N+2,4)-P(N+1,1)*P(N+2,1)-P(N+1,2)*P(N+2,2)- - & P(N+1,3)*P(N+2,3) - PM13=P(N+1,4)*P(N+3,4)-P(N+1,1)*P(N+3,1)-P(N+1,2)*P(N+3,2)- - & P(N+1,3)*P(N+3,3) - PM23=P(N+2,4)*P(N+3,4)-P(N+2,1)*P(N+3,1)-P(N+2,2)*P(N+3,2)- - & P(N+2,3)*P(N+3,3) - IF(PM12.LT.PM13.AND.PM12.LT.PM23) THEN - K(N+4,4)=N+3+K(N+4,4) - K(N+4,5)=N+1+MSTU(5)*(N+2) - ELSEIF(PM13.LT.PM23) THEN - K(N+4,4)=N+2+K(N+4,4) - K(N+4,5)=N+1+MSTU(5)*(N+3) - ELSE - K(N+4,4)=N+1+K(N+4,4) - K(N+4,5)=N+2+MSTU(5)*(N+3) - ENDIF - DO 240 J=1,5 - P(N+4,J)=0D0 - V(N+4,J)=0D0 - 240 CONTINUE -C...Connect daughters to junction. - DO 250 II=N+1,N+3 - K(II,4)=0 - K(II,5)=0 - K(II,ITJUNC(JT)+3)=MSTU(5)*(N+4) - 250 CONTINUE -C...Particle counter should be stepped up one extra for junction. - N=N+1 - -C...Gluino decays. - ELSEIF (KCQM(JT).EQ.2.AND.IABS(KCQSUM).EQ.3) THEN - ITJUNC(JT)=(5+(1-KCQ1(JT))/2) - K(N+4,4)=ITJUNC(JT)*MSTU(5) -C...Insert junction to keep track of colours. - IF(KCQ1(JT).NE.0) K(N+1,1)=3 - IF(KCQ2(JT).NE.0) K(N+2,1)=3 - IF(KCQ3(JT).NE.0) K(N+3,1)=3 - K(N+4,1)=42 - K(N+4,2)=88 - DO 260 J=1,5 - P(N+4,J)=0D0 - V(N+4,J)=0D0 - 260 CONTINUE - CTMSUM=0D0 - DO 270 II=N+1,N+3 - K(II,4)=0 - K(II,5)=0 -C...Start by connecting all daughters to junction. - K(II,ITJUNC(JT)-1)=MSTU(5)*(N+4) -C...Only consider colour topologies with off shell resonances. - RMQ1=PMAS(PYCOMP(K(II,2)),1) - RMRES=PMAS(PYCOMP(KSUSY1+IABS(K(II,2))),1) - RMGLU=PMAS(PYCOMP(KSUSY1+21),1) - IF (RMGLU-RMQ1.LT.RMRES) THEN -C...Calculate propagators for each colour topology. - RM2Q23=RMGLU**2+RMQ1**2-2D0*(P(II,4)*P(ID,4)+P(II,1) - & *P(ID,1)+P(II,2)*P(ID,2)+P(II,3)*P(ID,3)) - CTM2(II-N)=1D0/(RM2Q23-RMRES**2)**2 - ELSE - CTM2(II-N)=0D0 - ENDIF - CTMSUM=CTMSUM+CTM2(II-N) - 270 CONTINUE - CTMSUM=PYR(0)*CTMSUM -C...Select colour topology J, with most off shell least likely. - J=0 - 280 J=J+1 - CTMSUM=CTMSUM-CTM2(J) - IF (CTMSUM.GT.0D0) GOTO 280 -C...The lucky winner gets its colour (anti-colour) directly from gluino. - K(N+J,ITJUNC(JT)-1)=MSTU(5)*ID - K(ID,ITJUNC(JT)-1)=N+J+(K(ID,ITJUNC(JT)-1)/MSTU(5))*MSTU(5) -C...The other gluino colour is connected to junction - K(ID,10-ITJUNC(JT))=N+4+(K(ID,10-ITJUNC(JT))/MSTU(5))* - & MSTU(5) - K(N+4,4)=K(N+4,4)+ID -C...Lastly, connect junction to remaining daughters. - K(N+4,5)=N+1+MOD(J,3)+MSTU(5)*(N+1+MOD(J+1,3)) -C...Particle counter should be stepped up one extra for junction. - N=N+1 - ENDIF - -C...Update particle counter. - N=N+3 - -C...2) Everything else two-body decay. - ELSE - CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) -C...First set colour flow as if mother colour singlet. - IF(KCQ1(JT).NE.0) THEN - K(N-1,1)=3 - IF(KCQ1(JT).NE.-1) K(N-1,4)=MSTU(5)*N - IF(KCQ1(JT).NE.1) K(N-1,5)=MSTU(5)*N - ENDIF - IF(KCQ2(JT).NE.0) THEN - K(N,1)=3 - IF(KCQ2(JT).NE.-1) K(N,4)=MSTU(5)*(N-1) - IF(KCQ2(JT).NE.1) K(N,5)=MSTU(5)*(N-1) - ENDIF -C...Then redirect colour flow if mother (anti)triplet. - IF(KCQM(JT).EQ.0) THEN - ELSEIF(KCQM(JT).NE.2) THEN - ISID=4 - IF(KCQM(JT).EQ.-1) ISID=5 - IDAU=N-1 - IF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.2) IDAU=N - K(ID,ISID)=K(ID,ISID)+IDAU - K(IDAU,ISID)=MSTU(5)*ID -C...Then redirect colour flow if mother octet. - ELSEIF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.0) THEN - IDAU=N-1 - IF(KCQ1(JT).EQ.0) IDAU=N - K(ID,4)=K(ID,4)+IDAU - K(ID,5)=K(ID,5)+IDAU - K(IDAU,4)=MSTU(5)*ID - K(IDAU,5)=MSTU(5)*ID - ELSE - ISID=4 - IF(KCQ1(JT).EQ.-1) ISID=5 - IF(KCQ1(JT).EQ.2) ISID=INT(4.5D0+PYR(0)) - K(ID,ISID)=K(ID,ISID)+(N-1) - K(ID,9-ISID)=K(ID,9-ISID)+N - K(N-1,ISID)=MSTU(5)*ID - K(N,9-ISID)=MSTU(5)*ID - ENDIF - -C...Insert junction - IF(IABS(KCQ1(JT)+KCQ2(JT)-KCQM(JT)).EQ.3) THEN - N=N+1 -C...~q* mother: type 3 junction. ~q mother: type 4. - ITJUNC(JT)=(7+KCQM(JT))/2 -C...Specify junction KF and set colour flow from junction - K(N,1)=42 - K(N,2)=88 - K(N,3)=ID -C...Junction type encoded together with mother: - K(N,4)=ID+ITJUNC(JT)*MSTU(5) - K(N,5)=N-1+MSTU(5)*(N-2) -C...Zero P and V for junction (V filled later) - DO 290 J=1,5 - P(N,J)=0D0 - V(N,J)=0D0 - 290 CONTINUE -C...Set colour flow from mother to junction - K(ID,8-ITJUNC(JT))= N + MSTU(5)*(K(ID,8-ITJUNC(JT))/MSTU(5)) -C...Set colour flow from daughters to junction - DO 300 II=N-2,N-1 - K(II,4) = 0 - K(II,5) = 0 -C...(Anti-)colour mother is junction. - K(II,1+ITJUNC(JT)) = MSTU(5)*(N) - 300 CONTINUE - ENDIF - ENDIF - -C...End loop over resonances for daughter flavour and mass selection. - MSTU(10)=MSTU10 - 310 IF(MWID(KCA).NE.0.AND.(KFL1(JT).EQ.0.OR.KFL3(JT).NE.0)) - & NINH=NINH+1 - IF(IRES.GT.0.AND.MWID(KCA).NE.0.AND.MDCY(KCA,1).NE.0.AND. - & KFL1(JT).EQ.0) THEN - WRITE(CODE,'(I9)') K(ID,2) - WRITE(MASS,'(F9.3)') P(ID,5) - CALL PYERRM(3,'(PYRESD:) Failed to decay particle'// - & CODE//' with mass'//MASS) - MINT(51)=1 - GOTO 700 - ENDIF - 320 CONTINUE - -C...Check for allowed combinations. Skip if no decays. - IF(JTMAX.EQ.1) THEN - IF(KDCY(1).EQ.0) GOTO 690 - ELSEIF(JTMAX.EQ.2) THEN - IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 690 - IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 - ELSEIF(JTMAX.EQ.3) THEN - IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 690 - IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 - IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 - IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 - IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 - ENDIF - -C...Special case: matrix element option for Z0 decay to quarks. - IF(MSTP(48).EQ.1.AND.ISUB.EQ.1.AND.JTMAX.EQ.1.AND. - &IABS(MINT(11)).EQ.11.AND.IABS(KFL1(1)).LE.5) THEN - -C...Check consistency of MSTJ options set. - IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN - CALL PYERRM(6, - & '(PYRESD:) MSTJ(109) value requires MSTJ(110) = 1') - MSTJ(110)=1 - ENDIF - IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN - CALL PYERRM(6, - & '(PYRESD:) MSTJ(109) value requires MSTJ(111) = 0') - - MSTJ(111)=0 - ENDIF - -C...Select alpha_strong behaviour. - MST111=MSTU(111) - PAR112=PARU(112) - 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) - -C...Find axial fraction in total cross section for scalar gluon model. - PARJ(171)=0D0 - IF((IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.1).OR. - & (MSTJ(101).EQ.5.AND.MSTJ(49).EQ.1)) THEN - POLL=1D0-PARJ(131)*PARJ(132) - SFF=1D0/(16D0*XW*XW1) - SFW=P(ID,5)**4/((P(ID,5)**2-PARJ(123)**2)**2+ - & (PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/P(ID,5))**2) - VE=4D0*XW-1D0 - HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) - HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE* - & (PARJ(132)-PARJ(131))) - KFLC=IABS(KFL1(1)) - PMQ=PYMASS(KFLC) - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0, - & 1D0-(2D0*PMQ/P(ID,5))**2)) - VF=SIGN(1D0,QF)-4D0*QF*XW - RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+ - & VF**2*HF1W)+VQ**3*HF1W - IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) - ENDIF - -C...Choice of jet configuration. - CALL PYXJET(P(ID,5),NJET,CUT) - KFLC=IABS(KFL1(1)) - KFLN=21 - - IF(NJET.EQ.4) THEN - CALL PYX4JT(NJET,CUT,KFLC,P(ID,5),KFLN,X1,X2,X4,X12,X14) - ELSEIF(NJET.EQ.3) THEN - CALL PYX3JT(NJET,CUT,KFLC,P(ID,5),X1,X3) - ELSE - MSTJ(120)=1 - ENDIF - -C...Fill jet configuration; return if incorrect kinematics. - NC=N-2 - IF(NJET.EQ.2.AND.MSTJ(101).NE.5) THEN - CALL PY2ENT(NC+1,KFLC,-KFLC,P(ID,5)) - ELSEIF(NJET.EQ.2) THEN - CALL PY2ENT(-(NC+1),KFLC,-KFLC,P(ID,5)) - ELSEIF(NJET.EQ.3) THEN - CALL PY3ENT(NC+1,KFLC,21,-KFLC,P(ID,5),X1,X3) - ELSEIF(KFLN.EQ.21) THEN - CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, - & X12,X14) - ELSE - CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, - & X12,X14) - ENDIF - IF(MSTU(24).NE.0) THEN - MINT(51)=1 - MSTU(111)=MST111 - PARU(112)=PAR112 - GOTO 700 - ENDIF - -C...Angular orientation according to matrix element. - IF(MSTJ(106).EQ.1) THEN - CALL PYXDIF(NC,NJET,KFLC,P(ID,5),CHIZ,THEZ,PHIZ) - IF(MINT(11).LT.0) THEZ=PARU(1)-THEZ - CTHE(1)=COS(THEZ) - CALL PYROBO(NC+1,N,0D0,CHIZ,0D0,0D0,0D0) - CALL PYROBO(NC+1,N,THEZ,PHIZ,0D0,0D0,0D0) - ENDIF - -C...Boost partons to Z0 rest frame. - CALL PYROBO(NC+1,N,0D0,0D0,P(ID,1)/P(ID,4), - & P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) - -C...Mark decayed resonance and add documentation lines, - K(ID,1)=K(ID,1)+10 - IDOC=MINT(83)+MINT(4) - DO 340 I=NC+1,N - I1=MINT(83)+MINT(4)+1 - K(I,3)=I1 - IF(MSTP(128).GE.1) K(I,3)=ID - IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN - MINT(4)=MINT(4)+1 - K(I1,1)=21 - K(I1,2)=K(I,2) - K(I1,3)=IREF(IP,4) - DO 330 J=1,5 - P(I1,J)=P(I,J) - 330 CONTINUE - ENDIF - 340 CONTINUE - -C...Generate parton shower. - IF(MSTJ(101).EQ.5) CALL PYSHOW(N-1,N,P(ID,5)) - -C... End special case for Z0: skip ahead. - MSTU(111)=MST111 - PARU(112)=PAR112 - GOTO 680 - ENDIF - -C...Order incoming partons and outgoing resonances. - IF(JTMAX.EQ.2.AND.ISUB.NE.0.AND.MSTP(47).GE.1.AND. - &NINH.EQ.0) THEN - ILIN(1)=MINT(84)+1 - IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2 - IF(K(ILIN(1),2).EQ.21.OR.K(ILIN(1),2).EQ.22) - & ILIN(1)=2*MINT(84)+3-ILIN(1) - ILIN(2)=2*MINT(84)+3-ILIN(1) - IMIN=1 - IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) - & .EQ.36) IMIN=3 - IMAX=2 - IORD=1 - IF(K(IREF(IP,1),2).EQ.23) IORD=2 - IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2 - IAKIPD=IABS(K(IREF(IP,IORD),2)) - IF(IAKIPD.EQ.25.OR.IAKIPD.EQ.35.OR.IAKIPD.EQ.36) IORD=3-IORD - IF(KDCY(IORD).EQ.0) IORD=3-IORD - -C...Order decay products of resonances. - DO 350 JT=IORD,3-IORD,3-2*IORD - IF(KDCY(JT).EQ.0) THEN - ILIN(IMAX+1)=NSD(JT) - IMAX=IMAX+1 - ELSEIF(K(NSD(JT)+1,2).GT.0) THEN - ILIN(IMAX+1)=N+2*JT-1 - ILIN(IMAX+2)=N+2*JT - IMAX=IMAX+2 - K(N+2*JT-1,2)=K(NSD(JT)+1,2) - K(N+2*JT,2)=K(NSD(JT)+2,2) - ELSE - ILIN(IMAX+1)=N+2*JT - - ILIN(IMAX+2)=N+2*JT-1 - IMAX=IMAX+2 - K(N+2*JT-1,2)=K(NSD(JT)+1,2) - K(N+2*JT,2)=K(NSD(JT)+2,2) - ENDIF - 350 CONTINUE - -C...Find charge, isospin, left- and righthanded couplings. - DO 370 I=IMIN,IMAX - DO 360 J=1,4 - COUP(I,J)=0D0 - 360 CONTINUE - KFA=IABS(K(ILIN(I),2)) - IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 370 - COUP(I,1)=KCHG(KFA,1)/3D0 - COUP(I,2)=(-1)**MOD(KFA,2) - COUP(I,4)=-2D0*COUP(I,1)*XWV - COUP(I,3)=COUP(I,2)+COUP(I,4) - 370 CONTINUE - -C...Full propagator dependence and flavour correlations for 2 gamma*/Z. - IF(ISUB.EQ.22) THEN - DO 400 I=3,5,2 - I1=IORD - IF(I.EQ.5) I1=3-IORD - DO 390 J1=1,2 - DO 380 J2=1,2 - CORL(I/2,J1,J2)=COUP(1,1)**2*HGZ(I1,1)*COUP(I,1)**2/ - & 16D0+COUP(1,1)*COUP(1,J1+2)*HGZ(I1,2)*COUP(I,1)* - & COUP(I,J2+2)/4D0+COUP(1,J1+2)**2*HGZ(I1,3)* - & COUP(I,J2+2)**2 - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - COWT12=(CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ - & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)) - COMX12=(CORL(1,1,1)+CORL(1,1,2)+CORL(1,2,1)+CORL(1,2,2))* - & (CORL(2,1,1)+CORL(2,1,2)+CORL(2,2,1)+CORL(2,2,2)) - - IF(COWT12.LT.PYR(0)*COMX12) GOTO 160 - ENDIF - ENDIF - -C...Select angular orientation type - Z'/W' only. - MZPWP=0 - IF(ISUB.EQ.141) THEN - IF(PYR(0).LT.PARU(130)) MZPWP=1 - IF(IP.EQ.2) THEN - IF(IABS(K(IREF(2,1),2)).EQ.37) MZPWP=2 - IAKIR=IABS(K(IREF(2,2),2)) - IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 - IF(IAKIR.LE.20) MZPWP=2 - ENDIF - IF(IP.GE.3) MZPWP=2 - ELSEIF(ISUB.EQ.142) THEN - IF(PYR(0).LT.PARU(136)) MZPWP=1 - IF(IP.EQ.2) THEN - IAKIR=IABS(K(IREF(2,2),2)) - IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 - IF(IAKIR.LE.20) MZPWP=2 - ENDIF - IF(IP.GE.3) MZPWP=2 - ENDIF - -C...Select random angles (begin of weighting procedure). - 410 DO 420 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 420 - IF(JTMAX.EQ.1.AND.ISUB.NE.0.AND.IHDEC.EQ.0) THEN - CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*PYR(0) - IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33) - PHI(JT)=VINT(24) - ELSE - CTHE(JT)=2D0*PYR(0)-1D0 - PHI(JT)=PARU(2)*PYR(0) - ENDIF - 420 CONTINUE - - IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN -C...Construct massless four-vectors. - DO 440 I=N+1,N+4 - K(I,1)=1 - DO 430 J=1,5 - P(I,J)=0D0 - V(I,J)=0D0 - 430 CONTINUE - 440 CONTINUE - DO 450 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 450 - ID=IREF(IP,JT) - P(N+2*JT-1,3)=0.5D0*P(ID,5) - P(N+2*JT-1,4)=0.5D0*P(ID,5) - P(N+2*JT,3)=-0.5D0*P(ID,5) - P(N+2*JT,4)=0.5D0*P(ID,5) - CALL PYROBO(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT), - & P(ID,1)/P(ID,4),P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) - 450 CONTINUE - -C...Store incoming and outgoing momenta, with random rotation to -C...avoid accidental zeroes in HA expressions. - IF(ISUB.NE.0) THEN - DO 470 I=IMIN,IMAX - K(N+4+I,1)=1 - P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+ - & P(ILIN(I),3)**2+P(ILIN(I),5)**2) - P(N+4+I,5)=P(ILIN(I),5) - DO 460 J=1,3 - P(N+4+I,J)=P(ILIN(I),J) - 460 CONTINUE - 470 CONTINUE - 480 THERR=ACOS(2D0*PYR(0)-1D0) - PHIRR=PARU(2)*PYR(0) - CALL PYROBO(N+4+IMIN,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) - DO 500 I=IMIN,IMAX - IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*(P(N+4+I,1)**2+ - & P(N+4+I,2)**2+P(N+4+I,3)**2)) GOTO 480 - DO 490 J=1,4 - PK(I,J)=P(N+4+I,J) - 490 CONTINUE - 500 CONTINUE - ENDIF - -C...Calculate internal products. - IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25.OR.ISUB.EQ.141.OR. - & ISUB.EQ.142) THEN - DO 520 I1=IMIN,IMAX-1 - DO 510 I2=I1+1,IMAX - HA(I1,I2)=SNGL(SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+ - & PK(I2,3))/(1D-20+PK(I1,1)**2+PK(I1,2)**2)))* - & CMPLX(SNGL(PK(I1,1)),SNGL(PK(I1,2)))- - & SNGL(SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ - & (1D-20+PK(I2,1)**2+PK(I2,2)**2)))* - & CMPLX(SNGL(PK(I2,1)),SNGL(PK(I2,2))) - HC(I1,I2)=CONJG(HA(I1,I2)) - IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2) - IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2) - HA(I2,I1)=-HA(I1,I2) - HC(I2,I1)=-HC(I1,I2) - 510 CONTINUE - 520 CONTINUE - ENDIF - -C...Calculate four-products. - IF(ISUB.NE.0) THEN - DO 540 I=1,2 - DO 530 J=1,4 - PK(I,J)=-PK(I,J) - 530 CONTINUE - 540 CONTINUE - DO 560 I1=IMIN,IMAX-1 - DO 550 I2=I1+1,IMAX - PKK(I1,I2)=2D0*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)- - & PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3)) - PKK(I2,I1)=PKK(I1,I2) - 550 CONTINUE - 560 CONTINUE - ENDIF - ENDIF - - KFAGM=IABS(IREF(IP,7)) - IF(MSTP(47).LE.0.OR.NINH.NE.0) THEN -C...Isotropic decay selected by user. - WT=1D0 - WTMAX=1D0 - - ELSEIF(JTMAX.EQ.3) THEN -C...Isotropic decay when three mother particles. - WT=1D0 - WTMAX=1D0 - - ELSEIF(IT4.GE.1) THEN -C... Isotropic decay t -> b + W etc for 4th generation q and l. - WT=1D0 - WTMAX=1D0 - - ELSEIF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR. - & IREF(IP,7).EQ.36) THEN -C...Angular weight for h0/A0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons. -C...CP-odd case added by Kari Ertresvag Myklevoll. -C...Now also with mixed Higgs CP-states - ETA=PARP(25) - IF(IP.EQ.1) WTMAX=SH**2 - IF(IP.GE.2) WTMAX=P(IREF(IP,8),5)**4 - KFA=IABS(K(IREF(IP,1),2)) - - IF((KFA.EQ.23.OR.KFA.EQ.24).AND.MSTP(25).GE.3) THEN -C...For mixed CP states need epsilon product. - P10=PK(3,4) - P20=PK(4,4) - P30=PK(5,4) - P40=PK(6,4) - P11=PK(3,1) - P21=PK(4,1) - P31=PK(5,1) - P41=PK(6,1) - P12=PK(3,2) - P22=PK(4,2) - P32=PK(5,2) - P42=PK(6,2) - P13=PK(3,3) - P23=PK(4,3) - P33=PK(5,3) - P43=PK(6,3) - EPSI=P10*P21*P32*P43-P10*P21*P33*P42-P10*P22*P31*P43+P10*P22* - & P33*P41+P10*P23*P31*P42-P10*P23*P32*P41-P11*P20*P32*P43+P11* - & P20*P33*P42+P11*P22*P30*P43-P11*P22*P33*P40-P11*P23*P30*P42+ - & P11*P23*P32*P40+P12*P20*P31*P43-P12*P20*P33*P41-P12*P21*P30* - & P43+P12*P21*P33*P40+P12*P23*P30*P41-P12*P23*P31*P40-P13*P20* - & P31*P42+P13*P20*P32*P41+P13*P21*P30*P42-P13*P21*P32*P40-P13* - & P22*P30*P41+P13*P22*P31*P40 -C...For mixed CP states need gauge boson masses. - XMA=SQRT(MAX(0D0,(PK(3,4)+PK(4,4))**2-(PK(3,1)+PK(4,1))**2- - & (PK(3,2)+PK(4,2))**2-(PK(3,3)+PK(4,3))**2)) - XMB=SQRT(MAX(0D0,(PK(5,4)+PK(6,4))**2-(PK(5,1)+PK(6,1))**2- - & (PK(5,2)+PK(6,2))**2-(PK(5,3)+PK(6,3))**2)) - XMV=PMAS(KFA,1) - ENDIF - -C...Z decay - IF(KFA.EQ.23) THEN - KFLF1A=IABS(KFL1(1)) - EF1=KCHG(KFLF1A,1)/3D0 - AF1=SIGN(1D0,EF1+0.1D0) - VF1=AF1-4D0*EF1*XWV - KFLF2A=IABS(KFL1(2)) - EF2=KCHG(KFLF2A,1)/3D0 - AF2=SIGN(1D0,EF2+0.1D0) - VF2=AF2-4D0*EF2*XWV - VA12AS=4D0*VF1*AF1*VF2*AF2/((VF1**2+AF1**2)*(VF2**2+AF2**2)) - IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) - & THEN -C...CP-even decay - WT=8D0*(1D0+VA12AS)*PKK(3,5)*PKK(4,6)+ - & 8D0*(1D0-VA12AS)*PKK(3,6)*PKK(4,5) - ELSEIF(MSTP(25).LE.2) THEN -C...CP-odd decay - WT=((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 - & -2*PKK(3,4)*PKK(5,6) - & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ - & (PKK(3,4)*PKK(5,6)) - & +VA12AS*(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* - & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6)))/(1+VA12AS) - ELSE -C...Mixed CP states. - WT=32D0*(0.25D0*((1D0+VA12AS)*PKK(3,5)*PKK(4,6) - & +(1D0-VA12AS)*PKK(3,6)*PKK(4,5)) - & -0.5D0*ETA/XMV**2*EPSI*((1D0+VA12AS)*(PKK(3,5)+PKK(4,6)) - & -(1D0-VA12AS)*(PKK(3,6)+PKK(4,5))) - & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 - & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 - & +PKK(3,4)*PKK(5,6) - & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) - & +VA12AS*PKK(3,4)*PKK(5,6) - & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) - & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) - & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 - & +2D0*(ETA*XMA*XMB/XMV**2)**2*(1D0+VA12AS)) - ENDIF - -C...W decay - ELSEIF(KFA.EQ.24) THEN - IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) - & THEN -C...CP-even decay - WT=16D0*PKK(3,5)*PKK(4,6) - ELSEIF(MSTP(25).LE.2) THEN -C...CP-odd decay - WT=0.5D0*((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 - & -2*PKK(3,4)*PKK(5,6) - & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ - & (PKK(3,4)*PKK(5,6)) - & +(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* - & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6))) - ELSE -C...Mixed CP states. - WT=32D0*(0.25D0*2D0*PKK(3,5)*PKK(4,6) - & -0.5D0*ETA/XMV**2*EPSI*2D0*(PKK(3,5)+PKK(4,6)) - & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 - & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 - & +PKK(3,4)*PKK(5,6) - & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) - & +PKK(3,4)*PKK(5,6) - & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) - & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) - & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 - & +(2D0*ETA*XMA*XMB/XMV**2)**2) - ENDIF - -C...No angular correlations in other Higgs decays. - ELSE - WT=WTMAX - ENDIF - - ELSEIF((KFAGM.EQ.6.OR.KFAGM.EQ.7.OR.KFAGM.EQ.8.OR. - & KFAGM.EQ.17.OR.KFAGM.EQ.18).AND.IABS(K(IREF(IP,1),2)).EQ.24) - & THEN -C...Angular correlation in f -> f' + W -> f' + 2 quarks/leptons. - I1=IREF(IP,8) - IF(MOD(KFAGM,2).EQ.0) THEN - I2=N+1 - I3=N+2 - ELSE - I2=N+2 - I3=N+1 - ENDIF - I4=IREF(IP,2) - WT=(P(I1,4)*P(I2,4)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- - & P(I1,3)*P(I2,3))*(P(I3,4)*P(I4,4)-P(I3,1)*P(I4,1)- - & P(I3,2)*P(I4,2)-P(I3,3)*P(I4,3)) - WTMAX=(P(I1,5)**4-P(IREF(IP,1),5)**4)/8D0 - - ELSEIF(ISUB.EQ.1) THEN -C...Angular weight for gamma*/Z0 -> 2 quarks/leptons. - EI=KCHG(IABS(MINT(15)),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EF=KCHG(IABS(KFL1(1)),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - - VF=AF-4D0*EF*XWV - RMF=MIN(1D0,4D0*PMAS(IABS(KFL1(1)),1)**2/SH) - WT1=EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & (VI**2+AI**2)*VINT(114)*(VF**2+(1D0-RMF)*AF**2) - WT2=RMF*(EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & (VI**2+AI**2)*VINT(114)*VF**2) - WT3=SQRT(1D0-RMF)*(EI*AI*VINT(112)*EF*AF+ - & 4D0*VI*AI*VINT(114)*VF*AF) - WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ - & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) - WTMAX=2D0*(WT1+ABS(WT3)) - - ELSEIF(ISUB.EQ.2) THEN -C...Angular weight for W+/- -> 2 quarks/leptons. - RM3=PMAS(IABS(KFL1(1)),1)**2/SH - RM4=PMAS(IABS(KFL2(1)),1)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 - WTMAX=4D0 - - ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN -C...Angular weight for f + fbar -> gluon/gamma + (gamma*/Z0) -> -C...-> gluon/gamma + 2 quarks/leptons. - CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 - CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 - WT=(CLILF+CRIRF)*(PKK(1,3)**2+PKK(2,4)**2)+ - & (CLIRF+CRILF)*(PKK(1,4)**2+PKK(2,3)**2) - WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* - & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2) - - ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN -C...Angular weight for f + fbar' -> gluon/gamma + W+/- -> -C...-> gluon/gamma + 2 quarks/leptons. - WT=PKK(1,3)**2+PKK(2,4)**2 - WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2 - - ELSEIF(ISUB.EQ.22) THEN -C...Angular weight for f + fbar -> Z0 + Z0 -> 4 quarks/leptons. - S34=P(IREF(IP,IORD),5)**2 - S56=P(IREF(IP,3-IORD),5)**2 - TI=PKK(1,3)+PKK(1,4)+S34 - UI=PKK(1,5)+PKK(1,6)+S56 - TIR=REAL(TI) - UIR=REAL(UI) - FGK135=ABS(FGK(1,2,3,4,5,6)/TIR+FGK(1,2,5,6,3,4)/UIR)**2 - FGK145=ABS(FGK(1,2,4,3,5,6)/TIR+FGK(1,2,5,6,4,3)/UIR)**2 - FGK136=ABS(FGK(1,2,3,4,6,5)/TIR+FGK(1,2,6,5,3,4)/UIR)**2 - FGK146=ABS(FGK(1,2,4,3,6,5)/TIR+FGK(1,2,6,5,4,3)/UIR)**2 - FGK253=ABS(FGK(2,1,5,6,3,4)/TIR+FGK(2,1,3,4,5,6)/UIR)**2 - FGK263=ABS(FGK(2,1,6,5,3,4)/TIR+FGK(2,1,3,4,6,5)/UIR)**2 - FGK254=ABS(FGK(2,1,5,6,4,3)/TIR+FGK(2,1,4,3,5,6)/UIR)**2 - FGK264=ABS(FGK(2,1,6,5,4,3)/TIR+FGK(2,1,4,3,6,5)/UIR)**2 - - WT= - & CORL(1,1,1)*CORL(2,1,1)*FGK135+CORL(1,1,2)*CORL(2,1,1)*FGK145+ - & CORL(1,1,1)*CORL(2,1,2)*FGK136+CORL(1,1,2)*CORL(2,1,2)*FGK146+ - & CORL(1,2,1)*CORL(2,2,1)*FGK253+CORL(1,2,2)*CORL(2,2,1)*FGK263+ - & CORL(1,2,1)*CORL(2,2,2)*FGK254+CORL(1,2,2)*CORL(2,2,2)*FGK264 - WTMAX=16D0*((CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ - & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)))*S34*S56* - & ((TI**2+UI**2+2D0*SH*(S34+S56))/(TI*UI)-S34*S56*(1D0/TI**2+ - & 1D0/UI**2)) - - ELSEIF(ISUB.EQ.23) THEN -C...Angular weight for f + fbar' -> Z0 + W+/- -> 4 quarks/leptons. - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FACBW=1D0/((SH-SQMW)**2+GMMW**2) - CAWZ=COUP(2,3)/DT-2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW - CBWZ=COUP(1,3)/DU+2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW - FGK135=ABS(REAL(CAWZ)*FGK(1,2,3,4,5,6)+ - - & REAL(CBWZ)*FGK(1,2,5,6,3,4)) - FGK136=ABS(REAL(CAWZ)*FGK(1,2,3,4,6,5)+ - & REAL(CBWZ)*FGK(1,2,6,5,3,4)) - WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 - WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2* - & DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU)) - - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN -C...Angular weight for f + fbar -> Z0 + h0 -> 2 quarks/leptons + h0 -C...(or H0, or A0). - WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* - & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)* - & COUP(3,3))**2)*PKK(1,4)*PKK(2,3) - WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* - & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) - - ELSEIF(ISUB.EQ.25) THEN -C...Angular weight for f + fbar -> W+ + W- -> 4 quarks/leptons. - POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) - POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FACBW=1D0/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2) - CDWW=(COUP(1,3)*SQMZ*(SH-SQMZ)*FACBW+COUP(1,2))/SH - CAWW=CDWW+0.5D0*(COUP(1,2)+1D0)/DT - CBWW=CDWW+0.5D0*(COUP(1,2)-1D0)/DU - CCWW=COUP(1,4)*SQMZ*(SH-SQMZ)*FACBW/SH - FGK135=ABS(REAL(CAWW)*FGK(1,2,3,4,5,6)- - & REAL(CBWW)*FGK(1,2,5,6,3,4)) - FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) - IF(MSTP(50).LE.0) THEN - WT=FGK135**2+(CCWW*FGK253)**2 - WTMAX=4D0*D34*D56*(CAWW**2*DIGK(DT,DU)+CBWW**2*DIGK(DU,DT)- - & CAWW*CBWW*DJGK(DT,DU)+CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)- - & DJGK(DT,DU))) - ELSE - WT=POLL*FGK135**2+POLR*(CCWW*FGK253)**2 - WTMAX=4D0*D34*D56*(POLL*(CAWW**2*DIGK(DT,DU)+ - & CBWW**2*DIGK(DU,DT)-CAWW*CBWW*DJGK(DT,DU))+ - & POLR*CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))) - ENDIF - - ELSEIF(ISUB.EQ.26.OR.ISUB.EQ.172.OR.ISUB.EQ.177) THEN -C...Angular weight for f + fbar' -> W+/- + h0 -> 2 quarks/leptons + h0 -C...(or H0, or A0). - WT=PKK(1,3)*PKK(2,4) - WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) - - ELSEIF(ISUB.EQ.30.OR.ISUB.EQ.35) THEN -C...Angular weight for f + g/gamma -> f + (gamma*/Z0) -C...-> f + 2 quarks/leptons. - CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 - CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 - IF(K(ILIN(1),2).GT.0) WT=(CLILF+CRIRF)*(PKK(1,4)**2+ - & PKK(3,5)**2)+(CLIRF+CRILF)*(PKK(1,3)**2+PKK(4,5)**2) - IF(K(ILIN(1),2).LT.0) WT=(CLILF+CRIRF)*(PKK(1,3)**2+ - & PKK(4,5)**2)+(CLIRF+CRILF)*(PKK(1,4)**2+PKK(3,5)**2) - WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* - & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2) - - ELSEIF(ISUB.EQ.31.OR.ISUB.EQ.36) THEN -C...Angular weight for f + g/gamma -> f' + W+/- -> f' + 2 fermions. - IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2 - IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2 - WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2 - - ELSEIF(ISUB.EQ.71.OR.ISUB.EQ.72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR. - & ISUB.EQ.77) THEN -C...Angular weight for V_L1 + V_L2 -> V_L3 + V_L4 (V = Z/W). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - - ELSEIF(ISUB.EQ.110) THEN -C...Angular weight for f + fbar -> gamma + h0 -> gamma + X is isotropic. - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.EQ.141) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN -C...Angular weight for f + fbar -> gamma*/Z0/Z'0 -> 2 quarks/leptons. -C...Couplings of incoming flavour. - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - KFAIC=1 - IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 - IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 - IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 - IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN - VPI=PARU(119+2*KFAIC) - API=PARU(120+2*KFAIC) - ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN - VPI=PARJ(178+2*KFAIC) - API=PARJ(179+2*KFAIC) - ELSE - VPI=PARJ(186+2*KFAIC) - API=PARJ(187+2*KFAIC) - ENDIF -C...Couplings of final flavour. - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - KFAFC=1 - IF(KFAF.LE.10.AND.MOD(KFAF,2).EQ.0) KFAFC=2 - IF(KFAF.GT.10.AND.MOD(KFAF,2).NE.0) KFAFC=3 - IF(KFAF.GT.10.AND.MOD(KFAF,2).EQ.0) KFAFC=4 - IF(KFAF.LE.2.OR.KFAF.EQ.11.OR.KFAF.EQ.12) THEN - VPF=PARU(119+2*KFAFC) - APF=PARU(120+2*KFAFC) - ELSEIF(KFAF.LE.4.OR.KFAF.EQ.13.OR.KFAF.EQ.14) THEN - VPF=PARJ(178+2*KFAFC) - APF=PARJ(179+2*KFAFC) - ELSE - VPF=PARJ(186+2*KFAFC) - APF=PARJ(187+2*KFAFC) - ENDIF -C...Asymmetry and weight. - ASYM=2D0*(EI*AI*VINT(112)*EF*AF+EI*API*VINT(113)*EF*APF+ - & 4D0*VI*AI*VINT(114)*VF*AF+(VI*API+VPI*AI)*VINT(115)* - & (VF*APF+VPF*AF)+4D0*VPI*API*VINT(116)*VPF*APF)/ - & (EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* - & (VF**2+AF**2)+(VI*VPI+AI*API)*VINT(115)*(VF*VPF+AF*APF)+ - & (VPI**2+API**2)*VINT(116)*(VPF**2+APF**2)) - WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 - WTMAX=2D0+ABS(ASYM) - ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).EQ.24) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W-. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* - & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ - & (RM2-RM1)**2) - WT=CFLAT+CCOS2*CTHE(1)**2 - WTMAX=CFLAT+MAX(0D0,CCOS2) - ELSEIF(IP.EQ.1.AND.(KFL1(1).EQ.25.OR.KFL1(1).EQ.35.OR. - & IABS(KFL1(1)).EQ.37)) THEN -C...Angular weight for f + fbar -> Z' -> h0 + A0, H0 + A0, H+ + H-. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN -C...Angular weight for f + fbar -> Z' -> Z0 + h0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) - WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) - WTMAX=1D0+FLAM2/(8D0*RM1) - ELSEIF(MZPWP.EQ.0) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons -C...(W:s like if intermediate Z). - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) - FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) - WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2 - WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)* - & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) - ELSEIF(MZPWP.EQ.1) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons -C...(W:s approximately longitudinal, like if intermediate H). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - ELSE -C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0, -C...H0 + A0 -> 4 quarks/leptons, t + tbar -> b + W+ + bbar + W- . - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.142) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN -C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons. - KFAI=IABS(MINT(15)) - KFAIC=1 - IF(KFAI.GT.10) KFAIC=2 - VI=PARU(129+2*KFAIC) - AI=PARU(130+2*KFAIC) - KFAF=IABS(KFL1(1)) - KFAFC=1 - IF(KFAF.GT.10) KFAFC=2 - VF=PARU(129+2*KFAFC) - AF=PARU(130+2*KFAFC) - ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2)) - WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 - WTMAX=2D0+ABS(ASYM) - ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN -C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* - & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ - & (RM2-RM1)**2) - WT=CFLAT+CCOS2*CTHE(1)**2 - WTMAX=CFLAT+MAX(0D0,CCOS2) - ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN -C...Angular weight for f + fbar -> W'+/- -> W+/- + h0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) - WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) - WTMAX=1D0+FLAM2/(8D0*RM1) - ELSEIF(MZPWP.EQ.0) THEN -C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons -C...(W/Z like if intermediate W). - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) - FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4)) - WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 - WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)* - & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) - ELSEIF(MZPWP.EQ.1) THEN -C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons -C...(W/Z approximately longitudinal, like if intermediate H). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - ELSE -C...Angular weight for f + fbar -> W' -> W + h0 -> whatever, -C...t + bbar -> t + W + bbar. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.145.OR.ISUB.EQ.162.OR.ISUB.EQ.163.OR.ISUB.EQ.164) - & THEN -C...Isotropic decay of leptoquarks (assumed spin 0). - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.GE.146.AND.ISUB.LE.148) THEN -C...Decays of (spin 1/2) q*/e* -> q/e + (g,gamma) or (Z0,W+-). - SIDE=1D0 - IF(MINT(16).EQ.21.OR.MINT(16).EQ.22) SIDE=-1D0 - IF(IP.EQ.1.AND.(KFL1(1).EQ.21.OR.KFL1(1).EQ.22)) THEN - WT=1D0+SIDE*CTHE(1) - WTMAX=2D0 - ELSEIF(IP.EQ.1) THEN - - RM1=P(NSD(1)+1,5)**2/SH - WT=1D0+SIDE*CTHE(1)*(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) - WTMAX=1D0+(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) - ELSE -C...W/Z decay assumed isotropic, since not known. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.149) THEN -C...Isotropic decay of techni-eta. - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.EQ.191) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar -> rho_tc0 -> W+ W-, -C...W+ pi_tc-, pi_tc+ W- or pi_tc+ pi_tc-. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar -> rho_tc0 -> f fbar. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - ALEFTI=(EI+VALI*BWZR)**2+(VALI*BWZI)**2 - ARIGHI=(EI+VARI*BWZR)**2+(VARI*BWZI)**2 - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - ALEFTF=(EF+VALF*BWZR)**2+(VALF*BWZI)**2 - ARIGHF=(EF+VARF*BWZR)**2+(VARF*BWZI)**2 - ASAME=ALEFTI*ALEFTF+ARIGHI*ARIGHF - AFLIP=ALEFTI*ARIGHF+ARIGHI*ALEFTF - WT=ASAME*(1D0+CTHESG)**2+AFLIP*(1D0-CTHESG)**2 - WTMAX=4D0*MAX(ASAME,AFLIP) - ELSE -C...Isotropic decay of W/pi_tc produced in rho_tc decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.192) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar' -> rho_tc+ -> W+ Z0, -C...W+ pi_tc0, pi_tc+ Z0 or pi_tc+ pi_tc0. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar' -> rho_tc+ -> f fbar'. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - WT=(1D0+CTHESG)**2 - WTMAX=4D0 - ELSE -C...Isotropic decay of W/Z/pi_tc produced in rho_tc+ decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.193) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar -> omega_tc0 -> -C...gamma pi_tc0 or Z0 pi_tc0. - WT=1D0+CTHE(1)**2 - WTMAX=2D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar -> omega_tc0 -> f fbar. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - BLEFTI=(EI-VALI*BWZR)**2+(VALI*BWZI)**2 - BRIGHI=(EI-VARI*BWZR)**2+(VARI*BWZI)**2 - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - BLEFTF=(EF-VALF*BWZR)**2+(VALF*BWZI)**2 - BRIGHF=(EF-VARF*BWZR)**2+(VARF*BWZI)**2 - BSAME=BLEFTI*BLEFTF+BRIGHI*BRIGHF - BFLIP=BLEFTI*BRIGHF+BRIGHI*BLEFTF - WT=BSAME*(1D0+CTHESG)**2+BFLIP*(1D0-CTHESG)**2 - WTMAX=4D0*MAX(BSAME,BFLIP) - ELSE -C...Isotropic decay of Z/pi_tc produced in omega_tc decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.353) THEN -C...Angular weight for Z_R0 -> 2 quarks/leptons. - EI=KCHG(IABS(MINT(15)),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EF=KCHG(PYCOMP(KFL1(1)),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - RMF=MIN(1D0,4D0*PMAS(PYCOMP(KFL1(1)),1)**2/SH) - WT1=(VI**2+AI**2)*(VF**2+(1D0-RMF)*AF**2) - WT2=RMF*(VI**2+AI**2)*VF**2 - WT3=SQRT(1D0-RMF)*4D0*VI*AI*VF*AF - WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ - & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) - WTMAX=2D0*(WT1+ABS(WT3)) - - ELSEIF(ISUB.EQ.354) THEN -C...Angular weight for W_R+/- -> 2 quarks/leptons. - RM3=PMAS(PYCOMP(KFL1(1)),1)**2/SH - RM4=PMAS(PYCOMP(KFL2(1)),1)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 - WTMAX=4D0 - - ELSEIF(ISUB.EQ.391) THEN -C...Angular weight for f + fbar -> G* -> f + fbar - IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN - WT=1D0-3D0*CTHE(1)**2+4D0*CTHE(1)**4 - WTMAX=2D0 -C...Other G* decays not yet implemented angular distributions. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.392) THEN -C...Angular weight for g + g -> G* -> f + fbar - IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN - WT=1D0-CTHE(1)**4 - WTMAX=1D0 -C...Other G* decays not yet implemented angular distributions. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - -C...Obtain correct angular distribution by rejection techniques. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - IF(WT.LT.PYR(0)*WTMAX) GOTO 410 - -C...Construct massive four-vectors using angles chosen. - 570 DO 670 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 670 - ID=IREF(IP,JT) - DO 580 J=1,5 - DPMO(J)=P(ID,J) - 580 CONTINUE - DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2) -CMRENNA++ - IF(KFL3(JT).EQ.0) THEN - CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), - & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) - N0=NSD(JT)+2 - ELSE - CALL PYROBO(NSD(JT)+1,NSD(JT)+3,ACOS(CTHE(JT)),PHI(JT), - & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) - N0=NSD(JT)+3 - ENDIF - - DO 590 J=1,4 - VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) - 590 CONTINUE -C...Fill in position of decay vertex. - DO 610 I=NSD(JT)+1,N0 - DO 600 J=1,4 - V(I,J)=VDCY(J) - 600 CONTINUE - V(I,5)=0D0 - - 610 CONTINUE -CMRENNA-- - -C...Mark decayed resonances; trace history. - K(ID,1)=K(ID,1)+10 - KFA=IABS(K(ID,2)) - KCA=PYCOMP(KFA) - IF(KCQM(JT).NE.0) THEN -C...Do not kill colour flow through coloured resonance! - ELSE - K(ID,4)=NSD(JT)+1 - K(ID,5)=NSD(JT)+2 -C...If 3-body or 2-body with junction: - IF(KFL3(JT).NE.0.OR.ITJUNC(JT).NE.0) K(ID,5)=NSD(JT)+3 -C...If 3-body with junction: - IF(ITJUNC(JT).NE.0.AND.KFL3(JT).NE.0) K(ID,5)=NSD(JT)+4 - ENDIF - -C...Add documentation lines. - ISUBRG=MAX(1,MIN(500,MINT(1))) - IF(IRES.EQ.0.OR.ISET(ISUBRG).EQ.11) THEN - IDOC=MINT(83)+MINT(4) -CMRENNA+++ - IHI=NSD(JT)+2 - IF(KFL3(JT).NE.0) IHI=IHI+1 - DO 630 I=NSD(JT)+1,IHI -CMRENNA--- - I1=MINT(83)+MINT(4)+1 - K(I,3)=I1 - IF(MSTP(128).GE.1) K(I,3)=ID - IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN - MINT(4)=MINT(4)+1 - K(I1,1)=21 - K(I1,2)=K(I,2) - K(I1,3)=IREF(IP,JT+3) - DO 620 J=1,5 - P(I1,J)=P(I,J) - 620 CONTINUE - ENDIF - 630 CONTINUE - ELSE - K(NSD(JT)+1,3)=ID - K(NSD(JT)+2,3)=ID -C...If 3-body or 2-body with junction: - IF(KFL3(JT).NE.0.OR.ITJUNC(JT).GT.0) K(NSD(JT)+3,3)=ID -C...If 3-body with junction: - IF(KFL3(JT).NE.0.AND.ITJUNC(JT).GT.0) K(NSD(JT)+4,3)=ID - ENDIF - -C...Do showering of two or three objects. - NSHBEF=N - IF(MSTP(71).GE.1) THEN - IF(KFL3(JT).EQ.0) THEN - CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5)) - ELSE - CALL PYSHOW(NSD(JT)+1,-3,P(ID,5)) - ENDIF - ENDIF - NSHAFT=N - IF(JT.EQ.1) NAFT1=N - -C...Check if decay products moved by shower. - NSD1=NSD(JT)+1 - NSD2=NSD(JT)+2 - NSD3=NSD(JT)+3 - IF(NSHAFT.GT.NSHBEF) THEN - IF(K(NSD1,1).GT.10) THEN - DO 640 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD1,2)) NSD1=I - 640 CONTINUE - ENDIF - IF(K(NSD2,1).GT.10) THEN - DO 650 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD2,2).AND. - & I.NE.NSD1) NSD2=I - 650 CONTINUE - ENDIF - IF(KFL3(JT).NE.0.AND.K(NSD3,1).GT.10) THEN - DO 660 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD3,2).AND. - & I.NE.NSD1.AND.I.NE.NSD2) NSD3=I - 660 CONTINUE - ENDIF - ENDIF - -C...Store decay products for further treatment. - NP=NP+1 - IREF(NP,1)=NSD1 - IREF(NP,2)=NSD2 - IREF(NP,3)=0 - IF(KFL3(JT).NE.0) IREF(NP,3)=NSD3 - IREF(NP,4)=IDOC+1 - IREF(NP,5)=IDOC+2 - IREF(NP,6)=0 - IF(KFL3(JT).NE.0) IREF(NP,6)=IDOC+3 - IREF(NP,7)=K(IREF(IP,JT),2) - IREF(NP,8)=IREF(IP,JT) - 670 CONTINUE - -C...Fill information for 2 -> 1 -> 2. - 680 IF(JTMAX.EQ.1.AND.KDCY(1).NE.0.AND.ISUB.NE.0) THEN - MINT(7)=MINT(83)+6+2*ISET(ISUB) - MINT(8)=MINT(83)+7+2*ISET(ISUB) - MINT(25)=KFL1(1) - MINT(26)=KFL2(1) - VINT(23)=CTHE(1) - RM3=P(N-1,5)**2/SH - RM4=P(N,5)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1)) - VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1)) - VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2) - VINT(47)=SQRT(VINT(48)) - ENDIF - -C...Possibility of colour rearrangement in W+W- events. - IF((ISUB.EQ.25.OR.ISUB.EQ.22).AND.MSTP(115).GE.1) THEN - IAKF1=IABS(KFL1(1)) - IAKF2=IABS(KFL1(2)) - IAKF3=IABS(KFL2(1)) - IAKF4=IABS(KFL2(2)) - IF(MIN(IAKF1,IAKF2,IAKF3,IAKF4).GE.1.AND. - & MAX(IAKF1,IAKF2,IAKF3,IAKF4).LE.5) CALL - & PYRECO(IREF(1,1),IREF(1,2),NSD(1),NAFT1) - ENDIF - -C...Loop back if needed. - 690 IF(IP.LT.NP) GOTO 150 - -C...Boost back to standard frame. - 700 IF(IBST.EQ.1) CALL PYROBO(MINT(83)+7,N,THEIN,PHIIN,BEXIN,BEYIN, - &BEZIN) - - RETURN - END - -C********************************************************************* - -C...PYR -C...Generates random numbers uniformly distributed between -C...0 and 1, excluding the endpoints. - -C FUNCTION PYR(IDUMMY) ! regular PYR - FUNCTION PYRXXXX(IDUMMY) ! dummy PYR, should be redefined (E.Chudakov) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Equivalence between commonblock and local variables. - EQUIVALENCE (MRPY1,MRPY(1)),(MRPY2,MRPY(2)),(MRPY3,MRPY(3)), - &(MRPY4,MRPY(4)),(MRPY5,MRPY(5)),(MRPY6,MRPY(6)), - &(RRPY98,RRPY(98)),(RRPY99,RRPY(99)),(RRPY00,RRPY(100)) - -C...Initialize generation from given seed. - IF(MRPY2.EQ.0) THEN - IJ=MOD(MRPY1/30082,31329) - KL=MOD(MRPY1,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=0D0 - T=0.5D0 - DO 100 JJ=1,48 - 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.5D0*T - 100 CONTINUE - RRPY(II)=S - 110 CONTINUE - TWOM24=1D0 - DO 120 I24=1,24 - TWOM24=0.5D0*TWOM24 - 120 CONTINUE - RRPY98=362436D0*TWOM24 - RRPY99=7654321D0*TWOM24 - RRPY00=16777213D0*TWOM24 - MRPY2=1 - MRPY3=0 - MRPY4=97 - MRPY5=33 - ENDIF - -C...Generate next random number. - 130 RUNI=RRPY(MRPY4)-RRPY(MRPY5) - IF(RUNI.LT.0D0) RUNI=RUNI+1D0 - RRPY(MRPY4)=RUNI - MRPY4=MRPY4-1 - IF(MRPY4.EQ.0) MRPY4=97 - MRPY5=MRPY5-1 - IF(MRPY5.EQ.0) MRPY5=97 - RRPY98=RRPY98-RRPY99 - IF(RRPY98.LT.0D0) RRPY98=RRPY98+RRPY00 - RUNI=RUNI-RRPY98 - IF(RUNI.LT.0D0) RUNI=RUNI+1D0 - IF(RUNI.LE.0D0.OR.RUNI.GE.1D0) GOTO 130 - -C...Update counters. Random number to output. - MRPY3=MRPY3+1 - IF(MRPY3.EQ.1000000000) THEN - MRPY2=MRPY2+1 - MRPY3=0 - ENDIF - PYR=RUNI - - RETURN - END - -C********************************************************************* - -C...PYRGET -C...Dumps the state of the random number generator on a file -C...for subsequent startup from this state onwards. - - SUBROUTINE PYRGET(LFN,MOVE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Local character variable. - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRPY(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=110,IOSTAT=IERR) - 100 CONTINUE - MRPY(6)=MRPY(6)-NBCK - ENDIF - -C...Unformatted write on unit LFN. - WRITE(LFN,ERR=110,IOSTAT=IERR) (MRPY(I1),I1=1,5), - &(RRPY(I2),I2=1,100) - MRPY(6)=MRPY(6)+1 - RETURN - -C...Write error. - 110 WRITE(CHERR,'(I8)') IERR - CALL PYERRM(18,'(PYRGET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - -C...PYRGHM -C...Auxiliary to PYPOLE. - - SUBROUTINE PYRGHM(MCHI,MA,TANB,MQ,MUR,MD,MTOP,AU,AD,MU, - * MHP,HMP,MCH,SA,CA,SAB,CAB,TANBA,MGLU,DELTAMT,DELTAMB) - IMPLICIT DOUBLE PRECISION(A-H,L,M,O-Z) - DIMENSION VH(2,2),M2(2,2),M2P(2,2) -C...Parameters. - INTEGER MSTU,MSTJ - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - MZ = 91.18D0 - PI = PARU(1) - V = 174.1D0 - ALPHA1 = 0.0101D0 - ALPHA2 = 0.0337D0 - ALPHA3Z = 0.12D0 - TANBA = TANB - TANBT = TANB -C MBOTTOM(MTOP) = 3. GEV - MB = PYMRUN(5,MTOP**2) - ALPHA3 = ALPHA3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPHA3Z* - *LOG(MTOP**2/MZ**2)) -C RMTOP= RUNNING TOP QUARK MASS - RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) - TQ = LOG((MQ**2+MTOP**2)/MTOP**2) - TU = LOG((MUR**2 + MTOP**2)/MTOP**2) - TD = LOG((MD**2 + MTOP**2)/MTOP**2) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C NEW DEFINITION, TGLU. -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - TGLU = LOG(MGLU**2/MTOP**2) - SINB = TANB/DSQRT(1D0 + TANB**2) - COSB = SINB/TANB - IF(MA.GT.MTOP) - *TANBA = TANB*(1D0-3D0/32D0/PI**2* - *(RMTOP**2/V**2/SINB**2-MB**2/V**2/COSB**2)* - *LOG(MA**2/MTOP**2)) - IF(MA.LT.MTOP.OR.MA.EQ.MTOP) TANBT = TANBA - SINB = TANBT/SQRT(1D0 + TANBT**2) - COSB = 1D0/DSQRT(1D0 + TANBT**2) - G1 = SQRT(ALPHA1*4D0*PI) - G2 = SQRT(ALPHA2*4D0*PI) - G3 = SQRT(ALPHA3*4D0*PI) - HU = RMTOP/V/SINB - HD = MB/V/COSB - CALL PYGFXX(MA,TANBA,MQ,MUR,MD,MTOP,AU,AD,MU,MGLU,VH,STOP1,STOP2, - *SBOT1,SBOT2,DELTAMT,DELTAMB) - IF(MQ.GT.MUR) TP = TQ - TU - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TP = TU - TQ - IF(MQ.GT.MUR) TDP = TU - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TDP = TQ - IF(MQ.GT.MD) TPD = TQ - TD - IF(MQ.LT.MD.OR.MQ.EQ.MD) TPD = TD - TQ - IF(MQ.GT.MD) TDPD = TD - IF(MQ.LT.MD.OR.MQ.EQ.MD) TDPD = TQ - - IF(MQ.GT.MD) DLAMBDA1 = 6D0/96D0/PI**2*G1**2*HD**2*TPD - IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA1 = 3D0/32D0/PI**2* - * HD**2*(G1**2/3D0+G2**2)*TPD - - IF(MQ.GT.MUR) DLAMBDA2 =12D0/96D0/PI**2*G1**2*HU**2*TP - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA2 = 3D0/32D0/PI**2* - * HU**2*(-G1**2/3D0+G2**2)*TP - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C DLAMBDAP1 AND DLAMBDAP2 ARE THE NEW LOG CORRECTIONS DUE TO -C THE PRESENCE OF THE GLUINO MASS. THEY ARE IN GENERAL VERY SMALL, -C AND ONLY PRESENT IF THERE IS A HIERARCHY OF MASSES BETWEEN THE -C TWO STOPS. -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DLAMBDAP2 = 0D0 - IF(MGLU.LT.MUR.OR.MGLU.LT.MQ) THEN - IF(MQ.GT.MUR.AND.MGLU.GT.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TGLU**2) - ENDIF - - IF(MQ.GT.MUR.AND.MGLU.LT.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) - ENDIF - - IF(MQ.GT.MUR.AND.MGLU.EQ.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.GT.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TGLU**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.LT.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.EQ.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) - ENDIF - ENDIF - DLAMBDA3 = 0D0 - DLAMBDA4 = 0D0 - IF(MQ.GT.MD) DLAMBDA3 = -1D0/32D0/PI**2*G1**2*HD**2*TPD - IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA3 = 3D0/64D0/PI**2*HD**2* - *(G2**2-G1**2/3D0)*TPD - IF(MQ.GT.MUR) DLAMBDA3 = DLAMBDA3 - - *1D0/16D0/PI**2*G1**2*HU**2*TP - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA3 = DLAMBDA3 + - * 3D0/64D0/PI**2*HU**2*(G2**2+G1**2/3D0)*TP - IF(MQ.LT.MUR) DLAMBDA4 = -3D0/32D0/PI**2*G2**2*HU**2*TP - IF(MQ.LT.MD) DLAMBDA4 = DLAMBDA4 - 3D0/32D0/PI**2*G2**2* - *HD**2*TPD - LAMBDA1 = ((G1**2 + G2**2)/4D0)* - * (1D0-3D0*HD**2*(TPD + TDPD)/8D0/PI**2) - *+(3D0*HD**4D0/16D0/PI**2) *TPD*(1D0 - *+ (3D0*HD**2/2D0 + HU**2/2D0 - *- 8D0*G3**2) * (TPD + 2D0*TDPD)/16D0/PI**2) - *+(3D0*HD**4D0/8D0/PI**2) *TDPD*(1D0 + (3D0*HD**2/2D0 + HU**2/2D0 - *- 8D0*G3**2) * TDPD/16D0/PI**2) + DLAMBDA1 - LAMBDA2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU**2* - *(TP + TDP)/8D0/PI**2) - *+(3D0*HU**4D0/16D0/PI**2) *TP*(1D0 - *+ (3D0*HU**2/2D0 + HD**2/2D0 - *- 8D0*G3**2) * (TP + 2D0*TDP)/16D0/PI**2) - *+(3D0*HU**4D0/8D0/PI**2) *TDP*(1D0 + (3D0*HU**2/2D0 + HD**2/2D0 - *- 8D0*G3**2) * TDP/16D0/PI**2) + DLAMBDA2 + DLAMBDAP2 - LAMBDA3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* - *(HU**2)*(TP + TDP)/16D0/PI**2 -3D0* - *(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA3 - LAMBDA4 = (- G2**2/2D0)*(1D0 - *-3D0*(HU**2)*(TP + TDP)/16D0/PI**2 - *-3D0*(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA4 - - LAMBDA5 = 0D0 - LAMBDA6 = 0D0 - LAMBDA7 = 0D0 - - M2(1,1) = 2D0*V**2*(LAMBDA1*COSB**2+2D0*LAMBDA6* - *COSB*SINB + LAMBDA5*SINB**2) + MA**2*SINB**2 - - M2(2,2) = 2D0*V**2*(LAMBDA5*COSB**2+2D0*LAMBDA7* - *COSB*SINB + LAMBDA2*SINB**2) + MA**2*COSB**2 - M2(1,2) = 2D0*V**2*(LAMBDA6*COSB**2+(LAMBDA3+LAMBDA4)* - *COSB*SINB + LAMBDA7*SINB**2) - MA**2*SINB*COSB - - M2(2,1) = M2(1,2) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC THIS IS THE CONTRIBUTION FROM LIGHT CHARGINOS/NEUTRALINOS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - MSSUSY=DSQRT(.5D0*(MQ**2+MUR**2)+MTOP**2) - - IF(MCHI.GT.MSSUSY) GOTO 100 - IF(MCHI.LT.MTOP) MCHI=MTOP - - TCHAR=LOG(MSSUSY**2/MCHI**2) - - DELTAL12=(9D0/64D0/PI**2*G2**4+5D0/192D0/PI**2*G1**4)*TCHAR - DELTAL3P4=(3D0/64D0/PI**2*G2**4+7D0/192D0/PI**2*G1**4 - *+4D0/32D0/PI**2*G1**2*G2**2)*TCHAR - - DELTAM112=2D0*DELTAL12*V**2*COSB**2 - DELTAM222=2D0*DELTAL12*V**2*SINB**2 - DELTAM122=2D0*DELTAL3P4*V**2*SINB*COSB - - M2(1,1)=M2(1,1)+DELTAM112 - M2(2,2)=M2(2,2)+DELTAM222 - M2(1,2)=M2(1,2)+DELTAM122 - M2(2,1)=M2(2,1)+DELTAM122 - - 100 CONTINUE - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC END OF CHARGINOS/NEUTRALINOS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 120 I = 1,2 - DO 110 J = 1,2 - M2P(I,J) = M2(I,J) + VH(I,J) - 110 CONTINUE - 120 CONTINUE - TRM2P = M2P(1,1) + M2P(2,2) - DETM2P = M2P(1,1)*M2P(2,2) - M2P(1,2)*M2P(2,1) - MH2P = (TRM2P - DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 - HM2P = (TRM2P + DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 - HMP = DSQRT(HM2P) - MCH2=MA**2+(LAMBDA5-LAMBDA4)*V**2 - MCH=DSQRT(MCH2) - IF(MH2P.LT.0.) GOTO 130 - MHP = SQRT(MH2P) - SIN2ALPHA = 2D0*M2P(1,2)/SQRT(TRM2P**2-4D0*DETM2P) - COS2ALPHA = (M2P(1,1)-M2P(2,2))/SQRT(TRM2P**2-4D0*DETM2P) - IF(COS2ALPHA.GE.0.) THEN - ALPHA = ASIN(SIN2ALPHA)/2D0 - ELSE - ALPHA = -PI/2D0-ASIN(SIN2ALPHA)/2D0 - ENDIF - SA = SIN(ALPHA) - CA = COS(ALPHA) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE THE VALUES OF SAB AND CAB ARE DEFINED, IN ORDER -C TO DEFINE THE NEW COUPLINGS OF THE LIGHTEST AND -C HEAVY CP-EVEN HIGGS TO THE BOTTOM QUARK. -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - SAB = SA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0+CA/SA/TANB)) - CAB = CA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0-SA/CA/TANB)) - 130 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYRNM3 -C...Calculates the running of M3, the SU(3) gluino mass parameter. - - FUNCTION PYRNM3(RGUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION R - DOUBLE PRECISION TOL - EXTERNAL PYALPS - DOUBLE PRECISION PYALPS - DATA TOL/0.001D0/ - DATA R/0.61803399D0/ - - C=1D0-R - - BX=RGUT*PYALPS(RGUT**2) - AX=MIN(50D0,BX*0.5D0) - CX=MAX(2000D0,2D0*BX) - - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - AS1=PYALPS(X1**2) - F1=ABS(X1-RGUT*AS1) - AS2=PYALPS(X2**2) - F2=ABS(X2-RGUT*AS2) - 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN - IF(F2.LT.F1) THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - AS2=PYALPS(X2**2) - F2=ABS(X2-RGUT*AS2) - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - AS1=PYALPS(X1**2) - F1=ABS(X1-RGUT*AS1) - ENDIF - GOTO 100 - ENDIF - IF(F1.LT.F2) THEN - PYRNM3=X1 - XMIN=X1 - ELSE - PYRNM3=X2 - XMIN=X2 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRNMQ -C...Determines the running mass of Squarks. - - FUNCTION PYRNMQ(ID,DTERM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYMSSM/ - -C...Local variables. - DOUBLE PRECISION PI,R - DOUBLE PRECISION TOL - DOUBLE PRECISION CI(3) - EXTERNAL PYALPS - DOUBLE PRECISION PYALPS - DATA TOL/0.001D0/ - DATA PI,R/3.141592654D0,.61803399D0/ - DATA CI/0.47D0,0.07D0,0.02D0/ - - C=1D0-R - CA=CI(ID) - AG=(0.71D0)**2/4D0/PI - AG=RMSS(20) - XM0=RMSS(8) - XMG=RMSS(1) - XM02=XM0*XM0 - XMG2=XMG*XMG - - AS=PYALPS(XM02+6D0*XMG2) - CG=8D0/9D0*((AS/AG)**2-1D0) - BX=XM02+(CA+CG)*XMG2+DTERM - AX=MIN(50D0**2,0.5D0*BX) - CX=MAX(2000D0**2,2D0*BX) - - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - AS1=PYALPS(X1) - CG=8D0/9D0*((AS1/AG)**2-1D0) - F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) - AS2=PYALPS(X2) - CG=8D0/9D0*((AS2/AG)**2-1D0) - F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) - 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN - IF(F2.LT.F1) THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - AS2=PYALPS(X2) - CG=8D0/9D0*((AS2/AG)**2-1D0) - F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - AS1=PYALPS(X1) - CG=8D0/9D0*((AS1/AG)**2-1D0) - F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) - ENDIF - GOTO 100 - ENDIF - IF(F1.LT.F2) THEN - PYRNMQ=X1 - XMIN=X1 - ELSE - PYRNMQ=X2 - XMIN=X2 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYROBO -C...Performs rotations and boosts. - - SUBROUTINE PYROBO(IMI,IMA,THE,PHI,BEX,BEY,BEZ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) - -C...Find and check range of rotation/boost. - IMIN=IMI - IF(IMIN.LE.0) IMIN=1 - IF(MSTU(1).GT.0) IMIN=MSTU(1) - IMAX=IMA - IF(IMAX.LE.0) IMAX=N - IF(MSTU(2).GT.0) IMAX=MSTU(2) - IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN - CALL PYERRM(11,'(PYROBO:) range outside PYJETS memory') - RETURN - ENDIF - -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)=0D0 - 100 CONTINUE - 110 CONTINUE - MSTU(33)=0 - ENDIF - -C...Rotate, typically from z axis to direction (theta,phi). - IF(THE**2+PHI**2.GT.1D-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)=0D0 - ROT(3,3)=COS(THE) - DO 140 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 140 - DO 120 J=1,3 - PR(J)=P(I,J) - VR(J)=V(I,J) - 120 CONTINUE - DO 130 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) - 130 CONTINUE - 140 CONTINUE - ENDIF - -C...Boost, typically from rest to momentum/energy=beta. - IF(BEX**2+BEY**2+BEZ**2.GT.1D-20) THEN - DBX=BEX - DBY=BEY - DBZ=BEZ - DB=SQRT(DBX**2+DBY**2+DBZ**2) - EPS1=1D0-1D-12 - IF(DB.GT.EPS1) THEN -C...Rescale boost vector if too close to unity. - CALL PYERRM(3,'(PYROBO:) boost vector too large') - DBX=DBX*(EPS1/DB) - DBY=DBY*(EPS1/DB) - DBZ=DBZ*(EPS1/DB) - DB=EPS1 - ENDIF - DGA=1D0/SQRT(1D0-DB**2) - DO 160 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 160 - DO 150 J=1,4 - DP(J)=P(I,J) - DV(J)=V(I,J) - 150 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) - 160 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRSET -C...Reads a state of the random number generator from a file -C...for subsequent generation from this state onwards. - - SUBROUTINE PYRSET(LFN,MOVE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Local character variable. - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRPY(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=120,IOSTAT=IERR) - 100 CONTINUE - MRPY(6)=MRPY(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) (MRPY(I1),I1=1,5), - & (RRPY(I2),I2=1,100) - 110 CONTINUE - MRPY(6)=MRPY(6)+NFOR - RETURN - -C...Write error. - 120 WRITE(CHERR,'(I8)') IERR - CALL PYERRM(18,'(PYRSET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - -C...PYRVCH -C...Calculates R-violating chargino decay widths. -C...P. Z. Skands - - SUBROUTINE PYRVCH(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP -C...Information from main routine to PYRVGW - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) -C...Auxiliary variables needed for BV (RV Gauge STOre) - COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ - & ,RVLJKI,RVLJIK -C...Running quark masses - DOUBLE PRECISION RMQ(6) -C...Decay product masses on/off - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, - & /RVGSTO/ - - -C...IF R-VIOLATION ON. - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN - KFSM=KFIN-KSUSY1 - IF(KFSM.EQ.24.OR.KFSM.EQ.37) THEN -C...WHICH CHARGINO ? - NCHI = 1 - IF (KFSM.EQ.37) NCHI = 2 - -C...Useful parameters for calculating the A and B constants. -C...SIGN OF MASS (Opposite convention as HERWIG) - ISM = 1 - IF (SMW(NCHI).LT.0D0) ISM = -1 - WMASS = PMAS(PYCOMP(24),1) - COSB = 1/(SQRT(1+RMSS(5)**2)) - SINB = RMSS(5)/SQRT(1+RMSS(5)**2) - GW2 = 4*PARU(103)*PARU(1)/PARU(102) - C1U = UMIX(NCHI,2)/(SQRT(2D0)*COSB*WMASS) - C1V = VMIX(NCHI,2)/(SQRT(2D0)*SINB*WMASS) - C2 = UMIX(NCHI,1) - C3 = VMIX(NCHI,1) -C...Running masses at Q^2=MCHI^2. - SQMCHI = PMAS(PYCOMP(KFSM),1)**2 - DO 100 I=1,6 - RMQ(I)=PYMRUN(I,SQMCHI) - 100 CONTINUE - -C... AB(x,y,z) coefficients: -C x=1-2 : A or B coefficient (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,...) -C z=1-2 : Mass eigenstate number - DO 110 I = 11,15,2 -C...Intermediate sleptons - AB(1,I,1) = 0D0 - AB(1,I,2) = 0D0 - AB(2,I,1) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,2) + - & SFMIX(I,1)*C2 - AB(2,I,2) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,4) + - & SFMIX(I,3)*C2 -C...Intermediate sneutrinos - AB(1,I+1,1) = -PMAS(PYCOMP(I),1)*C1U - AB(1,I+1,2) = 0D0 - AB(2,I+1,1) = ISM*C3 - AB(2,I+1,2) = 0D0 -C...Intermediate sdown - J=I-10 - AB(1,J,1) = -RMQ(J+1)*C1V*SFMIX(J,1) - AB(1,J,2) = -RMQ(J+1)*C1V*SFMIX(J,3) - AB(2,J,1) = -ISM*(RMQ(J)*C1U*SFMIX(J,2) - SFMIX(J,1)*C2) - AB(2,J,2) = -ISM*(RMQ(J)*C1U*SFMIX(J,4) - SFMIX(J,3)*C2) -C...Intermediate sup - J=J+1 - AB(1,J,1) = -RMQ(J-1)*C1U*SFMIX(J,1) - AB(1,J,2) = -RMQ(J-1)*C1U*SFMIX(J,3) - AB(2,J,1) = -ISM*(RMQ(J)*C1V*SFMIX(J,2) - SFMIX(J,1)*C3) - AB(2,J,2) = -ISM*(RMQ(J)*C1V*SFMIX(J,4) - SFMIX(J,3)*C3) - 110 CONTINUE - -C...LLE TYPE R-VIOLATION - IF (IMSS(51).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 140 ISC=0,26 - -C...CHI+ -> NUBAR_I + LEPTON+_J + NU_K. - IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 12 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K). - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = -IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> NU_I + NU_J + LEPTON+_K. (NOTE: SYMM. IN I AND J) - 120 IF (MOD(ISC/9,3).LT.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 12 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) =-11 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 -C...I,J SYMMETRY => FACTOR 2 - RVLAMC=2*RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,3).EQ.-15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=IDLAM(LKNT,1)-1 - KFR(2)=IDLAM(LKNT,2)-1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 130 ENDIF - -C * CHI+ -> LEPTON+_I + LEPTON+_J + LEPTON-_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 -C...I,J SYMMETRY => FACTOR 2 - RVLAMC=2*RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-15 - & .OR.IDLAM(LKNT,3).EQ.15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) =-IDLAM(LKNT,1)+1 - KFR(2) =-IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 140 CONTINUE - ENDIF - -C...LQD TYPE R-VIOLATION - IF (IMSS(52).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 180 ISC=0,26 - -C...CHI+ -> NUBAR_I + DBAR_J + U_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.6) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=0 - KFR(2)=0 - KFR(3)=-IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> LEPTON+_I + UBAR_J + U_K. - 150 LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-11.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.6) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=0 - KFR(2)=0 - KFR(3)=-IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> LEPTON+_I + DBAR_J + D_K. - 160 LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1)+1 - KFR(2)=-IDLAM(LKNT,2)+1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> NU_I + U_J + DBAR_K. - 170 LKNT = LKNT+1 - IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - DCMASS = .FALSE. - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - IF (IDLAM(LKNT,2).EQ.6.OR.IDLAM(LKNT,3).EQ.-5) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=IDLAM(LKNT,1)-1 - KFR(2)=IDLAM(LKNT,2)-1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - - 180 CONTINUE - ENDIF - -C...UDD TYPE R-VIOLATION -C...These decays need special treatment since more than one BV coupling -C...contributes (with interference). Consider e.g. (symbolically) -C |M|^2 = |l''_{ijk}|^2*(PYRVI1(RES_I) + PYRVI2(RES_I)) -C +|l''_{jik}|^2*(PYRVI1(RES_J) + PYRVI2(RES_J)) -C +l''_{ijk}*l''_{jik}*PYRVI3(PYRVI4(RES_I,RES_J)) -C...The problem is that a single call to PYRVGW would evaluate all -C...these terms and sum them, but without the different couplings. The -C...way out is to call PYRVGW three times, once for the first line, once -C...for the second line, and then once for all the lines (it is -C...impossible to get just the last line out) without multiplying by -C...couplings. The last line is then obtained as the result of the third -C...call minus the results of the two first calls. Each term is then -C...multiplied by its respective coupling before the whole thing is -C...summed up in XLAM. -C...Note that with three interfering resonances, this procedure becomes -C...more complicated, as can be seen in the CHI+ -> 3*DBAR mode. - - IF (IMSS(53).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 190 ISC=1,25 - -C...CHI+ -> U_I + U_J + D_K -C...Decay mode I<->J symmetric. - IF (MOD(ISC/9,3).LE.MOD(ISC/3,3).AND.ISC.NE.13) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = 2 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC= 6. * GW2 * 5D-1 - RVLJIK= RVLAMB(MOD(ISC/3,3)+1,MOD(ISC/9,3)+1,MOD(ISC,3) - & +1) - RVLIJK= RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) - & +1) - IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3)) RVLAMC = 5D-1 - & * RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.6.OR.IDLAM(LKNT,2).EQ.6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS =.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = -IDLAM(LKNT,1)+1 - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = -IDLAM(LKNT,1)+1 - KFR(2) = -IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIJ) - IF (ABS((XRESI+XRESJ)/XRESIJ-1.).GT.1D-4) THEN - XRESIJ = XRESIJ-XRESI-XRESJ - ELSE - XRESIJ = 0D0 - ENDIF -C...CALCULATE TOTAL WIDTH - XLAM(LKNT) = RVLJIK**2 * XRESI + RVLIJK**2 * XRESJ - & + RVLJIK*RVLIJK * XRESIJ - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF -C...CHI+ -> DBAR_I + DBAR_J + DBAR_K -C...Symmetry I<->J<->K. - IF ((MOD(ISC/9,3).LE.MOD(ISC/3,3)).AND.(MOD(ISC/3,3).LE - & .MOD(ISC,3)).AND.ISC.NE.13) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -1 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 6. * GW2 * 5D-1 - RVLIJK = RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) - & +1) - RVLKIJ = RVLAMB(MOD(ISC,3)+1,MOD(ISC/9,3)+1,MOD(ISC/3,3) - & +1) - RVLJKI = RVLAMB(MOD(ISC/3,3)+1,MOD(ISC,3)+1,MOD(ISC/9,3) - & +1) - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-5.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS = .TRUE. -C...Collect symmetry factors - IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3).OR.MOD(ISC/3,3).EQ - & .MOD(ISC,3).OR.MOD(ISC/9,3).EQ.MOD(ISC,3)) - & RVLAMC = 5D-1 * RVLAMC -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESK) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIJ) - IF (ABS(XRESIJ/(XRESI+XRESJ)-1.).GT.1D-4) THEN - XRESIJ = XRESI+XRESJ-XRESIJ - ELSE - XRESIJ = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJK) - IF (ABS(XRESJK/(XRESJ+XRESK)-1.).GT.1D-4) THEN - XRESJK = XRESJ+XRESK-XRESJK - ELSE - XRESJK = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIK) - IF (ABS(XRESIK/(XRESI+XRESK)-1.).GT.1D-4) THEN - XRESIK = XRESI+XRESK-XRESIK - ELSE - XRESIK = 0D0 - ENDIF -C...CALCULATE TOTAL WIDTH - XLAM(LKNT) = - & RVLIJK**2 * XRESI - & + RVLJKI**2 * XRESJ - & + RVLKIJ**2 * XRESK - & + RVLIJK*RVLJKI * XRESIJ - & + RVLIJK*RVLKIJ * XRESIK - & + RVLJKI*RVLKIJ * XRESJK - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2.*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 190 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRVG1 -C...Integrand for resonance contributions - - FUNCTION PYRVG1(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY,PYRVR - DOUBLE PRECISION RVR,PYRVG1,E2,E3,C1,SR1,SR2,A1,A2 - LOGICAL MFLAG - SAVE/PYRVPM/ - RVR = PYRVR(X,RESM(1),RESW(1)) - C1 = 2D0*SQRT(MAX(0D0,X)) - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - DELTAY = 4D0*E2*E3 - PYRVG1 = DELTAY*RVR*X*(A(1)**2+B(1)**2)*(RM(0)**2-X) - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - DELTAY = 4D0*SR1*SR2 - A1 = 4.*A(1)*B(1)*RM(3)*RM(0) - A2 = (A(1)**2+B(1)**2)*(RM(0)**2+RM(3)**2-X) - PYRVG1 = DELTAY*RVR*(X-RM(1)**2-RM(2)**2)*(A1+A2) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVG2 -C...Integrand for L-R interference contributions - - FUNCTION PYRVG2(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY, PYRVS - DOUBLE PRECISION RVS,PYRVG2,E2,E3,C1,SR1,SR2 - LOGICAL MFLAG - SAVE/PYRVPM/ - C1 = 2D0*SQRT(MAX(0D0,X)) - RVS = PYRVS(X,X,RESM(1),RESW(1),RESM(2),RESW(2)) - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - DELTAY = 4D0*E2*E3 - PYRVG2 = DELTAY*RVS*X*(A(1)*A(2)+B(1)*B(2))*(RM(0)**2-X) - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - DELTAY = 4D0*SR1*SR2 - PYRVG2 = DELTAY*RVS*(X-RM(1)**2-RM(2)**2)*((A(1)*A(2) - & + B(1)*B(2))*(RM(0)**2+RM(3)**2-X) - & + 2D0*(A(1)*B(2)+A(2)*B(1))*RM(3)*RM(0)) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVG3 -C...Function to do Y integration over true interference contributions - - FUNCTION PYRVG3(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG -C...Second Dalitz variable for PYRVG4 - COMMON/PYG2DX/X1 - DOUBLE PRECISION RM, A, B, RESM, RESW, X, X1 - DOUBLE PRECISION E2, E3, C1, SQ1, SR1, SR2, YMIN, YMAX - DOUBLE PRECISION PYRVG3, PYRVG4, PYGAU2 - LOGICAL MFLAG - EXTERNAL PYGAU2,PYRVG4 - SAVE/PYRVPM/,/PYG2DX/ - PYRVG3=0D0 - C1=2D0*SQRT(MAX(1D-9,X)) - X1=X - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - YMIN = 0D0 - YMAX = 4D0*E2*E3 - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SQ1 = (E2+E3)**2 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - YMIN = SQ1-(SR1+SR2)**2 - YMAX = SQ1-(SR1-SR2)**2 - ENDIF - PYRVG3 = PYGAU2(PYRVG4,YMIN,YMAX,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVG4 -C...Integrand for true intereference contributions - - FUNCTION PYRVG4(Y) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - COMMON/PYG2DX/X - DOUBLE PRECISION X, Y, PYRVG4, RM, A, B, RESM, RESW, RVS, PYRVS - LOGICAL MFLAG - SAVE /PYRVPM/,/PYG2DX/ - PYRVG4=0D0 - RVS=PYRVS(X,Y,RESM(1),RESW(1),RESM(2),RESW(2)) - IF (.NOT.MFLAG) THEN - PYRVG4 = RVS*B(1)*B(2)*X*Y - ELSE - PYRVG4 = RVS*(RM(1)*RM(3)*A(1)*A(2)*(X+Y-RM(1)**2-RM(3)**2) - & + RM(1)*RM(0)*B(1)*A(2)*(Y-RM(2)**2-RM(3)**2) - & + RM(3)*RM(0)*A(1)*B(2)*(X-RM(1)**2-RM(2)**2) - & + B(1)*B(2)*(X*Y-(RM(1)*RM(3))**2-(RM(0)*RM(2))**2)) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVGL -C...Calculates R-violating gluino decay widths. -C...See BV part of PYRVCH for comments about the way the BV decay width -C...is calculated. Same comments apply here. -C...P. Z. Skands - - SUBROUTINE PYRVGL(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP -C...Information from main routine to PYRVGW - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) -C...Auxiliary variables needed for BV (RV Gauge STOre) - COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ - & ,RVLJKI,RVLJIK -C...Running quark masses - DOUBLE PRECISION RMQ(6) -C...Decay product masses on/off - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, - & /RVGSTO/ - -C...IF LQD OR UDD TYPE R-VIOLATION ON. - IF (IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - KFSM=KFIN-KSUSY1 - -C... AB(x,y,z): -C x=1-2 : Select A or B coupling (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,... not used here) -C z=1-2 : Mass eigenstate number - DO 100 I = 1,6 -C...A Couplings - AB(1,I,1) = SFMIX(I,2) - AB(1,I,2) = SFMIX(I,4) -C...B Couplings - AB(2,I,1) = -SFMIX(I,1) - AB(2,I,2) = -SFMIX(I,3) - 100 CONTINUE - GSTR2 = 4D0*PARU(1) * PYALPS(PMAS(PYCOMP(KFIN),1)**2) -C...LQD DECAYS. - IF (IMSS(52).GE.1) THEN -C...STEP IN I,J,K USING SINGLE COUNTER - DO 120 ISC=0,26 -C * GLUINO -> NUBAR_I + DBAR_J + D_K. - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off - RVLAMC=RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - & * 5D-1 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2) - KFR(3) = -IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) -C...Normalize - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - 110 LKNT = LKNT+1 - IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) - IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) - IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - -C * GLUINO -> LEPTON+_I + UBAR_J + D_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2* 5D-1 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2) - KFR(3) = -IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1) = -IDLAM(LKNT-1,1) - IDLAM(LKNT,2) = -IDLAM(LKNT-1,2) - IDLAM(LKNT,3) = -IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - - 120 CONTINUE - ENDIF - -C...UDD DECAYS. - IF (IMSS(53).GE.1) THEN -C...STEP IN I,J,K USING SINGLE COUNTER - DO 130 ISC=0,26 -C * GLUINO -> UBAR_I + DBAR_J + DBAR_K. - IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off. A factor of 2 for -C...(N_C-1) has been used to cancel a factor 0.5. - RVLAMC=RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2) - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESK) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = IDLAM(LKNT,2) - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESIJ) -C...Calculate interference function. (Factor -1/2 to make up for factor -C...-2 in PYRVGW. - IF (ABS((XRESI+XRESJ)/XRESIJ-1D0).GT.1D-4) THEN - XRESIJ = 5D-1 * (XRESI+XRESJ-XRESIJ) - ELSE - XRESIJ = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2) - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESJK) - IF (ABS((XRESJ+XRESK)/XRESJK-1).GT.1D-4) THEN - XRESJK = 5D-1 * (XRESJ+XRESK-XRESJK) - ELSE - XRESJK = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESIK) - IF (ABS((XRESI+XRESK)/XRESIK-1).GT.1D-4) THEN - XRESIK = 5D-1 * (XRESI+XRESK-XRESIK) - ELSE - XRESIK = 0D0 - ENDIF -C...Calculate total width (factor 1/2 from 1/(N_C-1)) - XLAM(LKNT) = XRESI + XRESJ + XRESK - & + 5D-1 * (XRESIJ + XRESIK + XRESJK) -C...Normalize - XLAM(LKNT) = XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT = LKNT+1 - IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) - IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) - IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVGW -C...Generalized Matrix Element for R-Violating 3-body widths. -C...P. Z. Skands - SUBROUTINE PYRVGW(KFIN,ID1,ID2,ID3,XLAM) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - IMPLICIT INTEGER (I-N) - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - PARAMETER (EPS=1D-4) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - & SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - DOUBLE PRECISION XLIM(3,3) - INTEGER KC(0:3), PYCOMP - LOGICAL DCMASS, DCHECK(6) - SAVE /PYDAT2/,/PYRVNV/,/PYSSMT/ - - XLAM = 0D0 - - KC(0) = PYCOMP(KFIN) - KC(1) = PYCOMP(ID1) - KC(2) = PYCOMP(ID2) - KC(3) = PYCOMP(ID3) - RMS(0) = PMAS(KC(0),1) - RMS(1) = PYMRUN(ID1,PMAS(KC(1),1)**2) - RMS(2) = PYMRUN(ID2,PMAS(KC(2),1)**2) - RMS(3) = PYMRUN(ID3,PMAS(KC(3),1)**2) -C...INITIALIZE OUTER INTEGRATION LIMITS AND KINEMATICS CHECK - XLIM(1,1)=(RMS(1)+RMS(2))**2 - XLIM(1,2)=(RMS(0)-RMS(3))**2 - XLIM(1,3)=XLIM(1,2)-XLIM(1,1) - XLIM(2,1)=(RMS(2)+RMS(3))**2 - XLIM(2,2)=(RMS(0)-RMS(1))**2 - XLIM(2,3)=XLIM(2,2)-XLIM(2,1) - XLIM(3,1)=(RMS(1)+RMS(3))**2 - XLIM(3,2)=(RMS(0)-RMS(2))**2 - XLIM(3,3)=XLIM(3,2)-XLIM(3,1) -C...Check Phase Space - IF (XLIM(1,3).LT.0D0.OR.XLIM(2,3).LT.0D0.OR.XLIM(3,3).LT.0D0) THEN - RETURN - ENDIF - -C...INITIALIZE RESONANCE INFORMATION - DO 110 JRES = 1,3 - DO 100 IMASS = 1,2 - IRES = 2*(JRES-1)+IMASS - INTRES(IRES,1) = 0 - DCHECK(IRES) =.FALSE. -C...NO RIGHT-HANDED NEUTRINOS - IF (((IMASS.EQ.2).AND.((IABS(KFR(JRES)).EQ.12).OR - & .(IABS(KFR(JRES)).EQ.14).OR.(IABS(KFR(JRES)).EQ.16))).OR - & .KFR(JRES).EQ.0) GOTO 100 - RES(IRES,1) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),1) - RES(IRES,2) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),2) - INTRES(IRES,1) = IABS(KFR(JRES)) - INTRES(IRES,2) = IMASS - IF (KFR(JRES).LT.0) INTRES(IRES,3) = 1 - IF (KFR(JRES).GT.0) INTRES(IRES,3) = 0 - 100 CONTINUE - 110 CONTINUE - -C...SUM OVER DIAGRAMS AND INTEGRATE OVER PHASE SPACE - -C...RESONANCE CONTRIBUTIONS -C...(Only sum contributions where the resonance is off shell). -C...Store whether diagram on/off in DCHECK. -C...LOOP OVER MASS STATES - DO 120 J=1,2 - IDR=J - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(1)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(2) - & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(2,3,1) - ENDIF - - IDR=J+2 - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(2)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) - & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(1,3,2) - ENDIF - - IDR=J+4 - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(3)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) - & +RMS(2)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(1,2,3) - ENDIF - 120 CONTINUE -C... L-R INTERFERENCES -C... (Only add contributions where both contributing diagrams -C... are non-resonant). - IDR=1 - IF (DCHECK(1).AND.DCHECK(2)) THEN -C...Bug corrected 11/12 2001. Skands. - XLAM = XLAM + 2D0 * PYRVI2(2,3,1) - & * SFMIX(INTRES(1,1),2+INTRES(1,3)-1) - & * SFMIX(INTRES(2,1),4+INTRES(2,3)-1) - ENDIF - - IDR=3 - IF (DCHECK(3).AND.DCHECK(4)) THEN - XLAM = XLAM + 2D0 * PYRVI2(1,3,2) - & * SFMIX(INTRES(3,1),2+INTRES(3,3)-1) - & * SFMIX(INTRES(4,1),4+INTRES(4,3)-1) - ENDIF - - IDR=5 - IF (DCHECK(5).AND.DCHECK(6)) THEN - XLAM = XLAM + 2D0 * PYRVI2(1,2,3) - & * SFMIX(INTRES(5,1),2+INTRES(5,3)-1) - & * SFMIX(INTRES(6,1),4+INTRES(6,3)-1) - ENDIF -C... TRUE INTERFERENCES -C... (Only add contributions where both contributing diagrams -C... are non-resonant). - PREF=-2D0 - IF ((KFIN-KSUSY1).EQ.24.OR.(KFIN-KSUSY1).EQ.37) PREF=2D0 - DO 140 IKR1 = 1,2 - DO 130 IKR2 = 1,2 - IDR = IKR1+2 - IDR2 = IKR2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(1,3,2) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - - IDR = IKR1+4 - IDR2 = IKR2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(1,2,3) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - - IDR = IKR1+4 - IDR2 = IKR2+2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(2,1,3) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - 130 CONTINUE - 140 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYRVI1 -C...Function to integrate resonance contributions - - FUNCTION PYRVI1(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI1,PYRVG1,PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG1,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI1 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) -C...A->B and B->A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) -C...Integration boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI1 = PYGAUS(PYRVG1,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVI2 -C...Function to integrate L-R interference contributions - - FUNCTION PYRVI2(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI2, PYRVG2, PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG2,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI2 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) - RESM(2)= RES(IDR+1,1) - RESW(2)= RES(IDR+1,2) -C...A->B and B->A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - A(2) = AB(1+INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) - B(2) = AB(2-INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) -C...Boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI2 = PYGAUS(PYRVG2,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVI3 -C...Function to integrate true interference contributions - - FUNCTION PYRVI3(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI3, PYRVG3, PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG3,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI3 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) - RESM(2)= RES(IDR2,1) - RESW(2)= RES(IDR2,2) -C...A -> B and B -> A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - A(2) = AB(1+INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) - B(2) = AB(2-INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) -C...Boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI3 = PYGAUS(PYRVG3,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVNE -C...Calculates R-violating neutralino decay widths (pure 1->3 parts). -C...P. Z. Skands - - SUBROUTINE PYRVNE(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - DOUBLE PRECISION XLAM(0:400) - DOUBLE PRECISION ZPMIX(4,4), NMIX(4,4), RMQ(6) - INTEGER IDLAM(400,3), PYCOMP - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/ - -C...R-VIOLATING DECAYS - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN - KFSM=KFIN-KSUSY1 - IF(KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN -C...WHICH NEUTRALINO ? - NCHI=1 - IF (KFSM.EQ.23) NCHI=2 - IF (KFSM.EQ.25) NCHI=3 - IF (KFSM.EQ.35) NCHI=4 -C...SIGN OF MASS (Opposite convention as HERWIG) - ISM = 1 - IF (SMZ(NCHI).LT.0D0) ISM = -ISM - -C...Useful parameters for the calculation of the A and B constants. - WMASS = PMAS(PYCOMP(24),1) - ECHG = 2*SQRT(PARU(103)*PARU(1)) - COSB=1/(SQRT(1+RMSS(5)**2)) - SINB=RMSS(5)/SQRT(1+RMSS(5)**2) - COSW=SQRT(1-PARU(102)) - SINW=SQRT(PARU(102)) - GW=2D0*SQRT(PARU(103)*PARU(1))/SINW -C...Run quark masses to neutralino mass squared (for Higgs-type -C...couplings) - SQMCHI=PMAS(PYCOMP(KFIN),1)**2 - DO 100 I=1,6 - RMQ(I)=PYMRUN(I,SQMCHI) - 100 CONTINUE -C...EXPRESS NEUTRALINO MIXING IN (photino,Zino,~H_u,~H_d) BASIS - DO 110 NCHJ=1,4 - ZPMIX(NCHJ,1)= ZMIX(NCHJ,1)*COSW+ZMIX(NCHJ,2)*SINW - ZPMIX(NCHJ,2)=-ZMIX(NCHJ,1)*SINW+ZMIX(NCHJ,2)*COSW - ZPMIX(NCHJ,3)= ZMIX(NCHJ,3) - ZPMIX(NCHJ,4)= ZMIX(NCHJ,4) - 110 CONTINUE - C1=GW*ZPMIX(NCHI,3)/(2D0*COSB*WMASS) - C1U=GW*ZPMIX(NCHI,4)/(2D0*SINB*WMASS) - C2=ECHG*ZPMIX(NCHI,1) - C3=GW*ZPMIX(NCHI,2)/COSW - EU=2D0/3D0 - ED=-1D0/3D0 -C... AB(x,y,z): -C x=1-2 : Select A or B constant (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,...) -C z=1-2 : Mass eigenstate number -C...CALCULATE COUPLINGS - DO 120 I = 11,15,2 - CMS=PMAS(PYCOMP(I),1) -C...Intermediate sleptons - AB(1,I,1)=ISM*(CMS*C1*SFMIX(I,1) + SFMIX(I,2) - & *(C2-C3*SINW**2)) - AB(1,I,2)=ISM*(CMS*C1*SFMIX(I,3) + SFMIX(I,4) - & *(C2-C3*SINW**2)) - AB(2,I,1)= CMS*C1*SFMIX(I,2) - SFMIX(I,1)*(C2+C3*(5D-1-SINW - & **2)) - AB(2,I,2)=CMS*C1*SFMIX(I,4) - SFMIX(I,3)*(C2+C3*(5D-1-SINW - & **2)) -C...Inermediate sneutrinos - AB(1,I+1,1)=0D0 - AB(2,I+1,1)=5D-1*C3 - AB(1,I+1,2)=0D0 - AB(2,I+1,2)=0D0 -C...Inermediate sdown - J=I-10 - CMS=RMQ(J) - AB(1,J,1)=ISM*(CMS*C1*SFMIX(J,1) - SFMIX(J,2) - & *ED*(C2-C3*SINW**2)) - AB(1,J,2)=ISM*(CMS*C1*SFMIX(J,3) - SFMIX(J,4) - & *ED*(C2-C3*SINW**2)) - AB(2,J,1)=CMS*C1*SFMIX(J,2) + SFMIX(J,1) - & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) - AB(2,J,2)=CMS*C1*SFMIX(J,4) + SFMIX(J,3) - & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) -C...Inermediate sup - J=J+1 - CMS=RMQ(J) - AB(1,J,1)=ISM*(CMS*C1U*SFMIX(J,1) - SFMIX(J,2) - & *EU*(C2-C3*SINW**2)) - AB(1,J,2)=ISM*(CMS*C1U*SFMIX(J,3) - SFMIX(J,4) - & *EU*(C2-C3*SINW**2)) - AB(2,J,1)=CMS*C1U*SFMIX(J,2) + SFMIX(J,1) - & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) - AB(2,J,2)=CMS*C1U*SFMIX(J,4) + SFMIX(J,3) - & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) - 120 CONTINUE - - IF (IMSS(51).GE.1) THEN -C...LAMBDA COUPLINGS (LLE TYPE R-VIOLATION) -C * CHI0_I -> NUBAR_I + LEPTON+_J + lEPTON-_K. -C...STEP IN I,J,K USING SINGLE COUNTER - DO 130 ISC=0,26 -C...LAMBDA COUPLING ASYM IN I,J - IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-15.OR.IDLAM(LKNT,3).EQ.15) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - - IF (IMSS(52).GE.1) THEN -C...LAMBDA' COUPLINGS. (LQD TYPE R-VIOLATION) -C * CHI0 -> NUBAR_I + DBAR_J + D_K - DO 140 ISC=0,26 - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - -C * CHI0 -> LEPTON_I+ + UBAR_J + D_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - 140 CONTINUE - ENDIF - - IF (IMSS(53).GE.1) THEN -C...LAMBDA'' COUPLINGS. (UDD TYPE R-VIOLATION) -C * CHI0 -> UBAR_I + DBAR_J + DBAR_K - DO 150 ISC=0,26 -C...Symmetry J<->K. Also, LAMB antisymmetric in J and K, so no J=K. - IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 6. * RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3) - & +1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = IDLAM(LKNT,2) - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 150 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRVR -C...Breit-Wigner for resonance contributions - - FUNCTION PYRVR(Mab2,RM,RW) - - IMPLICIT NONE - DOUBLE PRECISION Mab2,RM,RW,PYRVR - PYRVR = 1D0/((Mab2-RM**2)**2+RM**2*RW**2) - RETURN - END - -C********************************************************************* - -C...PYRVSB -C...Auxiliary function to PYRVSF for calculating R-Violating -C...sfermion widths. Though the decay products are most often treated -C...as massless in the calculation, the kinematical boundary of phase -C...space is tested using the true masses. -C...MODE = 1: All decay products massive -C...MODE = 2: Decay product 1 massless -C...MODE = 3: Decay product 2 massless -C...MODE = 4: All decay products massless - - FUNCTION PYRVSB(KFIN,ID1,ID2,RM2,MODE) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - DOUBLE PRECISION SM(3) - INTEGER PYCOMP, KC(3) - KC(1)=PYCOMP(KFIN) - KC(2)=PYCOMP(ID1) - KC(3)=PYCOMP(ID2) - SM(1)=PMAS(KC(1),1)**2 - SM(2)=PMAS(KC(2),1)**2 - SM(3)=PMAS(KC(3),1)**2 -C...Kinematics check - IF ((SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2).LE.0D0) THEN - PYRVSB=0D0 - RETURN - ENDIF -C...CM momenta squared - IF (MODE.EQ.1) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2) - & * (SM(1)-(PMAS(KC(2),1)-PMAS(KC(3),1))**2) - ELSE IF (MODE.EQ.2) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(3),1))**2)**2 - ELSE IF (MODE.EQ.3) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1))**2)**2 - ELSE - P2CM=SM(1)/4. - ENDIF -C...Calculate Width - PYRVSB=RM2*SQRT(MAX(0D0,P2CM))/(8*PARU(1)*SM(1)) - RETURN - END - -C********************************************************************* - -C...PYRVS -C...Interference function - - FUNCTION PYRVS(X,Y,M1,W1,M2,W2) - - IMPLICIT NONE - DOUBLE PRECISION X, Y, PYRVS, PYRVR, M1, M2, W1, W2 - PYRVS = PYRVR(X,M1,W1)*PYRVR(Y,M2,W2)*((X-M1**2)*(Y-M2**2) - & +W1*W2*M1*M2) - RETURN - END - -C********************************************************************* - -C...PYRVSF -C...Calculates R-violating decays of sfermions. -C...P. Z. Skands - - SUBROUTINE PYRVSF(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP - SAVE /PYMSRV/,/PYSSMT/,/PYMSSM/,/PYDAT2/ - -C...IS R-VIOLATION ON ? - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN -C...Mass eigenstate counter - ICNT=INT(KFIN/KSUSY1) -C...SM KF code of SUSY particle - KFSM=KFIN-ICNT*KSUSY1 -C...Squared Sparticle Mass - SM=PMAS(PYCOMP(KFIN),1)**2 -C... Squared mass of top quark - SMT=PMAS(PYCOMP(6),1)**2 -C...IS L-VIOLATION ON ? - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1)) THEN -C...SLEPTON -> NU(BAR) + LEPTON and UBAR + D - IF(ICNT.NE.0.AND.(KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15)) - & THEN - K=INT((KFSM-9)/2) - DO 110 I=1,3 - DO 100 J=1,3 - IF(I.NE.J) THEN -C...~e,~mu,~tau -> nu_I + lepton-_J - LKNT = LKNT+1 - IDLAM(LKNT,1)= 12 +2*(I-1) - IDLAM(LKNT,2)= 11 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 100 CONTINUE - 110 CONTINUE -C...~e,~mu,~tau -> nu_Ibar + lepton-_K - J=INT((KFSM-9)/2) - DO 130 I=1,3 - IF(I.NE.J) THEN - DO 120 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-12 -2*(I-1) - IDLAM(LKNT,2)= 11 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 120 CONTINUE - ENDIF - 130 CONTINUE -C...~e,~mu,~tau -> u_Jbar + d_K - I=INT((KFSM-9)/2) - DO 150 J=1,3 - DO 140 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-2 -2*(J-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0 - IF (IMSS(52).NE.0) THEN -C...Use massive top quark - IF (IDLAM(LKNT,1).EQ.-6) THEN - RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 - & * (SM-SMT) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) -C...If no top quark, all decay products massless - ELSE - RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 140 CONTINUE - 150 CONTINUE - ENDIF -C * SNEUTRINO -> LEPTON+ + LEPTON- and DBAR + D -C...No right-handed neutrinos - IF(ICNT.EQ.1) THEN - IF(KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16) THEN - J=INT((KFSM-10)/2) - DO 170 I=1,3 - DO 160 K=1,3 - IF (I.NE.J) THEN -C...~nu_J -> lepton+_I + lepton-_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-11 -2*(I-1) - IDLAM(LKNT,2)= 11 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 160 CONTINUE - 170 CONTINUE -C...~nu_I -> dbar_J + d_K - I=INT((KFSM-10)/2) - DO 190 J=1,3 - DO 180 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-1 -2*(J-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=3*RVLAMP(I,J,K)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 180 CONTINUE - 190 CONTINUE - ENDIF - ENDIF -C * SDOWN -> NU(BAR) + D and LEPTON- + U - IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN - J=INT((KFSM+1)/2) - DO 210 I=1,3 - DO 200 K=1,3 -C...~d_J -> nu_Ibar + d_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-12 -2*(I-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 200 CONTINUE - 210 CONTINUE - K=INT((KFSM+1)/2) - DO 240 I=1,3 - DO 230 J=1,3 -C...~d_K -> nu_I + d_J - LKNT = LKNT+1 - IDLAM(LKNT,1)= 12 +2*(I-1) - IDLAM(LKNT,2)= 1 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF -C...~d_K -> lepton_I- + u_J - 220 LKNT = LKNT+1 - IDLAM(LKNT,1)= 11 +2*(I-1) - IDLAM(LKNT,2)= 2 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - IF (IMSS(52).NE.0) THEN -C...Use massive top quark - IF (IDLAM(LKNT,2).EQ.6) THEN - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,2) -C...If no top quark, all decay products massless - ELSE - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 230 CONTINUE - 240 CONTINUE - ENDIF -C * SUP -> LEPTON+ + D - IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN - J=NINT(KFSM/2.) - DO 260 I=1,3 - DO 250 K=1,3 -C...~u_J -> lepton_I+ + d_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-11 -2*(I-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 250 CONTINUE - 260 CONTINUE - ENDIF - ENDIF -C...BARYON NUMBER VIOLATING DECAYS - IF (IMSS(53).GE.1) THEN -C * SUP -> DBAR + DBAR - IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN - I = KFSM/2 - DO 280 J=1,3 - DO 270 K=1,3 -C...~u_I -> dbar_J + dbar_K - IF (J.LT.K) THEN -C...(anti-) symmetry J <-> K. - LKNT = LKNT + 1 - IDLAM(LKNT,1) = -1 -2*(J-1) - IDLAM(LKNT,2) = -1 -2*(K-1) - IDLAM(LKNT,3) = 0 - XLAM(LKNT) = 0D0 - RM2 = 2.*(RVLAMB(I,J,K)**2) - & * SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT = LKNT-1 - ENDIF - ENDIF - 270 CONTINUE - 280 CONTINUE - ENDIF -C * SDOWN -> UBAR + DBAR - IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN - K=(KFSM+1)/2 - DO 300 I=1,3 - DO 290 J=1,3 -C...LAMB coupling antisymmetric in J and K. - IF (J.NE.K) THEN -C...~d_K -> ubar_I + dbar_K - LKNT = LKNT + 1 - IDLAM(LKNT,1)= -2 -2*(I-1) - IDLAM(LKNT,2)= -1 -2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 -C...Use massive top quark - IF (IDLAM(LKNT,1).EQ.-6) THEN - RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT - & ) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) -C...If no top quark, all decay products massless - ELSE - RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 290 CONTINUE - 300 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSAVE -C...Saves and restores parameter and cross section values for the -C...3 gamma-p and 6 (or 4, or 9, or 13) gamma-gamma alternatives. -C...Also makes random choice between alternatives. - - SUBROUTINE PYSAVE(ISAVE,IGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION NCP(15),NSUBCP(15,20),MSUBCP(15,20),COEFCP(15,20,20), - &NGENCP(15,0:20,3),XSECCP(15,0:20,3),SIGTCP(15,0:6,0:6,0:5), - &INTCP(15,20),RECP(15,20) - SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,SIGTCP,INTCP,RECP - -C...Save list of subprocesses and cross-section information. - IF(ISAVE.EQ.1) THEN - ICP=0 - DO 120 I=1,500 - IF(MSUB(I).EQ.0.AND.I.NE.96.AND.I.NE.97) GOTO 120 - ICP=ICP+1 - NSUBCP(IGA,ICP)=I - MSUBCP(IGA,ICP)=MSUB(I) - DO 100 J=1,20 - COEFCP(IGA,ICP,J)=COEF(I,J) - 100 CONTINUE - DO 110 J=1,3 - NGENCP(IGA,ICP,J)=NGEN(I,J) - XSECCP(IGA,ICP,J)=XSEC(I,J) - 110 CONTINUE - 120 CONTINUE - NCP(IGA)=ICP - DO 130 J=1,3 - NGENCP(IGA,0,J)=NGEN(0,J) - XSECCP(IGA,0,J)=XSEC(0,J) - 130 CONTINUE - DO 160 I1=0,6 - DO 150 I2=0,6 - DO 140 J=0,5 - SIGTCP(IGA,I1,I2,J)=SIGT(I1,I2,J) - 140 CONTINUE - 150 CONTINUE - 160 CONTINUE - -C...Save various common process variables. - DO 170 J=1,10 - INTCP(IGA,J)=MINT(40+J) - 170 CONTINUE - INTCP(IGA,11)=MINT(101) - INTCP(IGA,12)=MINT(102) - INTCP(IGA,13)=MINT(107) - INTCP(IGA,14)=MINT(108) - INTCP(IGA,15)=MINT(123) - RECP(IGA,1)=CKIN(3) - RECP(IGA,2)=VINT(318) - -C...Save cross-section information only. - ELSEIF(ISAVE.EQ.2) THEN - DO 190 ICP=1,NCP(IGA) - I=NSUBCP(IGA,ICP) - DO 180 J=1,3 - NGENCP(IGA,ICP,J)=NGEN(I,J) - XSECCP(IGA,ICP,J)=XSEC(I,J) - 180 CONTINUE - 190 CONTINUE - DO 200 J=1,3 - NGENCP(IGA,0,J)=NGEN(0,J) - XSECCP(IGA,0,J)=XSEC(0,J) - 200 CONTINUE - -C...Choose between allowed alternatives. - ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN - IF(ISAVE.EQ.4) THEN - XSUMCP=0D0 - DO 210 IG=1,MINT(121) - XSUMCP=XSUMCP+XSECCP(IG,0,1) - 210 CONTINUE - XSUMCP=XSUMCP*PYR(0) - DO 220 IG=1,MINT(121) - IGA=IG - XSUMCP=XSUMCP-XSECCP(IG,0,1) - IF(XSUMCP.LE.0D0) GOTO 230 - 220 CONTINUE - 230 CONTINUE - ENDIF - -C...Restore cross-section information. - DO 240 I=1,500 - MSUB(I)=0 - 240 CONTINUE - DO 270 ICP=1,NCP(IGA) - I=NSUBCP(IGA,ICP) - MSUB(I)=MSUBCP(IGA,ICP) - DO 250 J=1,20 - COEF(I,J)=COEFCP(IGA,ICP,J) - 250 CONTINUE - DO 260 J=1,3 - NGEN(I,J)=NGENCP(IGA,ICP,J) - XSEC(I,J)=XSECCP(IGA,ICP,J) - 260 CONTINUE - 270 CONTINUE - DO 280 J=1,3 - NGEN(0,J)=NGENCP(IGA,0,J) - XSEC(0,J)=XSECCP(IGA,0,J) - 280 CONTINUE - DO 310 I1=0,6 - DO 300 I2=0,6 - DO 290 J=0,5 - SIGT(I1,I2,J)=SIGTCP(IGA,I1,I2,J) - 290 CONTINUE - 300 CONTINUE - 310 CONTINUE - -C...Restore various common process variables. - DO 320 J=1,10 - MINT(40+J)=INTCP(IGA,J) - 320 CONTINUE - MINT(101)=INTCP(IGA,11) - MINT(102)=INTCP(IGA,12) - MINT(107)=INTCP(IGA,13) - MINT(108)=INTCP(IGA,14) - MINT(123)=INTCP(IGA,15) - CKIN(3)=RECP(IGA,1) - CKIN(1)=2D0*CKIN(3) - VINT(318)=RECP(IGA,2) - -C...Sum up cross-section info (for PYSTAT). - ELSEIF(ISAVE.EQ.5) THEN - DO 330 I=1,500 - MSUB(I)=0 - NGEN(I,1)=0 - NGEN(I,3)=0 - XSEC(I,3)=0D0 - 330 CONTINUE - NGEN(0,1)=0 - NGEN(0,2)=0 - NGEN(0,3)=0 - XSEC(0,3)=0 - DO 350 IG=1,MINT(121) - DO 340 ICP=1,NCP(IG) - I=NSUBCP(IG,ICP) - IF(MSUBCP(IG,ICP).EQ.1) MSUB(I)=1 - NGEN(I,1)=NGEN(I,1)+NGENCP(IG,ICP,1) - NGEN(I,3)=NGEN(I,3)+NGENCP(IG,ICP,3) - XSEC(I,3)=XSEC(I,3)+XSECCP(IG,ICP,3) - 340 CONTINUE - NGEN(0,1)=NGEN(0,1)+NGENCP(IG,0,1) - NGEN(0,2)=NGEN(0,2)+NGENCP(IG,0,2) - NGEN(0,3)=NGEN(0,3)+NGENCP(IG,0,3) - XSEC(0,3)=XSEC(0,3)+XSECCP(IG,0,3) - 350 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSCAT -C...Finds outgoing flavours and event type; sets up the kinematics -C...and colour flow of the hard scattering - - SUBROUTINE PYSCAT - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Commonblocks - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/,/PYTCSM/ -C...Local arrays and saved variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5),PMQ(2),Z(2),CTHE(2), - &PHI(2),KUPPO(100),VINTSV(41:66),ILAB(100) - SAVE VINTSV - -C...Read out process - ISUB=MINT(1) - ISUBSV=ISUB - -C...Restore information for low-pT processes - IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN - DO 100 J=41,66 - 100 VINT(J)=VINTSV(J) - ENDIF - -C...Convert H' or A process into equivalent H one - IHIGG=1 - KFHIGG=25 - IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. - &ISUB.LE.190)) THEN - IHIGG=2 - IF(MOD(ISUB-1,10).GE.5) IHIGG=3 - KFHIGG=33+IHIGG - IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 - IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 - IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 - IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 - IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 - IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 - IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 - IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 - IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 - IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 - IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 - IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 - ENDIF - - IF(ISUB.EQ.401.OR.ISUB.EQ.402) KFHIGG=KFPR(ISUB,1) - -C...Choice of subprocess, number of documentation lines - IDOC=6+ISET(ISUB) - IF(ISUB.EQ.95) IDOC=8 - IF(ISET(ISUB).EQ.5) IDOC=9 - IF(ISET(ISUB).EQ.11) IDOC=4+NUP - MINT(3)=IDOC-6 - IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2 - MINT(4)=IDOC - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IPU3=MINT(84)+3 - IPU4=MINT(84)+4 - IPU5=MINT(84)+5 - IPU6=MINT(84)+6 - -C...Reset K, P and V vectors. Store incoming particles - DO 120 JT=1,MSTP(126)+100 - I=MINT(83)+JT - IF(I.GT.MSTU(4)) GOTO 120 - DO 110 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 110 CONTINUE - 120 CONTINUE - DO 140 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 130 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 130 CONTINUE - 140 CONTINUE - MINT(6)=2 - KFRES=0 - -C...Store incoming partons in their CM-frame - SH=VINT(44) - SHR=SQRT(SH) - SHP=VINT(26)*VINT(2) - SHPR=SQRT(SHP) - SHUSER=SHR - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR - DO 150 JT=1,2 - I=MINT(84)+JT - K(I,1)=14 - K(I,2)=MINT(14+JT) - K(I,3)=MINT(83)+2+JT - P(I,3)=0.5D0*SHUSER*(-1D0)**(JT-1) - P(I,4)=0.5D0*SHUSER - 150 CONTINUE - -C...Copy incoming partons to documentation lines - DO 170 JT=1,2 - I1=MINT(83)+4+JT - I2=MINT(84)+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 160 J=1,5 - P(I1,J)=P(I2,J) - 160 CONTINUE - 170 CONTINUE - -C...Choose new quark/lepton flavour for relevant annihilation graphs - IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58.OR. - &(ISUB.GE.135.AND.ISUB.LE.140).OR.ISUB.EQ.382.OR.ISUB.EQ.385) THEN - IGLGA=21 - IF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) IGLGA=22 - CALL PYWIDT(IGLGA,SH,WDTP,WDTE) - 180 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) - DO 190 I=1,MDCY(IGLGA,3) - KFLF=KFDP(I+MDCY(IGLGA,2)-1,1) - RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) - IF(RKFL.LE.0D0) GOTO 200 - 190 CONTINUE - 200 CONTINUE - IF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.2) THEN - IF(KFLF.GE.4) GOTO 180 - ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.4) THEN - KFLF=4 - MINT(2)=MINT(2)-2 - ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385) THEN - KFLF=5 - MINT(2)=MINT(2)-4 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.1.AND.IABS(MINT(15)).LE.2 - & .AND.IABS(KFLF).GE.3) THEN - FACQQB=VINT(58)**2*4D0/9D0*(VINT(45)**2+VINT(46)**2)/ - & VINT(44)**2 - FACCIB=VINT(46)**2/RTCM(41)**4 - IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.2) THEN - KFLF=5 - MINT(2)=1 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.1) THEN - IF(KFLF.EQ.5) GOTO 180 - ELSEIF(ISUB.EQ.54.OR.ISUB.EQ.135.OR.ISUB.EQ.136) THEN - IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180 - ELSEIF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) THEN - IF((KCHG(PYCOMP(KFLF),1)/3D0)**2.LT.PYR(0)) GOTO 180 - ENDIF - ENDIF - -C...Final state flavours and colour flow: default values - JS=1 - MINT(21)=MINT(15) - MINT(22)=MINT(16) - MINT(23)=0 - MINT(24)=0 - KCC=20 - KCS=ISIGN(1,MINT(15)) - - IF(ISET(ISUB).EQ.11) THEN -C...User-defined processes: find products - MINT(3)=0 - DO 210 IUP=3,NUP - IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) THEN - ELSEIF(NUP.EQ.5.AND.IUP.GE.4.AND.MOTHUP(1,4).EQ.3) THEN - MINT(21+IUP)=IDUP(IUP) - ELSEIF(ISTUP(IUP).EQ.1.AND.(ISTUP(MOTHUP(1,IUP)).EQ.2.OR. - & ISTUP(MOTHUP(1,IUP)).EQ.3).AND.IDUP(MOTHUP(1,IUP)).NE.0) THEN - ELSEIF(IDUP(IUP).EQ.0) THEN - ELSE - MINT(3)=MINT(3)+1 - IF(MINT(3).LE.6) MINT(20+MINT(3))=IDUP(IUP) - ENDIF - 210 CONTINUE - - ELSEIF(ISUB.LE.10) THEN - IF(ISUB.EQ.1) THEN -C...f + fbar -> gamma*/Z0 - KFRES=23 - - ELSEIF(ISUB.EQ.2) THEN -C...f + fbar' -> W+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.3) THEN -C...f + fbar -> h0 (or H0, or A0) - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.4) THEN -C...gamma + W+/- -> W+/- - - ELSEIF(ISUB.EQ.5) THEN -C...Z0 + Z0 -> h0 - XH=SH/SHP - MINT(21)=MINT(15) - MINT(22)=MINT(16) - PMQ(1)=PYMASS(MINT(21)) - PMQ(2)=PYMASS(MINT(22)) - 220 JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 220 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 220 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 220 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220 - KCC=22 - KFRES=25 - - ELSEIF(ISUB.EQ.6) THEN -C...Z0 + W+/- -> W+/- - - ELSEIF(ISUB.EQ.7) THEN -C...W+ + W- -> Z0 - - ELSEIF(ISUB.EQ.8) THEN -C...W+ + W- -> h0 - XH=SH/SHP - 230 DO 260 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 240 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 250 - 240 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 250 PMQ(JT)=PYMASS(MINT(20+JT)) - 260 CONTINUE - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 230 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 230 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 230 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 230 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230 - KCC=22 - KFRES=25 - - ELSEIF(ISUB.EQ.10) THEN -C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2 - IF(MINT(2).EQ.1) THEN - KCC=22 - ELSE -C...W exchange: need to mix flavours according to CKM matrix - DO 280 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 270 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 280 - 270 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 280 CONTINUE - KCC=22 - ENDIF - ENDIF - - ELSEIF(ISUB.LE.20) THEN - IF(ISUB.EQ.11) THEN -C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.12) THEN -C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 - MINT(21)=ISIGN(KFLF,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.13) THEN -C...f + fbar -> g + g; th arbitrary - MINT(21)=21 - MINT(22)=21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.14) THEN -C...f + fbar -> g + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=22 - KCC=17+JS - - ELSEIF(ISUB.EQ.15) THEN -C...f + fbar -> g + Z0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=23 - KCC=17+JS - - ELSEIF(ISUB.EQ.16) THEN -C...f + fbar' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.17) THEN -C...f + fbar -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=25 - KCC=17+JS - - ELSEIF(ISUB.EQ.18) THEN -C...f + fbar -> gamma + gamma; th arbitrary - MINT(21)=22 - MINT(22)=22 - - ELSEIF(ISUB.EQ.19) THEN -C...f + fbar -> gamma + Z0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=23 - - ELSEIF(ISUB.EQ.20) THEN -C...f + fbar' -> gamma + W+/-; th = (p(f)-p(W-))**2 or -C...(p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - ENDIF - - ELSEIF(ISUB.LE.30) THEN - IF(ISUB.EQ.21) THEN -C...f + fbar -> gamma + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=25 - - ELSEIF(ISUB.EQ.22) THEN -C...f + fbar -> Z0 + Z0; th arbitrary - MINT(21)=23 - MINT(22)=23 - - ELSEIF(ISUB.EQ.23) THEN -C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=23 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.24) THEN -C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=23 - MINT(23-JS)=KFHIGG - - ELSEIF(ISUB.EQ.25) THEN -C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2 - MINT(21)=-ISIGN(24,MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.26) THEN -C...f + fbar' -> W+/- + h0 (or H0, or A0); -C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(24,KCH1+KCH2) - MINT(23-JS)=KFHIGG - - ELSEIF(ISUB.EQ.27) THEN -C...f + fbar -> h0 + h0 - - ELSEIF(ISUB.EQ.28) THEN -C...f + g -> f + g; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - KCC=MINT(2)+6 - IF(MINT(15).EQ.21) KCC=KCC+2 - IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) - IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) - - ELSEIF(ISUB.EQ.29) THEN -C...f + g -> f + gamma; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.30) THEN -C...f + g -> f + Z0; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.31) THEN -C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f' - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) - RVCKM=VINT(180+I)*PYR(0) - DO 290 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290 - MINT(20+JS)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 300 - 290 CONTINUE - 300 KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.32) THEN -C...f + g -> f + h0; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.33) THEN -C...f + gamma -> f + g; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=21 - KCC=24+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.34) THEN -C...f + gamma -> f + gamma; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - KCC=22 - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.35) THEN -C...f + gamma -> f + Z0; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=23 - KCC=22 - - ELSEIF(ISUB.EQ.36) THEN -C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2 - IF(MINT(15).EQ.22) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 310 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310 - MINT(20+JS)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 320 - 310 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JS)=ISIGN(IB,I) - ENDIF - 320 KCC=22 - - ELSEIF(ISUB.EQ.37) THEN -C...f + gamma -> f + h0 - - ELSEIF(ISUB.EQ.38) THEN -C...f + Z0 -> f + g - - ELSEIF(ISUB.EQ.39) THEN -C...f + Z0 -> f + gamma - - ELSEIF(ISUB.EQ.40) THEN -C...f + Z0 -> f + Z0 - ENDIF - - ELSEIF(ISUB.LE.50) THEN - IF(ISUB.EQ.41) THEN -C...f + Z0 -> f' + W+/- - - ELSEIF(ISUB.EQ.42) THEN -C...f + Z0 -> f + h0 - - ELSEIF(ISUB.EQ.43) THEN -C...f + W+/- -> f' + g - - ELSEIF(ISUB.EQ.44) THEN -C...f + W+/- -> f' + gamma - - ELSEIF(ISUB.EQ.45) THEN -C...f + W+/- -> f' + Z0 - - ELSEIF(ISUB.EQ.46) THEN -C...f + W+/- -> f' + W+/- - - ELSEIF(ISUB.EQ.47) THEN -C...f + W+/- -> f' + h0 - - ELSEIF(ISUB.EQ.48) THEN -C...f + h0 -> f + g - - ELSEIF(ISUB.EQ.49) THEN -C...f + h0 -> f + gamma - - ELSEIF(ISUB.EQ.50) THEN -C...f + h0 -> f + Z0 - ENDIF - - ELSEIF(ISUB.LE.60) THEN - IF(ISUB.EQ.51) THEN -C...f + h0 -> f' + W+/- - - ELSEIF(ISUB.EQ.52) THEN -C...f + h0 -> f + h0 - - ELSEIF(ISUB.EQ.53) THEN -C...g + g -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.54) THEN -C...g + gamma -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.EQ.55) THEN -C...g + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.56) THEN -C...g + W+/- -> f + fbar' - - ELSEIF(ISUB.EQ.57) THEN -C...g + h0 -> f + fbar - - ELSEIF(ISUB.EQ.58) THEN -C...gamma + gamma -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=21 - - ELSEIF(ISUB.EQ.59) THEN -C...gamma + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.60) THEN -C...gamma + W+/- -> f + fbar' - ENDIF - - ELSEIF(ISUB.LE.70) THEN - IF(ISUB.EQ.61) THEN -C...gamma + h0 -> f + fbar - - ELSEIF(ISUB.EQ.62) THEN -C...Z0 + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.63) THEN -C...Z0 + W+/- -> f + fbar' - - ELSEIF(ISUB.EQ.64) THEN -C...Z0 + h0 -> f + fbar - - ELSEIF(ISUB.EQ.65) THEN -C...W+ + W- -> f + fbar - - ELSEIF(ISUB.EQ.66) THEN -C...W+/- + h0 -> f + fbar' - - ELSEIF(ISUB.EQ.67) THEN -C...h0 + h0 -> f + fbar - - ELSEIF(ISUB.EQ.68) THEN -C...g + g -> g + g; th arbitrary - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.69) THEN -C...gamma + gamma -> W+ + W-; th arbitrary - MINT(21)=24 - MINT(22)=-24 - KCC=21 - - ELSEIF(ISUB.EQ.70) THEN -C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2 - IF(MINT(15).EQ.22) MINT(21)=23 - IF(MINT(16).EQ.22) MINT(22)=23 - KCC=21 - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN -C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W- - XH=SH/SHP - MINT(21)=MINT(15) - MINT(22)=MINT(16) - PMQ(1)=PYMASS(MINT(21)) - PMQ(2)=PYMASS(MINT(22)) - 330 JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 330 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 330 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 330 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330 - KCC=22 - - ELSEIF(ISUB.EQ.73) THEN -C...Z0 + W+/- -> Z0 + W+/- - JS=MINT(2) - XH=SH/SHP - 340 JT=3-MINT(2) - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 350 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 360 - 350 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 360 PMQ(JT)=PYMASS(MINT(20+JT)) - MINT(23-JT)=MINT(17-JT) - PMQ(3-JT)=PYMASS(MINT(23-JT)) - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 340 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 340 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 340 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 340 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340 - KCC=22 - - ELSEIF(ISUB.EQ.74) THEN -C...Z0 + h0 -> Z0 + h0 - - ELSEIF(ISUB.EQ.75) THEN -C...W+ + W- -> gamma + gamma - - ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN -C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W- - XH=SH/SHP - 370 DO 400 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 380 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 390 - 380 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 390 PMQ(JT)=PYMASS(MINT(20+JT)) - 400 CONTINUE - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 370 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 370 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 370 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 370 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370 - KCC=22 - - ELSEIF(ISUB.EQ.78) THEN -C...W+/- + h0 -> W+/- + h0 - - ELSEIF(ISUB.EQ.79) THEN -C...h0 + h0 -> h0 + h0 - - ELSEIF(ISUB.EQ.80) THEN -C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2 - IF(MINT(15).EQ.22) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I) - IB=3-IA - MINT(20+JS)=ISIGN(IB,I) - KCC=22 - ENDIF - - ELSEIF(ISUB.LE.90) THEN - IF(ISUB.EQ.81) THEN -C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2 - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.82) THEN -C...g + g -> Q + Qbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.83) THEN -C...f + q -> f' + Q; th = (p(f) - p(f'))**2 - KFOLD=MINT(16) - IF(MINT(2).EQ.2) KFOLD=MINT(15) - KFAOLD=IABS(KFOLD) - IF(KFAOLD.GT.10) THEN - KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1 - ELSE - RCKM=VINT(180+KFOLD)*PYR(0) - IPM=(5-ISIGN(1,KFOLD))/2 - KFANEW=-MOD(KFAOLD+1,2) - 410 KFANEW=KFANEW+2 - IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN - IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM- - & VCKM(KFAOLD/2,(KFANEW+1)/2) - IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM- - & VCKM(KFANEW/2,(KFAOLD+1)/2) - ENDIF - IF(KFANEW.LE.6.AND.RCKM.GT.0D0) GOTO 410 - ENDIF - IF(MINT(2).EQ.1) THEN - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=ISIGN(KFANEW,MINT(16)) - ELSE - MINT(21)=ISIGN(KFANEW,MINT(15)) - MINT(22)=ISIGN(MINT(55),MINT(16)) - JS=2 - ENDIF - KCC=22 - - ELSEIF(ISUB.EQ.84) THEN -C...g + gamma -> Q + Qbar; th arbitary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.EQ.85) THEN -C...gamma + gamma -> F + Fbar; th arbitary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(56),KCS) - MINT(22)=-MINT(21) - KCC=21 - - ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN -C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=24 - KCS=(-1)**INT(1.5D0+PYR(0)) - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.95) THEN -C...Low-pT ( = energyless g + g -> g + g) - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.96) THEN -C...Multiple interactions (should be reassigned to QCD process) - ENDIF - - ELSEIF(ISUB.LE.110) THEN - IF(ISUB.EQ.101) THEN -C...g + g -> gamma*/Z0 - KCC=21 - KFRES=22 - - ELSEIF(ISUB.EQ.102) THEN -C...g + g -> h0 (or H0, or A0) - KCC=21 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.103) THEN -C...gamma + gamma -> h0 (or H0, or A0) - KCC=21 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.104.OR.ISUB.EQ.105) THEN -C...g + g -> chi_0c or chi_2c. - KCC=21 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.106) THEN -C...g + g -> J/Psi + gamma - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=21 - - ELSEIF(ISUB.EQ.107) THEN -C...g + gamma -> J/Psi + g - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=22 - IF(MINT(16).EQ.22) KCC=33 - - ELSEIF(ISUB.EQ.108) THEN -C...gamma + gamma -> J/Psi + gamma - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - - ELSEIF(ISUB.EQ.110) THEN -C...f + fbar -> gamma + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=KFHIGG - ENDIF - - ELSEIF(ISUB.LE.120) THEN - IF(ISUB.EQ.111) THEN -C...f + fbar -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=KFHIGG - KCC=17+JS - - ELSEIF(ISUB.EQ.112) THEN -C...f + g -> f + h0; th = (p(f) - p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=KFHIGG - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.113) THEN -C...g + g -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=KFHIGG - KCC=22+JS - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.114) THEN -C...g + g -> gamma + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(21)=22 - MINT(22)=22 - KCC=21 - - ELSEIF(ISUB.EQ.115) THEN -C...g + g -> g + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=22 - KCC=22+JS - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.116) THEN -C...g + g -> gamma + Z0 - - ELSEIF(ISUB.EQ.117) THEN -C...g + g -> Z0 + Z0 - - ELSEIF(ISUB.EQ.118) THEN -C...g + g -> W+ + W- - ENDIF - - ELSEIF(ISUB.LE.140) THEN - IF(ISUB.EQ.121) THEN -C...g + g -> Q + Qbar + h0 - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) - MINT(22)=-MINT(21) - KCC=11+INT(0.5D0+PYR(0)) - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.122) THEN -C...q + qbar -> Q + Qbar + h0 - MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.123) THEN -C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as -C...inner process) - KCC=22 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.124) THEN -C...f + f' -> f" + f"' + h0 (or H0, or A) (W+ + W- -> h0 as -C...inner process) - DO 430 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 420 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 430 - 420 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 430 CONTINUE - KCC=22 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN -C...f + gamma*_(T,L) -> f + g; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=21 - KCC=24+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN -C...f + gamma*_(T,L) -> f + gamma; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - KCC=22 - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN -C...g + gamma*_(T,L) -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN -C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=21 - - ENDIF - - ELSEIF(ISUB.LE.160) THEN - IF(ISUB.EQ.141) THEN -C...f + fbar -> gamma*/Z0/Z'0 - KFRES=32 - - ELSEIF(ISUB.EQ.142) THEN -C...f + fbar' -> W'+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(34,KCH1+KCH2) - - ELSEIF(ISUB.EQ.143) THEN -C...f + fbar' -> H+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.144) THEN -C...f + fbar' -> R - KFRES=ISIGN(41,MINT(15)+MINT(16)) - - ELSEIF(ISUB.EQ.145) THEN -C...q + l -> LQ (leptoquark) - IF(IABS(MINT(16)).LE.8) JS=2 - KFRES=ISIGN(42,MINT(14+JS)) - KCC=28+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.146) THEN -C...e + gamma -> e* (excited lepton) - IF(MINT(15).EQ.22) JS=2 - KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) - KCC=22 - - ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN -C...q + g -> q* (excited quark) - IF(MINT(15).EQ.21) JS=2 - KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) - KCC=30+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.149) THEN -C...g + g -> eta_tc - KFRES=KTECHN+331 - KCC=23 - KCS=(-1)**INT(1.5D0+PYR(0)) - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.161) THEN -C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I) - IB=IA+MOD(IA,2)-MOD(IA+1,2) - MINT(20+JS)=ISIGN(IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.162) THEN -C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2 - IF(MINT(15).EQ.21) JS=2 - MINT(20+JS)=ISIGN(42,MINT(14+JS)) - KFLQL=KFDP(MDCY(42,2),2) - MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS)) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.163) THEN -C...g + g -> LQ + LQbar; LQ=leptoquark; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(42,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.164) THEN -C...q + qbar -> LQ + LQbar; LQ=leptoquark; th=(p(q)-p(LQ))**2 - MINT(21)=ISIGN(42,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.165) THEN -C...q + qbar -> l- + l+; th=(p(q)-p(l-))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.166) THEN -C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 - IF(MOD(MINT(15),2).EQ.0) THEN - MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) - ELSE - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) - ENDIF - - ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN -C...q + q' -> q" + q* (excited quark) - KFQSTR=KFPR(ISUB,2) - KFQEXC=MOD(KFQSTR,KEXCIT) - JS=MINT(2) - MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) - IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC) - & MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) - KCC=22 - JS=3-JS - - ELSEIF(ISUB.EQ.169) THEN -C...q + qbar -> e + e* (excited lepton) - KFQSTR=KFPR(ISUB,2) - KFQEXC=MOD(KFQSTR,KEXCIT) - JS=MINT(2) - MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) - MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) - JS=3-JS - - ELSEIF(ISUB.EQ.191) THEN -C...f + fbar -> rho_tc0. - KFRES=KTECHN+113 - - ELSEIF(ISUB.EQ.192) THEN -C...f + fbar' -> rho_tc+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KTECHN+213,KCH1+KCH2) - - ELSEIF(ISUB.EQ.193) THEN -C...f + fbar -> omega_tc0. - KFRES=KTECHN+223 - - ELSEIF(ISUB.EQ.194) THEN -C...f + fbar -> f' + fbar' via mixture of s-channel -C...rho_tc and omega_tc; th=(p(f)-p(f'))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.195) THEN -C...f + fbar' -> f'' + fbar''' via s-channel -C...rho_tc+ th=(p(f)-p(f'))**2 -C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 - IF(MOD(MINT(15),2).EQ.0) THEN - MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) - ELSE - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) - ENDIF - ENDIF - -CMRENNA++ - ELSEIF(ISUB.LE.215) THEN - IF(ISUB.EQ.201) THEN -C...f + fbar -> ~e_L + ~e_Lbar - MINT(21)=ISIGN(KSUSY1+11,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.202) THEN -C...f + fbar -> ~e_R + ~e_Rbar - MINT(21)=ISIGN(KSUSY2+11,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.203) THEN -C...f + fbar -> ~e_L + ~e_Rbar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.204) THEN -C...f + fbar -> ~mu_L + ~mu_Lbar - MINT(21)=ISIGN(KSUSY1+13,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.205) THEN -C...f + fbar -> ~mu_R + ~mu_Rbar - MINT(21)=ISIGN(KSUSY2+13,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.206) THEN -C...f + fbar -> ~mu_L + ~mu_Rbar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.207) THEN -C...f + fbar -> ~tau_1 + ~tau_1bar - MINT(21)=ISIGN(KSUSY1+15,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.208) THEN -C...f + fbar -> ~tau_2 + ~tau_2bar - MINT(21)=ISIGN(KSUSY2+15,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.209) THEN -C...f + fbar -> ~tau_1 + ~tau_2bar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.210) THEN -C...q + qbar' -> ~l_L + ~nulbar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2) - MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2) - - ELSEIF(ISUB.EQ.211) THEN -C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2) - MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) - - ELSEIF(ISUB.EQ.212) THEN -C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2) - MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) - - ELSEIF(ISUB.EQ.213) THEN -C...f + fbar -> ~nul + ~nulbar - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.214) THEN -C...f + fbar -> ~nutau + ~nutaubar - MINT(21)=ISIGN(KSUSY1+16,KCS) - MINT(22)=-MINT(21) - ENDIF - - ELSEIF(ISUB.LE.225) THEN - IF(ISUB.EQ.216) THEN -C...f + fbar -> ~chi01 + ~chi01 - MINT(21)=KSUSY1+22 - MINT(22)=KSUSY1+22 - - ELSEIF(ISUB.EQ.217) THEN -C...f + fbar -> ~chi02 + ~chi02 - MINT(21)=KSUSY1+23 - MINT(22)=KSUSY1+23 - - ELSEIF(ISUB.EQ.218 ) THEN -C...f + fbar -> ~chi03 + ~chi03 - MINT(21)=KSUSY1+25 - MINT(22)=KSUSY1+25 - - ELSEIF(ISUB.EQ.219 ) THEN -C...f + fbar -> ~chi04 + ~chi04 - MINT(21)=KSUSY1+35 - MINT(22)=KSUSY1+35 - - ELSEIF(ISUB.EQ.220 ) THEN -C...f + fbar -> ~chi01 + ~chi02 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+23 - - ELSEIF(ISUB.EQ.221 ) THEN -C...f + fbar -> ~chi01 + ~chi03 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+25 - - ELSEIF(ISUB.EQ.222) THEN -C...f + fbar -> ~chi01 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+35 - - ELSEIF(ISUB.EQ.223) THEN -C...f + fbar -> ~chi02 + ~chi03 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=KSUSY1+25 - - ELSEIF(ISUB.EQ.224) THEN -C...f + fbar -> ~chi02 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=KSUSY1+35 - - ELSEIF(ISUB.EQ.225) THEN -C...f + fbar -> ~chi03 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=KSUSY1+35 - ENDIF - - ELSEIF(ISUB.LE.236) THEN - IF(ISUB.EQ.226) THEN -C...f + fbar -> ~chi+-1 + ~chi-+1 -C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - MINT(21)=ISIGN(KSUSY1+24,KCH1) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.227) THEN -C...f + fbar -> ~chi+-2 + ~chi-+2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - MINT(21)=ISIGN(KSUSY1+37,KCH1) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.228) THEN -C...f + fbar -> ~chi+-1 + ~chi-+2 -C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2 -C...js=1 if pyr<.5, js=2 if pyr>.5 -C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2 -C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2 -C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2 -C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=INT(1-KCH1)/2 - IF(MINT(2).EQ.1) THEN - MINT(21)= ISIGN(KSUSY1+24,KCH1) - MINT(22)= -ISIGN(KSUSY1+37,KCH1) -c IF(KCH2.EQ.0) JS=2 - ELSE - MINT(21)= ISIGN(KSUSY1+37,KCH1) - MINT(22)= -ISIGN(KSUSY1+24,KCH1) - JS=2 -c IF(KCH2.EQ.1) JS=2 - ENDIF - - ELSEIF(ISUB.EQ.229) THEN -C...q + qbar' -> ~chi01 + ~chi+-1 -C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) -C...CHECK THIS - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.230) THEN -C...q + qbar' -> ~chi02 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.231) THEN -C...q + qbar' -> ~chi03 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.232) THEN -C...q + qbar' -> ~chi04 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+35 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.233) THEN -C...q + qbar' -> ~chi01 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.234) THEN -C...q + qbar' -> ~chi02 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.235) THEN -C...q + qbar' -> ~chi03 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.236) THEN -C...q + qbar' -> ~chi04 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+35 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - ENDIF - - ELSEIF(ISUB.LE.245) THEN - IF(ISUB.EQ.237) THEN -C...q + qbar -> ~chi01 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+22 - KCC=17+JS - - ELSEIF(ISUB.EQ.238) THEN -C...q + qbar -> ~chi02 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+23 - KCC=17+JS - - ELSEIF(ISUB.EQ.239) THEN -C...q + qbar -> ~chi03 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+25 - KCC=17+JS - - ELSEIF(ISUB.EQ.240) THEN -C...q + qbar -> ~chi04 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+35 - KCC=17+JS - - ELSEIF(ISUB.EQ.241) THEN -C...q + qbar' -> ~chi+-1 + ~g -C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ -C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- -C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- -C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ -C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - JS=1 - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.242) THEN -C...q + qbar' -> ~chi+-2 + ~g -C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ -C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- -C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- -C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ -C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - JS=1 - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.243) THEN -C...q + qbar -> ~g + ~g ; th arbitrary - MINT(21)=KSUSY1+21 - MINT(22)=KSUSY1+21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.244) THEN -C...g + g -> ~g + ~g ; th arbitrary - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=KSUSY1+21 - MINT(22)=KSUSY1+21 - ENDIF - - ELSEIF(ISUB.LE.260) THEN - IF(ISUB.EQ.246) THEN -C...qj + g -> ~qj_L + ~chi01 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.247) THEN -C...qj + g -> ~qj_R + ~chi01 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.248) THEN -C...qj + g -> ~qj_L + ~chi02 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.249) THEN -C...qj + g -> ~qj_R + ~chi02 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.250) THEN -C...qj + g -> ~qj_L + ~chi03 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.251) THEN -C...qj + g -> ~qj_R + ~chi03 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.252) THEN -C...qj + g -> ~qj_L + ~chi04 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+35 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.253) THEN -C...qj + g -> ~qj_R + ~chi04 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+35 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.254) THEN -C...qj + g -> ~qk_L + ~chi+-1 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY1+IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.255) THEN -C...qj + g -> ~qk_L + ~chi+-1 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY2+IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.256) THEN -C...qj + g -> ~qk_L + ~chi+-2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY1+IB,I) - MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.257) THEN -C...qj + g -> ~qk_R + ~chi+-2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY2+IB,I) - MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.258) THEN -C...qj + g -> ~qj_L + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - - ELSEIF(ISUB.EQ.259) THEN -C...qj + g -> ~qj_R + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - ENDIF - - ELSEIF(ISUB.LE.270) THEN - IF(ISUB.EQ.261) THEN -C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.262) THEN -C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.263) THEN -C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2 - IF((KCS.GT.0.AND.MINT(2).EQ.1).OR. - & (KCS.LT.0.AND.MINT(2).EQ.2)) THEN - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-ISIGN(KFPR(ISUB,2),KCS) - ELSE - JS=2 - MINT(21)=ISIGN(KFPR(ISUB,2),KCS) - MINT(22)=-ISIGN(KFPR(ISUB,1),KCS) - ENDIF -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.264) THEN -C...g + g -> ~t_1 + ~t_1bar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.265) THEN -C...g + g -> ~t_2 + ~t_2bar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - ENDIF - - ELSEIF(ISUB.LE.296) THEN - IF(ISUB.EQ.271.OR.ISUB.EQ.281.OR.ISUB.EQ.291) THEN -C...qi + qj -> ~qi_L + ~qj_L - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) - - ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.282.OR.ISUB.EQ.292) THEN -C...qi + qj -> ~qi_R + ~qj_R - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) - - ELSEIF(ISUB.EQ.273.OR.ISUB.EQ.283.OR.ISUB.EQ.293) THEN -C...qi + qj -> ~qi_L + ~qj_R - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.274.OR.ISUB.EQ.284) THEN -C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.275.OR.ISUB.EQ.285) THEN -C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.276.OR.ISUB.EQ.286.OR.ISUB.EQ.296) THEN -C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.287) THEN -C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.288) THEN -C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.279.OR.ISUB.EQ.289) THEN -C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary -C...pure LL + RR - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.280.OR.ISUB.EQ.290) THEN -C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.294) THEN -C...qj + g -> ~qj_L + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - - ELSEIF(ISUB.EQ.295) THEN -C...qj + g -> ~qj_R + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - ENDIF - - ELSEIF(ISUB.LE.340) THEN - - IF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN -C...q + qbar' -> H+ + H0 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(37,KCH1+KCH2) - MINT(23-JS)=KFPR(ISUB,2) - ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN -C...f + fbar -> A0 + H0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ELSEIF(ISUB.EQ.301) THEN -C...f + fbar -> H+ H- - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - ENDIF -CMRENNA-- - - ELSEIF(ISUB.LE.360) THEN - - IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN -C...l + l -> H_L++/--, H_R++/-- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) - - ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN -C...l + gamma -> l' + H++/--; th=(p(l)-p(H))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(20+JS)=ISIGN(KFPR(ISUB,1),-MINT(14+JS)) - MINT(23-JS)=ISIGN(KFPR(ISUB,2),-MINT(14+JS)) - KCC=22 - - ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN -C...f + fbar -> H++ + H--; th = (p(f)-p(H--))**2 - MINT(21)=-ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN -C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- -C...as inner process). - DO 450 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 440 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 440 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 450 - 440 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 450 CONTINUE - KCC=22 - KFRES=ISIGN(KFPR(ISUB,1),MINT(15)) - IF(MOD(MINT(15),2).EQ.1) KFRES=-KFRES - - ELSEIF(ISUB.EQ.353) THEN -C...f + fbar -> Z_R0 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.354) THEN -C...f + fbar' -> W+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) - - ENDIF - - ELSEIF(ISUB.LE.380) THEN - - IF(ISUB.LE.363.OR.ISUB.EQ.368) THEN -C...f + fbar -> charged+ charged- technicolor - KSW=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KSW) - MINT(22)=-ISIGN(KFPR(ISUB,2),KSW) - - ELSEIF(ISUB.LE.367) THEN -C...f + fbar -> neutral neutral technicolor - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - - ELSEIF(ISUB.EQ.374.OR.ISUB.EQ.375) THEN -C...f + fbar' -> neutral charged technicolor - IN=1 - IC=2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(23-JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) - MINT(20+JS)=KFPR(ISUB,IN) - - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN -C...f + fbar' -> charged neutral technicolor - IN=2 - IC=1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) - MINT(23-JS)=KFPR(ISUB,IN) - ENDIF - - ELSEIF(ISUB.LE.400) THEN - IF(ISUB.EQ.381) THEN -C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2, TC extensions - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.382) THEN -C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2, TC extensions - MINT(21)=ISIGN(KFLF,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.383) THEN -C...f + fbar -> g + g; th arbitrary, TC extensions - MINT(21)=21 - MINT(22)=21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.384) THEN -C...f + g -> f + g; th = (p(f)-p(f))**2, TC extensions - IF(MINT(15).EQ.21) JS=2 - KCC=MINT(2)+6 - IF(MINT(15).EQ.21) KCC=KCC+2 - IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) - IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) - - ELSEIF(ISUB.EQ.385) THEN -C...g + g -> f + fbar; th arbitrary, TC extensions - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.386) THEN -C...g + g -> g + g; th arbitrary, TC extensions - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.387) THEN -C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2, TC extensions - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.388) THEN -C...g + g -> Q + Qbar; th arbitrary, TC extensions - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.391) THEN -C...f + fbar -> G*. - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.392) THEN -C...g + g -> G*. - KCC=21 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.393) THEN -C...q + qbar -> g + G*; th arbitrary. - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - KCC=17+JS - - ELSEIF(ISUB.EQ.394) THEN -C...q + g -> q + G*; th = (p(f) - p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=KFPR(ISUB,2) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.395) THEN -C...g + g -> G* + g; th arbitrary. - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=KFPR(ISUB,2) - KCC=22+JS - ENDIF - - ELSEIF(ISUB.LE.402) THEN - IF(ISUB.EQ.401) THEN -C...g + g -> t + b + H+/- - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) - MINT(22)=ISIGN(5,-KCS) - KCC=11+INT(0.5D0+PYR(0)) - KFRES=ISIGN(KFHIGG,-KCS) - - ELSEIF(ISUB.EQ.402) THEN -C...q + qbar -> t + b + H+/- - KFL=(-1)**INT(1.5D0+PYR(0)) ! Top or bottom - MINT(21)=ISIGN(INT(6.+.5*KFL),KCS) - MINT(22)=ISIGN(INT(6.-.5*KFL),-KCS) - KCC=4 - KFRES=ISIGN(KFHIGG,-KFL*KCS) - ENDIF - ENDIF - - IF(ISET(ISUB).EQ.11) THEN -C...Store documentation for user-defined processes - BEZUP=(PUP(3,1)+PUP(3,2))/(PUP(4,1)+PUP(4,2)) - KUPPO(1)=MINT(83)+5 - KUPPO(2)=MINT(83)+6 - I=MINT(83)+6 - DO 470 IUP=3,NUP - KUPPO(IUP)=0 - IF(MSTP(128).GE.2.AND.MOTHUP(1,IUP).GE.3) THEN - IDOC=IDOC-1 - MINT(4)=MINT(4)-1 - GOTO 470 - ENDIF - I=I+1 - KUPPO(IUP)=I - K(I,1)=21 - K(I,2)=IDUP(IUP) - IF(IDUP(IUP).EQ.0) K(I,2)=90 - K(I,3)=0 - IF(MOTHUP(1,IUP).GE.3) K(I,3)=KUPPO(MOTHUP(1,IUP)) - K(I,4)=0 - K(I,5)=0 - DO 460 J=1,5 - P(I,J)=PUP(J,IUP) - 460 CONTINUE - V(I,5)=VTIMUP(IUP) - 470 CONTINUE - CALL PYROBO(MINT(83)+7,MINT(83)+4+NUP,0D0,VINT(24),0D0,0D0, - & -BEZUP) - -C...Store final state partons for user-defined processes - N=IPU2 - DO 490 IUP=3,NUP - N=N+1 - K(N,1)=1 - IF(ISTUP(IUP).EQ.2.OR.ISTUP(IUP).EQ.3) K(N,1)=11 - K(N,2)=IDUP(IUP) - IF(IDUP(IUP).EQ.0) K(N,2)=90 - IF(MSTP(128).LE.0.OR.MOTHUP(1,IUP).EQ.0) THEN - K(N,3)=KUPPO(IUP) - ELSE - K(N,3)=MINT(84)+MOTHUP(1,IUP) - ENDIF - K(N,4)=0 - K(N,5)=0 - DO 480 J=1,5 - P(N,J)=PUP(J,IUP) - 480 CONTINUE - V(N,5)=VTIMUP(IUP) - 490 CONTINUE - CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP) - -C...Arrange colour flow for user-defined processes - NLBL=0 - DO 540 IUP1=1,NUP - I1=MINT(84)+IUP1 - IF(KCHG(PYCOMP(K(I1,2)),2).EQ.0) GOTO 540 - IF(K(I1,1).EQ.1) K(I1,1)=3 - IF(K(I1,1).EQ.11) K(I1,1)=14 -C...Find a not yet considered colour/anticolour line. - DO 530 ISDE1=1,2 - IF(ICOLUP(ISDE1,IUP1).EQ.0) GOTO 530 - NMAT=0 - DO 500 ILBL=1,NLBL - IF(ICOLUP(ISDE1,IUP1).EQ.ILAB(ILBL)) NMAT=1 - 500 CONTINUE - IF(NMAT.EQ.0) THEN - NLBL=NLBL+1 - ILAB(NLBL)=ICOLUP(ISDE1,IUP1) -C...Find all others belonging to same line. - I3=I1 - I4=0 - DO 520 IUP2=IUP1+1,NUP - I2=MINT(84)+IUP2 - DO 510 ISDE2=1,2 - IF(ICOLUP(ISDE2,IUP2).EQ.ICOLUP(ISDE1,IUP1)) THEN - IF(ISDE2.EQ.ISDE1) THEN - K(I3,3+ISDE2)=K(I3,3+ISDE2)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I3 - I3=I2 - ELSEIF(I4.NE.0) THEN - K(I4,3+ISDE2)=K(I4,3+ISDE2)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I4 - I4=I2 - ELSEIF(IUP2.LE.2) THEN - K(I1,3+ISDE1)=K(I1,3+ISDE1)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+I1 - I4=I2 - ELSE - K(I1,3+ISDE1)=K(I1,3+ISDE1)+MSTU(5)*I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I1 - I4=I2 - ENDIF - ENDIF - 510 CONTINUE - 520 CONTINUE - ENDIF - 530 CONTINUE - 540 CONTINUE - - ELSEIF(IDOC.EQ.7) THEN -C...Resonance not decaying; store kinematics - I=MINT(83)+7 - K(IPU3,1)=1 - K(IPU3,2)=KFRES - K(IPU3,3)=I - P(IPU3,4)=SHUSER - P(IPU3,5)=SHUSER - K(I,1)=21 - K(I,2)=KFRES - P(I,4)=SHUSER - P(I,5)=SHUSER - N=IPU3 - MINT(21)=KFRES - MINT(22)=0 - -C...Special cases: colour flow in coloured resonances - KCRES=PYCOMP(KFRES) - IF(KCHG(KCRES,2).NE.0) THEN - K(IPU3,1)=3 - DO 550 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & MINT(84)+ICOL(KCC,1,JC) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & MINT(84)+ICOL(KCC,2,JC) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - 550 CONTINUE - ELSE - K(IPU1,4)=IPU2 - K(IPU1,5)=IPU2 - K(IPU2,4)=IPU1 - K(IPU2,5)=IPU1 - ENDIF - - ELSEIF(IDOC.EQ.8) THEN -C...2 -> 2 processes: store outgoing partons in their CM-frame - DO 560 JT=1,2 - I=MINT(84)+2+JT - KCA=PYCOMP(MINT(20+JT)) - K(I,1)=1 - IF(KCHG(KCA,2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - KFAA=IABS(K(I,2)) - IF(KFPR(ISUBSV,1+MOD(JS+JT,2)).NE.0) THEN - P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) - ELSE - P(I,5)=PYMASS(K(I,2)) - ENDIF - IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND. - & P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2)) - 560 CONTINUE - IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN - KFA1=IABS(MINT(21)) - KFA2=IABS(MINT(22)) - IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21)) - & THEN - MINT(51)=1 - RETURN - ENDIF - P(IPU3,5)=0D0 - P(IPU4,5)=0D0 - ENDIF - P(IPU3,4)=0.5D0*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR) - P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2)) - P(IPU4,4)=SHR-P(IPU3,4) - P(IPU4,3)=-P(IPU3,3) - N=IPU4 - MINT(7)=MINT(83)+7 - MINT(8)=MINT(83)+8 - -C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) - CALL PYROBO(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) - - ELSEIF(IDOC.EQ.9) THEN -C...2 -> 3 processes: store outgoing partons in their CM frame - DO 570 JT=1,2 - I=MINT(84)+2+JT - KCA=PYCOMP(MINT(20+JT)) - K(I,1)=1 - IF(KCHG(KCA,2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-3 - JTA=JT -C...t and b in opposide order in event list as compared to matrix element? - IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) JTA=3-JT - IF(IABS(K(I,2)).LE.22) THEN - P(I,5)=PYMASS(K(I,2)) - ELSE - P(I,5)=SQRT(VINT(63+MOD(JS+JTA,2))) - ENDIF - PT=SQRT(MAX(0D0,VINT(197+5*JTA)-P(I,5)**2+VINT(196+5*JTA)**2)) - P(I,1)=PT*COS(VINT(198+5*JTA)) - P(I,2)=PT*SIN(VINT(198+5*JTA)) - 570 CONTINUE - K(IPU5,1)=1 - K(IPU5,2)=KFRES - K(IPU5,3)=MINT(83)+IDOC - P(IPU5,5)=SHR - P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) - P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) - PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 - PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2 - PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2 - PMT3=SQRT(PMS3) - P(IPU5,3)=PMT3*SINH(VINT(211)) - P(IPU5,4)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2 - SQL12=(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2 - IF(SQL12.LE.0D0) THEN - MINT(51)=1 - RETURN - ENDIF - P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+ - & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) - P(IPU4,3)=-P(IPU3,3)-P(IPU5,3) - IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) THEN -C...t and b in opposide order in event list as compared to matrix element - P(IPU4,3)=(-P(IPU5,3)*(PMS12+PMS2-PMS1)+ - & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) - P(IPU3,3)=-P(IPU4,3)-P(IPU5,3) - END IF - P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2) - P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2) - MINT(23)=KFRES - N=IPU5 - MINT(7)=MINT(83)+7 - MINT(8)=MINT(83)+8 - - ELSEIF(IDOC.EQ.11) THEN -C...Z0 + Z0 -> h0, W+ + W- -> h0: store Higgs and outgoing partons - PHI(1)=PARU(2)*PYR(0) - PHI(2)=PHI(1)-PHIR - DO 580 JT=1,2 - I=MINT(84)+2+JT - K(I,1)=1 - IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - P(I,5)=PYMASS(K(I,2)) - IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN - MINT(51)=1 - RETURN - ENDIF - PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) - PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) - P(I,1)=PTABS*COS(PHI(JT)) - P(I,2)=PTABS*SIN(PHI(JT)) - P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) - P(I,4)=0.5D0*SHPR*Z(JT) - IZW=MINT(83)+6+JT - K(IZW,1)=21 - K(IZW,2)=23 - IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))) - K(IZW,3)=IZW-2 - P(IZW,1)=-P(I,1) - P(IZW,2)=-P(I,2) - P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) - P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) - P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) - 580 CONTINUE - I=MINT(83)+9 - K(IPU5,1)=1 - K(IPU5,2)=KFRES - K(IPU5,3)=I - P(IPU5,5)=SHR - P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) - P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) - P(IPU5,3)=-P(IPU3,3)-P(IPU4,3) - P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4) - K(I,1)=21 - K(I,2)=KFRES - DO 590 J=1,5 - P(I,J)=P(IPU5,J) - 590 CONTINUE - N=IPU5 - MINT(23)=KFRES - - ELSEIF(IDOC.EQ.12) THEN -C...Z0 and W+/- scattering: store bosons and outgoing partons - PHI(1)=PARU(2)*PYR(0) - PHI(2)=PHI(1)-PHIR - JTRAN=INT(1.5D0+PYR(0)) - DO 600 JT=1,2 - I=MINT(84)+2+JT - K(I,1)=1 - IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - P(I,5)=PYMASS(K(I,2)) - IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0D0 - PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) - PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) - P(I,1)=PTABS*COS(PHI(JT)) - P(I,2)=PTABS*SIN(PHI(JT)) - P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) - P(I,4)=0.5D0*SHPR*Z(JT) - IZW=MINT(83)+6+JT - K(IZW,1)=21 - IF(MINT(14+JT).EQ.MINT(20+JT)) THEN - K(IZW,2)=23 - ELSE - K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))-PYCHGE(MINT(20+JT))) - ENDIF - K(IZW,3)=IZW-2 - P(IZW,1)=-P(I,1) - P(IZW,2)=-P(I,2) - P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) - P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) - P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) - IPU=MINT(84)+4+JT - K(IPU,1)=3 - K(IPU,2)=KFPR(ISUB,JT) - IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2) - IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2) - K(IPU,3)=MINT(83)+8+JT - IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN - P(IPU,5)=PYMASS(K(IPU,2)) - ELSE - P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2))) - ENDIF - MINT(22+JT)=K(IPU,2) - 600 CONTINUE -C...Find rotation and boost for hard scattering subsystem - I1=MINT(83)+7 - I2=MINT(83)+8 - BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4)) - BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4)) - BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4)) - GAMCM=(P(I1,4)+P(I2,4))/SHR - BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3) - PX=P(I1,1)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEXCM - PY=P(I1,2)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEYCM - PZ=P(I1,3)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEZCM - THECM=PYANGL(PZ,SQRT(PX**2+PY**2)) - PHICM=PYANGL(PX,PY) -C...Store hard scattering subsystem. Rotate and boost it - SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4D0*P(IPU5,5)**2* - & P(IPU6,5)**2 - PABS=SQRT(MAX(0D0,SQLAM/(4D0*SH))) - CTHWZ=VINT(23) - STHWZ=SQRT(MAX(0D0,1D0-CTHWZ**2)) - PHIWZ=VINT(24)-PHICM - P(IPU5,1)=PABS*STHWZ*COS(PHIWZ) - P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ) - P(IPU5,3)=PABS*CTHWZ - P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2) - P(IPU6,1)=-P(IPU5,1) - P(IPU6,2)=-P(IPU5,2) - P(IPU6,3)=-P(IPU5,3) - P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2) - CALL PYROBO(IPU5,IPU6,THECM,PHICM,BEXCM,BEYCM,BEZCM) - DO 620 JT=1,2 - I1=MINT(83)+8+JT - I2=MINT(84)+4+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - DO 610 J=1,5 - P(I1,J)=P(I2,J) - 610 CONTINUE - 620 CONTINUE - N=IPU6 - MINT(7)=MINT(83)+9 - MINT(8)=MINT(83)+10 - ENDIF - - IF(ISET(ISUB).EQ.11) THEN - ELSEIF(IDOC.GE.8) THEN -C...Store colour connection indices - DO 630 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) - 630 CONTINUE - -C...Copy outgoing partons to documentation lines - IMAX=2 - IF(IDOC.EQ.9) IMAX=3 - DO 650 I=1,IMAX - I1=MINT(83)+IDOC-IMAX+I - I2=MINT(84)+2+I - K(I1,1)=21 - K(I1,2)=K(I2,2) - IF(IDOC.LE.9) K(I1,3)=0 - IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I - DO 640 J=1,5 - P(I1,J)=P(I2,J) - 640 CONTINUE - 650 CONTINUE - - ELSEIF(IDOC.EQ.9) THEN -C...Store colour connection indices - DO 660 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+ - & MAX(0,MIN(1,ICOL(KCC,1,JC)-2)) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+ - & MAX(0,MIN(1,ICOL(KCC,2,JC)-2)) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) - 660 CONTINUE - -C...Copy outgoing partons to documentation lines - DO 680 I=1,3 - I1=MINT(83)+IDOC-3+I - I2=MINT(84)+2+I - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=0 - DO 670 J=1,5 - P(I1,J)=P(I2,J) - 670 CONTINUE - 680 CONTINUE - ENDIF - -C...Low-pT events: remove gluons used for string drawing purposes - IF(ISUB.EQ.95) THEN - K(IPU3,1)=K(IPU3,1)+10 - K(IPU4,1)=K(IPU4,1)+10 - DO 690 J=41,66 - VINTSV(J)=VINT(J) - VINT(J)=0D0 - 690 CONTINUE - DO 710 I=MINT(83)+5,MINT(83)+8 - DO 700 J=1,5 - P(I,J)=0D0 - 700 CONTINUE - 710 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSFDC -C...Calculates decays of sfermions. - - SUBROUTINE PYSFDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2) - COMPLEX*16 CAL,CAR,CBL,CBR,CALP,CARP,CBLP,CBRP,CA,CB - INTEGER KFIN,KCIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,XMZ,AXMJ - DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS - DOUBLE PRECISION AL,AR,BL,BR - DOUBLE PRECISION CH1,CH2,CH3,CH4 - DOUBLE PRECISION XMBOT,XMTOP - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,ILR,IDU,J,I,IKNT,IFL,II - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA - DOUBLE PRECISION CW - DOUBLE PRECISION BETA,ALFA,XMU,AT,AB,ATRIT,ATRIB,ATRIL - DOUBLE PRECISION COSA,SINA,TANB - DOUBLE PRECISION PYALEM,PI,PYALPS,EI - DOUBLE PRECISION GHRR,GHLL,GHLR,XMB,BLR - INTEGER IG,KF1,KF2 - INTEGER IGG(4),KFNCHI(4),KFCCHI(2) - DATA IGG/23,25,35,36/ - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - -C...NO NU_R DECAYS - IF(KFIN.EQ.KSUSY2+12.OR.KFIN.EQ.KSUSY2+14.OR. - &KFIN.EQ.KSUSY2+16) RETURN - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - CW=SQRT(1D0-XW) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - -C...KCIN - KCIN=PYCOMP(KFIN) -C...ILR is 1 for left and 2 for right. - ILR=KFIN/KSUSY1 -C...IFL is matching non-SUSY flavour. - IFL=MOD(KFIN,KSUSY1) -C...IDU is weak isospin, 1 for down and 2 for up. - IDU=2-MOD(IFL,2) - - XMI=PMAS(KCIN,1) - XMI2=XMI**2 - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=XMI**3 - EI=KCHG(IFL,1)/3D0 - - XMBOT=PYMRUN(5,XMI2) - XMTOP=PYMRUN(6,XMI2) - - TANB=RMSS(5) - BETA=ATAN(TANB) - ALFA=RMSS(18) - CBETA=COS(BETA) - SBETA=TANB*CBETA - SINA=SIN(ALFA) - COSA=COS(ALFA) - XMU=-RMSS(4) - ATRIT=RMSS(16) - ATRIB=RMSS(15) - ATRIL=RMSS(17) - -C...2-BODY DECAYS OF SFERMION -> GRAVITINO + FERMION - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - XFAC=(XMI2/(XMP*XMGR))**2*XMI/48D0/PI - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(XMI.GT.XMGR+XMF) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(1D0-XMF**2/XMI2)**4 - ENDIF - ENDIF - -C...2-BODY DECAYS OF SFERMION -> FERMION + GAUGE/GAUGINO - -C...CHARGED DECAYS: - DO 140 IX=1,2 -C...DI -> U CHI1-,CHI2- - IF(IDU.EQ.1) THEN - XMFP=PMAS(IFL+1,1) - XMF =PMAS(IFL,1) -C...UI -> D CHI1+,CHI2+ - ELSE - XMFP=PMAS(IFL-1,1) - XMF =PMAS(IFL,1) - ENDIF - XMJ=SMW(IX) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMFP) THEN - XMA2=XMJ**2 - XMB2=XMFP**2 - IF(IDU.EQ.2) THEN - IF(IFL.EQ.6) THEN - XMFP=XMBOT - XMF =XMTOP - ELSEIF(IFL.LT.6) THEN - XMF=0D0 - XMFP=0D0 - ENDIF - CBL=VMIXC(IX,1) - CAL=-XMFP*UMIXC(IX,2)/SR2/XMW/CBETA - CBR=-XMF*VMIXC(IX,2)/SR2/XMW/SBETA - CAR=0D0 - ELSE - IF(IFL.EQ.5) THEN - XMF =XMBOT - XMFP=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - XMFP=0D0 - ENDIF - CBL=UMIXC(IX,1) - CAL=-XMFP*VMIXC(IX,2)/SR2/XMW/SBETA - CBR=-XMF*UMIXC(IX,2)/SR2/XMW/CBETA - CAR=0D0 - ENDIF - - CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR - CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR - CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL - CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL - CAL=CALP - CBL=CBLP - CAR=CARP - CBR=CBRP - -C...F1 -> F` CHI - IF(ILR.EQ.1) THEN - CA=CAL - CB=CBL -C...F2 -> F` CHI - ELSE - CA=CAR - CB=CBR - ENDIF - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMA2,XMB2) -C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT - XLAM(LKNT)=2D0*C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMFP) - IDLAM(LKNT,3)=0 - IF(IDU.EQ.1) THEN - IDLAM(LKNT,1)=-KFCCHI(IX) - IDLAM(LKNT,2)=IFL+1 - ELSE - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=IFL-1 - ENDIF - ENDIF - 140 CONTINUE - -C...NEUTRAL DECAYS - DO 150 IX=1,4 -C...DI -> D CHI10 - XMF=PMAS(IFL,1) - XMJ=SMZ(IX) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMF) THEN - XMA2=XMJ**2 - XMB2=XMF**2 - IF(IDU.EQ.1) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ENDIF - CBL=-ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI+1) - CAL=XMF*ZMIXC(IX,3)/XMW/CBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ELSE - IF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ENDIF - CBL=ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-1) - CAL=XMF*ZMIXC(IX,4)/XMW/SBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ENDIF - - CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR - CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR - CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL - CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL - CAL=CALP - CBL=CBLP - CAR=CARP - CBR=CBRP - -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - CA=CAL - CB=CBL -C...F2 -> F CHI - ELSE - CA=CAR - CB=CBR - ENDIF - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMA2,XMB2) -C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMF) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - ENDIF - 150 CONTINUE - -C...2-BODY DECAYS TO SM GAUGE AND HIGGS BOSONS -C...IG=23,25,35,36 - DO 160 II=1,4 - IG=IGG(II) - IF(ILR.EQ.1) GOTO 160 - XMB=PMAS(IG,1) - XMSF1=PMAS(PYCOMP(KFIN-KSUSY1),1) - IF(XMI.LT.XMSF1+XMB) GOTO 160 - IF(IG.EQ.23) THEN - BL=-SIGN(.5D0,EI)/CW+EI*XW/CW - BR=EI*XW/CW - BLR=0D0 - ELSEIF(IG.EQ.25) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IDU.EQ.2) THEN - GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*COSA/SBETA - GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*COSA/SBETA - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*(-SINA)/CBETA - GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*(-SINA)/CBETA - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW/SBETA*(-XMU*SINA+ - & AT*COSA) - ELSE - GHLR=XMF/2D0/XMW/CBETA*(XMU*COSA- - & AT*SINA) - ENDIF - BL=GHLL - BR=GHRR - BLR=-GHLR - ELSEIF(IG.EQ.35) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IDU.EQ.2) THEN - GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*SINA/SBETA - GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*SINA/SBETA - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*COSA/CBETA - GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*COSA/CBETA - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........Need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW/SBETA*(XMU*COSA+ - & AT*SINA) - ELSE - GHLR=XMF/2D0/XMW/CBETA*(XMU*SINA+ - & AT*COSA) - ENDIF - BL=GHLL - BR=GHRR - BLR=GHLR - ELSEIF(IG.EQ.36) THEN - GHLL=0D0 - GHRR=0D0 - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........Need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW*(-XMU+AT/TANB) - ELSE - GHLR=XMF/2D0/XMW/(-XMU+AT*TANB) - ENDIF - BL=GHLL - BR=GHRR - BLR=GHLR - ENDIF - AL=SFMIX(IFL,1)*SFMIX(IFL,3)*BL+ - & SFMIX(IFL,2)*SFMIX(IFL,4)*BR+ - & (SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,3)*SFMIX(IFL,2))*BLR - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 - IF(IG.EQ.23) THEN - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - ELSE - XLAM(LKNT)=C1/4D0/XMI3*SQRT(XL)*AL**2 - ENDIF - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KFIN-KSUSY1 - IDLAM(LKNT,2)=IG - 160 CONTINUE - -C...SF -> SF' + W - XMB=PMAS(24,1) - IF(MOD(IFL,2).EQ.0) THEN - KF1=KSUSY1+IFL-1 - ELSE - KF1=KSUSY1+IFL+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - IF(XMI.GT.XMB+XMSF1) THEN - IF(MOD(IFL,2).EQ.0) THEN - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,1) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,1) - ENDIF - ELSE - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,1) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,1) - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) - ENDIF - IF(XMI.GT.XMB+XMSF2) THEN - IF(MOD(IFL,2).EQ.0) THEN - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,3) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,3) - ENDIF - ELSE - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,3) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,3) - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF2**2,XMB**2) - LKNT=LKNT+1 - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) - ENDIF - -C...SF -> SF' + HC - XMB=PMAS(37,1) - IF(MOD(IFL,2).EQ.0) THEN - KF1=KSUSY1+IFL-1 - ELSE - KF1=KSUSY1+IFL+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - IF(XMI.GT.XMB+XMSF1) THEN - XMF=0D0 - XMFP=0D0 - AT=0D0 - AB=0D0 - IF(MOD(IFL,2).EQ.0) THEN -C...T1-> B1 HC - IF(ILR.EQ.1) THEN - CH1=-SFMIX(IFL,1)*SFMIX(IFL-1,1) - CH2= SFMIX(IFL,2)*SFMIX(IFL-1,2) - CH3=-SFMIX(IFL,1)*SFMIX(IFL-1,2) - CH4=-SFMIX(IFL,2)*SFMIX(IFL-1,1) -C...T2-> B1 HC - ELSE - CH1= SFMIX(IFL,3)*SFMIX(IFL-1,1) - CH2=-SFMIX(IFL,4)*SFMIX(IFL-1,2) - CH3= SFMIX(IFL,3)*SFMIX(IFL-1,2) - CH4= SFMIX(IFL,4)*SFMIX(IFL-1,1) - ENDIF - IF(IFL.EQ.6) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ELSE -C...B1 -> T1 HC - IF(ILR.EQ.1) THEN - CH1=-SFMIX(IFL+1,1)*SFMIX(IFL,1) - CH2= SFMIX(IFL+1,2)*SFMIX(IFL,2) - CH3=-SFMIX(IFL+1,1)*SFMIX(IFL,2) - CH4=-SFMIX(IFL+1,2)*SFMIX(IFL,1) -C...B2-> T1 HC - ELSE - CH1= SFMIX(IFL,3)*SFMIX(IFL+1,1) - CH2=-SFMIX(IFL,4)*SFMIX(IFL+1,2) - CH3= SFMIX(IFL,4)*SFMIX(IFL+1,1) - CH4= SFMIX(IFL,3)*SFMIX(IFL+1,2) - ENDIF - IF(IFL.EQ.5) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 -C.......Need to complexify - AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ - & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ - & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) - ENDIF - IF(XMI.GT.XMB+XMSF2) THEN - XMF=0D0 - XMFP=0D0 - AT=0D0 - AB=0D0 - IF(MOD(IFL,2).EQ.0) THEN -C...T1-> B2 HC - IF(ILR.EQ.1) THEN - CH1= SFMIX(IFL-1,3)*SFMIX(IFL,1) - CH2=-SFMIX(IFL-1,4)*SFMIX(IFL,2) - CH3= SFMIX(IFL-1,4)*SFMIX(IFL,1) - CH4= SFMIX(IFL-1,3)*SFMIX(IFL,2) -C...T2-> B2 HC - ELSE - CH1= -SFMIX(IFL,3)*SFMIX(IFL-1,3) - CH2= SFMIX(IFL,4)*SFMIX(IFL-1,4) - CH3= -SFMIX(IFL,3)*SFMIX(IFL-1,4) - CH4= -SFMIX(IFL,4)*SFMIX(IFL-1,3) - ENDIF - IF(IFL.EQ.6) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ELSE -C...B1 -> T2 HC - IF(ILR.EQ.1) THEN - CH1= SFMIX(IFL+1,3)*SFMIX(IFL,1) - CH2=-SFMIX(IFL+1,4)*SFMIX(IFL,2) - CH3= SFMIX(IFL+1,3)*SFMIX(IFL,2) - CH4= SFMIX(IFL+1,4)*SFMIX(IFL,1) -C...B2-> T2 HC - ELSE - CH1= -SFMIX(IFL+1,3)*SFMIX(IFL,3) - CH2= SFMIX(IFL+1,4)*SFMIX(IFL,4) - CH3= -SFMIX(IFL+1,3)*SFMIX(IFL,4) - CH4= -SFMIX(IFL+1,4)*SFMIX(IFL,3) - ENDIF - IF(IFL.EQ.5) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 -C.......Need to complexify - AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ - & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ - & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) - ENDIF - -C...2-BODY DECAYS OF SQUARK -> QUARK GLUINO - - IF(IFL.LE.6) THEN - XMFP=0D0 - XMF=0D0 - IF(IFL.EQ.6) XMF=PMAS(6,1) - IF(IFL.EQ.5) XMF=PMAS(5,1) - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMF) THEN - AL=-SFMIX(IFL,3) - BL=SFMIX(IFL,1) - AR=-SFMIX(IFL,4) - BR=SFMIX(IFL,2) -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - XCA=AL - XCB=BL -C...F2 -> F CHI - ELSE - XCA=AR - XCB=BR - ENDIF - LKNT=LKNT+1 - XMA2=XMJ**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=4D0/3D0*AS/2D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (XCA**2+XCB**2)+4D0*XCA*XCB*XMJ*XMF) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - ENDIF - ENDIF - -C...IF NOTHING ELSE FOR T1, THEN T1* -> C+CHI0 - IF(KFIN.EQ.KSUSY1+6.AND.PMAS(KCIN,1).GT. - &PMAS(PYCOMP(KSUSY1+22),1)+PMAS(4,1)) THEN -C...THIS IS A BACK-OF-THE-ENVELOPE ESTIMATE -C...M = 1/(16PI**2)G**3 = G*2/(4PI) G/(4PI) = C1 * G/(4PI) -C...M*M = C1**2 * G**2/(16PI**2) -C...G = 1/(8PI)P/MI**2 * M*M = C1**3/(32PI**2)*LAM/(2*MI**3) - LKNT=LKNT+1 - XL=PYLAMF(XMI2,0D0,PMAS(PYCOMP(KSUSY1+22),1)**2) - XLAM(LKNT)=C1**3/64D0/PI**2/XMI3*SQRT(XL) - IF(XLAM(LKNT).EQ.0) XLAM(LKNT)=1D-3 - IDLAM(LKNT,1)=KSUSY1+22 - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=0 - ENDIF - -C...R-violating sfermion decays (SKANDS). - CALL PYRVSF(KFIN,XLAM,IDLAM,LKNT) - - IKNT=LKNT - XLAM(0)=0D0 - DO 170 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 170 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-3 - - RETURN - END - -C********************************************************************* - -C...PYSGEX -C...Subprocess cross sections for assorted exotic processes, -C...including Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGEX(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.160) THEN - IF(ISUB.EQ.141) THEN -C...f + fbar -> gamma*/Z0/Z'0 - SQMZP=PMAS(32,1)**2 - MINT(61)=2 - CALL PYWIDT(32,SH,WDTP,WDTE) - HP0=AEM/3D0*SH - HP1=AEM/3D0*XWC*SH - HP2=HP1 - HS=SHR*VINT(117) - HSP=SHR*WDTP(0) - FACZP=4D0*COMFAC*3D0 - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - IA=IABS(I) - IF(IA.LT.10) THEN - IF(IA.LE.2) THEN - VPI=PARU(123-2*MOD(IABS(I),2)) - API=PARU(124-2*MOD(IABS(I),2)) - ELSEIF(IA.LE.4) THEN - VPI=PARJ(182-2*MOD(IABS(I),2)) - API=PARJ(183-2*MOD(IABS(I),2)) - ELSE - VPI=PARJ(190-2*MOD(IABS(I),2)) - API=PARJ(191-2*MOD(IABS(I),2)) - ENDIF - ELSE - IF(IA.LE.12) THEN - VPI=PARU(127-2*MOD(IABS(I),2)) - API=PARU(128-2*MOD(IABS(I),2)) - ELSEIF(IA.LE.14) THEN - VPI=PARJ(186-2*MOD(IABS(I),2)) - API=PARJ(187-2*MOD(IABS(I),2)) - ELSE - VPI=PARJ(194-2*MOD(IABS(I),2)) - API=PARJ(195-2*MOD(IABS(I),2)) - ENDIF - ENDIF - HI0=HP0 - IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 - HI1=HP1 - IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 - HI2=HP2 - IF(IABS(I).LE.10) HI2=HI2*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI* - & (1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)* - & VINT(112)+EI*VPI*(1D0-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)* - & (HI0*HP2+HI2*HP0)*VINT(113)+(VI**2+AI**2)/ - & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+(VI*VPI+AI*API)* - & ((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+HS**2)* - & ((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+ - & (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116)) - 100 CONTINUE - - ELSEIF(ISUB.EQ.142) THEN -C...f + fbar' -> W'+/- - SQMWP=PMAS(34,1)**2 - CALL PYWIDT(34,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMWP)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - IA=IABS(I) - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 110 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*(PARU(133)**2+PARU(134)**2) - IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)* - & VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.144) THEN -C...f + fbar' -> R - SQMR=PMAS(41,1)**2 - CALL PYWIDT(41,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMR)**2+HS**2)*3D0 - HP=AEM/(12D0*XW)*SH - DO 140 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 - IA=IABS(I) - DO 130 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 - JA=IABS(J) - IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 130 - HI=HP - IF(IA.LE.10) HI=HI*FACA/3D0 - HF=SHR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 130 CONTINUE - 140 CONTINUE - - ELSEIF(ISUB.EQ.145) THEN -C...q + l -> LQ (leptoquark) - SQMLQ=PMAS(42,1)**2 - CALL PYWIDT(42,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMLQ)**2+HS**2) - IF(ABS(SHR-PMAS(42,1)).GT.PARP(48)*PMAS(42,2)) FACBW=0D0 - HP=AEM/4D0*SH - KFLQQ=KFDP(MDCY(42,2),1) - KFLQL=KFDP(MDCY(42,2),2) - DO 160 I=MMIN1,MMAX1 - IF(KFAC(1,I).EQ.0) GOTO 160 - IA=IABS(I) - IF(IA.NE.KFLQQ.AND.IA.NE.IABS(KFLQL)) GOTO 160 - DO 150 J=MMIN2,MMAX2 - IF(KFAC(2,J).EQ.0) GOTO 150 - JA=IABS(J) - IF(JA.NE.KFLQQ.AND.JA.NE.IABS(KFLQL)) GOTO 150 - IF(I*J.NE.KFLQQ*KFLQL) GOTO 150 - IF(JA.EQ.IA) GOTO 150 - IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I) - IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J) - HI=HP*PARU(151) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 150 CONTINUE - 160 CONTINUE - - ELSEIF(ISUB.EQ.146) THEN -C...e + gamma* -> e* (excited lepton) - KFQSTR=KFPR(ISUB,1) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) - QF=-RTCM(43)/2D0-RTCM(44)/2D0 - FACBW=FACBW*AEM*QF**2*SH/RTCM(41)**2 - IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) - & FACBW=0D0 - HP=SH - DO 180 I=-KFQEXC,KFQEXC,2*KFQEXC - DO 170 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 170 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 170 - HI=HP - IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 170 CONTINUE - 180 CONTINUE - - ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN -C...d + g -> d* and u + g -> u* (excited quarks) - KFQSTR=KFPR(ISUB,1) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) - FACBW=FACBW*AS*RTCM(45)**2*SH/(3D0*RTCM(41)**2) - IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) - & FACBW=0D0 - HP=SH - DO 200 I=-KFQEXC,KFQEXC,2*KFQEXC - DO 190 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 190 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 190 - HI=HP - IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 190 CONTINUE - 200 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.190) THEN - IF(ISUB.EQ.162) THEN -C...q + g -> LQ + lbar; LQ=leptoquark - SQMLQ=PMAS(42,1)**2 - FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6D0)*(-TH/SH)* - & (UH2+SQMLQ**2)/(UH-SQMLQ)**2 - KFLQQ=KFDP(MDCY(42,2),1) - DO 220 I=MMINA,MMAXA - IF(IABS(I).NE.KFLQQ) GOTO 220 - KCHLQ=ISIGN(1,I) - DO 210 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 210 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 210 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLQ*WIDS(42,(5-KCHLQ)/2) - 210 CONTINUE - 220 CONTINUE - - ELSEIF(ISUB.EQ.163) THEN -C...g + g -> LQ + LQbar; LQ=leptoquark - SQMLQ=PMAS(42,1)**2 - FACLQ=COMFAC*FACA*WIDS(42,1)*(AS**2/2D0)* - & (7D0/48D0+3D0*(UH-TH)**2/(16D0*SH2))*(1D0+2D0*SQMLQ*TH/ - & (TH-SQMLQ)**2+2D0*SQMLQ*UH/(UH-SQMLQ)**2+4D0*SQMLQ**2/ - & ((TH-SQMLQ)*(UH-SQMLQ))) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 230 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 -C...Since don't know proper colour flow, randomize between alternatives - ISIG(NCHN,3)=INT(1.5D0+PYR(0)) - SIGH(NCHN)=FACLQ - 230 CONTINUE - - ELSEIF(ISUB.EQ.164) THEN -C...q + qbar -> LQ + LQbar; LQ=leptoquark - DELTA=0.25D0*(SQM3-SQM4)**2/SH - SQMLQ=0.5D0*(SQM3+SQM4)-DELTA - TH=TH-DELTA - UH=UH-DELTA -C SQMLQ=PMAS(42,1)**2 - FACLQA=COMFAC*WIDS(42,1)*(AS**2/9D0)* - & (SH*(SH-4D0*SQMLQ)-(UH-TH)**2)/SH2 - FACLQS=COMFAC*WIDS(42,1)*((PARU(151)**2*AEM**2/8D0)* - & (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18D0)* - & ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH)) - KFLQQ=KFDP(MDCY(42,2),1) - DO 240 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 240 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLQA - IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS - 240 CONTINUE - - ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN -C...q + q' -> q" + d* and q + q' -> q" + u* (excited quarks) - KFQSTR=KFPR(ISUB,2) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - FACQSA=COMFAC*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH) - FACQSB=COMFAC*0.25D0*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* - & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) -C...Propagators: as simulated in PYOFSH and as desired - GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) - HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) - CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) - GMMQC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) - FACQSA=FACQSA*HBW4C/HBW4 - FACQSB=FACQSB*HBW4C/HBW4 -C...Branching ratios. - BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) - BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) - DO 260 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 260 - DO 250 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 250 - IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS - IF(I.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS - IF(J.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG - ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 - IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSA*BRPOS - IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSA*BRNEG - ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG - ELSEIF(I.EQ.-J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG - ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 - IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSB*BRNEG - ENDIF - 250 CONTINUE - 260 CONTINUE - - ELSEIF(ISUB.EQ.169) THEN -C...q + qbar -> e + e* (excited lepton) - KFQSTR=KFPR(ISUB,2) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - FACQSB=(COMFAC/12D0)*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* - & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) -C...Propagators: as simulated in PYOFSH and as desired - GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) - HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) - CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) - GMMQC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) - FACQSB=FACQSB*HBW4C/HBW4 -C...Branching ratios. - BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) - BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) - DO 270 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 270 - J=-I - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 270 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG - 270 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.360) THEN - IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN -C...l + l -> H_L++/-- or H_R++/--. - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - CALL PYWIDT(KFRES,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=8D0*COMFAC/((SH-PMAS(KFREC,1)**2)**2+HS**2) - DO 290 I=MMIN1,MMAX1 - IA=IABS(I) - IF((IA.NE.11.AND.IA.NE.13.AND.IA.NE.15).OR.KFAC(1,I).EQ.0) - & GOTO 290 - DO 280 J=MMIN2,MMAX2 - JA=IABS(J) - IF((JA.NE.11.AND.JA.NE.13.AND.JA.NE.15).OR.KFAC(2,J).EQ.0) - & GOTO 280 - IF(I*J.LT.0) GOTO 280 - KCHH=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HI=SH*PARP(181+3*((IA-11)/2)+(JA-11)/2)**2/(8D0*PARU(1)) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 280 CONTINUE - 290 CONTINUE - - ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN -C...l + gamma -> H_L++/-- l' or l + gamma -> H_R++/-- l'. - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) -C...Propagators: as simulated in PYOFSH and as desired - HBW3=PMAS(KFREC,1)*PMAS(KFREC,2)/((SQM3-PMAS(KFREC,1)**2)**2+ - & (PMAS(KFREC,1)*PMAS(KFREC,2))**2) - CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) - GMMC=SQRT(SQM3)*WDTP(0) - HBW3C=GMMC/((SQM3-PMAS(KFREC,1)**2)**2+GMMC**2) - FHCC=COMFAC*AEM*HBW3C/HBW3 - DO 310 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.11.AND.IA.NE.13.AND.IA.NE.15) GOTO 310 - SQML=PMAS(IA,1)**2 - J=ISIGN(KFPR(ISUB,2),-I) - KCHH=ISIGN(2,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))/WDTP(0) - SMM1=8D0*(SH+TH-SQM3)*(SH+TH-2D0*SQM3-SQML-SQM4)/ - & (UH-SQM3)**2 - SMM2=2D0*((2D0*SQM3-3D0*SQML)*SQM4+(SQML-2D0*SQM4)*TH- - & (TH-SQM4)*SH)/(TH-SQM4)**2 - SMM3=2D0*((2D0*SQM3-3D0*SQM4+TH)*SQML-(2D0*SQML-SQM4+TH)* - & SH)/(SH-SQML)**2 - SMM12=4D0*((2D0*SQML-SQM4-2D0*SQM3+TH)*SH+(TH-3D0*SQM3- - & 3D0*SQM4)*TH+(2D0*SQM3-2D0*SQML+3D0*SQM4)*SQM3)/ - & ((UH-SQM3)*(TH-SQM4)) - SMM13=-4D0*((TH+SQML-2D0*SQM4)*TH-(SQM3+3D0*SQML-2D0*SQM4)* - & SQM3+(SQM3+3D0*SQML+TH)*SH-(TH-SQM3+SH)**2)/ - & ((UH-SQM3)*(SH-SQML)) - SMM23=-4D0*((SQML-SQM4+SQM3)*TH-SQM3**2+SQM3*(SQML+SQM4)- - & 3D0*SQML*SQM4-(SQML-SQM4-SQM3+TH)*SH)/ - & ((SH-SQML)*(TH-SQM4)) - SMM=(SH/(SH-SQML))**2*(SMM1+SMM2+SMM3+SMM12+SMM13+SMM23)* - & PARP(181+3*((IA-11)/2)+(IABS(J)-11)/2)**2/(4D0*PARU(1)) - DO 300 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 300 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 300 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=0 - SIGH(NCHN)=FHCC*SMM*WIDSC - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN -C...f + fbar -> H_L++ + H_L-- or H_R++ + H_R-- - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - SQMH=PMAS(KFREC,1)**2 - GMMH=PMAS(KFREC,1)*PMAS(KFREC,2) -C...Propagators: H++/-- as simulated in PYOFSH and as desired - HBW3=GMMH/((SQM3-SQMH)**2+GMMH**2) - CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) - GMMH3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMH3/((SQM3-SQMH)**2+GMMH3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFRES,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) -C...Kinematical and coupling functions - FACHH=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*(TH*UH-SQM3*SQM4) - XWHH=(1D0-2D0*XWV)/(8D0*XWV*(1D0-XWV)) -C...Loop over allowed flavours - DO 320 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF(ISUB.EQ.349) THEN - HBWZ=1D0/((SH-SQMZ)**2+GMMZ**2) - IF(IABS(I).LT.10) THEN - DSIGHH=8D0*AEM**2*(EI**2/SH2+ - & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ - & (VI**2+AI**2)*XWHH**2*HBWZ) - ELSE - IAOFF=181+3*((IABS(I)-11)/2) - HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ - & (4D0*PARU(1)) - DSIGHH=8D0*AEM**2*(EI**2/SH2+ - & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ - & (VI**2+AI**2)*XWHH**2*HBWZ)+ - & 8D0*AEM*(EI*HSUM/(SH*TH)+ - & (VI+AI)*XWHH*HSUM*(SH-SQMZ)*HBWZ/TH)+ - & 4D0*HSUM**2/TH2 - ENDIF - ELSE - IF(IABS(I).LT.10) THEN - DSIGHH=8D0*AEM**2*EI**2/SH2 - ELSE - IAOFF=181+3*((IABS(I)-11)/2) - HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ - & (4D0*PARU(1)) - DSIGHH=8D0*AEM**2*EI**2/SH2+8D0*AEM*EI*HSUM/(SH*TH)+ - & 4D0*HSUM**2/TH2 - ENDIF - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHH*FCOI*DSIGHH - 320 CONTINUE - - ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN -C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- as inner process) - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - SQMH=PMAS(KFREC,1)**2 - IF(ISUB.EQ.351) FACNOR=PARP(190)**8*PARP(192)**2 - IF(ISUB.EQ.352) FACNOR=PARP(191)**6*2D0* - & PMAS(PYCOMP(9900024),1)**2 - FACWW=COMFAC*FACNOR*TAUP*VINT(2)*VINT(219) - FACPRT=1D0/((VINT(204)**2-VINT(215))* - & (VINT(209)**2-VINT(216))) - FACPRU=1D0/((VINT(204)**2+2D0*VINT(217))* - & (VINT(209)**2+2D0*VINT(218))) - CALL PYWIDT(KFRES,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=(1D0/PARU(1))*VINT(2)/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFREC,1)).GT.PARP(48)*PMAS(KFREC,2)) - & FACBW=0D0 - DO 340 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340 - IF(ISUB.EQ.352.AND.IABS(I).GT.10) GOTO 340 - KCHWI=(1-2*MOD(IABS(I),2))*ISIGN(1,I) - DO 330 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330 - IF(ISUB.EQ.352.AND.IABS(J).GT.10) GOTO 330 - KCHWJ=(1-2*MOD(IABS(J),2))*ISIGN(1,J) - KCHH=KCHWI+KCHWJ - IF(IABS(KCHH).NE.2) GOTO 330 - FACLR=VINT(180+I)*VINT(180+J) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) - IF(I.EQ.J.AND.IABS(I).GT.10) THEN - FACPRP=0.5D0*(FACPRT+FACPRU)**2 - ELSE - FACPRP=FACPRT**2 - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLR*FACWW*FACPRP*FACBW*HF - 330 CONTINUE - 340 CONTINUE - - ELSEIF(ISUB.EQ.353) THEN -C...f + fbar -> Z_R0 - SQMZR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 - CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMZR)**2+HS**2)*3D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HP=(AEM/(3D0*(1D0-2D0*XW)))*XWC*SH - DO 350 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350 - IF(IABS(I).LE.8) THEN - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0)*(1D0-2D0*XW) - VI=SIGN(1D0,EI+0.1D0)-4D0*EI*XW - ELSE - AI=-(1D0-2D0*XW) - VI=-1D0+4D0*XW - ENDIF - HI=HP*(VI**2+AI**2) - IF(IABS(I).LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 350 CONTINUE - - ELSEIF(ISUB.EQ.354) THEN -C...f + fbar' -> W_R+/- - SQMWR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 - CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMWR)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 370 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370 - IA=IABS(I) - DO 360 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 360 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*2D0 - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 360 CONTINUE - 370 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.400) THEN - IF(ISUB.EQ.391) THEN -C...f + fbar -> G*. - KFGSTR=KFPR(ISUB,1) - KCGSTR=PYCOMP(KFGSTR) - CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACG=COMFAC*PARP(50)**2/(16D0*PARU(1))*SH*HF/ - & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) -C...Modify cross section in wings of peak. - FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4 - DO 380 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 - HI=1D0 - IF(IABS(I).LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG*HI - 380 CONTINUE - - ELSEIF(ISUB.EQ.392) THEN -C...g + g -> G*. - KFGSTR=KFPR(ISUB,1) - KCGSTR=PYCOMP(KFGSTR) - CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACG=COMFAC*PARP(50)**2/(32D0*PARU(1))*SH*HF/ - & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) -C...Modify cross section in wings of peak. - FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 390 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 390 CONTINUE - - ELSEIF(ISUB.EQ.393) THEN -C...q + qbar -> g + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=COMFAC*PARP(50)**2*AS*SH/(72D0*PARU(1)*SQM4)* - & (4D0*(TH2+UH2)/SH2+9D0*(TH+UH)/SH+(TH2/UH+UH2/TH)/SH+ - & 3D0*(4D0+TH/UH+UH/TH)+4D0*(SH/UH+SH/TH)+ - & 2D0*SH2/(TH*UH)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - DO 400 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 400 CONTINUE - - ELSEIF(ISUB.EQ.394) THEN -C...q + g -> q + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=-COMFAC*PARP(50)**2*AS*SH/(192D0*PARU(1)*SQM4)* - & (4D0*(SH2+UH2)/(TH*SH)+9D0*(SH+UH)/SH+SH/UH+UH2/SH2+ - & 3D0*TH*(4D0+SH/UH+UH/SH)/SH+4D0*TH2*(1D0/UH+1D0/SH)/SH+ - & 2D0*TH2*TH/(UH*SH2)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - DO 420 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 420 - DO 410 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 410 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 410 CONTINUE - 420 CONTINUE - - ELSEIF(ISUB.EQ.395) THEN -C...g + g -> g + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=COMFAC*3D0*PARP(50)**2*AS*SH/(32D0*PARU(1)*SQM4)* - & ((TH2+TH*UH+UH2)**2/(SH2*TH*UH)+2D0*(TH2/UH+UH2/TH)/SH+ - & 3D0*(TH/UH+UH/TH)+2D0*(SH/UH+SH/TH)+SH2/(TH*UH)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGHF -C...Subprocess cross sections for heavy flavour production, -C...open and closed. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGHF(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.100) THEN - IF(ISUB.EQ.81) THEN -C...q + qbar -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ - & 2D0*SQMAVG/SH) - IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQB=FACQQB*WID2 - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 100 CONTINUE - - ELSEIF(ISUB.EQ.82) THEN -C...g + g -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 - IF(MSTP(35).GE.1) THEN - FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) - FACQQ1=FACQQ1*FATRE - FACQQ2=FACQQ2*FATRE - ENDIF - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ1=FACQQ1*WID2 - FACQQ2=FACQQ2*WID2 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 110 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 110 CONTINUE - - ELSEIF(ISUB.EQ.83) THEN -C...f + q -> f' + Q - FACQQS=COMFAC*(0.5D0*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2 - FACQQU=COMFAC*(0.5D0*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2 - DO 130 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 130 - DO 120 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 120 - IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 120 - IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 120 - IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1) - & THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, - & (IABS(I)+1)/2)*VINT(180+J) - IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2, - & (MINT(55)+1)/2)*VINT(180+J) - WID2=1D0 - IF(I.GT.0) THEN - IF(MINT(55).EQ.6) WID2=WIDS(6,2) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),2) - ELSE - IF(MINT(55).EQ.6) WID2=WIDS(6,3) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),3) - ENDIF - IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 - IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 - ENDIF - IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1) - & THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, - & (IABS(J)+1)/2)*VINT(180+I) - IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2, - & (MINT(55)+1)/2)*VINT(180+I) - IF(J.GT.0) THEN - IF(MINT(55).EQ.6) WID2=WIDS(6,2) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),2) - ELSE - IF(MINT(55).EQ.6) WID2=WIDS(6,3) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),3) - ENDIF - IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 - IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 - ENDIF - 120 CONTINUE - 130 CONTINUE - - ELSEIF(ISUB.EQ.84) THEN -C...g + gamma -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3D0)**2* - & (THQ**2+UHQ**2+4D0*SQMAVG*SH*(1D0-SQMAVG*SH/(THQ*UHQ)))/ - & (THQ*UHQ) - IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ=FACQQ*WID2 - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.EQ.85) THEN -C...gamma + gamma -> F + Fbar (heavy fermion, quark or lepton) - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3D0)**4*2D0* - & ((1D0-PARJ(131)*PARJ(132))*(THQ*UHQ-SQMAVG*SH)* - & (UHQ**2+THQ**2+2D0*SQMAVG*SH)+(1D0+PARJ(131)*PARJ(132))* - & SQMAVG*SH**2*(SH-2D0*SQMAVG))/(THQ*UHQ)**2 - IF(IABS(MINT(56)).LT.10) FACFF=3D0*FACFF - IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1) - & FACFF=FACFF*PYHFTH(SH,SQMAVG,1D0) - WID2=1D0 - IF(MINT(56).EQ.6) WID2=WIDS(6,1) - IF(MINT(56).EQ.7.OR.MINT(56).EQ.8) WID2=WIDS(MINT(56),1) - IF(MINT(56).EQ.17) WID2=WIDS(17,1) - FACFF=FACFF*WID2 - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ELSEIF(ISUB.EQ.86) THEN -C...g + g -> J/Psi + g - FACQQG=COMFAC*AS**3*(5D0/9D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.87) THEN -C...g + g -> chi_0c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & (9D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- - & 6D0*RGTW*PGTW**3*QGTW*(2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)- - & PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)+ - & 2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6D0*RGTW**2*QGTW**4)/ - & (QGTW*(QGTW-RGTW*PGTW)**4) - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.88) THEN -C...g + g -> chi_1c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*12D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)+2D0*QGTW*(-RGTW**4+ - & 5D0*RGTW**2*PGTW+PGTW**2)-15D0*RGTW*QGTW**2)/ - & (QGTW-RGTW*PGTW)**4 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.89) THEN -C...g + g -> chi_2c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & (12D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- - & 3D0*RGTW*PGTW**3*QGTW*(8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)+ - & 2D0*PGTW**2*QGTW**2*(-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)+ - & RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)+12D0*RGTW**2* - & QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4) - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.104) THEN -C...g + g -> chi_c0. - KC=PYCOMP(10441) - FACBW=COMFAC*12D0*AS**2*PARP(39)*PMAS(KC,2)/ - & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) - IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACBW - ENDIF - - ELSEIF(ISUB.EQ.105) THEN -C...g + g -> chi_c2. - KC=PYCOMP(445) - FACBW=COMFAC*16D0*AS**2*PARP(39)*PMAS(KC,2)/ - & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) - IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACBW - ENDIF - - ELSEIF(ISUB.EQ.106) THEN -C...g + g -> J/Psi + gamma. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM*EQ**2*AS**2*(4D0/3D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.107) THEN -C...g + gamma -> J/Psi + g. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM*EQ**2*AS**2*(32D0/3D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.108) THEN -C...gamma + gamma -> J/Psi + gamma. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM**3*EQ**6*384D0*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGHG -C...Subprocess cross sections for Higgs processes, -C...except Higgs pairs in PYSGSU, but including WW scattering. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGHG(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSUBS/,/PYMSSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 A004,A204,A114,A00U,A20U,A11U - COMPLEX*16 CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF - -C...Convert H or A process into equivalent h one - IHIGG=1 - KFHIGG=25 - IF(ISUB.EQ.401.OR.ISUB.EQ.402) THEN - KFHIGG=KFPR(ISUB,1) - END IF - IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. - &ISUB.LE.190)) THEN - IHIGG=2 - IF(MOD(ISUB-1,10).GE.5) IHIGG=3 - KFHIGG=33+IHIGG - IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 - IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 - IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 - IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 - IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 - IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 - IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 - IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 - IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 - IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 - IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 - IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 - ENDIF - SQMH=PMAS(KFHIGG,1)**2 - GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2) - -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ. - &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN -C...Calculate M_R and N_R functions for Higgs-like and QCD-like models - IF(MSTP(46).LE.4) THEN - HDTLH=LOG(PMAS(25,1)/PARP(44)) - HDTMR=(4.5D0*PARU(1)/SQRT(3D0)-74D0/9D0)/8D0+HDTLH/12D0 - HDTNR=-1D0/18D0+HDTLH/6D0 - ELSE - HDTNM=0.125D0*(1D0/(288D0*PARU(1)**2)+(PARP(47)/PARP(45))**2) - HDTLQ=LOG(PARP(45)/PARP(44)) - HDTMR=-(4D0*PARU(1))**2*0.5D0*HDTNM+HDTLQ/12D0 - HDTNR=(4D0*PARU(1))**2*HDTNM+HDTLQ/6D0 - ENDIF - -C...Calculate lowest and next-to-lowest order partial wave amplitudes - HDTV=1D0/(16D0*PARU(1)*PARP(47)**2) - A00L=DBLE(HDTV*SH) - A20L=-0.5D0*A00L - A11L=A00L/6D0 - HDTLS=LOG(SH/PARP(44)**2) - A004=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* - & CMPLX(DBLE((176D0*HDTMR+112D0*HDTNR)/3D0+11D0/27D0- - & (50D0/9D0)*HDTLS),DBLE(4D0*PARU(1))) - A204=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* - & CMPLX(DBLE(32D0*(HDTMR+2D0*HDTNR)/3D0+25D0/54D0- - & (20D0/9D0)*HDTLS),DBLE(PARU(1))) - A114=DBLE((HDTV*SH)**2/(6D0*PARU(1)))* - & CMPLX(DBLE(4D0*(-2D0*HDTMR+HDTNR)-1D0/18D0),DBLE(PARU(1)/6D0)) - -C...Unitarize partial wave amplitudes with Pade or K-matrix method - IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN - A00U=A00L/(1D0-A004/A00L) - A20U=A20L/(1D0-A204/A20L) - A11U=A11L/(1D0-A114/A11L) - ELSE - A00U=(A00L+DBLE(A004))/(1D0-DCMPLX(0.D0,A00L+DBLE(A004))) - A20U=(A20L+DBLE(A204))/(1D0-DCMPLX(0.D0,A20L+DBLE(A204))) - A11U=(A11L+DBLE(A114))/(1D0-DCMPLX(0.D0,A11L+DBLE(A114))) - ENDIF - ENDIF - -C...Differential cross section expressions. - - IF(ISUB.LE.60) THEN - IF(ISUB.EQ.3) THEN -C...f + fbar -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - IA=IABS(I) - RMQ=PYMRUN(IA,SH)**2/SH - HI=HP*RMQ - IF(IA.LE.10) HI=HP*RMQ*FACA/3D0 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - HI=HI*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - HI=HI/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - HI=HI*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 100 CONTINUE - - ELSEIF(ISUB.EQ.5) THEN -C...Z0 + Z0 -> h0 - CALL PYWIDT(25,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HI=HP/4D0 - FACI=8D0/(PARU(1)**2*XW1)*(AEM*XWC)**2 - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.8) THEN -C...W+ + W- -> h0 - CALL PYWIDT(25,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HI=HP/2D0 - FACI=1D0/(4D0*PARU(1)**2)*(AEM/XW)**2 - DO 140 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 130 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 130 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF - 130 CONTINUE - 140 CONTINUE - - ELSEIF(ISUB.EQ.24) THEN -C...f + fbar -> Z0 + h0 (or H0, or A0) -C...Propagators: Z0, h0 as simulated in PYOFSH and as desired - HBW3=GMMZ/((SQM3-SQMZ)**2+GMMZ**2) - CALL PYWIDT(23,SQM3,WDTP,WDTE) - GMMZ3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMZ3/((SQM3-SQMZ)**2+GMMZ3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACHZ=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*8D0*(AEM*XWC)**2* - & (THUH+2D0*SH*SQM3)/((SH-SQMZ)**2+GMMZ**2) - FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ* - & PARU(154+10*IHIGG)**2 - DO 150 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2) - 150 CONTINUE - - ELSEIF(ISUB.EQ.26) THEN -C...f + fbar' -> W+/- + h0 (or H0, or A0) -C...Propagators: W+-, h0 as simulated in PYOFSH and as desired - HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM3,WDTP,WDTE) - GMMW3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACHW=COMFAC*0.125D0*(AEM/XW)**2*(THUH+2D0*SH*SQM3)/ - & ((SH-SQMW)**2+GMMW**2)*(HBW3C/HBW3)*(HBW4C/HBW4) - FACHW=FACHW*WIDS(KFHIGG,2) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW* - & PARU(155+10*IHIGG)**2 - DO 170 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 170 - DO 160 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 160 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 160 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=1D0 - IF(IA.LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2) - 160 CONTINUE - 170 CONTINUE - - ELSEIF(ISUB.EQ.32) THEN -C...f + g -> f + h0 (q + g -> q + h0 only) - FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24D0 -C...H propagator: as simulated in PYOFSH and as desired - SQMHC=PMAS(25,1)**2 - GMMHC=PMAS(25,1)*PMAS(25,2) - HBW4=GMMHC/((SQM4-SQMHC)**2+GMMHC**2) - CALL PYWIDT(25,SQM4,WDTP,WDTE) - GMMHCC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMHCC/((SQM4-SQMHC)**2+GMMHCC**2) - FHCQ=FHCQ*HBW4C/HBW4 - DO 190 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.5) GOTO 190 - SQML=PYMRUN(IA,SH)**2 - SQMQ=PMAS(IA,1)**2 - FACHCQ=FHCQ*SQML/SQMW* - & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH- - & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* - & (SQMHC-SQMQ-SH)/SH) - DO 180 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHCQ*WIDS(25,2) - 180 CONTINUE - 190 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.71) THEN -C...Z0 + Z0 -> Z0 + Z0 - IF(SH.LE.4.01D0*SQMZ) GOTO 220 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-4D0*SQMZ/SH - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 220 - SHANG=1D0/XW1*SQMW/SQMZ*(1D0+BE2)**2 - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - THANG=1D0/XW1*SQMW/SQMZ*(BE2-CTH)**2 - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - UHANG=1D0/XW1*SQMW/SQMZ*(BE2+CTH)**2 - AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG - AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG - FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* - & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+ - & (ASHIM+ATHIM+AUHIM)**2) - IF(MSTP(46).EQ.2) FACZZ=0D0 - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZZ=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* - & ABS(A00U+2D0*A20U)**2 - ENDIF - FACZZ=FACZZ*WIDS(23,1) - - DO 210 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - DO 200 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 200 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*AVI*AVJ - 200 CONTINUE - 210 CONTINUE - 220 CONTINUE - - ELSEIF(ISUB.EQ.72) THEN -C...Z0 + Z0 -> W+ + W- - IF(SH.LE.4.01D0*SQMZ) GOTO 250 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) - CTH2=CTH**2 - TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) - UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 250 - SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* - & (1D0-2D0*SQMZ/SH) - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - ATWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - AUWIM=0D0 - A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) - A4IM=0D0 - FACWW=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* - & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+ - & (ASHIM+ATWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+ - & (ATWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACWW=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* - & ABS(A00U-A20U)**2 - ENDIF - FACWW=FACWW*WIDS(24,1) - - DO 240 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - DO 230 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*AVI*AVJ - 230 CONTINUE - 240 CONTINUE - 250 CONTINUE - - ELSEIF(ISUB.EQ.73) THEN -C...Z0 + W+/- -> Z0 + W+/- - IF(SH.LE.2D0*SQMZ+2D0*SQMW) GOTO 280 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-2D0*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2 - EP1=1D0-(SQMZ-SQMW)/SH - EP2=1D0+(SQMZ-SQMW)/SH - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=(SQMZ-SQMW)**2/SH-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 280 - THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH) - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+ - & 1D0/4D0*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4D0*BE2*CTH)+ - & 2D0*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH- - & 1D0/16D0*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2) - ASWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)* - & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)* - & (BE2+EP1*EP2*CTH)*(2D0*EP2-EP2*CTH+EP1)- - & BE2*(EP2+EP1*CTH)**2*(BE2-EP2**2*CTH)-1D0/8D0* - & (BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+ - & 1D0/32D0*SH/SQMW*(BE2+EP1*EP2*CTH)**2* - & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)* - & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)* - & (2D0*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2* - & (BE2-EP1**2*CTH)-1D0/8D0*(BE2+EP1*EP2*CTH)**2* - & ((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+1D0/32D0*SH/SQMW* - & (BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2) - AUWIM=0D0 - A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1D0)- - & 2D0*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2D0*BE2*EP1*EP2) - A4IM=0D0 - FACZW=COMFAC*1D0/(4096D0*PARU(1)**2*4D0*XW1)*(AEM/XW)**4* - & (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACZW=0D0 - IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+ - & (ATHIM+ASWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+ - & (ASWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZW=COMFAC*AEM**2/(64D0*PARU(1)**2*XW**2*XW1)*16D0* - & ABS(A20U+3D0*A11U*DBLE(CTH))**2 - ENDIF - FACZW=FACZW*WIDS(23,2) - - DO 270 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 270 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I)) - DO 260 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 260 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AI-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ - 260 CONTINUE - 270 CONTINUE - 280 CONTINUE - - ELSEIF(ISUB.EQ.75) THEN -C...W+ + W- -> gamma + gamma - - ELSEIF(ISUB.EQ.76) THEN -C...W+ + W- -> Z0 + Z0 - IF(SH.LE.4.01D0*SQMZ) GOTO 310 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) - CTH2=CTH**2 - TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) - UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 310 - SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* - & (1D0-2D0*SQMZ/SH) - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - ATWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - AUWIM=0D0 - A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) - A4IM=0D0 - FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* - & (SH/SQMW)**2*SH2 - IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+ - & (ASHIM+ATWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+ - & (ATWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZZ=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* - & ABS(A00U-A20U)**2 - ENDIF - FACZZ=FACZZ*WIDS(23,1) - - DO 300 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 290 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 290 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*VINT(180+I)*VINT(180+J) - 290 CONTINUE - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.77) THEN -C...W+/- + W+/- -> W+/- + W+/- - IF(SH.LE.4.01D0*SQMW) GOTO 340 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-4D0*SQMW/SH - BE4=BE2**2 - CTH2=CTH**2 - CTH3=CTH**3 - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 340 - SHANG=(1D0+BE2)**2 - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - THANG=(BE2-CTH)**2 - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - UHANG=(BE2+CTH)**2 - AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG - AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG - SGZANG=1D0/SQMW*BE2*(3D0-BE2)**2*CTH - ASGRE=XW*SGZANG - ASGIM=0D0 - ASZRE=XW1*SH/(SH-SQMZ)*SGZANG - ASZIM=0D0 - TGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)+BE2*(4D0-10D0*BE2+ - & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2+BE2*CTH3) - ATGRE=0.5D0*XW*SH/TH*TGZANG - ATGIM=0D0 - ATZRE=0.5D0*XW1*SH/(TH-SQMZ)*TGZANG - ATZIM=0D0 - UGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)-BE2*(4D0-10D0*BE2+ - & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2-BE2*CTH3) - AUGRE=0.5D0*XW*SH/UH*UGZANG - AUGIM=0D0 - AUZRE=0.5D0*XW1*SH/(UH-SQMZ)*UGZANG - AUZIM=0D0 - A4ARE=1D0/SQMW*(1D0+2D0*BE2-6D0*BE2*CTH-CTH2) - A4AIM=0D0 - A4SRE=2D0/SQMW*(1D0+2D0*BE2-CTH2) - A4SIM=0D0 - FWW=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* - & (SH/SQMW)**2*SH2 - IF(MSTP(46).LE.0) THEN - AWWARE=ASHRE - AWWAIM=ASHIM - AWWSRE=0D0 - AWWSIM=0D0 - ELSEIF(MSTP(46).EQ.1) THEN - AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE - AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM - AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE - AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM - ELSE - AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE - AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM - AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE - AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM - ENDIF - AWWA2=AWWARE**2+AWWAIM**2 - AWWS2=AWWSRE**2+AWWSIM**2 - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FWWA=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* - & ABS(A00U+0.5D0*A20U+4.5D0*A11U*DBLE(CTH))**2 - FWWS=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*64D0*ABS(A20U)**2 - ENDIF - - DO 330 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 330 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 320 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 320 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.LT.0D0) THEN -C...W+W- - IF(MSTP(45).EQ.1) GOTO 320 - IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1) - IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1) - ELSE -C...W+W+/W-W- - IF(MSTP(45).EQ.2) GOTO 320 - IF(MSTP(46).LE.2) FACWW=FWW*AWWS2 - IF(MSTP(46).GE.3) FACWW=FWWS - IF(EI.GT.0D0) FACWW=FACWW*WIDS(24,4) - IF(EI.LT.0D0) FACWW=FACWW*WIDS(24,5) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J) - IF(EI*EJ.GT.0D0) SIGH(NCHN)=0.5D0*SIGH(NCHN) - 320 CONTINUE - 330 CONTINUE - 340 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.120) THEN - IF(ISUB.EQ.102) THEN -C...g + g -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HI=SHR*WDTP(13)/32D0 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 350 CONTINUE - - ELSEIF(ISUB.EQ.103) THEN -C...gamma + gamma -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HI=SHR*WDTP(14)*2D0 - IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 360 - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 360 CONTINUE - - ELSEIF(ISUB.EQ.110) THEN -C...f + fbar -> gamma + h0 - THUH=MAX(TH*UH,SH*CKIN(3)**2) - FACHG=COMFAC*(3D0*AEM**4)/(2D0*PARU(1)**2*XW*SQMW)*SH*THUH - FACHG=FACHG*WIDS(KFHIGG,2) -C...Calculate loop contributions for intermediate gamma* and Z0 - CIGTOT=DCMPLX(0D0,0D0) - CIZTOT=DCMPLX(0D0,0D0) - JMAX=3*MSTP(1)+1 - DO 370 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - FNC=1D0 - EJ=KCHG(J,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - BALP=SQM4/(2D0*PMAS(J,1))**2 - BBET=SH/(2D0*PMAS(J,1))**2 - ELSEIF(J.LE.3*MSTP(1)) THEN - FNC=3D0 - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - BALP=SQM4/(2D0*PMAS(10+JL,1))**2 - BBET=SH/(2D0*PMAS(10+JL,1))**2 - ELSE - BALP=SQM4/(2D0*PMAS(24,1))**2 - BBET=SH/(2D0*PMAS(24,1))**2 - ENDIF - BABI=1D0/(BALP-BBET) - IF(BALP.LT.1D0) THEN - F0ALP=DCMPLX(DBLE(ASIN(SQRT(BALP))),0D0) - F1ALP=F0ALP**2 - ELSE - F0ALP=DCMPLX(DBLE(LOG(SQRT(BALP)+SQRT(BALP-1D0))), - & -DBLE(0.5D0*PARU(1))) - F1ALP=-F0ALP**2 - ENDIF - F2ALP=DBLE(SQRT(ABS(BALP-1D0)/BALP))*F0ALP - IF(BBET.LT.1D0) THEN - F0BET=DCMPLX(DBLE(ASIN(SQRT(BBET))),0D0) - F1BET=F0BET**2 - ELSE - F0BET=DCMPLX(DBLE(LOG(SQRT(BBET)+SQRT(BBET-1D0))), - & -DBLE(0.5D0*PARU(1))) - F1BET=-F0BET**2 - ENDIF - F2BET=DBLE(SQRT(ABS(BBET-1D0)/BBET))*F0BET - IF(J.LE.3*MSTP(1)) THEN - FIF=DBLE(0.5D0*BABI)+DBLE(BABI**2)*(DBLE(0.5D0*(1D0-BALP+ - & BBET))*(F1BET-F1ALP)+DBLE(BBET)*(F2BET-F2ALP)) - CIGTOT=CIGTOT+DBLE(FNC*EJ**2)*FIF - CIZTOT=CIZTOT+DBLE(FNC*EJ*VJ)*FIF - ELSE - TXW=XW/XW1 - CIGTOT=CIGTOT-0.5*(DBLE(BABI*(1.5D0+BALP))+DBLE(BABI**2)* - & (DBLE(1.5D0-3D0*BALP+4D0*BBET)*(F1BET-F1ALP)+ - & DBLE(BBET*(2D0*BALP+3D0))*(F2BET-F2ALP))) - CIZTOT=CIZTOT-DBLE(0.5D0*BABI*XW1)*(DBLE(5D0-TXW+2D0*BALP* - & (1D0-TXW))*(1D0+DBLE(2D0*BABI*BBET)*(F2BET-F2ALP))+ - & DBLE(BABI*(4D0*BBET*(3D0-TXW)-(2D0*BALP-1D0)*(5D0-TXW)))* - & (F1BET-F1ALP)) - ENDIF - 370 CONTINUE - CIGTOT=CIGTOT/DBLE(SH) - CIZTOT=CIZTOT*DBLE(XWC)/DCMPLX(DBLE(SH-SQMZ),DBLE(GMMZ)) -C...Loop over initial flavours - DO 380 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHG*FCOI*(ABS(DBLE(EI)*CIGTOT+DBLE(VI)* - & CIZTOT)**2+AI**2*ABS(CIZTOT)**2) - 380 CONTINUE - - ELSEIF(ISUB.EQ.111) THEN -C...f + fbar -> g + h0 (q + qbar -> g + h0 only) - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACGH=COMFAC*FACA*(2D0/9D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (TH**2+UH**2)/(SH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACGH=FACGH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A5STUR=0D0 - A5STUI=0D0 - DO 390 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPSH=4D0*SQMQ/SQMH - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - A5STUR=A5STUR+EPSH*(1D0+SH/(TH+UH)*(W1SR-W1HR)+ - & (0.25D0-SQMQ/(TH+UH))*(W2SR-W2HR)) - A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+ - & (0.25D0-SQMQ/(TH+UH))*(W2SI-W2HI)) - 390 CONTINUE - FACGH=COMFAC*FACA/(144D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* - & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2) - FACGH=FACGH*WIDS(25,2) - ENDIF - DO 400 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGH - 400 CONTINUE - - ELSEIF(ISUB.EQ.112) THEN -C...f + g -> f + h0 (q + g -> q + h0 only) - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACQH=COMFAC*FACA*(1D0/12D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (SH**2+UH**2)/(-TH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACQH=FACQH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A5TSUR=0D0 - A5TSUI=0D0 - DO 410 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPST=4D0*SQMQ/TH - EPSH=4D0*SQMQ/SQMH - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - A5TSUR=A5TSUR+EPSH*(1D0+TH/(SH+UH)*(W1TR-W1HR)+ - & (0.25D0-SQMQ/(SH+UH))*(W2TR-W2HR)) - A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+ - & (0.25D0-SQMQ/(SH+UH))*(W2TI-W2HI)) - 410 CONTINUE - FACQH=COMFAC*FACA/(384D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* - & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2) - FACQH=FACQH*WIDS(25,2) - ENDIF - DO 430 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 - DO 420 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQH - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.113) THEN -C...g + g -> g + h0 - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACGH=COMFAC*FACA*(3D0/16D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (SH**4+TH**4+UH**4+SQM4**4)/(SH*TH*UH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACGH=FACGH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A2STUR=0D0 - A2STUI=0D0 - A2USTR=0D0 - A2USTI=0D0 - A2TUSR=0D0 - A2TUSI=0D0 - A4STUR=0D0 - A4STUI=0D0 - DO 440 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPST=4D0*SQMQ/TH - EPSU=4D0*SQMQ/UH - EPSH=4D0*SQMQ/SQMH - IF(EPSH.LT.1D-6) GOTO 440 - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSU,W1UR,W1UI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSU,W2UR,W2UI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) - CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) - CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) - CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) - CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) - CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) - CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI) - CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI) - CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI) - CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI) - CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI) - CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI) - W3STUR=YHSTUR-Y3STUR-Y3UTSR - W3STUI=YHSTUI-Y3STUI-Y3UTSI - W3SUTR=YHSUTR-Y3SUTR-Y3TUSR - W3SUTI=YHSUTI-Y3SUTI-Y3TUSI - W3TSUR=YHTSUR-Y3TSUR-Y3USTR - W3TSUI=YHTSUI-Y3TSUI-Y3USTI - W3TUSR=YHTUSR-Y3TUSR-Y3SUTR - W3TUSI=YHTUSI-Y3TUSI-Y3SUTI - W3USTR=YHUSTR-Y3USTR-Y3TSUR - W3USTI=YHUSTI-Y3USTI-Y3TSUI - W3UTSR=YHUTSR-Y3UTSR-Y3STUR - W3UTSI=YHUTSI-Y3UTSI-Y3STUI - B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2D0*TH*UH* - & (UH+2D0*SH)/(SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4D0)* - & (0.5D0*W2SR+0.5D0*W2HR-W2TR+W3STUR)+SH2*(2D0*SQMQ/ - & (SH+UH)**2-0.5D0/(SH+UH))*(W2TR-W2HR)+0.5D0*TH*UH/SH* - & (W2HR-2D0*W2TR)+0.125D0*(SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUR) - B2STUI=SQMQ/SQMH**2*(2D0*TH*UH*(UH+2D0*SH)/(SH+UH)**2* - & (W1TI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2TI+ - & W3STUI)+SH2*(2D0*SQMQ/(SH+UH)**2-0.5D0/(SH+UH))* - & (W2TI-W2HI)+0.5D0*TH*UH/SH*(W2HI-2D0*W2TI)+0.125D0* - & (SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUI) - B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2D0*UH*TH* - & (TH+2D0*SH)/(SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4D0)* - & (0.5D0*W2SR+0.5D0*W2HR-W2UR+W3SUTR)+SH2*(2D0*SQMQ/ - & (SH+TH)**2-0.5D0/(SH+TH))*(W2UR-W2HR)+0.5D0*UH*TH/SH* - & (W2HR-2D0*W2UR)+0.125D0*(SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTR) - B2SUTI=SQMQ/SQMH**2*(2D0*UH*TH*(TH+2D0*SH)/(SH+TH)**2* - & (W1UI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2UI+ - & W3SUTI)+SH2*(2D0*SQMQ/(SH+TH)**2-0.5D0/(SH+TH))* - & (W2UI-W2HI)+0.5D0*UH*TH/SH*(W2HI-2D0*W2UI)+0.125D0* - & (SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTI) - B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2D0*SH*UH* - & (UH+2D0*TH)/(TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4D0)* - & (0.5D0*W2TR+0.5D0*W2HR-W2SR+W3TSUR)+TH2*(2D0*SQMQ/ - & (TH+UH)**2-0.5D0/(TH+UH))*(W2SR-W2HR)+0.5D0*SH*UH/TH* - & (W2HR-2D0*W2SR)+0.125D0*(TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUR) - B2TSUI=SQMQ/SQMH**2*(2D0*SH*UH*(UH+2D0*TH)/(TH+UH)**2* - & (W1SI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2SI+ - & W3TSUI)+TH2*(2D0*SQMQ/(TH+UH)**2-0.5D0/(TH+UH))* - & (W2SI-W2HI)+0.5D0*SH*UH/TH*(W2HI-2D0*W2SI)+0.125D0* - & (TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUI) - B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2D0*UH*SH* - & (SH+2D0*TH)/(TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4D0)* - & (0.5D0*W2TR+0.5D0*W2HR-W2UR+W3TUSR)+TH2*(2D0*SQMQ/ - & (TH+SH)**2-0.5D0/(TH+SH))*(W2UR-W2HR)+0.5D0*UH*SH/TH* - & (W2HR-2D0*W2UR)+0.125D0*(TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSR) - B2TUSI=SQMQ/SQMH**2*(2D0*UH*SH*(SH+2D0*TH)/(TH+SH)**2* - & (W1UI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2UI+ - & W3TUSI)+TH2*(2D0*SQMQ/(TH+SH)**2-0.5D0/(TH+SH))* - & (W2UI-W2HI)+0.5D0*UH*SH/TH*(W2HI-2D0*W2UI)+0.125D0* - & (TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSI) - B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2D0*SH*TH* - & (TH+2D0*UH)/(UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4D0)* - & (0.5D0*W2UR+0.5D0*W2HR-W2SR+W3USTR)+UH2*(2D0*SQMQ/ - & (UH+TH)**2-0.5D0/(UH+TH))*(W2SR-W2HR)+0.5D0*SH*TH/UH* - & (W2HR-2D0*W2SR)+0.125D0*(UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTR) - B2USTI=SQMQ/SQMH**2*(2D0*SH*TH*(TH+2D0*UH)/(UH+TH)**2* - & (W1SI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2SI+ - & W3USTI)+UH2*(2D0*SQMQ/(UH+TH)**2-0.5D0/(UH+TH))* - & (W2SI-W2HI)+0.5D0*SH*TH/UH*(W2HI-2D0*W2SI)+0.125D0* - & (UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTI) - B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2D0*TH*SH* - & (SH+2D0*UH)/(UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4D0)* - & (0.5D0*W2UR+0.5D0*W2HR-W2TR+W3UTSR)+UH2*(2D0*SQMQ/ - & (UH+SH)**2-0.5D0/(UH+SH))*(W2TR-W2HR)+0.5D0*TH*SH/UH* - & (W2HR-2D0*W2TR)+0.125D0*(UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSR) - B2UTSI=SQMQ/SQMH**2*(2D0*TH*SH*(SH+2D0*UH)/(UH+SH)**2* - & (W1TI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2TI+ - & W3UTSI)+UH2*(2D0*SQMQ/(UH+SH)**2-0.5D0/(UH+SH))* - & (W2TI-W2HI)+0.5D0*TH*SH/UH*(W2HI-2D0*W2TI)+0.125D0* - & (UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSI) - B4STUR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2SR-W2HR+W3STUR)) - B4STUI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2SI-W2HI+W3STUI) - B4TUSR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2TR-W2HR+W3TUSR)) - B4TUSI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2TI-W2HI+W3TUSI) - B4USTR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2UR-W2HR+W3USTR)) - B4USTI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2UI-W2HI+W3USTI) - A2STUR=A2STUR+B2STUR+B2SUTR - A2STUI=A2STUI+B2STUI+B2SUTI - A2USTR=A2USTR+B2USTR+B2UTSR - A2USTI=A2USTI+B2USTI+B2UTSI - A2TUSR=A2TUSR+B2TUSR+B2TSUR - A2TUSI=A2TUSI+B2TUSI+B2TSUI - A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR - A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI - 440 CONTINUE - FACGH=COMFAC*FACA*3D0/(128D0*PARU(1)**2)*AEM/XW*AS**3* - & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+ - & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2) - FACGH=FACGH*WIDS(25,2) - ENDIF - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 450 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGH - 450 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.170) THEN - IF(ISUB.EQ.121) THEN -C...g + g -> Q + Qbar + h0 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 460 - IA=KFPR(ISUBSV,2) - PMF=PYMRUN(IA,SH) - FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* - & (0.5D0*PMF/PMAS(24,1))**2 - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - FACQQH=FACQQH*WID2 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - FACQQH=FACQQH/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - CALL PYQQBH(WTQQBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQH*WTQQBH*FACBW - 460 CONTINUE - - ELSEIF(ISUB.EQ.122) THEN -C...q + qbar -> Q + Qbar + h0 - IA=KFPR(ISUBSV,2) - PMF=PYMRUN(IA,SH) - FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* - & (0.5D0*PMF/PMAS(24,1))**2 - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - FACQQH=FACQQH*WID2 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - FACQQH=FACQQH/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - CALL PYQQBH(WTQQBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 470 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQH*WTQQBH*FACBW - 470 CONTINUE - - ELSEIF(ISUB.EQ.123) THEN -C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as -C...inner process) - FACNOR=COMFAC*(4D0*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32D0 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* - & PARU(154+10*IHIGG)**2 - FACPRP=1D0/((VINT(215)-VINT(204)**2)* - & (VINT(216)-VINT(209)**2))**2 - FACZZ1=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) - FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 490 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 490 - IA=IABS(I) - DO 480 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 480 - JA=IABS(J) - EI=KCHG(IA,1)*ISIGN(1,I)/3D0 - AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 - AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) - VJ=AJ-4D0*EJ*XWV - FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4D0*VI*AI*VJ*AJ - FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4D0*VI*AI*VJ*AJ - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW - 480 CONTINUE - 490 CONTINUE - - ELSEIF(ISUB.EQ.124) THEN -C...f + f' -> f" + f"' + h0 (or H0, or A0) (W+ + W- -> h0 as -C...inner process) - FACNOR=COMFAC*(4D0*PARU(1)*AEM/XW)**3*SQMW - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* - & PARU(155+10*IHIGG)**2 - FACPRP=1D0/((VINT(215)-VINT(204)**2)* - & (VINT(216)-VINT(209)**2))**2 - FACWW=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 510 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 510 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 500 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 500 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 500 - FACLR=VINT(180+I)*VINT(180+J) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLR*FACWW*FACBW - 500 CONTINUE - 510 CONTINUE - - ELSEIF(ISUB.EQ.143) THEN -C...f + fbar' -> H+/- - SQMHC=PMAS(37,1)**2 - CALL PYWIDT(37,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMHC)**2+HS**2) - HP=AEM/(8D0*XW)*SH/SQMW*SH - DO 530 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530 - IA=IABS(I) - IM=(MOD(IA,10)+1)/2 - DO 520 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520 - JA=IABS(J) - JM=(MOD(JA,10)+1)/2 - IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 520 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 520 - IF(MOD(IA,2).EQ.0) THEN - IU=IA - IL=JA - ELSE - IU=JA - IL=IA - ENDIF - RML=PYMRUN(IL,SH)**2/SH - RMU=PYMRUN(IU,SH)**2/SH - HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 520 CONTINUE - 530 CONTINUE - - ELSEIF(ISUB.EQ.161) THEN -C...f + g -> f' + H+/- (b + g -> t + H+/- only) -C...(choice of only b and t to avoid kinematics problems) - FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24 -C...H propagator: as simulated in PYOFSH and as desired - SQMHC=PMAS(37,1)**2 - GMMHC=PMAS(37,1)*PMAS(37,2) - HBW4=GMMHC/((SQM4-SQMHC)**2+GMMHC**2) - CALL PYWIDT(37,SQM4,WDTP,WDTE) - GMMHCC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMHCC/((SQM4-SQMHC)**2+GMMHCC**2) - FHCQ=FHCQ*HBW4C/HBW4 - DO 550 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.5) GOTO 550 - SQML=PYMRUN(IA,SH)**2 - IUA=IA+MOD(IA,2) - SQMQ=PYMRUN(IUA,SH)**2 - FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW* - & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH- - & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* - & (SQMHC-SQMQ-SH)/SH) - KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - DO 540 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 540 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 540 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2) - IF(IUA.EQ.6) SIGH(NCHN)=SIGH(NCHN)*WIDS(6,(5+KCHHC)/2) - 540 CONTINUE - 550 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.402) THEN - IF(ISUB.EQ.401) THEN -C... g + g -> t + bbar + H- - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 560 - IA=KFPR(ISUBSV,2) - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - CALL PYSTBH(WTTBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=2d0*WID2*COMFAC*WTTBH*FACBW - 560 CONTINUE - - ELSEIF(ISUB.EQ.402) THEN -C... q + qbar -> t + bbar + H- - IA=KFPR(ISUBSV,2) - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - CALL PYSTBH(WTTBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 570 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 570 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=2d0*WID2*COMFAC*WTTBH*FACBW - 570 CONTINUE - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGQC -C...Subprocess cross sections for QCD processes, -C...including photons. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGQC(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYINT7/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.20) THEN - IF(ISUB.EQ.10) THEN -C...f + f' -> f + f' (gamma/Z/W exchange) - FACGGF=COMFAC*AEM**2*2D0*(SH2+UH2)/TH2 - FACGZF=COMFAC*AEM**2*XWC*4D0*SH2/(TH*(TH-SQMZ)) - FACZZF=COMFAC*(AEM*XWC)**2*2D0*SH2/(TH-SQMZ)**2 - FACWWF=COMFAC*(0.5D0*AEM/XW)**2*SH2/(TH-SQMW)**2 - DO 110 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 110 - IA=IABS(I) - DO 100 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 100 - JA=IABS(J) -C...Electroweak couplings - EI=KCHG(IA,1)*ISIGN(1,I)/3D0 - AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 - AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) - VJ=AJ-4D0*EJ*XWV - EPSIJ=ISIGN(1,I*J) -C...gamma/Z exchange, only gamma exchange, or only Z exchange - IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN - IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN - FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ* - & (VI*VJ*(1D0+UH2/SH2)+AI*AJ*EPSIJ*(1D0-UH2/SH2))+ - & FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1D0+UH2/SH2)+ - & 4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) - ELSEIF(MSTP(21).EQ.2) THEN - FACNCF=FACGGF*EI**2*EJ**2 - ELSE - FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)* - & (1D0+UH2/SH2)+4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) - ENDIF -C...Extrafactor 2 for only one incoming neutrino spin state. - IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACNCF=2D0*FACNCF - IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACNCF=2D0*FACNCF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACNCF - ENDIF -C...W exchange - IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0D0) THEN - FACCCF=FACWWF*VINT(180+I)*VINT(180+J) - IF(EPSIJ.LT.0D0) FACCCF=FACCCF*UH2/SH2 - IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2D0*FACCCF - IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2D0*FACCCF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACCCF - ENDIF - 100 CONTINUE - 110 CONTINUE - - ELSEIF(ISUB.EQ.11) THEN -C...f + f' -> f + f' (g exchange) - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- - & MSTP(34)*2D0/3D0*UH2/(SH*TH)) - FACQQ2=COMFAC*AS**2*4D0/9D0*((SH2+TH2)/UH2- - & MSTP(34)*2D0/3D0*SH2/(TH*UH)) - DO 130 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 130 - DO 120 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 120 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - IF(I.EQ.J) THEN - SIGH(NCHN)=0.5D0*SIGH(NCHN) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACQQ2 - ENDIF - 120 CONTINUE - 130 CONTINUE - - ELSEIF(ISUB.EQ.12) THEN -C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) - CALL PYWIDT(21,SH,WDTP,WDTE) - FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - DO 140 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 140 CONTINUE - - ELSEIF(ISUB.EQ.13) THEN -C...f + fbar -> g + g (q + qbar -> g + g only) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2) - DO 150 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - 150 CONTINUE - - ELSEIF(ISUB.EQ.14) THEN -C...f + fbar -> g + gamma (q + qbar -> g + gamma only) - FACGG=COMFAC*AS*AEM*8D0/9D0*(TH2+UH2)/(TH*UH) - DO 160 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 - EI=KCHG(IABS(I),1)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGG*EI**2 - 160 CONTINUE - - ELSEIF(ISUB.EQ.18) THEN -C...f + fbar -> gamma + gamma - FACGG=COMFAC*AEM**2*2D0*(TH2+UH2)/(TH*UH) - DO 170 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170 - EI=KCHG(IABS(I),1)/3D0 - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG*FCOI*EI**4 - 170 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.28) THEN -C...f + g -> f + g (q + g -> q + g only) - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH) - DO 190 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 190 - DO 180 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2 - 180 CONTINUE - 190 CONTINUE - - ELSEIF(ISUB.EQ.29) THEN -C...f + g -> f + gamma (q + g -> q + gamma only) - FGQ=COMFAC*FACA*AS*AEM*1D0/3D0*(SH2+UH2)/(-SH*UH) - DO 210 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 200 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 200 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 200 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 200 CONTINUE - 210 CONTINUE - - ELSEIF(ISUB.EQ.33) THEN -C...f + gamma -> f + g (q + gamma -> q + g only) - FGQ=COMFAC*AS*AEM*8D0/3D0*(SH2+UH2)/(-SH*UH) - DO 230 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 230 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 220 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 220 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 220 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 220 CONTINUE - 230 CONTINUE - - ELSEIF(ISUB.EQ.34) THEN -C...f + gamma -> f + gamma - FGQ=COMFAC*AEM**2*2D0*(SH2+UH2)/(-SH*UH) - DO 250 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 250 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**4 - DO 240 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 240 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 240 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 240 CONTINUE - 250 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.53) THEN -C...g + g -> f + fbar (g + g -> q + qbar only) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 270 - IDC0=MDCY(21,2)-1 -C...Begin by d, u, s flavours. - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 -C...Next c and b flavours: modified that and uhat for fixed -C...cos(theta-hat). - DO 260 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 260 CONTINUE - 270 CONTINUE - - ELSEIF(ISUB.EQ.54) THEN -C...g + gamma -> f + fbar (g + gamma -> q + qbar only) - CALL PYWIDT(21,SH,WDTP,WDTE) - WDTESU=0D0 - DO 280 I=1,MIN(8,MDCY(21,3)) - EF=KCHG(I,1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 280 CONTINUE - FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH) - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.EQ.58) THEN -C...gamma + gamma -> f + fbar - CALL PYWIDT(22,SH,WDTP,WDTE) - WDTESU=0D0 - DO 290 I=1,MIN(12,MDCY(22,3)) - IF(I.LE.8) EF= KCHG(I,1)/3D0 - IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 290 CONTINUE - FACFF=COMFAC*AEM**2*WDTESU*2D0*(TH2+UH2)/(TH*UH) - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ELSEIF(ISUB.EQ.68) THEN -C...g + g -> g + g - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 300 - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+2D0*TH/SH+ - & TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+2D0*SH/UH+ - & SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+2D0*UH/TH+ - & UH2/TH2) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=0.5D0*FACGG3 - 300 CONTINUE - - ELSEIF(ISUB.EQ.80) THEN -C...q + gamma -> q' + pi+/- - FQPI=COMFAC*(2D0*AEM/9D0)*(-SH/TH)*(1D0/SH2+1D0/TH2) - ASSH=PYALPS(MAX(0.5D0,0.5D0*SH)) - Q2FPSH=0.55D0/LOG(MAX(2D0,2D0*SH)) - DELSH=UH*SQRT(ASSH*Q2FPSH) - ASUH=PYALPS(MAX(0.5D0,-0.5D0*UH)) - Q2FPUH=0.55D0/LOG(MAX(2D0,-2D0*UH)) - DELUH=SH*SQRT(ASUH*Q2FPUH) - DO 320 I=MAX(-2,MMINA),MIN(2,MMAXA) - IF(I.EQ.0) GOTO 320 - EI=KCHG(IABS(I),1)/3D0 - EJ=SIGN(1D0-ABS(EI),EI) - DO 310 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 310 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 310 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2 - 310 CONTINUE - 320 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.91) THEN -C...Elastic scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,1) - - ELSEIF(ISUB.EQ.92) THEN -C...Single diffractive scattering (first side, i.e. XB) - SIGS=VINT(315)*VINT(316)*SIGT(0,0,2) - - ELSEIF(ISUB.EQ.93) THEN -C...Single diffractive scattering (second side, i.e. AX) - SIGS=VINT(315)*VINT(316)*SIGT(0,0,3) - - ELSEIF(ISUB.EQ.94) THEN -C...Double diffractive scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,4) - - ELSEIF(ISUB.EQ.95) THEN -C...Low-pT scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,5) - - ELSEIF(ISUB.EQ.96) THEN -C...Multiple interactions: sum of QCD processes - CALL PYWIDT(21,SH,WDTP,WDTE) - -C...q + q' -> q + q' - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- - & MSTP(34)*2D0/3D0*UH2/(SH*TH)) - FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)/UH2 - FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) - RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) - DO 340 I=-5,5 - IF(I.EQ.0) GOTO 340 - DO 330 J=-5,5 - IF(J.EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=111 - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - IF(I.EQ.J) THEN - SIGH(NCHN)=0.5D0*FACQQ1*RATQQI - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=112 - SIGH(NCHN)=0.5D0*FACQQ2*RATQQI - ENDIF - 330 CONTINUE - 340 CONTINUE - -C...q + qbar -> q' + qbar' or g + g - FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4)) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2) - DO 350 I=-5,5 - IF(I.EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=121 - SIGH(NCHN)=FACQQB - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=131 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=132 - SIGH(NCHN)=0.5D0*FACGG2 - 350 CONTINUE - -C...q + g -> q + g - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH) - DO 370 I=-5,5 - IF(I.EQ.0) GOTO 370 - DO 360 ISDE=1,2 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=281 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=282 - SIGH(NCHN)=FACQG2 - 360 CONTINUE - 370 CONTINUE - -C...g + g -> q + qbar (only d, u, s) - IDC0=MDCY(21,2)-1 - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=531 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=532 - SIGH(NCHN)=FACQQ2 - -C...g + g -> c + cbar, b + bbar: modified that/uhat for fixed -C...cos(theta-hat) - DO 380 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=531+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=532+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 380 CONTINUE - -C...g + g -> g + g - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ - & 2D0*TH/SH+TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ - & 2D0*SH/UH+SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3+ - & 2D0*UH/TH+UH2/TH2) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=681 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=682 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=683 - SIGH(NCHN)=0.5D0*FACGG3 - - ELSEIF(ISUB.EQ.99) THEN -C...f + gamma* -> f. - IF(MINT(107).EQ.4) THEN - Q2GA=VINT(307) - P2GA=VINT(308) - ISDE=2 - ELSE - Q2GA=VINT(308) - P2GA=VINT(307) - ISDE=1 - ENDIF - COMFAC=PARU(5)*4D0*PARU(1)**2*PARU(101)*VINT(315)*VINT(316) - PM2RHO=PMAS(PYCOMP(113),1)**2 - IF(MSTP(19).EQ.0) THEN - COMFAC=COMFAC/Q2GA - ELSEIF(MSTP(19).EQ.1) THEN - COMFAC=COMFAC/(Q2GA+PM2RHO) -C ...patty -C To use MSTP(19).EQ.1 (less Q2 suppression) with the right factor (1-x)^-1 -C - W2GA=VINT(2) - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - XGA=Q2GA/(W2GA+VINT(307)+VINT(308)) - ELSE - XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2) - ENDIF - COMFAC=COMFAC/MAX(1D-2,1D0-XGA) - ELSEIF(MSTP(19).EQ.2) THEN - COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 - ELSE - COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 - W2GA=VINT(2) - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - RDRDS=4.1D-3*W2GA**2.167D0/((Q2GA+0.15D0*W2GA)**2* - & Q2GA**0.75D0)*(1D0+0.11D0*Q2GA*P2GA/(1D0+0.02D0*P2GA**2)) - XGA=Q2GA/(W2GA+VINT(307)+VINT(308)) - ELSE - RDRDS=1.5D-4*W2GA**2.167D0/((Q2GA+0.041D0*W2GA)**2* - & Q2GA**0.57D0) - XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2) - ENDIF - COMFAC=COMFAC*EXP(-MAX(1D-10,RDRDS)) - IF(MSTP(19).EQ.4) COMFAC=COMFAC/MAX(1D-2,1D0-XGA) - ENDIF - DO 390 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(ISDE,I).EQ.0) GOTO 390 - IF(IABS(I).LT.10.AND.IABS(I).GT.MSTP(58)) GOTO 390 - EI=KCHG(IABS(I),1)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*EI**2 - 390 CONTINUE - ENDIF - - ELSE - IF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN -C...g + g -> gamma + gamma or g + g -> g + gamma - A0STUR=0D0 - A0STUI=0D0 - A0TSUR=0D0 - A0TSUI=0D0 - A0UTSR=0D0 - A0UTSI=0D0 - A1STUR=0D0 - A1STUI=0D0 - A2STUR=0D0 - A2STUI=0D0 - ALST=LOG(-SH/TH) - ALSU=LOG(-SH/UH) - ALTU=LOG(TH/UH) - IMAX=2*MSTP(1) - IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38) - DO 400 I=1,IMAX - EI=KCHG(IABS(I),1)/3D0 - EIWT=EI**2 - IF(ISUB.EQ.115) EIWT=EI - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPST=4D0*SQMQ/TH - EPSU=4D0*SQMQ/UH - IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1D-4) THEN - B0STUR=1D0+(TH-UH)/SH*ALTU+0.5D0*(TH2+UH2)/SH2*(ALTU**2+ - & PARU(1)**2) - B0STUI=0D0 - B0TSUR=1D0+(SH-UH)/TH*ALSU+0.5D0*(SH2+UH2)/TH2*ALSU**2 - B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU) - B0UTSR=1D0+(SH-TH)/UH*ALST+0.5D0*(SH2+TH2)/UH2*ALST**2 - B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST) - B1STUR=-1D0 - B1STUI=0D0 - B2STUR=-1D0 - B2STUI=0D0 - ELSE - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSU,W1UR,W1UI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSU,W2UR,W2UI) - CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) - CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) - CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) - CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) - CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) - CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) - B0STUR=1D0+(1D0+2D0*TH/SH)*W1TR+(1D0+2D0*UH/SH)*W1UR+ - & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)- - & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTR+Y3TUSR)- - & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUR+Y3UTSR)+ - & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ - & 0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) - B0STUI=(1D0+2D0*TH/SH)*W1TI+(1D0+2D0*UH/SH)*W1UI+ - & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)- - & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTI+Y3TUSI)- - & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUI+Y3UTSI)+ - & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ - & 0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) - B0TSUR=1D0+(1D0+2D0*SH/TH)*W1SR+(1D0+2D0*UH/TH)*W1UR+ - & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)- - & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSR+Y3SUTR)- - & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUR+Y3USTR)+ - & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ - & 0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR) - B0TSUI=(1D0+2D0*SH/TH)*W1SI+(1D0+2D0*UH/TH)*W1UI+ - & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)- - & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSI+Y3SUTI)- - & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUI+Y3USTI)+ - & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ - & 0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI) - B0UTSR=1D0+(1D0+2D0*TH/UH)*W1TR+(1D0+2D0*SH/UH)*W1SR+ - & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)- - & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTR+Y3TSUR)- - & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSR+Y3STUR)+ - & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ - & 0.5D0*EPST*EPSS)*(Y3TUSR+Y3SUTR) - B0UTSI=(1D0+2D0*TH/UH)*W1TI+(1D0+2D0*SH/UH)*W1SI+ - & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)- - & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTI+Y3TSUI)- - & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSI+Y3STUI)+ - & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ - & 0.5D0*EPST*EPSS)*(Y3TUSI+Y3SUTI) - B1STUR=-1D0-0.25D0*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+ - & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTR+Y3TUSR)+ - & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)+ - & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) - B1STUI=-0.25D0*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+ - & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTI+Y3TUSI)+ - & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)+ - & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) - B2STUR=-1D0+0.125D0*EPSS*EPST*(Y3SUTR+Y3TUSR)+ - & 0.125D0*EPSS*EPSU*(Y3STUR+Y3UTSR)+ - & 0.125D0*EPST*EPSU*(Y3TSUR+Y3USTR) - B2STUI=0.125D0*EPSS*EPST*(Y3SUTI+Y3TUSI)+ - & 0.125D0*EPSS*EPSU*(Y3STUI+Y3UTSI)+ - & 0.125D0*EPST*EPSU*(Y3TSUI+Y3USTI) - ENDIF - A0STUR=A0STUR+EIWT*B0STUR - A0STUI=A0STUI+EIWT*B0STUI - A0TSUR=A0TSUR+EIWT*B0TSUR - A0TSUI=A0TSUI+EIWT*B0TSUI - A0UTSR=A0UTSR+EIWT*B0UTSR - A0UTSI=A0UTSI+EIWT*B0UTSI - A1STUR=A1STUR+EIWT*B1STUR - A1STUI=A1STUI+EIWT*B1STUI - A2STUR=A2STUR+EIWT*B2STUR - A2STUI=A2STUI+EIWT*B2STUI - 400 CONTINUE - ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+ - & A0UTSI**2+4D0*A1STUR**2+4D0*A1STUI**2+A2STUR**2+A2STUI**2 - FACGG=COMFAC*FACA/(16D0*PARU(1)**2)*AS**2*AEM**2*ASQSUM - FACGP=COMFAC*FACA*5D0/(192D0*PARU(1)**2)*AS**3*AEM*ASQSUM - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - IF(ISUB.EQ.114) SIGH(NCHN)=0.5D0*FACGG - IF(ISUB.EQ.115) SIGH(NCHN)=FACGP - 410 CONTINUE - - ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN -C...f + gamma*_(T,L) -> f + g (q + gamma*_(T,L) -> q + g only) - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - IF(ISUB.EQ.131) THEN - FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**2* - & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) - ELSE - FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) - ENDIF - DO 430 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 420 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 420 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN -C...f + gamma*_(T,L) -> f + gamma - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - IF(ISUB.EQ.133) THEN - FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**2* - & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) - ELSE - FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) - ENDIF - DO 450 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 450 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**4 - DO 440 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 440 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 440 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 440 CONTINUE - 450 CONTINUE - - ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN -C...g + gamma*_(T,L) -> f + fbar (g + gamma*_(T,L) -> q + qbar only) - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - CALL PYWIDT(21,SH,WDTP,WDTE) - WDTESU=0D0 - DO 460 I=1,MIN(8,MDCY(21,3)) - EF=KCHG(I,1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 460 CONTINUE - IF(ISUB.EQ.135) THEN - FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**2* - & ((TH2+UH2-2D0*PH*SH)/(TH*UH)+4D0*PH*SH/(SH+PH)**2) - ELSE - FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**4*8D0*PH*SH - ENDIF - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN -C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar - PH1=0D0 - IF(VINT(3).LT.0D0) PH1=VINT(3)**2 - PH2=0D0 - IF(VINT(4).LT.0D0) PH2=VINT(4)**2 - CALL PYWIDT(22,SH,WDTP,WDTE) - WDTESU=0D0 - DO 470 I=1,MIN(12,MDCY(22,3)) - IF(I.LE.8) EF= KCHG(I,1)/3D0 - IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 470 CONTINUE - DLAMB2=(TH+UH)**2-4D0*PH1*PH2 - IF(ISUB.EQ.137) THEN - FPARAM=-SH*(TH+UH)/DLAMB2 - FACFF=COMFAC*AEM**2*WDTESU*2D0*SH2/(DLAMB2*TH2*UH2)* - & (TH*UH-PH1*PH2)*((TH2+UH2)*(1D0-2D0*FPARAM*(1D0-FPARAM))- - & 2D0*PH1*PH2*FPARAM**2) - ELSEIF(ISUB.EQ.138) THEN - FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* - & PH2*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH1*SH*(TH-UH)**2/DLAMB2)+ - & 2D0*PH1**2*(TH-UH)**2) - ELSEIF(ISUB.EQ.139) THEN - FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* - & PH1*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH2*SH*(TH-UH)**2/DLAMB2)+ - & 2D0*PH2**2*(TH-UH)**2) - ELSE - FACFF=COMFAC*AEM**2*WDTESU*32D0*SH2**2/(DLAMB2**3*TH2*UH2)* - & PH1*PH2*(TH*UH-PH1*PH2)*(TH-UH)**2 - ENDIF - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGSU -C...Subprocess cross sections for SUSY processes, -C...including Higgs pair production. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGSU(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 OLPP,ORPP,OLP,ORP,OL,OR,QLL,QLR - COMPLEX*16 QRR,QRL,GLIJ,GRIJ,PROPW,PROPZ - COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) - -CMRENNA++ -C...Z and W width, combinations of weak mixing angle - ZWID=PMAS(23,2) - WWID=PMAS(24,2) - TANW=SQRT(XW/XW1) - CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) - -C...Convert almost equivalent SUSY processes into each other -C...Extract differences in flavours and couplings - -C...Sleptons and sneutrinos - IF(ISUB.EQ.201.OR.ISUB.EQ.204.OR.ISUB.EQ.207) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=201 - ILR=0 - ELSEIF(ISUB.EQ.202.OR.ISUB.EQ.205.OR.ISUB.EQ.208) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=201 - ILR=1 - ELSEIF(ISUB.EQ.203.OR.ISUB.EQ.206.OR.ISUB.EQ.209) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=203 - ELSEIF(ISUB.GE.210.AND.ISUB.LE.212) THEN - IF(ISUB.EQ.210) THEN - RKF=2.0D0 - ELSEIF(ISUB.EQ.211) THEN - RKF=SFMIX(15,1)**2 - ELSEIF(ISUB.EQ.212) THEN - RKF=SFMIX(15,2)**2 - ENDIF - ISUB=210 - ELSEIF(ISUB.EQ.213.OR.ISUB.EQ.214) THEN - IF(ISUB.EQ.213) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - RKF=2.0D0 - ELSEIF(ISUB.EQ.214) THEN - KFID=16 - RKF=1.0D0 - ENDIF - ISUB=213 - -C...Neutralinos - ELSEIF(ISUB.GE.216.AND.ISUB.LE.225) THEN - IF(ISUB.EQ.216) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.217) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.218) THEN - IZID1=3 - IZID2=3 - ELSEIF(ISUB.EQ.219) THEN - IZID1=4 - IZID2=4 - ELSEIF(ISUB.EQ.220) THEN - IZID1=1 - IZID2=2 - ELSEIF(ISUB.EQ.221) THEN - IZID1=1 - IZID2=3 - ELSEIF(ISUB.EQ.222) THEN - IZID1=1 - IZID2=4 - ELSEIF(ISUB.EQ.223) THEN - IZID1=2 - IZID2=3 - ELSEIF(ISUB.EQ.224) THEN - IZID1=2 - IZID2=4 - ELSEIF(ISUB.EQ.225) THEN - IZID1=3 - IZID2=4 - ENDIF - ISUB=216 - -C...Charginos - ELSEIF(ISUB.GE.226.AND.ISUB.LE.228) THEN - IF(ISUB.EQ.226) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.227) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.228) THEN - IZID1=1 - IZID2=2 - ENDIF - ISUB=226 - -C...Neutralino + chargino - ELSEIF(ISUB.GE.229.AND.ISUB.LE.236) THEN - IF(ISUB.EQ.229) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.230) THEN - IZID1=1 - IZID2=2 - ELSEIF(ISUB.EQ.231) THEN - IZID1=1 - IZID2=3 - ELSEIF(ISUB.EQ.232) THEN - IZID1=1 - IZID2=4 - ELSEIF(ISUB.EQ.233) THEN - IZID1=2 - IZID2=1 - ELSEIF(ISUB.EQ.234) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.235) THEN - IZID1=2 - IZID2=3 - ELSEIF(ISUB.EQ.236) THEN - IZID1=2 - IZID2=4 - ENDIF - ISUB=229 - -C...Gluino + neutralino - ELSEIF(ISUB.GE.237.AND.ISUB.LE.240) THEN - IF(ISUB.EQ.237) THEN - IZID=1 - ELSEIF(ISUB.EQ.238) THEN - IZID=2 - ELSEIF(ISUB.EQ.239) THEN - IZID=3 - ELSEIF(ISUB.EQ.240) THEN - IZID=4 - ENDIF - ISUB=237 - -C...Gluino + chargino - ELSEIF(ISUB.GE.241.AND.ISUB.LE.242) THEN - IF(ISUB.EQ.241) THEN - IZID=1 - ELSEIF(ISUB.EQ.242) THEN - IZID=2 - ENDIF - ISUB=241 - -C...Squark + neutralino - ELSEIF(ISUB.GE.246.AND.ISUB.LE.253) THEN - ILR=0 - IF(MOD(ISUB,2).NE.0) ILR=1 - IF(ISUB.LE.247) THEN - IZID=1 - ELSEIF(ISUB.LE.249) THEN - IZID=2 - ELSEIF(ISUB.LE.251) THEN - IZID=3 - ELSEIF(ISUB.LE.253) THEN - IZID=4 - ENDIF - ISUB=246 - RKF=5D0 - -C...Squark + chargino - ELSEIF(ISUB.GE.254.AND.ISUB.LE.257) THEN - IF(ISUB.LE.255) THEN - IZID=1 - ELSEIF(ISUB.LE.257) THEN - IZID=2 - ENDIF - IF(MOD(ISUB,2).EQ.0) THEN - ILR=0 - ELSE - ILR=1 - ENDIF - ISUB=254 - RKF=5D0 - -C...Squark + gluino - ELSEIF(ISUB.EQ.258.OR.ISUB.EQ.259) THEN - ISUB=258 - RKF=4D0 - -C...Stops - ELSEIF(ISUB.EQ.261.OR.ISUB.EQ.262) THEN - ILR=0 - IF(ISUB.EQ.262) ILR=1 - ISUB=261 - ELSEIF(ISUB.EQ.265) THEN - ISUB=264 - -C...Squarks - ELSEIF(ISUB.GE.271.AND.ISUB.LE.280) THEN - ILR=0 - IF(ISUB.LE.273) THEN - IF(ISUB.EQ.273) ILR=1 - ISUB=271 - RKF=16D0 - ELSEIF(ISUB.LE.276) THEN - IF(ISUB.EQ.276) ILR=1 - ISUB=274 - RKF=16D0 - ELSEIF(ISUB.LE.278) THEN - IF(ISUB.EQ.278) ILR=1 - ISUB=277 - RKF=4D0 - ELSE - IF(ISUB.EQ.280) ILR=1 - ISUB=279 - RKF=4D0 - ENDIF -C...Sbottoms - ELSEIF(ISUB.GE.281.AND.ISUB.LE.296) THEN - ILR=0 - IF(ISUB.LE.283) THEN - IF(ISUB.EQ.283) ILR=1 - ISUB=271 - RKF=4D0 - ELSEIF(ISUB.LE.286) THEN - IF(ISUB.EQ.286) ILR=1 - ISUB=274 - RKF=4D0 - ELSEIF(ISUB.LE.288) THEN - IF(ISUB.EQ.288) ILR=1 - ISUB=277 - RKF=1D0 - ELSEIF(ISUB.LE.290) THEN - IF(ISUB.EQ.290) ILR=1 - ISUB=279 - RKF=1D0 - ELSEIF(ISUB.LE.293) THEN - IF(ISUB.EQ.293) ILR=1 - ISUB=271 - RKF=1D0 - ELSEIF(ISUB.EQ.296) THEN - ILR=1 - ISUB=274 - RKF=1D0 -C...Squark + gluino - ELSEIF(ISUB.EQ.294.OR.ISUB.EQ.295) THEN - ISUB=258 - RKF=1D0 - ENDIF -C...H+/- + H0 - ELSEIF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN - IF(ISUB.EQ.297) THEN - RKF=.5D0*PARU(195)**2 - ELSEIF(ISUB.EQ.298) THEN - RKF=.5D0*(1D0-PARU(195)**2) - ENDIF - ISUB=210 -C...A0 + H0 - ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN - IF(ISUB.EQ.299) THEN - RKF=PARU(186)**2 - KFID=25 - ELSEIF(ISUB.EQ.300) THEN - RKF=PARU(187)**2 - KFID=35 - ENDIF - ISUB=213 -C...H+ + H- - ELSEIF(ISUB.EQ.301) THEN - KFID=37 - RKF=1D0 - ISUB=201 - ENDIF - -C...Supersymmetric processes - all of type 2 -> 2 : -C...correct final-state Breit-Wigners from fixed to running width. - IF(MSTP(42).GT.0) THEN - DO 100 I=1,2 - KFLW=KFPR(ISUBSV,I) - KCW=PYCOMP(KFLW) - IF(PMAS(KCW,2).LT.PARP(41)) GOTO 100 - IF(I.EQ.1) SQMI=SQM3 - IF(I.EQ.2) SQMI=SQM4 - SQMS=PMAS(KCW,1)**2 - GMMS=PMAS(KCW,1)*PMAS(KCW,2) - HBWS=GMMS/((SQMI-SQMS)**2+GMMS**2) - CALL PYWIDT(KFLW,SQMI,WDTP,WDTE) - GMMI=SQRT(SQMI)*WDTP(0) - HBWI=GMMI/((SQMI-SQMS)**2+GMMI**2) - COMFAC=COMFAC*(HBWI/HBWS) - 100 CONTINUE - ENDIF - -C...Differential cross section expressions. - - IF(ISUB.LE.210) THEN - IF(ISUB.EQ.201) THEN -C...f + fbar -> e_L + e_Lbar - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - DO 130 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 130 - EI=KCHG(IA,1)/3D0 - TT3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=-1D0 - TT3J=-1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - IF(ISUBSV.EQ.301) THEN - A1=1D0 - A2=0D0 - ELSEIF(ILR.EQ.1) THEN - A1=SFMIX(KFID,3)**2 - A2=SFMIX(KFID,4)**2 - ELSEIF(ILR.EQ.0) THEN - A1=SFMIX(KFID,1)**2 - A2=SFMIX(KFID,2)**2 - ENDIF - XLQ=(TT3J-EJ*XW)*A1 - XRQ=(-EJ*XW)*A2 - XLF=(TT3I-EI*XW) - XRF=(-EI*XW) - TAA=(EI*EJ)**2*(POLL+POLR) - TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ+XRQ)**2/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*ZWID/SH**2) - TAZ=2D0*EI*EJ*(XLQ+XRQ)*(XLF*POLL+XRF*POLR)/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - TNN=0.0D0 - TAN=0.0D0 - TZN=0.0D0 - IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN - FAC2=SQRT(2D0) - TNN1=0D0 - TNN2=0D0 - TNN3=0D0 - DO 120 II=1,4 - DK=1D0/(TH-SMZ(II)**2) - FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* - & ZMIX(II,1)) - FREK=FAC2*TANW*EI*ZMIX(II,1) - TNN1=TNN1+FLEK**2*DK - TNN2=TNN2+FREK**2*DK - DO 110 JJ=1,4 - DL=1D0/(TH-SMZ(JJ)**2) - FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* - & ZMIX(JJ,1)) - FREL=FAC2*TANW*EJ*ZMIX(JJ,1) - TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) - 110 CONTINUE - 120 CONTINUE - TNN=(UH*TH-SQM3*SQM4)*(A1**2*TNN1**2*POLL+ - & A2**2*TNN2**2*POLR) - TNN=(TNN+SH*A1*A2*TNN3*((1D0-PARJ(131))*(1D0-PARJ(132))+ - & (1D0+PARJ(131))*(1D0+PARJ(132))))/4D0/XW**2 - TZN=(UH*TH-SQM3*SQM4)*(XLQ+XRQ)* - & (TNN1*XLF*A1*POLL+TNN2*XRF*A2*POLR) - TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* - & (1D0-SQMZ/SH)/SH - TZN=TZN/XW**2/XW1 - TAN=EI*EJ*(UH*TH-SQM3*SQM4)/SH*(A1*TNN1*POLL+ - & A2*TNN2*POLR)/XW - ENDIF - FACQQ1=COMFAC*AEM**2*(TAA+TZZ+TAZ)*FCOL/3D0 - FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH**2 - FACQQ2=COMFAC*AEM**2*(TNN+TZN+TAN)*FCOL/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1+FACQQ2 - 130 CONTINUE - - ELSEIF(ISUB.EQ.203) THEN -C...f + fbar -> e_L + e_Rbar - DO 160 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 - EI=KCHG(IABS(I),1)/3D0 - TT3I=SIGN(1D0,EI)/2D0 - EJ=-1 - TT3J=-1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - A1=SFMIX(KFID,1)**2 - A2=SFMIX(KFID,2)**2 - XLQ=(TT3J-EJ*XW) - XRQ=(-EJ*XW) - XLF=(TT3I-EI*XW) - XRF=(-EI*XW) - TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ-XRQ)**2 - & /XW**2/XW1**2*A1*A2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TNN=0.0D0 - TZN=0.0D0 - TNNA=0D0 - TNNB=0D0 - IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN - FAC2=SQRT(2D0) - TNN1=0D0 - TNN2=0D0 - TNN3=0D0 - DO 150 II=1,4 - DK=1D0/(TH-SMZ(II)**2) - FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* - & ZMIX(II,1)) - FREK=FAC2*TANW*EI*ZMIX(II,1) - TNN1=TNN1+FLEK**2*DK - TNN2=TNN2+FREK**2*DK - DO 140 JJ=1,4 - DL=1D0/(TH-SMZ(JJ)**2) - FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* - & ZMIX(JJ,1)) - FREL=FAC2*TANW*EJ*ZMIX(JJ,1) - TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) - 140 CONTINUE - 150 CONTINUE - TNN=(UH*TH-SQM3*SQM4)*A1*A2*(TNN2**2*POLR+TNN1**2*POLL) - TNNA=(TNN+SH*(A1**2*POLLL+A2**2*POLRR)*TNN3)/4D0 - TNNB=(TNN+SH*(A1**2*POLRR+A2**2*POLLL)*TNN3)/4D0 - TZN=(UH*TH-SQM3*SQM4)*A1*A2 - TZN=TZN*(XLQ-XRQ)*(XLF*TNN1*POLL-XRF*TNN2*POLR)/XW1 - TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* - & (1D0-SQMZ/SH)/SH - ENDIF - FACQQ0=COMFAC*AEM**2*TZZ*FCOL/3D0*(UH*TH-SQM3*SQM4)/SH2 - FACQQ2=COMFAC*AEM**2/XW**2*(TNNA+TZN)*FCOL/3D0 - FACQQ1=COMFAC*AEM**2/XW**2*(TNNB+TZN)*FCOL/3D0 -C%%%%%%%%%%% - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACQQ0+FACQQ1)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=(FACQQ0+FACQQ2)*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 160 CONTINUE - - ELSEIF(ISUB.EQ.210) THEN -C...q + qbar' -> W*- > ~l_L + ~nu_L - FAC0=RKF*COMFAC*AEM**2/XW**2/12D0 - FAC1=(TH*UH-SQM3*SQM4)/((SH-SQMW)**2+WWID**2*SQMW) - DO 180 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 180 - DO 170 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 170 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 170 - FCKM=3D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(ISUBSV.EQ.297.OR.ISUBSV.EQ.298) THEN - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ELSE - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - ENDIF - SIGH(NCHN)=FAC0*FAC1*FCKM*FACR - 170 CONTINUE - 180 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.220) THEN - IF(ISUB.EQ.213) THEN -C...f + fbar -> ~nu_L + ~nu_Lbar - IF(ISUBSV.EQ.299.OR.ISUBSV.EQ.300) THEN - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ELSE - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ENDIF - COMFAC=COMFAC*FACR - PROPZ2=(SH-SQMZ)**2+ZWID**2*SQMZ - XLL=0.5D0 - XLR=0.0D0 - DO 190 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 190 - EI=KCHG(IA,1)/3D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0 - XRQ=-EI*XW - TZC=0.0D0 - TCC=0.0D0 - IF(IA.GE.11.AND.KFID.EQ.IA+1) THEN - TZC=VMIX(1,1)**2/(TH-SMW(1)**2)+VMIX(2,1)**2/ - & (TH-SMW(2)**2) - TCC=TZC**2 - TZC=TZC/XW1*(SH-SQMZ)/PROPZ2*XLQ*XLL - ENDIF - FACQQ1=(XLQ**2+XRQ**2)*(XLL+XLR)**2/XW1**2/PROPZ2 - FACQQ2=TZC+TCC/4D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACQQ1+FACQQ2)*RKF*(UH*TH-SQM3*SQM4)*COMFAC - & *AEM**2*FCOL/3D0/XW**2 - 190 CONTINUE - - ELSEIF(ISUB.EQ.216) THEN -C...q + qbar -> ~chi0_1 + ~chi0_1 - IF(IZID1.EQ.IZID2) THEN - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ELSE - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ENDIF - FACXX=COMFAC*AEM**2/3D0/XW**2 - IF(IZID1.EQ.IZID2) FACXX=FACXX/2D0 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMZ(IZID1)*SMZ(IZID2)*SH - PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 - PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) - DO 200 I=1,4 - ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) - IF(IZID2.NE.IZID1) THEN - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - ENDIF - 200 CONTINUE - OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- - & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 - ORPP=DCONJG(OLPP) - DO 210 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2 - XMR2=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2 - GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* - & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) - GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 - QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) - QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) - & /DCMPLX(TH-XML2) - QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) - QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ - & -DCONJG(GRIJ)/DCMPLX(UH-XMR2) - FCOL=1D0 - IF(IABS(I).GE.11) FCOL=3D0 - FACGG1=(ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ - & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ - & QRL*DCONJG(QRR)*POLR)*WS2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACXX*FACGG1*FCOL - 210 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.230) THEN - IF(ISUB.EQ.226) THEN -C...f + fbar -> ~chi+_1 + ~chi-_1 - FACXX=COMFAC*AEM**2/3D0 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMW(IZID1)*SMW(IZID2)*SH - PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 - PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) - DIFF=0D0 - IF(IZID1.EQ.IZID2) DIFF=1D0 - DO 220 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - IF(IZID2.NE.IZID1) THEN - VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) - UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) - ENDIF - 220 CONTINUE - OLP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- - & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0+DCMPLX(XW*DIFF) - ORP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- - & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0+DCMPLX(XW*DIFF) - DO 230 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 230 - EI=KCHG(IABS(I),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - QRL=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*ORP - QLL=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)*PROPZ*ORP - QRR=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*OLP - IF(MOD(I,2).EQ.0) THEN - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)-1),1)**2 - QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* - & PROPZ*OLP-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))* - & DCMPLX(T3I/XW/(TH-XML2)) - ELSE - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)+1),1)**2 - QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* - & PROPZ*OLP-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))* - & DCMPLX(T3I/XW/(TH-XML2)) - ENDIF - FCOL=1D0 - IF(IABS(I).GE.11) FCOL=3D0 - FACSUM=((ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ - & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ - & QRL*DCONJG(QRR)*POLR)*WS2)*FACXX*FCOL - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(IZID1.EQ.IZID2) THEN - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ELSE - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - ENDIF - 230 CONTINUE - - ELSEIF(ISUB.EQ.229) THEN -C...q + qbar' -> ~chi0_1 + ~chi+-_1 - FACXX=COMFAC*AEM**2/6D0/XW**2 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMW(IZID1)*SMZ(IZID2)*SH - RT2I = 1D0/SQRT(2D0) - PROPW = DCMPLX(SH-SQMW,-WWID*PMAS(24,1))/ - & DCMPLX((SH-SQMW)**2+WWID**2*SQMW,0D0) - DO 240 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - 240 CONTINUE - DO 250 I=1,4 - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 250 CONTINUE - OL=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- - & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I)*PROPW - OR=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ - & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I)*PROPW - - DO 270 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 270 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - DO 260 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 260 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 260 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - FCKM=3D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - IF(MOD(IA,2).EQ.0) THEN - ZMI2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - ZMJ2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* - & TANW+ZMIXC(IZID2,2)*T3I)/DCMPLX(UH-ZMI2) - QLR=OR-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) - & /DCMPLX(TH-ZMJ2) - ELSE - ZMI2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - ZMJ2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* - & TANW+ZMIXC(IZID2,2)*T3J)/DCMPLX(UH-ZMJ2) - QLR=OR-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) - & /DCMPLX(TH-ZMI2) - ENDIF - ZINTR=DBLE(QLR*DCONJG(QLL)) - FACGG1=FACXX*(ABS(QLL)**2*WU2+ABS(QLR)**2*WT2+ - & 2D0*ZINTR*WS2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGG1*FCKM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - 260 CONTINUE - 270 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.240) THEN - IF(ISUB.EQ.237) THEN -C...q + qbar -> gluino + ~chi0_1 - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - FAC0=COMFAC*AS*AEM*4D0/9D0/XW - GM2=SQM3 - ZM2=SQM4 - DO 280 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 280 - EI=KCHG(IABS(I),1)/3D0 - IA=IABS(I) - XLQC = -TANW*EI*ZMIX(IZID,1) - XRQC =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* - & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 - XLQ2=XLQC**2 - XRQ2=XRQC**2 - XML2=PMAS(PYCOMP(KSUSY1+IA),1)**2 - XMR2=PMAS(PYCOMP(KSUSY2+IA),1)**2 - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XML2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XML2)**2 - ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XML2)/(UH-XML2) - SGCHIL=XLQ2*(ATKIN+AUKIN-2D0*ATUKIN) - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMR2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMR2)**2 - ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XMR2)/(UH-XMR2) - SGCHIR=XRQ2*(ATKIN+AUKIN-2D0*ATUKIN) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FAC0*(SGCHIL+SGCHIR) - 280 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.250) THEN - IF(ISUB.EQ.241) THEN -C...q + qbar' -> ~chi+-_1 + gluino - FACWG=COMFAC*AS*AEM/XW*2D0/9D0 - GM2=SQM3 - ZM2=SQM4 - FAC01=2D0*UMIX(IZID,1)*VMIX(IZID,1) - FAC0=UMIX(IZID,1)**2 - FAC1=VMIX(IZID,1)**2 - DO 300 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 300 - DO 290 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 290 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290 - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - XMU2=PMAS(PYCOMP(KSUSY1+2),1)**2 - XMD2=PMAS(PYCOMP(KSUSY1+1),1)**2 - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2 - ATUKIN=SMW(IZID)*SQRT(GM2)*SH/(TH-XMU2)/(UH-XMD2) - XMU2=PMAS(PYCOMP(KSUSY2+2),1)**2 - XMD2=PMAS(PYCOMP(KSUSY2+1),1)**2 - ATKIN=(ATKIN+(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2)/2D0 - AUKIN=(AUKIN+(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2)/2D0 - ATUKIN=(ATUKIN+SMW(IZID)*SQRT(GM2)* - & SH/(TH-XMU2)/(UH-XMD2))/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWG*FCKM*(FAC0*ATKIN+FAC1*AUKIN- - & FAC01*ATUKIN)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - 290 CONTINUE - 300 CONTINUE - - ELSEIF(ISUB.EQ.243) THEN -C...q + qbar -> gluino + gluino - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - XMT=SQM3-TH - XMU=SQM3-UH - DO 310 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 - NCHN=NCHN+1 - XSU=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-UH - XST=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-TH - FACGG1=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ - & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ - & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + - & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) - XSU=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-UH - XST=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-TH - FACGG2=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ - & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ - & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + - & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 -C...1/2 for identical particles - SIGH(NCHN)=0.25D0*(FACGG1+FACGG2) - 310 CONTINUE - - ELSEIF(ISUB.EQ.244) THEN -C...g + g -> gluino + gluino - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - XMT=SQM3-TH - XMU=SQM3-UH - FACQQ1=COMFAC*AS**2*9D0/4D0*( - & (XMT*XMU-2D0*SQM3*(TH+SQM3))/XMT**2 - - & (XMT*XMU+SQM3*(UH-TH))/SH/XMT ) - FACQQ2=COMFAC*AS**2*9D0/4D0*( - & (XMU*XMT-2D0*SQM3*(UH+SQM3))/XMU**2 - - & (XMU*XMT+SQM3*(TH-UH))/SH/XMU ) - FACQQ3=COMFAC*AS**2*9D0/4D0*(2D0*XMT*XMU/SH2 + - & SQM3*(SH-4D0*SQM3)/XMT/XMU) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 320 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=FACQQ3/2D0 - 320 CONTINUE - - ELSEIF(ISUB.EQ.246) THEN -C...g + q_j -> ~chi0_1 + ~q_j - FAC0=COMFAC*AS*AEM/6D0/XW - ZM2=SQM4 - QM2=SQM3 - FACZQ0=FAC0*( (ZM2-TH)/SH + - & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - - & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - DO 340 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 340 - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 - EI=KCHG(IABS(I),1)/3D0 - IA=IABS(I) - XRQZ = -TANW*EI*ZMIX(IZID,1) - XLQZ =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* - & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 - IF(ILR.EQ.0) THEN - BS=XLQZ**2*SFMIX(IA,1)**2+XRQZ**2*SFMIX(IA,2)**2 - ELSE - BS=XLQZ**2*SFMIX(IA,3)**2+XRQZ**2*SFMIX(IA,4)**2 - ENDIF - FACZQ=FACZQ0*BS - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 330 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 330 CONTINUE - 340 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.260) THEN - IF(ISUB.EQ.254) THEN -C...g + q_j -> ~chi1_1 + ~q_i - FAC0=COMFAC*AS*AEM/12D0/XW - ZM2=SQM4 - QM2=SQM3 - AU=UMIX(IZID,1)**2 - AD=VMIX(IZID,1)**2 - FACZQ0=FAC0*( (ZM2-TH)/SH + - & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - - & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) - KFNSQ1=MOD(KFPR(ISUBSV,1),KSUSY1) - IF(MOD(KFNSQ1,2).EQ.0) THEN - KFNSQ=KFNSQ1-1 - KCHW=2 - ELSE - KFNSQ=KFNSQ1+1 - KCHW=3 - ENDIF - DO 360 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 360 - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 - IA=IABS(I) - IF(MOD(IA,2).EQ.0) THEN - FACZQ=FACZQ0*AU - ELSE - FACZQ=FACZQ0*AD - ENDIF - FACZQ=FACZQ*SFMIX(KFNSQ1,1+2*ILR)**2 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - KCHWQ=KCHW - IF(I.LT.0) KCHWQ=5-KCHW - DO 350 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHWQ) - 350 CONTINUE - 360 CONTINUE - - ELSEIF(ISUB.EQ.258) THEN -C...g + q_j -> gluino + ~q_i - XG2=SQM4 - XQ2=SQM3 - XMT=XG2-TH - XMU=XG2-UH - XST=XQ2-TH - XSU=XQ2-UH - FACQG1=0.5D0*4D0/9D0*XMT/SH + (XMT*SH+2D0*XG2*XST)/XMT**2 - - & ( (SH-XQ2+XG2)*(-XST)-SH*XG2 )/SH/(-XMT) + - & 0.5D0*1D0/2D0*( XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST) + - & (-XMU)*(TH+XG2+2D0*XQ2) )/2D0/XMT/XSU - FACQG2= 4D0/9D0*(-XMU)*(UH+XQ2)/XSU**2 + 1D0/18D0* - & (SH*(UH+XG2) - & +2D0*(XQ2-XG2)*XMU)/SH/(-XSU) + 0.5D0*4D0/9D0*XMT/SH + - & 0.5D0*1D0/2D0*(XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST)+ - & (-XMU)*(TH+XG2+2D0*XQ2))/2D0/XMT/XSU - FACQG1=COMFAC*AS**2*FACQG1/2D0 - FACQG2=COMFAC*AS**2*FACQG2/2D0 - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - DO 380 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 380 - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 380 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - FACSEL=RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - DO 370 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 370 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 370 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1*FACSEL - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2*FACSEL - 370 CONTINUE - 380 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.270) THEN - IF(ISUB.EQ.261) THEN -C...q_i + q_ibar -> ~t_1 + ~t_1bar - FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 )* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - FAC0=AS**2*4D0/9D0 - DO 390 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390 - IF(IA.GE.11.AND.IA.LE.18) THEN - EI=KCHG(IA,1)/3D0 - EJ=KCHG(KFNSQ,1)/3D0 - T3I=SIGN(1D0,EI)/2D0 - T3J=SIGN(1D0,EJ)/2D0 - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,2*ILR+1)**2 - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2*ILR+2)**2 - XLF=2D0*(T3I-EI*XW) - XRF=2D0*(-EI*XW) - TAA=0.5D0*(EI*EJ)**2 - TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*FAC0 - 390 CONTINUE - - ELSEIF(ISUB.EQ.263) THEN -C...f + fbar -> ~t1 + ~t2bar - DO 400 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - EI=KCHG(IABS(I),1)/3D0 - TT3I=SIGN(1D0,EI)/2D0 - EJ=2D0/3D0 - TT3J=1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - XLQ=2D0*(TT3J-EJ*XW) - XRQ=2D0*(-EJ*XW) - XLF=2D0*(TT3I-EI*XW) - XRF=2D0*(-EI*XW) - TZZ=(XLF**2+XRF**2)*(XLQ-XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ*(SFMIX(6,1)*SFMIX(6,2))**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) -C...Factor of 2 for t1 t2bar + t2 t1bar - FACQQ1=2D0*COMFAC*AEM**2*TZZ*FCOL*4D0 - FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 400 CONTINUE - - ELSEIF(ISUB.EQ.264) THEN -C...g + g -> ~t_1 + ~t_1bar - XSU=SQM3-UH - XST=SQM3-TH - FAC0=COMFAC*AS**2*(7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 )*0.5D0* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) - FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.280) THEN - IF(ISUB.EQ.271) THEN -C...q + q' -> ~q + ~q' (~g exchange) - XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 - XMT=XMG2-TH - XMU=XMG2-UH - XSU1=SQM3-UH - XSU2=SQM4-UH - XST1=SQM3-TH - XST2=SQM4-TH - IF(ILR.EQ.1) THEN - FACQQ1=COMFAC*AS**2*4D0/9D0*( -(XST1*XST2+SH*TH)/XMT**2 ) - FACQQ2=COMFAC*AS**2*4D0/9D0*( -(XSU1*XSU2+SH*UH)/XMU**2 ) - FACQQB=0.0D0 - ELSE - FACQQ1=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMT**2 ) - FACQQ2=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMU**2 ) - FACQQB=0.5D0*COMFAC*AS**2*4D0/9D0*( -2D0*SH*XMG2/3D0/ - & XMT/XMU ) - ENDIF - KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) - KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) - DO 430 I=-KFNSQI,KFNSQI,2*KFNSQI - IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 430 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 420 J=-KFNSQJ,KFNSQJ,2*KFNSQJ - IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 420 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 - IF(I*J.LT.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - IF(I.EQ.J) THEN - IF(ILR.EQ.0) THEN - SIGH(NCHN)=0.5D0*(FACQQ1+0.5D0*FACQQB)*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) - ELSE - SIGH(NCHN)=0.5D0*FACQQ1*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(ILR.EQ.0) THEN - SIGH(NCHN)=0.5D0*(FACQQ2+0.5D0*FACQQB)*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) - ELSE - SIGH(NCHN)=0.5D0*FACQQ2*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - ENDIF - ENDIF - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.274) THEN -C...q + qbar' -> ~q + ~qbar' - XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 - XMT=XMG2-TH - XMU=XMG2-UH - IF(ILR.EQ.0) THEN -C...Mrenna...Normalization.and.1/XMT - FACQQ1=COMFAC*AS**2*2D0/9D0*( - & (UH*TH-SQM3*SQM4)/XMT**2 ) - FACQQB=COMFAC*AS**2*2D0/9D0*( - & (UH*TH-SQM3*SQM4)/SH2*(2D0-2D0/3D0*SH/XMT)) - FACQQB=FACQQB+FACQQ1 - ELSE - FACQQ1=COMFAC*AS**2*4D0/9D0*( XMG2*SH/XMT**2 ) - FACQQB=FACQQ1 - ENDIF - KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) - KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) - DO 450 I=-KFNSQI,KFNSQI,2*KFNSQI - IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 450 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 450 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 440 J=-KFNSQJ,KFNSQJ,2*KFNSQJ - IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 440 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 440 - IF(I*J.GT.0) GOTO 440 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),5-KCHQ) - IF(I.EQ.-J) SIGH(NCHN)=FACQQB*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 440 CONTINUE - 450 CONTINUE - - ELSEIF(ISUB.EQ.277) THEN -C...q_i + q_ibar -> ~q_j + ~q_jbar ,i .ne. j -C...if i .eq. j covered in 274 - FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 ) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - FAC0=0D0 - DO 460 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.(IA.GT.MSTP(58).AND.IA.LE.10).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 - IF(IA.EQ.KFNSQ) GOTO 460 - IF(IA.EQ.11.OR.IA.EQ.13.OR.IA.EQ.15) THEN - EI=KCHG(IA,1)/3D0 - EJ=KCHG(KFNSQ,1)/3D0 - T3J=SIGN(0.5D0,EJ) - T3I=SIGN(1D0,EI)/2D0 - IF(ILR.EQ.0) THEN - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,1) - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2) - ELSE - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,3) - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,4) - ENDIF - XLF=2D0*(T3I-EI*XW) - XRF=2D0*(-EI*XW) - IF(ILR.EQ.0) THEN - XRQ=0D0 - ELSE - XLQ=0D0 - ENDIF - TAA=0.5D0*(EI*EJ)**2 - TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) - ELSEIF(IA.LE.6) THEN - FAC0=AS**2*8D0/9D0/2D0 - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*FAC0*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 460 CONTINUE - - ELSEIF(ISUB.EQ.279) THEN -C...g + g -> ~q_j + ~q_jbar - XSU=SQM3-UH - XST=SQM3-TH -C...5=RKF because ~t ~tbar treated separately - FAC0=RKF*COMFAC*AS**2*( 7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 ) - FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) - FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 470 CONTINUE - - ENDIF - ENDIF -CMRENNA-- - - RETURN - END - -C********************************************************************* - -C...PYSGTC -C...Subprocess cross sections for Technicolor processes. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGTC(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 SSMZ,SSMR,SSMO,DETD,F2L,F2R,DARHO,DZRHO,DAOME,DZOME - COMPLEX*16 DAA,DZZ,DAZ,DWW,DWRHO - COMPLEX*16 ZTC(6,6),YTC(6,6),DGGS,DGGT,DGGU,DGVS,DGVT,DGVU - COMPLEX*16 DQQS,DQQT,DQQU,DQTS,DQGS,DTGS - COMPLEX*16 DVVS,DVVT,DVVU - INTEGER INDX(6) - -C...Combinations of weak mixing angle. - TANW=SQRT(XW/XW1) - CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) - -C...Convert almost equivalent technicolor processes into -C...a few basic processes, and set distinguishing parameters. - IF(ISUB.GE.361.AND.ISUB.LE.379) THEN - SQTV=RTCM(12)**2 - SQTA=RTCM(13)**2 - SN2W=2D0*SQRT(PARU(102)*(1D0-PARU(102))) - CS2W=1D0-2D0*PARU(102) - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=CS2W/SN2W - CSXI=COS(ASIN(RTCM(3))) - CSXIP=COS(ASIN(RTCM(4))) - QUPD=2D0*RTCM(2)-1D0 - Q2UD=RTCM(2)**2+(RTCM(2)-1D0)**2 -C... rho_tc0 -> W_L W_L - IF(ISUB.EQ.361) THEN - KFA=24 - KFB=24 - CAB2=RTCM(3)**4 -C... rho_tc0 -> W_L pi_tc- - ELSEIF(ISUB.EQ.362) THEN - KFA=24 - KFB=KTECHN+211 - ISUB=361 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... pi_tc pi_tc - ELSEIF(ISUB.EQ.363) THEN - KFA=KTECHN+211 - KFB=KTECHN+211 - ISUB=361 - CAB2=(1D0-RTCM(3)**2)**2 -C... rho_tc0/omega_tc -> gamma pi_tc - ELSEIF(ISUB.EQ.364) THEN - KFA=22 - KFB=KTECHN+111 - VOGP=CSXI/RTCM(12) -C..........!!! - VRGP=VOGP*QUPD - AOGP=0D0 - ARGP=0D0 - VAGP=2D0*QUPD*CSXI - VZGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W -C... gamma pi_tc' - ELSEIF(ISUB.EQ.365) THEN - KFA=22 - KFB=KTECHN+221 - ISUB=364 - VRGP=CSXIP/RTCM(12) -C..........!!!! - VOGP=VRGP*QUPD - AOGP=0D0 - ARGP=0D0 - VAGP=2D0*Q2UD*CSXIP - VZGP=CSXIP/SN2W*(1D0-4D0*PARU(102)*Q2UD) -C... Z pi_tc - ELSEIF(ISUB.EQ.366) THEN - KFA=23 - KFB=KTECHN+111 - ISUB=364 - VOGP=CSXI*CT2W/RTCM(12) - VRGP=-QUPD*CSXI*TANW/RTCM(12) - AOGP=0D0 - ARGP=0D0 - VAGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W - VZGP=-QUPD*CSXI*CS2W/(1D0-PARU(102)) -C... Z pi_tc' - ELSEIF(ISUB.EQ.367) THEN - KFA=23 - KFB=KTECHN+221 - ISUB=364 - VRGP=CSXIP*CT2W/RTCM(12) - VOGP=-QUPD*CSXIP*TANW/RTCM(12) - AOGP=0D0 - ARGP=0D0 - VAGP=CSXIP*(1D0-4D0*Q2UD*PARU(102))/SN2W - VZGP=2D0*CSXIP*(CS2W+4D0*Q2UD*PARU(102)**2)/SN2W**2 -C... W_T pi_tc - ELSEIF(ISUB.EQ.368) THEN - KFA=24 - KFB=KTECHN+211 - ISUB=364 - VOGP=CSXI/(2D0*SQRT(PARU(102)))/RTCM(12) - VRGP=0D0 - AOGP=0D0 -C..........!!!! - ARGP=-CSXI/(2D0*SQRT(PARU(102)))/RTCM(13) - VAGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) - VZGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) -C... rho_tc+ -> W_L Z_L - ELSEIF(ISUB.EQ.370) THEN - KFA=24 - KFB=23 - CAB2=RTCM(3)**4 -C... W_L pi_tc0 - ELSEIF(ISUB.EQ.371) THEN - KFA=24 - KFB=KTECHN+111 - ISUB=370 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... Z_L pi_tc+ - ELSEIF(ISUB.EQ.372) THEN - KFA=KTECHN+211 - KFB=23 - ISUB=370 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... pi_tc+ pi_tc0 - ELSEIF(ISUB.EQ.373) THEN - KFA=KTECHN+211 - KFB=KTECHN+111 - ISUB=370 - CAB2=(1D0-RTCM(3)**2)**2 -C... gamma pi_tc+ - ELSEIF(ISUB.EQ.374) THEN - KFA=KTECHN+211 - KFB=22 - VRGP=QUPD*CSXI - ARGP=0D0 - VWGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) -C... Z_T pi_tc+ - ELSEIF(ISUB.EQ.375) THEN - KFA=KTECHN+211 - KFB=23 - ISUB=374 - VRGP=-QUPD*CSXI*TANW - ARGP=CSXI/(2D0*SQRT(PARU(102)*(1D0-PARU(102)))) - VWGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) -C... W_T pi_tc0 - ELSEIF(ISUB.EQ.376) THEN - KFA=24 - KFB=KTECHN+111 - ISUB=374 - VRGP=0D0 - ARGP=-CSXI/(2D0*SQRT(PARU(102))) - VWGP=0D0 -C... W_T pi_tc0' - ELSEIF(ISUB.EQ.377) THEN - KFA=24 - KFB=KTECHN+221 - ISUB=374 - ARGP=0D0 - VRGP=CSXIP/(2D0*SQRT(PARU(102))) - VWGP=CSXIP/(2D0*PARU(102)) - ENDIF - ENDIF - -C...QCD 2 -> 2 processes: corrections from virtual technicolor exchange. - IF(ISUB.GE.381.AND.ISUB.LE.388) THEN - IF(ITCM(5).LE.4) THEN - SQDQQS=1D0/SH2 - SQDQQT=1D0/TH2 - SQDQQU=1D0/UH2 - SQDGGS=SQDQQS - SQDGGT=SQDQQT - SQDGGU=SQDQQU - REDGGS=1D0/SH - REDGGT=1D0/TH - REDGGU=1D0/UH - REDGTU=1D0/UH/TH - REDGSU=1D0/SH/UH - REDGST=1D0/SH/TH - REDQST=1D0/SH/TH - REDQTU=1D0/UH/TH - SQDLGS=0D0 - SQDLGT=0D0 - SQDQTS=SQDQQS - ELSEIF(ITCM(5).EQ.5) THEN - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSE - IMDL=2 - ENDIF - ALPRHT=2.91D0*(3D0/ITCM(1)) - SIN2T=2D0*TANT3/(TANT3**2+1D0) - SINT3=TANT3/SQRT(TANT3**2+1D0) - XIG=SQRT(PYALPS(SH)/ALPRHT) - X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0)/SIN2T - X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0)/SIN2T - X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- - & SINT3**2)*2D0/SIN2T - X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- - & SINT3**2)*2D0/SIN2T - - SM1122=.5D0*(2D0-RTCM(29)**2-RTCM(31)**2)*RTCM(28)**2 - SM1112=X12*RTCM(28)**2*SIN2T - SM1121=-X21*RTCM(28)**2*SIN2T - SM2212=-SM1112 - SM2221=-SM1121 - SM1221=-.5D0*((1D0-RTCM(29)**2)*SIN(2D0*RTCM(30))+ - & (1D0-RTCM(31)**2)*SIN(2D0*RTCM(32)))*RTCM(28)**2 - -C.........SH LOOP - ZTC(1,1)=DCMPLX(SH,0D0) - CALL PYWIDT(3100021,SH,WDTP,WDTE) - IF(WDTP(0).GT.RTCM(33)*SHR) WDTP(0)=RTCM(33)*SHR - ZTC(2,2)=DCMPLX(SH-PMAS(PYCOMP(3100021),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3100113,SH,WDTP,WDTE) - ZTC(3,3)=DCMPLX(SH-PMAS(PYCOMP(3100113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3400113,SH,WDTP,WDTE) - ZTC(4,4)=DCMPLX(SH-PMAS(PYCOMP(3400113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3200113,SH,WDTP,WDTE) - ZTC(5,5)=DCMPLX(SH-PMAS(PYCOMP(3200113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3300113,SH,WDTP,WDTE) - ZTC(6,6)=DCMPLX(SH-PMAS(PYCOMP(3300113),1)**2,-SHR*WDTP(0)) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(SH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(SH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(SH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(SH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(SH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - - DO 110 I=1,5 - DO 100 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 100 CONTINUE - 110 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 130 I=1,6 - DO 120 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 120 CONTINUE - 130 CONTINUE - - DO 140 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 140 CONTINUE - DGGS=YTC(1,1) - DVVS=YTC(2,2) - DGVS=YTC(1,2) - - XIG=SQRT(PYALPS(-TH)/ALPRHT) -C.........TH LOOP - ZTC(1,1)=DCMPLX(TH) - ZTC(2,2)=DCMPLX(TH-PMAS(PYCOMP(3100021),1)**2) - ZTC(3,3)=DCMPLX(TH-PMAS(PYCOMP(3100113),1)**2) - ZTC(4,4)=DCMPLX(TH-PMAS(PYCOMP(3400113),1)**2) - ZTC(5,5)=DCMPLX(TH-PMAS(PYCOMP(3200113),1)**2) - ZTC(6,6)=DCMPLX(TH-PMAS(PYCOMP(3300113),1)**2) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(TH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(TH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(TH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(TH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(TH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - DO 160 I=1,5 - DO 150 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 150 CONTINUE - 160 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 180 I=1,6 - DO 170 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 170 CONTINUE - 180 CONTINUE - DO 190 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 190 CONTINUE - DGGT=YTC(1,1) - DVVT=YTC(2,2) - DGVT=YTC(1,2) - - XIG=SQRT(PYALPS(-UH)/ALPRHT) -C.........UH LOOP - ZTC(1,1)=DCMPLX(UH,0D0) - ZTC(2,2)=DCMPLX(UH-PMAS(PYCOMP(3100021),1)**2) - ZTC(3,3)=DCMPLX(UH-PMAS(PYCOMP(3100113),1)**2) - ZTC(4,4)=DCMPLX(UH-PMAS(PYCOMP(3400113),1)**2) - ZTC(5,5)=DCMPLX(UH-PMAS(PYCOMP(3200113),1)**2) - ZTC(6,6)=DCMPLX(UH-PMAS(PYCOMP(3300113),1)**2) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(UH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(UH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(UH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(UH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(UH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - DO 210 I=1,5 - DO 200 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 200 CONTINUE - 210 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 230 I=1,6 - DO 220 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 220 CONTINUE - 230 CONTINUE - DO 240 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 240 CONTINUE - DGGU=YTC(1,1) - DVVU=YTC(2,2) - DGVU=YTC(1,2) - - IF(IMDL.EQ.1) THEN - DQQS=DGGS+DVVS*DCMPLX(TANT3**2)-DGVS*DCMPLX(2D0*TANT3) - DQQT=DGGT+DVVT*DCMPLX(TANT3**2)-DGVT*DCMPLX(2D0*TANT3) - DQQU=DGGU+DVVU*DCMPLX(TANT3**2)-DGVU*DCMPLX(2D0*TANT3) - DQTS=DGGS-DVVS-DGVS*DCMPLX(TANT3-1D0/TANT3) - DQGS=DGGS-DGVS*DCMPLX(TANT3) - DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - ELSE - DQQS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) - DQQT=DGGT+DVVT*DCMPLX(1D0/TANT3**2)+DGVT*DCMPLX(2D0/TANT3) - DQQU=DGGU+DVVU*DCMPLX(1D0/TANT3**2)+DGVU*DCMPLX(2D0/TANT3) - DQTS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) - DQGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - ENDIF - - SQDQTS=ABS(DQTS)**2 - SQDQQS=ABS(DQQS)**2 - SQDQQT=ABS(DQQT)**2 - SQDQQU=ABS(DQQU)**2 - SQDLGS=ABS(DCMPLX(SH)*DQGS-DCMPLX(1D0))**2 - REDLGS=DBLE(DQGS) - SQDHGS=ABS(DCMPLX(SH)*DTGS-DCMPLX(1D0))**2 - REDHGS=DBLE(DTGS) - SQDLGT=ABS(DCMPLX(TH)*DGGT-DCMPLX(1D0))**2 - - SQDGGS=ABS(DGGS)**2 - SQDGGT=ABS(DGGT)**2 - SQDGGU=ABS(DGGU)**2 - REDGGS=DBLE(DGGS) - REDGGT=DBLE(DGGT) - REDGGU=DBLE(DGGU) - REDGTU=DBLE(DGGU*DCONJG(DGGT)) - REDGSU=DBLE(DGGU*DCONJG(DGGS)) - REDGST=DBLE(DGGS*DCONJG(DGGT)) - REDQST=DBLE(DQQS*DCONJG(DQQT)) - REDQTU=DBLE(DQQT*DCONJG(DQQU)) - ENDIF - ENDIF - - -C...Differential cross section expressions. - - IF(ISUB.LE.190) THEN - IF(ISUB.EQ.149) THEN -C...g + g -> eta_tc - KCTC=PYCOMP(KTECHN+331) - CALL PYWIDT(KTECHN+331,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC*0.5D0/((SH-PMAS(KCTC,1)**2)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HP=SH - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 250 - HI=HP*WDTP(3) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 250 CONTINUE - - ELSEIF(ISUB.EQ.165) THEN -C...q + qbar -> l+ + l- (including contact term for compositeness) - ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - ZRATI=XWC*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFF=IABS(KFPR(ISUB,1)) - EF=KCHG(KFF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=VF+AF - VARF=VF-AF - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - WID2=1D0 - IF(KFF.EQ.6) WID2=WIDS(6,1) - IF(KFF.EQ.7.OR.KFF.EQ.8) WID2=WIDS(KFF,1) - IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) - DO 260 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=VI+AI - VARI=VI-AI - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF((ITCM(5).EQ.1.AND.IABS(I).LE.2).OR.ITCM(5).EQ.2) THEN - FGZA=(EI*EF+VALI*VALF*ZRATR+RTCM(42)*SH/ - & (AEM*RTCM(41)**2))**2+(VALI*VALF*ZRATI)**2+ - & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 - ELSE - FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+ - & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 - ENDIF - FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+ - & (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2 - FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2) - IF((ITCM(5).EQ.3.AND.IABS(I).EQ.2).OR.(ITCM(5).EQ.4.AND. - & MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2D0*RTCM(41)**4) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2 - 260 CONTINUE - - ELSEIF(ISUB.EQ.166) THEN -C...q + q'bar -> l + nu_l (including contact term for compositeness) - WFAC=(1D0/4D0)*(AEM/XW)**2*UH2/((SH-SQMW)**2+GMMW**2) - WCIFAC=WFAC+SH2/(4D0*RTCM(41)**4) - KFF=IABS(KFPR(ISUB,1)) - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - DO 280 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 280 - IA=IABS(I) - DO 270 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 270 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 270 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 270 - FCOI=1D0 - IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - WID2=1D0 - IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND. - & MOD(J,2).EQ.0)) THEN - IF(KFF.EQ.5) WID2=WIDS(6,2) - IF(KFF.EQ.7) WID2=WIDS(8,2)*WIDS(7,3) - IF(KFF.EQ.17) WID2=WIDS(18,2)*WIDS(17,3) - ELSE - IF(KFF.EQ.5) WID2=WIDS(6,3) - IF(KFF.EQ.7) WID2=WIDS(8,3)*WIDS(7,2) - IF(KFF.EQ.17) WID2=WIDS(18,3)*WIDS(17,2) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2 - IF((ITCM(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.ITCM(5).EQ.4) - & SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2 - 270 CONTINUE - 280 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.191) THEN -C...q + qbar -> rho_tc0. - KCTC=PYCOMP(KTECHN+113) - SQMRHT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 290 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 290 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - HI=HP*((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 290 CONTINUE - - ELSEIF(ISUB.EQ.192) THEN -C...q + qbar' -> rho_tc+/-. - KCTC=PYCOMP(KTECHN+213) - SQMRHT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)* - & (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) - DO 310 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 310 - IA=IABS(I) - DO 300 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 300 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 300 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 300 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHR)/2)+WDTE(0,4)) - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.193) THEN -C...q + qbar -> omega_tc0. - KCTC=PYCOMP(KTECHN+223) - SQMOMT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMOMT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMOMT**2/SH)* - & (2D0*RTCM(2)-1D0)**2 - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 320 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - HI=HP*((EI-VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI-VARI*BWZR)**2+(VARI*BWZI)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 320 CONTINUE - - ELSEIF(ISUB.EQ.194) THEN -C...f + fbar -> f' + fbar' via s-channel rho_tc and omega_tc. - KFA=KFPR(ISUBSV,1) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=AEM**2*COMFAC - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) - - QUPD=2D0*RTCM(2)-1D0 - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DAA=(-Sfzr*SSMO - Sfzo*SSMR + SSMO*SSMR*SSMZ)/DETD/SH - DZZ=(-Sfar*SSMO - Sfao*SSMR + SSMO*SSMR)/DETD/SH - DAZ=(far*fzr*SSMO + fao*fzo*SSMR)/DETD/SH - - XWRHT=1D0/(4D0*XW*(1D0-XW)) - KFF=IABS(KFPR(ISUB,1)) - EF=KCHG(KFF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - - WID2=1D0 - IF(KFF.GE.6.AND.KFF.LE.8) WID2=WIDS(KFF,1) - IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) - DZZ=DZZ*DCMPLX(XWRHT,0D0) - DAZ=DAZ*DCMPLX(SQRT(XWRHT),0D0) - - DO 330 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 330 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - FCOI=FCOF - IF(IABS(I).LE.10) FCOI=FCOI/3D0 - DIFLL=ABS(EI*EF*DAA+VALI*VALF*DZZ+DAZ*(EI*VALF+EF*VALI))**2 - DIFRR=ABS(EI*EF*DAA+VARI*VARF*DZZ+DAZ*(EI*VARF+EF*VARI))**2 - DIFLR=ABS(EI*EF*DAA+VALI*VARF*DZZ+DAZ*(EI*VARF+EF*VALI))**2 - DIFRL=ABS(EI*EF*DAA+VARI*VALF*DZZ+DAZ*(EI*VALF+EF*VARI))**2 - FACSIG=(DIFLL+DIFRR)*((UH-SQM4)**2+SH*SQM4)+ - & (DIFLR+DIFRL)*((TH-SQM3)**2+SH*SQM3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HP*FCOI*FACSIG*WID2 - 330 CONTINUE - - ELSEIF(ISUB.EQ.195) THEN -C...f + fbar' -> f'' + fbar''' via s-channel rho_tc+ - KFA=KFPR(ISUBSV,1) - KFB=KFA+1 - ALPRHT=2.91D0*(3D0/ITCM(1)) - FACTC=COMFAC*(AEM**2/12D0/XW**2)*(UH-SQM3)*(UH-SQM4)*3D0 - - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - - FCOF=1D0 - IF(KFA.LE.8) FCOF=3D0 - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - HP=FACTC*ABS(SSMR/DETD)**2/SH**2*FCOF - - DO 350 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 350 - IA=IABS(I) - DO 340 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 340 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 340 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 340 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(KFA,(5-KCHR)/2)*WIDS(KFB,(5+KCHR)/2) - 340 CONTINUE - 350 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.380) THEN - IF(ISUB.EQ.361) THEN -C...f + fbar -> W_L W_L, W_L pi_tc, pi_tc pi_tc - FACA=(SH**2*BE34**2-(TH-UH)**2) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/12D0)*AEM**2*CAB2*COMFAC*FACA*3D0 - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DARHO=-(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH - DZRHO=-(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH - DAA=-(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH - DZZ=-(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH - DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH - - DO 360 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 360 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.25D0*(VI+AI) - VARI=0.25D0*(VI-AI) - F2L=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ - $ VALI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) - F2R=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ - $ VARI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) - HI=ABS(F2L)**2+ABS(F2R)**2 - IF(IA.LE.10) HI=HI/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(KFA.EQ.KFB) THEN - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),1) - ELSE - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) - ENDIF - 360 CONTINUE - - ELSEIF(ISUB.EQ.364) THEN -C...f + fbar -> gamma pi_tc, gamma pi_tc', Z pi_tc, Z pi_tc', -C...W pi_tc - VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) - AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3) - FANOM=SQRT(PARU(1)*AEM)*ITCM(1)/PARU(2)**2/RTCM(1) - - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/24D0)*AEM**2*COMFAC*3D0*SH - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DARHO=(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH - DZRHO=(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH - DAOME=(-FAO*SFZR+FAR*FZO*FZR+FAO*SSMR*SSMZ)/DETD/SH - DZOME=(-FZO*SFAR+FAR*FAO*FZR+FZO*SSMR)/DETD/SH - DAA=(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH - DZZ=(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH - DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH - - DO 370 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.25D0*(VI+AI) - VARI=0.25D0*(VI-AI) -C...........Add in anomaly contribution - F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*VRGP - F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*VOGP - F2L=F2L+FANOM*(VAGP*(EI*DAA+VALI*DAZ/SQRT(XW*XW1))+ - $ VZGP*(EI*DAZ+VALI*DZZ/SQRT(XW*XW1))) - F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*VRGP - F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*VOGP - F2R=F2R+FANOM*(VAGP*(EI*DAA+VARI*DAZ/SQRT(XW*XW1))+ - $ VZGP*(EI*DAZ+VARI*DZZ/SQRT(XW*XW1))) - HI=(ABS(F2L)**2+ABS(F2R)**2)*VFAC - F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*ARGP - F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*AOGP - F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*ARGP - F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*AOGP - HJ=(ABS(F2L)**2+ABS(F2R)**2)*AFAC - HI=HI+HJ - IF(IA.LE.10) HI=HI/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(ISUBSV.NE.368) THEN - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),2) - ELSE - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) - ENDIF - 370 CONTINUE - - ELSEIF(ISUB.EQ.370) THEN -C...f + fbar' -> W_L Z_L, W_L pi_tc, Z_L pi_tc, pi_tc pi_tc - - FACA=(SH**2*BE34**2-(TH-UH)**2) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/96D0)*AEM**2*CAB2*COMFAC*FACA*3D0/XW**2 - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - DWW=SSMR/DETD/SH - DWRHO=-1D0/DETD/SH - HP=HP*ABS(DWW+DWRHO)**2 - DO 390 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 390 - IA=IABS(I) - DO 380 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 380 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 380 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 380 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* - & WIDS(PYCOMP(KFB),2) - 380 CONTINUE - 390 CONTINUE - - ELSEIF(ISUB.EQ.374) THEN -C...f + fbar' -> gamma pi_tc - FANOM=SQRT(AEM)*ITCM(1)/2D0/PARU(2)/RTCM(1) - VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) - AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3)/SQTA*ARGP**2 - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/48D0)*AEM**2/XW*COMFAC*3D0*SH - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - DWW=SSMR/DETD/SH - DWRHO=-DCMPLX(FWR,0D0)/DETD/SH - HP=HP*(AFAC*ABS(DWRHO)**2+ - $ VFAC*ABS(FANOM*DWW*VWGP+DWRHO*VRGP/SQRT(SQTV))**2) - DO 410 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410 - IA=IABS(I) - DO 400 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 400 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 400 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* - & WIDS(PYCOMP(KFB),2) - 400 CONTINUE - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.390) THEN - IF(ISUB.EQ.381) THEN -C...f + f' -> f + f' (g exchange) - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)*SQDQQT - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)*SQDQQT*FACA- - & MSTP(34)*2D0/3D0*UH2*REDQST) - FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)*SQDQQU - FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) - RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) - IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN -C...Modifications from contact interactions (compositeness) - FACCI1=FACQQ1+COMFAC*(SH2/RTCM(41)**4) - FACCIB=FACQQB+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* - & (UH2/TH+UH2/SH)+COMFAC*(5D0/3D0)*(UH2/RTCM(41)**4) - FACCI2=FACQQ2+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* - & (SH2/TH+SH2/UH)+COMFAC*(5D0/3D0)*(SH2/RTCM(41)**4) - FACCI3=FACQQ1+COMFAC*(UH2/RTCM(41)**4) - RATCII=(FACCI1+FACCI2+FACQQI)/(FACCI1+FACCI2) - ELSEIF(ITCM(5).EQ.5) THEN - FACCI1=FACQQ1 - FACCIB=FACQQB - FACCI2=FACQQ2 - FACCI3=FACQQ1 -CSM.......Check this change from -CSM RATCII=1D0 - RATCII=RATQQI - ENDIF - DO 430 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 - DO 420 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.(IA.GE.3.OR. - & JA.GE.3))) THEN - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - ELSE - SIGH(NCHN)=FACCI1 - IF(I*J.LT.0) SIGH(NCHN)=FACCI3 - IF(I.EQ.-J) SIGH(NCHN)=FACCIB - ENDIF - IF(I.EQ.J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IA.GE.3)) THEN - SIGH(NCHN-1)=0.5D0*FACQQ1*RATQQI - SIGH(NCHN)=0.5D0*FACQQ2*RATQQI - ELSE - SIGH(NCHN-1)=0.5D0*FACCI1*RATCII - SIGH(NCHN)=0.5D0*FACCI2*RATCII - ENDIF - ENDIF - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.382) THEN -C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) - CALL PYWIDT(21,SH,WDTP,WDTE) - FACQQF=COMFAC*AS**2*4D0/9D0*(TH2+UH2) - FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(ITCM(5).EQ.1) THEN -C...Modifications from contact interactions (compositeness) - FACCIB=FACQQB - DO 440 I=1,2 - FACCIB=FACCIB+COMFAC*(UH2/RTCM(41)**4)*(WDTE(I,1)+ - & WDTE(I,2)+WDTE(I,4)) - 440 CONTINUE - ELSEIF(ITCM(5).GE.2.AND.ITCM(5).LE.4) THEN - FACCIB=FACQQB+COMFAC*(UH2/RTCM(41)**4)* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ELSEIF(ITCM(5).EQ.5) THEN - FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)- - & WDTE(5,1)-WDTE(5,2)-WDTE(5,4)) - FACCIB=FACQQF*SQDQTS*(WDTE(5,1)+WDTE(5,2)+WDTE(5,4)) - ENDIF - DO 450 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 450 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IABS(I).GE.3)) THEN - SIGH(NCHN)=FACQQB - ELSEIF(ITCM(5).EQ.5) THEN - SIGH(NCHN)=FACQQB - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACCIB - ELSE - SIGH(NCHN)=FACCIB - ENDIF - 450 CONTINUE - - ELSEIF(ISUB.EQ.383) THEN -C...f + fbar -> g + g (q + qbar -> g + g only) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) - IF(ITCM(5).EQ.5) THEN - FACGG3=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) - FACGG4=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) - ENDIF - DO 460 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG4 - 460 CONTINUE - - ELSEIF(ISUB.EQ.384) THEN -C...f + g -> f + g (q + g -> q + g only) - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH-9D0/4D0*SH*UH/TH2*SQDLGT)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH-9D0/4D0*SH*UH/TH2*SQDLGT) - DO 480 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 480 - DO 470 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 470 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2 - 470 CONTINUE - 480 CONTINUE - - ELSEIF(ISUB.EQ.385) THEN -C...g + g -> f + fbar (g + g -> q + qbar only) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500 - IDC0=MDCY(21,2)-1 -C...Begin by d, u, s flavours. - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 -C...Next c and b flavours: modified that and uhat for fixed -C...cos(theta-hat). - DO 490 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - IF(ITCM(5).GE.5) THEN - IF(IFL.EQ.4) THEN - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - ELSE - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - ENDIF - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 490 CONTINUE - 500 CONTINUE - - ELSEIF(ISUB.EQ.386) THEN -C...g + g -> g + g - IF(ITCM(5).LE.4) THEN - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ - & 2D0*TH/SH+TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ - & 2D0*SH/UH+SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+ - & 2D0*UH/TH+UH2/TH2) - ELSE - GST= (12D0 + 40D0*TH/SH + 56D0*TH2/SH2 + 32D0*TH**3/SH**3 + - & 16D0*TH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*TH + 16D0*TH2)+ - & 4D0*REDGST*(SH + 2D0*TH)* - & (2D0*SH**3 - 3D0*SH2*TH - 2D0*SH*TH2 + 2D0*TH**3)/SH2 + - & 2D0*REDGGS*(2D0*SH - 12D0*TH2/SH - 8D0*TH**3/SH2) + - & 2D0*REDGGT*(4D0*SH - 22D0*TH - 68D0*TH2/SH - 60D0*TH**3/SH2- - & 32D0*TH**4/SH**3 - 16D0*TH**5/SH**4) + - & SQDGGT*(16D0*SH2 + 16D0*SH*TH + 68D0*TH2 + 144D0*TH**3/SH + - & 96D0*TH**4/SH2 + 32D0*TH**5/SH**3 + 16D0*TH**6/SH**4))/16D0 - GSU= (12D0 + 40D0*UH/SH + 56D0*UH2/SH2 + 32D0*UH**3/SH**3 + - & 16D0*UH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*UH + 16D0*UH2)+ - & 4D0*REDGSU*(SH + 2D0*UH)* - & (2D0*SH**3 - 3D0*SH2*UH - 2D0*SH*UH2 + 2D0*UH**3)/SH2 + - & 2D0*REDGGS*(2D0*SH - 12D0*UH2/SH - 8D0*UH**3/SH2) + - & 2D0*REDGGU*(4D0*SH - 22D0*UH - 68D0*UH2/SH - 60D0*UH**3/SH2- - & 32D0*UH**4/SH**3 - 16D0*UH**5/SH**4) + - & SQDGGU*(16D0*SH2 + 16D0*SH*UH + 68D0*UH2 + 144D0*UH**3/SH + - & 96D0*UH**4/SH2 + 32D0*UH**5/SH**3 + 16D0*UH**6/SH**4))/16D0 - GUT= (12D0 - 16D0*TH*(TH - UH)**2*UH/SH**4 + - & 4D0*REDGGU*(2D0*TH**5 - 15D0*TH**4*UH - 48D0*TH**3*UH2 - - & 58D0*TH2*UH**3 - 10D0*TH*UH**4 + UH**5)/SH**4 + - & 4D0*REDGGT*(TH**5 - 10D0*TH**4*UH - 58D0*TH**3*UH2 - - & 48D0*TH2*UH**3 - 15D0*TH*UH**4 + 2D0*UH**5)/SH**4 + - & 4D0*SQDGGU*(4D0*TH**6 + 20D0*TH**5*UH + 57D0*TH**4*UH2 + - & 72D0*TH**3*UH**3+ 38D0*TH2*UH**4+4D0*TH*UH**5 +UH**6)/SH**4+ - & 4D0*SQDGGT*(4D0*UH**6 + 4D0*TH**5*UH + 38D0*TH**4*UH2 + - & 72D0*TH**3*UH**3 +57D0*TH2*UH**4+20D0*TH*UH**5+TH**6)/SH**4+ - & 2D0*REDGTU*((TH - UH)**2* (TH**4 + 20D0*TH**3*UH + - & 30D0*TH2*UH2 + 20D0*TH*UH**3 + UH**4) + - & SH2*(7D0*TH**4 + 52D0*TH**3*UH + 274D0*TH2*UH2 + - & 52D0*TH*UH**3 + 7D0*UH**4))/(2D0*SH**4))/16D0 - FACGG1=COMFAC*AS**2*9D0/4D0*GST*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*GSU*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*GUT - ENDIF - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=0.5D0*FACGG3 - 510 CONTINUE - - ELSEIF(ISUB.EQ.387) THEN -C...q + qbar -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ - & 2D0*SQMAVG/SH) - IF(ITCM(5).GE.5) THEN - IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN - FACQQB=FACQQB*SH2*SQDQTS - ELSE - FACQQB=FACQQB*SH2*SQDQQS - ENDIF - ENDIF - IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQB=FACQQB*WID2 - DO 520 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 520 CONTINUE - - ELSEIF(ISUB.EQ.388) THEN -C...g + g -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - IF(ITCM(5).GE.5) THEN - IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - ELSE - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - ENDIF - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 - IF(MSTP(35).GE.1) THEN - FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) - FACQQ1=FACQQ1*FATRE - FACQQ2=FACQQ2*FATRE - ENDIF - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ1=FACQQ1*WID2 - FACQQ2=FACQQ2*WID2 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 530 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 530 CONTINUE - ENDIF - ENDIF - -CMRENNA-- - - RETURN - END - -C********************************************************************* - -C...PYSGWZ -C...Subprocess cross sections for W/Z processes, -C...except that longitudinal WW scattering is in Higgs sector. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGWZ(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex numbers - DIMENSION WDTP(0:400),WDTE(0:400,0:5),HGZ(6,3),HL3(3),HR3(3), - &HL4(3),HR4(3) - COMPLEX*16 COULCK,COULCP,COULCD,COULCR,COULCS - -C...Differential cross section expressions. - - IF(ISUB.LE.20) THEN - IF(ISUB.EQ.1) THEN -C...f + fbar -> gamma*/Z0 - MINT(61)=2 - CALL PYWIDT(23,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACZ=4D0*COMFAC*3D0 - HP0=AEM/3D0*SH - HP1=AEM/3D0*XWC*SH - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - HI0=HP0 - IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 - HI1=HP1 - IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+ - & EI*VI*(1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)* - & (HI0*HP1+HI1*HP0)*VINT(112)+(VI**2+AI**2)/ - & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)) - 100 CONTINUE - - ELSEIF(ISUB.EQ.2) THEN -C...f + fbar' -> W+/- - CALL PYWIDT(24,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMW)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - IA=IABS(I) - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 110 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*2D0 - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.15) THEN -C...f + fbar -> g + (gamma*/Z0) (q + qbar -> g + (gamma*/Z0) only) - FACZG=COMFAC*AS*AEM*(8D0/9D0)*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 130 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 130 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 130 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 140 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - 140 CONTINUE - - ELSEIF(ISUB.EQ.16) THEN -C...f + fbar' -> g + W+/- (q + qbar' -> g + W+/- only) - FACWG=COMFAC*AS*AEM/XW*2D0/9D0*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACWG=FACWG*HBW4C/HBW4 - DO 160 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 160 - DO 150 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 150 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 150 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - FCKM=VCKM((IA+1)/2,(JA+1)/2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWG*FCKM*WIDSC - 150 CONTINUE - 160 CONTINUE - - ELSEIF(ISUB.EQ.19) THEN -C...f + fbar -> gamma + (gamma*/Z0) - FACGZ=COMFAC*2D0*AEM**2*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 170 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 170 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 170 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 180 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - 180 CONTINUE - - ELSEIF(ISUB.EQ.20) THEN -C...f + fbar' -> gamma + W+/- - FACGW=COMFAC*0.5D0*AEM**2/XW -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACGW=FACGW*HBW4C/HBW4 -C...Anomalous couplings - TERM1=(TH2+UH2+2D0*SQM4*SH)/(TH*UH) - TERM2=0D0 - TERM3=0D0 - IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN - TERM2=RTCM(46)*(TH-UH)/(TH+UH) - TERM3=0.5D0*RTCM(46)**2*(TH*UH+(TH2+UH2)*SH/ - & (4D0*SQMW))/(TH+UH)**2 - ENDIF - DO 200 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 200 - DO 190 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 190 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 190 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 190 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - IF(IA.LE.10) THEN - FACWR=UH/(TH+UH)-1D0/3D0 - FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=FACA/3D0 - ELSE - FACWR=-TH/(TH+UH) - FCKM=1D0 - FCOI=1D0 - ENDIF - FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC - 190 CONTINUE - 200 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.22) THEN -C...f + fbar -> (gamma*/Z0) + (gamma*/Z0) -C...Kinematics dependence - FACZZ=COMFAC*AEM**2*((TH2+UH2+2D0*(SQM3+SQM4)*SH)/(TH*UH)- - & SQM3*SQM4*(1D0/TH2+1D0/UH2)) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - DO 220 I=1,6 - DO 210 J=1,3 - HGZ(I,J)=0D0 - 210 CONTINUE - 220 CONTINUE - RADC3=1D0+PYALPS(SQM3)/PARU(1) - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 230 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 230 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1 - IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC3 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.GE.1) THEN - HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.GE.1) THEN - HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 230 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW3=(1D0/PARU(1))*GMMZ/((SQM3-SQMZ)**2+GMMZ**2) - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM3,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - DO 240 J=1,3 - HGZ(1,J)=HGZ(1,J)*HFAEM*VINT(111)/SQM3 - HGZ(2,J)=HGZ(2,J)*HFAEM*VINT(112)/SQM3 - HGZ(3,J)=HGZ(3,J)*HFAEM*VINT(114)/SQM3 - 240 CONTINUE - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - DO 250 J=1,3 - HGZ(4,J)=HGZ(4,J)*HFAEM*VINT(111)/SQM4 - HGZ(5,J)=HGZ(5,J)*HFAEM*VINT(112)/SQM4 - HGZ(6,J)=HGZ(6,J)*HFAEM*VINT(114)/SQM4 - 250 CONTINUE -C...Loop over flavours; separate left- and right-handed couplings - DO 270 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - VALI=VI-AI - VARI=VI+AI - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - DO 260 J=1,3 - HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J) - HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J) - HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J) - HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J) - 260 CONTINUE - FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+ - & HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+ - & HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+ - & HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*FCOI*FACLR/(HBW3*HBW4) - 270 CONTINUE - - ELSEIF(ISUB.EQ.23) THEN -C...f + fbar' -> Z0 + W+/- (Z0 only, i.e. no gamma* admixture.) - FACZW=COMFAC*0.5D0*(AEM/XW)**2 - FACZW=FACZW*WIDS(23,2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACBW=1D0/((SH-SQMW)**2+GMMW**2) - DO 290 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 290 - DO 280 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 280 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 280 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 280 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - IF(VI+AI.GT.0) THEN - VISAV=VI - AISAV=AI - VI=VJ - AI=AJ - VJ=VISAV - AJ=AISAV - ENDIF - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=1D0 - IF(IA.LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9D0-8D0*XW)/4D0*THUH+ - & (8D0*XW-6D0)/4D0*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))* - & (SH-SQMW)*FACBW*0.5D0*((VJ+AJ)/TH-(VI+AI)/UH)+ - & THUH/(16D0*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+ - & SH*(SQM3+SQM4)/(8D0*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))* - & WIDS(24,(5-KCHW)/2) -C***Protect against slightly negative cross sections. (Reason yet to be -C***sorted out. One possibility: addition of width to the W propagator.) - SIGH(NCHN)=MAX(0D0,SIGH(NCHN)) - 280 CONTINUE - 290 CONTINUE - - ELSEIF(ISUB.EQ.25) THEN -C...f + fbar -> W+ + W- -C...Propagators: Z0, W+- as simulated in PYOFSH and as desired - GMMZC=GMMZ - HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2) - HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM3,WDTP,WDTE) - GMMW3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMW4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2) -C...Kinematical functions - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - THUH34=(2D0*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4) - GS=(((SH-SQM3-SQM4)**2-4D0*SQM3*SQM4)*THUH34+12D0*THUH)/SH2 - GT=THUH34+4D0*THUH/TH2 - GST=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/TH)/SH - GU=THUH34+4D0*THUH/UH2 - GSU=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/UH)/SH -C...Common factors and couplings - FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4) - FACWW=FACWW*WIDS(24,1) - CGG=AEM**2/2D0 - CGZ=AEM**2/(4D0*XW)*HBWZC*(1D0-SQMZ/SH) - CZZ=AEM**2/(32D0*XW**2)*HBWZC - CNG=AEM**2/(4D0*XW) - CNZ=AEM**2/(16D0*XW**2)*HBWZC*(1D0-SQMZ/SH) - CNN=AEM**2/(16D0*XW**2) -C...Coulomb factor for W+W- pair - IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN - COULE=(SH-4D0*SQMW)/(4D0*PMAS(24,1)) - COULP=MAX(1D-10,0.5D0*BE34*SQRT(SH)) - IF(COULE.LT.100D0*PMAS(24,2)) THEN - COULP1=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ - & PMAS(24,2)**2)-COULE)) - ELSE - COULP1=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/COULE)) - ENDIF - IF(COULE.GT.-100D0*PMAS(24,2)) THEN - COULP2=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ - & PMAS(24,2)**2)+COULE)) - ELSE - COULP2=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/ - & ABS(COULE))) - ENDIF - IF(MSTP(40).EQ.1) THEN - COULDC=PARU(1)-2D0*ATAN((COULP1**2+COULP2**2-COULP**2)/ - & MAX(1D-10,2D0*COULP*COULP1)) - FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) - ELSEIF(MSTP(40).EQ.2) THEN - COULCK=DCMPLX(DBLE(COULP1),DBLE(COULP2)) - COULCP=DCMPLX(0D0,DBLE(COULP)) - COULCD=(COULCK+COULCP)/(COULCK-COULCP) - COULCR=1D0+DBLE(PARU(101)*SQRT(SH))/ - & (4D0*COULCP)*LOG(COULCD) - COULCS=DCMPLX(0D0,0D0) - NSTP=100 - DO 300 ISTP=1,NSTP - COULXX=(ISTP-0.5)/NSTP - COULCS=COULCS+(1D0/COULXX)*LOG((1D0+COULXX*COULCD)/ - & (1D0+COULXX/COULCD)) - 300 CONTINUE - COULCR=COULCR+DBLE(PARU(101)**2*SH)/(16D0*COULCP*COULCK)* - & (COULCS/NSTP) - FACCOU=ABS(COULCR)**2 - ELSEIF(MSTP(40).EQ.3) THEN - COULDC=PARU(1)-2D0*(1D0-BE34)**2*ATAN((COULP1**2+ - & COULP2**2-COULP**2)/MAX(1D-10,2D0*COULP*COULP1)) - FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) - ENDIF - ELSEIF(MSTP(40).EQ.4) THEN - FACCOU=1D0+0.5D0*PARU(101)*PARU(1)/MAX(1D-5,BE34) - ELSE - FACCOU=1D0 - ENDIF - VINT(95)=FACCOU - FACWW=FACWW*FACCOU -C...Loop over allowed flavours - DO 310 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF(MSTP(50).LE.0.OR.IABS(I).LE.10) THEN - IF(AI.LT.0D0) THEN - DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+ - & (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT - ELSE - DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS- - & (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU - ENDIF - ELSE - XMW02=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - BET=SQRT(1D0-4D0*XMW02/SH) - GAT=1D0/SQRT(1D0-BET**2) - STHE2=1D0-CTH**2 - AMPZG=BET**3*(16D0+(4D0*BET**2*GAT**2+3D0/GAT**2)*STHE2) - AMPNU=BET*(2D0+BET**2*GAT**2*STHE2/2D0+ - & 2D0*BET**2*(1D0-BET**2)*STHE2/(1D0-2D0*BET*CTH+BET**2)**2) - AMPNG=BET*((1D0+BET**2)*(4D0+BET**2*GAT**2*STHE2)+ - & 2D0*(1D0-BET**2)*(BET**2*STHE2-2D0*(1D0-BET**2))/ - & (1D0-2D0*BET*CTH+BET**2)) - PROPI1=(0.25D0*SQMZ/XMW02)*HBWZC*(1D0-SQMZ/SH) - PROPI2=(0.25D0*SQMZ/XMW02)**2*HBWZC - A0=(2D0*(XMW02/SQMZ)-(1D0-BET**2)*XW)*POLL - A1=(2D0*(XMW02/SQMZ)**2-2*XMW02/SQMZ*(1D0-BET**2)*XW)*POLL - A2=(1D0-BET**2)**2*XW**2*(POLR+POLL)/2D0 - ATOT=AMPNU*POLL+(A1+A2)*PROPI2*AMPZG-A0*PROPI1*AMPNG - ATOT=ATOT*CNN/SQMW*SH/BET*2D0 - DSIGWW=ATOT - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*FCOI*DSIGWW - 310 CONTINUE - - ELSEIF(ISUB.EQ.30) THEN -C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only) - FZQ=COMFAC*FACA*AS*AEM*(1D0/3D0)*(SH2+UH2+2D0*SQM4*TH)/ - & (-SH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 320 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 320 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 320 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 340 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - DO 330 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ - 330 CONTINUE - 340 CONTINUE - - ELSEIF(ISUB.EQ.31) THEN -C...f + g -> f' + W+/- (q + g -> q' + W+/- only) - FACWQ=COMFAC*FACA*AS*AEM/XW*1D0/12D0* - & (SH2+UH2+2D0*SQM4*TH)/(-SH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACWQ=FACWQ*HBW4C/HBW4 - DO 360 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 - IA=IABS(I) - KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - DO 350 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC - 350 CONTINUE - 360 CONTINUE - - ELSEIF(ISUB.EQ.35) THEN -C...f + gamma -> f + (gamma*/Z0) - IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) THEN - FZQN=SH2+UH2+2D0*(SQM4-VINT(3)**2)*TH - FZQDTM=VINT(3)**2*SQM4-SH*(UH-VINT(4)**2) - ELSEIF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) THEN - FZQN=SH2+UH2+2D0*(SQM4-VINT(4)**2)*TH - FZQDTM=VINT(4)**2*SQM4-SH*(UH-VINT(3)**2) - ELSE - FZQN=SH2+UH2+2D0*SQM4*TH - FZQDTM=-SH*UH - ENDIF - FZQN=COMFAC*2D0*AEM**2*MAX(0D0,FZQN) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 370 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 370 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 370 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 390 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 390 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - FZQD=MAX(PMAS(IABS(I),1)**2*SQM4,FZQDTM) - DO 380 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 380 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 380 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*FZQN/FZQD - 380 CONTINUE - 390 CONTINUE - - ELSEIF(ISUB.EQ.36) THEN -C...f + gamma -> f' + W+/- - FWQ=COMFAC*AEM**2/(2D0*XW)* - & (SH2+UH2+2D0*SQM4*TH)/(SQPTH*SQM4-SH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FWQ=FWQ*HBW4C/HBW4 - DO 410 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 410 - IA=IABS(I) - EIA=ABS(KCHG(IABS(I),1)/3D0) - FACWQ=FWQ*(EIA-SH/(SH+UH))**2 - KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - DO 400 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 400 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC - 400 CONTINUE - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.69) THEN -C...gamma + gamma -> W+ + W- - SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) - FPROP=SH2/((SQMWE-TH)*(SQMWE-UH)) - FACWW=COMFAC*6D0*AEM**2*(1D0-FPROP*(4D0/3D0+2D0*SQMWE/SH)+ - & FPROP**2*(2D0/3D0+2D0*(SQMWE/SH)**2))*WIDS(24,1) - IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW - 420 CONTINUE - - ELSEIF(ISUB.EQ.70) THEN -C...gamma + W+/- -> Z0 + W+/- - SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) - FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH)) - FACZW=COMFAC*6D0*AEM**2*(XW1/XW)* - & (1D0-FPROP*(4D0/3D0+2D0*SQMWE/(TH-SQMWE))+ - & FPROP**2*(2D0/3D0+2D0*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2) - DO 440 KCHW=1,-1,-2 - DO 430 ISDE=1,2 - IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 430 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=22 - ISIG(NCHN,3-ISDE)=24*KCHW - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2) - 430 CONTINUE - 440 CONTINUE - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSHOW -C...Generates timelike parton showers from given partons. - - SUBROUTINE PYSHOW(IP1,IP2,QMAX) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION PMTH(5,140),PS(5),PMA(100),PMSD(100),IEP(100),IPA(100), - &KFLA(100),KFLD(100),KFL(100),ITRY(100),ISI(100),ISL(100),DP(100), - &DPT(5,4),KSH(0:140),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2), - &PHIIIS(2,2),ISII(2),ISSET(2),ISCOL(0:140),ISCHG(0:140), - &IREF(1000) - -C...Check that QMAX not too low. - IF(MSTJ(41).LE.0) THEN - RETURN - ELSEIF(MSTJ(41).EQ.1) THEN - IF(QMAX.LE.PARJ(82).AND.IP2.GT.-8) RETURN - ELSE - IF(QMAX.LE.MIN(PARJ(82),PARJ(83),PARJ(90)).AND.IP2.GT.-8) - & RETURN - ENDIF - -C...Initialization of cutoff masses etc. - DO 100 IFL=0,40 - ISCOL(IFL)=0 - ISCHG(IFL)=0 - KSH(IFL)=0 - 100 CONTINUE - ISCOL(21)=1 - KSH(21)=1 - PMTH(1,21)=PYMASS(21) - PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25D0*PARJ(82)**2) - PMTH(3,21)=2D0*PMTH(2,21) - PMTH(4,21)=PMTH(3,21) - PMTH(5,21)=PMTH(3,21) - PMTH(1,22)=PYMASS(22) - PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25D0*PARJ(83)**2) - PMTH(3,22)=2D0*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)) - PMQT1E=MIN(PMQTH1,PARJ(90)) - PMQTH2=PMTH(2,21) - IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) - PMQT2E=MIN(PMQTH2,0.5D0*PARJ(90)) - DO 110 IFL=1,5 - ISCOL(IFL)=1 - IF(MSTJ(41).GE.2) ISCHG(IFL)=1 - KSH(IFL)=1 - PMTH(1,IFL)=PYMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PMQTH1**2) - PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 - PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) - 110 CONTINUE - DO 120 IFL=11,15,2 - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IFL)=1 - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) KSH(IFL)=1 - PMTH(1,IFL)=PYMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(90)**2) - PMTH(3,IFL)=PMTH(2,IFL)+0.5D0*PARJ(90) - PMTH(4,IFL)=PMTH(3,IFL) - PMTH(5,IFL)=PMTH(3,IFL) - 120 CONTINUE - PT2MIN=MAX(0.5D0*PARJ(82),1.1D0*PARJ(81))**2 - ALAMS=PARJ(81)**2 - ALFM=LOG(PT2MIN/ALAMS) - -C...Store positions of shower initiating partons. - MPSPD=0 - IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN - NPA=1 - IPA(1)=IP1 - ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- - & MSTU(32))) THEN - NPA=2 - IPA(1)=IP1 - IPA(2)=IP2 - ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0 - & .AND.IP2.GE.-80) THEN - NPA=IABS(IP2) - DO 130 I=1,NPA - IPA(I)=IP1+I-1 - 130 CONTINUE - ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND. - &IP2.EQ.-100) THEN - MPSPD=1 - NPA=2 - IPA(1)=IP1+6 - IPA(2)=IP1+7 - ELSE - CALL PYERRM(12, - & '(PYSHOW:) 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)=0D0 - 140 CONTINUE - PM=0D0 - KFLA(2)=0 - DO 160 I=1,NPA - KFLA(I)=IABS(K(IPA(I),2)) - PMA(I)=P(IPA(I),5) -C...Special cutoff masses for initial partons (may be a heavy quark, -C...squark, ..., and need not be on the mass shell). - IR=30+I - IF(NPA.LE.1) IREF(I)=IR - IF(NPA.GE.2) IREF(I+1)=IR - ISCOL(IR)=0 - ISCHG(IR)=0 - KSH(IR)=0 - IF(KFLA(I).LE.8) THEN - ISCOL(IR)=1 - IF(MSTJ(41).GE.2) ISCHG(IR)=1 - ELSEIF(KFLA(I).EQ.11.OR.KFLA(I).EQ.13.OR.KFLA(I).EQ.15.OR. - & KFLA(I).EQ.17) THEN - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IR)=1 - ELSEIF(KFLA(I).EQ.21) THEN - ISCOL(IR)=1 - ELSEIF((KFLA(I).GE.KSUSY1+1.AND.KFLA(I).LE.KSUSY1+8).OR. - & (KFLA(I).GE.KSUSY2+1.AND.KFLA(I).LE.KSUSY2+8)) THEN - ISCOL(IR)=1 - ELSEIF(KFLA(I).EQ.KSUSY1+21) THEN - ISCOL(IR)=1 - ENDIF - IF(ISCOL(IR).EQ.1.OR.ISCHG(IR).EQ.1) KSH(IR)=1 - PMTH(1,IR)=PMA(I) - IF(ISCOL(IR).EQ.1.AND.ISCHG(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PMQTH1**2) - PMTH(3,IR)=PMTH(2,IR)+PMQTH2 - PMTH(4,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) - ELSEIF(ISCOL(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2) - PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(82) - PMTH(4,IR)=PMTH(3,IR) - PMTH(5,IR)=PMTH(3,IR) - ELSEIF(ISCHG(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(90)**2) - PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(90) - PMTH(4,IR)=PMTH(3,IR) - PMTH(5,IR)=PMTH(3,IR) - ENDIF - IF(KSH(IR).EQ.1) PMA(I)=PMTH(3,IR) - PM=PM+PMA(I) - IF(KSH(IR).EQ.0.OR.PMA(I).GT.10D0*QMAX) IREJ=IREJ+1 - DO 150 J=1,4 - PS(J)=PS(J)+P(IPA(I),J) - 150 CONTINUE - 160 CONTINUE - IF(IREJ.EQ.NPA.AND.IP2.GE.-7) RETURN - PS(5)=SQRT(MAX(0D0,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+PMQT1E) RETURN - -C...Identify source: q(1), ~q(2), V(3), S(4), chi(5), ~g(6), unknown(0). - KFSRCE=0 - IF(IP2.LE.0) THEN - ELSEIF(K(IP1,3).EQ.K(IP2,3).AND.K(IP1,3).GT.0) THEN - KFSRCE=IABS(K(K(IP1,3),2)) - ELSE - IPAR1=MAX(1,K(IP1,3)) - IPAR2=MAX(1,K(IP2,3)) - IF(K(IPAR1,3).EQ.K(IPAR2,3).AND.K(IPAR1,3).GT.0) - & KFSRCE=IABS(K(K(IPAR1,3),2)) - ENDIF - ITYPES=0 - IF(KFSRCE.GE.1.AND.KFSRCE.LE.8) ITYPES=1 - IF(KFSRCE.GE.KSUSY1+1.AND.KFSRCE.LE.KSUSY1+8) ITYPES=2 - IF(KFSRCE.GE.KSUSY2+1.AND.KFSRCE.LE.KSUSY2+8) ITYPES=2 - IF(KFSRCE.GE.21.AND.KFSRCE.LE.24) ITYPES=3 - IF(KFSRCE.GE.32.AND.KFSRCE.LE.34) ITYPES=3 - IF(KFSRCE.EQ.25.OR.(KFSRCE.GE.35.AND.KFSRCE.LE.37)) ITYPES=4 - IF(KFSRCE.GE.KSUSY1+22.AND.KFSRCE.LE.KSUSY1+37) ITYPES=5 - IF(KFSRCE.EQ.KSUSY1+21) ITYPES=6 - -C...Identify two primary showerers. - ITYPE1=0 - IF(KFLA(1).GE.1.AND.KFLA(1).LE.8) ITYPE1=1 - IF(KFLA(1).GE.KSUSY1+1.AND.KFLA(1).LE.KSUSY1+8) ITYPE1=2 - IF(KFLA(1).GE.KSUSY2+1.AND.KFLA(1).LE.KSUSY2+8) ITYPE1=2 - IF(KFLA(1).GE.21.AND.KFLA(1).LE.24) ITYPE1=3 - IF(KFLA(1).GE.32.AND.KFLA(1).LE.34) ITYPE1=3 - IF(KFLA(1).EQ.25.OR.(KFLA(1).GE.35.AND.KFLA(1).LE.37)) ITYPE1=4 - IF(KFLA(1).GE.KSUSY1+22.AND.KFLA(1).LE.KSUSY1+37) ITYPE1=5 - IF(KFLA(1).EQ.KSUSY1+21) ITYPE1=6 - ITYPE2=0 - IF(KFLA(2).GE.1.AND.KFLA(2).LE.8) ITYPE2=1 - IF(KFLA(2).GE.KSUSY1+1.AND.KFLA(2).LE.KSUSY1+8) ITYPE2=2 - IF(KFLA(2).GE.KSUSY2+1.AND.KFLA(2).LE.KSUSY2+8) ITYPE2=2 - IF(KFLA(2).GE.21.AND.KFLA(2).LE.24) ITYPE2=3 - IF(KFLA(2).GE.32.AND.KFLA(2).LE.34) ITYPE2=3 - IF(KFLA(2).EQ.25.OR.(KFLA(2).GE.35.AND.KFLA(2).LE.37)) ITYPE2=4 - IF(KFLA(2).GE.KSUSY1+22.AND.KFLA(2).LE.KSUSY1+37) ITYPE2=5 - IF(KFLA(2).EQ.KSUSY1+21) ITYPE2=6 - -C...Order of showerers. Presence of gluino. - ITYPMN=MIN(ITYPE1,ITYPE2) - ITYPMX=MAX(ITYPE1,ITYPE2) - IORD=1 - IF(ITYPE1.GT.ITYPE2) IORD=2 - IGLUI=0 - IF(ITYPE1.EQ.6.OR.ITYPE2.EQ.6) IGLUI=1 - -C...Check if 3-jet matrix elements to be used. - M3JC=0 - ALPHA=0.5D0 - IF(NPA.EQ.2.AND.MSTJ(47).GE.1.AND.MPSPD.EQ.0) THEN - IF(MSTJ(38).NE.0) THEN - M3JC=MSTJ(38) - ALPHA=PARJ(80) - MSTJ(38)=0 - ELSEIF(MSTJ(47).GE.6) THEN - M3JC=MSTJ(47) - ELSE - ICLASS=1 - ICOMBI=4 - -C...Vector/axial vector -> q + qbar; q -> q + V. - IF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.3)) THEN - ICLASS=2 - IF(KFSRCE.EQ.21.OR.KFSRCE.EQ.22) THEN - ICOMBI=1 - ELSEIF(KFSRCE.EQ.23.OR.(KFSRCE.EQ.0.AND. - & K(IP1,2)+K(IP2,2).EQ.0)) THEN -C...gamma*/Z0: assume e+e- initial state if unknown. - EI=-1D0 - IF(KFSRCE.EQ.23) THEN - IANNFL=K(K(IP1,3),3) - IF(IANNFL.NE.0) THEN - KANNFL=IABS(K(IANNFL,2)) - IF(KANNFL.GE.1.AND.KANNFL.LE.18) EI=KCHG(KANNFL,1)/3D0 - ENDIF - ENDIF - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*PARU(102) - EF=KCHG(KFLA(1),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*PARU(102) - XWC=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SH=PS(5)**2 - SQMZ=PMAS(23,1)**2 - SQWZ=PS(5)*PMAS(23,2) - SBWZ=1D0/((SH-SQMZ)**2+SQWZ**2) - VECT=EI**2*EF**2+2D0*EI*VI*EF*VF*XWC*SH*(SH-SQMZ)*SBWZ+ - & (VI**2+AI**2)*VF**2*XWC**2*SH**2*SBWZ - AXIV=(VI**2+AI**2)*AF**2*XWC**2*SH**2*SBWZ - ICOMBI=3 - ALPHA=VECT/(VECT+AXIV) - ELSEIF(KFSRCE.EQ.24.OR.KFSRCE.EQ.0) THEN - ICOMBI=4 - ENDIF -C...For chi -> chi q qbar, use V/A -> q qbar as first approximation. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.5) THEN - ICLASS=2 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=3 - -C...Scalar/pseudoscalar -> q + qbar; q -> q + S. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.4) THEN - ICLASS=4 - IF(KFSRCE.EQ.25.OR.KFSRCE.EQ.35.OR.KFSRCE.EQ.37) THEN - ICOMBI=1 - ELSEIF(KFSRCE.EQ.36) THEN - ICOMBI=2 - ENDIF - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=5 - -C...V -> ~q + ~qbar; ~q -> ~q + V; S -> ~q + ~qbar; ~q -> ~q + S. - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.3)) THEN - ICLASS=6 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=7 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.4) THEN - ICLASS=8 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=9 - -C...chi -> q + ~qbar; ~q -> q + chi; q -> ~q + chi. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.5)) THEN - ICLASS=10 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=11 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=12 - -C...~g -> q + ~qbar; ~q -> q + ~g; q -> ~q + ~g. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.6) THEN - ICLASS=13 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=14 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=15 - -C...g -> ~g + ~g (eikonal approximation). - ELSEIF(ITYPMN.EQ.6.AND.ITYPMX.EQ.6.AND.ITYPES.EQ.0) THEN - ICLASS=16 - ENDIF - M3JC=5*ICLASS+ICOMBI - 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.AND.KFSRCE.EQ.0 - &.AND.MPSPD.EQ.0) MIIS=MSTJ(50) - IF(MSTJ(50).GE.4.AND.MSTJ(50).LE.6.AND.NPA.EQ.2.AND.MPSPD.EQ.0) - &MIIS=MSTJ(50)-3 - IF(MIIS.NE.0) THEN - DO 180 I=1,2 - KCII(I)=0 - KCA=PYCOMP(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)=0D0 - 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)=0D0 - 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)=0D0 - 230 CONTINUE - 240 CONTINUE - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,0D0,-PS(1)/PS(4), - & -PS(2)/PS(4),-PS(3)/PS(4)) - PHI=PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(N+1,3),P(N+1,1)) - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),-THE,0D0,0D0,0D0,0D0) - DO 250 I=3,2+NIIS(1) - THEIIS(1,I-2)=PYANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(1,I-2)=PYANGL(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)-PYANGL(P(N+I,3), - & SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(2,I-2-NIIS(1))=PYANGL(P(N+I,1),P(N+I,2)) - 260 CONTINUE - ENDIF - -C...Boost 3 or more partons to their rest frame. - IF(NPA.GE.3) CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,-PS(1)/PS(4), - &-PS(2)/PS(4),-PS(3)/PS(4)) - -C...Define imagined single initiator of shower for parton system. - NS=N - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - 270 N=NS - 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)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=0D0 - P(N+1,4)=PS(5) - P(N+1,5)=PS(5) - V(N+1,5)=PS(5)**2 - N=N+1 - IREF(1)=21 - ENDIF - -C...Loop over partons that may branch. - NEP=NPA - IM=NS - IF(NPA.EQ.1) IM=NS-1 - 280 IM=IM+1 - IF(N.GT.NS) THEN - IF(IM.GT.N) GOTO 590 - KFLM=IABS(K(IM,2)) - IR=IREF(IM-NS) - IF(KSH(IR).EQ.0) GOTO 280 - IF(P(IM,5).LT.PMTH(2,IR)) GOTO 280 - IGM=K(IM,3) - ELSE - IGM=-1 - ENDIF - IF(N+NEP.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - 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 290 I=1,NEP - K(N+I,3)=IM - 290 CONTINUE - ELSE - K(N+1,3)=IPA(1) - ENDIF - IF(IGM.LE.0) THEN - DO 300 I=1,NEP - K(N+I,2)=K(IPA(I),2) - 300 CONTINUE - ELSEIF(KFLM.NE.21) THEN - K(N+1,2)=K(IM,2) - K(N+2,2)=K(IM,5) - IREF(N+1-NS)=IREF(IM-NS) - IREF(N+2-NS)=IABS(K(N+2,2)) - ELSEIF(K(IM,5).EQ.21) THEN - K(N+1,2)=21 - K(N+2,2)=21 - IREF(N+1-NS)=21 - IREF(N+2-NS)=21 - ELSE - K(N+1,2)=K(IM,5) - K(N+2,2)=-K(IM,5) - IREF(N+1-NS)=IABS(K(N+1,2)) - IREF(N+2-NS)=IABS(K(N+2,2)) - ENDIF - -C...Reset flags on daughters and tries made. - DO 310 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(PYCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 - ITRY(IP)=0 - ISL(IP)=0 - ISI(IP)=0 - IF(KSH(IREF(N+IP-NS)).EQ.1) ISI(IP)=1 - 310 CONTINUE - ISLM=0 - -C...Maximum virtuality of daughters. - IF(IGM.LE.0) THEN - DO 320 I=1,NPA - IF(NPA.GE.3) P(N+I,4)=P(IPA(I),4) - P(N+I,5)=MIN(QMAX,PS(5)) - IR=IREF(N+I-NS) - IF(IP2.LE.-8) P(N+I,5)=MAX(P(N+I,5),2D0*PMTH(3,IR)) - IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) - 320 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),(1D0-V(IM,1))*PEM) - IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) - ENDIF - DO 330 I=1,NEP - PMSD(I)=P(N+I,5) - IF(ISI(I).EQ.1) THEN - IR=IREF(N+I-NS) - IF(P(N+I,5).LE.PMTH(3,IR)) P(N+I,5)=PMTH(1,IR) - ENDIF - V(N+I,5)=P(N+I,5)**2 - 330 CONTINUE - -C...Choose one of the daughters for evolution. - 340 INUM=0 - IF(NEP.EQ.1) INUM=1 - DO 350 I=1,NEP - IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I - 350 CONTINUE - DO 360 I=1,NEP - IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN - IR=IREF(N+I-NS) - IF(P(N+I,5).GE.PMTH(2,IR)) INUM=I - ENDIF - 360 CONTINUE - IF(INUM.EQ.0) THEN - RMAX=0D0 - DO 370 I=1,NEP - IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQT2E) THEN - RPM=P(N+I,5)/PMSD(I) - IR=IREF(N+I-NS) - IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IR)) THEN - RMAX=RPM - INUM=I - ENDIF - ENDIF - 370 CONTINUE - ENDIF - -C...Cancel choice of predetermined daughter already treated. - INUM=MAX(1,INUM) - INUMT=INUM - IF(MPSPD.EQ.1.AND.IGM.EQ.0.AND.ITRY(INUMT).GE.1) THEN - IF(K(IP1-1+INUM,4).GT.0) INUM=3-INUM - ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2.AND.ITRY(INUMT).GE.1) THEN - IF(KFLD(INUMT).NE.21.AND.K(IP1+2,4).GT.0) INUM=3-INUM - IF(KFLD(INUMT).EQ.21.AND.K(IP1+3,4).GT.0) INUM=3-INUM - ENDIF - -C...Store information on choice of evolving daughter. - IEP(1)=N+INUM - DO 380 I=2,NEP - IEP(I)=IEP(I-1)+1 - IF(IEP(I).GT.N+NEP) IEP(I)=N+1 - 380 CONTINUE - DO 390 I=1,NEP - KFL(I)=IABS(K(IEP(I),2)) - 390 CONTINUE - ITRY(INUM)=ITRY(INUM)+1 - IF(ITRY(INUM).GT.200) THEN - CALL PYERRM(14,'(PYSHOW:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - Z=0.5D0 - IR=IREF(IEP(1)-NS) - IF(KSH(IR).EQ.0) GOTO 440 - IF(P(IEP(1),5).LT.PMTH(2,IR)) GOTO 440 - -C...Check if evolution already predetermined for daughter. - IPSPD=0 - IF(MPSPD.EQ.1.AND.IGM.EQ.0) THEN - IF(K(IP1-1+INUM,4).GT.0) IPSPD=IP1-1+INUM - ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2) THEN - IF(KFL(1).NE.21.AND.K(IP1+2,4).GT.0) IPSPD=IP1+2 - IF(KFL(1).EQ.21.AND.K(IP1+3,4).GT.0) IPSPD=IP1+3 - ENDIF - IF(INUM.EQ.1.OR.INUM.EQ.2) THEN - ISSET(INUM)=0 - IF(IPSPD.NE.0) ISSET(INUM)=1 - ENDIF - -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(PYR(0).GT.0.5D0) ISII(III)=1 - ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN - ISII(III)=1 - IF(PYR(0).GT.0.5D0) 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=(1D0-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - ZC=PMTH(2,21)/PMED - ZCE=PMTH(2,22)/PMED - IF(ISCOL(IR).EQ.0) ZCE=0.5D0*PARJ(90)/PMED - ELSE - ZC=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTH(2,21)/PMED)**2))) - IF(ZC.LT.1D-6) ZC=(PMTH(2,21)/PMED)**2 - PMTMPE=PMTH(2,22) - IF(ISCOL(IR).EQ.0) PMTMPE=0.5D0*PARJ(90) - ZCE=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTMPE/PMED)**2))) - IF(ZCE.LT.1D-6) ZCE=(PMTMPE/PMED)**2 - ENDIF - ZC=MIN(ZC,0.491D0) - ZCE=MIN(ZCE,0.49991D0) - IF(((MSTJ(41).EQ.1.AND.ZC.GT.0.49D0).OR.(MSTJ(41).GE.2.AND. - &MIN(ZC,ZCE).GT.0.4999D0)).AND.IPSPD.EQ.0) THEN - P(IEP(1),5)=PMTH(1,IR) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 440 - ENDIF - -C...Integral of Altarelli-Parisi z kernel for QCD. -C...(Includes squark and gluino; with factor N_C/C_F extra for latter). - IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN - FBR=6D0*LOG((1D0-ZC)/ZC)+MSTJ(45)*0.5D0 - ELSEIF(MSTJ(49).EQ.0) THEN - FBR=(8D0/3D0)*LOG((1D0-ZC)/ZC) - IF(IGLUI.EQ.1.AND.IR.GE.31) FBR=FBR*(9D0/4D0) - -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))*(1D0-2D0*ZC) - ELSEIF(MSTJ(49).EQ.1) THEN - FBR=(1D0-2D0*ZC)/3D0 - IF(IGM.EQ.0.AND.M3JC.GE.1) FBR=4D0*FBR - -C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. - ELSEIF(KFL(1).EQ.21) THEN - FBR=6D0*MSTJ(45)*(0.5D0-ZC) - ELSE - FBR=2D0*LOG((1D0-ZC)/ZC) - ENDIF - -C...Reset QCD probability for colourless. - IF(ISCOL(IR).EQ.0) FBR=0D0 - -C...Integral of Altarelli-Parisi kernel for photon emission. - FBRE=0D0 - IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1) THEN - IF(KFL(1).LE.18) THEN - FBRE=(KCHG(KFL(1),1)/3D0)**2*2D0*LOG((1D0-ZCE)/ZCE) - ENDIF - IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE - ENDIF - -C...Inner veto algorithm starts. Find maximum mass for evolution. - 400 PMS=V(IEP(1),5) - IF(IGM.GE.0) THEN - PM2=0D0 - DO 410 I=2,NEP - PM=P(IEP(I),5) - IRI=IREF(IEP(I)-NS) - IF(KSH(IRI).EQ.1) PM=PMTH(2,IRI) - PM2=PM2+PM - 410 CONTINUE - PMS=MIN(PMS,(P(IM,5)-PM2)**2) - ENDIF - -C...Select mass for daughter in QCD evolution. - B0=27D0/6D0 - DO 420 IFF=4,MSTJ(45) - IF(PMS.GT.4D0*PMTH(2,IFF)**2) B0=(33D0-2D0*IFF)/6D0 - 420 CONTINUE -C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. - PMSC=MAX(0.5D0*PARJ(82),PMS-PMTH(1,IR)**2) -C...Already predetermined choice. - IF(IPSPD.NE.0) THEN - PMSQCD=P(IPSPD,5)**2 - ELSEIF(FBR.LT.1D-3) THEN - PMSQCD=0D0 - ELSEIF(MSTJ(44).LE.0) THEN - PMSQCD=PMSC*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/(PARU(111)*FBR))) - ELSEIF(MSTJ(44).EQ.1) THEN - PMSQCD=4D0*ALAMS*(0.25D0*PMSC/ALAMS)**(PYR(0)**(B0/FBR)) - ELSE - PMSQCD=PMSC*EXP(MAX(-50D0,ALFM*B0*LOG(PYR(0))/FBR)) - ENDIF -C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. - IF(IPSPD.EQ.0) PMSQCD=PMSQCD+PMTH(1,IR)**2 - IF(ZC.GT.0.49D0.OR.PMSQCD.LE.PMTH(4,IR)**2) PMSQCD=PMTH(2,IR)**2 - V(IEP(1),5)=PMSQCD - MCE=1 - -C...Select mass for daughter in QED evolution. - IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1.AND.IPSPD.EQ.0) THEN -C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. - PMSE=MAX(0.5D0*PARJ(83),PMS-PMTH(1,IR)**2) - IF(FBRE.LT.1D-3) THEN - PMSQED=0D0 - ELSE - PMSQED=PMSE*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ - & (PARU(101)*FBRE))) - ENDIF -C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. - PMSQED=PMSQED+PMTH(1,IR)**2 - IF(ZCE.GT.0.4999D0.OR.PMSQED.LE.PMTH(5,IR)**2) PMSQED= - & PMTH(2,IR)**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,IR)) THEN - P(IEP(1),5)=PMTH(1,IR) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 440 - ENDIF - -C...Already predetermined choice of z, and flavour in g -> qqbar. - IF(IPSPD.NE.0) THEN - IPSGD1=K(IPSPD,4) - IPSGD2=K(IPSPD,5) - PMSGD1=P(IPSGD1,5)**2 - PMSGD2=P(IPSGD2,5)**2 - ALAMPS=SQRT(MAX(1D-10,(PMSQCD-PMSGD1-PMSGD2)**2- - & 4D0*PMSGD1*PMSGD2)) - Z=0.5D0*(PMSQCD*(2D0*P(IPSGD1,4)/P(IPSPD,4)-1D0)+ALAMPS- - & PMSGD1+PMSGD2)/ALAMPS - Z=MAX(0.00001D0,MIN(0.99999D0,Z)) - IF(KFL(1).NE.21) THEN - K(IEP(1),5)=21 - ELSE - K(IEP(1),5)=IABS(K(IPSGD1,2)) - ENDIF - -C...Select z value of branching: q -> qgamma. - ELSEIF(MCE.EQ.2) THEN - Z=1D0-(1D0-ZCE)*(ZCE/(1D0-ZCE))**PYR(0) - IF(1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 - 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=1D0-(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) -C...Only do z weighting when no ME correction afterwards. - IF(M3JC.EQ.0.AND.1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*0.5D0.LT.PYR(0)*FBR) THEN - Z=(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) - IF(PYR(0).GT.0.5D0) Z=1D0-Z - IF((1D0-Z*(1D0-Z))**2.LT.PYR(0)) GOTO 400 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).NE.1) THEN - Z=PYR(0) - IF(Z**2+(1D0-Z)**2.LT.PYR(0)) GOTO 400 - KFLB=1+INT(MSTJ(45)*PYR(0)) - PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1D0) GOTO 400 - IF(MSTJ(44).LE.2.OR.MSTJ(44).EQ.4) THEN - IF(Z.LT.ZC.OR.Z.GT.1D0-ZC) GOTO 400 - PMQ0=4D0*PMTH(2,21)**2/V(IEP(1),5) - IF(MOD(MSTJ(43),2).EQ.0.AND.(1D0+0.5D0*PMQ)*SQRT(1D0-PMQ) - & .LT.PYR(0)*(1D0+0.5D0*PMQ0)*SQRT(1D0-PMQ0)) GOTO 400 - ELSE - IF((1D0+0.5D0*PMQ)*SQRT(1D0-PMQ).LT.PYR(0)) GOTO 400 - ENDIF - K(IEP(1),5)=KFLB - -C...Ditto for scalar gluon model. - ELSEIF(KFL(1).NE.21) THEN - Z=1D0-SQRT(ZC**2+PYR(0)*(1D0-2D0*ZC)) - K(IEP(1),5)=21 - ELSEIF(PYR(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN - Z=ZC+(1D0-2D0*ZC)*PYR(0) - K(IEP(1),5)=21 - ELSE - Z=ZC+(1D0-2D0*ZC)*PYR(0) - KFLB=1+INT(MSTJ(45)*PYR(0)) - PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1D0) GOTO 400 - K(IEP(1),5)=KFLB - ENDIF - -C...Correct to alpha_s(pT^2) (optionally m^2/4 for g -> q qbar). - IF(MCE.EQ.1.AND.MSTJ(44).GE.2.AND.IPSPD.EQ.0) THEN - IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - IF(ALFM/LOG(V(IEP(1),5)*0.25D0/ALAMS).LT.PYR(0)) GOTO 400 - ELSE - PT2APP=Z*(1D0-Z)*V(IEP(1),5) - IF(MSTJ(44).GE.4) PT2APP=PT2APP* - & (1D0-PMTH(1,IR)**2/V(IEP(1),5))**2 - IF(PT2APP.LT.PT2MIN) GOTO 400 - IF(ALFM/LOG(PT2APP/ALAMS).LT.PYR(0)) GOTO 400 - ENDIF - ENDIF - -C...Check if z consistent with chosen m. - IF(KFL(1).EQ.21) THEN - IRGD1=IABS(K(IEP(1),5)) - IRGD2=IRGD1 - ELSE - IRGD1=IR - IRGD2=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.5D0*(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=(1D0-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - PMQTH3=0.5D0*PARJ(82) - IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) - IF(IRGD2.EQ.22.AND.ISCOL(IR).EQ.0) PMQTH3=0.5D0*PARJ(90) - PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(IEP(1),5) - PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(IEP(1),5) - ZD=SQRT(MAX(0D0,(1D0-V(IEP(1),5)/PED**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0D0,1D0-V(IEP(1),5)/PED**2)) - ZH=1D0 - ENDIF - IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. - &(MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - ELSEIF(IPSPD.NE.0) THEN - ELSE - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 400 - ENDIF - IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1D0-ZL)/MAX(1D-20,ZL* - &(1D0-ZU))) - IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) - -C...Width suppression for q -> q + g. - IF(MSTJ(40).NE.0.AND.KFL(1).NE.21.AND.IPSPD.EQ.0) THEN - IF(IGM.EQ.0) THEN - EGLU=0.5D0*PS(5)*(1D0-Z)*(1D0+V(IEP(1),5)/V(NS+1,5)) - ELSE - EGLU=PMED*(1D0-Z) - ENDIF - CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2) - IF(MSTJ(40).EQ.1) THEN - IF(CHI.LT.PYR(0)) GOTO 400 - ELSEIF(MSTJ(40).EQ.2) THEN - IF(1D0-CHI.LT.PYR(0)) GOTO 400 - ENDIF - ENDIF - -C...Three-jet matrix element correction. - IF(M3JC.GE.1) THEN - WME=1D0 - WSHOW=1D0 - -C...QED matrix elements: only for massless case so far. - IF(MCE.EQ.2.AND.IGM.EQ.0) THEN - X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) - X2=1D0-V(IEP(1),5)/V(NS+1,5) - X3=(1D0-X1)+(1D0-X2) - KI1=K(IPA(INUM),2) - KI2=K(IPA(3-INUM),2) - QF1=KCHG(PYCOMP(KI1),1)*ISIGN(1,KI1)/3D0 - QF2=KCHG(PYCOMP(KI2),1)*ISIGN(1,KI2)/3D0 - WSHOW=QF1**2*(1D0-X1)/X3*(1D0+(X1/(2D0-X2))**2)+ - & QF2**2*(1D0-X2)/X3*(1D0+(X2/(2D0-X1))**2) - WME=(QF1*(1D0-X1)/X3-QF2*(1D0-X2)/X3)**2*(X1**2+X2**2) - ELSEIF(MCE.EQ.2) THEN - -C...QCD matrix elements, including mass effects. - ELSEIF(MSTJ(49).NE.1.AND.K(IEP(1),2).NE.21) THEN - PS1ME=V(IEP(1),5) - PM1ME=PMTH(1,IR) - M3JCC=M3JC - IF(IR.GE.31.AND.IGM.EQ.0) THEN -C...QCD ME: original parton, first branching. - PM2ME=PMTH(1,63-IR) - ECMME=PS(5) - ELSEIF(IR.GE.31) THEN -C...QCD ME: original parton, subsequent branchings. - PM2ME=PMTH(1,63-IR) - PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - ELSEIF(K(IM,2).EQ.21) THEN -C...QCD ME: secondary partons, first branching. - PM2ME=PM1ME - ZMME=V(IM,1) - IF(IEP(1).GT.IEP(2)) ZMME=1D0-ZMME - PMLME=SQRT(MAX(0D0,(V(IM,5)-PS1ME-PM2ME**2)**2- - & 4D0*PS1ME*PM2ME**2)) - PEDME=PEM*(0.5D0*(V(IM,5)-PMLME+PS1ME-PM2ME**2)+PMLME*ZMME)/ - & V(IM,5) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - M3JCC=66 - ELSE -C...QCD ME: secondary partons, subsequent branchings. - PM2ME=PM1ME - PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - M3JCC=66 - ENDIF -C...Construct ME variables. - R1ME=PM1ME/ECMME - R2ME=PM2ME/ECMME - X1=(1D0+PS1ME/ECMME**2-R2ME**2)*(Z+(1D0-Z)*PM1ME**2/PS1ME) - X2=1D0+R2ME**2-PS1ME/ECMME**2 -C...Call ME, with right order important for two inequivalent showerers. - IF(IR.EQ.IORD+30) THEN - WME=PYMAEL(M3JCC,X1,X2,R1ME,R2ME,ALPHA) - ELSE - WME=PYMAEL(M3JCC,X2,X1,R2ME,R1ME,ALPHA) - ENDIF -C...Split up total ME when two radiating partons. - ISPRAD=1 - IF((M3JCC.GE.16.AND.M3JCC.LE.19).OR. - & (M3JCC.GE.26.AND.M3JCC.LE.29).OR. - & (M3JCC.GE.36.AND.M3JCC.LE.39).OR. - & (M3JCC.GE.46.AND.M3JCC.LE.49).OR. - & (M3JCC.GE.56.AND.M3JCC.LE.64)) ISPRAD=0 - IF(ISPRAD.EQ.1) WME=WME*MAX(1D-10,1D0+R1ME**2-R2ME**2-X1)/ - & MAX(1D-10,2D0-X1-X2) -C...Evaluate shower rate to be compared with. - WSHOW=2D0/(MAX(1D-10,2D0-X1-X2)* - & MAX(1D-10,1D0+R2ME**2-R1ME**2-X2)) - IF(IGLUI.EQ.1.AND.IR.GE.31) WSHOW=(9D0/4D0)*WSHOW - ELSEIF(MSTJ(49).NE.1) THEN - -C...Toy model scalar theory matrix elements; no mass effects. - ELSE - X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) - X2=1D0-V(IEP(1),5)/V(NS+1,5) - X3=(1D0-X1)+(1D0-X2) - WSHOW=4D0*X3*((1D0-X1)/(2D0-X2)**2+(1D0-X2)/(2D0-X1)**2) - WME=X3**2 - IF(MSTJ(102).GE.2) WME=X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)* - & PARJ(171) - ENDIF - - IF(WME.LT.PYR(0)*WSHOW) GOTO 400 - ENDIF - -C...Impose angular ordering by rejection of nonordered emission. - IF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2.AND.IPSPD.EQ.0) THEN - PEMAO=V(IM,1)*P(IM,4) - IF(IEP(1).EQ.N+2) PEMAO=(1D0-V(IM,1))*P(IM,4) - IF(IR.GE.31.AND.MSTJ(42).GE.5) THEN - MAOD=0 - ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.4 - & .OR.MSTJ(42).EQ.7)) THEN - MAOD=0 - ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.3 - & .OR.MSTJ(42).EQ.6)) THEN - MAOD=1 - PMDAO=PMTH(2,K(IEP(1),5)) - THE2ID=Z*(1D0-Z)*PEMAO**2/(V(IEP(1),5)-4D0*PMDAO**2) - ELSE - MAOD=1 - THE2ID=Z*(1D0-Z)*PEMAO**2/V(IEP(1),5) - IF(MSTJ(42).GE.3.AND.MSTJ(42).NE.5) THE2ID=THE2ID* - & (1D0+PMTH(1,IR)**2*(1D0-Z)/(V(IEP(1),5)*Z))**2 - ENDIF - MAOM=1 - IAOM=IM - 430 IF(K(IAOM,5).EQ.22) THEN - IAOM=K(IAOM,3) - IF(K(IAOM,3).LE.NS) MAOM=0 - IF(MAOM.EQ.1) GOTO 430 - ENDIF - IF(MAOM.EQ.1.AND.MAOD.EQ.1) THEN - THE2IM=V(IAOM,1)*(1D0-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) - IF(THE2ID.LT.THE2IM) GOTO 400 - ENDIF - ENDIF - -C...Impose user-defined maximum angle at first branching. - IF(MSTJ(48).EQ.1.AND.IPSPD.EQ.0) THEN - IF(NEP.EQ.1.AND.IM.EQ.NS) THEN - THE2ID=Z*(1D0-Z)*PS(4)**2/V(IEP(1),5) - IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN - THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) - IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN - THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) - IF(PARJ(86)**2*THE2ID.LT.1D0) GOTO 400 - 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((1D0-Z)/Z,Z/(1D0-Z))*V(IEP(1),5)/(0.5D0*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 400 - ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN - IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 400 - ENDIF - ENDIF - -C...End of inner veto algorithm. Check if only one leg evolved so far. - 440 V(IEP(1),1)=Z - ISL(1)=0 - ISL(2)=0 - IF(NEP.EQ.1) GOTO 480 - IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 340 - DO 450 I=1,NEP - IR=IREF(N+I-NS) - IF(ITRY(I).EQ.0.AND.KSH(IR).EQ.1) THEN - IF(P(N+I,5).GE.PMTH(2,IR)) GOTO 340 - ENDIF - 450 CONTINUE - -C...Check if chosen multiplet m1,m2,z1,z2 is physical. - IF(NEP.GE.3) THEN - PMSUM=0D0 - DO 460 I=1,NEP - PMSUM=PMSUM+P(N+I,5) - 460 CONTINUE - IF(PMSUM.GE.PS(5)) GOTO 340 - ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN - DO 470 I1=N+1,N+2 - IRDA=IREF(I1-NS) - IF(KSH(IRDA).EQ.0) GOTO 470 - IF(P(I1,5).LT.PMTH(2,IRDA)) GOTO 470 - IF(IRDA.EQ.21) THEN - IRGD1=IABS(K(I1,5)) - IRGD2=IRGD1 - ELSE - IRGD1=IRDA - IRGD2=IABS(K(I1,5)) - ENDIF - I2=2*N+3-I1 - IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN - PED=0.5D0*(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=1D0-V(IM,1) - PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- - & 4D0*V(N+1,5)*V(N+2,5)) - PED=PEM*(0.5D0*(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.5D0*PARJ(82) - IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) - IF(IRGD2.EQ.22.AND.ISCOL(IRDA).EQ.0) PMQTH3=0.5D0*PARJ(90) - PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(I1,5) - PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(I1,5) - ZD=SQRT(MAX(0D0,(1D0-V(I1,5)/PED**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0D0,1D0-V(I1,5)/PED**2)) - ZH=1D0 - ENDIF - IF(IRDA.EQ.21.AND.IRGD1.LT.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - ELSE - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. - & ISSET(1).EQ.0) THEN - ISL(1)=1 - ELSEIF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. - & ISSET(2).EQ.0) THEN - ISL(2)=1 - ENDIF - ENDIF - IF(IRDA.EQ.21) V(I1,4)=LOG(ZU*(1D0-ZL)/MAX(1D-20, - & ZL*(1D0-ZU))) - IF(IRDA.NE.21) V(I1,4)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) - 470 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(0D0,V(N+1,3)/MAX(1D-6,V(N+1,4))-1D0) - ZDR2=MAX(0D0,V(N+2,3)/MAX(1D-6,V(N+2,4))-1D0) - IF(ZDR2.GT.PYR(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 340 - ENDIF - IRD1=IREF(N+1-NS) - IRD2=IREF(N+2-NS) - IF(IGM.GT.0) THEN - IF(MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. - & PMTH(2,IRD1).OR.P(N+2,5).GE.PMTH(2,IRD2))) THEN - PMQ1=V(N+1,5)/V(IM,5) - PMQ2=V(N+2,5)/V(IM,5) - ZD=SQRT(MAX(0D0,(1D0-V(IM,5)/PEM**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 340 - ENDIF - ENDIF - -C...Accepted branch. Construct four-momentum for initial partons. - 480 MAZIP=0 - MAZIC=0 - IF(NEP.EQ.1) THEN - P(N+1,1)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=SQRT(MAX(0D0,(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.5D0*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) - P(N+1,1)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=SQRT(MAX(0D0,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) - P(N+1,4)=PED1 - P(N+2,1)=0D0 - P(N+2,2)=0D0 - 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.GE.3) THEN -C...Rescale all momenta for energy conservation. - LOOP=0 - PES=0D0 - PQS=0D0 - DO 500 I=1,NEP - DO 490 J=1,4 - P(N+I,J)=P(IPA(I),J) - 490 CONTINUE - PES=PES+P(N+I,4) - PQS=PQS+P(N+I,5)**2/P(N+I,4) - 500 CONTINUE - 510 LOOP=LOOP+1 - FAC=(PS(5)-PQS)/(PES-PQS) - PES=0D0 - PQS=0D0 - DO 530 I=1,NEP - DO 520 J=1,3 - P(N+I,J)=FAC*P(N+I,J) - 520 CONTINUE - P(N+I,4)=SQRT(P(N+I,5)**2+P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) - V(N+I,2)=P(N+I,4) - PES=PES+P(N+I,4) - PQS=PQS+P(N+I,5)**2/P(N+I,4) - 530 CONTINUE - IF(LOOP.LT.10.AND.ABS(PES-PS(5)).GT.1D-12*PS(5)) GOTO 510 - -C...Construct transverse momentum for ordinary branching in shower. - ELSE - ZM=V(IM,1) - LOOPPT=0 - 540 LOOPPT=LOOPPT+1 - PZM=SQRT(MAX(0D0,(PEM+P(IM,5))*(PEM-P(IM,5)))) - PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4D0*V(N+1,5)*V(N+2,5) - IF(PZM.LE.0D0) THEN - PTS=0D0 - ELSEIF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - PTS=PMLS*ZM*(1D0-ZM)/V(IM,5) - ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN - PTS=(PEM**2*(ZM*(1D0-ZM)*V(IM,5)-(1D0-ZM)*V(N+1,5)- - & ZM*V(N+2,5))-0.25D0*PMLS)/PZM**2 - ELSE - PTS=PMLS*(ZM*(1D0-ZM)*PEM**2/V(IM,5)-0.25D0)/PZM**2 - ENDIF - IF(PTS.LT.0D0.AND.LOOPPT.LT.10) THEN - ZM=0.05D0+0.9D0*ZM - GOTO 540 - ELSEIF(PTS.LT.0D0) THEN - GOTO 270 - ENDIF - PT=SQRT(MAX(0D0,PTS)) - -C...Find coefficient of azimuthal asymmetry due to gluon polarization. - HAZIP=0D0 - 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=1D0-V(IGM,1) - IF(MAZIP.EQ.0) ZAU=0D0 - IF(K(IGM,2).NE.21) THEN - HAZIP=2D0*ZAU/(1D0+ZAU**2) - ELSE - HAZIP=(ZAU/(1D0-ZAU*(1D0-ZAU)))**2 - ENDIF - IF(K(N+1,2).NE.21) THEN - HAZIP=HAZIP*(-2D0*ZM*(1D0-ZM))/(1D0-2D0*ZM*(1D0-ZM)) - ELSE - HAZIP=HAZIP*(ZM*(1D0-ZM)/(1D0-ZM*(1D0-ZM)))**2 - ENDIF - ENDIF - -C...Find coefficient of azimuthal asymmetry due to soft gluon -C...interference. - HAZIC=0D0 - 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.5D0) MAZIC=N+2 - IF(K(IAU,2).EQ.22) MAZIC=0 - ZS=ZM - IF(MAZIC.EQ.N+2) ZS=1D0-ZM - ZGM=V(IGM,1) - IF(IAU.EQ.IM-1) ZGM=1D0-V(IGM,1) - IF(MAZIC.EQ.0) ZGM=1D0 - IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))* - & SQRT((1D0-ZS)*(1D0-ZGM)/(ZS*ZGM)) - HAZIC=MIN(0.95D0,HAZIC) - ENDIF - ENDIF - -C...Construct energies for ordinary branching in shower. - 550 IF(NEP.EQ.2.AND.IGM.GT.0) THEN - IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - P(N+1,4)=0.5D0*(PEM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ - & PZM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) - ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN - P(N+1,4)=PEM*V(IM,1) - ELSE - P(N+1,4)=PEM*(0.5D0*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ - & SQRT(PMLS)*ZM)/V(IM,5) - ENDIF - -C...Already predetermined choice of phi angle or not - PHI=PARU(2)*PYR(0) - IF(MPSPD.EQ.1.AND.IGM.EQ.NS+1) THEN - IPSPD=IP1+IM-NS-2 - IF(K(IPSPD,4).GT.0) THEN - IPSGD1=K(IPSPD,4) - IF(IM.EQ.NS+2) THEN - PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) - ELSE - PHI=PYANGL(-P(IPSGD1,1),P(IPSGD1,2)) - ENDIF - ENDIF - ELSEIF(MPSPD.EQ.1.AND.IGM.EQ.NS+2) THEN - IPSPD=IP1+IM-NS-2 - IF(K(IPSPD,4).GT.0) THEN - IPSGD1=K(IPSPD,4) - PHIPSM=PYANGL(P(IPSPD,1),P(IPSPD,2)) - THEPSM=PYANGL(P(IPSPD,3),SQRT(P(IPSPD,1)**2+P(IPSPD,2)**2)) - CALL PYROBO(IPSGD1,IPSGD1,0D0,-PHIPSM,0D0,0D0,0D0) - CALL PYROBO(IPSGD1,IPSGD1,-THEPSM,0D0,0D0,0D0,0D0) - PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) - CALL PYROBO(IPSGD1,IPSGD1,THEPSM,PHIPSM,0D0,0D0,0D0) - ENDIF - ENDIF - -C...Construct momenta for ordinary branching in shower. - P(N+1,1)=PT*COS(PHI) - P(N+1,2)=PT*SIN(PHI) - IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - P(N+1,3)=0.5D0*(PZM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ - & PEM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) - ELSEIF(PZM.GT.0D0) THEN - P(N+1,3)=0.5D0*(V(N+2,5)-V(N+1,5)-V(IM,5)+ - & 2D0*PEM*P(N+1,4))/PZM - ELSE - P(N+1,3)=0D0 - 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))/(1D0+GA)- - & P(IM,4)) - ELSE - BEX=0D0 - BEY=0D0 - BEZ=0D0 - GA=1D0 - GABEP=0D0 - ENDIF - PTIMB=SQRT((P(IM,1)+GABEP*BEX)**2+(P(IM,2)+GABEP*BEY)**2) - THE=PYANGL(P(IM,3)+GABEP*BEZ,PTIMB) - IF(PTIMB.GT.1D-4) THEN - PHI=PYANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) - ELSE - PHI=0D0 - ENDIF - DO 560 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) - 560 CONTINUE - ENDIF - -C...Weight with azimuthal distribution, if required. - IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN - DO 570 J=1,3 - DPT(1,J)=P(IM,J) - DPT(2,J)=P(IAU,J) - DPT(3,J)=P(N+1,J) - 570 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 580 J=1,3 - DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/MAX(1D-10,DPMM) - DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/MAX(1D-10,DPMM) - 580 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.1D0*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(1D0+HAZIP*(2D0*CAD**2-1D0).LT.PYR(0)*(1D0+ABS(HAZIP))) - & GOTO 550 - ENDIF - IF(MAZIC.NE.0) THEN - IF(MAZIC.EQ.N+2) CAD=-CAD - IF((1D0-HAZIC)*(1D0-HAZIC*CAD)/(1D0+HAZIC**2-2D0*HAZIC*CAD) - & .LT.PYR(0)) GOTO 550 - 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=PYANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) - IF(III.EQ.2) THEIID=PARU(1)-THEIID - PHIIID=PYANGL(P(IAZIID,1),P(IAZIID,2)) - HAZII=MIN(0.95D0,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((1D0-HAZII)*(1D0-HAZII*CAD)/(1D0+HAZII**2-2D0*HAZII*CAD) - & .LT.PYR(0)) GOTO 550 - 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)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) N=NS - IF(MSTU(21).GE.1) RETURN - ENDIF - GOTO 280 - -C...Set information on imagined shower initiator. - 590 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 600 I=NS+1+IIM,N - KQ=KCHG(PYCOMP(K(I,2)),2) - 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(KQ.EQ.1.AND.K(I,2).GT.0) ID1=MOD(K(I,4),MSTU(5))+1 - IF(KQ.EQ.2.AND.(K(ID1,2).EQ.21.OR.K(ID1+1,2).EQ.21).AND. - & PYR(0).GT.0.5D0) 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(KQ.EQ.1.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 - 600 CONTINUE - -C...Transformation from CM frame. - IF(NPA.EQ.1) THEN - THE=PYANGL(P(IPA(1),3),SQRT(P(IPA(1),1)**2+P(IPA(1),2)**2)) - PHI=PYANGL(P(IPA(1),1),P(IPA(1),2)) - MSTU(33)=1 - CALL PYROBO(NS+1,N,THE,PHI,0D0,0D0,0D0) - ELSEIF(NPA.EQ.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)) - & /(1D0+GA)-P(IPA(1),4)) - THE=PYANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) - & +GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) - PHI=PYANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) - MSTU(33)=1 - CALL PYROBO(NS+1,N,THE,PHI,BEX,BEY,BEZ) - ELSE - CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,PS(1)/PS(4),PS(2)/PS(4), - & PS(3)/PS(4)) - MSTU(33)=1 - CALL PYROBO(NS+1,N,0D0,0D0,PS(1)/PS(4),PS(2)/PS(4),PS(3)/PS(4)) - ENDIF - -C...Decay vertex of shower. - DO 620 I=NS+1,N - DO 610 J=1,5 - V(I,J)=V(IP1,J) - 610 CONTINUE - 620 CONTINUE - -C...Delete trivial shower, else connect initiators. - IF(N.LE.NS+NPA+IIM) THEN - N=NS - ELSE - DO 630 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 - 630 CONTINUE - ENDIF - - RETURN - END - -C*********************************************************************** - -C...PYSIGH -C...Differential matrix elements for all included subprocesses -C...Note that what is coded is (disregarding the COMFAC factor) -C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where, -C...when d(sigma-hat) is given in the zero-width limit, the delta -C...function in tau is replaced by a (modified) Breit-Wigner: -C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2), -C...where H_res = s-hat/m_res*Gamma_res(s-hat); -C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat); -C...i.e., dimensionless quantities -C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is -C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) * -C...(2pi)^4 delta^4(P - sum p_i) -C...COMFAC contains the factor pi/s (or equivalent) and -C...the conversion factor from GeV^-2 to mb - - SUBROUTINE PYSIGH(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/, - &/PYMSSM/,/PYSSMT/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION X(2),XPQ(-25:25) - -C...Map of processes onto which routine to call -C...in order to evaluate cross section: -C...0 = not implemented; -C...1 = standard QCD (including photons); -C...2 = heavy flavours; -C...3 = W/Z; -C...4 = Higgs (2 doublets; including longitudinal W/Z scattering); -C...5 = SUSY; -C...6 = Technicolor; -C...7 = exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). - DIMENSION MAPPR(500) - DATA (MAPPR(I),I=1,180)/ - & 3, 3, 4, 0, 4, 0, 0, 4, 0, 1, - 1 1, 1, 1, 1, 3, 3, 0, 1, 3, 3, - 2 0, 3, 3, 4, 3, 4, 0, 1, 1, 3, - 3 3, 4, 1, 1, 3, 3, 0, 0, 0, 0, - 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 5 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 1, 3, 3, - 7 4, 4, 4, 0, 0, 4, 4, 0, 0, 1, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, - 9 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, - & 0, 4, 4, 2, 2, 2, 2, 2, 0, 4, - 1 4, 4, 4, 1, 1, 0, 0, 0, 0, 0, - 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, - 3 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 4 7, 7, 4, 7, 7, 7, 7, 7, 6, 0, - 5 4, 4, 4, 0, 0, 4, 4, 4, 0, 0, - 6 4, 7, 7, 7, 6, 6, 7, 7, 7, 0, - 7 4, 4, 4, 4, 0, 4, 4, 4, 4, 0/ - DATA (MAPPR(I),I=181,500)/ - 8 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 9 6, 6, 6, 6, 6, 0, 0, 0, 0, 0, - & 100*5, - & 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 30*0, - 4 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 5 7, 7, 7, 7, 0, 0, 0, 0, 0, 0, - 6 6, 6, 6, 6, 6, 6, 6, 6, 0, 6, - 7 6, 6, 6, 6, 6, 6, 6, 0, 0, 0, - 8 6, 6, 6, 6, 6, 6, 6, 6, 0, 0, - 9 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, - & 4, 4, 98*0/ - -C...Reset number of channels and cross-section - NCHN=0 - SIGS=0D0 - -C...Read process to consider. - ISUB=MINT(1) - ISUBSV=ISUB - MAP=MAPPR(ISUB) - -C...Read kinematical variables and limits - ISTSB=ISET(ISUBSV) - TAUMIN=VINT(11) - YSTMIN=VINT(12) - CTNMIN=VINT(13) - CTPMIN=VINT(14) - TAUPMN=VINT(16) - TAU=VINT(21) - YST=VINT(22) - CTH=VINT(23) - XT2=VINT(25) - TAUP=VINT(26) - TAUMAX=VINT(31) - YSTMAX=VINT(32) - CTNMAX=VINT(33) - CTPMAX=VINT(34) - TAUPMX=VINT(36) - -C...Derive kinematical quantities - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP - X(1)=SQRT(TAUE)*EXP(YST) - X(2)=SQRT(TAUE)*EXP(-YST) - IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN - IF(X(1).GT.1D0-1D-7) RETURN - ELSEIF(MINT(45).EQ.3) THEN - X(1)=MIN(1D0-1.1D-10,X(1)) - ENDIF - IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN - IF(X(2).GT.1D0-1D-7) RETURN - ELSEIF(MINT(46).EQ.3) THEN - X(2)=MIN(1D0-1.1D-10,X(2)) - ENDIF - SH=MAX(1D0,TAU*VINT(2)) - SQM3=VINT(63) - SQM4=VINT(64) - RM3=SQM3/SH - RM4=SQM4/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - RPTS=4D0*VINT(71)**2/SH - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=MAX(1D-20,2D0*RM3*RM4) - RSQM=1D0+RM34 - IF(2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2)).LT.0.0001D0) - &RM34=MAX(RM34,2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2))) - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - IF(ISTSB.EQ.0) THEN - TH=VINT(45) - UH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*VINT(59)**2) - ELSE -C...Kinematics with incoming masses tricky: now depends on how -C...subprocess has been set up w.r.t. order of incoming partons. - RM1=0D0 - IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) RM1=-VINT(3)**2/SH - RM2=0D0 - IF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) RM2=-VINT(4)**2/SH - IF(ISUB.EQ.35) THEN - RM2=MIN(RM1,RM2) - RM1=0D0 - ENDIF - BE12=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - TUCOM=(1D0-RM1-RM2)*(1D0-RM3-RM4) - TH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM4-2D0*RM2*RM3- - & BE12*BE34*CTH) - UH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM3-2D0*RM2*RM4+ - & BE12*BE34*CTH) - SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*(1D0-CTH**2)) - ENDIF - SHR=SQRT(SH) - SH2=SH**2 - TH2=TH**2 - UH2=UH**2 - -C...Choice of Q2 scale: hard, parton distributions, parton showers - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - Q2=SH - ELSEIF(ISTSB.EQ.8) THEN - IF(MINT(107).EQ.4) Q2=VINT(307) - IF(MINT(108).EQ.4) Q2=VINT(308) - ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN - Q2IN1=0D0 - IF(MINT(11).EQ.22.AND.VINT(3).LT.0D0) Q2IN1=VINT(3)**2 - Q2IN2=0D0 - IF(MINT(12).EQ.22.AND.VINT(4).LT.0D0) Q2IN2=VINT(4)**2 - IF(MSTP(32).EQ.1) THEN - Q2=2D0*SH*TH*UH/(SH**2+TH**2+UH**2) - ELSEIF(MSTP(32).EQ.2) THEN - Q2=SQPTH+0.5D0*(SQM3+SQM4) - ELSEIF(MSTP(32).EQ.3) THEN - Q2=MIN(-TH,-UH) - ELSEIF(MSTP(32).EQ.4) THEN - Q2=SH - ELSEIF(MSTP(32).EQ.5) THEN - Q2=-TH - ELSEIF(MSTP(32).EQ.6) THEN - XSF1=X(1) - IF(ISTSB.EQ.9) XSF1=X(1)/VINT(143) - XSF2=X(2) - IF(ISTSB.EQ.9) XSF2=X(2)/VINT(144) - Q2=(1D0+XSF1*Q2IN1/SH+XSF2*Q2IN2/SH)* - & (SQPTH+0.5D0*(SQM3+SQM4)) - ELSEIF(MSTP(32).EQ.7) THEN - Q2=(1D0+Q2IN1/SH+Q2IN2/SH)*(SQPTH+0.5D0*(SQM3+SQM4)) - ELSEIF(MSTP(32).EQ.8) THEN - Q2=SQPTH+0.5D0*(Q2IN1+Q2IN2+SQM3+SQM4) - ELSEIF(MSTP(32).EQ.9) THEN - Q2=SQPTH+Q2IN1+Q2IN2+SQM3+SQM4 - ELSEIF(MSTP(32).EQ.10) THEN - Q2=VINT(2) - ENDIF - IF((ISTSB.EQ.9).AND.(MSTP(81).NE.0)) THEN - Q2=SQPTH - ENDIF - IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2=Q2+ - & (PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2 - ENDIF - Q2SF=Q2 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - Q2SF=PMAS(23,1)**2 - IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124.OR. - & ISUB.EQ.351) Q2SF=PMAS(24,1)**2 - IF(ISUB.EQ.352) Q2SF=PMAS(PYCOMP(9900024),1)**2 - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. - & ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) THEN - Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,2)),1)**2 - IF(MSTP(39).EQ.2) Q2SF= - & MAX(VINT(201)**2+VINT(202),VINT(206)**2+VINT(207)) - IF(MSTP(39).EQ.3) Q2SF=SH - IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2) - IF(MSTP(39).EQ.5) Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,1)),1)**2 - ENDIF - ENDIF - Q2PS=Q2SF - Q2SF=Q2SF*PARP(34) - IF(MSTP(69).GE.1.AND.MINT(47).EQ.5) Q2SF=VINT(2) - IF(MSTP(69).GE.2) Q2SF=VINT(2) - IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND. - &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN - XBJ=X(2) - IF(MINT(43).EQ.3) XBJ=X(1) - IF(MSTP(22).EQ.1) THEN - Q2PS=-TH - ELSEIF(MSTP(22).EQ.2) THEN - Q2PS=((1D0-XBJ)/XBJ)*(-TH) - ELSEIF(MSTP(22).EQ.3) THEN - Q2PS=SQRT((1D0-XBJ)/XBJ)*(-TH) - ELSE - Q2PS=(1D0-XBJ)*MAX(1D0,-LOG(XBJ))*(-TH) - ENDIF - ENDIF - IF(MSTP(68).EQ.1.AND.(ISUBSV.EQ.1.OR.ISUBSV.EQ.2.OR. - &ISUBSV.EQ.102.OR.ISUBSV.EQ.141.OR.ISUBSV.EQ.142.OR. - &ISUBSV.EQ.144.OR.ISUBSV.EQ.152.OR.ISUBSV.EQ.157)) THEN - Q2PS=VINT(2) - ELSEIF(MSTP(68).GE.2.AND.(ISUBSV.NE.11.AND.ISUBSV.NE.12.AND. - &ISUBSV.NE.13.AND.ISUBSV.NE.28.AND.ISUBSV.NE.53.AND. - &ISUBSV.NE.68)) THEN - Q2PS=VINT(2) - ENDIF - -C...Store derived kinematical quantities - VINT(41)=X(1) - VINT(42)=X(2) - VINT(44)=SH - VINT(43)=SQRT(SH) - VINT(45)=TH - VINT(46)=UH - IF(ISTSB.NE.8) VINT(48)=SQPTH - IF(ISTSB.NE.8) VINT(47)=SQRT(SQPTH) - VINT(50)=TAUP*VINT(2) - VINT(49)=SQRT(MAX(0D0,VINT(50))) - VINT(52)=Q2 - VINT(51)=SQRT(Q2) - VINT(54)=Q2SF - VINT(53)=SQRT(Q2SF) - VINT(56)=Q2PS - VINT(55)=SQRT(Q2PS) - -C...Calculate parton distributions - IF(ISTSB.LE.0) GOTO 160 - IF(MINT(47).GE.2) THEN - DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46)) - XSF=X(I) - IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I) - IF(ISUB.EQ.99) THEN - IF(MINT(140+I).EQ.0) THEN - XSF=VINT(309-I)/(VINT(2)+VINT(309-I)-VINT(I+2)**2) - ELSE - XSF=VINT(309-I)/(VINT(2)+VINT(307)+VINT(308)) - ENDIF - VINT(40+I)=XSF - Q2SF=VINT(309-I) - ENDIF - MINT(105)=MINT(102+I) - MINT(109)=MINT(106+I) - VINT(120)=VINT(2+I) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(MINT(10+I),XSF,Q2SF,XPQ) - ELSE - CALL PYPDFL(MINT(10+I),XSF,Q2SF,XPQ) - ENDIF - DO 100 KFL=-25,25 - XSFX(I,KFL)=XPQ(KFL) - 100 CONTINUE - 110 CONTINUE - ENDIF - -C...Calculate alpha_em, alpha_strong and K-factor - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW= - &1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - XWC=1D0/(16D0*XW*XW1) - AEM=PYALEM(Q2) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - IF(MSTP(33).NE.3) AS=PYALPS(PARP(34)*Q2) - FACK=1D0 - FACA=1D0 - IF(MSTP(33).EQ.1) THEN - FACK=PARP(31) - ELSEIF(MSTP(33).EQ.2) THEN - FACK=PARP(31) - FACA=PARP(32)/PARP(31) - ELSEIF(MSTP(33).EQ.3) THEN - Q2AS=PARP(33)*Q2 - IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+ - & PARU(112)*PARP(82)*(VINT(1)/PARP(89))**PARP(90) - AS=PYALPS(Q2AS) - ENDIF - VINT(138)=1D0 - VINT(57)=AEM - VINT(58)=AS - -C...Set flags for allowed reacting partons/leptons - DO 140 I=1,2 - DO 120 J=-25,25 - KFAC(I,J)=0 - 120 CONTINUE - IF(MINT(44+I).EQ.1) THEN - KFAC(I,MINT(10+I))=1 - ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN - KFAC(I,MINT(10+I))=1 - KFAC(I,22)=1 - KFAC(I,24)=1 - KFAC(I,-24)=1 - ELSE - DO 130 J=-25,25 - KFAC(I,J)=KFIN(I,J) - IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0 - IF(XSFX(I,J).LT.1D-10) KFAC(I,J)=0 - 130 CONTINUE - ENDIF - 140 CONTINUE - -C...Lower and upper limit for fermion flavour loops - MMIN1=0 - MMAX1=0 - MMIN2=0 - MMAX2=0 - DO 150 J=-20,20 - IF(KFAC(1,-J).EQ.1) MMIN1=-J - IF(KFAC(1,J).EQ.1) MMAX1=J - IF(KFAC(2,-J).EQ.1) MMIN2=-J - IF(KFAC(2,J).EQ.1) MMAX2=J - 150 CONTINUE - MMINA=MIN(MMIN1,MMIN2) - MMAXA=MAX(MMAX1,MMAX2) - -C...Common resonance mass and width combinations - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - GMMW=PMAS(24,1)*PMAS(24,2) - -C...Polarization factors...implemented so far for W+W-(25) - POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) - POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) - POLRR=(1D0+PARJ(132))*(1D0+PARJ(131)) - POLLL=(1D0-PARJ(132))*(1D0-PARJ(131)) - -C...Phase space integral in tau - COMFAC=PARU(1)*PARU(5)/VINT(2) - IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK - IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND. - &ISTSB.NE.8.AND.ISTSB.NE.9) THEN - ATAU1=LOG(TAUMAX/TAUMIN) - ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) - H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU - IF(MINT(72).GE.1) THEN - TAUR1=VINT(73) - GAMR1=VINT(74) - ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1)) - ATAU3=ATAUD/TAUR1 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1) - ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1) - ATAU4=ATAUD/GAMR1 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2) - ENDIF - IF(MINT(72).EQ.2) THEN - TAUR2=VINT(75) - GAMR2=VINT(76) - ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2)) - ATAU5=ATAUD/TAUR2 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2) - ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2) - ATAU6=ATAUD/GAMR2 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2) - ENDIF - IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN - ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) - IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ - & MAX(2D-10,1D0-TAU) - ELSEIF(MINT(47).GE.6.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN - ATAU7=LOG(MAX(1D-10,1D0-TAUMIN)/MAX(1D-10,1D0-TAUMAX)) - IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ - & MAX(1D-10,1D0-TAU) - ENDIF - COMFAC=COMFAC*ATAU1/(TAU*H1) - ENDIF - -C...Phase space integral in y* - IF((MINT(47).EQ.4.OR.MINT(47).EQ.5).AND.ISTSB.NE.8.AND.ISTSB.NE.9) - &THEN - AYST0=YSTMAX-YSTMIN - IF(AYST0.LT.1D-10) THEN - COMFAC=0D0 - ELSE - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST2=AYST1 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ - & (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+ - & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) - IF(MINT(45).EQ.3) THEN - YST0=-0.5D0*LOG(TAUE) - AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ - & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - IF(AYST4.GT.1D-10) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/ - & MAX(1D-10,1D0-EXP(YST-YST0)) - ENDIF - IF(MINT(46).EQ.3) THEN - YST0=-0.5D0*LOG(TAUE) - AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ - & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - IF(AYST5.GT.1D-10) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/ - & MAX(1D-10,1D0-EXP(-YST-YST0)) - ENDIF - COMFAC=COMFAC*AYST0/H2 - ENDIF - ENDIF - -C...2 -> 1 processes: reduction in angular part of phase space integral -C...for case of decaying resonance - ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN - IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN - IF(MDCY(PYCOMP(KFPR(ISUBSV,1)),1).EQ.1) THEN - IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR. - & KFPR(ISUB,1).EQ.39) THEN - COMFAC=COMFAC*0.5D0*ACTH0 - ELSE - COMFAC=COMFAC*0.125D0*(3D0*ACTH0+CTNMAX**3-CTNMIN**3+ - & CTPMAX**3-CTPMIN**3) - ENDIF - ENDIF - -C...2 -> 2 processes: angular part of phase space integral - ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/ - & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX))) - ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/ - & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN))) - ACTH3=1D0/MAX(RM34,RSQM-CTNMAX)-1D0/MAX(RM34,RSQM-CTNMIN)+ - & 1D0/MAX(RM34,RSQM-CTPMAX)-1D0/MAX(RM34,RSQM-CTPMIN) - ACTH4=1D0/MAX(RM34,RSQM+CTNMIN)-1D0/MAX(RM34,RSQM+CTNMAX)+ - & 1D0/MAX(RM34,RSQM+CTPMIN)-1D0/MAX(RM34,RSQM+CTPMAX) - H3=COEF(ISUBSV,13)+ - & (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+ - & (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+ - & (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+ - & (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2 - COMFAC=COMFAC*ACTH0*0.5D0*BE34/H3 - -C...2 -> 2 processes: take into account final state Breit-Wigners - COMFAC=COMFAC*VINT(80) - ENDIF - -C...2 -> 3, 4 processes: phace space integral in tau' - IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN - ATAUP1=LOG(TAUPMX/TAUPMN) - ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) - H4=COEF(ISUBSV,18)+ - & (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1D0-TAU/TAUP)**3/TAUP - IF(MINT(47).EQ.5) THEN - ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) - H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2D-10,1D0-TAUP) - ELSEIF(MINT(47).GE.6) THEN - ATAUP3=LOG(MAX(1D-10,1D0-TAUPMN)/MAX(1D-10,1D0-TAUPMX)) - H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(1D-10,1D0-TAUP) - ENDIF - COMFAC=COMFAC*ATAUP1/H4 - ENDIF - -C...2 -> 3, 4 processes: effective W/Z parton distributions - IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN - IF(1D0-TAU/TAUP.GT.1D-4) THEN - FZW=(1D0+TAU/TAUP)*LOG(TAUP/TAU)-2D0*(1D0-TAU/TAUP) - ELSE - FZW=1D0/6D0*(1D0-TAU/TAUP)**3*TAU/TAUP - ENDIF - COMFAC=COMFAC*FZW - ENDIF - -C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror - IF(ISTSB.EQ.5) THEN - COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/ - & (128D0*PARU(1)**4*VINT(220))*(TAU**2/TAUP) - ENDIF - -C...Phase space integral for low-pT and multiple interactions - IF(ISTSB.EQ.9) THEN - COMFAC=PARU(1)*PARU(5)*FACK*0.5D0*VINT(2)/SH2 - ATAU1=LOG(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0) - ATAU2=2D0*ATAN(1D0/XT2-1D0)/SQRT(XT2) - H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU) - COMFAC=COMFAC*ATAU1/H1 - AYST0=YSTMAX-YSTMIN - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ - & (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+ - & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) - COMFAC=COMFAC*AYST0/H2 - IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1D0/VINT(149)-1D0) -C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is -C...introduced to make cross-section finite for xT2 -> 0 - IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)* - & (1D0+VINT(149))) - ENDIF - -C...Real gamma + gamma: include factor 2 when different nature - 160 IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. - &MSTP(14).LE.10) COMFAC=2D0*COMFAC - -C...Extra factors to include the effects of -C...longitudinal resolved photons (but not direct or DIS ones). - DO 170 ISDE=1,2 - IF(MINT(10+ISDE).EQ.22.AND.MINT(106+ISDE).GE.1.AND. - & MINT(106+ISDE).LE.3) THEN - VINT(314+ISDE)=1D0 - XY=PARP(166+ISDE) - IF(MSTP(16).EQ.0) THEN - IF(VINT(304+ISDE).GT.0D0.AND.VINT(304+ISDE).LT.1D0) - & XY=VINT(304+ISDE) - ELSE - IF(VINT(308+ISDE).GT.0D0.AND.VINT(308+ISDE).LT.1D0) - & XY=VINT(308+ISDE) - ENDIF - Q2GA=VINT(306+ISDE) - IF(MSTP(17).GT.0.AND.XY.GT.0D0.AND.XY.LT.1D0.AND. - & Q2GA.GT.0D0) THEN - REDUCE=0D0 - IF(MSTP(17).EQ.1) THEN - REDUCE=4D0*Q2*Q2GA/(Q2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.2) THEN - REDUCE=4D0*Q2GA/(Q2+Q2GA) - ELSEIF(MSTP(17).EQ.3) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.1) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.2) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.3) THEN - PMVSMN=4D0*PARP(15)**2 - PMVSMX=4D0*VINT(154)**2 - REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) - REDLON=(3D0*PMVSMN+Q2GA)/(PMVSMN+Q2GA)**3- - & (3D0*PMVSMX+Q2GA)/(PMVSMX+Q2GA)**3 - REDUCE=4D0*(Q2GA/6D0)*REDLON/REDTRA - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.1) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.2) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.3) THEN - PMVSMN=4D0*PARP(15)**2 - PMVSMX=4D0*VINT(154)**2 - REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) - REDLON=1D0/(PMVSMN+Q2GA)**2-1D0/(PMVSMX+Q2GA)**2 - REDUCE=4D0*(Q2GA/2D0)*REDLON/REDTRA -C ........Hermes version of R_VMD - ELSEIF(MSTP(17).EQ.6) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=(Q2GA/PMVIRT**2)**PARP(166) - ENDIF - BEAMAS=PYMASS(11) - IF(VINT(302+ISDE).GT.0D0) BEAMAS=VINT(302+ISDE) - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - FRACLT=1D0/(1D0+(XY**2*(1D0-2D0*BEAMAS**2/Q2GA))/ - & (2D0/(1D0+Q2GA/XY**2/VINT(290)**2)*(1D0-XY- - & (Q2GA/4D0/VINT(290)**2)))) - ELSE - FRACLT=1D0/(1D0+XY**2/2D0/(1D0-XY)* - & (1D0-2D0*BEAMAS**2/Q2GA)) - ENDIF - VINT(314+ISDE)=1D0+PARP(165)*REDUCE*FRACLT - ENDIF - ELSE - VINT(314+ISDE)=1D0 - ENDIF - COMFAC=COMFAC*VINT(314+ISDE) - 170 CONTINUE - -C...Evaluate cross sections - done in separate routines by kind -C...of physics, to keep PYSIGH of sensible size. - IF(MAP.EQ.1) THEN -C...Standard QCD (including photons). - CALL PYSGQC(NCHN,SIGS) - ELSEIF(MAP.EQ.2) THEN -C...Heavy flavours. - CALL PYSGHF(NCHN,SIGS) - ELSEIF(MAP.EQ.3) THEN -C...W/Z. - CALL PYSGWZ(NCHN,SIGS) - ELSEIF(MAP.EQ.4) THEN -C...Higgs (2 doublets; including longitudinal W/Z scattering). - CALL PYSGHG(NCHN,SIGS) - ELSEIF(MAP.EQ.5) THEN -C...SUSY. - CALL PYSGSU(NCHN,SIGS) - ELSEIF(MAP.EQ.6) THEN -C...Technicolor. - CALL PYSGTC(NCHN,SIGS) - ELSEIF(MAP.EQ.7) THEN -C...Exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). - CALL PYSGEX(NCHN,SIGS) - ENDIF - -C...Multiply with parton distributions - IF(ISUB.LE.90.OR.ISUB.GE.96) THEN - DO 180 ICHN=1,NCHN - IF(MINT(45).GE.2) THEN - KFL1=ISIG(ICHN,1) - SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1) - ENDIF - IF(MINT(46).GE.2) THEN - KFL2=ISIG(ICHN,2) - SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2) - ENDIF - SIGS=SIGS+SIGH(ICHN) - 180 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSIMP -C...Simpson formula for an integral. - - FUNCTION PYSIMP(Y,X0,X1,N) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION Y,X0,X1,H,S - DIMENSION Y(0:N) - - S=0D0 - H=(X1-X0)/N - DO 100 I=0,N-2,2 - S=S+Y(I)+4D0*Y(I+1)+Y(I+2) - 100 CONTINUE - PYSIMP=S*H/3D0 - - RETURN - END - -C*********************************************************************** - -C...PYSPEN -C...Calculates real and imaginary part of Spence function; see -C...G. 't Hooft and M. Veltman, Nucl. Phys. B153 (1979) 365. - - FUNCTION PYSPEN(XREIN,XIMIN,IREIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array and data. - DIMENSION B(0:14) - DATA B/ - &1.000000D+00, -5.000000D-01, 1.666667D-01, - &0.000000D+00, -3.333333D-02, 0.000000D+00, - &2.380952D-02, 0.000000D+00, -3.333333D-02, - &0.000000D+00, 7.575757D-02, 0.000000D+00, - &-2.531135D-01, 0.000000D+00, 1.166667D+00/ - - XRE=XREIN - XIM=XIMIN - IF(ABS(1D0-XRE).LT.1D-6.AND.ABS(XIM).LT.1D-6) THEN - IF(IREIM.EQ.1) PYSPEN=PARU(1)**2/6D0 - IF(IREIM.EQ.2) PYSPEN=0D0 - RETURN - ENDIF - - XMOD=SQRT(XRE**2+XIM**2) - IF(XMOD.LT.1D-6) THEN - IF(IREIM.EQ.1) PYSPEN=0D0 - IF(IREIM.EQ.2) PYSPEN=0D0 - RETURN - ENDIF - - XARG=SIGN(ACOS(XRE/XMOD),XIM) - SP0RE=0D0 - SP0IM=0D0 - SGN=1D0 - IF(XMOD.GT.1D0) THEN - ALGXRE=LOG(XMOD) - ALGXIM=XARG-SIGN(PARU(1),XARG) - SP0RE=-PARU(1)**2/6D0-(ALGXRE**2-ALGXIM**2)/2D0 - SP0IM=-ALGXRE*ALGXIM - SGN=-1D0 - XMOD=1D0/XMOD - XARG=-XARG - XRE=XMOD*COS(XARG) - XIM=XMOD*SIN(XARG) - ENDIF - IF(XRE.GT.0.5D0) THEN - ALGXRE=LOG(XMOD) - ALGXIM=XARG - XRE=1D0-XRE - XIM=-XIM - XMOD=SQRT(XRE**2+XIM**2) - XARG=SIGN(ACOS(XRE/XMOD),XIM) - ALGYRE=LOG(XMOD) - ALGYIM=XARG - SP0RE=SP0RE+SGN*(PARU(1)**2/6D0-(ALGXRE*ALGYRE-ALGXIM*ALGYIM)) - SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE) - SGN=-SGN - ENDIF - - XRE=1D0-XRE - XIM=-XIM - XMOD=SQRT(XRE**2+XIM**2) - XARG=SIGN(ACOS(XRE/XMOD),XIM) - ZRE=-LOG(XMOD) - ZIM=-XARG - - SPRE=0D0 - SPIM=0D0 - SAVERE=1D0 - SAVEIM=0D0 - DO 100 I=0,14 - IF(MAX(ABS(SAVERE),ABS(SAVEIM)).LT.1D-30) GOTO 110 - TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/DBLE(I+1) - TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/DBLE(I+1) - SAVERE=TERMRE - SAVEIM=TERMIM - SPRE=SPRE+B(I)*TERMRE - SPIM=SPIM+B(I)*TERMIM - 100 CONTINUE - - 110 IF(IREIM.EQ.1) PYSPEN=SP0RE+SGN*SPRE - IF(IREIM.EQ.2) PYSPEN=SP0IM+SGN*SPIM - - RETURN - END - -C********************************************************************* - -C...PYSPHE -C...Performs sphericity tensor analysis to give sphericity, -C...aplanarity and the related event axes. - - SUBROUTINE PYSPHE(SPH,APL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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)=0D0 - 100 CONTINUE - 110 CONTINUE - PS=0D0 - 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=PYCOMP(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.PYCHGE(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=1D0 - IF(ABS(PARU(41)-2D0).GT.0.001D0) PWT= - & MAX(1D-10,PA)**(PARU(41)-2D0) - 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 PYERRM(8,'(PYSPHE:) too few particles for analysis') - SPH=-1D0 - APL=-1D0 - 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)/3D0-1D0/9D0 - SR=-0.5D0*(SQ+1D0/9D0+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)+1D0/27D0 - SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) - P(N+1,4)=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP) - P(N+3,4)=1D0/3D0+SQRT(-SQ)*MIN(2D0*SP,-SQRT(3D0*(1D0-SP**2))-SP) - P(N+2,4)=1D0-P(N+1,4)-P(N+3,4) - IF(P(N+2,4).LT.1D-5) THEN - CALL PYERRM(8,'(PYSPHE:) all particles back-to-back') - SPH=-1D0 - APL=-1D0 - 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=0D0 - 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=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - DO 250 J=1,5 - V(I,J)=0D0 - 250 CONTINUE - 260 CONTINUE - -C...Calculate sphericity and aplanarity. Select storing option. - SPH=1.5D0*(P(N+2,4)+P(N+3,4)) - APL=1.5D0*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********************************************************************* - -C...PYSPLI -C...Splits a hadron remnant into two (partons or hadron + parton) -C...in case it is more complicated than just a quark or a diquark. - - SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. PYDAT1 temporary - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYPARS/,/PYINT1/,/PYDAT1/ -C...Local array. - DIMENSION KFL(3) - -C...Preliminaries. Parton composition. - KFA=IABS(KF) - KFS=ISIGN(1,KF) - KFL(1)=MOD(KFA/1000,10) - KFL(2)=MOD(KFA/100,10) - KFL(3)=MOD(KFA/10,10) - IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN - KFL(2)=INT(1.5D0+PYR(0)) - IF(MINT(105).EQ.333) KFL(2)=3 - IF(MINT(105).EQ.443) KFL(2)=4 - KFL(3)=KFL(2) - ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN - KFL(2)=2 - KFL(3)=2 - ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN - KFL(2)=1 - KFL(3)=1 - ELSEIF((KFA.EQ.130.OR.KFA.EQ.310).AND.PYR(0).GT.0.5D0) THEN - KFL(2)=MOD(KFA/10,10) - KFL(3)=MOD(KFA/100,10) - ENDIF - IF(KFLIN.NE.21.AND.KFLIN.NE.22.AND.KFLIN.NE.23) THEN - KFLR=KFLIN*KFS - ELSE - KFLR=KFLIN - ENDIF - KFLCH=0 - -C...Subdivide lepton. - IF(KFA.GE.11.AND.KFA.LE.18) THEN - IF(KFLR.EQ.KFA) THEN - KFLSP=KFS*22 - ELSEIF(KFLR.EQ.22) THEN - KFLSP=KFA - ELSEIF(KFLR.EQ.-24.AND.MOD(KFA,2).EQ.1) THEN - KFLSP=KFA+1 - ELSEIF(KFLR.EQ.24.AND.MOD(KFA,2).EQ.0) THEN - KFLSP=KFA-1 - ELSEIF(KFLR.EQ.21) THEN - KFLSP=KFA - KFLCH=KFS*21 - ELSE - KFLSP=KFA - KFLCH=-KFLR - ENDIF - -C...Subdivide photon. - ELSEIF(KFA.EQ.22.AND.MINT(109).NE.2) THEN - IF(KFLR.NE.21) THEN - KFLSP=-KFLR - ELSE - RAGR=0.75D0*PYR(0) - KFLSP=1 - IF(RAGR.GT.0.125D0) KFLSP=2 - IF(RAGR.GT.0.625D0) KFLSP=3 - IF(PYR(0).GT.0.5D0) KFLSP=-KFLSP - KFLCH=-KFLSP - ENDIF - -C...Subdivide Reggeon or Pomeron. - ELSEIF(KFA.EQ.110.OR.KFA.EQ.990) THEN - IF(KFLIN.EQ.21) THEN - KFLSP=KFS*21 - ELSE - KFLSP=-KFLIN - ENDIF - -C...Subdivide meson. - ELSEIF(KFL(1).EQ.0) THEN - KFL(2)=KFL(2)*(-1)**KFL(2) - KFL(3)=-KFL(3)*(-1)**IABS(KFL(2)) - IF(KFLR.EQ.KFL(2)) THEN - KFLSP=KFL(3) - ELSEIF(KFLR.EQ.KFL(3)) THEN - KFLSP=KFL(2) - ELSEIF(KFLR.EQ.21.AND.PYR(0).GT.0.5D0) THEN - KFLSP=KFL(2) - KFLCH=KFL(3) - ELSEIF(KFLR.EQ.21) THEN - KFLSP=KFL(3) - KFLCH=KFL(2) - ELSEIF(KFLR*KFL(2).GT.0) THEN - NTRY=0 - 100 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(2),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 100 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(3) - ELSE - NTRY=0 - 110 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(3),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 110 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(2) - ENDIF - -C...Subdivide baryon. - ELSE - NAGR=0 - DO 120 J=1,3 - IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1 - 120 CONTINUE - IF(NAGR.GE.1) THEN - RAGR=0.00001D0+(NAGR-0.00002D0)*PYR(0) - IAGR=0 - DO 130 J=1,3 - IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1D0 - IF(IAGR.EQ.0.AND.RAGR.LE.0D0) IAGR=J - 130 CONTINUE - ELSE - IAGR=1.00001D0+2.99998D0*PYR(0) - ENDIF - ID1=1 - IF(IAGR.EQ.1) ID1=2 - IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3 - ID2=6-IAGR-ID1 - KSP=3 - IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN - IF(IAGR.NE.3.AND.PYR(0).GT.0.25D0) KSP=1 - ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN - IF(IAGR.NE.1.AND.PYR(0).GT.0.25D0) KSP=1 - ELSEIF(MOD(KFA,10).EQ.2) THEN - IF(IAGR.EQ.1) KSP=1 - IF(IAGR.NE.1.AND.PYR(0).GT.0.75D0) KSP=1 - ENDIF - KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP - IF(KFLR.EQ.21) THEN - KFLCH=KFL(IAGR) - ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN - NTRY=0 - 140 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 140 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - ELSEIF(NAGR.EQ.0) THEN - NTRY=0 - 150 NTRY=NTRY+1 - CALL PYKFDI(10000*KFL(ID1)+KFLSP,-KFLR,KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 150 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(IAGR) - ENDIF - ENDIF - -C...Add on correct sign for result. - KFLCH=KFLCH*KFS - KFLSP=KFLSP*KFS - - RETURN - END - -C********************************************************************* - -C...PYSSPA -C...Generates spacelike parton showers. - - SUBROUTINE PYSSPA(IPU1,IPU2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/ -C...Local arrays and data. - DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVCSV(2),TEVESV(2), - &XFS(2,-25:25),XFA(-25:25),XFB(-25:25),XFN(-25:25),WTAPC(-25:25), - &WTAPE(-25:25),WTSF(-25:25),THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4), - &DPB(4),ROBO(5),MORE(2),KFBEAM(2),Q2MNCS(2),KCFI(2),NFIS(2), - &THEFIS(2,2),ISFI(2),DPHI(2),MCESV(2) - DATA IS/2*0/ - -C...Read out basic information; set global Q^2 scale. - IPUS1=IPU1 - IPUS2=IPU2 - ISUB=MINT(1) - Q2MX=VINT(56) - IF(ISET(ISUB).EQ.2) Q2MX=MIN(VINT(2),PARP(67)*VINT(56)) - FCQ2MX=1D0 - -C...Define which processes ME corrections have been implemented for. - MECOR=0 - IF(MSTP(68).EQ.1) THEN - IF(ISUB.EQ.1.OR.ISUB.EQ.2.OR.ISUB.EQ.141.OR.ISUB.EQ.142.OR. - & ISUB.EQ.144) MECOR=1 - IF(ISUB.EQ.102.OR.ISUB.EQ.152.OR.ISUB.EQ.157) MECOR=2 - ENDIF - -C...Initialize QCD evolution and check phase space. - Q2MNC=PARP(62)**2 - Q2MNCS(1)=Q2MNC - Q2MNCS(2)=Q2MNC - IF(MINT(107).EQ.2.AND.MSTP(66).EQ.2) THEN - Q0S=PARP(15)**2 - PS=VINT(3)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - Q2MNCS(1)=MAX(Q2MNC,Q2INT) - ELSEIF(MINT(107).EQ.3.AND.MSTP(66).GE.1) THEN - Q2MNCS(1)=MAX(Q2MNC,VINT(283)) - ENDIF - IF(MINT(108).EQ.2.AND.MSTP(66).EQ.2) THEN - Q0S=PARP(15)**2 - PS=VINT(4)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - Q2MNCS(2)=MAX(Q2MNC,Q2INT) - ELSEIF(MINT(108).EQ.3.AND.MSTP(66).GE.1) THEN - Q2MNCS(2)=MAX(Q2MNC,VINT(284)) - ENDIF - MCEV=0 - ALAMS=PARU(112) - PARU(112)=PARP(61) - FQ2C=1D0 - TCMX=0D0 - IF(MINT(47).GE.2.AND.(MINT(47).LT.5.OR.MSTP(12).GE.1)) THEN - MCEV=1 - IF(MSTP(64).EQ.1) FQ2C=PARP(63) - IF(MSTP(64).EQ.2) FQ2C=PARP(64) - TCMX=LOG(FQ2C*Q2MX/PARP(61)**2) - IF(Q2MX.LT.MAX(Q2MNC,2D0*PARP(61)**2).OR.TCMX.LT.0.2D0) - & MCEV=0 - ENDIF - -C...Initialize QED evolution and check phase space. - MEEV=0 - XEE=1D-10 - SPME=PMAS(11,1)**2 - IF(IABS(MINT(11)).EQ.13.OR.IABS(MINT(12)).EQ.13) - &SPME=PMAS(13,1)**2 - IF(IABS(MINT(11)).EQ.15.OR.IABS(MINT(12)).EQ.15) - &SPME=PMAS(15,1)**2 - Q2MNE=MAX(PARP(68)**2,2D0*SPME) - TEMX=0D0 - FWTE=10D0 - IF(MINT(45).EQ.3.OR.MINT(46).EQ.3) THEN - MEEV=1 - TEMX=LOG(Q2MX/SPME) - IF(Q2MX.LE.Q2MNE.OR.TEMX.LT.0.2D0) MEEV=0 - ENDIF - IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0) THEN - MEEV=2 - TEMX=TCMX - FWTE=1D0 - ENDIF - IF(MCEV.EQ.0.AND.MEEV.EQ.0) RETURN - -C...Loopback point in case of failure to reconstruct kinematics. - NS=N - LOOP=0 - 100 LOOP=LOOP+1 - IF(LOOP.GT.100) THEN - MINT(51)=1 - RETURN - ENDIF - N=NS - -C...Initial values: flavours, momenta, virtualities. - DO 120 JT=1,2 - MORE(JT)=1 - KFBEAM(JT)=MINT(10+JT) - IF(MINT(18+JT).EQ.1)KFBEAM(JT)=22 - KFLS(JT)=MINT(14+JT) - KFLS(JT+2)=KFLS(JT) - XS(JT)=VINT(40+JT) - IF(MINT(18+JT).EQ.1) XS(JT)=VINT(40+JT)/VINT(154+JT) - ZS(JT)=1D0 - Q2S(JT)=FCQ2MX*Q2MX - DQ2(JT)=0D0 - TEVCSV(JT)=TCMX - ALAM(JT)=PARP(61) - THE2(JT)=1D0 - TEVESV(JT)=TEMX - MCESV(JT)=0 -C...Calculate initial parton distribution weights. - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(XS(JT).LT.1D0-XEE) THEN - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XS(JT),Q2S(JT),XFB) - ELSE - CALL PYPDFL(KFBEAM(JT),XS(JT),Q2S(JT),XFB) - ENDIF - ENDIF - DO 110 KFL=-25,25 - XFS(JT,KFL)=XFB(KFL) - 110 CONTINUE -C...Special kinematics check for c/b quarks (that g -> c cbar or -C...b bbar kinematically possible). - KFLCB=IABS(KFLS(JT)) - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5)) THEN - IF(XS(JT).GT.0.9D0*Q2S(JT)/(PMAS(KFLCB,1)**2+Q2S(JT))) THEN - MINT(51)=1 - RETURN - ENDIF - ENDIF - 120 CONTINUE - DSH=VINT(44) - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) DSH=VINT(26)*VINT(2) - -C...Find if interference with final state partons. - MFIS=0 - IF(MSTP(67).GE.1.AND.MSTP(67).LE.3) MFIS=MSTP(67) - IF(MFIS.NE.0) THEN - DO 140 I=1,2 - KCFI(I)=0 - KCA=PYCOMP(IABS(KFLS(I))) - IF(KCA.NE.0) KCFI(I)=KCHG(KCA,2)*ISIGN(1,KFLS(I)) - NFIS(I)=0 - IF(KCFI(I).NE.0) THEN - IF(I.EQ.1) IPFS=IPUS1 - IF(I.EQ.2) IPFS=IPUS2 - DO 130 J=1,2 - ICSI=MOD(K(IPFS,3+J),MSTU(5)) - IF(ICSI.GT.0.AND.ICSI.NE.IPUS1.AND.ICSI.NE.IPUS2.AND. - & (KCFI(I).EQ.(-1)**(J+1).OR.KCFI(I).EQ.2)) THEN - NFIS(I)=NFIS(I)+1 - THEFIS(I,NFIS(I))=PYANGL(P(ICSI,3),SQRT(P(ICSI,1)**2+ - & P(ICSI,2)**2)) - IF(I.EQ.2) THEFIS(I,NFIS(I))=PARU(1)-THEFIS(I,NFIS(I)) - ENDIF - 130 CONTINUE - ENDIF - 140 CONTINUE - IF(NFIS(1)+NFIS(2).EQ.0) MFIS=0 - ENDIF - -C...Pick up leg with highest virtuality. - JTOLD=1 - 150 N=N+1 - JT=1 - IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 - IF(N.EQ.NS+2.AND.JT.EQ.JTOLD) JT=3-JT - IF(MORE(JT).EQ.0) JT=3-JT - JTOLD=JT - KFLB=KFLS(JT) - XB=XS(JT) - DO 160 KFL=-25,25 - XFB(KFL)=XFS(JT,KFL) - 160 CONTINUE - DSHR=2D0*SQRT(DSH) - DSHZ=DSH/ZS(JT) - -C...Check if allowed to branch. - MCEV=0 - IF(IABS(KFLB).LE.10.OR.KFLB.EQ.21) THEN - MCEV=1 - XEC=MAX(PARP(65)*DSHR/VINT(2),XB*(1D0/(1D0-PARP(66))-1D0)) - IF(XB.GE.1D0-2D0*XEC) MCEV=0 - ENDIF - MEEV=0 - IF(MINT(44+JT).EQ.3) THEN - MEEV=1 - IF(XB.GE.1D0-2D0*XEE) MEEV=0 - IF((IABS(KFLB).LE.10.OR.KFLB.EQ.21).AND.XB.GE.1D0-2D0*XEC) - & MEEV=0 -C***Currently kill QED shower for resolved photoproduction. - IF(MINT(18+JT).EQ.1) MEEV=0 -C***Currently kill shower for W inside electron. - IF(IABS(KFLB).EQ.24) THEN - MCEV=0 - MEEV=0 - ENDIF - ENDIF - IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0.AND.IABS(KFLB).LE.10) - &MEEV=2 - IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN - Q2B=0D0 - GOTO 260 - ENDIF - -C...Maximum Q2 with or without Q2 ordering. Effective Lambda and n_f. - Q2B=Q2S(JT) - TEVCB=TEVCSV(JT) - TEVEB=TEVESV(JT) - IF(MSTP(62).LE.1) THEN - IF(ZS(JT).GT.0.99999D0) THEN - Q2B=Q2S(JT) - ELSE - Q2B=0.5D0*(1D0/ZS(JT)+1D0)*Q2S(JT)+0.5D0*(1D0/ZS(JT)-1D0)* - & (Q2S(3-JT)-DSH+SQRT((DSH+Q2S(1)+Q2S(2))**2+ - & 8D0*Q2S(1)*Q2S(2)*ZS(JT)/(1D0-ZS(JT)))) - ENDIF - IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) - ENDIF - IF(MCEV.EQ.1) THEN - ALSDUM=PYALPS(FQ2C*Q2B) - TEVCB=TEVCB+2D0*LOG(ALAM(JT)/PARU(117)) - ALAM(JT)=PARU(117) - B0=(33D0-2D0*MSTU(118))/6D0 - ENDIF - IF(MEEV.EQ.2) TEVEB=TEVCB - TEVCBS=TEVCB - TEVEBS=TEVEB - -C...Select side for interference with final state partons. - IF(MFIS.GE.1.AND.N.LE.NS+2) THEN - IFI=N-NS - ISFI(IFI)=0 - IF(IABS(KCFI(IFI)).EQ.1.AND.NFIS(IFI).EQ.1) THEN - ISFI(IFI)=1 - ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.1) THEN - IF(PYR(0).GT.0.5D0) ISFI(IFI)=1 - ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.2) THEN - ISFI(IFI)=1 - IF(PYR(0).GT.0.5D0) ISFI(IFI)=2 - ENDIF - ENDIF - -C...Calculate preweighting factor for ME-corrected processes. - IF(MECOR.GE.1) CALL PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) - -C...Calculate Altarelli-Parisi weights. - DO 170 KFL=-25,25 - WTAPC(KFL)=0D0 - WTAPE(KFL)=0D0 - WTSF(KFL)=0D0 - 170 CONTINUE -C...q -> q (g or gamma emission), g -> q. - IF(IABS(KFLB).LE.10) THEN - WTAPC(KFLB)=(8D0/3D0)*LOG((1D0-XEC-XB)*(XB+XEC)/(XEC*(1D0-XEC))) - WTAPC(21)=0.5D0*(XB/(XB+XEC)-XB/(1D0-XEC)) - EQ2=1D0/9D0 - IF(MOD(IABS(KFLB),2).EQ.0) EQ2=4D0*EQ2 - IF(MEEV.EQ.2) WTAPE(KFLB)=2.*EQ2*LOG((1D0-XEC-XB)*(XB+XEC)/ - & (XEC*(1D0-XEC))) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPC(KFLB)=WTFF*WTAPC(KFLB) - WTAPC(21)=WTGF*WTAPC(21) - WTAPE(KFLB)=WTFF*WTAPE(KFLB) - ENDIF -C...f -> f, gamma -> f. - ELSEIF(IABS(KFLB).LE.20) THEN - WTAPF1=LOG((1D0-XEE-XB)*(XB+XEE)/(XEE*(1D0-XEE))) - WTAPF2=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE))) - WTAPE(KFLB)=2D0*(WTAPF1+WTAPF2) - IF(MSTP(12).GE.1) WTAPE(22)=XB/(XB+XEE)-XB/(1D0-XEE) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPE(KFLB)=WTFF*WTAPE(KFLB) - WTAPE(22)=WTGF*WTAPE(22) - ENDIF -C...f -> g, g -> g. - ELSEIF(KFLB.EQ.21) THEN - WTAPQ=(16D0/3D0)*(SQRT((1D0-XEC)/XB)-SQRT((XB+XEC)/XB)) - DO 180 KFL=1,MSTP(58) - WTAPC(KFL)=WTAPQ - WTAPC(-KFL)=WTAPQ - 180 CONTINUE - WTAPC(21)=6D0*LOG((1D0-XEC-XB)/XEC) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - DO 190 KFL=1,MSTP(58) - WTAPC(KFL)=WTFG*WTAPC(KFL) - WTAPC(-KFL)=WTFG*WTAPC(-KFL) - 190 CONTINUE - WTAPC(21)=WTGG*WTAPC(21) - ENDIF -C...f -> gamma, W+, W-. - ELSEIF(KFLB.EQ.22) THEN - WTAPF=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE)))/XB - WTAPE(11)=WTAPF - WTAPE(-11)=WTAPF - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPE(11)=WTFG*WTAPE(11) - WTAPE(-11)=WTFG*WTAPE(-11) - ENDIF - ELSEIF(KFLB.EQ.24) THEN - WTAPE(-11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ - & (XEE*(XB+XEE)))/XB - ELSEIF(KFLB.EQ.-24) THEN - WTAPE(11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ - & (XEE*(XB+XEE)))/XB - ENDIF - -C...Calculate parton distribution weights and sum. - NTRY=0 - 200 NTRY=NTRY+1 - IF(NTRY.GT.500) THEN - MINT(51)=1 - RETURN - ENDIF - WTSUMC=0D0 - WTSUME=0D0 - XFBO=MAX(1D-10,XFB(KFLB)) - DO 210 KFL=-25,25 - WTSF(KFL)=XFB(KFL)/XFBO - WTSUMC=WTSUMC+WTAPC(KFL)*WTSF(KFL) - WTSUME=WTSUME+WTAPE(KFL)*WTSF(KFL) - 210 CONTINUE - WTSUMC=MAX(0.0001D0,WTSUMC) - WTSUME=MAX(0.0001D0/FWTE,WTSUME) - -C...Choose new t: fix alpha_s, alpha_s(Q^2), alpha_s(k_T^2). - NTRY2=0 - 220 NTRY2=NTRY2+1 - IF(NTRY2.GT.500) THEN - MINT(51)=1 - RETURN - ENDIF - IF(MCEV.EQ.1) THEN - IF(MSTP(64).LE.0) THEN - TEVCB=TEVCB+LOG(PYR(0))*PARU(2)/(PARU(111)*WTSUMC) - ELSEIF(MSTP(64).EQ.1) THEN - TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/WTSUMC)) - ELSE - TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/(5D0*WTSUMC))) - ENDIF - ENDIF - IF(MEEV.EQ.1) THEN - TEVEB=TEVEB*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ - & (PARU(101)*FWTE*WTSUME*TEMX))) - ELSEIF(MEEV.EQ.2) THEN - TEVEB=TEVEB+LOG(PYR(0))*PARU(2)/(PARU(101)*WTSUME) - ENDIF - -C...Translate t into Q2 scale; choose between QCD and QED evolution. - 230 IF(MCEV.EQ.1) Q2CB=ALAM(JT)**2*EXP(MAX(-50D0,TEVCB))/FQ2C - IF(MEEV.EQ.1) Q2EB=SPME*EXP(MAX(-50D0,TEVEB)) - IF(MEEV.EQ.2) Q2EB=ALAM(JT)**2*EXP(MAX(-50D0,TEVEB))/FQ2C -C...Ensure that Q2 is above threshold for charm/bottom. - KFLCB=IABS(KFLB) - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. - &MCEV.EQ.1) THEN - IF(Q2CB.LT.PMAS(KFLCB,1)**2) THEN - Q2CB=1.1D0*PMAS(KFLCB,1)**2 - TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - FCQ2MX=MIN(2D0,1.05D0*FCQ2MX) - ENDIF - ENDIF - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. - &MEEV.EQ.2) THEN - IF(Q2EB.LT.PMAS(KFLCB,1)**2) MEEV=0 - ENDIF - MCE=0 - IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN - ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.0) THEN - IF(Q2CB.GT.Q2MNCS(JT)) MCE=1 - ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.1) THEN - IF(Q2EB.GT.Q2MNE) MCE=2 - ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.2) THEN - IF(Q2EB.GT.Q2MNCS(JT)) MCE=2 - ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.2) THEN - IF(Q2CB.GT.Q2EB.AND.Q2CB.GT.Q2MNCS(JT)) MCE=1 - IF(Q2EB.GT.Q2CB.AND.Q2EB.GT.Q2MNCS(JT)) MCE=2 - ELSEIF(Q2MNCS(JT).GT.Q2MNE) THEN - MCE=1 - IF(Q2EB.GT.Q2CB.OR.Q2CB.LE.Q2MNCS(JT)) MCE=2 - IF(MCE.EQ.2.AND.Q2EB.LE.Q2MNE) MCE=0 - ELSE - MCE=2 - IF(Q2CB.GT.Q2EB.OR.Q2EB.LE.Q2MNE) MCE=1 - IF(MCE.EQ.1.AND.Q2CB.LE.Q2MNCS(JT)) MCE=0 - ENDIF - -C...Evolution possibly ended. Update t values. - IF(MCE.EQ.0) THEN - Q2B=0D0 - GOTO 260 - ELSEIF(MCE.EQ.1) THEN - Q2B=Q2CB - Q2REF=FQ2C*Q2B - IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) - IF(MEEV.EQ.2) TEVEB=LOG(FQ2C*Q2B/ALAM(JT)**2) - ELSE - Q2B=Q2EB - Q2REF=Q2B - IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - ENDIF - -C...Select flavour for branching parton. - IF(MCE.EQ.1) WTRAN=PYR(0)*WTSUMC - IF(MCE.EQ.2) WTRAN=PYR(0)*WTSUME - KFLA=-25 - 240 KFLA=KFLA+1 - IF(MCE.EQ.1) WTRAN=WTRAN-WTAPC(KFLA)*WTSF(KFLA) - IF(MCE.EQ.2) WTRAN=WTRAN-WTAPE(KFLA)*WTSF(KFLA) - IF(KFLA.LE.24.AND.WTRAN.GT.0D0) GOTO 240 - IF(KFLA.EQ.25) THEN - Q2B=0D0 - GOTO 260 - ENDIF - -C...Choose z value and corrective weight. - WTZ=0D0 -C...q -> q + g or q -> q + gamma. - IF(IABS(KFLA).LE.10.AND.IABS(KFLB).LE.10) THEN - Z=1D0-((1D0-XB-XEC)/(1D0-XEC))* - & (XEC*(1D0-XEC)/((XB+XEC)*(1D0-XB-XEC)))**PYR(0) - WTZ=0.5D0*(1D0+Z**2) -C...q -> g + q. - ELSEIF(IABS(KFLA).LE.10.AND.KFLB.EQ.21) THEN - Z=XB/(SQRT(XB+XEC)+PYR(0)*(SQRT(1D0-XEC)-SQRT(XB+XEC)))**2 - WTZ=0.5D0*(1D0+(1D0-Z)**2)*SQRT(Z) -C...f -> f + gamma. - ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN - IF(WTAPF1.GT.PYR(0)*(WTAPF1+WTAPF2)) THEN - Z=1D0-((1D0-XB-XEE)/(1D0-XEE))* - & (XEE*(1D0-XEE)/((XB+XEE)*(1D0-XB-XEE)))**PYR(0) - ELSE - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - ENDIF - WTZ=0.5D0*(1D0+Z**2)*(Z-XB)/(1D0-XB) -C...f -> gamma + f. - ELSEIF(IABS(KFLA).LE.20.AND.KFLB.EQ.22) THEN - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - WTZ=0.5D0*(1D0+(1D0-Z)**2)*XB*(Z-XB)/Z -C...f -> W+- + f. - ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).EQ.24) THEN - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - WTZ=0.5D0*(1D0+(1D0-Z)**2)*(XB*(Z-XB)/Z)* - & (Q2B/(Q2B+PMAS(24,1)**2)) -C...g -> q + qbar. - ELSEIF(KFLA.EQ.21.AND.IABS(KFLB).LE.10) THEN - Z=XB/(1D0-XEC)+PYR(0)*(XB/(XB+XEC)-XB/(1D0-XEC)) - WTZ=1D0-2D0*Z*(1D0-Z) -C...g -> g + g. - ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN - Z=1D0/(1D0+((1D0-XEC-XB)/XB)*(XEC/(1D0-XEC-XB))**PYR(0)) - WTZ=(1D0-Z*(1D0-Z))**2 -C...gamma -> f + fbar. - ELSEIF(KFLA.EQ.22.AND.IABS(KFLB).LE.20) THEN - Z=XB/(1D0-XEE)+PYR(0)*(XB/(XB+XEE)-XB/(1D0-XEE)) - WTZ=1D0-2D0*Z*(1D0-Z) - ENDIF - IF(MCE.EQ.2.AND.MEEV.EQ.1) WTZ=(WTZ/FWTE)*(TEVEB/TEMX) - -C...Option with resummation of soft gluon emission as effective z shift. - IF(MCE.EQ.1) THEN - IF(MSTP(65).GE.1) THEN - RSOFT=6D0 - IF(KFLB.NE.21) RSOFT=8D0/3D0 - Z=Z*(TEVCB/TEVCSV(JT))**(RSOFT*XEC/((XB+XEC)*B0)) - IF(Z.LE.XB) GOTO 220 - ENDIF - -C...Option with alpha_s(k_T^2): demand k_T^2 > cutoff, reweight. - IF(MSTP(64).GE.2) THEN - IF((1D0-Z)*Q2B.LT.Q2MNCS(JT)) GOTO 220 - ALPRAT=TEVCB/(TEVCB+LOG(1D0-Z)) - IF(ALPRAT.LT.5D0*PYR(0)) GOTO 220 - IF(ALPRAT.GT.5D0) WTZ=WTZ*ALPRAT/5D0 - ENDIF - ENDIF - -C...Remove kinematically impossible branchings. - UHAT=Q2B-DSH*(1D0-Z)/Z - IF(MSTP(68).GE.0.AND.UHAT.GT.0D0) GOTO 220 - -C...Select phi angle of branching at random. - PHIBR=PARU(2)*PYR(0) - -C...Matrix-element corrections for some processes. - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - IF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN - CALL PYMEWT(MECOR,1,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTFF - ELSEIF((KFLA.EQ.21.OR.KFLA.EQ.22).AND.IABS(KFLB).LE.20) THEN - CALL PYMEWT(MECOR,2,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTGF - ELSEIF(IABS(KFLA).LE.20.AND.(KFLB.EQ.21.OR.KFLB.EQ.22)) THEN - CALL PYMEWT(MECOR,3,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTFG - ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN - CALL PYMEWT(MECOR,4,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTGG - ENDIF - ENDIF - -C...Impose angular constraint in first branching from interference -C...with final state partons. - IF(MCE.EQ.1) THEN - IF(MFIS.GE.1.AND.N.LE.NS+2.AND.NTRY2.LT.200) THEN - THE2D=(4D0*Q2B)/(DSH*(1D0-Z)) - IF(N.EQ.NS+1.AND.ISFI(1).GE.1) THEN - IF(THE2D.GT.THEFIS(1,ISFI(1))**2) GOTO 220 - ELSEIF(N.EQ.NS+2.AND.ISFI(2).GE.1) THEN - IF(THE2D.GT.THEFIS(2,ISFI(2))**2) GOTO 220 - ENDIF - ENDIF - -C...Option with angular ordering requirement. - IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THEN - THE2T=(4D0*Z**2*Q2B)/(4D0*Z**2*Q2B+(1D0-Z)*XB**2*VINT(2)) - IF(THE2T.GT.THE2(JT)) GOTO 220 - ENDIF - ENDIF - -C...Weighting with new parton distributions. - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XB,Q2REF,XFN) - ELSE - CALL PYPDFL(KFBEAM(JT),XB,Q2REF,XFN) - ENDIF - XFBN=XFN(KFLB) - IF(XFBN.LT.1D-20) THEN - IF(KFLA.EQ.KFLB) THEN - TEVCB=TEVCBS - TEVEB=TEVEBS - WTAPC(KFLB)=0D0 - WTAPE(KFLB)=0D0 - GOTO 200 - ELSEIF(MCE.EQ.1.AND.TEVCBS-TEVCB.GT.0.2D0) THEN - TEVCB=0.5D0*(TEVCBS+TEVCB) - GOTO 230 - ELSEIF(MCE.EQ.2.AND.TEVEBS-TEVEB.GT.0.2D0) THEN - TEVEB=0.5D0*(TEVEBS+TEVEB) - GOTO 230 - ELSE - XFBN=1D-10 - XFN(KFLB)=XFBN - ENDIF - ENDIF - DO 250 KFL=-25,25 - XFB(KFL)=XFN(KFL) - 250 CONTINUE - XA=XB/Z - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XA,Q2REF,XFA) - ELSE - CALL PYPDFL(KFBEAM(JT),XA,Q2REF,XFA) - ENDIF - XFAN=XFA(KFLA) - IF(XFAN.LT.1D-20) GOTO 200 - WTSFA=WTSF(KFLA) - IF(WTZ*XFAN/XFBN.LT.PYR(0)*WTSFA) GOTO 200 - -C...Define two hard scatterers in their CM-frame. - 260 IF(N.EQ.NS+2) THEN - DQ2(JT)=Q2B - DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR - DO 280 JR=1,2 - I=NS+JR - IF(JR.EQ.1) IPO=IPUS1 - IF(JR.EQ.2) IPO=IPUS2 - DO 270 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 270 CONTINUE - K(I,1)=14 - K(I,2)=KFLS(JR+2) - K(I,4)=IPO - K(I,5)=IPO - P(I,3)=DPLCM*(-1)**(JR+1) - P(I,4)=(DSH+DQ2(3-JR)-DQ2(JR))/DSHR - P(I,5)=-SQRT(DQ2(JR)) - K(IPO,1)=14 - K(IPO,3)=I - K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I - K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I - 280 CONTINUE - -C...Find maximum allowed mass of timelike parton. - ELSEIF(N.GT.NS+2) THEN - JR=3-JT - DQ2(3)=Q2B - DPC(1)=P(IS(1),4) - DPC(2)=P(IS(2),4) - DPC(3)=0.5D0*(ABS(P(IS(1),3))+ABS(P(IS(2),3))) - DPD(1)=DSH+DQ2(JR)+DQ2(JT) - DPD(2)=DSHZ+DQ2(JR)+DQ2(3) - DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT)) - DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3)) - IKIN=0 - IF(Q2S(JR).GE.0.25D0*Q2MNC.AND.DPD(1)-DPD(3).GE. - & 1D-10*DPD(1)) IKIN=1 - IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/ZS(JT)-DQ2(3))* - & (DSH/(DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3))) - IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/ - & (2D0*DQ2(JR))-DQ2(JT)-DQ2(3) - -C...Generate timelike parton shower (if required). - IT=N - DO 290 J=1,5 - K(IT,J)=0 - P(IT,J)=0D0 - V(IT,J)=0D0 - 290 CONTINUE -C...f -> f + g (gamma). - IF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).LE.20) THEN - K(IT,2)=21 - IF(MCESV(JT).EQ.2.OR.IABS(KFLB).GE.11) K(IT,2)=22 -C...f -> g (gamma, W+-) + f. - ELSEIF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).GT.20) THEN - K(IT,2)=KFLB - IF(KFLS(JT+2).EQ.24) THEN - K(IT,2)=-12 - ELSEIF(KFLS(JT+2).EQ.-24) THEN - K(IT,2)=12 - ENDIF -C...g (gamma) -> f + fbar, g + g. - ELSE - K(IT,2)=-KFLS(JT+2) - IF(KFLS(JT+2).GT.20) K(IT,2)=KFLS(JT+2) - ENDIF - K(IT,1)=3 - IF((IABS(K(IT,2)).GE.11.AND.IABS(K(IT,2)).LE.18).OR. - & IABS(K(IT,2)).EQ.22) K(IT,1)=1 - P(IT,5)=PYMASS(K(IT,2)) - IF(DMSMA.LE.P(IT,5)**2) GOTO 100 - IF(MSTP(63).GE.1.AND.MCESV(JT).EQ.1) THEN - MSTJ48=MSTJ(48) - PARJ85=PARJ(85) - P(IT,4)=(DSHZ-DSH-P(IT,5)**2)/DSHR - P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2) - IF(MSTP(63).EQ.1) THEN - Q2TIM=DMSMA - ELSEIF(MSTP(63).EQ.2) THEN - Q2TIM=MIN(DMSMA,PARP(71)*Q2S(JT)) - ELSE - Q2TIM=DMSMA - MSTJ(48)=1 - IF(IKIN.EQ.0) DPT2=DMSMA*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) - IF(IKIN.EQ.1) DPT2=DMSMA*(0.5D0*DPD(1)*DPD(2)+0.5D0*DPD(3)* - & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)))/(4D0*DSH*DPC(3)**2) - PARJ(85)=SQRT(MAX(0D0,DPT2))* - & (1D0/P(IT,4)+1D0/P(IS(JT),4)) - ENDIF - CALL PYSHOW(IT,0,SQRT(Q2TIM)) - MSTJ(48)=MSTJ48 - PARJ(85)=PARJ85 - IF(N.GE.IT+1) P(IT,5)=P(IT+1,5) - ENDIF - -C...Reconstruct kinematics of branching: timelike parton shower. - DMS=P(IT,5)**2 - IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) - IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5D0*DPD(1)*DPD(2)+ - & 0.5D0*DPD(3)*DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/ - & (4D0*DSH*DPC(3)**2) - IF(DPT2.LT.0D0) GOTO 100 - DPB(1)=(0.5D0*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/ - & DSHR)/DPC(3)-DPC(3) - P(IT,1)=SQRT(DPT2) - P(IT,3)=DPB(1)*(-1)**(JT+1) - P(IT,4)=SQRT(DPT2+DPB(1)**2+DMS) - IF(N.GE.IT+1) THEN - DPB(1)=SQRT(DPB(1)**2+DPT2) - DPB(2)=SQRT(DPB(1)**2+DMS) - DPB(3)=P(IT+1,3) - DPB(4)=SQRT(DPB(3)**2+DMS) - DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)* - & DPB(1)) - CALL PYROBO(IT+1,N,0D0,0D0,0D0,0D0,DBEZ) - THE=PYANGL(P(IT,3),P(IT,1)) - CALL PYROBO(IT+1,N,THE,0D0,0D0,0D0,0D0) - ENDIF - -C...Reconstruct kinematics of branching: spacelike parton. - DO 300 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 300 CONTINUE - K(N+1,1)=14 - K(N+1,2)=KFLB - P(N+1,1)=P(IT,1) - P(N+1,3)=P(IT,3)+P(IS(JT),3) - P(N+1,4)=P(IT,4)+P(IS(JT),4) - P(N+1,5)=-SQRT(DQ2(3)) - -C...Define colour flow of branching. - K(IS(JT),3)=N+1 - K(IT,3)=N+1 - IM1=N+1 - IM2=N+1 -C...f -> f + gamma (Z, W). - IF(IABS(K(IT,2)).GE.22) THEN - K(IT,1)=1 - ID1=IS(JT) - ID2=IS(JT) -C...f -> gamma (Z, W) + f. - ELSEIF(IABS(K(IS(JT),2)).GE.22) THEN - ID1=IT - ID2=IT -C...gamma -> q + qbar, g + g. - ELSEIF(K(N+1,2).EQ.22) THEN - ID1=IS(JT) - ID2=IT - IM1=ID2 - IM2=ID1 -C...q -> q + g. - ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(IT,2).EQ.21) THEN - ID1=IT - ID2=IS(JT) -C...q -> g + q. - ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21) THEN - ID1=IS(JT) - ID2=IT -C...qbar -> qbar + g. - ELSEIF(K(N+1,2).LT.0.AND.K(IT,2).EQ.21) THEN - ID1=IS(JT) - ID2=IT -C...qbar -> g + qbar. - ELSEIF(K(N+1,2).LT.0) THEN - ID1=IT - ID2=IS(JT) -C...g -> g + g; g -> q + qbar. - ELSEIF((K(IT,2).EQ.21.AND.PYR(0).GT.0.5D0).OR.K(IT,2).LT.0) THEN - ID1=IS(JT) - ID2=IT - ELSE - ID1=IT - ID2=IS(JT) - ENDIF - IF(IM1.EQ.N+1) K(IM1,4)=K(IM1,4)+ID1 - IF(IM2.EQ.N+1) K(IM2,5)=K(IM2,5)+ID2 - K(ID1,4)=K(ID1,4)+MSTU(5)*IM1 - K(ID2,5)=K(ID2,5)+MSTU(5)*IM2 - IF(ID1.NE.ID2) THEN - K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 - K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 - ENDIF - N=N+1 - IF(K(IT,1).EQ.1) THEN - K(IT,4)=0 - K(IT,5)=0 - ENDIF - -C...Boost to new CM-frame. - DBSVX=(P(N,1)+P(IS(JR),1))/(P(N,4)+P(IS(JR),4)) - DBSVZ=(P(N,3)+P(IS(JR),3))/(P(N,4)+P(IS(JR),4)) - IF(DBSVX**2+DBSVZ**2.GE.1D0) GOTO 100 - CALL PYROBO(NS+1,N,0D0,0D0,-DBSVX,0D0,-DBSVZ) - IR=N+(JT-1)*(IS(1)-N) - CALL PYROBO(NS+1,N,-PYANGL(P(IR,3),P(IR,1)),DPHI(JT), - & 0D0,0D0,0D0) - ENDIF - -C...Update kinematics variables. - IS(JT)=N - DQ2(JT)=Q2B - IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THE2(JT)=THE2T - DSH=DSHZ - -C...Save quantities; loop back. - Q2S(JT)=Q2B - DPHI(JT)=PHIBR - MCESV(JT)=MCE - IF((MCEV.EQ.1.AND.Q2B.GE.0.25D0*Q2MNC).OR. - &(MEEV.EQ.1.AND.Q2B.GE.Q2MNE)) THEN - KFLS(JT+2)=KFLS(JT) - KFLS(JT)=KFLA - XS(JT)=XA - ZS(JT)=Z - DO 310 KFL=-25,25 - XFS(JT,KFL)=XFA(KFL) - 310 CONTINUE - TEVCSV(JT)=TEVCB - TEVESV(JT)=TEVEB - ELSE - MORE(JT)=0 - IF(JT.EQ.1) IPU1=N - IF(JT.EQ.2) IPU2=N - ENDIF - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSSPA:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) N=NS - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MORE(1).EQ.1.OR.MORE(2).EQ.1) GOTO 150 - -C...Boost hard scattering partons to frame of shower initiators. - DO 320 J=1,3 - ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) - 320 CONTINUE - K(N+2,1)=1 - DO 330 J=1,5 - P(N+2,J)=P(NS+1,J) - 330 CONTINUE - CALL PYROBO(N+2,N+2,0D0,0D0,-ROBO(3),-ROBO(4),-ROBO(5)) - ROBO(2)=PYANGL(P(N+2,1),P(N+2,2)) - ROBO(1)=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) - CALL PYROBO(MINT(83)+5,NS,0D0,-ROBO(2),0D0,0D0,0D0) - CALL PYROBO(MINT(83)+5,NS,ROBO(1),ROBO(2),ROBO(3),ROBO(4), - &ROBO(5)) - -C...Store user information. Reset Lambda value. - K(IPU1,3)=MINT(83)+3 - K(IPU2,3)=MINT(83)+4 - DO 340 JT=1,2 - MINT(12+JT)=KFLS(JT) - VINT(140+JT)=XS(JT) - IF(MINT(18+JT).EQ.1) VINT(140+JT)=VINT(154+JT)*XS(JT) - 340 CONTINUE - PARU(112)=ALAMS - - RETURN - END - -C*********************************************************************** - -C...PYSTAT -C...Prints out information about cross-sections, decay widths, branching -C...ratios, kinematical limits, status codes and parameter values. - - SUBROUTINE PYSTAT(MSTAT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - PARAMETER (EPS=1D-3) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28, CHTMP*16 - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/,/PYMSRV/ -C...Local arrays, character variables and data. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),NMODES(0:20),PBRAT(10) - CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16, - &CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28, - &PROGG9(13)*28,PROGG4(4)*28,PROGG2(2)*28,PROGP4(4)*28 - CHARACTER*24 CHD0, CHDC(10) - CHARACTER*6 DNAME(3) - DATA PROGA/ - &'VMD/hadron * VMD ','VMD/hadron * direct ', - &'VMD/hadron * anomalous ','direct * direct ', - &'direct * anomalous ','anomalous * anomalous '/ - DATA DISGA/'e * VMD','e * anomalous'/ - DATA PROGG9/ - &'direct * direct ','direct * VMD ', - &'direct * anomalous ','VMD * direct ', - &'VMD * VMD ','VMD * anomalous ', - &'anomalous * direct ','anomalous * VMD ', - &'anomalous * anomalous ','DIS * VMD ', - &'DIS * anomalous ','VMD * DIS ', - &'anomalous * DIS '/ - DATA PROGG4/ - &'direct * direct ','direct * resolved ', - &'resolved * direct ','resolved * resolved '/ - DATA PROGG2/ - &'direct * hadron ','resolved * hadron '/ - DATA PROGP4/ - &'VMD * hadron ','direct * hadron ', - &'anomalous * hadron ','DIS * hadron '/ - DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/, - &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ', - &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ', - &' y*_small ',' eta*_large ',' eta*_small ', - &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ', - &' x_2 ',' x_F ',' cos(theta_hard) ', - &'m''_hard (GeV/c^2) ',' tau ',' y* ', - &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ', - &' tau'' '/ - DATA DNAME /'q ','lepton','nu '/ - -C...Cross-sections. - IF(MSTAT.LE.1) THEN - IF(MINT(121).GT.1) CALL PYSAVE(5,0) - WRITE(MSTU(11),5000) - WRITE(MSTU(11),5100) - WRITE(MSTU(11),5200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3) - DO 100 I=1,500 - IF(MSUB(I).NE.1) GOTO 100 - WRITE(MSTU(11),5200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3) - 100 CONTINUE - IF(MINT(121).GT.1) THEN - WRITE(MSTU(11),5300) - DO 110 IGA=1,MINT(121) - CALL PYSAVE(3,IGA) - IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN - WRITE(MSTU(11),5200) IGA,DISGA(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - WRITE(MSTU(11),5200) IGA,PROGG9(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.30) THEN - WRITE(MSTU(11),5200) IGA,PROGP4(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.4) THEN - WRITE(MSTU(11),5200) IGA,PROGG4(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.2) THEN - WRITE(MSTU(11),5200) IGA,PROGG2(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSE - WRITE(MSTU(11),5200) IGA,PROGA(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ENDIF - 110 CONTINUE - CALL PYSAVE(5,0) - ENDIF - WRITE(MSTU(11),5400) 1D0-DBLE(NGEN(0,3))/ - & MAX(1D0,DBLE(NGEN(0,2))) - -C...Decay widths and branching ratios. - ELSEIF(MSTAT.EQ.2) THEN - WRITE(MSTU(11),5500) - WRITE(MSTU(11),5600) - DO 140 KC=1,500 - KF=KCHG(KC,4) - CALL PYNAME(KF,CHKF) - IOFF=0 - IF(KC.LE.22) THEN - IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140 - IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140 - IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1 - IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1 - IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1 - ELSE - IF(MWID(KC).LE.0) GOTO 140 - IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR. - & KF/KSUSY1.EQ.2)) GOTO 140 - ENDIF -C...Off-shell branchings. - IF(IOFF.EQ.1) THEN - NGP=0 - IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2 - IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10), - & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0 - DO 120 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - NGP1=0 - IF(IABS(KFDP(IDC,1)).LE.20) NGP1= - & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 - NGP2=0 - IF(IABS(KFDP(IDC,2)).LE.20) NGP2= - & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 - CALL PYNAME(KFDP(IDC,1),CHD1) - CALL PYNAME(KFDP(IDC,2),CHD2) - IF(KFDP(IDC,3).EQ.0) THEN - IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. - & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10), - & CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 - ELSE - CALL PYNAME(KFDP(IDC,3),CHD3) - IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. - & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5900) IDC,CHD1(1:10), - & CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 - ENDIF - 120 CONTINUE -C...On-shell decays. - ELSE - CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) - BRFIN=1D0 - IF(WDTE(0,0).LE.0D0) BRFIN=0D0 - WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0, - & STATE(MDCY(KC,1)),BRFIN - DO 130 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - NGP1=0 - IF(IABS(KFDP(IDC,1)).LE.20) NGP1= - & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 - NGP2=0 - IF(IABS(KFDP(IDC,2)).LE.20) NGP2= - & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 - BRPRI=0D0 - IF(WDTP(0).GT.0D0) BRPRI=WDTP(J)/WDTP(0) - BRFIN=0D0 - IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0) - CALL PYNAME(KFDP(IDC,1),CHD1) - CALL PYNAME(KFDP(IDC,2),CHD2) - IF(KFDP(IDC,3).EQ.0) THEN - IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) - & WRITE(MSTU(11),5800) IDC,CHD1(1:10), - & CHD2(1:10),WDTP(J),BRPRI, - & STATE(MDME(IDC,1)),BRFIN - ELSE - CALL PYNAME(KFDP(IDC,3),CHD3) - IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) - & WRITE(MSTU(11),5900) IDC,CHD1(1:10), - & CHD2(1:10),CHD3(1:10),WDTP(J),BRPRI, - & STATE(MDME(IDC,1)),BRFIN - ENDIF - 130 CONTINUE - ENDIF - 140 CONTINUE - WRITE(MSTU(11),6000) - -C...Allowed incoming partons/particles at hard interaction. - ELSEIF(MSTAT.EQ.3) THEN - WRITE(MSTU(11),6100) - CALL PYNAME(MINT(11),CHAU) - CHIN(1)=CHAU(1:12) - CALL PYNAME(MINT(12),CHAU) - CHIN(2)=CHAU(1:12) - WRITE(MSTU(11),6200) CHIN(1),CHIN(2) - DO 150 I=-20,22 - IF(I.EQ.0) GOTO 150 - IA=IABS(I) - IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150 - IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150 - CALL PYNAME(I,CHAU) - WRITE(MSTU(11),6300) CHAU,STATE(KFIN(1,I)),CHAU, - & STATE(KFIN(2,I)) - 150 CONTINUE - WRITE(MSTU(11),6400) - -C...User-defined limits on kinematical variables. - ELSEIF(MSTAT.EQ.4) THEN - WRITE(MSTU(11),6500) - WRITE(MSTU(11),6600) - SHRMAX=CKIN(2) - IF(SHRMAX.LT.0D0) SHRMAX=VINT(1) - WRITE(MSTU(11),6700) CKIN(1),CHKIN(1),SHRMAX - PTHMIN=MAX(CKIN(3),CKIN(5)) - PTHMAX=CKIN(4) - IF(PTHMAX.LT.0D0) PTHMAX=0.5D0*SHRMAX - WRITE(MSTU(11),6800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX - WRITE(MSTU(11),6900) CHKIN(3),CKIN(6) - DO 160 I=4,14 - WRITE(MSTU(11),6700) CKIN(2*I-1),CHKIN(I),CKIN(2*I) - 160 CONTINUE - SPRMAX=CKIN(32) - IF(SPRMAX.LT.0D0) SPRMAX=VINT(1) - WRITE(MSTU(11),6700) CKIN(31),CHKIN(15),SPRMAX - WRITE(MSTU(11),7000) - -C...Status codes and parameter values. - ELSEIF(MSTAT.EQ.5) THEN - WRITE(MSTU(11),7100) - WRITE(MSTU(11),7200) - DO 170 I=1,100 - WRITE(MSTU(11),7300) I,MSTP(I),PARP(I),100+I,MSTP(100+I), - & PARP(100+I) - 170 CONTINUE - -C...List of all processes implemented in the program. - ELSEIF(MSTAT.EQ.6) THEN - WRITE(MSTU(11),7400) - WRITE(MSTU(11),7500) - DO 180 I=1,500 - IF(ISET(I).LT.0) GOTO 180 - WRITE(MSTU(11),7600) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2) - 180 CONTINUE - WRITE(MSTU(11),7700) - - ELSEIF(MSTAT.EQ.7) THEN - WRITE (MSTU(11),8000) - NMODES(0)=0 - NMODES(10)=0 - NMODES(9)=0 - DO 290 ILR=1,2 - DO 280 KFSM=1,16 - KFSUSY=ILR*KSUSY1+KFSM - NRVDC=0 -C...SDOWN DECAYS - IF (KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5) THEN - NRVDC=3 - DO 190 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 190 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(1) - CHDC(2)=DNAME(2) // ' + ' // DNAME(1) - CHDC(3)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 200 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 200 CONTINUE - ENDIF -C...SUP DECAYS - IF (KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6) THEN - NRVDC=2 - DO 210 I=1,NRVDC - NMODES(I)=0 - PBRAT(I)=0D0 - 210 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(2) // ' + ' // DNAME(1) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 220 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 220 CONTINUE - ENDIF -C...SLEPTON DECAYS - IF (KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15) THEN - NRVDC=2 - DO 230 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 230 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(2) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 240 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 240 CONTINUE - ENDIF -C...SNEUTRINO DECAYS - IF ((KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16).AND.ILR.EQ.1) - & THEN - NRVDC=2 - DO 250 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 250 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(2) // ' + ' // DNAME(2) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 260 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - NMODES(2)=NMODES(2)+1 - PBRAT(2)=PBRAT(2)+BRAT(IDC) - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 260 CONTINUE - ENDIF - IF (NRVDC.NE.0) THEN - DO 270 I=1,NRVDC - WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) - NMODES(0)=NMODES(0)+NMODES(I) - 270 CONTINUE - ENDIF - 280 CONTINUE - 290 CONTINUE - DO 370 KFSM=21,37 - KFSUSY=KSUSY1+KFSM - NRVDC=0 -C...NEUTRALINO DECAYS - IF (KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN - NRVDC=4 - DO 300 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 300 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(2) // ' + ' // DNAME(2) - CHDC(2)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(3)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(4)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 310 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.11.OR - & .ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 310 CONTINUE - ENDIF -C...CHARGINO DECAYS - IF (KFSM.EQ.24.OR.KFSM.EQ.37) THEN - NRVDC=5 - DO 320 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 320 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(3) // ' + ' // DNAME(2) - CHDC(2)=DNAME(2) // ' + ' // DNAME(2) // ' + ' // DNAME(2) - CHDC(3)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(4)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(5)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 330 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.12.OR - & .ID3.EQ.14.OR.ID3.EQ.16)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.12.OR.ID2.EQ.14.OR.ID2.EQ.16).AND.(ID3.EQ - & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ - & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(5)=PBRAT(5)+BRAT(IDC) - NMODES(5)=NMODES(5)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(5)=PBRAT(5)+BRAT(IDC) - NMODES(5)=NMODES(5)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 330 CONTINUE - ENDIF -C...GLUINO DECAYS - IF (KFSM.EQ.21) THEN - NRVDC=3 - DO 340 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 340 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(2)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(3)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 350 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1.OR - & .ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 350 CONTINUE - ENDIF - - IF (NRVDC.NE.0) THEN - DO 360 I=1,NRVDC - WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) - NMODES(0)=NMODES(0)+NMODES(I) - 360 CONTINUE - ENDIF - 370 CONTINUE - WRITE (MSTU(11),8100) NMODES(0), NMODES(10), NMODES(9) - - IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - WRITE (MSTU(11),8500) - DO 400 IRV=1,3 - DO 390 JRV=1,3 - DO 380 KRV=1,3 - WRITE (MSTU(11),8700) IRV,JRV,KRV,RVLAM(IRV,JRV,KRV) - & ,RVLAMP(IRV,JRV,KRV),RVLAMB(IRV,JRV,KRV) - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - WRITE (MSTU(11),8600) - ENDIF - ENDIF - -C...Formats for printouts. - 5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ', - &'Events and Cross-sections',1X,9('*')) - 5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X, - &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X, - &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'), - &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X, - &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X, - &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X, - &'I',12X,'I') - 5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P, - &D10.3,1X,'I') - 5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/ - &1X,'I',34X,'I',28X,'I',12X,'I') - 5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')// - &1X,'********* Fraction of events that fail fragmentation ', - &'cuts =',1X,F8.5,' *********'/) - 5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ', - &'Ratios',1X,27('*')) - 5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ - &1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X, - &'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X, - &'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ - &1X,98('=')) - 5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X, - &I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X, - &'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I') - 5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X, - &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, - &1P,D10.3,0P,1X,'I') - 5900 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X, - &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, - &1P,D10.3,0P,1X,'I') - 6000 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('=')) - 6100 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/', - &'Particles at Hard Interaction',1X,7('*')) - 6200 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X, - &'Beam particle:',1X,A12,10X,'I',1X,'Target particle:',1X,A12,7X, - &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',6X,'State',19X, - &'I',1X,'Content',6X,'State',18X,'I'/1X,'I',38X,'I',37X,'I'/1X, - &78('=')/1X,'I',38X,'I',37X,'I') - 6300 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I') - 6400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('=')) - 6500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ', - &'Kinematical Variables',1X,12('*')) - 6600 FORMAT(/1X,78('=')/1X,'I',76X,'I') - 6700 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P, - &16X,'I') - 6800 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A, - &1X,'<',1X,1P,D10.3,0P,16X,'I') - 6900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I') - 7000 FORMAT(1X,'I',76X,'I'/1X,78('=')) - 7100 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ', - &'Parameter Values',1X,12('*')) - 7200 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X, - &'PARP(I)'/) - 7300 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3) - 7400 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes', - &1X,13('*')) - 7500 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X, - &'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X, - &'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I') - 7600 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I') - 7700 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('=')) - 8000 FORMAT(1X/ 1X/ - & 17X,'Sums over R-Violating branching ratios',1X/ 1X - & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I'/1X,'I',4X - & ,'Mother --> Sum over final state flavours',4X,'I',2X - & ,'BR(sum)',2X,'I',2X,'N',2X,'I'/1X,'I',50X,'I',11X,'I',5X,'I' - & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I') - 8100 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I'/1X,70('=')/1X,'I',1X - & ,'Total number of R-Violating modes :',3X,I5,24X,'I'/ - & 1X,'I',1X,'Total number with non-vanishing BR :',2X,I5,24X - & ,'I'/1X,'I',1X,'Total number with BR > 0.001 :',8X,I5,24X,'I' - & /1X,70('=')) - 8200 FORMAT(1X,'I',1X,A9,1X,'-->',1X,A24,11X, - & 'I',2X,1P,D8.2,0P,1X,'I',2X,I2,1X,'I') - 8300 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I') - 8500 FORMAT(1X/ 1X/ - & 1X,'R-Violating couplings',1X/ 1X / - & 1X,55('=')/ - & 1X,'I',1X,'IJK',1X,'I',2X,'LAMBDA(IJK)',2X,'I',2X - & ,'LAMBDA''(IJK)',1X,'I',1X,"LAMBDA''(IJK)",1X,'I'/1X,'I',5X - & ,'I',15X,'I',15X,'I',15X,'I') - 8600 FORMAT(1X,55('=')) - 8700 FORMAT(1X,'I',1X,I1,I1,I1,1X,'I',1X,1P,D13.3,0P,1X,'I',1X,1P - & ,D13.3,0P,1X,'I',1X,1P,D13.3,0P,1X,'I') - - RETURN - END - -C********************************************************************* - -C...PYSTBH (and auxiliaries) -C.. Evaluates the matrix elements for t + b + H production. - - SUBROUTINE PYSTBH(WTTBH) - -C...DOUBLE PRECISION AND INTEGER DECLARATIONS - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...COMMONBLOCKS - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - DOUBLE PRECISION MW2 - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSUBS/,/PYMSSM/,/PYSGCM/,/PYCTBH/ - -C...LOCAL ARRAYS AND COMPLEX VARIABLES - DIMENSION QQ(4,2),PP(4,3) - DATA QQ/8*0D0/ - -C...MASS PARAMETERS. - WTQQBH=0D0 - ISUB=MINT(1) - SHPR=SQRT(VINT(26))*VINT(1) - PH=SQRT(VINT(21))*VINT(1) - SPH=PH**2 - RMB=PYMRUN(5,VINT(44)) - -C...SET UP OUTGOING KINEMATICS: 1=T, 2=TBAR, 3=H. - DO 100 I=1,2 - PT=SQRT(MAX(0D0,VINT(197+5*I))) - PP(1,I)=PT*COS(VINT(198+5*I)) - PP(2,I)=PT*SIN(VINT(198+5*I)) - 100 CONTINUE - PP(1,3)=-PP(1,1)-PP(1,2) - PP(2,3)=-PP(2,1)-PP(2,2) - PMS1=VINT(201)**2+PP(1,1)**2+PP(2,1)**2 - PMS2=VINT(206)**2+PP(1,2)**2+PP(2,2)**2 - PMS3=SPH+PP(1,3)**2+PP(2,3)**2 - PMT3=SQRT(PMS3) - PP(3,3)=PMT3*SINH(VINT(211)) - PP(4,3)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-PP(4,3))**2-PP(3,3)**2 - PP(3,1)=(-PP(3,3)*(PMS12+PMS1-PMS2)+ - &VINT(213)*(SHPR-PP(4,3))*VINT(220))/(2D0*PMS12) - PP(3,2)=-PP(3,1)-PP(3,3) - PP(4,1)=SQRT(PMS1+PP(3,1)**2) - PP(4,2)=SQRT(PMS2+PP(3,2)**2) - -C...CM SYSTEM, INGOING QUARKS - QQ(3,1) = SHPR/2.D0 - QQ(4,1) = QQ(3,1) - QQ(3,2) = -QQ(3,1) - QQ(4,2) = QQ(4,1) - -C...PARAMETERS FOR AMPLITUDE METHOD - ALPHA = PYALEM(VINT(54)) - ALPHAS = PYALPS(VINT(54)) - - SW2 = PARU(102) - MW2 = PMAS(24,1)**2 - TANB = PARU(141) - VTB = VCKM(3,3) - - IF (ISUB.EQ.401) THEN - CALL PYTBHG(QQ(1,1),QQ(1,2),PP(1,1),PP(1,2),PP(1,3), - & VINT(201),VINT(206),RMB,VINT(43),WTTBH) - ELSE IF (ISUB.EQ.402) THEN - CALL PYTBHQ(QQ(1,1),QQ(1,2),PP(1,1),PP(1,2),PP(1,3), - & VINT(201),VINT(206),RMB,VINT(43),WTTBH) - END IF - - RETURN - END - -C********************************************************************* - -C...PYSTRF -C...Handles the fragmentation of an arbitrary colour singlet -C...jet system according to the Lund string fragmentation model. - - SUBROUTINE PYSTRF(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. All MOPS variables ends with MO - 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(6),PJU(5,5), - &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8), - &INMO(9),PM2QMO(2),XTMO(2),EJSTR(2),IJUORI(2),IBARRK(2), - &PBST(3,5),TJUOLD(5) - -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. - 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 - NTRYFN=0 - IJUORI(1)=0 - IJUORI(2)=0 - -C...Identify parton system. - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL PYERRM(12,'(PYSTRF:) 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=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0.AND.K(I,1).NE.41) GOTO 110 - IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - 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(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - K(N+NP,3)=I - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(K(I,1).EQ.41) THEN - IF(MOD(KQSUM,2).EQ.0.AND.MJU(1).EQ.0) THEN - MJU(1)=N+NP - IJUORI(1)=I - ELSE - MJU(2)=N+NP - IJUORI(2)=I - ENDIF - ENDIF - IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 - IF(MOD(KQSUM,3).NE.0) THEN - CALL PYERRM(12,'(PYSTRF:) unphysical flavour combination') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MJU(1).GT.0.OR.MJU(2).GT.0) MSTU(29)=1 - -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 PYROBO(N+1,N+NP,0D0,0D0,-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.0D0) THEN - HHPEZ=MAX(1D-10,(P(I,4)+P(I,3))/HHBZ) - P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=MAX(1D-10,(P(I,4)-P(I,3))*HHBZ) - P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 130 CONTINUE - ENDIF - -C...Search for very nearby partons that may be recombined. - NTRYR=0 - NTRYWR=0 - PARU12=PARU(12) - PARU13=PARU(13) - MJU(3)=MJU(1) - MJU(4)=MJU(2) - NR=NP - 140 IF(NR.GE.3) THEN - PDRMIN=2D0*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=4D0*(PAP-PVP)**2/MAX(1D-6,PARU13**2*PAP+2D0*(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(0D0,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(0D0,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- - & P(IR,3)**2)) - IF(MJU(2).NE.0.AND.IR.GT.MJU(2)) K(IR,2)=K(IR+1,2) - DO 190 I=IR+1,N+NR-1 - K(I,1)=K(I+1,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.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) 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 640 - IF(MSTJ(12).GE.4) CALL PYERRM(29,'(PYSTRF:) sorry,'// - & ' junction strings not handled by MSTJ(12)>3 options') - DO 630 JT=1,2 - NJS(JT)=0 - IF(MJU(JT).EQ.0) GOTO 630 - JS=3-2*JT - -C++SKANDS -C...Find and sum up momentum on three sides of junction. -C...Begin with previous boost = zero. - IJRFIT=0 - DO 210 IX=1,3 - TJUOLD(IX)=0D0 - 210 CONTINUE - TJUOLD(4)=1D0 - 220 IU=0 -C...Beginning and end of string system in event record. - I1BEG=N+1+(JT-1)*(NR-1) - I1END=N+NR+(JT-1)*(1-NR) -C...Look for junction string piece end points - DO 230 I1=I1BEG,I1END,JS - IF(K(I1,2).NE.21.AND.IU.LE.5.AND.IJRFIT.EQ.0) THEN -C...Store junction string piece end points. -C 1-junction systems 2-junction systems -C IU : 1 2 3 4 1 2 3 4 5 6 -C IJU(IU): q-g-g-q-g-g-j-g-q q-g-g-q-g-j-g-g-j-g-q-g-g-q - IU=IU+1 - IJU(IU)=I1 - ENDIF -C...Sum over momenta, from junction outwards. - 230 CONTINUE - DO 280 IU=1,3 - PWT=0D0 -C...Initialize junction drag and string piece 4-vectors. - DO 240 J=1,5 - PBST(IU,J)=0D0 - PJU(IU,J)=0D0 - 240 CONTINUE -C...First two branches. Inwards out means opposite direction to JS. -C...(JS is 1 for JT=1, -1 for JT=2) - IF (IU.LT.3) THEN - I1A=IJU(IU+1)-JS - I1B=IJU(IU) - IDIR=-JS -C...Last branch (gq or gjgqgq). Direction now reversed. - ELSE - I1A=IJU(IU)+JS - I1B=I1END - IDIR=JS - ENDIF - DO 270 I1=I1A,I1B,IDIR -C...Sum up momentum directions with exponential suppression -C...for use in finding junction rest frame below. - IF (K(I1,2).EQ.88) THEN -C...gjgqgq type system encountered. Use current PWT as start -C...for both strings. - PWTOLD=PWT - ELSE - IF (I1.EQ.IJU(5)+IDIR) PWT=PWTOLD -C...Sum up string piece (boosted) 4-momenta. - DO 250 J=1,4 - PJU(IU,J)=PJU(IU,J)+P(I1,J) - 250 CONTINUE -C...Compute "junction drag" vectors from (boosted) 4-momenta (initial -C...boost is zero, see above). Skip parton if suppression factor large. - IF (PWT.GT.10D0) GOTO 270 -C...Compute momentum in current frame: - TDP=TJUOLD(1)*P(I1,1)+TJUOLD(2)*P(I1,2)+TJUOLD(3)*P(I1,3) - BFC=TDP/(1D0+TJUOLD(4))+P(I1,4) - DO 260 J=1,3 - PTMP=P(I1,J)+TJUOLD(J)*BFC - PBST(IU,J)=PBST(IU,J)+PTMP*EXP(-PWT) - 260 CONTINUE -C...Boosted energy - PTMP=TJUOLD(4)*P(I1,4)+TDP - PBST(IU,4)=PBST(IU,J)+PTMP*EXP(-PWT) - PWT=PWT+PTMP/PARJ(48) - ENDIF - 270 CONTINUE -C...Put |p| rather than m in 5th slot. - PBST(IU,5)=SQRT(PBST(IU,1)**2+PBST(IU,2)**2+PBST(IU,3)**2) - PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) - 280 CONTINUE - -C...Calculate boost from present frame to next JRF candidate. - IJRFIT=IJRFIT+1 - CALL PYJURF(PBST,TJU) - -C...Combine new boost (TJU) with old boost (TJUOLD) - TMP=TJU(1)*TJUOLD(1)+TJU(2)*TJUOLD(2)+TJU(3)*TJUOLD(3) - DO 290 IX=1,3 - TJUOLD(IX)=TJU(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+TJU(4)) - 290 CONTINUE - TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3)**2) - -C...If last boost small, accept JRF, else iterate. -C...Also prevent possibility of infinite loop. - IF (ABS((TJU(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. - & IJRFIT.LT.MSTJ(18)) THEN - GOTO 220 - ELSEIF (IJRFIT.GE.MSTJ(18)) THEN - CALL PYERRM(1,'(PYSTRF:) failed to converge on JRF') - ENDIF - -C...Now store total boost in TJU and change perception. -C...TJUOLD = boost vector from CM of string syst -> JRF. Henceforth, -C...TJU = junction motion vector in string CM, so the sign changes. - DO 300 J=1,3 - TJU(J)=-TJUOLD(J) - 300 CONTINUE - TJU(4)=SQRT(1D0+TJU(1)**2+TJU(2)**2+TJU(3)**2) - -C--SKANDS - -C...Calculate string piece energies in junction rest frame. - DO 310 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) - PBST(IU,5)=TJU(4)*PBST(IU,4)-TJU(1)*PBST(IU,1)- - & TJU(2)*PBST(IU,2)-TJU(3)*PBST(IU,3) - 310 CONTINUE - -C...Start preparing for fragmentation of two strings from junction. - ISTA=I - NTRYER=0 - 320 NTRYER=NTRYER+1 - I=ISTA - DO 610 IU=1,2 - NS=IABS(IJU(IU+1)-IJU(IU)) - -C...Junction strings: find longitudinal string directions. - DO 350 IS=1,NS - IS1=IJU(IU)+JS*(IS-1) - IS2=IJU(IU)+JS*IS - DO 330 J=1,5 - DP(1,J)=0.5D0*P(IS1,J) - IF(IS.EQ.1) DP(1,J)=P(IS1,J) - DP(2,J)=0.5D0*P(IS2,J) - IF(IS.EQ.NS) DP(2,J)=(-PBST(IU,J)+2D0*PBST(IU,5)*TJU(J))* - & (PJU(IU,5)/PBST(IU,5)) - 330 CONTINUE - IF(IS.EQ.NS) DP(2,5)=SQRT(MAX(0D0,PJU(IU,4)**2- - & PJU(IU,1)**2-PJU(IU,2)**2-PJU(IU,3)**2)) - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) 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.5D0*((DP(4,5)+DHKC)/DHKS-1D0) - DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) - DO 340 J=1,4 - P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) - 340 CONTINUE - 350 CONTINUE - -C...Junction strings: initialize flavour, momentum and starting pos. - ISAV=I - MSTU91=MSTU(90) - 360 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) 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 380 JQ=1,2 - DO 370 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)=1D0 - 370 CONTINUE - 380 CONTINUE - KFL(1)=K(IJU(IU),2) - PX(1)=0D0 - PY(1)=0D0 - GAM(1)=0D0 - DO 390 J=1,5 - PJU(IU+3,J)=0D0 - 390 CONTINUE - -C...Junction strings: find initial transverse directions. - DO 400 J=1,4 - DP(1,J)=P(IN(4),J) - DP(2,J)=P(IN(4)+1,J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 400 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 410 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)) - 410 CONTINUE - -C...Junction strings: produce new particle, origin. - 420 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - 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. - 430 CALL PYKFDI(KFL(1),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 360 - IF(IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. - & IABS(KFL(3)).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 430 - ENDIF - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(KFL(1),PX(3),PY(3)) - PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 - CALL PYZDIS(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)=(1D0-Z)*(GAM(1)+PR(1)/Z) - DO 440 J=1,3 - IN(J)=IN(3+J) - 440 CONTINUE - -C...Junction strings: stepping within 'low' string region. - 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 450 J=1,4 - P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) - 450 CONTINUE - GOTO 550 -C...Has used up energy of junction string, i.e. no more hadrons in it. - ELSEIF(IN(1)+1.EQ.IN(2).AND.IN(1).EQ.N+NR+4*NS-3) THEN - DO 460 J=1,5 - P(I,J)=0D0 - 460 CONTINUE - GOTO 590 -C...Stepping from 'low' string region - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(2)+2,4)=P(IN(2)+2,3) - P(IN(2)+2,1)=1D0 - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 360 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - ENDIF - ENDIF - -C...Junction strings: find new transverse directions. - 470 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. - & IN(1).GT.IN(2)) GOTO 360 - IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN - DO 480 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 480 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.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - GOTO 470 - 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 490 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)) - 490 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.01D0) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Junction strings: sum up known four-momentum, coefficients for m2. - DO 520 J=1,4 - DHG(J)=0D0 - 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 500 IN1=IN(4),IN(1)-4,4 - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 500 CONTINUE - DO 510 IN2=IN(5),IN(2)-4,4 - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 510 CONTINUE - 520 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2D0*FOUR(I,IN(1)) - DHM(3)=2D0*FOUR(I,IN(2)) - DHM(4)=2D0*FOUR(IN(1),IN(2)) - -C...Junction strings: find coefficients for Gamma expression. - DO 540 IN2=IN(1)+1,IN(2),4 - DO 530 IN1=IN(1),IN2-1,4 - DHC=2D0*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 - 530 CONTINUE - 540 CONTINUE - -C...Junction strings: solve (m2, Gamma) equation system for energies. - DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) - IF(ABS(DHS1).LT.1D-4) GOTO 360 - 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.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ - & ABS(DHS1)-DHS2/DHS1) - IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0D0) GOTO 360 - 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)=1D0 - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 360 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - ENDIF - GOTO 470 - 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)=0D0 - IN(1)=IN(1)+4 - GOTO 470 - ENDIF - -C...Junction strings: particle four-momentum, remainder, loop back. - 550 DO 560 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) - 560 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 360 - 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 570 J=1,4 - P(IN(6),J)=P(IN(3),J) - P(IN(6)+1,J)=P(IN(3)+1,J) - 570 CONTINUE - ENDIF - DO 580 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) - 580 CONTINUE - GOTO 420 - ENDIF - -C...Junction strings: save quantities left after each string. - IF(IABS(KFL(1)).GT.10) GOTO 360 - 590 I=I-1 - KFJH(IU)=KFL(1) - DO 600 J=1,4 - PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) - 600 CONTINUE - -C...Junction strings: loopback if much unused energy in both strings. - 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) - EJSTR(IU)=PJU(IU,5)-PJU(IU+3,5) - 610 CONTINUE - IF((MIN(EJSTR(1),EJSTR(2)).GT.PARJ(49).OR. - & EJSTR(1).GT.PARJ(49)+PYR(0)*PARJ(50).OR. - & EJSTR(2).GT.PARJ(49)+PYR(0)*PARJ(50)) - & .AND.NTRYER.LT.10) GOTO 320 - -C...Junction strings: put together to new effective string endpoint. - NJS(JT)=I-ISTA - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFJH(1).EQ.KFJH(2)) KFLS=3 - KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),IABS(KFJH(2)))+ - & 100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+KFLS,KFJH(1)) - DO 620 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) - 620 CONTINUE - PJS(JT,5)=SQRT(MAX(0D0,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- - & PJS(JT,3)**2)) - PJS(JT+2,5)=0D0 - 630 CONTINUE - -C...Open versus closed strings. Choose breakup region for latter. - 640 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=0D0 - DO 650 IS=1,NR - P(N+NR+IS,1)=0.5D0*FOUR(N+IS,N+IS+1-NR*(IS/NR)) - W2SUM=W2SUM+P(N+NR+IS,1) - 650 CONTINUE - W2RAN=PYR(0)*W2SUM - NB=0 - 660 NB=NB+1 - W2SUM=W2SUM-P(N+NR+NB,1) - IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 660 - ENDIF - -C...Find longitudinal string directions (i.e. lightlike four-vectors). - DO 690 IS=1,NS - IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) - IS2=N+IS+NB-NR*((IS+NB-1)/NR) - DO 670 J=1,5 - DP(1,J)=P(IS1,J) - IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5D0*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.5D0*DP(2,J) - IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) - 670 CONTINUE - IF(IS1.EQ.MJU(1)) DP(1,5)=SQRT(MAX(0D0,DP(1,4)**2-DP(1,1)**2- - & DP(1,2)**2-DP(1,3)**2)) - IF(IS2.EQ.MJU(2)) DP(2,5)=SQRT(MAX(0D0,DP(2,4)**2-DP(2,1)**2- - & DP(2,2)**2-DP(2,3)**2)) - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) GOTO 200 - DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) - DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0) - DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) - DO 680 J=1,4 - P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) - 680 CONTINUE - 690 CONTINUE - -C...Begin initialization: sum up energy, set starting position. - ISAV=I - MSTU91=MSTU(90) - 700 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=ISAV - MSTU(90)=MSTU91 - DO 720 J=1,4 - P(N+NRS,J)=0D0 - DO 710 IS=1,NR - P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) - 710 CONTINUE - 720 CONTINUE - DO 740 JT=1,2 - IRANK(JT)=0 - IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) - IF(NS.GT.NR) IRANK(JT)=1 - IBARRK(JT)=0 - 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 730 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)=1D0 - 730 CONTINUE - 740 CONTINUE - -C.. MOPS variables and switches - NRVMO=0 - XBMO=1D0 - MSTU(121)=0 - MSTU(122)=0 - -C...Initialize flavour and pT variables for open string. - IF(NS.LT.NR) THEN - PX(1)=0D0 - PY(1)=0D0 - IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL PYPTDI(0,PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - DO 750 JT=1,2 - KFL(JT)=K(IE(JT),2) - IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) - IF(MJU(JT).NE.0.AND.IABS(KFL(JT)).GT.1000) IBARRK(JT)=1 - MSTJ(93)=1 - PMQ(JT)=PYMASS(KFL(JT)) - GAM(JT)=0D0 - 750 CONTINUE - -C...Closed string: random initial breakup flavour, pT and vertex. - ELSE - KFL(3)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - IBMO=0 - 760 CALL PYKFDI(KFL(3),0,KFL(1),KDUMP) -C.. Closed string: first vertex diq attempt => enforced second -C.. vertex diq - IF(IABS(KFL(1)).GT.10)THEN - IBMO=1 - MSTU(121)=0 - GOTO 760 - ENDIF - IF(IBMO.EQ.1) MSTU(121)=-1 - KFL(2)=-KFL(1) - CALL PYPTDI(KFL(1),PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - PR3=MIN(25D0,0.1D0*P(N+NR+1,5)**2) - 770 CALL PYZDIS(KFL(1),KFL(2),PR3,Z) - ZR=PR3/(Z*P(N+NR+1,5)**2) - IF(ZR.GE.1D0) GOTO 770 - DO 780 JT=1,2 - MSTJ(93)=1 - PMQ(JT)=PYMASS(KFL(JT)) - GAM(JT)=PR3*(1D0-Z)/Z - IN1=N+NR+3+4*(JT/2)*(NS-1) - P(IN1,JT)=1D0-Z - P(IN1,3-JT)=JT-1 - P(IN1,3)=(2-JT)*(1D0-Z)+(JT-1)*Z - P(IN1+1,JT)=ZR - P(IN1+1,3-JT)=2-JT - P(IN1+1,3)=(2-JT)*(1D0-ZR)+(JT-1)*ZR - 780 CONTINUE - ENDIF -C.. MOPS variables - DO 790 JT=1,2 - XTMO(JT)=1D0 - PM2QMO(JT)=PMQ(JT)**2 - IF(IABS(KFL(JT)).GT.10) PM2QMO(JT)=0D0 - 790 CONTINUE - -C...Find initial transverse directions (i.e. spacelike four-vectors). - DO 830 JT=1,2 - IF(JT.EQ.1.OR.NS.EQ.NR-1.OR.MJU(1)+MJU(2).NE.0) THEN - IN1=IN(3*JT+1) - IN3=IN(3*JT+3) - DO 800 J=1,4 - DP(1,J)=P(IN1,J) - DP(2,J)=P(IN1+1,J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 800 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 810 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)) - 810 CONTINUE - ELSE - DO 820 J=1,4 - P(IN3+2,J)=P(IN3,J) - P(IN3+3,J)=P(IN3+1,J) - 820 CONTINUE - ENDIF - 830 CONTINUE - -C...Remove energy used up in junction string fragmentation. - IF(MJU(1)+MJU(2).GT.0) THEN - DO 850 JT=1,2 - IF(NJS(JT).EQ.0) GOTO 850 - DO 840 J=1,4 - P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) - 840 CONTINUE - 850 CONTINUE - PARJST=PARJ(33) - IF(MSTJ(11).EQ.2) PARJST=PARJ(34) - WMIN=PARJST+PMQ(1)+PMQ(2) - WREM2=FOUR(N+NRS,N+NRS) - IF(P(N+NRS,4).LT.0D0.OR.WREM2.LT.WMIN**2) THEN - NTRYWR=NTRYWR+1 - IF(MOD(NTRYWR,20).NE.0) NTRYR=NTRYR-1 - GOTO 140 - ENDIF - ENDIF - -C...Produce new particle: side, origin. - 860 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF -C.. New side priority for popcorn systems - IF(MSTU(121).LE.0)THEN - JT=1.5D0+PYR(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 - ENDIF - JR=3-JT - JS=3-2*JT - IRANK(JT)=IRANK(JT)+1 - K(I,1)=1 - K(I,4)=0 - K(I,5)=0 - -C...Generate flavour, hadron and pT. - 870 K(I,3)=IE(JT) - CALL PYKFDI(KFL(JT),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 700 - MU90MO=MSTU(90) - IF(MSTU(121).EQ.-1) GOTO 900 - IF(IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. - &IABS(KFL(3)).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 870 - ENDIF - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JT) - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(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)=PYMASS(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.5D0*PARJ(36)*PMQ(3) - WREM2=FOUR(N+NRS,N+NRS) - IF(WREM2.LT.0.10D0) GOTO 700 - IF(WREM2.LT.MAX(WMIN*(1D0+(2D0*PYR(0)-1D0)*PARJ(37)), - &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 1070 - -C...Choose z, which gives Gamma. Shift z for heavy flavours. - CALL PYZDIS(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(0D0,(WREM2-PR(1)-PR(2))**2-4D0*PR(1)*PR(2))) - Z=(WREM2+PR(JT)-PR(JR)+PW12*(2D0*Z-1D0))/(2D0*WREM2) - PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 - IF((1D0-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 1070 - ENDIF - GAM(3)=(1D0-Z)*(GAM(JT)+PR(JT)/Z) - -C.. MOPS baryon model modification - XTMO3=(1D0-Z)*XTMO(JT) - IF(IABS(KFL(3)).LE.10) NRVMO=0 - IF(IABS(KFL(3)).GT.10.AND.MSTJ(12).GE.4) THEN - GTSTMO=1D0 - PTSTMO=1D0 - RTSTMO=PYR(0) - IF(IABS(KFL(JT)).LE.10)THEN - XBMO=MIN(XTMO3,1D0-(2D-10)) - GBMO=GAM(3) - PMMO=0D0 - PGMO=GBMO+LOG(1D0-XBMO)*PM2QMO(JT) - GTSTMO=1D0-PARF(192)**PGMO - ELSE - IF(IRANK(JT).EQ.1) THEN - GBMO=GAM(JT) - PMMO=0D0 - XBMO=1D0 - ENDIF - IF(XBMO.LT.1D0-(1D-10))THEN - PGNMO=GBMO*XTMO3/XBMO+PM2QMO(JT)*LOG(1D0-XTMO3) - GTSTMO=(1D0-PARF(192)**PGNMO)/(1D0-PARF(192)**PGMO) - PGMO=PGNMO - ENDIF - IF(MSTJ(12).GE.5)THEN - PMNMO=SQRT((XBMO-XTMO3)*(GAM(3)/XTMO3-GBMO/XBMO)) - PMMO=PMMO+PMAS(PYCOMP(K(I,2)),1)-PMAS(PYCOMP(K(I,2)),3) - PTSTMO=EXP((PMMO-PMNMO)*PARF(193)) - PMMO=PMNMO - ENDIF - ENDIF - -C.. MOPS Accepting popcorn system hadron. - IF(PTSTMO*GTSTMO.GT.RTSTMO) THEN - IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) THEN - NRVMO=I-N-NR - IF(I+NRVMO.GT.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11, - & '(PYSTRF:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - IMO=I - KFLMO=KFL(JT) - PMQMO=PMQ(JT) - PXMO=PX(JT) - PYMO=PY(JT) - GAMMO=GAM(JT) - IRMO=IRANK(JT) - XMO=XTMO(JT) - DO 890 J=1,9 - IF(J.LE.5) THEN - DO 880 LINE=1,I-N-NR - P(MSTU(4)-MSTU(32)-LINE,J)=P(N+NR+LINE,J) - K(MSTU(4)-MSTU(32)-LINE,J)=K(N+NR+LINE,J) - 880 CONTINUE - ENDIF - INMO(J)=IN(J) - 890 CONTINUE - ENDIF - ELSE -C..Reject popcorn system, flag=-1 if enforcing new one - MSTU(121)=-1 - IF(PTSTMO.GT.RTSTMO) MSTU(121)=-2 - ENDIF - ENDIF - - -C..Lift restoring string outside MOPS block - 900 IF(MSTU(121).LT.0) THEN - IF(MSTU(121).EQ.-2) MSTU(121)=0 - MSTU(90)=MU90MO - NRVMO=0 - IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) GOTO 870 - I=IMO - KFL(JT)=KFLMO - PMQ(JT)=PMQMO - PX(JT)=PXMO - PY(JT)=PYMO - GAM(JT)=GAMMO - IRANK(JT)=IRMO - XTMO(JT)=XMO - DO 920 J=1,9 - IF(J.LE.5) THEN - DO 910 LINE=1,I-N-NR - P(N+NR+LINE,J)=P(MSTU(4)-MSTU(32)-LINE,J) - K(N+NR+LINE,J)=K(MSTU(4)-MSTU(32)-LINE,J) - 910 CONTINUE - ENDIF - IN(J)=INMO(J) - 920 CONTINUE - GOTO 870 - ENDIF - XTMO(JT)=XTMO3 -C.. MOPS end of modification - - DO 930 J=1,3 - IN(J)=IN(3*JT+J) - 930 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 940 J=1,4 - P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) - 940 CONTINUE - GOTO 1030 - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(JR)+2,4)=P(IN(JR)+2,3) - P(IN(JR)+2,JT)=1D0 - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - ENDIF - ENDIF - -C...Find new transverse directions (i.e. spacelike string vectors). - 950 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 700 - IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN - DO 960 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 960 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.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - GOTO 950 - 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 970 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)) - 970 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.01D0) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Sum up known four-momentum. Gives coefficients for m2 expression. - DO 1000 J=1,4 - DHG(J)=0D0 - 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 980 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 980 CONTINUE - DO 990 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 990 CONTINUE - 1000 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2D0*FOUR(I,IN(1)) - DHM(3)=2D0*FOUR(I,IN(2)) - DHM(4)=2D0*FOUR(IN(1),IN(2)) - -C...Find coefficients for Gamma expression. - DO 1020 IN2=IN(1)+1,IN(2),4 - DO 1010 IN1=IN(1),IN2-1,4 - DHC=2D0*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 - 1010 CONTINUE - 1020 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.1D-4) GOTO 700 - 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.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ - &ABS(DHS1)-DHS2/DHS1) - IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0D0) GOTO 700 - 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)=1D0 - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - ENDIF - GOTO 950 - 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)=0D0 - IN(JT)=IN(JT)+4*JS - GOTO 950 - ENDIF - -C...Four-momentum of particle. Remaining quantities. Loop back. - 1030 DO 1040 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) - 1040 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 700 - 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 1050 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) - 1050 CONTINUE - ENDIF - DO 1060 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) - 1060 CONTINUE - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &IBARRK(JT)=0 - GOTO 860 - -C...Final hadron: side, flavour, hadron, mass. - 1070 I=I+1 - K(I,1)=1 - K(I,3)=IE(JR) - K(I,4)=0 - K(I,5)=0 - CALL PYKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 700 - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I-1,2)),10000).GT.1000) - &IBARRK(JT)=0 - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JT) - IF(IBARRK(JR).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JR) - P(I,5)=PYMASS(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)+2,3)*P(IN(8)+2,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=2D0*DHR1*DHR2*DHC12 - FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) - IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1D0) GOTO 200 - IF(FD.GE.1D0) GOTO 700 - FA=WREM2+PR(JT)-PR(JR) - FB=SQRT(MAX(0D0,FA**2-4D0*WREM2*PR(JT))) - PREVCF=PARJ(42) - IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) - PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*FB*PARJ(40)))) - FB=SIGN(FB,JS*(PYR(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(0D0,FA**2- - &4D0*WREM2*PR(JT))),DBLE(JS)) - DO 1080 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.5D0*(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) - 1080 CONTINUE - IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 700 - DM2F1=P(I-1,4)**2-P(I-1,1)**2-P(I-1,2)**2-P(I-1,3)**2-P(I-1,5)**2 - DM2F2=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 - IF(DM2F1.GT.1D-10*P(I-1,4)**2.OR.DM2F2.GT.1D-10*P(I,4)**2) THEN - NTRYFN=NTRYFN+1 - IF(NTRYFN.LT.100) GOTO 140 - CALL PYERRM(13,'(PYSTRF:) bad energies for final two hadrons') - ENDIF - -C...Mark jets as fragmented and give daughter pointers. - N=I-NRS+1 - DO 1090 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 - 1090 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 1100 J=1,4 - P(NSAV,J)=DPS(J) - V(NSAV,J)=V(IP,J) - 1100 CONTINUE - P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) - V(NSAV,5)=0D0 - DO 1120 I=NSAV+1,N - DO 1110 J=1,5 - K(I,J)=K(I+NRS-1,J) - P(I,J)=P(I+NRS-1,J) - V(I,J)=0D0 - 1110 CONTINUE - 1120 CONTINUE - MSTU91=MSTU(90) - DO 1130 IZ=MSTU90+1,MSTU91 - MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N - PARU9T(IZ)=PARU(90+IZ) - 1130 CONTINUE - MSTU(90)=MSTU90 - -C...Order particles in rank along the chain. Update mother pointer. - DO 1150 I=NSAV+1,N - DO 1140 J=1,5 - K(I-NSAV+N,J)=K(I,J) - P(I-NSAV+N,J)=P(I,J) - 1140 CONTINUE - 1150 CONTINUE - I1=NSAV - DO 1180 I=N+1,2*N-NSAV - IF(K(I,3).NE.IE(1).AND.K(I,3).NE.IJUORI(1)) GOTO 1180 - I1=I1+1 - DO 1160 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1160 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1170 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 - 1170 CONTINUE - 1180 CONTINUE - DO 1210 I=2*N-NSAV,N+1,-1 - IF(K(I,3).EQ.IE(1).OR.K(I,3).EQ.IJUORI(1)) GOTO 1210 - I1=I1+1 - DO 1190 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1190 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1200 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 - 1200 CONTINUE - 1210 CONTINUE - -C...Boost back particle system. Set production vertices. - IF(MBST.EQ.0) THEN - MSTU(33)=1 - CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4), - & DPS(3)/DPS(4)) - ELSE - DO 1220 I=NSAV+1,N - HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 - IF(P(I,3).GT.0D0) THEN - HHPEZ=(P(I,4)+P(I,3))*HHBZ - P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=(P(I,4)-P(I,3))/HHBZ - P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 1220 CONTINUE - ENDIF - DO 1240 I=NSAV+1,N - DO 1230 J=1,4 - V(I,J)=V(IP,J) - 1230 CONTINUE - 1240 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYSUBH -C...This routine computes the renormalization group improved -C...values of Higgs masses and couplings in the MSSM. - -C...Program based on the work by M. Carena, J.R. Espinosa, -c...M. Quiros and C.E.M. Wagner, CERN-preprint CERN-TH/95-45 - -C...Input: MA,TANB = TAN(BETA),MQ,MUR,MTOP,AU,AD,MU -C...All masses in GeV units. MA is the CP-odd Higgs mass, -C...MTOP is the physical top mass, MQ and MUR are the soft -C...supersymmetry breaking mass parameters of left handed -C...and right handed stops respectively, AU and AD are the -C...stop and sbottom trilinear soft breaking terms, -C...respectively, and MU is the supersymmetric -C...Higgs mass parameter. We use the conventions from -C...the physics report of Haber and Kane: left right -C...stop mixing term proportional to (AU - MU/TANB) -C...We use as input TANB defined at the scale MTOP - -C...Output: MH,HM,MHCH, SA = SIN(ALPHA), CA= COS(ALPHA), TANBA -C...where MH and HM are the lightest and heaviest CP-even -C...Higgs masses, MHCH is the charged Higgs mass and -C...ALPHA is the Higgs mixing angle -C...TANBA is the angle TANB at the CP-odd Higgs mass scale - -C...Range of validity: -C...(STOP1**2 - STOP2**2)/(STOP2**2 + STOP1**2) < 0.5 -C...(SBOT1**2 - SBOT2**2)/(SBOT2**2 + SBOT2**2) < 0.5 -C...where STOP1, STOP2, SBOT1 and SBOT2 are the stop and -C...are the sbottom mass eigenvalues, respectively. This -C...range automatically excludes the existence of tachyons. -C...For the charged Higgs mass computation, the method is -C...valid if -C...2 * |MB * AD* TANB| < M_SUSY**2, 2 * |MTOP * AU| < M_SUSY**2 -C...2 * |MB * MU * TANB| < M_SUSY**2, 2 * |MTOP * MU| < M_SUSY**2 -C...where M_SUSY**2 is the average of the squared stop mass -C...eigenvalues, M_SUSY**2 = (STOP1**2 + STOP2**2)/2. The sbottom -C...masses have been assumed to be of order of the stop ones -C...M_SUSY**2 = (MQ**2 + MUR**2)*0.5 + MTOP**2 - - SUBROUTINE PYSUBH (XMA,TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM, - &XMHCH,SA,CA,TANBA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYHTRI/HHH(7) - SAVE /PYDAT1/,/PYDAT2/ - -C...Local variables. - DOUBLE PRECISION PYALEM,PYALPS - DOUBLE PRECISION TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM - DOUBLE PRECISION XMHCH,SA,CA - DOUBLE PRECISION XMA,AEM,ALP1,ALP2,ALPH3Z,V,PI - DOUBLE PRECISION Q02 - DOUBLE PRECISION TANBA,TANBT,XMB,ALP3 - DOUBLE PRECISION RMTOP,XMS,T,SINB,COSB - DOUBLE PRECISION XLAM1,XLAM2,XLAM3,XLAM4,XLAM5,XLAM6 - DOUBLE PRECISION XLAM7,XAU,XAD,G1,G2,G3,HU,HD,HU2 - DOUBLE PRECISION HD2,HU4,HD4,SINBT,COSBT - DOUBLE PRECISION TRM2,DETM2,XMH2,XHM2,XMHCH2 - DOUBLE PRECISION SINALP,COSALP,AUD,PI2,XMS2,XMS4,AD2 - DOUBLE PRECISION AU2,XMU2,XMZ,XMS3 - - XMZ = PMAS(23,1) - Q02=XMZ**2 - AEM=PYALEM(Q02) - ALP1=AEM/(1D0-PARU(102)) - ALP2=AEM/PARU(102) - ALPH3Z=PYALPS(Q02) - - ALP1 = 0.0101D0 - ALP2 = 0.0337D0 - ALPH3Z = 0.12D0 - - V = 174.1D0 - PI = PARU(1) - TANBA = TANB - TANBT = TANB - -C...MBOTTOM(MTOP) = 3. GEV - XMB = PYMRUN(5,XMTOP**2) - ALP3 = ALPH3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPH3Z* - &LOG(XMTOP**2/XMZ**2)) - -C...RMTOP= RUNNING TOP QUARK MASS - RMTOP = XMTOP/(1D0+4D0*ALP3/3D0/PI) - XMS = ((XMQ**2 + XMUR**2)/2D0 + XMTOP**2)**0.5D0 - T = LOG(XMS**2/XMTOP**2) - SINB = TANB/((1D0 + TANB**2)**0.5D0) - COSB = SINB/TANB -C...IF(MA.LE.XMTOP) TANBA = TANBT - IF(XMA.GT.XMTOP) - &TANBA = TANBT*(1D0-3D0/32D0/PI**2* - &(RMTOP**2/V**2/SINB**2-XMB**2/V**2/COSB**2)* - &LOG(XMA**2/XMTOP**2)) - - SINBT = TANBT/SQRT(1D0 + TANBT**2) - COSBT = 1D0/SQRT(1D0 + TANBT**2) -C COS2BT = (TANBT**2 - 1D0)/(TANBT**2 + 1D0) - G1 = SQRT(ALP1*4D0*PI) - G2 = SQRT(ALP2*4D0*PI) - G3 = SQRT(ALP3*4D0*PI) - HU = RMTOP/V/SINBT - HD = XMB/V/COSBT - HU2=HU*HU - HD2=HD*HD - HU4=HU2*HU2 - HD4=HD2*HD2 - AU2=AU**2 - AD2=AD**2 - XMS2=XMS**2 - XMS3=XMS**3 - XMS4=XMS2*XMS2 - XMU2=XMU*XMU - PI2=PI*PI - - XAU = (2D0*AU2/XMS2)*(1D0 - AU2/12D0/XMS2) - XAD = (2D0*AD2/XMS2)*(1D0 - AD2/12D0/XMS2) - AUD = (-6D0*XMU2/XMS2 - ( XMU2- AD*AU)**2/XMS4 - &+ 3D0*(AU + AD)**2/XMS2)/6D0 - XLAM1 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HD2*T/8D0/PI2) - &+(3D0*HD4/8D0/PI2) * (T + XAD/2D0 + (3D0*HD2/2D0 + HU2/2D0 - &- 8D0*G3**2) * (XAD*T + T**2)/16D0/PI2) - &-(3D0*HU4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HU2 -5D0* HD2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU2*T/8D0/PI2) - &+(3D0*HU4/8D0/PI2) * (T + XAU/2D0 + (3D0*HU2/2D0 + HD2/2D0 - &- 8D0*G3**2) * (XAU*T + T**2)/16D0/PI2) - &-(3D0*HD4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HD2 -5D0* HU2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* - &(HU2 + HD2)*T/16D0/PI2) - &+(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 - &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) - &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ - &XMS4)* (1D0+ (6D0*HU2 -2D0* HD2/2D0 - &- 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ - &XMS4)*(1D0+ (6D0*HD2 -2D0* HU2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM4 = (- G2**2/2D0)*(1D0-3D0*(HU2 + HD2)*T/16D0/PI2) - &-(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 - &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) - &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ - &XMS4)* - &(1+ (6D0*HU2 -2D0* HD2 - &- 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ - &XMS4)* - &(1+ (6D0*HD2 -2D0* HU2/2D0 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM5 = -(3D0*HU4* XMU2*AU2/96D0/PI2/XMS4) * - &(1- (2D0*HD2 -6D0* HU2 + 16D0*G3**2) *T/16D0/PI2) - &-(3D0*HD4* XMU2*AD2/96D0/PI2/XMS4) * - &(1- (2D0*HU2 -6D0* HD2 + 16D0*G3**2) *T/16D0/PI2) - XLAM6 = (3D0*HU4* XMU**3*AU/96D0/PI2/XMS4) * - &(1- (7D0*HD2/2D0 -15D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4* XMU *(AD**3/XMS3 - 6D0*AD/XMS )/96D0/PI2/XMS) * - &(1- (HU2/2D0 -9D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) - XLAM7 = (3D0*HD4* XMU**3*AD/96D0/PI2/XMS4) * - &(1- (7D0*HU2/2D0 -15D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HU4* XMU *(AU**3/XMS3 - 6D0*AU/XMS )/96D0/PI2/XMS) * - &(1- (HD2/2D0 -9D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) - HHH(1)=XLAM1 - HHH(2)=XLAM2 - HHH(3)=XLAM3 - HHH(4)=XLAM4 - HHH(5)=XLAM5 - HHH(6)=XLAM6 - HHH(7)=XLAM7 - TRM2 = XMA**2 + 2D0*V**2* (XLAM1* COSBT**2 + - &2D0* XLAM6*SINBT*COSBT - &+ XLAM5*SINBT**2 + XLAM2* SINBT**2 + 2D0* XLAM7*SINBT*COSBT - &+ XLAM5*COSBT**2) - DETM2 = 4D0*V**4*(-(SINBT*COSBT*(XLAM3 + XLAM4) + - &XLAM6*COSBT**2 - &+ XLAM7* SINBT**2)**2 + (XLAM1* COSBT**2 + - &2D0* XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2)*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2)) + XMA**2*2D0*V**2 * - &((XLAM1* COSBT**2 +2D0* - &XLAM6* COSBT*SINBT + XLAM5*SINBT**2)*COSBT**2 + - &(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT + XLAM5*COSBT**2) - &*SINBT**2 - &+2D0*SINBT*COSBT* (SINBT*COSBT*(XLAM3 - &+ XLAM4) + XLAM6*COSBT**2 - &+ XLAM7* SINBT**2)) - - XMH2 = (TRM2 - SQRT(TRM2**2 - 4D0* DETM2))/2D0 - XHM2 = (TRM2 + SQRT(TRM2**2 - 4D0* DETM2))/2D0 - XHM = SQRT(XHM2) - XMH = SQRT(XMH2) - XMHCH2 = XMA**2 + (XLAM5 - XLAM4)* V**2 - XMHCH = SQRT(XMHCH2) - - SINALP = SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0) - - &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* - &XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) - &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))/ - &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0))/2D0**0.5D0 - - COSALP = (2D0*(2D0*V**2*(SINBT*COSBT*(XLAM3 + XLAM4) + - &XLAM6*COSBT**2 + XLAM7* SINBT**2) - - &XMA**2*SINBT*COSBT))/2D0**0.5D0/ - &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0)* - &(((TRM2**2 - 4D0* DETM2)**0.5D0) - - &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* - &XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) - &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))) - - SA = -SINALP - CA = -COSALP - - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYSUGI -C...Interface to ISASUSY version 7.69. -C...Warning: this interface should not be used with earlier versions -C...of ISASUSY, since common block incompatibilities may then arise. -C...Calls SUGRA (in ISAJET) to perform RGE evolution. -C...Then converts to Gunion-Haber conventions. - - SUBROUTINE PYSUGI - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - - INTEGER PYK,PYCHGE,PYCOMP - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...Date of Change - CHARACTER DOC*11 - PARAMETER (DOC='08 Oct 2003') - -C...ISASUGRA Input: - REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP -C...ISASUGRA Output - CHARACTER*40 ISAVER,VISAJE - REAL SUPER - COMMON /SSPAR/ SUPER(72) - COMMON /SUGMG/ MSS(32),GSS(31),MGUTSS,GGUTSS,AGUTSS,FTGUT, - $FBGUT,FTAGUT,FNGUT - REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS,FTGUT,FBGUT,FTAGUT,FNGUT - COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, - $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, - $FNMZ,AMNRMJ,NOGOOD,IAL3UN,ITACHY,MHPNEG,ASM3, - $VUMT,VDMT,ASMTP,ASMSS,M3Q - REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, - $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, - $FNMZ,AMNRMJ,ASM3,VUMT,VDMT,ASMTP,ASMSS,M3Q - INTEGER NOGOOD,IAL3UN,ITACHY,MHPNEG -C SUPER: Filled by ISASUGRA. -C SUPER(1) = mass of ~g -C SUPER(2:17) = mass of ~u_L,~u_R,~d_L,~d_R,~s_L,~s_R,~c_L,~c_R,~b_L -C ,~b_R,~b_1,~b_2,~t_L,~t_R,~t_1,~t_2 -C SUPER(18:25) = mass of ~e_L,~e_R,~mu_L,~mu_R,~tau_L,~tau_R,~tau_1 -C ,~tau_2 -C SUPER(26:28) = mass of ~nu_e,~nu_mu,~nu_tau -C SUPER(29) = Higgsino mass = - mu -C SUPER(30) = ratio v2/v1 of vev's -C SUPER(31:34) = Signed neutralino masses -C SUPER(35:50) = Neutralino mixing matrix -C SUPER(51:52) = Signed chargino masses -C SUPER(53:54) = Chargino left, right mixing angles -C SUPER(55:58) = mass of h0, H0, A0, H+ -C SUPER(59) = Higgs mixing angle alpha -C SUPER(60:65) = A_t, theta_t, A_b, theta_b, A_tau, theta_tau -C SUPER(66) = Gravitino mass -C SUPER(67:69) = Top,Bottom, and Tau masses at MSUSY (not used) -C SUPER(70) = b-Yukawa at mA scale (not used) -C SUPER(71:72) = H_u, H_d vev's at MSUSY (not used) -C GSS: Filled by ISASUGRA -C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 -C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t -C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 -C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t -C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 -C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 -C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 -C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 -C GSS(25) = mu GSS(26) = B GSS(27) = Y_N -C GSS(28) = M_nr GSS(29) = A_n GSS(30) = log(vdq) -C GSS(31) = log(vuq) -C MSS: Filled by ISASUGRA -C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr -C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl -C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr -C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 -C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl -C MSS(16) = nutl MSS(17) = el- MSS(18) = er- -C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 -C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss -C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss -C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 -C MSS(31) = ha0 MSS(32) = h+ -C Unification, filled by ISASUGRA if applicable. -C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUTC -C...SPYTHIA Input/Output: - INTEGER IMSS - DOUBLE PRECISION RMSS - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /SUGMG/,/SSPAR/ -C -C...PYTHIA common blocks -C...Parameters. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) -C...Particle properties + some flavour parameters. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT2/,/PYSSMT/ - -C...Start by checking for incompatibilities/inconsistencies: - DO 100 ICHK=2,9 - IF (ICHK.NE.8.AND.ICHK.NE.4.AND.IMSS(ICHK).NE.0) THEN - WRITE (MSTU(11),*) '(PYSUGI:) IMSS(',ICHK,')=',IMSS(ICHK) - & ,' option not used by PYSUGI' - ENDIF - 100 CONTINUE -C...ISAJET works with REAL numbers. - MZERO=REAL(RMSS(8)) - MHLF=REAL(RMSS(1)) - AZERO=REAL(RMSS(16)) - TANB=REAL(RMSS(5)) - SGNMU=REAL(RMSS(4)) - MTOP=REAL(PMAS(6,1)) -C...Initialize MSSM parameter array - DO 110 IPAR=1,72 - SUPER(IPAR)=0.0 - 110 CONTINUE -C...Call ISASUGRA - CALL SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,1) -C...Check whether ISASUSY thought the model was OK. - IF (NOGOOD.NE.0) THEN - IF (NOGOOD.EQ.1) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give tachyonic particles.') - IF (NOGOOD.EQ.2) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give no EWSB.') - IF (NOGOOD.EQ.3) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give m(A0) < 0.') - IF (NOGOOD.EQ.4) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give Yukawa > 100.') - IF (NOGOOD.EQ.7) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give x_T EWSB bad.') - IF (NOGOOD.EQ.8) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give m(h0)^2 < 0.') -C...Give warning, but don't stop, if LSP not ~chi_10. - IF (NOGOOD.EQ.5) CALL PYERRM(16 - & ,'(PYSUGI:) SUSY parameters give ~chi_10 not LSP.') - ENDIF -C...Warn about possible GUT scale tachyons. - IF (ITACHY.NE.0) CALL PYERRM(16, - & '(PYSUGI:) Tachyonic sleptons at GUT scale.') - -C...M1 and M2. - RMSS(1)=GSS(7) - RMSS(2)=GSS(8) -C...Gluino Mass. - RMSS(3)=SUPER(1) -C...Mu = - Higgsino mass. - RMSS(4)=-SUPER(29) - RMSS(5)=TANB -C...Slepton and squark masses. 2 first generations. - RMSS(6)=0.5*(SUPER(18)+SUPER(20)) - RMSS(7)=0.5*(SUPER(19)+SUPER(21)) - RMSS(8)=0.25*(SUPER(2)+SUPER(4)+SUPER(6)+SUPER(8)) - RMSS(9)=0.25*(SUPER(3)+SUPER(5)+SUPER(7)+SUPER(9)) -C...Third generation. - RMSS(10)=0.5*(SUPER(14)+SUPER(10)) - RMSS(11)=SUPER(11) - RMSS(12)=SUPER(15) - RMSS(13)=SUPER(22) - RMSS(14)=SUPER(23) -C...~b, ~t, and ~tau trilinear couplings and mixing angles. - RMSS(15)=SUPER(62) - RMSS(16)=SUPER(60) - RMSS(17)=SUPER(64) - RMSS(26)=SUPER(63) - RMSS(27)=SUPER(61) - RMSS(28)=SUPER(65) -C...Higgs mixing angle alpha (Gunion-Haber convention). - RMSS(18)=-SUPER(59) -C...A0 mass. - RMSS(19)=SUPER(57) -C...GUT scale coupling - RMSS(20)=AGUTSS -C...Gravitino mass (for future compatibility) - RMSS(21)=SUPER(66) - -C...Now we're done with RMSS. Time to fill PMAS (m > 0 required). -C...Higgs sector. - PMAS(PYCOMP(25),1)=ABS(SUPER(55)) - PMAS(PYCOMP(35),1)=ABS(SUPER(56)) - PMAS(PYCOMP(36),1)=ABS(SUPER(57)) - PMAS(PYCOMP(37),1)=ABS(SUPER(58)) -C...Gluino. - PMAS(PYCOMP(KSUSY1+21),1)=ABS(SUPER(1)) -C...Squarks and Sleptons. - DO 120 ILR=1,2 - ILRM=ILR-1 - PMAS(PYCOMP(ILR*KSUSY1+1),1)=ABS(SUPER(4+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+2),1)=ABS(SUPER(2+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+3),1)=ABS(SUPER(6+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+4),1)=ABS(SUPER(8+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+5),1)=ABS(SUPER(12+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+6),1)=ABS(SUPER(16+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+11),1)=ABS(SUPER(18+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+13),1)=ABS(SUPER(20+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+15),1)=ABS(SUPER(24+ILRM)) - 120 CONTINUE - PMAS(PYCOMP(KSUSY1+12),1)=ABS(SUPER(26)) - PMAS(PYCOMP(KSUSY1+14),1)=ABS(SUPER(27)) - PMAS(PYCOMP(KSUSY1+16),1)=ABS(SUPER(28)) -C...Neutralinos. - PMAS(PYCOMP(KSUSY1+22),1)=ABS(SUPER(31)) - PMAS(PYCOMP(KSUSY1+23),1)=ABS(SUPER(32)) - PMAS(PYCOMP(KSUSY1+25),1)=ABS(SUPER(33)) - PMAS(PYCOMP(KSUSY1+35),1)=ABS(SUPER(34)) -C...Signed masses (extra minus from going to G-H convention). - SMZ(1)=-SUPER(31) - SMZ(2)=-SUPER(32) - SMZ(3)=-SUPER(33) - SMZ(4)=-SUPER(34) -C...Charginos - PMAS(PYCOMP(KSUSY1+24),1)=ABS(SUPER(51)) - PMAS(PYCOMP(KSUSY1+37),1)=ABS(SUPER(52)) -C...Signed masses (extra minus from going to G-H convention). - SMW(1)=-SUPER(51) - SMW(2)=-SUPER(52) - -C... Neutralino Mixing. - DO 130 IN=1,4 - ZMIX(IN,1)= SUPER(38+4*(IN-1)) - ZMIX(IN,2)= SUPER(37+4*(IN-1)) - ZMIX(IN,3)=-SUPER(36+4*(IN-1)) - ZMIX(IN,4)=-SUPER(35+4*(IN-1)) - 130 CONTINUE -C...Chargino Mixing (PYTHIA same angle as HERWIG). - THX=1D0 - THY=1D0 - IF (SUPER(53).GT.0) THX=-1D0 - IF (SUPER(54).GT.0) THY=-1D0 - UMIX(1,1) = -SIN(SUPER(53)) - UMIX(1,2) = -COS(SUPER(53)) - UMIX(2,1) = -THX*COS(SUPER(53)) - UMIX(2,2) = THX*SIN(SUPER(53)) - VMIX(1,1) = -SIN(SUPER(54)) - VMIX(1,2) = -COS(SUPER(54)) - VMIX(2,1) = -THY*COS(SUPER(54)) - VMIX(2,2) = THY*SIN(SUPER(54)) -C...Sfermion mixing (PYTHIA same angle as ISAJET) - SFMIX(5,1)=COS(SUPER(63)) - SFMIX(5,2)=SIN(SUPER(63)) - SFMIX(5,3)=-SIN(SUPER(63)) - SFMIX(5,4)=COS(SUPER(63)) - SFMIX(6,1)=COS(SUPER(61)) - SFMIX(6,2)=SIN(SUPER(61)) - SFMIX(6,3)=-SIN(SUPER(61)) - SFMIX(6,4)=COS(SUPER(61)) - SFMIX(15,1)=COS(SUPER(65)) - SFMIX(15,2)=SIN(SUPER(65)) - SFMIX(15,3)=-SIN(SUPER(65)) - SFMIX(15,4)=COS(SUPER(65)) - - IF (MSTP(122).NE.0) THEN -C...Print a few lines to make the user know what's happening - ISAVER=VISAJE() - WRITE(MSTU(11),5000) DOC, ISAVER - WRITE(MSTU(11),5100) - WRITE(MSTU(11),5200) MZERO, MHLF, AZERO, TANB, NINT(SGNMU), MTOP - WRITE(MSTU(11),5300) - WRITE(MSTU(11),5500) 'EW scale masses' - WRITE(MSTU(11),5700) (SUPER(IP),IP=2,16,2),(SUPER(IP),IP=3,17,2) - WRITE(MSTU(11),5800) (SUPER(IP),IP=18,24,2),(SUPER(IP),IP=26,28) - & ,(SUPER(IP),IP=19,25,2) - WRITE(MSTU(11),5900) SUPER(1),(SMZ(IP),IP=1,4), (SMW(IP) - & ,IP=1,2) - WRITE(MSTU(11),6000) (SUPER(IP),IP=55,58) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),5500) 'Mixing structure' - WRITE(MSTU(11),6100) ((ZMIX(I,J), J=1,4),I=1,4) - WRITE(MSTU(11),6200) (UMIX(1,J), J=1,2),(VMIX(1,J),J=1,2) - & ,(UMIX(2,J), J=1,2),(VMIX(2,J),J=1,2) - WRITE(MSTU(11),6300) (SFMIX(5,J), J=1,2),(SFMIX(6,J),J=1,2) - & ,(SFMIX(15,J), J=1,2),(SFMIX(5,J),J=3,4),(SFMIX(6,J), J=3,4 - & ),(SFMIX(15,J),J=3,4) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),5500) 'Couplings' - WRITE(MSTU(11),6400) RMSS(15),RMSS(16),RMSS(17),RMSS(20) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),6500) - ENDIF - -C...Fix the higgs sector (in PYMSIN) using the masses and mixing angle -C...output by ISASUGRA. - IMSS(4)=2 - - 5000 FORMAT(1x,19('*'),1x,'PYSUGI v1.3: PYTHIA/ISASUGRA ' - & ,'INTERFACE',1x,19('*')/1x,'*',3x,'PYSUGI: Last Change',1x,A - & ,1x,'-',1x,'P.Z. Skands'/1x,'*',2x,A/1x,'*') - 5100 FORMAT(1x,'*',1x,'ISASUGRA Input:'/1x,'*',1x,'----------------') - 5200 FORMAT(1x,'*',1x,3x,'M_0',6x,'M_1/2',5x,'A_0',3x,'Tan(beta)', - & 3x,'Sgn(mu)',3x,'M_t'/1x,'*',1x,4(F8.2,1x),I8,2x,F8.2) - 5300 FORMAT(1x,'*'/1x,'*',1x,'ISASUGRA Output:'/1x,'*',1x - & ,'----------------') - 5400 FORMAT(1x,'*',1x,A) - 5500 FORMAT(1x,'*',1x,A,':') - 5600 FORMAT(1x,'*',2x,2x,'M_GUT',2x,2x,'g_GUT',2x,1x,'alpha_GUT'/ - & 1x,'*',2x,1P,2(1x,E8.2),2x,E8.2) - 5700 FORMAT(1x,'*',4x,4x,'~u',2x,1x,4x,'~d',2x,1x,4x,'~s',2x,1x, - & 4x,'~c',2x,1x,4x,'~b',2x,1x,2x,'~b(12)',1x,4x,'~t',2x,1x, 2x, - & '~t(12)'/1x,'*',2x,'L',1x,8(F8.2,1x)/1x,'*',2x,'R',1x,8(F8.2 - & ,1x)) - 5800 FORMAT(1x,'*'/1x,'*',4x,4x,'~e',2x,1x,3x,'~mu',2x,1x,3x,'~tau',1x - & ,1x,'~tau(12)',1x,2x,'~nu_e',1x,1x,1x,'~nu_mu',1x,1x,1x - & ,'~nu_tau'/1x,'*',2x,'L',1x,7(F8.2,1x)/1x,'*',2x,'R',1x,4(F8 - & .2,1x)) - 5900 FORMAT(1x,'*'/1x,'*',4x,4x,'~g',2x,1x,1x,'~chi_10',1x,1x,'~chi_20' - & ,1x,1x,'~chi_30',1x,1x,'~chi_40',1x,1x,'~chi_1+',1x - & ,1x,'~chi_2+'/1x,'*',3x,1x,7(F8.2,1x)) - 6000 FORMAT(1x,'*'/1x,'*',4x,4x,'h0',2x,1x,4x,'H0',2x,1x,4x,'A0',2x - & ,1x,4x,'H+'/1x,'*',3x,1x,5(F8.2,1x)) - 6100 FORMAT(1x,'*',11x,'|',3x,'~B',3x,'|',2x,'~W_3',2x,'|',2x - & ,'~H_1',2x,'|',2x,'~H_2',2x,'|'/1x,'*',3x,'~chi_10',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_20',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_30',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_40',1x,4('|' - & ,1x,F6.3,1x),'|') - 6200 FORMAT(1x,'*'/1x,'*',6x,'L',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|' - & ,12x,'R',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|'/1x,'*',3x - & ,'~chi_1+',1x,2('|',1x,F6.3,1x),'|',9x,'~chi_1+',1x,2('|',1x - & ,F6.3,1x),'|'/1x,'*',3x,'~chi_2+',1x,2('|',1x,F6.3,1x),'|',9x - & ,'~chi_2+',1x,2('|',1x,F6.3,1x),'|') - 6300 FORMAT(1x,'*'/1x,'*',8x,'|',2x,'~b_L',2x,'|',2x,'~b_R',2x,'|',8x - & ,'|',2x,'~t_L',2x,'|',2x,'~t_R',2x,'|',10x - & ,'|',1x,'~tau_L',1x,'|',1x,'~tau_R',1x,'|'/ - & 1x,'*',3x,'~b_1',1x,2('|',1x,F6.3,1x),'|',3x,'~t_1',1x,2('|' - & ,1x,F6.3,1x),'|',3x,'~tau_1',1x,2('|',1x,F6.3,1x),'|'/ - & 1x,'*',3x,'~b_2',1x,2('|',1x,F6.3,1x),'|',3x,'~t_2',1x,2('|' - & ,1x,F6.3,1x),'|',3x,'~tau_2',1x,2('|',1x,F6.3,1x),'|') - 6400 FORMAT(1x,'*',3x,'A_b = ',F8.2,4x,'A_t = ',F8.2,4x,'A_tau = ',F8.2 - & ,4x,'Alpha_GUT = ',F8.2) - 6500 FORMAT(1x,32('*'),1x,'END OF PYSUGI',1x,31('*')) - - END - -C********************************************************************* - -C...PYTABU -C...Evaluates various properties of an event, with statistics -C...accumulated during the course of the run and -C...printed at the end. - - SUBROUTINE PYTABU(MTABU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays, character variables, saved variables and data. - 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*0D0/,FM2FM/120*0D0/, - &NEVEE/0/,FE1EC/50*0D0/,FE2EC/50*0D0/,FE1EA/25*0D0/,FE2EA/25*0D0/, - &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=1D0/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 PYNAME(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 PYNAME(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)/DBLE(NPIS(I,0)),J=1,10) - 170 CONTINUE - -C...Copy statistics on initial parton state into /PYJETS/. - ELSEIF(MTABU.EQ.13) THEN - FAC=1D0/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)=0D0 - V(N+1,J)=0D0 - 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=PYCOMP(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=PYCOMP(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(PYCHGE(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=1D0/MAX(1,NEVFS) - WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS - DO 270 I=1,NKFFS - CALL PYNAME(KFFS(I),CHAU) - KC=PYCOMP(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 /PYJETS/. - ELSEIF(MTABU.EQ.23) THEN - FAC=1D0/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)=0D0 - 280 CONTINUE - P(I,5)=FAC*K(I,5) - V(I,5)=0D0 - 290 CONTINUE - N=NKFFS - DO 300 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 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)=0D0 - FM2FM(IM,IB,IP)=0D0 - 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=PYCOMP(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. - & PYCHGE(K(I,2)).EQ.0) GOTO 410 - ENDIF - PMR=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - PR=MAX(1D-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), - & 1D20)),P(I,3)) - IF(ABS(YETA).GT.PARU(57)) GOTO 410 - PHI=PYANGL(P(I,1),P(I,2)) - IYETA=512D0*(YETA+PARU(57))/(2D0*PARU(57)) - IYETA=MAX(0,MIN(511,IYETA)) - IPHI=512D0*(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 PYERRM(11,'(PYTABU:) no more memory left in PYJETS') - 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)=0D0 - 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)+2D0 - ELSEIF(NAGR.EQ.3) THEN - FEVFM(IB,1)=FEVFM(IB,1)+6D0 - FEVFM(IB,2)=FEVFM(IB,2)+6D0 - ELSEIF(NAGR.EQ.4) THEN - FEVFM(IB,1)=FEVFM(IB,1)+12D0 - FEVFM(IB,2)=FEVFM(IB,2)+24D0 - FEVFM(IB,3)=FEVFM(IB,3)+24D0 - ELSE - FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1D0) - FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1D0)*(NAGR-2D0) - FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1D0)*(NAGR-2D0)* - & (NAGR-3D0) - FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1D0)*(NAGR-2D0)* - & (NAGR-3D0)*(NAGR-4D0) - 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.5D0) THEN - FEVFM(IB,IP)=0D0 - ELSEIF(IM.LE.2) THEN - FEVFM(IB,IP)=2D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) - ELSE - FEVFM(IB,IP)=4D0**((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=1D0/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=2D0*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/DBLE(2**(IB-1)) - IF(IM.EQ.3) BNAVE=FAC*NMUFM/DBLE(4**(IB-1)) - DO 490 IP=1,4 - FMOMA(IP)=FAC*FM1FM(IM,IB,IP) - FMOMS(IP)=SQRT(MAX(0D0,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 /PYJETS/. - ELSEIF(MTABU.EQ.33) THEN - FAC=1D0/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)=2D0*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(0D0,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)=0D0 - V(N+1,J)=0D0 - 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)=0D0 - FE2EC(J)=0D0 - FE1EC(51-J)=0D0 - FE2EC(51-J)=0D0 - FE1EA(J)=0D0 - FE2EA(J)=0D0 - 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=0D0 - 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=PYCOMP(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. - & PYCHGE(K(I,2)).EQ.0) GOTO 570 - ENDIF - PMR=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN - CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS') - 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(1D-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=(2D0/ECM**2)*50D0/PARU(1) - DO 580 J=1,50 - FEVEE(J)=0D0 - 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(-1D0,MIN(1D0,CTHE))) - ITHE=MAX(1,MIN(50,1+INT(50D0*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=1D0/MAX(1,NEVEE) - WRITE(MSTU(11),5700) NEVEE - DO 620 J=1,25 - FEEC1=FAC*FE1EC(J) - FEES1=SQRT(MAX(0D0,FAC*(FAC*FE2EC(J)-FEEC1**2))) - FEEC2=FAC*FE1EC(51-J) - FEES2=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) - FEECA=FAC*FE1EA(J) - FEESA=SQRT(MAX(0D0,FAC*(FAC*FE2EA(J)-FEECA**2))) - WRITE(MSTU(11),5800) 3.6D0*(J-1),3.6D0*J,FEEC1,FEES1, - & FEEC2,FEES2,FEECA,FEESA - 620 CONTINUE - -C...Copy statistics on Energy-Energy Correlation into /PYJETS/. - ELSEIF(MTABU.EQ.43) THEN - FAC=1D0/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(0D0,FAC*(FAC*FE2EC(I)-P(I,1)**2))) - P(I,2)=FAC*FE1EC(51-I) - V(I,2)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) - P(I,3)=FAC*FE1EA(I) - V(I,3)=SQRT(MAX(0D0,FAC*(FAC*FE2EA(I)-P(I,3)**2))) - P(I,4)=PARU(1)*(I-1)/50D0 - P(I,5)=PARU(1)*I/50D0 - V(I,4)=3.6D0*(I-1) - V(I,5)=3.6D0*I - 630 CONTINUE - N=25 - DO 640 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 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=1D0/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 PYNAME(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 /PYJETS/. - ELSEIF(MTABU.EQ.53) THEN - FAC=1D0/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)=0D0 - V(IDC,J)=0D0 - 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)=0D0 - V(N+1,J)=0D0 - 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)'/ - &8X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', - &8X,'Total'/35X,'prim seco prim seco'/) - 5300 FORMAT(1X,I9,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********************************************************************* - -C...PYTAUD -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 /PYJETS/. -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 /PYJETS/ 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. - - SUBROUTINE PYTAUD(ITAU,IORIG,KFORIG,NDECAY) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ - -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(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYTAUD routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYTBBC -C...Calculates the three-body decay of gluinos into -C...charginos and third generation fermions. - - SUBROUTINE PYTBBC(I,NN,XMGLU,GAM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - EXTERNAL PYSIMP,PYLAMF - DOUBLE PRECISION PYSIMP,PYLAMF - INTEGER I,NN,LIN - DOUBLE PRECISION XMG,XMG2,XMB,XMB2,XMR,XMR2 - DOUBLE PRECISION XMT,XMT2,XMST(4),XMSB(4) - DOUBLE PRECISION ULR(2),VLR(2),XMQ2,XMQ4,AM,W,SBAR,SMIN,SMAX - DOUBLE PRECISION SUMME(0:100),A(4,8) - DOUBLE PRECISION COS2A,SIN2A,COS2C,SIN2C - DOUBLE PRECISION GRS,XMQ3,XMGBTR,XMGTBR,ANT1,ANT2,ANB1,ANB2 - DOUBLE PRECISION XMGLU,GAM - DOUBLE PRECISION XX1(2),XX2(2),AAA(2),BBB(2),CCC(2), - &DDD(2),EEE(2),FFF(2) - SAVE XX1,XX2,AAA,BBB,CCC,DDD,EEE,FFF - DOUBLE PRECISION ALPHAW,ALPHAS - DOUBLE PRECISION AMC(2) - SAVE AMC - DOUBLE PRECISION AMBOT,AMSB(2),SINC,COSC - DOUBLE PRECISION AMTOP,AMST(2),SINA,COSA - SAVE AMSB,AMST - LOGICAL IFIRST - SAVE IFIRST - DATA IFIRST/.TRUE./ - - TANB=RMSS(5) - SINB=TANB/SQRT(1D0+TANB**2) - COSB=SINB/TANB - XW=PARU(102) - AMW=PMAS(24,1) - COSC=SFMIX(5,1) - SINC=SFMIX(5,3) - COSA=SFMIX(6,1) - SINA=SFMIX(6,3) - AMBOT=PYMRUN(5,XMGLU**2) - AMTOP=PYMRUN(6,XMGLU**2) - W2=SQRT(2D0) - AMW=PMAS(24,1) - FAKT1=AMBOT/W2/AMW/COSB - FAKT2=AMTOP/W2/AMW/SINB - IF(IFIRST) THEN - AMC(1)=SMW(1) - AMC(2)=SMW(2) - DO 100 JJ=1,2 - CCC(JJ)=FAKT1*UMIX(JJ,2)*SINC-UMIX(JJ,1)*COSC - EEE(JJ)=FAKT2*VMIX(JJ,2)*COSC - DDD(JJ)=FAKT1*UMIX(JJ,2)*COSC+UMIX(JJ,1)*SINC - FFF(JJ)=FAKT2*VMIX(JJ,2)*SINC - XX1(JJ)=FAKT2*VMIX(JJ,2)*SINA-VMIX(JJ,1)*COSA - AAA(JJ)=FAKT1*UMIX(JJ,2)*COSA - XX2(JJ)=FAKT2*VMIX(JJ,2)*COSA+VMIX(JJ,1)*SINA - BBB(JJ)=FAKT1*UMIX(JJ,2)*SINA - 100 CONTINUE - AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) - AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) - AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) - AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) - IFIRST=.FALSE. - ENDIF - - ULR(1)=XX1(I)*XX1(I)+AAA(I)*AAA(I) - ULR(2)=XX2(I)*XX2(I)+BBB(I)*BBB(I) - VLR(1)=CCC(I)*CCC(I)+EEE(I)*EEE(I) - VLR(2)=DDD(I)*DDD(I)+FFF(I)*FFF(I) - - COS2A=COSA**2-SINA**2 - SIN2A=SINA*COSA*2D0 - COS2C=COSC**2-SINC**2 - SIN2C=SINC*COSC*2D0 - - XMG=XMGLU - XMT=PMAS(6,1) - XMB=PMAS(5,1) - XMR=AMC(I) - XMG2=XMG*XMG - ALPHAW=PYALEM(XMG2) - ALPHAS=PYALPS(XMG2) - XMT2=XMT*XMT - XMB2=XMB*XMB - XMR2=XMR*XMR - XMQ2=XMG2+XMT2+XMB2+XMR2 - XMQ4=XMG*XMT*XMB*XMR - XMQ3=XMG2*XMR2+XMT2*XMB2 - XMGBTR=(XMG2+XMB2)*(XMT2+XMR2) - XMGTBR=(XMG2+XMT2)*(XMB2+XMR2) - - XMST(1)=AMST(1)*AMST(1) - XMST(2)=AMST(1)*AMST(1) - XMST(3)=AMST(2)*AMST(2) - XMST(4)=AMST(2)*AMST(2) - XMSB(1)=AMSB(1)*AMSB(1) - XMSB(2)=AMSB(2)*AMSB(2) - XMSB(3)=AMSB(1)*AMSB(1) - XMSB(4)=AMSB(2)*AMSB(2) - - A(1,1)=-COSA*SINC*CCC(I)*AAA(I)-SINA*COSC*EEE(I)*XX1(I) - A(1,2)=XMG*XMB*(COSA*COSC*CCC(I)*AAA(I)+SINA*SINC*EEE(I)*XX1(I)) - A(1,3)=-XMG*XMR*(COSA*COSC*CCC(I)*XX1(I)+SINA*SINC*EEE(I)*AAA(I)) - A(1,4)=XMB*XMR*(COSA*SINC*CCC(I)*XX1(I)+SINA*COSC*EEE(I)*AAA(I)) - A(1,5)=XMG*XMT*(COSA*COSC*EEE(I)*XX1(I)+SINA*SINC*CCC(I)*AAA(I)) - A(1,6)=-XMT*XMB*(COSA*SINC*EEE(I)*XX1(I)+SINA*COSC*CCC(I)*AAA(I)) - A(1,7)=XMT*XMR*(COSA*SINC*EEE(I)*AAA(I)+SINA*COSC*CCC(I)*XX1(I)) - A(1,8)=-XMQ4*(COSA*COSC*EEE(I)*AAA(I)+SINA*SINC*CCC(I)*XX1(I)) - - A(2,1)=-COSA*COSC*DDD(I)*AAA(I)-SINA*SINC*FFF(I)*XX1(I) - A(2,2)=-XMG*XMB*(COSA*SINC*DDD(I)*AAA(I)+SINA*COSC*FFF(I)*XX1(I)) - A(2,3)=XMG*XMR*(COSA*SINC*DDD(I)*XX1(I)+SINA*COSC*FFF(I)*AAA(I)) - A(2,4)=XMB*XMR*(COSA*COSC*DDD(I)*XX1(I)+SINA*SINC*FFF(I)*AAA(I)) - A(2,5)=XMG*XMT*(COSA*SINC*FFF(I)*XX1(I)+SINA*COSC*DDD(I)*AAA(I)) - A(2,6)=XMT*XMB*(COSA*COSC*FFF(I)*XX1(I)+SINA*SINC*DDD(I)*AAA(I)) - A(2,7)=-XMT*XMR*(COSA*COSC*FFF(I)*AAA(I)+SINA*SINC*DDD(I)*XX1(I)) - A(2,8)=-XMQ4*(COSA*SINC*FFF(I)*AAA(I)+SINA*COSC*DDD(I)*XX1(I)) - - A(3,1)=-COSA*COSC*EEE(I)*XX2(I)-SINA*SINC*CCC(I)*BBB(I) - A(3,2)=XMG*XMB*(COSA*SINC*EEE(I)*XX2(I)+SINA*COSC*CCC(I)*BBB(I)) - A(3,3)=XMG*XMR*(COSA*SINC*EEE(I)*BBB(I)+SINA*COSC*CCC(I)*XX2(I)) - A(3,4)=-XMB*XMR*(COSA*COSC*EEE(I)*BBB(I)+SINA*SINC*CCC(I)*XX2(I)) - A(3,5)=-XMG*XMT*(COSA*SINC*CCC(I)*BBB(I)+SINA*COSC*EEE(I)*XX2(I)) - A(3,6)=XMT*XMB*(COSA*COSC*CCC(I)*BBB(I)+SINA*SINC*EEE(I)*XX2(I)) - A(3,7)=XMT*XMR*(COSA*COSC*CCC(I)*XX2(I)+SINA*SINC*EEE(I)*BBB(I)) - A(3,8)=-XMQ4*(COSA*SINC*CCC(I)*XX2(I)+SINA*COSC*EEE(I)*BBB(I)) - - A(4,1)=-COSA*SINC*FFF(I)*XX2(I)-SINA*COSC*DDD(I)*BBB(I) - A(4,2)=-XMG*XMB*(COSA*COSC*FFF(I)*XX2(I)+SINA*SINC*DDD(I)*BBB(I)) - A(4,3)=-XMG*XMR*(COSA*COSC*FFF(I)*BBB(I)+SINA*SINC*DDD(I)*XX2(I)) - A(4,4)=-XMB*XMR*(COSA*SINC*FFF(I)*BBB(I)+SINA*COSC*DDD(I)*XX2(I)) - A(4,5)=-XMG*XMT*(COSA*COSC*DDD(I)*BBB(I)+SINA*SINC*FFF(I)*XX2(I)) - A(4,6)=-XMT*XMB*(COSA*SINC*DDD(I)*BBB(I)+SINA*COSC*FFF(I)*XX2(I)) - A(4,7)=-XMT*XMR*(COSA*SINC*DDD(I)*XX2(I)+SINA*COSC*FFF(I)*BBB(I)) - A(4,8)=-XMQ4*(COSA*COSC*DDD(I)*XX2(I)+SINA*SINC*FFF(I)*BBB(I)) - - SMAX=(XMG-ABS(XMR))**2 - SMIN=(XMB+XMT)**2+0.1D0 - - DO 120 LIN=0,NN-1 - SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) - AM=(XMG2-XMR2)*(XMT2-XMB2)/2D0/SBAR - GRS=SBAR-XMQ2 - W=PYLAMF(SBAR,XMB2,XMT2)*PYLAMF(SBAR,XMG2,XMR2) - W=DSQRT(W)/2D0/SBAR - ANT1=LOG(ABS((GRS/2D0+AM+XMST(1)-W)/(GRS/2D0+AM+XMST(1)+W))) - ANT2=LOG(ABS((GRS/2D0+AM+XMST(3)-W)/(GRS/2D0+AM+XMST(3)+W))) - ANB1=LOG(ABS((GRS/2D0-AM+XMSB(1)-W)/(GRS/2D0-AM+XMSB(1)+W))) - ANB2=LOG(ABS((GRS/2D0-AM+XMSB(2)-W)/(GRS/2D0-AM+XMSB(2)+W))) - SUMME(LIN)=-ULR(1)*W+(ULR(1)*(XMQ2/2D0-XMST(1)-XMG*XMT*SIN2A) - & +2D0*XX1(I)*AAA(I)*XMR*XMB)*ANT1 - & +(ULR(1)/2D0*(XMST(1)*(XMQ2-XMST(1))-XMGTBR - & -2D0*XMG*XMT*SIN2A*(XMST(1)-XMB2-XMR2)) - & +2D0*XX1(I)*AAA(I)*XMR*XMB*(XMST(1)-XMG2-XMT2) - & +4D0*SIN2A*XX1(I)*AAA(I)*XMQ4) - & *(1D0/(GRS/2D0+AM+XMST(1)-W)-1D0/(GRS/2D0+AM+XMST(1)+W)) - SUMME(LIN)=SUMME(LIN)-ULR(2)*W - & +(ULR(2)*(XMQ2/2D0-XMST(3)+XMG*XMT*SIN2A) - & -2D0*XX2(I)*BBB(I)*XMR*XMB)*ANT2 - & +(ULR(2)/2D0*(XMST(3)*(XMQ2-XMST(3))-XMGTBR - & +2D0*XMG*XMT*SIN2A*(XMST(3)-XMB2-XMR2)) - & -2D0*XX2(I)*BBB(I)*XMR*XMB*(XMST(3)-XMG2-XMT2) - & +4D0*SIN2A*XX2(I)*BBB(I)*XMQ4) - & *(1D0/(GRS/2D0+AM+XMST(3)-W)-1D0/(GRS/2D0+AM+XMST(3)+W)) - SUMME(LIN)=SUMME(LIN)-VLR(1)*W - & +(VLR(1)*(XMQ2/2D0-XMSB(1)-XMG*XMB*SIN2C) - & +2D0*CCC(I)*EEE(I)*XMR*XMT)*ANB1 - & +(VLR(1)/2D0*(XMSB(1)*(XMQ2-XMSB(1))-XMGBTR - & -2D0*XMG*XMB*SIN2C*(XMSB(1)-XMT2-XMR2)) - & +2D0*CCC(I)*EEE(I)*XMR*XMT*(XMSB(1)-XMG2-XMB2) - & +4D0*SIN2C*CCC(I)*EEE(I)*XMQ4) - & *(1D0/(GRS/2D0-AM+XMSB(1)-W)-1D0/(GRS/2D0-AM+XMSB(1)+W)) - SUMME(LIN)=SUMME(LIN)-VLR(2)*W - & +(VLR(2)*(XMQ2/2D0-XMSB(2)+XMG*XMB*SIN2C) - & -2D0*DDD(I)*FFF(I)*XMR*XMT)*ANB2 - & +(VLR(2)/2D0*(XMSB(2)*(XMQ2-XMSB(2))-XMGBTR - & +2D0*XMG*XMB*SIN2C*(XMSB(2)-XMT2-XMR2)) - & -2D0*DDD(I)*FFF(I)*XMR*XMT*(XMSB(2)-XMG2-XMB2) - & +4D0*SIN2C*DDD(I)*FFF(I)*XMQ4) - & *(1D0/(GRS/2D0-AM+XMSB(2)-W)-1D0/(GRS/2D0-AM+XMSB(2)+W)) - SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMT*COS2A/(XMST(3)-XMST(1)) - & *((AAA(I)*BBB(I)-XX1(I)*XX2(I)) - & *((XMST(3)-XMB2-XMR2)*ANT2-(XMST(1)-XMB2-XMR2)*ANT1) - & +2D0*(AAA(I)*XX2(I)-XX1(I)*BBB(I))*XMB*XMR*(ANT2-ANT1)) - SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMB*COS2C/(XMSB(2)-XMSB(1)) - & *((EEE(I)*FFF(I)-CCC(I)*DDD(I)) - & *((XMSB(2)-XMT2-XMR2)*ANB2-(XMSB(1)-XMT2-XMR2)*ANB1) - & +2D0*(EEE(I)*DDD(I)-CCC(I)*FFF(I))*XMT*XMR*(ANB2-ANB1)) - DO 110 J=1,4 - SUMME(LIN)=SUMME(LIN)-2D0*A(J,1)*W - & +((-A(J,1)*(XMSB(J)*(GRS+XMSB(J))+XMQ3) - & +A(J,2)*(XMSB(J)-XMT2-XMR2)+A(J,3)*(SBAR-XMB2-XMT2) - & +A(J,4)*(XMSB(J)+SBAR-XMB2-XMR2) - & -A(J,5)*(XMSB(J)+SBAR-XMG2-XMT2)+A(J,6)*(XMG2+XMR2-SBAR) - & -A(J,7)*(XMSB(J)-XMG2-XMB2)+2D0*A(J,8)) - & *LOG(ABS((GRS/2D0+XMSB(J)-AM-W)/(GRS/2D0+XMSB(J)-AM+W))) - & -(A(J,1)*(XMST(J)*(GRS+XMST(J))+XMQ3) - & +A(J,2)*(XMST(J)+SBAR-XMG2-XMB2)-A(J,3)*(SBAR-XMB2-XMT2) - & +A(J,4)*(XMST(J)-XMG2-XMT2)-A(J,5)*(XMST(J)-XMR2-XMB2) - & -A(J,6)*(XMG2+XMR2-SBAR) - & -A(J,7)*(XMST(J)+SBAR-XMT2-XMR2)-2D0*A(J,8)) - & *LOG(ABS((GRS/2D0+XMST(J)+AM-W)/(GRS/2D0+XMST(J)+AM+W)))) - & /(GRS+XMSB(J)+XMST(J)) - 110 CONTINUE - 120 CONTINUE - SUMME(NN)=0D0 - GAM= ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) - &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) - - RETURN - END - - -C********************************************************************* - -C...PYTBBN -C...Calculates the three-body decay of gluinos into -C...neutralinos and third generation fermions. - - SUBROUTINE PYTBBN(I,NN,E,XMGLU,GAM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - EXTERNAL PYSIMP,PYLAMF - DOUBLE PRECISION PYSIMP,PYLAMF - INTEGER LIN,NN - DOUBLE PRECISION COSD,SIND,COSD2,SIND2,COS2D,SIN2D - DOUBLE PRECISION HL,HR,FL,FR,HL2,HR2,FL2,FR2 - DOUBLE PRECISION XMS2(2),XM,XM2,XMG,XMG2,XMR,XMR2 - DOUBLE PRECISION SBAR,SMIN,SMAX,XMQA,W,GRS,G(0:6),SUMME(0:100) - DOUBLE PRECISION FF,HH,HFL,HFR,HRFL,HLFR,XMQ4,XM24 - DOUBLE PRECISION XLN1,XLN2,B1,B2 - DOUBLE PRECISION E,XMGLU,GAM - DOUBLE PRECISION HRB(4),HLB(4),FLB(4),FRB(4) - SAVE HRB,HLB,FLB,FRB - DOUBLE PRECISION ALPHAW,ALPHAS - DOUBLE PRECISION HLT(4),HRT(4),FLT(4),FRT(4) - SAVE HLT,HRT,FLT,FRT - DOUBLE PRECISION AMN(4),AN(4,4),ZN(3) - SAVE AMN,AN,ZN - DOUBLE PRECISION AMBOT,SINC,COSC - DOUBLE PRECISION AMTOP,SINA,COSA - DOUBLE PRECISION SINW,COSW,TANW - DOUBLE PRECISION ROT1(4,4) - LOGICAL IFIRST - SAVE IFIRST - DATA IFIRST/.TRUE./ - - TANB=RMSS(5) - SINB=TANB/SQRT(1D0+TANB**2) - COSB=SINB/TANB - XW=PARU(102) - SINW=SQRT(XW) - COSW=SQRT(1D0-XW) - TANW=SINW/COSW - AMW=PMAS(24,1) - COSC=SFMIX(5,1) - SINC=SFMIX(5,3) - COSA=SFMIX(6,1) - SINA=SFMIX(6,3) - AMBOT=PYMRUN(5,XMGLU**2) - AMTOP=PYMRUN(6,XMGLU**2) - W2=SQRT(2D0) - FAKT1=AMBOT/W2/AMW/COSB - FAKT2=AMTOP/W2/AMW/SINB - IF(IFIRST) THEN - DO 110 II=1,4 - AMN(II)=SMZ(II) - DO 100 J=1,4 - ROT1(II,J)=0D0 - AN(II,J)=0D0 - 100 CONTINUE - 110 CONTINUE - ROT1(1,1)=COSW - ROT1(1,2)=-SINW - ROT1(2,1)=-ROT1(1,2) - ROT1(2,2)=ROT1(1,1) - ROT1(3,3)=COSB - ROT1(3,4)=SINB - ROT1(4,3)=-ROT1(3,4) - ROT1(4,4)=ROT1(3,3) - DO 140 II=1,4 - DO 130 J=1,4 - DO 120 JJ=1,4 - AN(II,J)=AN(II,J)+ZMIX(II,JJ)*ROT1(JJ,J) - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - DO 150 J=1,4 - ZN(1)=-FAKT2*(-SINB*AN(J,3)+COSB*AN(J,4)) - ZN(2)=-2D0*W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) - ZN(3)=-2*W2/3D0*SINW*AN(J,1)-W2*(0.5D0-2D0/3D0* - & XW)*AN(J,2)/COSW - HRT(J)=ZN(1)*COSA-ZN(3)*SINA - HLT(J)=ZN(1)*COSA+ZN(2)*SINA - FLT(J)=ZN(3)*COSA+ZN(1)*SINA - FRT(J)=ZN(2)*COSA-ZN(1)*SINA -C FLU(J)=ZN(3) -C FRU(J)=ZN(2) - ZN(1)=-FAKT1*(COSB*AN(J,3)+SINB*AN(J,4)) - ZN(2)=W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) - ZN(3)=W2/3D0*SINW*AN(J,1)+W2*(0.5D0-XW/3D0)*AN(J,2)/COSW - HRB(J)=ZN(1)*COSC-ZN(3)*SINC - HLB(J)=ZN(1)*COSC+ZN(2)*SINC - FLB(J)=ZN(3)*COSC+ZN(1)*SINC - FRB(J)=ZN(2)*COSC-ZN(1)*SINC -C FLD(J)=ZN(3) -C FRD(J)=ZN(2) - 150 CONTINUE -C AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) -C AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) -C AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) -C AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) - IFIRST=.FALSE. - ENDIF - - IF(NINT(3D0*E).EQ.2) THEN - HL=HLT(I) - HR=HRT(I) - FL=FLT(I) - FR=FRT(I) - COSD=SFMIX(6,1) - SIND=SFMIX(6,3) - XMS2(1)=PMAS(PYCOMP(KSUSY1+6),1)**2 - XMS2(2)=PMAS(PYCOMP(KSUSY2+6),1)**2 - XM=PMAS(6,1) - ELSE - HL=HLB(I) - HR=HRB(I) - FL=FLB(I) - FR=FRB(I) - COSD=SFMIX(5,1) - SIND=SFMIX(5,3) - XMS2(1)=PMAS(PYCOMP(KSUSY1+5),1)**2 - XMS2(2)=PMAS(PYCOMP(KSUSY2+5),1)**2 - XM=PMAS(5,1) - ENDIF - COSD2=COSD*COSD - SIND2=SIND*SIND - COS2D=COSD2-SIND2 - SIN2D=SIND*COSD*2D0 - HL2=HL*HL - HR2=HR*HR - FL2=FL*FL - FR2=FR*FR - FF=FL*FR - HH=HL*HR - HFL=HL*FL - HFR=HR*FR - HRFL=HR*FL - HLFR=HL*FR - XM2=XM*XM - XMG=XMGLU - XMG2=XMG*XMG - ALPHAW=PYALEM(XMG2) - ALPHAS=PYALPS(XMG2) - XMR=AMN(I) - XMR2=XMR*XMR - XMQ4=XMG*XM2*XMR - XM24=(XMG2+XM2)*(XM2+XMR2) - SMIN=4D0*XM2 - SMAX=(XMG-ABS(XMR))**2 - XMQA=XMG2+2D0*XM2+XMR2 - DO 170 LIN=1,NN-1 - SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) - GRS=SBAR-XMQA - W=PYLAMF(XMG2,XMR2,SBAR)*(0.25D0-XM2/SBAR) - W=DSQRT(W) - XLN1=LOG(ABS((GRS/2D0+XMS2(1)-W)/(GRS/2D0+XMS2(1)+W))) - XLN2=LOG(ABS((GRS/2D0+XMS2(2)-W)/(GRS/2D0+XMS2(2)+W))) - B1=1D0/(GRS/2D0+XMS2(1)-W)-1D0/(GRS/2D0+XMS2(1)+W) - B2=1D0/(GRS/2D0+XMS2(2)-W)-1D0/(GRS/2D0+XMS2(2)+W) - G(0)=-2D0*(HL2+FL2+HR2+FR2+(HFR-HFL)*SIN2D - & +2D0*(FF*SIND2-HH*COSD2))*W - G(1)=((HL2+FL2)*(XMQA-2D0*XMS2(1)-2D0*XM*XMG*SIN2D) - & +4D0*HFL*XM*XMR)*XLN1 - & +((HL2+FL2)*((XMQA-XMS2(1))*XMS2(1)-XM24 - & +2D0*XM*XMG*(XM2+XMR2-XMS2(1))*SIN2D) - & -4D0*HFL*XMR*XM*(XMG2+XM2-XMS2(1)) - & +8D0*HFL*XMQ4*SIN2D)*B1 - G(2)=((HR2+FR2)*(XMQA-2D0*XMS2(2)+2D0*XM*XMG*SIN2D) - & +4D0*HFR*XMR*XM)*XLN2 - & +((HR2+FR2)*((XMQA-XMS2(2))*XMS2(2)-XM24 - & +2D0*XMG*XM*SIN2D*(XMS2(2)-XM2-XMR2)) - & +4D0*HFR*XM*XMR*(XMS2(2)-XMG2-XM2) - & -8D0*HFR*XMQ4*SIN2D)*B2 - G(3)=(2D0*HFL*SIN2D*(XMS2(1)*(GRS+XMS2(1))+XM2*(SBAR-XMG2-XMR2) - & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HL2*SIND2+FL2*COSD2)*SBAR - & -2D0*XMG*XM*HFL*(SBAR+XMR2-XMG2) - & +XMR*XM*(HL2+FL2)*SIN2D*(SBAR+XMG2-XMR2) - & -4D0*XMQ4*(HL2-FL2)*COS2D)/(GRS+2D0*XMS2(1))*XLN1 - G(4)=4D0*COS2D*XM*XMG/(XMS2(1)-XMS2(2))* - & (((HLFR+HRFL)*(XM2+XMR2)+2D0*XM*XMR*(HH+FF))*(XLN1-XLN2) - & +(HLFR+HRFL)*(XMS2(2)*XLN2-XMS2(1)*XLN1)) - G(5)=(2D0*(HH*COSD2-FF*SIND2) - & *((XMS2(2)*(XMS2(2)+GRS)+XM2*XM2+XMG2*XMR2)*XLN2 - & +(XMS2(1)*(XMS2(1)+GRS)+XM2*XM2+XMG2*XMR2)*XLN1) - & +XM*((HH-FF)*SIN2D*XMG-(HRFL-HLFR)*XMR) - & *((GRS+XMS2(1)*2D0)*XLN1-(GRS+XMS2(2)*2D0)*XLN2) - & +((HRFL-HLFR)*XMR*(SIN2D*XMG*(SBAR-4D0*XM2) - & +COS2D*XM*(SBAR+XMG2-XMR2)) - & +2D0*(FF*COSD2-HH*SIND2)*XM2*(SBAR-XMG2-XMR2)) - & *(XLN1+XLN2))/(GRS+XMS2(1)+XMS2(2)) - G(6)=(-2D0*HFR*SIN2D*(XMS2(2)*(GRS+XMS2(2))+XM2*(SBAR-XMG2-XMR2) - & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HR2*SIND2+FR2*COSD2)*SBAR - & -2D0*XMG*XM*HFR*(SBAR+XMR2-XMG2) - & -XMR*XM*(HR2+FR2)*SIN2D*(SBAR+XMG2-XMR2) - & -4D0*XMQ4*(HR2-FR2)*COS2D)/(GRS+2D0*XMS2(2))*XLN2 - SUMME(LIN)=0D0 - DO 160 J=0,6 - SUMME(LIN)=SUMME(LIN)+G(J) - 160 CONTINUE - 170 CONTINUE - SUMME(0)=0D0 - SUMME(NN)=0D0 - GAM = ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) - &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) - - RETURN - END - -C********************************************************************* - -C...PYTBDY -C...Generates 3-body decays of gauginos. - - SUBROUTINE PYTBDY(IDIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) -C COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) -C COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -C SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYSSMT/ - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION XM(5) - COMPLEX*16 OLPP,ORPP,QLL,QLR,QRR,QRL,GLIJ,GRIJ,PROPZ - COMPLEX*16 QLLS,QRRS,QLRS,QRLS,QLLU,QRRU,QLRT,QRLT - COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) - DOUBLE PRECISION S12MIN,S12MAX,YJACO1,S23AVE,S23DF1,S23DF2 - DOUBLE PRECISION D1,D2,D3,P1,P2,P3,CTHE1,STHE1,CTHE3,STHE3 - DOUBLE PRECISION CPHI1,SPHI1 - DOUBLE PRECISION S23DEL,EPS - DOUBLE PRECISION GOLDEN,AX,BX,CX,TOL,XMIN,R,C - PARAMETER (R=0.61803399D0,C=1D0-R,TOL=1D-3) - DOUBLE PRECISION F1,F2,X0,X1,X2,X3 - INTEGER INOID(4) - DATA INOID/22,23,25,35/ - DATA EPS/1D-6/ - - ID=IDIN - ISKIP=1 - XM(1)=P(N+1,5) - XM(2)=P(N+2,5) - XM(3)=P(N+3,5) - XM(5)=P(ID,5) - -C...GENERATE S12 - S12MIN=(XM(1)+XM(2))**2 - S12MAX=(XM(5)-XM(3))**2 - YJACO1=S12MAX-S12MIN - -C...Initialize some parameters - XW=PARU(102) - XW1=1D0-XW - TANW=SQRT(XW/XW1) - IZID1=0 - IWID1=0 - IZID2=0 - IWID2=0 - DO 100 I1=1,4 - IF(MOD(K(N+1,2),KSUSY1).EQ.INOID(I1)) IZID1=I1 - IF(MOD(K(ID,2),KSUSY1).EQ.INOID(I1)) IZID2=I1 - 100 CONTINUE - IF(MOD(K(N+1,2),KSUSY1).EQ.24) IWID1=1 - IF(MOD(K(N+1,2),KSUSY1).EQ.37) IWID1=2 - IF(MOD(K(ID,2),KSUSY1).EQ.24) IWID2=1 - IF(MOD(K(ID,2),KSUSY1).EQ.37) IWID2=2 - IA=K(N+2,2) - JA=K(N+3,2) - ZM12=XM(5)**2 - ZM22=XM(1)**2 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - IF(MAX(ABS(IA),ABS(JA)).EQ.6) THEN - ISKIP=0 - ELSEIF(IZID1*IZID2.NE.0) THEN - SQMZ=PMAS(23,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - DO 110 I=1,4 - ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 110 CONTINUE - OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- - & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 - ORPP=DCONJG(OLPP) - XLL2=PMAS(PYCOMP(KSUSY1+IABS(IA)),1)**2 - XLR2=XLL2 - XRR2=PMAS(PYCOMP(KSUSY2+IABS(IA)),1)**2 - XRL2=XRR2 - GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* - & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) - GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 - XM1M2=SMZ(IZID1)*SMZ(IZID2) - QLLS=DCMPLX((T3I-EI*XW)/XW1)*OLPP - QLLU=-GLIJ - QLRS=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - QLRT=DCONJG(GLIJ) - QRLS=-DCMPLX((EI*XW)/XW1)*OLPP - QRLT=GRIJ - QRRS=DCMPLX((EI*XW)/XW1)*ORPP - QRRU=-DCONJG(GRIJ) - ELSEIF(IZID1*IWID2.NE.0.OR.IZID2*IWID1.NE.0) THEN - IF(IZID1.NE.0) THEN - XM1M2=SMZ(IZID1)*SMW(IWID2) - IZID1=IWID2 - IZID2=IZID1 - ELSE - XM1M2=SMZ(IZID2)*SMW(IWID1) - IZID1=IWID1 - ENDIF - RT2I = 1D0/SQRT(2D0) - SQMZ=PMAS(24,1)**2 - GMMZ=PMAS(24,1)*PMAS(24,2) - DO 120 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - 120 CONTINUE - DO 130 I=1,4 - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 130 CONTINUE - QLLS=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- - & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I) - QLRS=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ - & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I) - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - QRLS=DCMPLX(0D0,0D0) - QRLT=QRLS - QRRS=QRLS - QRRU=QRLS - XRR2=1D6**2 - XRL2=XRR2 - XLR2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - XLL2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - IF(MOD(IA,2).EQ.0) THEN - QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* - & TANW+ZMIXC(IZID2,2)*T3I) - QLRT=-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) - ELSE - QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* - & TANW+ZMIXC(IZID2,2)*T3J) - QLRT=-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) - ENDIF - ELSEIF(IWID1*IWID2.NE.0) THEN - IZID1=IWID1 - IZID2=IWID2 - XM1M2=SMW(IWID1)*SMW(IWID2) - SQMZ=PMAS(23,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - DO 140 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) - UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) - 140 CONTINUE - OLPP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- - & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0 - ORPP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- - & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0 - QRLS=-DCMPLX(EI/XW1)*ORPP - QLLS=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - QRRS=-DCMPLX(EI/XW1)*OLPP - QLRS=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - IF(MOD(IA,2).EQ.0) THEN - XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)-1),1)**2 - QLRT=-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))*DCMPLX(T3I/XW) - ELSE - XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)+1),1)**2 - QLRT=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))*DCMPLX(T3I/XW) - ENDIF - ELSEIF(MOD(K(N+1,2),KSUSY1).EQ.21.OR.MOD(K(ID,2),KSUSY1).EQ.21) - &THEN - ISKIP=0 - ELSE - ISKIP=0 - ENDIF - - IF(ISKIP.NE.0) THEN - WTMAX=0D0 - DO 160 KT=1,100 - S12=S12MIN+YJACO1*(KT-1)/99 - S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) - & *(S12+XM(3)**2-XM(5)**2)/(2D0*S12) - S23DF1=(S12-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(S12-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) - S23DEL=S23DEL/EPS - S23MIN=S23AVE-S23DEL - S23MAX=S23AVE+S23DEL - YJACO2=S23MAX-S23MIN - TH=S12 - DO 150 KS=1,100 - S23=S23MIN+YJACO2*(KS-1)/99 - SH=S23 - UH=ZM12+ZM22-SH-TH - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = XM1M2*SH - PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 - PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) - QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) - QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) - QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) - QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) - WT0=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ - & (ABS(QRL)**2+ABS(QLR)**2)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) - IF(WT0.GT.WTMAX) WTMAX=WT0 - 150 CONTINUE - 160 CONTINUE - - WTMAX=WTMAX*1.05D0 - ENDIF - -C...FIND S12* - AX=S12MIN - CX=S12MAX - BX=S12MIN+0.5D0*YJACO1 - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - -C...SOLVE FOR F1 AND F2 - S23DF1=(X1-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(X1-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) - F1=-2D0*S23DEL/EPS - S23DF1=(X2-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(X2-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) - F2=-2D0*S23DEL/EPS - - 170 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2)))THEN -C...Possibility of infinite loop with .LT.; changed to .LE. (SKANDS) - IF(F2.LE.F1)THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - S23DF1=(X2-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(X2-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) - F2=-2D0*S23DEL/EPS - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - S23DF1=(X1-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(X1-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) - F1=-2D0*S23DEL/EPS - ENDIF - GOTO 170 - ENDIF -C...WE WANT THE MAXIMUM, NOT THE MINIMUM - IF(F1.LT.F2)THEN - GOLDEN=-F1 - XMIN=X1 - ELSE - GOLDEN=-F2 - XMIN=X2 - ENDIF - - IKNT=0 - 180 S12=S12MIN+PYR(0)*YJACO1 - IKNT=IKNT+1 -C...GENERATE S23 - S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) - &*(S12+XM(3)**2-XM(5)**2)/(2D0*S12) - S23DF1=(S12-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(S12-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) - S23DEL=S23DEL/EPS - S23MIN=S23AVE-S23DEL - S23MAX=S23AVE+S23DEL - YJACO2=S23MAX-S23MIN - S23=S23MIN+PYR(0)*YJACO2 - -C...CHECK THE SAMPLING - IF(IKNT.GT.100) THEN - WRITE(MSTU(11),*) ' IKNT > 100 IN PYTBDY ' - GOTO 190 - ENDIF - IF(YJACO2.LT.PYR(0)*GOLDEN) GOTO 180 - - IF(ISKIP.EQ.0) GOTO 190 - - SH=S23 - TH=S12 - UH=ZM12+ZM22-SH-TH - - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = XM1M2*SH - PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 - PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) - - QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) - QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) - QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) - QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) -c QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) -c QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) -c &/DCMPLX(TH-XML2) -c QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) -c QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ -c &-DCONJG(GRIJ)/DCMPLX(UH-XMR2) - WT=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ - &(ABS(QRL)**2+ABS(QLR)**2)*WT2+ - &2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) - - IF(WT.LT.PYR(0)*WTMAX) GOTO 180 - IF(WT.GT.WTMAX) PRINT*,' WT > WTMAX ',WT,WTMAX - - 190 D3=(XM(5)**2+XM(3)**2-S12)/(2D0*XM(5)) - D1=(XM(5)**2+XM(1)**2-S23)/(2D0*XM(5)) - D2=XM(5)-D1-D3 - P1=SQRT(D1*D1-XM(1)**2) - P2=SQRT(D2*D2-XM(2)**2) - P3=SQRT(D3*D3-XM(3)**2) - CTHE1=2D0*PYR(0)-1D0 - ANG1=2D0*PYR(0)*PARU(1) - CPHI1=COS(ANG1) - SPHI1=SIN(ANG1) - ARG=1D0-CTHE1**2 - IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 - STHE1=SQRT(ARG) - P(N+1,1)=P1*STHE1*CPHI1 - P(N+1,2)=P1*STHE1*SPHI1 - P(N+1,3)=P1*CTHE1 - P(N+1,4)=D1 - -C...GET CPHI3 - ANG3=2D0*PYR(0)*PARU(1) - CPHI3=COS(ANG3) - SPHI3=SIN(ANG3) - CTHE3=(P2**2-P1**2-P3**2)/2D0/P1/P3 - ARG=1D0-CTHE3**2 - IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 - STHE3=SQRT(ARG) - P(N+3,1)=-P3*STHE3*CPHI3*CTHE1*CPHI1 - &+P3*STHE3*SPHI3*SPHI1 - &+P3*CTHE3*STHE1*CPHI1 - P(N+3,2)=-P3*STHE3*CPHI3*CTHE1*SPHI1 - &-P3*STHE3*SPHI3*CPHI1 - &+P3*CTHE3*STHE1*SPHI1 - P(N+3,3)=P3*STHE3*CPHI3*STHE1 - &+P3*CTHE3*CTHE1 - P(N+3,4)=D3 - - DO 200 I=1,3 - P(N+2,I)=-P(N+1,I)-P(N+3,I) - 200 CONTINUE - P(N+2,4)=D2 - - RETURN - END -C------------------------------------------------------------------ - SUBROUTINE PYTBHB(MT,MB,MHP,BR,GAMT) -C WIDTH AND BRANCHING RATIO FOR (ON-SHELL) T-> B W+, T->B H+ - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW,KFUN - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYCTBH/ - -C TOP WIDTH CALCULATION -C VTB = 0.99 - MW=DSQRT(MW2) - XB=(MB/MT)**2 - XW=(MW/MT)**2 - XH =(MHP/MT)**2 - GAMTBH = 0D0 - IF (MT .LT. (MHP+MB)) THEN -C T ->B W ONLY - BETW = DSQRT(1.D0-2*(XB+XW)+(XW-XB)**2) - GAMTBW = VTB**2*ALPHA/(16*SW2)*MT/XW*BETW* - & (2*(1.D0-XB-XW)-(1.D0+XB-XW)*(1.D0-XB -2*XW) ) - GAMT = GAMTBW - ELSE -C T ->BW +T ->B H^+ - BETW = DSQRT(1.D0-2*(XB+XW)+(XW-XB)**2) - GAMTBW = VTB**2*ALPHA/(16*SW2)*MT/XW*BETW* - & (2*(1.D0-XB-XW)-(1.D0+XB-XW)*(1.D0-XB -2*XW) ) -C - KFUN = DSQRT( (1.D0-(MHP/MT)**2-(MB/MT)**2)**2 - & -4.D0*(MHP*MB/MT**2)**2 ) - GAMTBH= ALPHA/SW2/8.D0*VTB**2*KFUN/MT * - & (V**2*((MT+MB)**2-MHP**2)+A**2*((MT-MB)**2-MHP**2)) - GAMT = GAMTBW+GAMTBH - ENDIF -C THUS BR IS - BR=GAMTBH/GAMT - RETURN - END - -C AMPLITUDE SQUARED (MATRIX ELEMENTS) FOR THE PROCESSES: -C GG->TBH^+, QQBAR->TBH^+ -C AS A FUNCTION OF 4-MOMENTA FOR SUITABLE INTERFACE -C (FOR INSTANCE WITH PYTHIA) -C------------------------------------------------------------ -C BASED ON F. BORZUMATI, J.-L. KNEUR, N. POLONSKY HEP-PH/9905443, -C PHYS REV. D 60 (1999) 115011 -C (THESE FILES PREPARED BY J.-L. KNEUR) -C------------------------------------------------------------ -C 1) GG->TBH^+ - SUBROUTINE PYTBHG(Q1,Q2,P1,P2,P3,MT,MB,RMB,MHP,AMP2) -C -C CONVENTIONS AND INPUT/OUTPUT DEFINITIONS: -C -C INPUT: Q1,Q2 ARE ENTERING 4-MOMENTA OF INITIAL GLUONS OR QUARKS; -C P1, P2 ARE THE TOP AND BOTTOM OUTGOING 4-MOMENTA; -C P3 IS OUTGOING CHARGED HIGGS 4-MOMENTA. -C (NB FOR ALL 4-MOMENTA P(4) IS TIME-COMPONENT) -C "PHYSICAL PARAMETERS" INPUT: -C MT,MB TOP AND BOTTOM MASSES; -C MHP CHARGED HIGGS MASS -C FURTHER PARAMETERS INPUT IS NEEDED FROM COMMON/PARAM/ (SEE BELOW) -C -C OUTPUT: AMP2 IS MATRIX ELEMENT (AMPLITUDE**2) FOR GG->TB H^+ -C (NB AMP2 IS TRULY AMPLITUDE SQUARRED, I.E. WITHOUT ANY -C PHASE SPACE FACTORS INCLUDED. IT INCLUDES COLOUR AND COUPLING -C FACTORS, AS EXPLICIT BELOW. ACCORDINGLY, FOR EXAMPLE THE TOTAL -C CROSS-SECTION SHOULD BE (SYMBOLICALLY): -C SIGMA = INTEGRATE [PARTON DENSITY FUNCTIONS * 3-PARTICLE FINAL -C STATE PHASE-SPACE (STANDARDLY NORMALIZED) * AMP2 ] -C - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW - DIMENSION Q1(4),Q2(4),P1(4),P2(4),P3(4) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYCTBH/ -C !THE RELEVANT INPUT PARAMETERS ABOVE ARE NEEDED FOR CALCULATION -C BUT ARE NOT DEFINED HERE SO THAT ONE MAY CHOOSE/VARY THEIR VALUES: -C ACCORDINGLY, WHEN CALLING THESE SUBROUTINES, PLEASE SUPPLY VIA -C THIS COMMON/PARAM/ YOUR PREFERRED ALPHA, ALPHAS,..AND TANB (TAN BETA) VALUES -C -C THE NORMALIZED V,A COUPLINGS ARE DEFINED BELOW AND USED BOTH -C IN THIS ROUTINE AND IN THE TOP WIDTH CALCULATION PYTBHB(..). - - PI = 4*DATAN(1.D0) - MW = DSQRT(MW2) -C -C COLLECTING THE RELEVANT OVERALL FACTORS: -C 8X8 INITIAL GLUON COLOR AVERAGE, 2X2 GLUON SPIN AVERAGE - PS=1.D0/(8.D0*8.D0 *2.D0*2.D0) -C COUPLING CONSTANT (OVERALL NORMALIZATION) - FACT=(4.D0*PI*ALPHA)*(4.D0*PI*ALPHAS)**2/SW2/2.D0 -C NB ALPHA IS E^2/4/PI, BUT BETTER DEFINED IN TERMS OF G_FERMI: -C ALPHA= DSQRT(2.D0)*GF*SW2*MW**2/PI -C ALPHAS IS ALPHA_STRONG; -C SW2 IS SIN(THETA_W)**2. -C -C VTB=.998D0 -C VTB IS TOP-BOTTOM CKM MATRIX ELEMENT (APPROXIMATE VALUE HERE) -C - V = ( MT/MW/TANB +RMB/MW*TANB)/2.D0 - A = (-MT/MW/TANB +RMB/MW*TANB)/2.D0 -C V AND A ARE (NORMALIZED) VECTOR AND AXIAL TBH^+ COUPLINGS -C -C REDEFINING P2 INGOING FROM OVERALL MOMENTUM CONSERVATION -C (BECAUSE P2 INGOING WAS USED IN OUR GRAPH CALCULATION CONVENTIONS) - DO KK=1,4 - P2(KK)=P3(KK)-Q1(KK)-Q2(KK)+P1(KK) - ENDDO -C DEFINING VARIOUS RELEVANT 4-SCALAR PRODUCTS: - S = 2*PYTBHS(Q1,Q2) - P1Q1=PYTBHS(Q1,P1) - P1Q2=PYTBHS(P1,Q2) - P2Q1=PYTBHS(P2,Q1) - P2Q2=PYTBHS(P2,Q2) - P1P2=PYTBHS(P1,P2) -C -C TOP WIDTH CALCULATION - CALL PYTBHB(MT,MB,MHP,BR,GAMT) -C GAMT IS THE TOP WIDTH: T->BH^+ AND/OR T->B W^+ -C THEN DEFINE TOP (RESONANT) PROPAGATOR: - A1INV= S -2*P1Q1 -2*P1Q2 - A1 =A1INV/(A1INV**2+ (GAMT*MT)**2) -C (I.E. INTRODUCE THE TOP WIDTH IN A1 TO REGULARISE THE POLE) -C NB: A12 = A1*A1 BUT CORRECT EXPRESSION BELOW BECAUSE OF -C THE TOP WIDTH - A12 = 1.D0/(A1INV**2+ (GAMT*MT)**2) - A2 =1.D0/(S +2*P2Q1 +2*P2Q2) -C NOTE A2 IS B PROPAGATOR, DOES NOT NEED A WIDTH -C NOW COMES THE AMP**2: -C NB COLOR FACTOR (COMING FROM GRAPHS) ALREADY INCLUDED IN -C THE EXPRESSIONS BELOW - V18=0.D0 - A18=0.D0 - V18= 640*A1/3+640*A2/3+32*A1*A2*MB**2-368*A12*MB*MT- - &512*A1*A2*MB*MT/3- - &368*A2**2*MB*MT+32*A1*A2*MT**2+496*A12*P1P2/3+ - &320*A1*A2*P1P2+496*A2**2*P1P2/3+128*A1*MB*MT**3/(3*P1Q1**2)+ - &128*A1*MT**4/(3*P1Q1**2)-256*A12*MB*MT**5/(3*P1Q1**2)+ - &256*A1*MT**2*P1P2/(3*P1Q1**2)-256*A12*MT**4*P1P2/(3*P1Q1**2)+ - &8/(3*P1Q1)-32*A1*MB*MT/P1Q1-56*A2*MB*MT/(3*P1Q1)+ - &88*A1*MT**2/(3*P1Q1)+72*A2*MT**2/P1Q1+ - &704*A12*MB*MT**3/(3*P1Q1)-224*A1*A2*MB*MT**3/(3*P1Q1)+ - &104*A1*P1P2/(3*P1Q1)+48*A2*P1P2/P1Q1+ - &128*A1*A2*MB*MT*P1P2/(3*P1Q1)+512*A12*MT**2*P1P2/(3*P1Q1)- - &448*A1*A2*MT**2*P1P2/(3*P1Q1)-32*A1*A2*P1P2**2/P1Q1- - &656*A1*A2*P1Q1/3-224*A2**2*P1Q1+128*A1*MB*MT**3/(3*P1Q2**2)+ - &128*A1*MT**4/(3*P1Q2**2)-256*A12*MB*MT**5/(3*P1Q2**2)+ - &256*A1*MT**2*P1P2/(3*P1Q2**2)-256*A12*MT**4*P1P2/(3*P1Q2**2)+ - &256*A1*MT**2*P1Q1/(3*P1Q2**2)+256*A12*MB*MT**3*P1Q1/(3*P1Q2**2)+ - &8/(3*P1Q2)-32*A1*MB*MT/P1Q2-56*A2*MB*MT/(3*P1Q2) - V18=V18+88*A1*MT**2/(3*P1Q2)+72*A2*MT**2/P1Q2+ - &704*A12*MB*MT**3/(3*P1Q2)-224*A1*A2*MB*MT**3/(3*P1Q2)+ - &104*A1*P1P2/(3*P1Q2)+48*A2*P1P2/P1Q2+ - &128*A1*A2*MB*MT*P1P2/(3*P1Q2)+512*A12*MT**2*P1P2/(3*P1Q2)- - &448*A1*A2*MT**2*P1P2/(3*P1Q2)-32*A1*A2*P1P2**2/P1Q2- - &32*A1*MB*MT**3/(3*P1Q1*P1Q2)-32*A1*MT**4/(3*P1Q1*P1Q2)+ - &64*A12*MB*MT**5/(3*P1Q1*P1Q2)+16*P1P2/(3*P1Q1*P1Q2)- - &64*A1*MT**2*P1P2/(3*P1Q1*P1Q2)+64*A12*MT**4*P1P2/(3*P1Q1*P1Q2)+ - &112*A1*P1Q1/P1Q2+272*A2*P1Q1/(3*P1Q2)- - &272*A1*A2*MB**2*P1Q1/(3*P1Q2)+208*A12*MB*MT*P1Q1/(3*P1Q2)- - &400*A1*A2*MB*MT*P1Q1/(3*P1Q2)-80*A1*A2*MT**2*P1Q1/P1Q2+ - &96*A12*P1P2*P1Q1/P1Q2-320*A1*A2*P1P2*P1Q1/P1Q2- - &544*A1*A2*P1Q1**2/(3*P1Q2)-656*A1*A2*P1Q2/3-224*A2**2*P1Q2+ - &256*A1*MT**2*P1Q2/(3*P1Q1**2)+256*A12*MB*MT**3*P1Q2/(3*P1Q1**2)+ - &112*A1*P1Q2/P1Q1+272*A2*P1Q2/(3*P1Q1)- - &272*A1*A2*MB**2*P1Q2/(3*P1Q1)+208*A12*MB*MT*P1Q2/(3*P1Q1)- - &400*A1*A2*MB*MT*P1Q2/(3*P1Q1)-80*A1*A2*MT**2*P1Q2/P1Q1 - V18=V18+96*A12*P1P2*P1Q2/P1Q1-320*A1*A2*P1P2*P1Q2/P1Q1- - &544*A1*A2*P1Q2**2/(3*P1Q1)+128*A2*MB**4/(3*P2Q1**2)+ - &128*A2*MB**3*MT/(3*P2Q1**2)-256*A2**2*MB**5*MT/(3*P2Q1**2)+ - &256*A2*MB**2*P1P2/(3*P2Q1**2)-256*A2**2*MB**4*P1P2/(3*P2Q1**2)+ - &256*A2*MB**2*P1Q1/(3*P2Q1**2)-256*A2**2*MB**4*P1Q1/(3*P2Q1**2)- - &64*MB**3*MT**3/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1**2)+ - &64*MB**3*MT/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**3*MT*P1Q1/(3*P1Q2*P2Q1**2)+ - &512*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q1**2)-8/(3*P2Q1)-72*A1*MB**2/P2Q1- - &88*A2*MB**2/(3*P2Q1)+56*A1*MB*MT/(3*P2Q1)+32*A2*MB*MT/P2Q1+ - &224*A1*A2*MB**3*MT/(3*P2Q1)-704*A2**2*MB**3*MT/(3*P2Q1) - V18=V18-48*A1*P1P2/P2Q1-104*A2*P1P2/(3*P2Q1)+ - &448*A1*A2*MB**2*P1P2/(3*P2Q1)-512*A2**2*MB**2*P1P2/(3*P2Q1)- - &128*A1*A2*MB*MT*P1P2/(3*P2Q1)+32*A1*A2*P1P2**2/P2Q1- - &16*P1P2/(3*P1Q1*P2Q1)-32*A1*MB*MT*P1P2/(3*P1Q1*P2Q1)- - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q1)- - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**3/(3*P1Q1*P2Q1)-256*A2*P1Q1/(3*P2Q1)+ - &448*A1*A2*MB**2*P1Q1/(3*P2Q1)-368*A2**2*MB**2*P1Q1/(3*P2Q1)+ - &224*A1*A2*MB*MT*P1Q1/(3*P2Q1)+304*A1*A2*P1P2*P1Q1/(3*P2Q1)- - &64*MB*MT**3/(3*P1Q2**2*P2Q1)- - &256*A1*MB*MT**3*P1P2/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2**2/(3*P1Q2**2*P2Q1)+ - &64*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB*MT**3*P1Q1/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2*P1Q1/(3*P1Q2**2*P2Q1)-4*MB**2/(3*P1Q2*P2Q1)+ - &64*MB*MT/(3*P1Q2*P2Q1)-128*A2*MB**3*MT/(3*P1Q2*P2Q1) - V18=V18-4*MT**2/(3*P1Q2*P2Q1)-128*A1*MB**2*MT**2/(3*P1Q2*P2Q1)- - &128*A2*MB**2*MT**2/(3*P1Q2*P2Q1)-128*A1*MB*MT**3/(3*P1Q2*P2Q1)- - &112*A2*MB**2*P1P2/(3*P1Q2*P2Q1)-32*A1*MB*MT*P1P2/(3*P1Q2*P2Q1)- - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q1)-112*A1*MT**2*P1P2/(3*P1Q2*P2Q1)- - &48*A1*P1P2**2/(P1Q2*P2Q1)-48*A2*P1P2**2/(P1Q2*P2Q1)+ - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2**3/(3*P1Q2*P2Q1)-8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+8*P1Q1/(3*P1Q2*P2Q1)- - &160*A1*MB**2*P1Q1/(3*P1Q2*P2Q1)-272*A2*MB**2*P1Q1/(3*P1Q2*P2Q1)+ - &56*A1*MB*MT*P1Q1/(3*P1Q2*P2Q1)+200*A2*MB*MT*P1Q1/(3*P1Q2*P2Q1)- - &48*A1*P1P2*P1Q1/(P1Q2*P2Q1)-256*A2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1)+ - &1024*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q1) - V18=V18-272*A2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1Q1**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P1Q1**2/(3*P1Q2*P2Q1)+16*A2*P1Q2/(3*P2Q1)+ - &64*A1*A2*MB**2*P1Q2/P2Q1+32*A2**2*MB**2*P1Q2/(3*P2Q1)+ - &112*A1*A2*MB*MT*P1Q2/(3*P2Q1)+368*A1*A2*P1P2*P1Q2/(3*P2Q1)+ - &32*A2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB*MT*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q1)+224*A12*P2Q1+ - &656*A1*A2*P2Q1/3-256*A1*MT**2*P2Q1/(3*P1Q1**2)+ - &256*A12*MT**4*P2Q1/(3*P1Q1**2)-256*A1*P2Q1/(3*P1Q1)+ - &224*A1*A2*MB*MT*P2Q1/(3*P1Q1)-368*A12*MT**2*P2Q1/(3*P1Q1)+ - &448*A1*A2*MT**2*P2Q1/(3*P1Q1)+304*A1*A2*P1P2*P2Q1/(3*P1Q1)+ - &256*A12*MT**4*P2Q1/(3*P1Q2**2)+ - &256*A12*MT**2*P1Q1*P2Q1/(3*P1Q2**2)+16*A1*P2Q1/(3*P1Q2)+ - &112*A1*A2*MB*MT*P2Q1/(3*P1Q2)+32*A12*MT**2*P2Q1/(3*P1Q2) - V18=V18+64*A1*A2*MT**2*P2Q1/P1Q2+368*A1*A2*P1P2*P2Q1/(3*P1Q2)+ - &16*A1*MT**2*P2Q1/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q1/(3*P1Q1*P1Q2)+ - &640*A12*P1Q1*P2Q1/(3*P1Q2)+544*A1*A2*P1Q1*P2Q1/(3*P1Q2)+ - &32*A12*P1Q2*P2Q1/P1Q1+944*A1*A2*P1Q2*P2Q1/(3*P1Q1)+ - &128*A2*MB**4/(3*P2Q2**2)+128*A2*MB**3*MT/(3*P2Q2**2)- - &256*A2**2*MB**5*MT/(3*P2Q2**2)+256*A2*MB**2*P1P2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1P2/(3*P2Q2**2)- - &64*MB**3*MT**3/(3*P1Q1**2*P2Q2**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q1**2*P2Q2**2)+ - &64*MB**3*MT/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q1*P2Q2**2)- - &256*A2**2*MB**4*P1Q1/(3*P2Q2**2)+256*A2*MB**2*P1Q2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q2**2)- - &64*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2**2)+ - &256*A2*MB**3*MT*P1Q2/(3*P1Q1*P2Q2**2)+ - &512*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2**2) - V18=V18+256*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P2Q1/(3*P2Q2**2)-256*A2**2*MB**3*MT*P2Q1/(3*P2Q2**2)+ - &64*MB**2*MT**2*P2Q1/(3*P1Q1**2*P2Q2**2)+ - &64*MB**2*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**3*MT*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*MT**2*P2Q1/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P1P2*P2Q1/(3*P1Q1*P2Q2**2)+ - &256*A2**2*MB**2*P1Q1*P2Q1/(3*P2Q2**2)- - &256*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2**2)-8/(3*P2Q2)- - &72*A1*MB**2/P2Q2-88*A2*MB**2/(3*P2Q2)+56*A1*MB*MT/(3*P2Q2)+ - &32*A2*MB*MT/P2Q2+224*A1*A2*MB**3*MT/(3*P2Q2)- - &704*A2**2*MB**3*MT/(3*P2Q2)-48*A1*P1P2/P2Q2- - &104*A2*P1P2/(3*P2Q2)+448*A1*A2*MB**2*P1P2/(3*P2Q2)- - &512*A2**2*MB**2*P1P2/(3*P2Q2)-128*A1*A2*MB*MT*P1P2/(3*P2Q2)+ - &32*A1*A2*P1P2**2/P2Q2-64*MB*MT**3/(3*P1Q1**2*P2Q2)- - &256*A1*MB*MT**3*P1P2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2**2/(3*P1Q1**2*P2Q2)-4*MB**2/(3*P1Q1*P2Q2) - V18=V18+64*MB*MT/(3*P1Q1*P2Q2)-128*A2*MB**3*MT/(3*P1Q1*P2Q2)- - &4*MT**2/(3*P1Q1*P2Q2)-128*A1*MB**2*MT**2/(3*P1Q1*P2Q2)- - &128*A2*MB**2*MT**2/(3*P1Q1*P2Q2)-128*A1*MB*MT**3/(3*P1Q1*P2Q2)- - &112*A2*MB**2*P1P2/(3*P1Q1*P2Q2)-32*A1*MB*MT*P1P2/(3*P1Q1*P2Q2)- - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q2)-112*A1*MT**2*P1P2/(3*P1Q1*P2Q2)- - &48*A1*P1P2**2/(P1Q1*P2Q2)-48*A2*P1P2**2/(P1Q1*P2Q2)+ - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2**3/(3*P1Q1*P2Q2)+16*A2*P1Q1/(3*P2Q2)+ - &64*A1*A2*MB**2*P1Q1/P2Q2+32*A2**2*MB**2*P1Q1/(3*P2Q2)+ - &112*A1*A2*MB*MT*P1Q1/(3*P2Q2)+368*A1*A2*P1P2*P1Q1/(3*P2Q2)- - &16*P1P2/(3*P1Q2*P2Q2)-32*A1*MB*MT*P1P2/(3*P1Q2*P2Q2)- - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q2)- - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**3/(3*P1Q2*P2Q2)-8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q2) - V18=V18+32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB*MT*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q2)-256*A2*P1Q2/(3*P2Q2)+ - &448*A1*A2*MB**2*P1Q2/(3*P2Q2)-368*A2**2*MB**2*P1Q2/(3*P2Q2)+ - &224*A1*A2*MB*MT*P1Q2/(3*P2Q2)+304*A1*A2*P1P2*P1Q2/(3*P2Q2)+ - &64*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB*MT**3*P1Q2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2*P1Q2/(3*P1Q1**2*P2Q2)+8*P1Q2/(3*P1Q1*P2Q2)- - &160*A1*MB**2*P1Q2/(3*P1Q1*P2Q2)-272*A2*MB**2*P1Q2/(3*P1Q1*P2Q2)+ - &56*A1*MB*MT*P1Q2/(3*P1Q1*P2Q2)+200*A2*MB*MT*P1Q2/(3*P1Q1*P2Q2)- - &48*A1*P1P2*P1Q2/(P1Q1*P2Q2)-256*A2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2)+ - &1024*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q2) - V18=V18-272*A2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1Q2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2*P1Q2**2/(3*P1Q1*P2Q2)-32*A2*MB**4/(3*P2Q1*P2Q2)- - &32*A2*MB**3*MT/(3*P2Q1*P2Q2)+64*A2**2*MB**5*MT/(3*P2Q1*P2Q2)+ - &16*P1P2/(3*P2Q1*P2Q2)-64*A2*MB**2*P1P2/(3*P2Q1*P2Q2)+ - &64*A2**2*MB**4*P1P2/(3*P2Q1*P2Q2)+8*MB**2*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &8*MB*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q1/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q1/(3*P2Q1*P2Q2)+ - &8*MB**2*P1P2/(3*P1Q2*P2Q1*P2Q2)+8*MB*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1*P2Q2)+ - &16*MB*MT*P1P2**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) - V18=V18+16*P1P2**3/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q2/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q2/(3*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1*P2Q2)+272*A1*P2Q1/(3*P2Q2)+ - &112*A2*P2Q1/P2Q2-80*A1*A2*MB**2*P2Q1/P2Q2- - &400*A1*A2*MB*MT*P2Q1/(3*P2Q2)+208*A2**2*MB*MT*P2Q1/(3*P2Q2)- - &272*A1*A2*MT**2*P2Q1/(3*P2Q2)-320*A1*A2*P1P2*P2Q1/P2Q2+ - &96*A2**2*P1P2*P2Q1/P2Q2+256*A1*MB*MT**3*P2Q1/(3*P1Q1**2*P2Q2)+ - &512*A1*MT**2*P1P2*P2Q1/(3*P1Q1**2*P2Q2)-8*P2Q1/(3*P1Q1*P2Q2)- - &200*A1*MB*MT*P2Q1/(3*P1Q1*P2Q2)-56*A2*MB*MT*P2Q1/(3*P1Q1*P2Q2)+ - &272*A1*MT**2*P2Q1/(3*P1Q1*P2Q2)+160*A2*MT**2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*P1P2*P2Q1/(3*P1Q1*P2Q2)+48*A2*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q1*P2Q2)- - &1024*A1*A2*P1P2**2*P2Q1/(3*P1Q1*P2Q2)- - &544*A1*A2*P1Q1*P2Q1/(3*P2Q2)-640*A2**2*P1Q1*P2Q1/(3*P2Q2)- - &32*A1*P1P2*P2Q1/(3*P1Q2*P2Q2) - V18=V18+32*A1*A2*MB*MT*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &64*A1*A2*P1P2**2*P2Q1/(3*P1Q2*P2Q2)- - &32*A1*MT**2*P1P2*P2Q1/(3*P1Q1*P1Q2*P2Q2)+ - &64*A1*A2*P1P2*P1Q1*P2Q1/(3*P1Q2*P2Q2)- - &944*A1*A2*P1Q2*P2Q1/(3*P2Q2)-32*A2**2*P1Q2*P2Q1/P2Q2+ - &256*A1*MT**2*P1Q2*P2Q1/(3*P1Q1**2*P2Q2)+ - &96*A1*P1Q2*P2Q1/(P1Q1*P2Q2)+96*A2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MT**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &512*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &512*A1*A2*P1Q2**2*P2Q1/(3*P1Q1*P2Q2)+544*A1*A2*P2Q1**2/(3*P2Q2)- - &256*A1*MT**2*P2Q1**2/(3*P1Q1**2*P2Q2)- - &272*A1*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MT**2*P2Q1**2/(3*P1Q1*P2Q2) - V18=V18+512*A1*A2*P1P2*P2Q1**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1Q2*P2Q1**2/(3*P1Q1*P2Q2)+224*A12*P2Q2+ - &656*A1*A2*P2Q2/3+256*A12*MT**4*P2Q2/(3*P1Q1**2)+ - &16*A1*P2Q2/(3*P1Q1)+112*A1*A2*MB*MT*P2Q2/(3*P1Q1)+ - &32*A12*MT**2*P2Q2/(3*P1Q1)+64*A1*A2*MT**2*P2Q2/P1Q1+ - &368*A1*A2*P1P2*P2Q2/(3*P1Q1)-256*A1*MT**2*P2Q2/(3*P1Q2**2)+ - &256*A12*MT**4*P2Q2/(3*P1Q2**2)-256*A1*P2Q2/(3*P1Q2)+ - &224*A1*A2*MB*MT*P2Q2/(3*P1Q2)-368*A12*MT**2*P2Q2/(3*P1Q2)+ - &448*A1*A2*MT**2*P2Q2/(3*P1Q2)+304*A1*A2*P1P2*P2Q2/(3*P1Q2)+ - &16*A1*MT**2*P2Q2/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q2/(3*P1Q1*P1Q2)+ - &32*A12*P1Q1*P2Q2/P1Q2+944*A1*A2*P1Q1*P2Q2/(3*P1Q2)+ - &256*A12*MT**2*P1Q2*P2Q2/(3*P1Q1**2)+ - &640*A12*P1Q2*P2Q2/(3*P1Q1)+544*A1*A2*P1Q2*P2Q2/(3*P1Q1)- - &256*A2*MB**2*P2Q2/(3*P2Q1**2)-256*A2**2*MB**3*MT*P2Q2/(3*P2Q1**2)+ - &64*MB**2*MT**2*P2Q2/(3*P1Q2**2*P2Q1**2)+ - &64*MB**2*P2Q2/(3*P1Q2*P2Q1**2)- - &128*A2*MB**3*MT*P2Q2/(3*P1Q2*P2Q1**2) - V18=V18-128*A2*MB**2*MT**2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1P2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1**2)+ - &256*A2**2*MB**2*P1Q2*P2Q2/(3*P2Q1**2)+272*A1*P2Q2/(3*P2Q1)+ - &112*A2*P2Q2/P2Q1-80*A1*A2*MB**2*P2Q2/P2Q1- - &400*A1*A2*MB*MT*P2Q2/(3*P2Q1)+208*A2**2*MB*MT*P2Q2/(3*P2Q1)- - &272*A1*A2*MT**2*P2Q2/(3*P2Q1)-320*A1*A2*P1P2*P2Q2/P2Q1+ - &96*A2**2*P1P2*P2Q2/P2Q1-32*A1*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MB*MT*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &64*A1*A2*P1P2**2*P2Q2/(3*P1Q1*P2Q1)-944*A1*A2*P1Q1*P2Q2/(3*P2Q1)- - &32*A2**2*P1Q1*P2Q2/P2Q1+256*A1*MB*MT**3*P2Q2/(3*P1Q2**2*P2Q1)+ - &512*A1*MT**2*P1P2*P2Q2/(3*P1Q2**2*P2Q1)+ - &256*A1*MT**2*P1Q1*P2Q2/(3*P1Q2**2*P2Q1)-8*P2Q2/(3*P1Q2*P2Q1)- - &200*A1*MB*MT*P2Q2/(3*P1Q2*P2Q1)-56*A2*MB*MT*P2Q2/(3*P1Q2*P2Q1)+ - &272*A1*MT**2*P2Q2/(3*P1Q2*P2Q1)+160*A2*MT**2*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*P1P2*P2Q2/(3*P1Q2*P2Q1)+48*A2*P1P2*P2Q2/(P1Q2*P2Q1) - V18=V18-256*A1*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1)- - &256*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q2*P2Q1)- - &1024*A1*A2*P1P2**2*P2Q2/(3*P1Q2*P2Q1)- - &32*A1*MT**2*P1P2*P2Q2/(3*P1Q1*P1Q2*P2Q1)+ - &96*A1*P1Q1*P2Q2/(P1Q2*P2Q1)+96*A2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MT**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &512*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &512*A1*A2*P1Q1**2*P2Q2/(3*P1Q2*P2Q1)-544*A1*A2*P1Q2*P2Q2/(3*P2Q1)- - &640*A2**2*P1Q2*P2Q2/(3*P2Q1)+ - &64*A1*A2*P1P2*P1Q2*P2Q2/(3*P1Q1*P2Q1)+544*A1*A2*P2Q2**2/(3*P2Q1)- - &256*A1*MT**2*P2Q2**2/(3*P1Q2**2*P2Q1)- - &272*A1*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MT**2*P2Q2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P2Q2**2/(3*P1Q2*P2Q1) - V18=V18+512*A1*A2*P1Q1*P2Q2**2/(3*P1Q2*P2Q1)+ - &384*A12*MB*MT*P1Q1**2/S**2+ - &384*A12*P1P2*P1Q1**2/S**2+2688*A12*MB*MT*P1Q1*P1Q2/S**2+ - &2688*A12*P1P2*P1Q1*P1Q2/S**2+384*A12*MB*MT*P1Q2**2/S**2+ - &384*A12*P1P2*P1Q2**2/S**2+768*A1*A2*MB*MT*P1Q1*P2Q1/S**2+ - &768*A1*A2*P1P2*P1Q1*P2Q1/S**2+2688*A1*A2*MB*MT*P1Q2*P2Q1/S**2+ - &2688*A1*A2*P1P2*P1Q2*P2Q1/S**2-960*A12*P1Q1*P1Q2*P2Q1/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q1/S**2+960*A12*P1Q2**2*P2Q1/S**2+ - &960*A1*A2*P1Q2**2*P2Q1/S**2+384*A2**2*MB*MT*P2Q1**2/S**2+ - &384*A2**2*P1P2*P2Q1**2/S**2-960*A1*A2*P1Q2*P2Q1**2/S**2- - &960*A2**2*P1Q2*P2Q1**2/S**2+2688*A1*A2*MB*MT*P1Q1*P2Q2/S**2+ - &2688*A1*A2*P1P2*P1Q1*P2Q2/S**2+960*A12*P1Q1**2*P2Q2/S**2+ - &960*A1*A2*P1Q1**2*P2Q2/S**2+768*A1*A2*MB*MT*P1Q2*P2Q2/S**2+ - &768*A1*A2*P1P2*P1Q2*P2Q2/S**2-960*A12*P1Q1*P1Q2*P2Q2/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q2/S**2+2688*A2**2*MB*MT*P2Q1*P2Q2/S**2+ - &2688*A2**2*P1P2*P2Q1*P2Q2/S**2+960*A1*A2*P1Q1*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q1*P2Q1*P2Q2/S**2+960*A1*A2*P1Q2*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q2*P2Q1*P2Q2/S**2+384*A2**2*MB*MT*P2Q2**2/S**2 - V18=V18+384*A2**2*P1P2*P2Q2**2/S**2-960*A1*A2*P1Q1*P2Q2**2/S**2- - &960*A2**2*P1Q1*P2Q2**2/S**2+96*A1*MB*MT/S+96*A2*MB*MT/S- - &768*A2**2*MB**3*MT/S-768*A12*MB*MT**3/S-192*A1*P1P2/S- - &192*A2*P1P2/S-768*A2**2*MB**2*P1P2/S-2304*A1*A2*MB*MT*P1P2/S- - &768*A12*MT**2*P1P2/S-2304*A1*A2*P1P2**2/S- - &96*A1*MB*MT**3/(P1Q1*S)-192*A2*MB*MT*P1P2/(P1Q1*S)- - &96*A1*MT**2*P1P2/(P1Q1*S)-192*A2*P1P2**2/(P1Q1*S)-192*A1*P1Q1/S- - &144*A2*P1Q1/S-384*A1*A2*MB**2*P1Q1/S-480*A2**2*MB**2*P1Q1/S- - &480*A12*MB*MT*P1Q1/S+96*A1*A2*MB*MT*P1Q1/S- - &864*A12*P1P2*P1Q1/S-672*A1*A2*P1P2*P1Q1/S-96*A1*A2*P1Q1**2/S- - &96*A1*MB*MT**3/(P1Q2*S)-192*A2*MB*MT*P1P2/(P1Q2*S)- - &96*A1*MT**2*P1P2/(P1Q2*S)-192*A2*P1P2**2/(P1Q2*S)- - &48*A1*MB*MT*P1Q1/(P1Q2*S)+96*A2*MB*MT*P1Q1/(P1Q2*S)- - &48*A1*MT**2*P1Q1/(P1Q2*S)-192*A1*P1P2*P1Q1/(P1Q2*S)- - &192*A2*P1P2*P1Q1/(P1Q2*S)+192*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*S)+ - &192*A1*A2*P1P2**2*P1Q1/(P1Q2*S)-192*A1*P1Q1**2/(P1Q2*S)- - &192*A2*P1Q1**2/(P1Q2*S)+192*A1*A2*MB**2*P1Q1**2/(P1Q2*S) - V18=V18-192*A12*MB*MT*P1Q1**2/(P1Q2*S)+ - &96*A1*A2*MB*MT*P1Q1**2/(P1Q2*S)+ - &192*A1*A2*P1P2*P1Q1**2/(P1Q2*S)-192*A1*P1Q2/S-144*A2*P1Q2/S- - &384*A1*A2*MB**2*P1Q2/S-480*A2**2*MB**2*P1Q2/S- - &480*A12*MB*MT*P1Q2/S+96*A1*A2*MB*MT*P1Q2/S- - &864*A12*P1P2*P1Q2/S-672*A1*A2*P1P2*P1Q2/S- - &48*A1*MB*MT*P1Q2/(P1Q1*S)+96*A2*MB*MT*P1Q2/(P1Q1*S)- - &48*A1*MT**2*P1Q2/(P1Q1*S)-192*A1*P1P2*P1Q2/(P1Q1*S)- - &192*A2*P1P2*P1Q2/(P1Q1*S)+192*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*S)+ - &192*A1*A2*P1P2**2*P1Q2/(P1Q1*S)-576*A1*A2*P1Q1*P1Q2/S- - &96*A1*A2*P1Q2**2/S-192*A1*P1Q2**2/(P1Q1*S)- - &192*A2*P1Q2**2/(P1Q1*S)+192*A1*A2*MB**2*P1Q2**2/(P1Q1*S)- - &192*A12*MB*MT*P1Q2**2/(P1Q1*S)+96*A1*A2*MB*MT*P1Q2**2/(P1Q1*S)+ - &192*A1*A2*P1P2*P1Q2**2/(P1Q1*S)+96*A2*MB**3*MT/(P2Q1*S)+ - &96*A2*MB**2*P1P2/(P2Q1*S)+192*A1*MB*MT*P1P2/(P2Q1*S)+ - &192*A1*P1P2**2/(P2Q1*S)+96*A1*MB**2*P1Q1/(P2Q1*S)+ - &192*A2*MB**2*P1Q1/(P2Q1*S)+96*A1*MB*MT*P1Q1/(P2Q1*S)+ - &192*A1*A2*MB**3*MT*P1Q1/(P2Q1*S)+192*A1*P1P2*P1Q1/(P2Q1*S) - V18=V18+192*A1*A2*MB**2*P1P2*P1Q1/(P2Q1*S)+ - &96*A1*A2*MB**2*P1Q1**2/(P2Q1*S)+ - &192*A2*MB**3*MT*P1Q1/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*P1P2**2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &48*A1*MB*MT*P1Q1**2/(P1Q2*P2Q1*S)+ - &96*A1*P1P2*P1Q1**2/(P1Q2*P2Q1*S)+96*A1*MB**2*P1Q2/(P2Q1*S)+ - &48*A2*MB**2*P1Q2/(P2Q1*S)-192*A1*A2*MB**3*MT*P1Q2/(P2Q1*S)- - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q1*S)- - &96*A1*A2*MB**2*P1Q2**2/(P2Q1*S)+144*A1*P2Q1/S+192*A2*P2Q1/S- - &96*A1*A2*MB*MT*P2Q1/S+480*A2**2*MB*MT*P2Q1/S+ - &480*A12*MT**2*P2Q1/S+384*A1*A2*MT**2*P2Q1/S+ - &672*A1*A2*P1P2*P2Q1/S+864*A2**2*P1P2*P2Q1/S+ - &96*A2*MB*MT*P2Q1/(P1Q1*S)+192*A1*MT**2*P2Q1/(P1Q1*S) - V18=V18+96*A2*MT**2*P2Q1/(P1Q1*S)+ - &192*A1*A2*MB*MT**3*P2Q1/(P1Q1*S)+ - &192*A2*P1P2*P2Q1/(P1Q1*S)+192*A1*A2*MT**2*P1P2*P2Q1/(P1Q1*S)- - &192*A12*P1Q1*P2Q1/S-192*A2**2*P1Q1*P2Q1/S+ - &48*A1*MT**2*P2Q1/(P1Q2*S)+96*A2*MT**2*P2Q1/(P1Q2*S)- - &192*A1*A2*MB*MT**3*P2Q1/(P1Q2*S)- - &192*A1*A2*MT**2*P1P2*P2Q1/(P1Q2*S)- - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P1Q2*S)- - &192*A12*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &96*A1*A2*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &384*A1*A2*P1P2*P1Q1*P2Q1/(P1Q2*S)-384*A12*P1Q1**2*P2Q1/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q1/(P1Q2*S)-480*A12*P1Q2*P2Q1/S- - &960*A1*A2*P1Q2*P2Q1/S-480*A2**2*P1Q2*P2Q1/S+ - &144*A1*P1Q2*P2Q1/(P1Q1*S)+96*A2*P1Q2*P2Q1/(P1Q1*S)- - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*S)- - &96*A12*MT**2*P1Q2*P2Q1/(P1Q1*S)+ - &96*A1*A2*MT**2*P1Q2*P2Q1/(P1Q1*S)- - &576*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*S)-192*A12*P1Q2**2*P2Q1/(P1Q1*S) - V18=V18-384*A1*A2*P1Q2**2*P2Q1/(P1Q1*S)-96*A1*A2*P2Q1**2/S- - &96*A1*A2*MT**2*P2Q1**2/(P1Q1*S)+96*A1*A2*MT**2*P2Q1**2/(P1Q2*S)+ - &288*A1*A2*P1Q2*P2Q1**2/(P1Q1*S)+96*A2*MB**3*MT/(P2Q2*S)+ - &96*A2*MB**2*P1P2/(P2Q2*S)+192*A1*MB*MT*P1P2/(P2Q2*S)+ - &192*A1*P1P2**2/(P2Q2*S)+96*A1*MB**2*P1Q1/(P2Q2*S)+ - &48*A2*MB**2*P1Q1/(P2Q2*S)-192*A1*A2*MB**3*MT*P1Q1/(P2Q2*S)- - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q2*S)- - &96*A1*A2*MB**2*P1Q1**2/(P2Q2*S)+96*A1*MB**2*P1Q2/(P2Q2*S)+ - &192*A2*MB**2*P1Q2/(P2Q2*S)+96*A1*MB*MT*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**3*MT*P1Q2/(P2Q2*S)+192*A1*P1P2*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q2*S)+ - &192*A2*MB**3*MT*P1Q2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2**2*P1Q2/(P1Q1*P2Q2*S)+96*A1*A2*MB**2*P1Q2**2/(P2Q2*S)+ - &96*A1*MB**2*P1Q2**2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1Q2**2/(P1Q1*P2Q2*S) - V18=V18+48*A1*MB*MT*P1Q2**2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2*P1Q2**2/(P1Q1*P2Q2*S)-48*A2*MB**2*P2Q1/(P2Q2*S)+ - &96*A1*MB*MT*P2Q1/(P2Q2*S)-48*A2*MB*MT*P2Q1/(P2Q2*S)- - &192*A1*P1P2*P2Q1/(P2Q2*S)-192*A2*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*MB*MT*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*P1P2**2*P2Q1/(P2Q2*S)- - &192*A1*MB*MT**3*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &192*A1*MT**2*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2**2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &192*A2**2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P2Q2*S)+ - &384*A1*A2*P1P2*P1Q1*P2Q1/(P2Q2*S)-96*A1*P1Q2*P2Q1/(P2Q2*S)- - &144*A2*P1Q2*P2Q1/(P2Q2*S)-96*A1*A2*MB**2*P1Q2*P2Q1/(P2Q2*S)+ - &96*A2**2*MB**2*P1Q2*P2Q1/(P2Q2*S)+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P2Q2*S) - V18=V18+576*A1*A2*P1P2*P1Q2*P2Q1/(P2Q2*S)- - &96*A2*MB**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &48*A1*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &48*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*MT**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q1/(P2Q2*S)+288*A1*A2*P1Q2**2*P2Q1/(P2Q2*S)- - &96*A1*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)-96*A2*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)+ - &192*A1*P2Q1**2/(P2Q2*S)+192*A2*P2Q1**2/(P2Q2*S)- - &96*A1*A2*MB*MT*P2Q1**2/(P2Q2*S)+192*A2**2*MB*MT*P2Q1**2/(P2Q2*S)- - &192*A1*A2*MT**2*P2Q1**2/(P2Q2*S)-192*A1*A2*P1P2*P2Q1**2/(P2Q2*S)+ - &48*A2*MB*MT*P2Q1**2/(P1Q1*P2Q2*S)+ - &192*A1*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1P2*P2Q1**2/(P1Q1*P2Q2*S)-384*A1*A2*P1Q1*P2Q1**2/(P2Q2*S)- - &384*A2**2*P1Q1*P2Q1**2/(P2Q2*S)-384*A1*A2*P1Q2*P2Q1**2/(P2Q2*S) - V18=V18-192*A2**2*P1Q2*P2Q1**2/(P2Q2*S)+ - &96*A1*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+144*A1*P2Q2/S+192*A2*P2Q2/S- - &96*A1*A2*MB*MT*P2Q2/S+480*A2**2*MB*MT*P2Q2/S+ - &480*A12*MT**2*P2Q2/S+384*A1*A2*MT**2*P2Q2/S+ - &672*A1*A2*P1P2*P2Q2/S+864*A2**2*P1P2*P2Q2/S+ - &48*A1*MT**2*P2Q2/(P1Q1*S)+96*A2*MT**2*P2Q2/(P1Q1*S)- - &192*A1*A2*MB*MT**3*P2Q2/(P1Q1*S)- - &192*A1*A2*MT**2*P1P2*P2Q2/(P1Q1*S)-480*A12*P1Q1*P2Q2/S- - &960*A1*A2*P1Q1*P2Q2/S-480*A2**2*P1Q1*P2Q2/S+ - &96*A2*MB*MT*P2Q2/(P1Q2*S)+192*A1*MT**2*P2Q2/(P1Q2*S)+ - &96*A2*MT**2*P2Q2/(P1Q2*S)+192*A1*A2*MB*MT**3*P2Q2/(P1Q2*S)+ - &192*A2*P1P2*P2Q2/(P1Q2*S)+192*A1*A2*MT**2*P1P2*P2Q2/(P1Q2*S)+ - &144*A1*P1Q1*P2Q2/(P1Q2*S)+96*A2*P1Q1*P2Q2/(P1Q2*S)- - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*S)- - &96*A12*MT**2*P1Q1*P2Q2/(P1Q2*S)+ - &96*A1*A2*MT**2*P1Q1*P2Q2/(P1Q2*S) - V18=V18-576*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*S)- - &192*A12*P1Q1**2*P2Q2/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q2/(P1Q2*S)-192*A12*P1Q2*P2Q2/S- - &192*A2**2*P1Q2*P2Q2/S-96*A1*A2*MB*MT*P1Q2*P2Q2/(P1Q1*S)- - &192*A12*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &96*A1*A2*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1P2*P1Q2*P2Q2/(P1Q1*S)-384*A12*P1Q2**2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q2/(P1Q1*S)-48*A2*MB**2*P2Q2/(P2Q1*S)+ - &96*A1*MB*MT*P2Q2/(P2Q1*S)-48*A2*MB*MT*P2Q2/(P2Q1*S)- - &192*A1*P1P2*P2Q2/(P2Q1*S)-192*A2*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*MB*MT*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*P1P2**2*P2Q2/(P2Q1*S)-96*A1*P1Q1*P2Q2/(P2Q1*S)- - &144*A2*P1Q1*P2Q2/(P2Q1*S)-96*A1*A2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &96*A2**2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P2Q1*S)+ - &576*A1*A2*P1P2*P1Q1*P2Q2/(P2Q1*S)+288*A1*A2*P1Q1**2*P2Q2/(P2Q1*S)- - &192*A1*MB*MT**3*P2Q2/(P1Q2*P2Q1*S) - V18=V18-96*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &192*A1*MT**2*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2**2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*MB**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)+ - &48*A1*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S) - - V18BIS= - &48*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*MT**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)-96*A2*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)+ - &96*A1*A2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &192*A2**2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*MB*MT*P1Q2*P2Q2/(P2Q1*S)+ - &384*A1*A2*P1P2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q2/(P2Q1*S)-576*A1*A2*P2Q1*P2Q2/S+ - &96*A1*A2*P1Q1*P2Q1*P2Q2/(P1Q2*S)+96*A1*A2*P1Q2*P2Q1*P2Q2/(P1Q1*S)- - &96*A1*A2*P2Q2**2/S+96*A1*A2*MT**2*P2Q2**2/(P1Q1*S)- - &96*A1*A2*MT**2*P2Q2**2/(P1Q2*S)+288*A1*A2*P1Q1*P2Q2**2/(P1Q2*S)+ - &192*A1*P2Q2**2/(P2Q1*S)+192*A2*P2Q2**2/(P2Q1*S)- - &96*A1*A2*MB*MT*P2Q2**2/(P2Q1*S)+192*A2**2*MB*MT*P2Q2**2/(P2Q1*S)- - &192*A1*A2*MT**2*P2Q2**2/(P2Q1*S)-192*A1*A2*P1P2*P2Q2**2/(P2Q1*S) - V18BIS=V18BIS-384*A1*A2*P1Q1*P2Q2**2/(P2Q1*S)- - &192*A2**2*P1Q1*P2Q2**2/(P2Q1*S)+ - &48*A2*MB*MT*P2Q2**2/(P1Q2*P2Q1*S)+ - &192*A1*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1P2*P2Q2**2/(P1Q2*P2Q1*S)+96*A1*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)-384*A1*A2*P1Q2*P2Q2**2/(P2Q1*S)- - &384*A2**2*P1Q2*P2Q2**2/(P2Q1*S)+512*A1*A2*S/3- - &128*A1*MT**2*S/(3*P1Q1**2)-128*A12*MB*MT**3*S/(3*P1Q1**2)- - &152*A1*S/(3*P1Q1)+152*A12*MB*MT*S/(3*P1Q1)+ - &128*A1*A2*MB*MT*S/(3*P1Q1)+112*A1*A2*MT**2*S/(3*P1Q1)- - &16*A12*P1P2*S/P1Q1+152*A1*A2*P1P2*S/(3*P1Q1)- - &128*A1*MT**2*S/(3*P1Q2**2)-128*A12*MB*MT**3*S/(3*P1Q2**2)- - &152*A1*S/(3*P1Q2)+152*A12*MB*MT*S/(3*P1Q2)+ - &128*A1*A2*MB*MT*S/(3*P1Q2)+112*A1*A2*MT**2*S/(3*P1Q2)- - &16*A12*P1P2*S/P1Q2+152*A1*A2*P1P2*S/(3*P1Q2)- - &16*A1*MB*MT*S/(3*P1Q1*P1Q2)+32*A12*MB*MT**3*S/(3*P1Q1*P1Q2) - V18BIS=V18BIS-16*A1*P1P2*S/(3*P1Q1*P1Q2)+ - &272*A1*A2*P1Q1*S/(3*P1Q2)+ - &272*A1*A2*P1Q2*S/(3*P1Q1)-128*A2*MB**2*S/(3*P2Q1**2)- - &128*A2**2*MB**3*MT*S/(3*P2Q1**2)+ - &32*MB**2*MT**2*S/(3*P1Q2**2*P2Q1**2)+32*MB**2*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**3*MT*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1**2)+ - &128*A2**2*MB**2*P1Q2*S/(3*P2Q1**2)+152*A2*S/(3*P2Q1)- - &112*A1*A2*MB**2*S/(3*P2Q1)-128*A1*A2*MB*MT*S/(3*P2Q1)- - &152*A2**2*MB*MT*S/(3*P2Q1)-152*A1*A2*P1P2*S/(3*P2Q1)+ - &16*A2**2*P1P2*S/P2Q1+8*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q1)+ - &8*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q1)-8*A1*P1P2*S/(3*P1Q1*P2Q1)- - &8*A2*P1P2*S/(3*P1Q1*P2Q1)+8*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1) - V18BIS=V18BIS+8*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q1)+ - &32*A1*A2*P1P2**2*S/(3*P1Q1*P2Q1)-32*A2**2*P1Q1*S/(3*P2Q1)- - &32*MT**2*S/(3*P1Q2**2*P2Q1)+64*A1*MB**2*MT**2*S/(3*P1Q2**2*P2Q1)+ - &64*A1*MB*MT**3*S/(3*P1Q2**2*P2Q1)+ - &128*A1*MT**2*P1P2*S/(3*P1Q2**2*P2Q1)-12*S/(P1Q2*P2Q1)+ - &24*A1*MB**2*S/(P1Q2*P2Q1)-64*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q1)+ - &24*A2*MT**2*S/(P1Q2*P2Q1)-128*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q1)+56*A1*P1P2*S/(3*P1Q2*P2Q1)+ - &56*A2*P1P2*S/(3*P1Q2*P2Q1)-64*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2**2*S/(3*P1Q2*P2Q1)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+ - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+136*A2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P1Q1*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1)-160*A2**2*P1Q2*S/(3*P2Q1) - V18BIS=V18BIS+16*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1)- - &32*A12*P2Q1*S/(3*P1Q1)- - &128*A12*MT**2*P2Q1*S/(3*P1Q2**2)-160*A12*P2Q1*S/(3*P1Q2)- - &128*A2*MB**2*S/(3*P2Q2**2)-128*A2**2*MB**3*MT*S/(3*P2Q2**2)+ - &32*MB**2*MT**2*S/(3*P1Q1**2*P2Q2**2)+32*MB**2*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**3*MT*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2**2)+ - &128*A2**2*MB**2*P1Q1*S/(3*P2Q2**2)- - &128*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2**2)+152*A2*S/(3*P2Q2)- - &112*A1*A2*MB**2*S/(3*P2Q2)-128*A1*A2*MB*MT*S/(3*P2Q2)- - &152*A2**2*MB*MT*S/(3*P2Q2)-152*A1*A2*P1P2*S/(3*P2Q2)+ - &16*A2**2*P1P2*S/P2Q2-32*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB**2*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB*MT**3*S/(3*P1Q1**2*P2Q2)+ - &128*A1*MT**2*P1P2*S/(3*P1Q1**2*P2Q2)-12*S/(P1Q1*P2Q2)+ - &24*A1*MB**2*S/(P1Q1*P2Q2)-64*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q2) - V18BIS=V18BIS+24*A2*MT**2*S/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q2)+56*A1*P1P2*S/(3*P1Q1*P2Q2)+ - &56*A2*P1P2*S/(3*P1Q1*P2Q2)-64*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2**2*S/(3*P1Q1*P2Q2)-160*A2**2*P1Q1*S/(3*P2Q2)+ - &8*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q2)-8*A1*P1P2*S/(3*P1Q2*P2Q2)- - &8*A2*P1P2*S/(3*P1Q2*P2Q2)+8*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q2)+ - &32*A1*A2*P1P2**2*S/(3*P1Q2*P2Q2)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &16*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q2)-32*A2**2*P1Q2*S/(3*P2Q2) - V18BIS=V18BIS+136*A2*P1Q2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P1Q2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q2)-16*A2*MB*MT*S/(3*P2Q1*P2Q2)+ - &32*A2**2*MB**3*MT*S/(3*P2Q1*P2Q2)-16*A2*P1P2*S/(3*P2Q1*P2Q2)- - &4*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+8*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1*P2Q2)- - &8*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1*P2Q2)-4*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1*P2Q2)- - &8*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &2*MB**3*MT*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB**2*MT**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &2*MB*MT**3*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &4*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &8*P1P2**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1*P2Q2) - V18BIS=V18BIS+8*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1*P2Q2)+ - &272*A1*A2*P2Q1*S/(3*P2Q2)- - &128*A1*MT**2*P2Q1*S/(3*P1Q1**2*P2Q2)-136*A1*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MB*MT*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MT**2*P2Q1*S/(3*P1Q1*P2Q2)+ - &256*A1*A2*P1P2*P2Q1*S/(3*P1Q1*P2Q2)- - &16*A1*A2*P1P2*P2Q1*S/(3*P1Q2*P2Q2)+ - &8*A1*P1P2*P2Q1*S/(3*P1Q1*P1Q2*P2Q2)+ - &256*A1*A2*P1Q2*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A12*MT**2*P2Q2*S/(3*P1Q1**2)-160*A12*P2Q2*S/(3*P1Q1)- - &32*A12*P2Q2*S/(3*P1Q2)+272*A1*A2*P2Q2*S/(3*P2Q1)- - &16*A1*A2*P1P2*P2Q2*S/(3*P1Q1*P2Q1)- - &128*A1*MT**2*P2Q2*S/(3*P1Q2**2*P2Q1)-136*A1*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MT**2*P2Q2*S/(3*P1Q2*P2Q1)+ - &256*A1*A2*P1P2*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A1*P1P2*P2Q2*S/(3*P1Q1*P1Q2*P2Q1) - V18BIS=V18BIS+256*A1*A2*P1Q1*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A12*MB*MT*S**2/(3*P1Q1*P1Q2)+16*A12*P1P2*S**2/(3*P1Q1*P1Q2)- - &8*A1*A2*P1P2*S**2/(3*P1Q1*P2Q1)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*A2*P1P2*S**2/(3*P1Q2*P2Q2)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q2)+ - &8*A2**2*MB*MT*S**2/(3*P2Q1*P2Q2)+16*A2**2*P1P2*S**2/(3*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q1*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q2*P2Q1*P2Q2)+ - &2*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) -C - - A18 = 640*A1/3+640*A2/3+32*A1*A2*MB**2+368*A12*MB*MT+ - &512*A1*A2*MB*MT/3+ - &368*A2**2*MB*MT+32*A1*A2*MT**2+496*A12*P1P2/3+ - &320*A1*A2*P1P2+496*A2**2*P1P2/3-128*A1*MB*MT**3/(3*P1Q1**2)+ - &128*A1*MT**4/(3*P1Q1**2)+256*A12*MB*MT**5/(3*P1Q1**2)+ - &256*A1*MT**2*P1P2/(3*P1Q1**2)-256*A12*MT**4*P1P2/(3*P1Q1**2)+ - &8/(3*P1Q1)+32*A1*MB*MT/P1Q1+56*A2*MB*MT/(3*P1Q1)+ - &88*A1*MT**2/(3*P1Q1)+72*A2*MT**2/P1Q1- - &704*A12*MB*MT**3/(3*P1Q1)+224*A1*A2*MB*MT**3/(3*P1Q1)+ - &104*A1*P1P2/(3*P1Q1)+48*A2*P1P2/P1Q1- - &128*A1*A2*MB*MT*P1P2/(3*P1Q1)+512*A12*MT**2*P1P2/(3*P1Q1)- - &448*A1*A2*MT**2*P1P2/(3*P1Q1)-32*A1*A2*P1P2**2/P1Q1- - &656*A1*A2*P1Q1/3-224*A2**2*P1Q1-128*A1*MB*MT**3/(3*P1Q2**2)+ - &128*A1*MT**4/(3*P1Q2**2)+256*A12*MB*MT**5/(3*P1Q2**2)+ - &256*A1*MT**2*P1P2/(3*P1Q2**2)-256*A12*MT**4*P1P2/(3*P1Q2**2)+ - &256*A1*MT**2*P1Q1/(3*P1Q2**2)-256*A12*MB*MT**3*P1Q1/(3*P1Q2**2)+ - &8/(3*P1Q2)+32*A1*MB*MT/P1Q2+56*A2*MB*MT/(3*P1Q2) - A18=A18+88*A1*MT**2/(3*P1Q2)+72*A2*MT**2/P1Q2- - &704*A12*MB*MT**3/(3*P1Q2)+224*A1*A2*MB*MT**3/(3*P1Q2)+ - &104*A1*P1P2/(3*P1Q2)+48*A2*P1P2/P1Q2- - &128*A1*A2*MB*MT*P1P2/(3*P1Q2)+512*A12*MT**2*P1P2/(3*P1Q2)- - &448*A1*A2*MT**2*P1P2/(3*P1Q2)-32*A1*A2*P1P2**2/P1Q2+ - &32*A1*MB*MT**3/(3*P1Q1*P1Q2)-32*A1*MT**4/(3*P1Q1*P1Q2)- - &64*A12*MB*MT**5/(3*P1Q1*P1Q2)+16*P1P2/(3*P1Q1*P1Q2)- - &64*A1*MT**2*P1P2/(3*P1Q1*P1Q2)+64*A12*MT**4*P1P2/(3*P1Q1*P1Q2)+ - &112*A1*P1Q1/P1Q2+272*A2*P1Q1/(3*P1Q2)- - &272*A1*A2*MB**2*P1Q1/(3*P1Q2)-208*A12*MB*MT*P1Q1/(3*P1Q2)+ - &400*A1*A2*MB*MT*P1Q1/(3*P1Q2)-80*A1*A2*MT**2*P1Q1/P1Q2+ - &96*A12*P1P2*P1Q1/P1Q2-320*A1*A2*P1P2*P1Q1/P1Q2- - &544*A1*A2*P1Q1**2/(3*P1Q2)-656*A1*A2*P1Q2/3-224*A2**2*P1Q2+ - &256*A1*MT**2*P1Q2/(3*P1Q1**2)-256*A12*MB*MT**3*P1Q2/(3*P1Q1**2)+ - &112*A1*P1Q2/P1Q1+272*A2*P1Q2/(3*P1Q1)- - &272*A1*A2*MB**2*P1Q2/(3*P1Q1)-208*A12*MB*MT*P1Q2/(3*P1Q1)+ - &400*A1*A2*MB*MT*P1Q2/(3*P1Q1)-80*A1*A2*MT**2*P1Q2/P1Q1 - A18=A18+96*A12*P1P2*P1Q2/P1Q1-320*A1*A2*P1P2*P1Q2/P1Q1- - &544*A1*A2*P1Q2**2/(3*P1Q1)+128*A2*MB**4/(3*P2Q1**2)- - &128*A2*MB**3*MT/(3*P2Q1**2)+256*A2**2*MB**5*MT/(3*P2Q1**2)+ - &256*A2*MB**2*P1P2/(3*P2Q1**2)-256*A2**2*MB**4*P1P2/(3*P2Q1**2)+ - &256*A2*MB**2*P1Q1/(3*P2Q1**2)-256*A2**2*MB**4*P1Q1/(3*P2Q1**2)+ - &64*MB**3*MT**3/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1**2)- - &64*MB**3*MT/(3*P1Q2*P2Q1**2)- - &256*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**3*MT*P1Q1/(3*P1Q2*P2Q1**2)+ - &512*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q1**2)-8/(3*P2Q1)-72*A1*MB**2/P2Q1- - &88*A2*MB**2/(3*P2Q1)-56*A1*MB*MT/(3*P2Q1)-32*A2*MB*MT/P2Q1- - &224*A1*A2*MB**3*MT/(3*P2Q1)+704*A2**2*MB**3*MT/(3*P2Q1) - A18=A18-48*A1*P1P2/P2Q1-104*A2*P1P2/(3*P2Q1)+ - &448*A1*A2*MB**2*P1P2/(3*P2Q1)-512*A2**2*MB**2*P1P2/(3*P2Q1)+ - &128*A1*A2*MB*MT*P1P2/(3*P2Q1)+32*A1*A2*P1P2**2/P2Q1- - &16*P1P2/(3*P1Q1*P2Q1)+32*A1*MB*MT*P1P2/(3*P1Q1*P2Q1)+ - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q1)+ - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**3/(3*P1Q1*P2Q1)-256*A2*P1Q1/(3*P2Q1)+ - &448*A1*A2*MB**2*P1Q1/(3*P2Q1)-368*A2**2*MB**2*P1Q1/(3*P2Q1)- - &224*A1*A2*MB*MT*P1Q1/(3*P2Q1)+304*A1*A2*P1P2*P1Q1/(3*P2Q1)+ - &64*MB*MT**3/(3*P1Q2**2*P2Q1)+ - &256*A1*MB*MT**3*P1P2/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2**2/(3*P1Q2**2*P2Q1)+ - &64*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1)+ - &128*A1*MB*MT**3*P1Q1/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2*P1Q1/(3*P1Q2**2*P2Q1)-4*MB**2/(3*P1Q2*P2Q1)- - &64*MB*MT/(3*P1Q2*P2Q1)+128*A2*MB**3*MT/(3*P1Q2*P2Q1) - A18=A18-4*MT**2/(3*P1Q2*P2Q1)-128*A1*MB**2*MT**2/(3*P1Q2*P2Q1)- - &128*A2*MB**2*MT**2/(3*P1Q2*P2Q1)+128*A1*MB*MT**3/(3*P1Q2*P2Q1)- - &112*A2*MB**2*P1P2/(3*P1Q2*P2Q1)+32*A1*MB*MT*P1P2/(3*P1Q2*P2Q1)+ - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q1)-112*A1*MT**2*P1P2/(3*P1Q2*P2Q1)- - &48*A1*P1P2**2/(P1Q2*P2Q1)-48*A2*P1P2**2/(P1Q2*P2Q1)- - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2**3/(3*P1Q2*P2Q1)+8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+8*P1Q1/(3*P1Q2*P2Q1)- - &160*A1*MB**2*P1Q1/(3*P1Q2*P2Q1)-272*A2*MB**2*P1Q1/(3*P1Q2*P2Q1)- - &56*A1*MB*MT*P1Q1/(3*P1Q2*P2Q1)-200*A2*MB*MT*P1Q1/(3*P1Q2*P2Q1)- - &48*A1*P1P2*P1Q1/(P1Q2*P2Q1)-256*A2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1)+ - &1024*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q1) - A18=A18-272*A2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1Q1**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P1Q1**2/(3*P1Q2*P2Q1)+16*A2*P1Q2/(3*P2Q1)+ - &64*A1*A2*MB**2*P1Q2/P2Q1+32*A2**2*MB**2*P1Q2/(3*P2Q1)- - &112*A1*A2*MB*MT*P1Q2/(3*P2Q1)+368*A1*A2*P1P2*P1Q2/(3*P2Q1)+ - &32*A2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MB*MT*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q1)+224*A12*P2Q1+ - &656*A1*A2*P2Q1/3-256*A1*MT**2*P2Q1/(3*P1Q1**2)+ - &256*A12*MT**4*P2Q1/(3*P1Q1**2)-256*A1*P2Q1/(3*P1Q1)- - &224*A1*A2*MB*MT*P2Q1/(3*P1Q1)-368*A12*MT**2*P2Q1/(3*P1Q1)+ - &448*A1*A2*MT**2*P2Q1/(3*P1Q1)+304*A1*A2*P1P2*P2Q1/(3*P1Q1)+ - &256*A12*MT**4*P2Q1/(3*P1Q2**2)+ - &256*A12*MT**2*P1Q1*P2Q1/(3*P1Q2**2)+16*A1*P2Q1/(3*P1Q2)- - &112*A1*A2*MB*MT*P2Q1/(3*P1Q2)+32*A12*MT**2*P2Q1/(3*P1Q2) - A18=A18+64*A1*A2*MT**2*P2Q1/P1Q2+368*A1*A2*P1P2*P2Q1/(3*P1Q2)+ - &16*A1*MT**2*P2Q1/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q1/(3*P1Q1*P1Q2)+ - &640*A12*P1Q1*P2Q1/(3*P1Q2)+544*A1*A2*P1Q1*P2Q1/(3*P1Q2)+ - &32*A12*P1Q2*P2Q1/P1Q1+944*A1*A2*P1Q2*P2Q1/(3*P1Q1)+ - &128*A2*MB**4/(3*P2Q2**2)-128*A2*MB**3*MT/(3*P2Q2**2)+ - &256*A2**2*MB**5*MT/(3*P2Q2**2)+256*A2*MB**2*P1P2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1P2/(3*P2Q2**2)+ - &64*MB**3*MT**3/(3*P1Q1**2*P2Q2**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q1**2*P2Q2**2)- - &64*MB**3*MT/(3*P1Q1*P2Q2**2)- - &256*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q1*P2Q2**2)- - &256*A2**2*MB**4*P1Q1/(3*P2Q2**2)+256*A2*MB**2*P1Q2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q2**2)- - &64*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2**2)- - &256*A2*MB**3*MT*P1Q2/(3*P1Q1*P2Q2**2)+ - &512*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2**2) - A18=A18+256*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P2Q1/(3*P2Q2**2)+256*A2**2*MB**3*MT*P2Q1/(3*P2Q2**2)+ - &64*MB**2*MT**2*P2Q1/(3*P1Q1**2*P2Q2**2)+ - &64*MB**2*P2Q1/(3*P1Q1*P2Q2**2)+ - &128*A2*MB**3*MT*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*MT**2*P2Q1/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P1P2*P2Q1/(3*P1Q1*P2Q2**2)+ - &256*A2**2*MB**2*P1Q1*P2Q1/(3*P2Q2**2)- - &256*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2**2)-8/(3*P2Q2)- - &72*A1*MB**2/P2Q2-88*A2*MB**2/(3*P2Q2)-56*A1*MB*MT/(3*P2Q2)- - &32*A2*MB*MT/P2Q2-224*A1*A2*MB**3*MT/(3*P2Q2)+ - &704*A2**2*MB**3*MT/(3*P2Q2)-48*A1*P1P2/P2Q2- - &104*A2*P1P2/(3*P2Q2)+448*A1*A2*MB**2*P1P2/(3*P2Q2)- - &512*A2**2*MB**2*P1P2/(3*P2Q2)+128*A1*A2*MB*MT*P1P2/(3*P2Q2)+ - &32*A1*A2*P1P2**2/P2Q2+64*MB*MT**3/(3*P1Q1**2*P2Q2)+ - &256*A1*MB*MT**3*P1P2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2**2/(3*P1Q1**2*P2Q2)-4*MB**2/(3*P1Q1*P2Q2) - A18=A18-64*MB*MT/(3*P1Q1*P2Q2)+128*A2*MB**3*MT/(3*P1Q1*P2Q2)- - &4*MT**2/(3*P1Q1*P2Q2)-128*A1*MB**2*MT**2/(3*P1Q1*P2Q2)- - &128*A2*MB**2*MT**2/(3*P1Q1*P2Q2)+128*A1*MB*MT**3/(3*P1Q1*P2Q2)- - &112*A2*MB**2*P1P2/(3*P1Q1*P2Q2)+32*A1*MB*MT*P1P2/(3*P1Q1*P2Q2)+ - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q2)-112*A1*MT**2*P1P2/(3*P1Q1*P2Q2)- - &48*A1*P1P2**2/(P1Q1*P2Q2)-48*A2*P1P2**2/(P1Q1*P2Q2)- - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2**3/(3*P1Q1*P2Q2)+16*A2*P1Q1/(3*P2Q2)+ - &64*A1*A2*MB**2*P1Q1/P2Q2+32*A2**2*MB**2*P1Q1/(3*P2Q2)- - &112*A1*A2*MB*MT*P1Q1/(3*P2Q2)+368*A1*A2*P1P2*P1Q1/(3*P2Q2)- - &16*P1P2/(3*P1Q2*P2Q2)+32*A1*MB*MT*P1P2/(3*P1Q2*P2Q2)+ - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q2)+ - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**3/(3*P1Q2*P2Q2)+8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q2) - A18=A18+32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MB*MT*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q2)-256*A2*P1Q2/(3*P2Q2)+ - &448*A1*A2*MB**2*P1Q2/(3*P2Q2)-368*A2**2*MB**2*P1Q2/(3*P2Q2)- - &224*A1*A2*MB*MT*P1Q2/(3*P2Q2)+304*A1*A2*P1P2*P1Q2/(3*P2Q2)+ - &64*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2)+ - &128*A1*MB*MT**3*P1Q2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2*P1Q2/(3*P1Q1**2*P2Q2)+8*P1Q2/(3*P1Q1*P2Q2)- - &160*A1*MB**2*P1Q2/(3*P1Q1*P2Q2)-272*A2*MB**2*P1Q2/(3*P1Q1*P2Q2)- - &56*A1*MB*MT*P1Q2/(3*P1Q1*P2Q2)-200*A2*MB*MT*P1Q2/(3*P1Q1*P2Q2)- - &48*A1*P1P2*P1Q2/(P1Q1*P2Q2)-256*A2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2)+ - &1024*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q2) - A18=A18-272*A2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1Q2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2*P1Q2**2/(3*P1Q1*P2Q2)-32*A2*MB**4/(3*P2Q1*P2Q2)+ - &32*A2*MB**3*MT/(3*P2Q1*P2Q2)-64*A2**2*MB**5*MT/(3*P2Q1*P2Q2)+ - &16*P1P2/(3*P2Q1*P2Q2)-64*A2*MB**2*P1P2/(3*P2Q1*P2Q2)+ - &64*A2**2*MB**4*P1P2/(3*P2Q1*P2Q2)+8*MB**2*P1P2/(3*P1Q1*P2Q1*P2Q2)- - &8*MB*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &32*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q1/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q1/(3*P2Q1*P2Q2)+ - &8*MB**2*P1P2/(3*P1Q2*P2Q1*P2Q2)-8*MB*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &32*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &16*MB*MT*P1P2**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) - A18=A18+16*P1P2**3/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q2/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q2/(3*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1*P2Q2)+272*A1*P2Q1/(3*P2Q2)+ - &112*A2*P2Q1/P2Q2-80*A1*A2*MB**2*P2Q1/P2Q2+ - &400*A1*A2*MB*MT*P2Q1/(3*P2Q2)-208*A2**2*MB*MT*P2Q1/(3*P2Q2)- - &272*A1*A2*MT**2*P2Q1/(3*P2Q2)-320*A1*A2*P1P2*P2Q1/P2Q2+ - &96*A2**2*P1P2*P2Q1/P2Q2-256*A1*MB*MT**3*P2Q1/(3*P1Q1**2*P2Q2)+ - &512*A1*MT**2*P1P2*P2Q1/(3*P1Q1**2*P2Q2)-8*P2Q1/(3*P1Q1*P2Q2)+ - &200*A1*MB*MT*P2Q1/(3*P1Q1*P2Q2)+56*A2*MB*MT*P2Q1/(3*P1Q1*P2Q2)+ - &272*A1*MT**2*P2Q1/(3*P1Q1*P2Q2)+160*A2*MT**2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*P1P2*P2Q1/(3*P1Q1*P2Q2)+48*A2*P1P2*P2Q1/(P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q1*P2Q2)- - &1024*A1*A2*P1P2**2*P2Q1/(3*P1Q1*P2Q2)- - &544*A1*A2*P1Q1*P2Q1/(3*P2Q2)-640*A2**2*P1Q1*P2Q1/(3*P2Q2)- - &32*A1*P1P2*P2Q1/(3*P1Q2*P2Q2) - A18=A18-32*A1*A2*MB*MT*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &64*A1*A2*P1P2**2*P2Q1/(3*P1Q2*P2Q2)- - &32*A1*MT**2*P1P2*P2Q1/(3*P1Q1*P1Q2*P2Q2)+ - &64*A1*A2*P1P2*P1Q1*P2Q1/(3*P1Q2*P2Q2)- - &944*A1*A2*P1Q2*P2Q1/(3*P2Q2)-32*A2**2*P1Q2*P2Q1/P2Q2+ - &256*A1*MT**2*P1Q2*P2Q1/(3*P1Q1**2*P2Q2)+ - &96*A1*P1Q2*P2Q1/(P1Q1*P2Q2)+96*A2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MT**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &512*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &512*A1*A2*P1Q2**2*P2Q1/(3*P1Q1*P2Q2)+544*A1*A2*P2Q1**2/(3*P2Q2)- - &256*A1*MT**2*P2Q1**2/(3*P1Q1**2*P2Q2)- - &272*A1*P2Q1**2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MT**2*P2Q1**2/(3*P1Q1*P2Q2) - A18=A18+512*A1*A2*P1P2*P2Q1**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1Q2*P2Q1**2/(3*P1Q1*P2Q2)+224*A12*P2Q2+ - &656*A1*A2*P2Q2/3+256*A12*MT**4*P2Q2/(3*P1Q1**2)+ - &16*A1*P2Q2/(3*P1Q1)-112*A1*A2*MB*MT*P2Q2/(3*P1Q1)+ - &32*A12*MT**2*P2Q2/(3*P1Q1)+64*A1*A2*MT**2*P2Q2/P1Q1+ - &368*A1*A2*P1P2*P2Q2/(3*P1Q1)-256*A1*MT**2*P2Q2/(3*P1Q2**2)+ - &256*A12*MT**4*P2Q2/(3*P1Q2**2)-256*A1*P2Q2/(3*P1Q2)- - &224*A1*A2*MB*MT*P2Q2/(3*P1Q2)-368*A12*MT**2*P2Q2/(3*P1Q2)+ - &448*A1*A2*MT**2*P2Q2/(3*P1Q2)+304*A1*A2*P1P2*P2Q2/(3*P1Q2)+ - &16*A1*MT**2*P2Q2/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q2/(3*P1Q1*P1Q2)+ - &32*A12*P1Q1*P2Q2/P1Q2+944*A1*A2*P1Q1*P2Q2/(3*P1Q2)+ - &256*A12*MT**2*P1Q2*P2Q2/(3*P1Q1**2)+ - &640*A12*P1Q2*P2Q2/(3*P1Q1)+544*A1*A2*P1Q2*P2Q2/(3*P1Q1)- - &256*A2*MB**2*P2Q2/(3*P2Q1**2)+256*A2**2*MB**3*MT*P2Q2/(3*P2Q1**2)+ - &64*MB**2*MT**2*P2Q2/(3*P1Q2**2*P2Q1**2)+ - &64*MB**2*P2Q2/(3*P1Q2*P2Q1**2)+ - &128*A2*MB**3*MT*P2Q2/(3*P1Q2*P2Q1**2) - A18=A18-128*A2*MB**2*MT**2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1P2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1**2)+ - &256*A2**2*MB**2*P1Q2*P2Q2/(3*P2Q1**2)+272*A1*P2Q2/(3*P2Q1)+ - &112*A2*P2Q2/P2Q1-80*A1*A2*MB**2*P2Q2/P2Q1+ - &400*A1*A2*MB*MT*P2Q2/(3*P2Q1)-208*A2**2*MB*MT*P2Q2/(3*P2Q1)- - &272*A1*A2*MT**2*P2Q2/(3*P2Q1)-320*A1*A2*P1P2*P2Q2/P2Q1+ - &96*A2**2*P1P2*P2Q2/P2Q1-32*A1*P1P2*P2Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB*MT*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &64*A1*A2*P1P2**2*P2Q2/(3*P1Q1*P2Q1)-944*A1*A2*P1Q1*P2Q2/(3*P2Q1)- - &32*A2**2*P1Q1*P2Q2/P2Q1-256*A1*MB*MT**3*P2Q2/(3*P1Q2**2*P2Q1)+ - &512*A1*MT**2*P1P2*P2Q2/(3*P1Q2**2*P2Q1)+ - &256*A1*MT**2*P1Q1*P2Q2/(3*P1Q2**2*P2Q1)-8*P2Q2/(3*P1Q2*P2Q1)+ - &200*A1*MB*MT*P2Q2/(3*P1Q2*P2Q1)+56*A2*MB*MT*P2Q2/(3*P1Q2*P2Q1)+ - &272*A1*MT**2*P2Q2/(3*P1Q2*P2Q1)+160*A2*MT**2*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*P1P2*P2Q2/(3*P1Q2*P2Q1)+48*A2*P1P2*P2Q2/(P1Q2*P2Q1) - A18=A18+256*A1*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1)- - &256*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q2*P2Q1)- - &1024*A1*A2*P1P2**2*P2Q2/(3*P1Q2*P2Q1)- - &32*A1*MT**2*P1P2*P2Q2/(3*P1Q1*P1Q2*P2Q1)+ - &96*A1*P1Q1*P2Q2/(P1Q2*P2Q1)+96*A2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MT**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &512*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &512*A1*A2*P1Q1**2*P2Q2/(3*P1Q2*P2Q1)-544*A1*A2*P1Q2*P2Q2/(3*P2Q1)- - &640*A2**2*P1Q2*P2Q2/(3*P2Q1)+ - &64*A1*A2*P1P2*P1Q2*P2Q2/(3*P1Q1*P2Q1)+544*A1*A2*P2Q2**2/(3*P2Q1)- - &256*A1*MT**2*P2Q2**2/(3*P1Q2**2*P2Q1)- - &272*A1*P2Q2**2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MT**2*P2Q2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P2Q2**2/(3*P1Q2*P2Q1) - A18=A18+512*A1*A2*P1Q1*P2Q2**2/(3*P1Q2*P2Q1)- - &384*A12*MB*MT*P1Q1**2/S**2+ - &384*A12*P1P2*P1Q1**2/S**2-2688*A12*MB*MT*P1Q1*P1Q2/S**2+ - &2688*A12*P1P2*P1Q1*P1Q2/S**2-384*A12*MB*MT*P1Q2**2/S**2+ - &384*A12*P1P2*P1Q2**2/S**2-768*A1*A2*MB*MT*P1Q1*P2Q1/S**2+ - &768*A1*A2*P1P2*P1Q1*P2Q1/S**2-2688*A1*A2*MB*MT*P1Q2*P2Q1/S**2+ - &2688*A1*A2*P1P2*P1Q2*P2Q1/S**2-960*A12*P1Q1*P1Q2*P2Q1/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q1/S**2+960*A12*P1Q2**2*P2Q1/S**2+ - &960*A1*A2*P1Q2**2*P2Q1/S**2-384*A2**2*MB*MT*P2Q1**2/S**2+ - &384*A2**2*P1P2*P2Q1**2/S**2-960*A1*A2*P1Q2*P2Q1**2/S**2- - &960*A2**2*P1Q2*P2Q1**2/S**2-2688*A1*A2*MB*MT*P1Q1*P2Q2/S**2+ - &2688*A1*A2*P1P2*P1Q1*P2Q2/S**2+960*A12*P1Q1**2*P2Q2/S**2+ - &960*A1*A2*P1Q1**2*P2Q2/S**2-768*A1*A2*MB*MT*P1Q2*P2Q2/S**2+ - &768*A1*A2*P1P2*P1Q2*P2Q2/S**2-960*A12*P1Q1*P1Q2*P2Q2/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q2/S**2-2688*A2**2*MB*MT*P2Q1*P2Q2/S**2+ - &2688*A2**2*P1P2*P2Q1*P2Q2/S**2+960*A1*A2*P1Q1*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q1*P2Q1*P2Q2/S**2+960*A1*A2*P1Q2*P2Q1*P2Q2/S**2 - A18=A18+960*A2**2*P1Q2*P2Q1*P2Q2/S**2- - &384*A2**2*MB*MT*P2Q2**2/S**2+ - &384*A2**2*P1P2*P2Q2**2/S**2-960*A1*A2*P1Q1*P2Q2**2/S**2- - &960*A2**2*P1Q1*P2Q2**2/S**2-96*A1*MB*MT/S-96*A2*MB*MT/S+ - &768*A2**2*MB**3*MT/S+768*A12*MB*MT**3/S-192*A1*P1P2/S- - &192*A2*P1P2/S-768*A2**2*MB**2*P1P2/S+2304*A1*A2*MB*MT*P1P2/S- - &768*A12*MT**2*P1P2/S-2304*A1*A2*P1P2**2/S+ - &96*A1*MB*MT**3/(P1Q1*S)+192*A2*MB*MT*P1P2/(P1Q1*S)- - &96*A1*MT**2*P1P2/(P1Q1*S)-192*A2*P1P2**2/(P1Q1*S)-192*A1*P1Q1/S- - &144*A2*P1Q1/S-384*A1*A2*MB**2*P1Q1/S-480*A2**2*MB**2*P1Q1/S+ - &480*A12*MB*MT*P1Q1/S-96*A1*A2*MB*MT*P1Q1/S- - &864*A12*P1P2*P1Q1/S-672*A1*A2*P1P2*P1Q1/S-96*A1*A2*P1Q1**2/S+ - &96*A1*MB*MT**3/(P1Q2*S)+192*A2*MB*MT*P1P2/(P1Q2*S)- - &96*A1*MT**2*P1P2/(P1Q2*S)-192*A2*P1P2**2/(P1Q2*S)+ - &48*A1*MB*MT*P1Q1/(P1Q2*S)-96*A2*MB*MT*P1Q1/(P1Q2*S)- - &48*A1*MT**2*P1Q1/(P1Q2*S)-192*A1*P1P2*P1Q1/(P1Q2*S)- - &192*A2*P1P2*P1Q1/(P1Q2*S)-192*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*S) - A18=A18+192*A1*A2*P1P2**2*P1Q1/(P1Q2*S)-192*A1*P1Q1**2/(P1Q2*S)- - &192*A2*P1Q1**2/(P1Q2*S)+192*A1*A2*MB**2*P1Q1**2/(P1Q2*S)+ - &192*A12*MB*MT*P1Q1**2/(P1Q2*S)-96*A1*A2*MB*MT*P1Q1**2/(P1Q2*S)+ - &192*A1*A2*P1P2*P1Q1**2/(P1Q2*S)-192*A1*P1Q2/S-144*A2*P1Q2/S- - &384*A1*A2*MB**2*P1Q2/S-480*A2**2*MB**2*P1Q2/S+ - &480*A12*MB*MT*P1Q2/S-96*A1*A2*MB*MT*P1Q2/S- - &864*A12*P1P2*P1Q2/S-672*A1*A2*P1P2*P1Q2/S+ - &48*A1*MB*MT*P1Q2/(P1Q1*S)-96*A2*MB*MT*P1Q2/(P1Q1*S)- - &48*A1*MT**2*P1Q2/(P1Q1*S)-192*A1*P1P2*P1Q2/(P1Q1*S)- - &192*A2*P1P2*P1Q2/(P1Q1*S)-192*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*S)+ - &192*A1*A2*P1P2**2*P1Q2/(P1Q1*S)-576*A1*A2*P1Q1*P1Q2/S- - &96*A1*A2*P1Q2**2/S-192*A1*P1Q2**2/(P1Q1*S)- - &192*A2*P1Q2**2/(P1Q1*S)+192*A1*A2*MB**2*P1Q2**2/(P1Q1*S)+ - &192*A12*MB*MT*P1Q2**2/(P1Q1*S)-96*A1*A2*MB*MT*P1Q2**2/(P1Q1*S)+ - &192*A1*A2*P1P2*P1Q2**2/(P1Q1*S)-96*A2*MB**3*MT/(P2Q1*S)+ - &96*A2*MB**2*P1P2/(P2Q1*S)-192*A1*MB*MT*P1P2/(P2Q1*S)+ - &192*A1*P1P2**2/(P2Q1*S)+96*A1*MB**2*P1Q1/(P2Q1*S) - A18=A18+192*A2*MB**2*P1Q1/(P2Q1*S)-96*A1*MB*MT*P1Q1/(P2Q1*S)- - &192*A1*A2*MB**3*MT*P1Q1/(P2Q1*S)+192*A1*P1P2*P1Q1/(P2Q1*S)+ - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q1*S)+ - &96*A1*A2*MB**2*P1Q1**2/(P2Q1*S)- - &192*A2*MB**3*MT*P1Q1/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1P2*P1Q1/(P1Q2*P2Q1*S)- - &96*A1*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*P1P2**2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1Q1**2/(P1Q2*P2Q1*S)- - &48*A1*MB*MT*P1Q1**2/(P1Q2*P2Q1*S)+ - &96*A1*P1P2*P1Q1**2/(P1Q2*P2Q1*S)+96*A1*MB**2*P1Q2/(P2Q1*S)+ - &48*A2*MB**2*P1Q2/(P2Q1*S)+192*A1*A2*MB**3*MT*P1Q2/(P2Q1*S)- - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q1*S)- - &96*A1*A2*MB**2*P1Q2**2/(P2Q1*S)+144*A1*P2Q1/S+192*A2*P2Q1/S+ - &96*A1*A2*MB*MT*P2Q1/S-480*A2**2*MB*MT*P2Q1/S+ - &480*A12*MT**2*P2Q1/S+384*A1*A2*MT**2*P2Q1/S - A18=A18+672*A1*A2*P1P2*P2Q1/S+864*A2**2*P1P2*P2Q1/S- - &96*A2*MB*MT*P2Q1/(P1Q1*S)+192*A1*MT**2*P2Q1/(P1Q1*S)+ - &96*A2*MT**2*P2Q1/(P1Q1*S)-192*A1*A2*MB*MT**3*P2Q1/(P1Q1*S)+ - &192*A2*P1P2*P2Q1/(P1Q1*S)+192*A1*A2*MT**2*P1P2*P2Q1/(P1Q1*S)- - &192*A12*P1Q1*P2Q1/S-192*A2**2*P1Q1*P2Q1/S+ - &48*A1*MT**2*P2Q1/(P1Q2*S)+96*A2*MT**2*P2Q1/(P1Q2*S)+ - &192*A1*A2*MB*MT**3*P2Q1/(P1Q2*S)- - &192*A1*A2*MT**2*P1P2*P2Q1/(P1Q2*S)+ - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P1Q2*S)- - &192*A12*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &96*A1*A2*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &384*A1*A2*P1P2*P1Q1*P2Q1/(P1Q2*S)-384*A12*P1Q1**2*P2Q1/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q1/(P1Q2*S)-480*A12*P1Q2*P2Q1/S- - &960*A1*A2*P1Q2*P2Q1/S-480*A2**2*P1Q2*P2Q1/S+ - &144*A1*P1Q2*P2Q1/(P1Q1*S)+96*A2*P1Q2*P2Q1/(P1Q1*S)+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*S)- - &96*A12*MT**2*P1Q2*P2Q1/(P1Q1*S) - A18=A18+96*A1*A2*MT**2*P1Q2*P2Q1/(P1Q1*S)- - &576*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*S)-192*A12*P1Q2**2*P2Q1/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q1/(P1Q1*S)-96*A1*A2*P2Q1**2/S- - &96*A1*A2*MT**2*P2Q1**2/(P1Q1*S)+96*A1*A2*MT**2*P2Q1**2/(P1Q2*S)+ - &288*A1*A2*P1Q2*P2Q1**2/(P1Q1*S)-96*A2*MB**3*MT/(P2Q2*S)+ - &96*A2*MB**2*P1P2/(P2Q2*S)-192*A1*MB*MT*P1P2/(P2Q2*S)+ - &192*A1*P1P2**2/(P2Q2*S)+96*A1*MB**2*P1Q1/(P2Q2*S)+ - &48*A2*MB**2*P1Q1/(P2Q2*S)+192*A1*A2*MB**3*MT*P1Q1/(P2Q2*S)- - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q2*S)- - &96*A1*A2*MB**2*P1Q1**2/(P2Q2*S)+96*A1*MB**2*P1Q2/(P2Q2*S)+ - &192*A2*MB**2*P1Q2/(P2Q2*S)-96*A1*MB*MT*P1Q2/(P2Q2*S)- - &192*A1*A2*MB**3*MT*P1Q2/(P2Q2*S)+192*A1*P1P2*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q2*S)- - &192*A2*MB**3*MT*P1Q2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1P2*P1Q2/(P1Q1*P2Q2*S)- - &96*A1*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2**2*P1Q2/(P1Q1*P2Q2*S)+96*A1*A2*MB**2*P1Q2**2/(P2Q2*S) - A18=A18+96*A1*MB**2*P1Q2**2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1Q2**2/(P1Q1*P2Q2*S)- - &48*A1*MB*MT*P1Q2**2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2*P1Q2**2/(P1Q1*P2Q2*S)-48*A2*MB**2*P2Q1/(P2Q2*S)- - &96*A1*MB*MT*P2Q1/(P2Q2*S)+48*A2*MB*MT*P2Q1/(P2Q2*S)- - &192*A1*P1P2*P2Q1/(P2Q2*S)-192*A2*P1P2*P2Q1/(P2Q2*S)- - &192*A1*A2*MB*MT*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*P1P2**2*P2Q1/(P2Q2*S)+ - &192*A1*MB*MT**3*P2Q1/(P1Q1*P2Q2*S)+ - &96*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &192*A1*MT**2*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2**2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &192*A2**2*MB**2*P1Q1*P2Q1/(P2Q2*S)- - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P2Q2*S)+ - &384*A1*A2*P1P2*P1Q1*P2Q1/(P2Q2*S)-96*A1*P1Q2*P2Q1/(P2Q2*S)- - &144*A2*P1Q2*P2Q1/(P2Q2*S)-96*A1*A2*MB**2*P1Q2*P2Q1/(P2Q2*S) - A18=A18+96*A2**2*MB**2*P1Q2*P2Q1/(P2Q2*S)- - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P2Q2*S)+ - &576*A1*A2*P1P2*P1Q2*P2Q1/(P2Q2*S)- - &96*A2*MB**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &48*A1*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &48*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*MT**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q1/(P2Q2*S)+288*A1*A2*P1Q2**2*P2Q1/(P2Q2*S)- - &96*A1*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)-96*A2*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)+ - &192*A1*P2Q1**2/(P2Q2*S)+192*A2*P2Q1**2/(P2Q2*S)+ - &96*A1*A2*MB*MT*P2Q1**2/(P2Q2*S)-192*A2**2*MB*MT*P2Q1**2/(P2Q2*S)- - &192*A1*A2*MT**2*P2Q1**2/(P2Q2*S)-192*A1*A2*P1P2*P2Q1**2/(P2Q2*S)- - &48*A2*MB*MT*P2Q1**2/(P1Q1*P2Q2*S)+ - &192*A1*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*MT**2*P2Q1**2/(P1Q1*P2Q2*S) - A18=A18+96*A2*P1P2*P2Q1**2/(P1Q1*P2Q2*S)- - &384*A1*A2*P1Q1*P2Q1**2/(P2Q2*S)- - &384*A2**2*P1Q1*P2Q1**2/(P2Q2*S)-384*A1*A2*P1Q2*P2Q1**2/(P2Q2*S)- - &192*A2**2*P1Q2*P2Q1**2/(P2Q2*S)+96*A1*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+144*A1*P2Q2/S+192*A2*P2Q2/S+ - &96*A1*A2*MB*MT*P2Q2/S-480*A2**2*MB*MT*P2Q2/S+ - &480*A12*MT**2*P2Q2/S+384*A1*A2*MT**2*P2Q2/S+ - &672*A1*A2*P1P2*P2Q2/S+864*A2**2*P1P2*P2Q2/S+ - &48*A1*MT**2*P2Q2/(P1Q1*S)+96*A2*MT**2*P2Q2/(P1Q1*S)+ - &192*A1*A2*MB*MT**3*P2Q2/(P1Q1*S)- - &192*A1*A2*MT**2*P1P2*P2Q2/(P1Q1*S)-480*A12*P1Q1*P2Q2/S- - &960*A1*A2*P1Q1*P2Q2/S-480*A2**2*P1Q1*P2Q2/S- - &96*A2*MB*MT*P2Q2/(P1Q2*S)+192*A1*MT**2*P2Q2/(P1Q2*S)+ - &96*A2*MT**2*P2Q2/(P1Q2*S)-192*A1*A2*MB*MT**3*P2Q2/(P1Q2*S)+ - &192*A2*P1P2*P2Q2/(P1Q2*S)+192*A1*A2*MT**2*P1P2*P2Q2/(P1Q2*S)+ - &144*A1*P1Q1*P2Q2/(P1Q2*S)+96*A2*P1Q1*P2Q2/(P1Q2*S)+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*S) - A18=A18-96*A12*MT**2*P1Q1*P2Q2/(P1Q2*S)+ - &96*A1*A2*MT**2*P1Q1*P2Q2/(P1Q2*S)- - &576*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*S)-192*A12*P1Q1**2*P2Q2/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q2/(P1Q2*S)-192*A12*P1Q2*P2Q2/S- - &192*A2**2*P1Q2*P2Q2/S+96*A1*A2*MB*MT*P1Q2*P2Q2/(P1Q1*S)- - &192*A12*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &96*A1*A2*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1P2*P1Q2*P2Q2/(P1Q1*S)-384*A12*P1Q2**2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q2/(P1Q1*S)-48*A2*MB**2*P2Q2/(P2Q1*S)- - &96*A1*MB*MT*P2Q2/(P2Q1*S)+48*A2*MB*MT*P2Q2/(P2Q1*S)- - &192*A1*P1P2*P2Q2/(P2Q1*S)-192*A2*P1P2*P2Q2/(P2Q1*S)- - &192*A1*A2*MB*MT*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*P1P2**2*P2Q2/(P2Q1*S)-96*A1*P1Q1*P2Q2/(P2Q1*S)- - &144*A2*P1Q1*P2Q2/(P2Q1*S)-96*A1*A2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &96*A2**2*MB**2*P1Q1*P2Q2/(P2Q1*S)- - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P2Q1*S)+ - &576*A1*A2*P1P2*P1Q1*P2Q2/(P2Q1*S)+288*A1*A2*P1Q1**2*P2Q2/(P2Q1*S) - A18=A18+192*A1*MB*MT**3*P2Q2/(P1Q2*P2Q1*S)+ - &96*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &192*A1*MT**2*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2**2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*MB**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &48*A1*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &48*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*MT**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)-96*A2*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)+ - &96*A1*A2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &192*A2**2*MB**2*P1Q2*P2Q2/(P2Q1*S)- - &96*A1*A2*MB*MT*P1Q2*P2Q2/(P2Q1*S)+ - &384*A1*A2*P1P2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q2/(P2Q1*S)-576*A1*A2*P2Q1*P2Q2/S+ - &96*A1*A2*P1Q1*P2Q1*P2Q2/(P1Q2*S)+96*A1*A2*P1Q2*P2Q1*P2Q2/(P1Q1*S) - A18=A18-96*A1*A2*P2Q2**2/S+96*A1*A2*MT**2*P2Q2**2/(P1Q1*S)- - &96*A1*A2*MT**2*P2Q2**2/(P1Q2*S)+288*A1*A2*P1Q1*P2Q2**2/(P1Q2*S)+ - &192*A1*P2Q2**2/(P2Q1*S)+192*A2*P2Q2**2/(P2Q1*S)+ - &96*A1*A2*MB*MT*P2Q2**2/(P2Q1*S)-192*A2**2*MB*MT*P2Q2**2/(P2Q1*S)- - &192*A1*A2*MT**2*P2Q2**2/(P2Q1*S)-192*A1*A2*P1P2*P2Q2**2/(P2Q1*S)- - &384*A1*A2*P1Q1*P2Q2**2/(P2Q1*S)-192*A2**2*P1Q1*P2Q2**2/(P2Q1*S)- - &48*A2*MB*MT*P2Q2**2/(P1Q2*P2Q1*S)+ - &192*A1*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1P2*P2Q2**2/(P1Q2*P2Q1*S)+96*A1*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)-384*A1*A2*P1Q2*P2Q2**2/(P2Q1*S)- - &384*A2**2*P1Q2*P2Q2**2/(P2Q1*S)+512*A1*A2*S/3- - &128*A1*MT**2*S/(3*P1Q1**2)+128*A12*MB*MT**3*S/(3*P1Q1**2)- - &152*A1*S/(3*P1Q1)-152*A12*MB*MT*S/(3*P1Q1)- - &128*A1*A2*MB*MT*S/(3*P1Q1)+112*A1*A2*MT**2*S/(3*P1Q1)- - &16*A12*P1P2*S/P1Q1+152*A1*A2*P1P2*S/(3*P1Q1)- - &128*A1*MT**2*S/(3*P1Q2**2)+128*A12*MB*MT**3*S/(3*P1Q2**2) - A18=A18-152*A1*S/(3*P1Q2)-152*A12*MB*MT*S/(3*P1Q2)- - &128*A1*A2*MB*MT*S/(3*P1Q2)+112*A1*A2*MT**2*S/(3*P1Q2)- - &16*A12*P1P2*S/P1Q2+152*A1*A2*P1P2*S/(3*P1Q2)+ - &16*A1*MB*MT*S/(3*P1Q1*P1Q2)-32*A12*MB*MT**3*S/(3*P1Q1*P1Q2)- - &16*A1*P1P2*S/(3*P1Q1*P1Q2)+272*A1*A2*P1Q1*S/(3*P1Q2)+ - &272*A1*A2*P1Q2*S/(3*P1Q1)-128*A2*MB**2*S/(3*P2Q1**2)+ - &128*A2**2*MB**3*MT*S/(3*P2Q1**2)+ - &32*MB**2*MT**2*S/(3*P1Q2**2*P2Q1**2)+32*MB**2*S/(3*P1Q2*P2Q1**2) - - A18BIS= - &64*A2*MB**3*MT*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1**2)+ - &128*A2**2*MB**2*P1Q2*S/(3*P2Q1**2)+152*A2*S/(3*P2Q1)- - &112*A1*A2*MB**2*S/(3*P2Q1)+128*A1*A2*MB*MT*S/(3*P2Q1)+ - &152*A2**2*MB*MT*S/(3*P2Q1)-152*A1*A2*P1P2*S/(3*P2Q1)+ - &16*A2**2*P1P2*S/P2Q1-8*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q1)- - &8*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q1)-8*A1*P1P2*S/(3*P1Q1*P2Q1)- - &8*A2*P1P2*S/(3*P1Q1*P2Q1)+8*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1)- - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q1)+ - &32*A1*A2*P1P2**2*S/(3*P1Q1*P2Q1)-32*A2**2*P1Q1*S/(3*P2Q1)- - &32*MT**2*S/(3*P1Q2**2*P2Q1)+64*A1*MB**2*MT**2*S/(3*P1Q2**2*P2Q1)- - &64*A1*MB*MT**3*S/(3*P1Q2**2*P2Q1) - A18BIS=A18BIS+128*A1*MT**2*P1P2*S/(3*P1Q2**2*P2Q1)- - &12*S/(P1Q2*P2Q1)+ - &24*A1*MB**2*S/(P1Q2*P2Q1)+64*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q1)+ - &24*A2*MT**2*S/(P1Q2*P2Q1)-128*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1)+ - &64*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q1)+56*A1*P1P2*S/(3*P1Q2*P2Q1)+ - &56*A2*P1P2*S/(3*P1Q2*P2Q1)-64*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2**2*S/(3*P1Q2*P2Q1)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+136*A2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P1Q1*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1)-160*A2**2*P1Q2*S/(3*P2Q1)+ - &16*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1)-32*A12*P2Q1*S/(3*P1Q1)- - &128*A12*MT**2*P2Q1*S/(3*P1Q2**2)-160*A12*P2Q1*S/(3*P1Q2)- - &128*A2*MB**2*S/(3*P2Q2**2)+128*A2**2*MB**3*MT*S/(3*P2Q2**2) - A18BIS=A18BIS+32*MB**2*MT**2*S/(3*P1Q1**2*P2Q2**2)+ - &32*MB**2*S/(3*P1Q1*P2Q2**2)+ - &64*A2*MB**3*MT*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2**2)+ - &128*A2**2*MB**2*P1Q1*S/(3*P2Q2**2)- - &128*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2**2)+152*A2*S/(3*P2Q2)- - &112*A1*A2*MB**2*S/(3*P2Q2)+128*A1*A2*MB*MT*S/(3*P2Q2)+ - &152*A2**2*MB*MT*S/(3*P2Q2)-152*A1*A2*P1P2*S/(3*P2Q2)+ - &16*A2**2*P1P2*S/P2Q2-32*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB**2*MT**2*S/(3*P1Q1**2*P2Q2)- - &64*A1*MB*MT**3*S/(3*P1Q1**2*P2Q2)+ - &128*A1*MT**2*P1P2*S/(3*P1Q1**2*P2Q2)-12*S/(P1Q1*P2Q2)+ - &24*A1*MB**2*S/(P1Q1*P2Q2)+64*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q2)+ - &24*A2*MT**2*S/(P1Q1*P2Q2)-128*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2)+ - &64*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q2)+56*A1*P1P2*S/(3*P1Q1*P2Q2)+ - &56*A2*P1P2*S/(3*P1Q1*P2Q2)-64*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2) - A18BIS=A18BIS+128*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2**2*S/(3*P1Q1*P2Q2)-160*A2**2*P1Q1*S/(3*P2Q2)- - &8*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q2)- - &8*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q2)-8*A1*P1P2*S/(3*P1Q2*P2Q2)- - &8*A2*P1P2*S/(3*P1Q2*P2Q2)+8*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q2)- - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q2)+ - &32*A1*A2*P1P2**2*S/(3*P1Q2*P2Q2)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &16*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q2)-32*A2**2*P1Q2*S/(3*P2Q2)+ - &136*A2*P1Q2*S/(3*P1Q1*P2Q2)-128*A1*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MB*MT*P1Q2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q2)+16*A2*MB*MT*S/(3*P2Q1*P2Q2)- - &32*A2**2*MB**3*MT*S/(3*P2Q1*P2Q2)-16*A2*P1P2*S/(3*P2Q1*P2Q2) - A18BIS=A18BIS-4*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+ - &8*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1*P2Q2)-4*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1*P2Q2)- - &2*MB**3*MT*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB**2*MT**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB*MT**3*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &8*P1P2**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1*P2Q2)+272*A1*A2*P2Q1*S/(3*P2Q2)- - &128*A1*MT**2*P2Q1*S/(3*P1Q1**2*P2Q2)-136*A1*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MT**2*P2Q1*S/(3*P1Q1*P2Q2) - A18BIS=A18BIS+256*A1*A2*P1P2*P2Q1*S/(3*P1Q1*P2Q2)- - &16*A1*A2*P1P2*P2Q1*S/(3*P1Q2*P2Q2)+ - &8*A1*P1P2*P2Q1*S/(3*P1Q1*P1Q2*P2Q2)+ - &256*A1*A2*P1Q2*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A12*MT**2*P2Q2*S/(3*P1Q1**2)-160*A12*P2Q2*S/(3*P1Q1)- - &32*A12*P2Q2*S/(3*P1Q2)+272*A1*A2*P2Q2*S/(3*P2Q1)- - &16*A1*A2*P1P2*P2Q2*S/(3*P1Q1*P2Q1)- - &128*A1*MT**2*P2Q2*S/(3*P1Q2**2*P2Q1)-136*A1*P2Q2*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MT**2*P2Q2*S/(3*P1Q2*P2Q1)+ - &256*A1*A2*P1P2*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A1*P1P2*P2Q2*S/(3*P1Q1*P1Q2*P2Q1)+ - &256*A1*A2*P1Q1*P2Q2*S/(3*P1Q2*P2Q1)- - &8*A12*MB*MT*S**2/(3*P1Q1*P1Q2)+16*A12*P1P2*S**2/(3*P1Q1*P1Q2)- - &8*A1*A2*P1P2*S**2/(3*P1Q1*P2Q1)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*A2*P1P2*S**2/(3*P1Q2*P2Q2)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q2)- - &8*A2**2*MB*MT*S**2/(3*P2Q1*P2Q2)+16*A2**2*P1P2*S**2/(3*P2Q1*P2Q2) - A18BIS=A18BIS-4*A2*P1P2*S**2/(3*P1Q1*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q2*P2Q1*P2Q2)+ - &2*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) -C - V18=V18+V18BIS - A18=A18+A18BIS - V910 =-48*A12*MB*MT-48*A2**2*MB*MT-48*A12*P1P2-48*A2**2*P1P2- - &384*A12*MB*MT*P1Q1*P1Q2/S**2-384*A12*P1P2*P1Q1*P1Q2/S**2- - &384*A1*A2*MB*MT*P1Q2*P2Q1/S**2-384*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &192*A12*P1Q1*P1Q2*P2Q1/S**2+192*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &192*A12*P1Q2**2*P2Q1/S**2-192*A1*A2*P1Q2**2*P2Q1/S**2+ - &192*A1*A2*P1Q2*P2Q1**2/S**2+192*A2**2*P1Q2*P2Q1**2/S**2- - &384*A1*A2*MB*MT*P1Q1*P2Q2/S**2-384*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &192*A12*P1Q1**2*P2Q2/S**2-192*A1*A2*P1Q1**2*P2Q2/S**2+ - &192*A12*P1Q1*P1Q2*P2Q2/S**2+192*A1*A2*P1Q1*P1Q2*P2Q2/S**2- - &384*A2**2*MB*MT*P2Q1*P2Q2/S**2-384*A2**2*P1P2*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q1*P2Q1*P2Q2/S**2-192*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q2*P2Q1*P2Q2/S**2-192*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &192*A1*A2*P1Q1*P2Q2**2/S**2+192*A2**2*P1Q1*P2Q2**2/S**2+ - &96*A12*MB*MT*P1Q1/S-96*A1*A2*MB*MT*P1Q1/S+ - &96*A12*P1P2*P1Q1/S-96*A1*A2*P1P2*P1Q1/S+96*A12*MB*MT*P1Q2/S- - &96*A1*A2*MB*MT*P1Q2/S+96*A12*P1P2*P1Q2/S-96*A1*A2*P1P2*P1Q2/S+ - &96*A1*A2*MB*MT*P2Q1/S-96*A2**2*MB*MT*P2Q1/S - V910=V910+96*A1*A2*P1P2*P2Q1/S- - &96*A2**2*P1P2*P2Q1/S+96*A12*P1Q2*P2Q1/S+ - &192*A1*A2*P1Q2*P2Q1/S+96*A2**2*P1Q2*P2Q1/S+ - &96*A1*A2*MB*MT*P2Q2/S-96*A2**2*MB*MT*P2Q2/S+ - &96*A1*A2*P1P2*P2Q2/S-96*A2**2*P1P2*P2Q2/S+96*A12*P1Q1*P2Q2/S+ - &192*A1*A2*P1Q1*P2Q2/S+96*A2**2*P1Q1*P2Q2/S -C - A910 = 48*A12*MB*MT+48*A2**2*MB*MT-48*A12*P1P2-48*A2**2*P1P2+ - &384*A12*MB*MT*P1Q1*P1Q2/S**2-384*A12*P1P2*P1Q1*P1Q2/S**2+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/S**2-384*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &192*A12*P1Q1*P1Q2*P2Q1/S**2+192*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &192*A12*P1Q2**2*P2Q1/S**2-192*A1*A2*P1Q2**2*P2Q1/S**2+ - &192*A1*A2*P1Q2*P2Q1**2/S**2+192*A2**2*P1Q2*P2Q1**2/S**2+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/S**2-384*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &192*A12*P1Q1**2*P2Q2/S**2-192*A1*A2*P1Q1**2*P2Q2/S**2+ - &192*A12*P1Q1*P1Q2*P2Q2/S**2+192*A1*A2*P1Q1*P1Q2*P2Q2/S**2+ - &384*A2**2*MB*MT*P2Q1*P2Q2/S**2-384*A2**2*P1P2*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q1*P2Q1*P2Q2/S**2-192*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q2*P2Q1*P2Q2/S**2-192*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &192*A1*A2*P1Q1*P2Q2**2/S**2+192*A2**2*P1Q1*P2Q2**2/S**2- - &96*A12*MB*MT*P1Q1/S+96*A1*A2*MB*MT*P1Q1/S+ - &96*A12*P1P2*P1Q1/S-96*A1*A2*P1P2*P1Q1/S-96*A12*MB*MT*P1Q2/S+ - &96*A1*A2*MB*MT*P1Q2/S+96*A12*P1P2*P1Q2/S-96*A1*A2*P1P2*P1Q2/S- - &96*A1*A2*MB*MT*P2Q1/S+96*A2**2*MB*MT*P2Q1/S - A910=A910+96*A1*A2*P1P2*P2Q1/S- - &96*A2**2*P1P2*P2Q1/S+96*A12*P1Q2*P2Q1/S+ - &192*A1*A2*P1Q2*P2Q1/S+96*A2**2*P1Q2*P2Q1/S- - &96*A1*A2*MB*MT*P2Q2/S+96*A2**2*MB*MT*P2Q2/S+ - &96*A1*A2*P1P2*P2Q2/S-96*A2**2*P1P2*P2Q2/S+96*A12*P1Q1*P2Q2/S+ - &192*A1*A2*P1Q1*P2Q2/S+96*A2**2*P1Q1*P2Q2/S -C -C FINAL RESULT; -C - AMP2= FACT*PS*VTB**2*(V**2 *(V18 +V910)+A**2 *(A18+A910) ) - - END -C--------------------------------------------------------- -C 2) Q QBAR ->TBH^+ - SUBROUTINE PYTBHQ(Q1,Q2,P1,P2,P3,MT,MB,RMB,MHP,AMP2) -C -C AMP2(OUTPUT) =MATRIX ELEMENT (AMPLITUDE**2) FOR Q QBAR->TB H^+ -C (NB SAME STRUCTURE AS FOR PYTBHG ROUTINE ABOVE) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW - DIMENSION Q1(4),Q2(4),P1(4),P2(4),P3(4) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYCTBH/ -C !THE RELEVANT INPUT PARAMETERS ABOVE ARE NEEDED FOR CALCULATION -C BUT ARE NOT DEFINED HERE SO THAT ONE MAY CHOOSE/VARY THEIR VALUES: -C ACCORDINGLY, WHEN CALLING THESE SUBROUTINES, PLEASE SUPPLY VIA -C THIS COMMON/PARAM/ YOUR PREFERRED ALPHA, ALPHAS,..AND TANB VALUES -C -C THE NORMALIZED V,A COUPLINGS ARE DEFINED BELOW AND USED BOTH -C IN THIS ROUTINE AND IN THE TOP WIDTH CALCULATION PYTBHB(..). -C - DIMENSION YY(2,2) - - PI = 4*DATAN(1.D0) - MW = DSQRT(MW2) - -C COLLECTING THE RELEVANT OVERALL FACTORS: -C 3X3 INITIAL QUARK COLOR AVERAGE, 2X2 QUARK SPIN AVERAGE - PS=1.D0/(3.D0*3.D0 *2.D0*2.D0) -C COUPLING CONSTANT (OVERALL NORMALIZATION) - FACT=(4.D0*PI*ALPHA)*(4.D0*PI*ALPHAS)**2/SW2/2.D0 -C NB ALPHA IS E^2/4/PI, BUT BETTER DEFINED IN TERMS OF G_FERMI: -C ALPHA= DSQRT(2.D0)*GF*SW2*MW**2/PI -C ALPHAS IS ALPHA_STRONG; -C SW2 IS SIN(THETA_W)**2. -C -C VTB=.998D0 -C VTB IS TOP-BOTTOM CKM MATRIX ELEMENT (APPROXIMATE VALUE HERE) -C - V = ( MT/MW/TANB +RMB/MW*TANB)/2.D0 - A = (-MT/MW/TANB +RMB/MW*TANB)/2.D0 -C V AND A ARE (NORMALIZED) VECTOR AND AXIAL TBH^+ COUPLINGS -C -C REDEFINING P2 INGOING FROM OVERALL MOMENTUM CONSERVATION -C (BECAUSE P2 INGOING WAS USED IN OUR GRAPH CALCULATION CONVENTIONS) - DO KK=1,4 - P2(KK)=P3(KK)-Q1(KK)-Q2(KK)+P1(KK) - ENDDO -C DEFINING VARIOUS RELEVANT 4-SCALAR PRODUCTS: - S = 2*PYTBHS(Q1,Q2) - P1Q1=PYTBHS(Q1,P1) - P1Q2=PYTBHS(P1,Q2) - P2Q1=PYTBHS(P2,Q1) - P2Q2=PYTBHS(P2,Q2) - P1P2=PYTBHS(P1,P2) -C -C TOP WIDTH CALCULATION - CALL PYTBHB(MT,MB,MHP,BR,GAMT) -C GAMT IS THE TOP WIDTH: T->BH^+ AND/OR T->B W^+ -C THEN DEFINE TOP (RESONANT) PROPAGATOR: - A1INV= S -2*P1Q1 -2*P1Q2 - A1 =A1INV/(A1INV**2+ (GAMT*MT)**2) -C (I.E. INTRODUCE THE TOP WIDTH IN A1 TO REGULARISE THE POLE) -C NB A12 = A1*A1 BUT WITH CORRECT WIDTH TREATMENT - A12 = 1.D0/(A1INV**2+ (GAMT*MT)**2) - A2 =1.D0/(S +2*P2Q1 +2*P2Q2) -C NOTE A2 IS B PROPAGATOR, DOES NOT NEED A WIDTH -C NOW COMES THE AMP**2: -C NB COLOR FACTOR (COMING FORM GRAPHS) ALREADY INCLUDED IN -C THE EXPRESSIONS BELOW - YY(1, 1) = -16*A**2*A2**2*MB*MT+ - &64*A**2*A2**2*P1Q2*P2Q1**2/S**2+ - &128*A**2*A2**2*MB*MT*P2Q1*P2Q2/S**2- - &128*A**2*A2**2*P1P2*P2Q1*P2Q2/S**2- - &64*A**2*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &64*A**2*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &64*A**2*A2**2*P1Q1*P2Q2**2/S**2- - &32*A**2*A2**2*MB**3*MT/S+32*A**2*A2**2*MB**2*P1P2/S+ - &32*A**2*A2**2*MB**2*P1Q1/S+32*A**2*A2**2*MB**2*P1Q2/S- - &32*A**2*A2**2*P1P2*P2Q1/S-32*A**2*A2**2*P1Q1*P2Q1/S- - &32*A**2*A2**2*P1P2*P2Q2/S-32*A**2*A2**2*P1Q2*P2Q2/S+ - &16*A2**2*MB*MT*V**2+64*A2**2*P1Q2*P2Q1**2*V**2/S**2- - &128*A2**2*MB*MT*P2Q1*P2Q2*V**2/S**2- - &128*A2**2*P1P2*P2Q1*P2Q2*V**2/S**2- - &64*A2**2*P1Q1*P2Q1*P2Q2*V**2/S**2- - &64*A2**2*P1Q2*P2Q1*P2Q2*V**2/S**2+ - &64*A2**2*P1Q1*P2Q2**2*V**2/S**2 - YY(1, 1)=YY(1, 1)+32*A2**2*MB**3*MT*V**2/S+ - &32*A2**2*MB**2*P1P2*V**2/S+ - &32*A2**2*MB**2*P1Q1*V**2/S+32*A2**2*MB**2*P1Q2*V**2/S- - &32*A2**2*P1P2*P2Q1*V**2/S-32*A2**2*P1Q1*P2Q1*V**2/S- - &32*A2**2*P1P2*P2Q2*V**2/S-32*A2**2*P1Q2*P2Q2*V**2/S - YY(1, 1)=2*YY(1, 1) - - YY(1, 2) = -32*A**2*A1*A2*MB*MT+ - &128*A**2*A1*A2*MB*MT*P1Q2*P2Q1/S**2- - &128*A**2*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &64*A**2*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &64*A**2*A1*A2*P1Q2**2*P2Q1/S**2+ - &64*A**2*A1*A2*P1Q2*P2Q1**2/S**2+ - &128*A**2*A1*A2*MB*MT*P1Q1*P2Q2/S**2- - &128*A**2*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &64*A**2*A1*A2*P1Q1**2*P2Q2/S**2+ - &64*A**2*A1*A2*P1Q1*P1Q2*P2Q2/S**2- - &64*A**2*A1*A2*P1Q1*P2Q1*P2Q2/S**2- - &64*A**2*A1*A2*P1Q2*P2Q1*P2Q2/S**2+ - &64*A**2*A1*A2*P1Q1*P2Q2**2/S**2- - &64*A**2*A1*A2*MB*MT*P1P2/S+ - &64*A**2*A1*A2*P1P2**2/S+32*A**2*A1*A2*MB**2*P1Q1/S+ - &32*A**2*A1*A2*P1P2*P1Q1/S+32*A**2*A1*A2*MB**2*P1Q2/S+ - &32*A**2*A1*A2*P1P2*P1Q2/S-32*A**2*A1*A2*MT**2*P2Q1/S - YY(1, 2)=YY(1, 2)-32*A**2*A1*A2*P1P2*P2Q1/S- - &64*A**2*A1*A2*P1Q1*P2Q1/S- - &32*A**2*A1*A2*MT**2*P2Q2/S-32*A**2*A1*A2*P1P2*P2Q2/S- - &64*A**2*A1*A2*P1Q2*P2Q2/S+32*A1*A2*MB*MT*V**2- - &128*A1*A2*MB*MT*P1Q2*P2Q1*V**2/S**2 - - &128*A1*A2*P1P2*P1Q2*P2Q1*V**2/S**2+ - &64*A1*A2*P1Q1*P1Q2*P2Q1*V**2/S**2- - &64*A1*A2*P1Q2**2*P2Q1*V**2/S**2+ - &64*A1*A2*P1Q2*P2Q1**2*V**2/S**2- - &128*A1*A2*MB*MT*P1Q1*P2Q2*V**2/S**2- - &128*A1*A2*P1P2*P1Q1*P2Q2*V**2/S**2- - &64*A1*A2*P1Q1**2*P2Q2*V**2/S**2+ - &64*A1*A2*P1Q1*P1Q2*P2Q2*V**2/S**2- - &64*A1*A2*P1Q1*P2Q1*P2Q2*V**2/S**2- - &64*A1*A2*P1Q2*P2Q1*P2Q2*V**2/S**2+ - &64*A1*A2*P1Q1*P2Q2**2*V**2/S**2+ - &64*A1*A2*MB*MT*P1P2*V**2/S+64*A1*A2*P1P2**2*V**2/S - YY(1, 2)=YY(1, 2)+32*A1*A2*MB**2*P1Q1*V**2/S+ - &32*A1*A2*P1P2*P1Q1*V**2/S+ - &32*A1*A2*MB**2*P1Q2*V**2/S+32*A1*A2*P1P2*P1Q2*V**2/S- - &32*A1*A2*MT**2*P2Q1*V**2/S-32*A1*A2*P1P2*P2Q1*V**2/S- - &64*A1*A2*P1Q1*P2Q1*V**2/S-32*A1*A2*MT**2*P2Q2*V**2/S- - &32*A1*A2*P1P2*P2Q2*V**2/S-64*A1*A2*P1Q2*P2Q2*V**2/S - - - YY(2, 2) =-16*A**2*A12*MB*MT+ - &128*A**2*A12*MB*MT*P1Q1*P1Q2/S**2- - &128*A**2*A12*P1P2*P1Q1*P1Q2/S**2+ - &64*A**2*A12*P1Q1*P1Q2*P2Q1/S**2- - &64*A**2*A12*P1Q2**2*P2Q1/S**2-64*A**2*A12*P1Q1**2*P2Q2/S**2+ - &64*A**2*A12*P1Q1*P1Q2*P2Q2/S**2-32*A**2*A12*MB*MT**3/S+ - &32*A**2*A12*MT**2*P1P2/S+32*A**2*A12*P1P2*P1Q1/S+ - &32*A**2*A12*P1P2*P1Q2/S-32*A**2*A12*MT**2*P2Q1/S- - &32*A**2*A12*P1Q1*P2Q1/S-32*A**2*A12*MT**2*P2Q2/S- - &32*A**2*A12*P1Q2*P2Q2/S+16*A12*MB*MT*V**2- - &128*A12*MB*MT*P1Q1*P1Q2*V**2/S**2- - &128*A12*P1P2*P1Q1*P1Q2*V**2/S**2+ - &64*A12*P1Q1*P1Q2*P2Q1*V**2/S**2- - &64*A12*P1Q2**2*P2Q1*V**2/S**2-64*A12*P1Q1**2*P2Q2*V**2/S**2+ - &64*A12*P1Q1*P1Q2*P2Q2*V**2/S**2+32*A12*MB*MT**3*V**2/S+ - &32*A12*MT**2*P1P2*V**2/S+32*A12*P1P2*P1Q1*V**2/S+ - &32*A12*P1P2*P1Q2*V**2/S-32*A12*MT**2*P2Q1*V**2/S - YY(2, 2)=YY(2, 2)-32*A12*P1Q1*P2Q1*V**2/S- - &32*A12*MT**2*P2Q2*V**2/S- - &32*A12*P1Q2*P2Q2*V**2/S - YY(2, 2)=2*YY(2, 2) - - RES=YY(1,1)+2*YY(1,2)+YY(2,2) - AMP2= FACT*PS*VTB**2*RES - - END -C===================================================================== -C ************* FUNCTION SCALAR PRODUCTS ************************* - DOUBLE PRECISION FUNCTION PYTBHS(A,B) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DIMENSION A(4),B(4) - DUM=A(4)*B(4) - DO 77 ID=1,3 - DUM=DUM-A(ID)*B(ID) - 77 CONTINUE - PYTBHS=DUM - RETURN - END - -C********************************************************************* - -C...PYTECM -C...Finds the s-hat dependent eigenvalues of the inverse propagator -C...matrix for gamma, Z, techni-rho, and techni-omega to optimize the -C...phase space generation. - - SUBROUTINE PYTECM(S1,S2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYTCSM/ - -C...Local variables. - DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),WORK(12,12), - &AT(4,4),WI(4),FV1(4),FV2(4),FV3(4),sh,aem,tanw,ct2w,qupd,alprht, - &far,fao,fzr,fzo,shr,R1,R2,S1,S2,WDTP(0:400),WDTE(0:400,0:5) - INTEGER i,j,ierr - - SH=PMAS(PYCOMP(KTECHN+113),1)**2 - AEM=PYALEM(SH) - - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) - QUPD=2D0*RTCM(2)-1D0 - - ALPRHT=2.91D0*(3D0/DBLE(ITCM(1))) - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - - AR(1,1) = SH - AR(2,2) = SH-PMAS(23,1)**2 - AR(3,3) = SH-PMAS(PYCOMP(KTECHN+113),1)**2 - AR(4,4) = SH-PMAS(PYCOMP(KTECHN+223),1)**2 - AR(1,2) = 0D0 - AR(2,1) = 0D0 - AR(1,3) = -SH*FAR - AR(3,1) = AR(1,3) - AR(1,4) = -SH*FAO - AR(4,1) = AR(1,4) - AR(2,3) = -SH*FZR - AR(3,2) = AR(2,3) - AR(2,4) = -SH*FZO - AR(4,2) = AR(2,4) - AR(3,4) = 0D0 - AR(4,3) = 0D0 -CCCCCCCC - DO 110 I=1,4 - DO 100 J=1,4 - AT(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - SHR=SQRT(SH) - CALL PYWIDT(23,SH,WDTP,WDTE) - AT(2,2) = WDTP(0)*SHR - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - AT(3,3) = WDTP(0)*SHR - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - AT(4,4) = WDTP(0)*SHR -CCCC - CALL PYEICG(4,4,AR,AT,WR,WI,0,ZR,ZI,FV1,FV2,FV3,IERR) - DO 120 I=1,4 - WI(I)=SQRT(ABS(SH-WR(I))) - WR(I)=ABS(WR(I)) - 120 CONTINUE - R1=MIN(WR(1),WR(2),WR(3),WR(4)) - R2=1D20 - S1=0D0 - S2=0D0 - DO 130 I=1,4 - IF(ABS(WR(I)-R1).LT.1D-6) THEN - S1=WI(I) - GOTO 130 - ENDIF - IF(WR(I).LE.R2) THEN - R2=WR(I) - S2=WI(I) - ENDIF - 130 CONTINUE - S1=S1**2 - S2=S2**2 - RETURN - END - -C********************************************************************* - -C...PYTEST -C...A simple program (disguised as subroutine) to run at installation -C...as a check that the program works as intended. - - SUBROUTINE PYTEST(MTEST) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/ -C...Local arrays. - DIMENSION PSUM(5),PINI(6),PFIN(6) - -C...Save defaults for values that are changed. - MSTJ1=MSTJ(1) - MSTJ3=MSTJ(3) - MSTJ11=MSTJ(11) - MSTJ42=MSTJ(42) - MSTJ43=MSTJ(43) - MSTJ44=MSTJ(44) - PARJ17=PARJ(17) - PARJ22=PARJ(22) - PARJ43=PARJ(43) - PARJ54=PARJ(54) - MST101=MSTJ(101) - MST104=MSTJ(104) - MST105=MSTJ(105) - MST107=MSTJ(107) - MST116=MSTJ(116) - -C...First part: loop over simple events to be generated. - IF(MTEST.GE.1) CALL PYTABU(20) - NERR=0 - DO 180 IEV=1,500 - -C...Reset parameter values. Switch on some nonstandard features. - MSTJ(1)=1 - MSTJ(3)=0 - MSTJ(11)=1 - MSTJ(42)=2 - MSTJ(43)=4 - MSTJ(44)=2 - PARJ(17)=0.1D0 - PARJ(22)=1.5D0 - PARJ(43)=1D0 - PARJ(54)=-0.05D0 - MSTJ(101)=5 - MSTJ(104)=5 - MSTJ(105)=0 - MSTJ(107)=1 - IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 - -C...Ten events each for some single jets configurations. - IF(IEV.LE.50) THEN - ITY=(IEV+9)/10 - MSTJ(3)=-1 - IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 - IF(ITY.EQ.1) CALL PY1ENT(1,1,15D0,0D0,0D0) - IF(ITY.EQ.2) CALL PY1ENT(1,3101,15D0,0D0,0D0) - IF(ITY.EQ.3) CALL PY1ENT(1,-2203,15D0,0D0,0D0) - IF(ITY.EQ.4) CALL PY1ENT(1,-4,30D0,0D0,0D0) - IF(ITY.EQ.5) CALL PY1ENT(1,21,15D0,0D0,0D0) - -C...Ten events each for some simple jet systems; string fragmentation. - ELSEIF(IEV.LE.130) THEN - ITY=(IEV-41)/10 - IF(ITY.EQ.1) CALL PY2ENT(1,1,-1,40D0) - IF(ITY.EQ.2) CALL PY2ENT(1,4,-4,30D0) - IF(ITY.EQ.3) CALL PY2ENT(1,2,2103,100D0) - IF(ITY.EQ.4) CALL PY2ENT(1,21,21,40D0) - IF(ITY.EQ.5) CALL PY3ENT(1,2101,21,-3203,30D0,0.6D0,0.8D0) - IF(ITY.EQ.6) CALL PY3ENT(1,5,21,-5,40D0,0.9D0,0.8D0) - IF(ITY.EQ.7) CALL PY3ENT(1,21,21,21,60D0,0.7D0,0.5D0) - IF(ITY.EQ.8) CALL PY4ENT(1,2,21,21,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - -C...Seventy events with independent fragmentation and momentum cons. - ELSEIF(IEV.LE.200) THEN - ITY=1+(IEV-131)/16 - MSTJ(2)=1+MOD(IEV-131,4) - MSTJ(3)=1+MOD((IEV-131)/4,4) - IF(ITY.EQ.1) CALL PY2ENT(1,4,-5,40D0) - IF(ITY.EQ.2) CALL PY3ENT(1,3,21,-3,40D0,0.9D0,0.4D0) - IF(ITY.EQ.3) CALL PY4ENT(1,2,21,21,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - IF(ITY.GE.4) CALL PY4ENT(1,2,-3,3,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - -C...A hundred events with random jets (check invariant mass). - ELSEIF(IEV.LE.300) THEN - 100 DO 110 J=1,5 - PSUM(J)=0D0 - 110 CONTINUE - NJET=2D0+6D0*PYR(0) - DO 130 I=1,NJET - KFL=21 - IF(I.EQ.1) KFL=INT(1D0+4D0*PYR(0)) - IF(I.EQ.NJET) KFL=-INT(1D0+4D0*PYR(0)) - EJET=5D0+20D0*PYR(0) - THETA=ACOS(2D0*PYR(0)-1D0) - PHI=6.2832D0*PYR(0) - IF(I.LT.NJET) CALL PY1ENT(-I,KFL,EJET,THETA,PHI) - IF(I.EQ.NJET) CALL PY1ENT(I,KFL,EJET,THETA,PHI) - IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 - IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+PYMASS(KFL) - DO 120 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 120 CONTINUE - 130 CONTINUE - IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. - & (PSUM(5)+PARJ(32))**2) GOTO 100 - -C...Fifty e+e- continuum events with matrix elements. - ELSEIF(IEV.LE.350) THEN - MSTJ(101)=2 - CALL PYEEVT(0,40D0) - -C...Fifty e+e- continuum event with varying shower options. - ELSEIF(IEV.LE.400) THEN - MSTJ(42)=1+MOD(IEV,2) - MSTJ(43)=1+MOD(IEV/2,4) - MSTJ(44)=MOD(IEV/8,3) - CALL PYEEVT(0,90D0) - -C...Fifty e+e- continuum events with coherent shower. - ELSEIF(IEV.LE.450) THEN - CALL PYEEVT(0,500D0) - -C...Fifty Upsilon decays to ggg or gammagg with coherent shower. - ELSE - CALL PYONIA(5,9.46D0) - ENDIF - -C...Generate event. Find total momentum, energy and charge. - DO 140 J=1,4 - PINI(J)=PYP(0,J) - 140 CONTINUE - PINI(6)=PYP(0,6) - CALL PYEXEC - DO 150 J=1,4 - PFIN(J)=PYP(0,J) - 150 CONTINUE - PFIN(6)=PYP(0,6) - -C...Check conservation of energy, momentum and charge; -C...usually exact, but only approximate for single jets. - MERR=0 - IF(IEV.LE.50) THEN - IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.10D0) - & MERR=MERR+1 - EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) - IF(EPZREM.LT.0D0.OR.EPZREM.GT.2D0*PARJ(31)) MERR=MERR+1 - IF(ABS(PFIN(6)-PINI(6)).GT.2.1D0) MERR=MERR+1 - ELSE - DO 160 J=1,4 - IF(ABS(PFIN(J)-PINI(J)).GT.0.0001D0*PINI(4)) MERR=MERR+1 - 160 CONTINUE - IF(ABS(PFIN(6)-PINI(6)).GT.0.1D0) MERR=MERR+1 - ENDIF - IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), - & (PFIN(J),J=1,4),PFIN(6) - -C...Check that all KF codes are known ones, and that partons/particles -C...satisfy energy-momentum-mass relation. Store particle statistics. - DO 170 I=1,N - IF(K(I,1).GT.20) GOTO 170 - IF(PYCOMP(K(I,2)).EQ.0) THEN - WRITE(MSTU(11),5100) I - MERR=MERR+1 - ENDIF - PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 - IF(ABS(PD).GT.MAX(0.1D0,0.001D0*P(I,4)**2).OR.P(I,4).LT.0D0) - & THEN - WRITE(MSTU(11),5200) I - MERR=MERR+1 - ENDIF - 170 CONTINUE - IF(MTEST.GE.1) CALL PYTABU(21) - -C...List all erroneous events and some normal ones. - IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN - IF(MERR.GE.1) WRITE(MSTU(11),6400) - CALL PYLIST(2) - ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN - CALL PYLIST(1) - ENDIF - -C...Stop execution if too many errors. - IF(MERR.NE.0) NERR=NERR+1 - IF(NERR.GE.10) THEN - WRITE(MSTU(11),6300) - CALL PYLIST(1) - STOP - ENDIF - 180 CONTINUE - -C...Summarize result of run. - IF(MTEST.GE.1) CALL PYTABU(22) - -C...Reset commonblock variables changed during run. - MSTJ(1)=MSTJ1 - MSTJ(3)=MSTJ3 - MSTJ(11)=MSTJ11 - MSTJ(42)=MSTJ42 - MSTJ(43)=MSTJ43 - MSTJ(44)=MSTJ44 - PARJ(17)=PARJ17 - PARJ(22)=PARJ22 - PARJ(43)=PARJ43 - PARJ(54)=PARJ54 - MSTJ(101)=MST101 - MSTJ(104)=MST104 - MSTJ(105)=MST105 - MSTJ(107)=MST107 - MSTJ(116)=MST116 - -C...Second part: complete events of various kinds. -C...Common initial values. Loop over initiating conditions. - MSTP(122)=MAX(0,MIN(2,MTEST)) - MDCY(PYCOMP(111),1)=0 - DO 230 IPROC=1,8 - -C...Reset process type, kinematics cuts, and the flags used. - MSEL=0 - DO 190 ISUB=1,500 - MSUB(ISUB)=0 - 190 CONTINUE - CKIN(1)=2D0 - CKIN(3)=0D0 - MSTP(2)=1 - MSTP(11)=0 - MSTP(33)=0 - MSTP(81)=1 - MSTP(82)=1 - MSTP(111)=1 - MSTP(131)=0 - MSTP(133)=0 - PARP(131)=0.01D0 - -C...Prompt photon production at fixed target. - IF(IPROC.EQ.1) THEN - PZSUM=300D0 - PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212) - PQSUM=2D0 - MSEL=10 - CKIN(3)=5D0 - CALL PYINIT('FIXT','pi+','p',PZSUM) - -C...QCD processes at ISR energies. - ELSEIF(IPROC.EQ.2) THEN - PESUM=63D0 - PZSUM=0D0 - PQSUM=2D0 - MSEL=1 - CKIN(3)=5D0 - CALL PYINIT('CMS','p','p',PESUM) - -C...W production + multiple interactions at CERN Collider. - ELSEIF(IPROC.EQ.3) THEN - PESUM=630D0 - PZSUM=0D0 - PQSUM=0D0 - MSEL=12 - CKIN(1)=20D0 - MSTP(82)=4 - MSTP(2)=2 - MSTP(33)=3 - CALL PYINIT('CMS','p','pbar',PESUM) - -C...W/Z gauge boson pairs + pileup events at the Tevatron. - ELSEIF(IPROC.EQ.4) THEN - PESUM=1800D0 - PZSUM=0D0 - PQSUM=0D0 - MSUB(22)=1 - MSUB(23)=1 - MSUB(25)=1 - CKIN(1)=200D0 - MSTP(111)=0 - MSTP(131)=1 - MSTP(133)=2 - PARP(131)=0.04D0 - CALL PYINIT('CMS','p','pbar',PESUM) - -C...Higgs production at LHC. - ELSEIF(IPROC.EQ.5) THEN - PESUM=15400D0 - PZSUM=0D0 - PQSUM=2D0 - MSUB(3)=1 - MSUB(102)=1 - MSUB(123)=1 - MSUB(124)=1 - PMAS(25,1)=300D0 - CKIN(1)=200D0 - MSTP(81)=0 - MSTP(111)=0 - CALL PYINIT('CMS','p','p',PESUM) - -C...Z' production at SSC. - ELSEIF(IPROC.EQ.6) THEN - PESUM=40000D0 - PZSUM=0D0 - PQSUM=2D0 - MSEL=21 - PMAS(32,1)=600D0 - CKIN(1)=400D0 - MSTP(81)=0 - MSTP(111)=0 - CALL PYINIT('CMS','p','p',PESUM) - -C...W pair production at 1 TeV e+e- collider. - ELSEIF(IPROC.EQ.7) THEN - PESUM=1000D0 - PZSUM=0D0 - PQSUM=0D0 - MSUB(25)=1 - MSUB(69)=1 - MSTP(11)=1 - CALL PYINIT('CMS','e+','e-',PESUM) - -C...Deep inelastic scattering at a LEP+LHC ep collider. - ELSEIF(IPROC.EQ.8) THEN - P(1,1)=0D0 - P(1,2)=0D0 - P(1,3)=8000D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(2,3)=-80D0 - PESUM=8080D0 - PZSUM=7920D0 - PQSUM=0D0 - MSUB(10)=1 - CKIN(3)=50D0 - MSTP(111)=0 - CALL PYINIT('3MOM','p','e-',PESUM) - ENDIF - -C...Generate 20 events of each required type. - DO 220 IEV=1,20 - CALL PYEVNT - PESUMM=PESUM - IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM - -C...Check conservation of energy/momentum/flavour. - PINI(1)=0D0 - PINI(2)=0D0 - PINI(3)=PZSUM - PINI(4)=PESUMM - PINI(6)=PQSUM - DO 200 J=1,4 - PFIN(J)=PYP(0,J) - 200 CONTINUE - PFIN(6)=PYP(0,6) - MERR=0 - DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3)) - DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2)) - DEVQ=ABS(PFIN(6)-PINI(6)) - IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR. - & DEVQ.GT.0.1D0) MERR=1 - IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), - & (PFIN(J),J=1,4),PFIN(6) - -C...Check that all KF codes are known ones, and that partons/particles -C...satisfy energy-momentum-mass relation. - DO 210 I=1,N - IF(K(I,1).GT.20) GOTO 210 - IF(PYCOMP(K(I,2)).EQ.0) THEN - WRITE(MSTU(11),5100) I - MERR=MERR+1 - ENDIF - PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2* - & SIGN(1D0,P(I,5)) - IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2) - & .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN - WRITE(MSTU(11),5200) I - MERR=MERR+1 - ENDIF - 210 CONTINUE - -C...Listing of erroneous events, and first event of each type. - IF(MERR.GE.1) NERR=NERR+1 - IF(NERR.GE.10) THEN - WRITE(MSTU(11),6300) - CALL PYLIST(1) - STOP - ENDIF - IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN - IF(MERR.GE.1) WRITE(MSTU(11),6400) - CALL PYLIST(1) - ENDIF - 220 CONTINUE - -C...List statistics for each process type. - IF(MTEST.GE.1) CALL PYSTAT(1) - 230 CONTINUE - -C...Summarize result of run. - IF(NERR.EQ.0) WRITE(MSTU(11),6500) - IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR - -C...Format statements for output. - 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', - &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, - &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, - &4(1X,F12.5),1X,F8.2) - 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') - 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', - &'kinematics') - 6300 FORMAT(/5X,'This is the tenth error experienced! Something is ', - &'wrong.'/5X,'Execution will be stopped after listing of event.') - 6400 FORMAT(5X,'Faulty event follows:') - 6500 FORMAT(//5X,'End result of PYTEST: no errors detected.') - 6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/ - &5X,'This should not have happened!') - - RETURN - END - - DOUBLE PRECISION FUNCTION PYTHAG(A,B) - DOUBLE PRECISION A,B -C -C FINDS DSQRT(A**2+B**2) WITHOUT OVERFLOW OR DESTRUCTIVE UNDERFLOW -C - DOUBLE PRECISION P,R,S,T,U - P = DMAX1(DABS(A),DABS(B)) - IF (P .EQ. 0.0D0) GOTO 110 - R = (DMIN1(DABS(A),DABS(B))/P)**2 - 100 CONTINUE - T = 4.0D0 + R - IF (T .EQ. 4.0D0) GOTO 110 - S = R/T - U = 1.0D0 + 2.0D0*S - P = U*P - R = (S/U)**2 * R - GOTO 100 - 110 PYTHAG = P - RETURN - END - -C********************************************************************* - -C...PYTHRG -C...Calculates the mass eigenstates of the third generation sfermions. -C...Created: 5-31-96 - - SUBROUTINE PYTHRG - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION BETA - DOUBLE PRECISION AM2(2,2),RT(2,2),DI(2,2) - DOUBLE PRECISION XMZ2,XMW2,TANB,XMU,COS2B,XMQL2,XMQR2 - DOUBLE PRECISION XMF,XMF2,DIFF,SAME,XMF12,XMF22,SMALL - DOUBLE PRECISION ATR,AMQR,AMQL - INTEGER ID1(3),ID2(3),ID3(3),ID4(3) - INTEGER IF,I,J,II,JJ,IT,L - LOGICAL DTERM - DATA SMALL/1D-3/ - DATA ID1/10,10,13/ - DATA ID2/5,6,15/ - DATA ID3/15,16,17/ - DATA ID4/11,12,14/ - DATA DTERM/.TRUE./ - - XMZ2=PMAS(23,1)**2 - XMW2=PMAS(24,1)**2 - TANB=RMSS(5) - XMU=-RMSS(4) - BETA=ATAN(TANB) - COS2B=COS(2D0*BETA) - -C...OPTION TO FIX T1, T2, B1 MASSES AND MIXINGS - - IOPT=IMSS(5) - IF(IOPT.EQ.1) THEN - CTT=DCOS(RMSS(27)) - CTT2=CTT**2 - STT=DSIN(RMSS(27)) - STT2=STT**2 - XM12=RMSS(10)**2 - XM22=RMSS(12)**2 - XMQL2=CTT2*XM12+STT2*XM22 - XMQR2=STT2*XM12+CTT2*XM22 - XMF2=PYMRUN(6,PMAS(6,1)**2)**2 - ATOP=-XMU/TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - RMSS(16)=ATOP -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQL2=XMQL2-XMF2-(4D0*XMW2-XMZ2)*COS2B/6D0 - XMQR2=XMQR2-XMF2+(XMW2-XMZ2)*COS2B*2D0/3D0 - IF(XMQL2.GE.0D0) THEN - RMSS(10)=SQRT(XMQL2) - ELSE - RMSS(10)=-SQRT(-XMQL2) - ENDIF - IF(XMQR2.GE.0D0) THEN - RMSS(12)=SQRT(XMQR2) - ELSE - RMSS(12)=-SQRT(-XMQR2) - ENDIF - -C SAME FOR BOTTOM SQUARK - CTT=DCOS(RMSS(26)) - CTT2=CTT**2 - STT=DSIN(RMSS(26)) - STT2=STT**2 - XM22=RMSS(11)**2 - XMF2=PYMRUN(5,PMAS(6,1)**2)**2 - XMQL2=SIGN(RMSS(10)**2,RMSS(10))-(2D0*XMW2+XMZ2)*COS2B/6D0+XMF2 - IF(ABS(CTT).GE..9999D0) THEN - ABOT=-XMU*TANB - XMQR2=RMSS(11)**2 - ELSEIF(ABS(CTT).LE.1D-4) THEN - ABOT=-XMU*TANB - XMQR2=RMSS(11)**2 - ELSE - XM12=(XMQL2-STT2*XM22)/CTT2 - XMQR2=STT2*XM12+CTT2*XM22 - ABOT=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - ENDIF - RMSS(15)=ABOT -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQR2=XMQR2-(XMW2-XMZ2)*COS2B/3D0-XMF2 - IF(XMQR2.GE.0D0) THEN - RMSS(11)=SQRT(XMQR2) - ELSE - RMSS(11)=-SQRT(-XMQR2) - ENDIF -C SAME FOR TAU SLEPTON - CTT=DCOS(RMSS(28)) - CTT2=CTT**2 - STT=DSIN(RMSS(28)) - STT2=STT**2 - XM12=RMSS(13)**2 - XM22=RMSS(14)**2 - XMQL2=CTT2*XM12+STT2*XM22 - XMQR2=STT2*XM12+CTT2*XM22 - XMFR=PMAS(15,1) - XMF2=XMFR**2 - ATAU=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - RMSS(17)=ATAU -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQL2=XMQL2-XMF2+(-.5D0*XMZ2+XMW2)*COS2B - XMQR2=XMQR2-XMF2+(XMZ2-XMW2)*COS2B - IF(XMQL2.GE.0D0) THEN - RMSS(13)=SQRT(XMQL2) - ELSE - RMSS(13)=-SQRT(-XMQL2) - ENDIF - IF(XMQR2.GE.0D0) THEN - RMSS(14)=SQRT(XMQR2) - ELSE - RMSS(14)=-SQRT(-XMQR2) - ENDIF - ENDIF - DO 170 L=1,3 - AMQL=RMSS(ID1(L)) - IF(AMQL.LT.0D0) THEN - XMQL2=-AMQL**2 - ELSE - XMQL2=AMQL**2 - ENDIF - ATR=RMSS(ID3(L)) - AMQR=RMSS(ID4(L)) - IF(AMQR.LT.0D0) THEN - XMQR2=-AMQR**2 - ELSE - XMQR2=AMQR**2 - ENDIF - IF=ID2(L) - XMF=PYMRUN(IF,PMAS(6,1)**2) - XMF2=XMF**2 - AM2(1,1)=XMQL2+XMF2 - AM2(2,2)=XMQR2+XMF2 - IF(AM2(1,1).EQ.AM2(2,2)) AM2(2,2)=AM2(2,2)*1.00001D0 - IF(DTERM) THEN - IF(L.EQ.1) THEN - AM2(1,1)=AM2(1,1)-(2D0*XMW2+XMZ2)*COS2B/6D0 - AM2(2,2)=AM2(2,2)+(XMW2-XMZ2)*COS2B/3D0 - AM2(1,2)=XMF*(ATR+XMU*TANB) - ELSEIF(L.EQ.2) THEN - AM2(1,1)=AM2(1,1)+(4D0*XMW2-XMZ2)*COS2B/6D0 - AM2(2,2)=AM2(2,2)-(XMW2-XMZ2)*COS2B*2D0/3D0 - AM2(1,2)=XMF*(ATR+XMU/TANB) - ELSEIF(L.EQ.3) THEN - IF(IMSS(8).EQ.1) THEN - AM2(1,1)=RMSS(6)**2 - AM2(2,2)=RMSS(7)**2 - AM2(1,2)=0D0 - RMSS(13)=RMSS(6) - RMSS(14)=RMSS(7) - ELSE - AM2(1,1)=AM2(1,1)-(-.5D0*XMZ2+XMW2)*COS2B - AM2(2,2)=AM2(2,2)-(XMZ2-XMW2)*COS2B - AM2(1,2)=XMF*(ATR+XMU*TANB) - ENDIF - ENDIF - ENDIF - AM2(2,1)=AM2(1,2) - DETM=AM2(1,1)*AM2(2,2)-AM2(2,1)**2 - IF(DETM.LT.0D0) THEN - WRITE(MSTU(11),*) ID2(L),DETM,AM2 - CALL PYERRM(30,' NEGATIVE**2 MASS FOR SFERMION IN PYTHRG ') - ENDIF - SAME=0.5D0*(AM2(1,1)+AM2(2,2)) - DIFF=0.5D0*SQRT((AM2(1,1)-AM2(2,2))**2+4D0*AM2(1,2)*AM2(2,1)) - XMF12=SAME-DIFF - XMF22=SAME+DIFF - IT=0 - IF(XMF22-XMF12.GT.0D0) THEN - RT(1,1) = SQRT(MAX(0D0,(XMF22-AM2(1,1))/(XMF22-XMF12))) - RT(2,2) = RT(1,1) - RT(1,2) = -SIGN(SQRT(MAX(0D0,1D0-RT(1,1)**2)), - & AM2(1,2)/(XMF22-XMF12)) - RT(2,1) = -RT(1,2) - ELSE - RT(1,1) = 1D0 - RT(2,2) = RT(1,1) - RT(1,2) = 0D0 - RT(2,1) = -RT(1,2) - ENDIF - 100 CONTINUE - IT=IT+1 - - DO 140 I=1,2 - DO 130 JJ=1,2 - DI(I,JJ)=0D0 - DO 120 II=1,2 - DO 110 J=1,2 - DI(I,JJ)=DI(I,JJ)+RT(I,J)*AM2(J,II)*RT(JJ,II) - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - - IF(DI(1,1).GT.DI(2,2)) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION ' - WRITE(MSTU(11),*) L,SQRT(XMF12),SQRT(XMF22) - WRITE(MSTU(11),*) AM2 - WRITE(MSTU(11),*) DI - WRITE(MSTU(11),*) RT - DI(1,1)=-RT(2,1) - DI(2,2)=RT(1,2) - DI(1,2)=-RT(2,2) - DI(2,1)=RT(1,1) - DO 160 I=1,2 - DO 150 J=1,2 - RT(I,J)=DI(I,J) - 150 CONTINUE - 160 CONTINUE - GOTO 100 - ELSEIF(ABS(DI(1,2)*DI(2,1)/DI(1,1)/DI(2,2)).GT.SMALL) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// - & ' OFF DIAGONAL ELEMENTS ' - WRITE(MSTU(11),*) 'MASSES = ',L,SQRT(XMF12),SQRT(XMF22) - WRITE(MSTU(11),*) DI - WRITE(MSTU(11),*) ' ROTATION = ',RT -C...STOP - ELSEIF(DI(1,1).LT.0D0.OR.DI(2,2).LT.0D0) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// - & ' NEGATIVE MASSES ' - STOP - ENDIF - PMAS(PYCOMP(KSUSY1+IF),1)=SQRT(XMF12) - PMAS(PYCOMP(KSUSY2+IF),1)=SQRT(XMF22) - SFMIX(IF,1)=RT(1,1) - SFMIX(IF,2)=RT(1,2) - SFMIX(IF,3)=RT(2,1) - SFMIX(IF,4)=RT(2,2) - 170 CONTINUE - -C.....TAU SNEUTRINO MASS...L=3 - - XARG=AM2(1,1)+XMW2*COS2B - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' PYTHRG:: TAU SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - PMAS(PYCOMP(KSUSY1+16),1)=SQRT(XARG) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYTHRU -C...Performs thrust analysis to give thrust, oblateness -C...and the related event axes. - - SUBROUTINE PYTHRU(THR,OBL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION TDI(3),TPR(3) - -C...Take copy of particles that are to be considered in thrust analysis. - NP=0 - PS=0D0 - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 100 - ENDIF - IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYTHRU:) no more memory left in PYJETS') - THR=-2D0 - OBL=-2D0 - 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)=1D0 - IF(ABS(PARU(42)-1D0).GT.0.001D0) P(N+NP,5)= - & P(N+NP,4)**(PARU(42)-1D0) - 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 PYERRM(8,'(PYTHRU:) too few particles for analysis') - THR=-1D0 - OBL=-1D0 - 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=PYANGL(P(N+NP+1,1),P(N+NP+1,2)) - MSTU(33)=1 - CALL PYROBO(N+1,N+NP+1,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(N+NP+1,3),P(N+NP+1,1)) - CALL PYROBO(N+1,N+NP+1,-THE,0D0,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)=0D0 - 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)=0D0 - 170 CONTINUE - NC=2**(MIN(MSTU(44),NP)-1) - DO 250 ILC=1,NC - DO 180 J=1,3 - TDI(J)=0D0 - 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)=0D0 - ILG=0 - 260 ILG=ILG+1 - THP=0D0 - 270 THPS=THP - DO 280 J=1,3 - IF(THP.LE.1D-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) - IF(THP.GT.1D-10) TDI(J)=TPR(J) - TPR(J)=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - THP=0D0 - 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)=0D0 - -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)=0D0 - 340 CONTINUE - 350 CONTINUE - CALL PYROBO(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********************************************************************* - -C...PYTIME -C...Finds current date and time. -C...Since this task is not standardized in Fortran 77, the routine -C...is dummy, to be replaced by the user. Examples are given for -C...the Fortran 90 routine and DEC Fortran 77, and what to do if -C...you do not have access to suitable routines. - - SUBROUTINE PYTIME(IDATI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - CHARACTER*8 ATIME -C...Local array. - INTEGER IDATI(6),IDTEMP(3) - -C...Example 0: if you do not have suitable routines. - DO 100 J=1,6 - IDATI(J)=0 - 100 CONTINUE - -C...Example 1: Fortran 90 routine. -C INTEGER IVAL(8) -C CALL DATE_AND_TIME(VALUES=IVAL) -C IDATI(1)=IVAL(1) -C IDATI(2)=IVAL(2) -C IDATI(3)=IVAL(3) -C IDATI(4)=IVAL(5) -C IDATI(5)=IVAL(6) -C IDATI(6)=IVAL(7) - -C...Example 2: DEC Fortran 77. AIX. -C CALL IDATE(IMON,IDAY,IYEAR) -C IDATI(1)=IYEAR -C IDATI(2)=IMON -C IDATI(3)=IDAY -C CALL ITIME(IHOUR,IMIN,ISEC) -C IDATI(4)=IHOUR -C IDATI(5)=IMIN -C IDATI(6)=ISEC - -C...Example 3: DEC Fortran, IRIX, IRIX64. -C CALL IDATE(IMON,IDAY,IYEAR) -C IDATI(1)=IYEAR -C IDATI(2)=IMON -C IDATI(3)=IDAY -C CALL TIME(ATIME) -C IHOUR=0 -C IMIN=0 -C ISEC=0 -C READ(ATIME(1:2),'(I2)') IHOUR -C READ(ATIME(4:5),'(I2)') IMIN -C READ(ATIME(7:8),'(I2)') ISEC -C IDATI(4)=IHOUR -C IDATI(5)=IMIN -C IDATI(6)=ISEC - -C...Example 4: GNU LINUX libU77, SunOS. - CALL IDATE(IDTEMP) - IDATI(1)=IDTEMP(3) - IDATI(2)=IDTEMP(2) - IDATI(3)=IDTEMP(1) - CALL ITIME(IDTEMP) - IDATI(4)=IDTEMP(1) - IDATI(5)=IDTEMP(2) - IDATI(6)=IDTEMP(3) - -C...Common code to ensure right century. - IDATI(1)=2000+MOD(IDATI(1),100) - - RETURN - END - -C********************************************************************* - -C...PYUPDA -C...Facilitates the updating of particle and decay data -C...by allowing it to be done in an external file. - - SUBROUTINE PYUPDA(MUPDA,LFN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYINT4/ -C...Local arrays, character variables and data. - CHARACTER CHINL*120,CHKF*9,CHVAR(22)*9,CHLIN*72, - &CHBLK(20)*72,CHOLD*16,CHTMP*16,CHNEW*16,CHCOM*24 - DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','KCHG(I,4)', - &'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,1)','CHAF(I,2)','MWID(I) '/ - -C...Write header if not yet done. - IF(MSTU(12).GE.1) CALL PYLIST(0) - -C...Write information on file for editing. - IF(MUPDA.EQ.1) THEN - DO 110 KC=1,500 - WRITE(LFN,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), - & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), - & MWID(KC),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...Read complete set of information from edited file or -C...read partial set of new or updated information from edited file. - ELSEIF(MUPDA.EQ.2.OR.MUPDA.EQ.3) THEN - -C...Reset counters. - KCC=100 - NDC=0 - CHKF=' ' - IF(MUPDA.EQ.2) THEN - DO 120 I=1,MSTU(6) - KCHG(I,4)=0 - 120 CONTINUE - ELSE - DO 130 KC=1,MSTU(6) - IF(KC.GT.100.AND.KCHG(KC,4).GT.100) KCC=KC - NDC=MAX(NDC,MDCY(KC,2)+MDCY(KC,3)-1) - 130 CONTINUE - ENDIF - -C...Begin of loop: read new line; unknown whether particle or -C...decay data. - 140 READ(LFN,5200,END=190) CHINL - -C...Identify particle code and whether already defined (for MUPDA=3). - IF(CHINL(2:10).NE.' ') THEN - CHKF=CHINL(2:10) - READ(CHKF,5300) KF - IF(MUPDA.EQ.2) THEN - IF(KF.LE.100) THEN - KC=KF - ELSE - KCC=KCC+1 - KC=KCC - ENDIF - ELSE - KCREP=0 - IF(KF.LE.100) THEN - KCREP=KF - ELSE - DO 150 KCR=101,KCC - IF(KCHG(KCR,4).EQ.KF) KCREP=KCR - 150 CONTINUE - ENDIF -C...Remove duplicate old decay data. - IF(KCREP.NE.0.AND.MDCY(KCREP,3).GT.0) THEN - IDCREP=MDCY(KCREP,2) - NDCREP=MDCY(KCREP,3) - DO 160 I=1,KCC - IF(MDCY(I,2).GT.IDCREP) MDCY(I,2)=MDCY(I,2)-NDCREP - 160 CONTINUE - DO 180 I=IDCREP,NDC-NDCREP - MDME(I,1)=MDME(I+NDCREP,1) - MDME(I,2)=MDME(I+NDCREP,2) - BRAT(I)=BRAT(I+NDCREP) - DO 170 J=1,5 - KFDP(I,J)=KFDP(I+NDCREP,J) - 170 CONTINUE - 180 CONTINUE - NDC=NDC-NDCREP - KC=KCREP - ELSEIF(KCREP.NE.0) THEN - KC=KCREP - ELSE - KCC=KCC+1 - KC=KCC - ENDIF - ENDIF - -C...Study line with particle data. - IF(KC.GT.MSTU(6)) CALL PYERRM(27, - & '(PYUPDA:) Particle arrays full by KF ='//CHKF) - READ(CHINL,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), - & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), - & MWID(KC),MDCY(KC,1) - MDCY(KC,2)=0 - MDCY(KC,3)=0 - -C...Study line with decay data. - ELSE - NDC=NDC+1 - IF(NDC.GT.MSTU(7)) CALL PYERRM(27, - & '(PYUPDA:) Decay data arrays full by KF ='//CHKF) - IF(MDCY(KC,2).EQ.0) MDCY(KC,2)=NDC - MDCY(KC,3)=MDCY(KC,3)+1 - READ(CHINL,5100) MDME(NDC,1),MDME(NDC,2),BRAT(NDC), - & (KFDP(NDC,J),J=1,5) - ENDIF - -C...End of loop; ensure that PYCOMP tables are updated. - GOTO 140 - 190 CONTINUE - MSTU(20)=0 - -C...Perform possible tests that new information is consistent. - DO 220 KC=1,MSTU(6) - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 220 - WRITE(CHKF,5300) KF - IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), - & PMAS(KC,4)).LT.0D0.OR.MDCY(KC,3).LT.0) CALL PYERRM(17, - & '(PYUPDA:) Mass/width/life/(# channels) wrong for KF ='//CHKF) - BRSUM=0D0 - DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - IF(MDME(IDC,2).GT.80) GOTO 210 - KQ=KCHG(KC,1) - PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) - MERR=0 - DO 200 J=1,5 - KP=KFDP(IDC,J) - IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN - IF(KP.EQ.81) KQ=0 - ELSEIF(PYCOMP(KP).EQ.0) THEN - MERR=3 - ELSE - KQ=KQ-PYCHGE(KP) - KPC=PYCOMP(KP) - PMS=PMS-PMAS(KPC,1) - IF(MSTJ(24).GT.0) PMS=PMS+0.5D0*MIN(PMAS(KPC,2), - & PMAS(KPC,3)) - ENDIF - 200 CONTINUE - IF(KQ.NE.0) MERR=MAX(2,MERR) - IF(MWID(KC).EQ.0.AND.KF.NE.311.AND.PMS.LT.0D0) - & MERR=MAX(1,MERR) - IF(MERR.EQ.3) CALL PYERRM(17, - & '(PYUPDA:) Unknown particle code in decay of KF ='//CHKF) - IF(MERR.EQ.2) CALL PYERRM(17, - & '(PYUPDA:) Charge not conserved in decay of KF ='//CHKF) - IF(MERR.EQ.1) CALL PYERRM(7, - & '(PYUPDA:) Kinematically unallowed decay of KF ='//CHKF) - BRSUM=BRSUM+BRAT(IDC) - 210 CONTINUE - WRITE(CHTMP,5500) BRSUM - IF(ABS(BRSUM).GT.0.0005D0.AND.ABS(BRSUM-1D0).GT.0.0005D0) - & CALL PYERRM(7,'(PYUPDA:) Sum of branching ratios is '// - & CHTMP(9:16)//' for KF ='//CHKF) - 220 CONTINUE - -C...Write DATA statements for inclusion in program. - ELSEIF(MUPDA.EQ.4) THEN - -C...Find out how many codes and decay channels are actually used. - KCC=0 - NDC=0 - DO 230 I=1,MSTU(6) - IF(KCHG(I,4).NE.0) THEN - KCC=I - NDC=MAX(NDC,MDCY(I,2)+MDCY(I,3)-1) - ENDIF - 230 CONTINUE - -C...Initialize writing of DATA statements for inclusion in program. - DO 300 IVAR=1,22 - NDIM=MSTU(6) - IF(IVAR.GE.12.AND.IVAR.LE.19) 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 280 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,5400) KCHG(IDIM,4) - IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,1) - IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,2) - IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,3) - IF(IVAR.EQ.8) WRITE(CHTMP,5500) PMAS(IDIM,4) - IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,1) - IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,2) - IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDCY(IDIM,3) - IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,1) - IF(IVAR.EQ.13) WRITE(CHTMP,5400) MDME(IDIM,2) - IF(IVAR.EQ.14) WRITE(CHTMP,5600) BRAT(IDIM) - IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,1) - IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,2) - IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,3) - IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,4) - IF(IVAR.EQ.19) WRITE(CHTMP,5400) KFDP(IDIM,5) - IF(IVAR.EQ.20) CHTMP=CHAF(IDIM,1) - IF(IVAR.EQ.21) CHTMP=CHAF(IDIM,2) - IF(IVAR.EQ.22) WRITE(CHTMP,5400) MWID(IDIM) - -C...Replace variables beyond what is properly defined. - IF(IVAR.LE.4) THEN - IF(IDIM.GT.KCC) CHTMP=' 0' - ELSEIF(IVAR.LE.8) THEN - IF(IDIM.GT.KCC) CHTMP=' 0.0' - ELSEIF(IVAR.LE.11) THEN - IF(IDIM.GT.KCC) CHTMP=' 0' - ELSEIF(IVAR.LE.13) THEN - IF(IDIM.GT.NDC) CHTMP=' 0' - ELSEIF(IVAR.LE.14) THEN - IF(IDIM.GT.NDC) CHTMP=' 0.0' - ELSEIF(IVAR.LE.19) THEN - IF(IDIM.GT.NDC) CHTMP=' 0' - ELSEIF(IVAR.LE.21) THEN - IF(IDIM.GT.KCC) CHTMP=' ' - ELSE - IF(IDIM.GT.KCC) CHTMP=' 0' - ENDIF - -C...Length of variable, trailing decimal zeros, quotation marks. - LLOW=1 - LHIG=1 - DO 240 LL=1,16 - IF(CHTMP(17-LL:17-LL).NE.' ') LLOW=17-LL - IF(CHTMP(LL:LL).NE.' ') LHIG=LL - 240 CONTINUE - CHNEW=CHTMP(LLOW:LHIG)//' ' - LNEW=1+LHIG-LLOW - IF((IVAR.GE.5.AND.IVAR.LE.8).OR.IVAR.EQ.14) THEN - LNEW=LNEW+1 - 250 LNEW=LNEW-1 - IF(LNEW.GE.2.AND.CHNEW(LNEW:LNEW).EQ.'0') GOTO 250 - IF(CHNEW(LNEW:LNEW).EQ.'.') LNEW=LNEW-1 - IF(LNEW.EQ.0) THEN - CHNEW(1:3)='0D0' - LNEW=3 - ELSE - CHNEW(LNEW+1:LNEW+2)='D0' - LNEW=LNEW+2 - ENDIF - ELSEIF(IVAR.EQ.20.OR.IVAR.EQ.21) THEN - DO 260 LL=LNEW,1,-1 - IF(CHNEW(LL:LL).EQ.'''') THEN - CHTMP=CHNEW - CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) - LNEW=LNEW+1 - ENDIF - 260 CONTINUE - LNEW=MIN(14,LNEW) - 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(17-LRPT:16)//'*'//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(13:16) - DO 270 ILIN=1,NLIN - WRITE(LFN,5700) CHBLK(ILIN) - 270 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(13:16) - LLIN=35+LCOM+1 - ENDIF - 280 CONTINUE - -C...Write final block of lines. - CHLIN(LLIN:72)='/'//' ' - CHBLK(NLIN)=CHLIN - WRITE(CHTMP,5400) NDIM - CHBLK(1)(30:33)=CHTMP(13:16) - DO 290 ILIN=1,NLIN - WRITE(LFN,5700) CHBLK(ILIN) - 290 CONTINUE - 300 CONTINUE - ENDIF - -C...Formats for reading and writing particle data. - 5000 FORMAT(1X,I9,2X,A16,2X,A16,3I3,3F12.5,1P,E13.5,2I3) - 5100 FORMAT(10X,2I5,F12.6,5I10) - 5200 FORMAT(A120) - 5300 FORMAT(I9) - 5400 FORMAT(I16) - 5500 FORMAT(F16.5) - 5600 FORMAT(F16.6) - 5700 FORMAT(A72) - - RETURN - END - -C********************************************************************* - -C...PYUPRE -C...Rearranges contents of the HEPEUP commonblock so that -C...mothers precede daughters and daughters of a decay are -C...listed consecutively. - - SUBROUTINE PYUPRE - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Local arrays. - DIMENSION NEWPOS(0:MAXNUP),IDUPT(MAXNUP),ISTUPT(MAXNUP), - &MOTUPT(2,MAXNUP),ICOUPT(2,MAXNUP),PUPT(5,MAXNUP), - &VTIUPT(MAXNUP),SPIUPT(MAXNUP) - -C...Check whether a rearrangement is required. - NEED=0 - DO 100 IUP=1,NUP - IF(MOTHUP(1,IUP).GT.IUP) NEED=NEED+1 - 100 CONTINUE - DO 110 IUP=2,NUP - IF(MOTHUP(1,IUP).LT.MOTHUP(1,IUP-1)) NEED=NEED+1 - 110 CONTINUE - - IF(NEED.NE.0) THEN -C...Find the new order that particles should have. - NEWPOS(0)=0 - NNEW=0 - INEW=-1 - 120 INEW=INEW+1 - DO 130 IUP=1,NUP - IF(MOTHUP(1,IUP).EQ.NEWPOS(INEW)) THEN - NNEW=NNEW+1 - NEWPOS(NNEW)=IUP - ENDIF - 130 CONTINUE - IF(INEW.LT.NNEW.AND.INEW.LT.NUP) GOTO 120 - IF(NNEW.NE.NUP) THEN - CALL PYERRM(2, - & '(PYUPRE:) failed to make sense of mother pointers in HEPEUP') - RETURN - ENDIF - -C...Copy old info into temporary storage. - DO 150 I=1,NUP - IDUPT(I)=IDUP(I) - ISTUPT(I)=ISTUP(I) - MOTUPT(1,I)=MOTHUP(1,I) - MOTUPT(2,I)=MOTHUP(2,I) - ICOUPT(1,I)=ICOLUP(1,I) - ICOUPT(2,I)=ICOLUP(2,I) - DO 140 J=1,5 - PUPT(J,I)=PUP(J,I) - 140 CONTINUE - VTIUPT(I)=VTIMUP(I) - SPIUPT(I)=SPINUP(I) - 150 CONTINUE - -C...Copy info back into HEPEUP in right order. - DO 180 I=1,NUP - IOLD=NEWPOS(I) - IDUP(I)=IDUPT(IOLD) - ISTUP(I)=ISTUPT(IOLD) - MOTHUP(1,I)=0 - MOTHUP(2,I)=0 - DO 160 IMOT=1,I-1 - IF(MOTUPT(1,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(1,I)=IMOT - IF(MOTUPT(2,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(2,I)=IMOT - 160 CONTINUE - IF(MOTHUP(2,I).GT.0.AND.MOTHUP(2,I).LT.MOTHUP(1,I)) THEN - MOTHSW=MOTHUP(1,I) - MOTHUP(1,I)=MOTHUP(2,I) - MOTHUP(2,I)=MOTHSW - ENDIF - ICOLUP(1,I)=ICOUPT(1,IOLD) - ICOLUP(2,I)=ICOUPT(2,IOLD) - DO 170 J=1,5 - PUP(J,I)=PUPT(J,IOLD) - 170 CONTINUE - VTIMUP(I)=VTIUPT(IOLD) - SPINUP(I)=SPIUPT(IOLD) - 180 CONTINUE - ENDIF - -c...If incoming particles are massive recalculate to put them massless. - IF(PUP(5,1).NE.0D0.OR.PUP(5,2).NE.0D0) THEN - PPLUS=(PUP(4,1)+PUP(3,1))+(PUP(4,2)+PUP(3,2)) - PMINUS=(PUP(4,1)-PUP(3,1))+(PUP(4,2)-PUP(3,2)) - PUP(4,1)=0.5D0*PPLUS - PUP(3,1)=PUP(4,1) - PUP(5,1)=0D0 - PUP(4,2)=0.5D0*PMINUS - PUP(3,2)=-PUP(4,2) - PUP(5,2)=0D0 - ENDIF - - RETURN - END - -C*********************************************************************** - -C...PYWAUX -C...Calculates real and imaginary parts of the auxiliary functions W1 -C...and W2; see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van -C...der Bij, Nucl. Phys. B297 (1988) 221. - - SUBROUTINE PYWAUX(IAUX,EPS,WRE,WIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - ASINH(X)=LOG(X+SQRT(X**2+1D0)) - ACOSH(X)=LOG(X+SQRT(X**2-1D0)) - - IF(EPS.LT.0D0) THEN - IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ASINH(SQRT(-1D0/EPS)) - IF(IAUX.EQ.2) WRE=4D0*(ASINH(SQRT(-1D0/EPS)))**2 - WIM=0D0 - ELSEIF(EPS.LT.1D0) THEN - IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ACOSH(SQRT(1D0/EPS)) - IF(IAUX.EQ.2) WRE=4D0*(ACOSH(SQRT(1D0/EPS)))**2-PARU(1)**2 - IF(IAUX.EQ.1) WIM=-PARU(1)*SQRT(1D0-EPS) - IF(IAUX.EQ.2) WIM=-4D0*PARU(1)*ACOSH(SQRT(1D0/EPS)) - ELSE - IF(IAUX.EQ.1) WRE=2D0*SQRT(EPS-1D0)*ASIN(SQRT(1D0/EPS)) - IF(IAUX.EQ.2) WRE=-4D0*(ASIN(SQRT(1D0/EPS)))**2 - WIM=0D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYWIDT -C...Calculates full and partial widths of resonances. - - SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYTCSM/ -C...Local arrays and saved variables. - COMPLEX*16 ZMIXC(4,4),AL,BL,AR,BR,FL,FR - DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), - &WID2SV(3,2),WDTPP(0:400),WDTEP(0:400,0:5) - SAVE MOFSV,WIDWSV,WID2SV - DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ - -C...Compressed code and sign; mass. - KFLA=IABS(KFLR) - KFLS=ISIGN(1,KFLR) - KC=PYCOMP(KFLA) - SHR=SQRT(SH) - PMR=PMAS(KC,1) - -C...Reset width information. - DO 110 I=0,MDCY(KC,3) - WDTP(I)=0D0 - DO 100 J=0,5 - WDTE(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - -C...Allow for fudge factor to rescale resonance width. - FUDGE=1D0 - IF(MSTP(110).NE.0.AND.(MWID(KC).EQ.1.OR.MWID(KC).EQ.2.OR. - &(MWID(KC).EQ.3.AND.MINT(63).EQ.1))) THEN - IF(MSTP(110).EQ.KFLA) THEN - FUDGE=PARP(110) - ELSEIF(MSTP(110).EQ.-1) THEN - IF(KFLA.NE.6.AND.KFLA.NE.23.AND.KFLA.NE.24) FUDGE=PARP(110) - ELSEIF(MSTP(110).EQ.-2) THEN - FUDGE=PARP(110) - ENDIF - ENDIF - -C...Not to be treated as a resonance: return. - IF((MWID(KC).LE.0.OR.MWID(KC).GE.4).AND.KFLA.NE.21.AND. - &KFLA.NE.22) THEN - WDTP(0)=1D0 - WDTE(0,0)=1D0 - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - -C...Treatment as a resonance based on tabulated branching ratios. - ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN -C...Loop over possible decay channels; skip irrelevant ones. - DO 120 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 120 - -C...Read out decay products and nominal masses. - KFD1=KFDP(IDC,1) - KFC1=PYCOMP(KFD1) - IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1 - PM1=PMAS(KFC1,1) - KFD2=KFDP(IDC,2) - KFC2=PYCOMP(KFD2) - IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2 - PM2=PMAS(KFC2,1) - KFD3=KFDP(IDC,3) - PM3=0D0 - IF(KFD3.NE.0) THEN - KFC3=PYCOMP(KFD3) - IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3 - PM3=PMAS(KFC3,1) - ENDIF - -C...Naive partial width and alternative threshold factors. - WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR) - IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND. - & PM1+PM2+PM3.GE.SHR) THEN - WDTP(I)=0D0 - ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN - WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2- - & 4D0*PM1**2*PM2**2))/SH - ELSEIF(MDME(IDC,2).EQ.52) THEN - PMA=MAX(PM1,PM2,PM3) - PMC=MIN(PM1,PM2,PM3) - PMB=PM1+PM2+PM3-PMA-PMC - PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC) - PMAN=PMA**2/SH - PMBN=PMB**2/SH - PMCN=PMC**2/SH - PMBCN=PMBC**2/SH - WDTP(I)=WDTP(I)*SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((SHR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ - & ((1D0-PMBCN)*PMBCN*SH) - ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN - WDTP(I)=WDTP(I)*SQRT( - & MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/ - & MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)) - ELSEIF(MDME(IDC,2).EQ.53) THEN - PMA=MAX(PM1,PM2,PM3) - PMC=MIN(PM1,PM2,PM3) - PMB=PM1+PM2+PM3-PMA-PMC - PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC) - PMAN=PMA**2/SH - PMBN=PMB**2/SH - PMCN=PMC**2/SH - PMBCN=PMBC**2/SH - FACACT=SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((SHR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ - & ((1D0-PMBCN)*PMBCN*SH) - PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC) - PMAN=PMA**2/PMR**2 - PMBN=PMB**2/PMR**2 - PMCN=PMC**2/PMR**2 - PMBCN=PMBC**2/PMR**2 - FACNOM=SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((PMR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/ - & ((1D0-PMBCN)*PMBCN*PMR**2) - WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - -C...Calculate secondary width (at most two identical/opposite). - WID2=1D0 - IF(MDME(IDC,1).GT.0) THEN - IF(KFD2.EQ.KFD1) THEN - IF(KCHG(KFC1,3).EQ.0) THEN - WID2=WIDS(KFC1,1) - ELSEIF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,4) - ELSE - WID2=WIDS(KFC1,5) - ENDIF - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ELSEIF(KFD2.EQ.-KFD1) THEN - WID2=WIDS(KFC1,1) - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ELSEIF(KFD3.EQ.KFD1) THEN - IF(KCHG(KFC1,3).EQ.0) THEN - WID2=WIDS(KFC1,1) - ELSEIF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,4) - ELSE - WID2=WIDS(KFC1,5) - ENDIF - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSEIF(KFD2.LT.0) THEN - WID2=WID2*WIDS(KFC2,3) - ENDIF - ELSEIF(KFD3.EQ.-KFD1) THEN - WID2=WIDS(KFC1,1) - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSEIF(KFD2.LT.0) THEN - WID2=WID2*WIDS(KFC2,3) - ENDIF - ELSEIF(KFD3.EQ.KFD2) THEN - IF(KCHG(KFC2,3).EQ.0) THEN - WID2=WIDS(KFC2,1) - ELSEIF(KFD2.GT.0) THEN - WID2=WIDS(KFC2,4) - ELSE - WID2=WIDS(KFC2,5) - ENDIF - IF(KFD1.GT.0) THEN - WID2=WID2*WIDS(KFC1,2) - ELSEIF(KFD1.LT.0) THEN - WID2=WID2*WIDS(KFC1,3) - ENDIF - ELSEIF(KFD3.EQ.-KFD2) THEN - WID2=WIDS(KFC2,1) - IF(KFD1.GT.0) THEN - WID2=WID2*WIDS(KFC1,2) - ELSEIF(KFD1.LT.0) THEN - WID2=WID2*WIDS(KFC1,3) - ENDIF - ELSE - IF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,2) - ELSE - WID2=WIDS(KFC1,3) - ENDIF - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSE - WID2=WID2*WIDS(KFC2,3) - ENDIF - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ENDIF - -C...Store effective widths according to case. - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 120 CONTINUE -C...Return. - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - ENDIF - -C...Here begins detailed dynamical calculation of resonance widths. -C...Shared treatment of Higgs states. - KFHIGG=25 - IHIGG=1 - IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN - KFHIGG=KFLA - IHIGG=KFLA-33 - ENDIF - -C...Common electroweak and strong constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - AEM=PYALEM(SH) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - AS=PYALPS(SH) - RADC=1D0+AS/PARU(1) - - IF(KFLA.EQ.6) THEN -C...t quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - RADCT=1D0-2.5D0*AS/PARU(1) - DO 140 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 140 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...t -> W + q; including approximate QCD correction factor. - WDTP(I)=FAC*VCKM(3,I-3)*RADCT* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - IF(I.EQ.7) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(24,3) - IF(I.EQ.7) WID2=WID2*WIDS(7,3) - ENDIF - ELSEIF(I.EQ.9) THEN -C...t -> H + b. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - WID2=WIDS(37,2) - IF(KFLR.LT.0) WID2=WIDS(37,3) -CMRENNA++ - ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN -C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4. - BETA=ATAN(RMSS(5)) - SINB=SIN(BETA) - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - ET=KCHG(6,1)/3D0 - T3L=SIGN(0.5D0,ET) - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - PMNCHI=PMAS(KFC1,1) - PMSTOP=PMAS(KFC2,1) - IF(SHR.GT.PMNCHI+PMSTOP) THEN - IZ=I-9 - DO 130 IK=1,4 - ZMIXC(IZ,IK)=DCMPLX(ZMIX(IZ,IK),ZMIXI(IZ,IK)) - 130 CONTINUE - AL=SHR*DCONJG(ZMIXC(IZ,4))/(2.0D0*PMAS(24,1)*SINB) - AR=-ET*ZMIXC(IZ,1)*TANW - BL=T3L*(ZMIXC(IZ,2)-ZMIXC(IZ,1)*TANW)-AR - BR=AL - FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR - FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR - PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* - & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) - WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM* - & ((ABS(FL)**2+ABS(FR)**2)*(SH+PMNCHI**2-PMSTOP**2)+ - & SMZ(IZ)*4D0*SHR*DBLE(FL*DCONJG(FR)))/SH - IF(KFLR.GT.0) THEN - WID2=WIDS(KFC1,2)*WIDS(KFC2,2) - ELSE - WID2=WIDS(KFC1,2)*WIDS(KFC2,3) - ENDIF - ENDIF - ELSEIF(I.EQ.14.AND.IMSS(1).NE.0) THEN -C...t -> ~g + ~t - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - PMNCHI=PMAS(KFC1,1) - PMSTOP=PMAS(KFC2,1) - IF(SHR.GT.PMNCHI+PMSTOP) THEN - RL=SFMIX(6,1) - RR=-SFMIX(6,2) - PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* - & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) - WDTP(I)=4D0/3D0*0.5D0*PYALPS(SH)*PCM*((RL**2+RR**2)* - & (SH+PMNCHI**2-PMSTOP**2)+PMNCHI*4D0*SHR*RL*RR)/SH - IF(KFLR.GT.0) THEN - WID2=WIDS(KFC1,2)*WIDS(KFC2,2) - ELSE - WID2=WIDS(KFC1,2)*WIDS(KFC2,3) - ENDIF - ENDIF - ELSEIF(I.EQ.15.AND.IMSS(1).NE.0) THEN -C...t -> ~gravitino + ~t - XMP2=RMSS(29)**2 - KFC1=PYCOMP(KFDP(IDC,1)) - XMGR2=PMAS(KFC1,1)**2 - WDTP(I)=SH**2*SHR/(96D0*PARU(1)*XMP2*XMGR2)*(1D0-RM2)**4 - KFC2=PYCOMP(KFDP(IDC,2)) - WID2=WIDS(KFC2,2) - IF(KFLR.LT.0) WID2=WIDS(KFC2,3) -CMRENNA-- - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 140 CONTINUE - - ELSEIF(KFLA.EQ.7) THEN -C...b' quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 150 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 150 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...b' -> W + q. - WDTP(I)=FAC*VCKM(I-3,4)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,3) - IF(I.EQ.6) WID2=WID2*WIDS(6,2) - IF(I.EQ.7) WID2=WID2*WIDS(8,2) - ELSE - WID2=WIDS(24,2) - IF(I.EQ.6) WID2=WID2*WIDS(6,3) - IF(I.EQ.7) WID2=WID2*WIDS(8,3) - ENDIF - WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ELSEIF(I.EQ.9.OR.I.EQ.10) THEN -C...b' -> H + q. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,3) - IF(I.EQ.10) WID2=WID2*WIDS(6,2) - ELSE - WID2=WIDS(37,2) - IF(I.EQ.10) WID2=WID2*WIDS(6,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 150 CONTINUE - - ELSEIF(KFLA.EQ.8) THEN -C...t' quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 160 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 160 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...t' -> W + q. - WDTP(I)=FAC*VCKM(4,I-3)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - IF(I.EQ.7) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(24,3) - IF(I.EQ.7) WID2=WID2*WIDS(7,3) - ENDIF - ELSEIF(I.EQ.9.OR.I.EQ.10) THEN -C...t' -> H + q. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,2) - IF(I.EQ.10) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(37,3) - IF(I.EQ.10) WID2=WID2*WIDS(7,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 160 CONTINUE - - ELSEIF(KFLA.EQ.17) THEN -C...tau' lepton. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 170 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 170 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170 - WID2=1D0 - IF(I.EQ.3) THEN -C...tau' -> W + nu'_tau. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,3) - WID2=WID2*WIDS(18,2) - ELSE - WID2=WIDS(24,2) - WID2=WID2*WIDS(18,3) - ENDIF - ELSEIF(I.EQ.5) THEN -C...tau' -> H + nu'_tau. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,3) - WID2=WID2*WIDS(18,2) - ELSE - WID2=WIDS(37,2) - WID2=WID2*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 170 CONTINUE - - ELSEIF(KFLA.EQ.18) THEN -C...nu'_tau neutrino. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 180 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 180 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180 - WID2=1D0 - IF(I.EQ.2) THEN -C...nu'_tau -> W + tau'. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - WID2=WID2*WIDS(17,2) - ELSE - WID2=WIDS(24,3) - WID2=WID2*WIDS(17,3) - ENDIF - ELSEIF(I.EQ.3) THEN -C...nu'_tau -> H + tau'. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,2) - WID2=WID2*WIDS(17,2) - ELSE - WID2=WIDS(37,3) - WID2=WID2*WIDS(17,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 180 CONTINUE - - ELSEIF(KFLA.EQ.21) THEN -C...QCD: -C***Note that widths are not given in dimensional quantities here. - DO 190 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 190 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190 - WID2=1D0 - IF(I.LE.8) THEN -C...QCD -> q + qbar - WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 190 CONTINUE - - ELSEIF(KFLA.EQ.22) THEN -C...QED photon. -C***Note that widths are not given in dimensional quantities here. - DO 200 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 200 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200 - WID2=1D0 - IF(I.LE.8) THEN -C...QED -> q + qbar. - EF=KCHG(I,1)/3D0 - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.12) THEN -C...QED -> l+ + l-. - EF=KCHG(9+2*(I-8),1)/3D0 - WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.12) WID2=WIDS(17,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 200 CONTINUE - - ELSEIF(KFLA.EQ.23) THEN -C...Z0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - 210 CONTINUE - IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN - VINT(111)=0D0 - VINT(112)=0D0 - VINT(114)=0D0 - ENDIF - IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - KFI=IABS(MINT(15)) - IF(KFI.GT.20) KFI=IABS(MINT(16)) - EI=KCHG(KFI,1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - SQMZ=PMAS(23,1)**2 - HZ=SHR*WDTP(0) - IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0 - IF(MSTP(43).EQ.3) VINT(112)= - & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) - IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= - & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) - ENDIF - DO 220 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 220 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220 - WID2=1D0 - IF(I.LE.8) THEN -C...Z0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & BE34 - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* - & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+ - & (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 - FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - IF(ICASE.EQ.1) WDTP(I)=FUDGE*WDTP(I) - IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. - & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)= - & VINT(111)+FGGF*WID2 - IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2 - IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= - & VINT(114)+FZZF*WID2 - ENDIF - ENDIF - 220 CONTINUE - IF(MINT(61).GE.1) ICASE=3-ICASE - IF(ICASE.EQ.2) GOTO 210 - - ELSEIF(KFLA.EQ.24) THEN -C...W+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 230 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 230 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 230 - WID2=1D0 - IF(I.LE.16) THEN -C...W+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W+/- -> l+/- + nu - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 230 CONTINUE - - ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN -C...h0 (or H0, or A0): - SHFS=SH - FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR - DO 270 I=1,MDCY(KFHIGG,3) - IDC=I+MDCY(KFHIGG,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 270 - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - RM1=PMAS(KFC1,1)**2/SH - RM2=PMAS(KFC2,1)**2/SH - IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0) - & GOTO 270 - WID2=1D0 - - IF(I.LE.8) THEN -C...h0 -> q + qbar - WDTP(I)=FAC*3D0*(PYMRUN(KFDP(IDC,1),SH)**2/SHFS)* - & SQRT(MAX(0D0,1D0-4D0*RM1))*RADC -C...A0 behaves like beta, ho and H0 like beta**3. - IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2 - IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2 - IF(IMSS(1).NE.0.AND.KFC1.EQ.5) THEN - WDTP(I)=WDTP(I)/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - WDTP(I)=WDTP(I)*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.12) THEN -C...h0 -> l+ + l- - WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))*(SH/SHFS) -C...A0 behaves like beta, ho and H0 like beta**3. - IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* - & PARU(153+10*IHIGG)**2 - IF(I.EQ.12) WID2=WIDS(17,1) - - ELSEIF(I.EQ.13) THEN -C...h0 -> g + g; quark loop contribution only - ETARE=0D0 - ETAIM=0D0 - DO 240 J=1,2*MSTP(1) - EPS=(2D0*PMAS(J,1))**2/SH -C...Loop integral; function of eps=4m^2/shat; different for A0. - IF(EPS.LE.1D0) THEN - IF(EPS.GT.1D-4) THEN - ROOT=SQRT(1D0-EPS) - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - ENDIF - IF(IHIGG.LE.2) THEN - ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) - ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM - ELSE - ETAREJ=-0.5D0*EPS*PHIRE - ETAIMJ=-0.5D0*EPS*PHIIM - ENDIF -C...Couplings (=1 for standard model Higgs). - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IF(MOD(J,2).EQ.1) THEN - ETAREJ=ETAREJ*PARU(151+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(151+10*IHIGG) - ELSE - ETAREJ=ETAREJ*PARU(152+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(152+10*IHIGG) - ENDIF - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 240 CONTINUE - ETA2=ETARE**2+ETAIM**2 - WDTP(I)=FAC*(AS/PARU(1))**2*ETA2 - - ELSEIF(I.EQ.14) THEN -C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions - ETARE=0D0 - ETAIM=0D0 - JMAX=3*MSTP(1)+1 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 - DO 250 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - EJ=KCHG(J,1)/3D0 - EPS=(2D0*PMAS(J,1))**2/SH - ELSEIF(J.LE.3*MSTP(1)) THEN - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - EPS=(2D0*PMAS(10+JL,1))**2/SH - ELSEIF(J.EQ.3*MSTP(1)+1) THEN - EPS=(2D0*PMAS(24,1))**2/SH - ELSE - EPS=(2D0*PMAS(37,1))**2/SH - ENDIF -C...Loop integral; function of eps=4m^2/shat. - IF(EPS.LE.1D0) THEN - IF(EPS.GT.1D-4) THEN - ROOT=SQRT(1D0-EPS) - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - ENDIF - IF(J.LE.3*MSTP(1)) THEN -C...Fermion loops: loop integral different for A0; charges. - IF(IHIGG.LE.2) THEN - PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) - PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM - ELSE - PHIPRE=-0.5D0*EPS*PHIRE - PHIPIM=-0.5D0*EPS*PHIIM - ENDIF - IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN - EJC=3D0*EJ**2 - EJH=PARU(151+10*IHIGG) - ELSEIF(J.LE.2*MSTP(1)) THEN - EJC=3D0*EJ**2 - EJH=PARU(152+10*IHIGG) - ELSE - EJC=EJ**2 - EJH=PARU(153+10*IHIGG) - ENDIF - IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 - ETAREJ=EJC*EJH*PHIPRE - ETAIMJ=EJC*EJH*PHIPIM - ELSEIF(J.EQ.3*MSTP(1)+1) THEN -C...W loops: loop integral and charges. - ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE) - ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - ETAREJ=ETAREJ*PARU(155+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) - ENDIF - ELSE -C...Charged H loops: loop integral and charges. - FACHHH=(PMAS(24,1)/PMAS(37,1))**2* - & PARU(158+10*IHIGG+2*(IHIGG/3)) - ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH - ETAIMJ=-EPS**2*PHIIM*FACHHH - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 250 CONTINUE - ETA2=ETARE**2+ETAIM**2 - WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2 - - ELSEIF(I.EQ.15) THEN -C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions - ETARE=0D0 - ETAIM=0D0 - JMAX=3*MSTP(1)+1 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 - DO 260 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - EJ=KCHG(J,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - EPS=(2D0*PMAS(J,1))**2/SH - EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2 - ELSEIF(J.LE.3*MSTP(1)) THEN - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - EPS=(2D0*PMAS(10+JL,1))**2/SH - EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2 - ELSE - EPS=(2D0*PMAS(24,1))**2/SH - EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2 - ENDIF -C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2. - IF(EPS.LE.1D0) THEN - ROOT=SQRT(1D0-EPS) - IF(EPS.GT.1D-4) THEN - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - PSIRE=0.5D0*ROOT*RLN - PSIIM=-0.5D0*ROOT*PARU(1) - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS)) - PSIIM=0D0 - ENDIF - IF(EPSP.LE.1D0) THEN - ROOT=SQRT(1D0-EPSP) - IF(EPSP.GT.1D-4) THEN - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPSP-2D0) - ENDIF - PHIREP=-0.25D0*(RLN**2-PARU(1)**2) - PHIIMP=0.5D0*PARU(1)*RLN - PSIREP=0.5D0*ROOT*RLN - PSIIMP=-0.5D0*ROOT*PARU(1) - ELSE - PHIREP=(ASIN(1D0/SQRT(EPSP)))**2 - PHIIMP=0D0 - PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP)) - PSIIMP=0D0 - ENDIF - FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)* - & (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) - FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)* - & (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP)) - F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP) - F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP) - IF(J.LE.3*MSTP(1)) THEN -C...Fermion loops: loop integral different for A0; charges. - IF(IHIGG.EQ.3) FXYRE=0D0 - IF(IHIGG.EQ.3) FXYIM=0D0 - IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN - EJC=-3D0*EJ*VJ - EJH=PARU(151+10*IHIGG) - ELSEIF(J.LE.2*MSTP(1)) THEN - EJC=-3D0*EJ*VJ - EJH=PARU(152+10*IHIGG) - ELSE - EJC=-EJ*VJ - EJH=PARU(153+10*IHIGG) - ENDIF - IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 - ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE) - ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM) - ELSEIF(J.EQ.3*MSTP(1)+1) THEN -C...W loops: loop integral and charges. - HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS) - ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE) - ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - ETAREJ=ETAREJ*PARU(155+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) - ENDIF - ELSE -C...Charged H loops: loop integral and charges. - FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)* - & PARU(158+10*IHIGG+2*(IHIGG/3)) - ETAREJ=FACHHH*FXYRE - ETAIMJ=FACHHH*FXYIM - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 260 CONTINUE - ETA2=(ETARE**2+ETAIM**2)/(XW*XW1) - WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2 - WID2=WIDS(23,2) - - ELSEIF(I.LE.17) THEN -C...h0 -> Z0 + Z0, W+ + W- - PM1=PMAS(IABS(KFDP(IDC,1)),1) - PG1=PMAS(IABS(KFDP(IDC,1)),2) - IF(MINT(62).GE.1) THEN - IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND. - & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND. - & MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN - MOFSV(IHIGG,I-15)=0 - WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, - & 1D0-4D0*RM1)) - WID2=1D0 - ELSE - MOFSV(IHIGG,I-15)=1 - RMAS=SQRT(MAX(0D0,SH)) - CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW, - & WID2) - WIDWSV(IHIGG,I-15)=WIDW - WID2SV(IHIGG,I-15)=WID2 - ENDIF - ELSE - IF(MOFSV(IHIGG,I-15).EQ.0) THEN - WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, - & 1D0-4D0*RM1)) - WID2=1D0 - ELSE - WIDW=WIDWSV(IHIGG,I-15) - WID2=WID2SV(IHIGG,I-15) - ENDIF - ENDIF - WDTP(I)=FAC*WIDW/(2D0*(18-I)) - IF(MSTP(49).NE.0) WDTP(I)=WDTP(I)*PMAS(KFHIGG,1)**2/SHFS - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* - & PARU(138+I+10*IHIGG)**2 - WID2=WID2*WIDS(7+I,1) - - ELSEIF(I.EQ.18.AND.IHIGG.GE.2) THEN -C...H0 -> Z0 + h0, A0-> Z0 + h0 - WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(IHIGG.EQ.2) THEN - WDTP(I)=WDTP(I)*PARU(179)**2 - ELSEIF(IHIGG.EQ.3) THEN - WDTP(I)=WDTP(I)*PARU(186)**2 - ENDIF - WID2=WIDS(23,2)*WIDS(25,2) - - ELSEIF(I.EQ.19.AND.IHIGG.GE.2) THEN -C...H0 -> h0 + h0, A0-> h0 + h0 - WDTP(I)=FAC*0.25D0* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IHIGG.EQ.2) THEN - WDTP(I)=WDTP(I)*PARU(176)**2 - ELSEIF(IHIGG.EQ.3) THEN - WDTP(I)=WDTP(I)*PARU(169)**2 - ENDIF - WID2=WIDS(25,1) - ELSEIF((I.EQ.20.OR.I.EQ.21).AND.IHIGG.GE.2) THEN -C...H0 -> W+/- + H-/+, A0 -> W+/- + H-/+ - WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - & *PARU(195+IHIGG)**2 - IF(I.EQ.20) THEN - WID2=WIDS(24,2)*WIDS(37,3) - ELSEIF(I.EQ.21) THEN - WID2=WIDS(24,3)*WIDS(37,2) - ENDIF - - ELSEIF(I.EQ.22.AND.IHIGG.EQ.2) THEN -C...H0 -> Z0 + A0. - WDTP(I)=FAC*0.5D0*PARU(187)**2*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*0.0D0 - WID2=WIDS(36,2)*WIDS(23,2) - - ELSEIF(I.EQ.23.AND.IHIGG.EQ.2) THEN -C...H0 -> h0 + A0. - WDTP(I)=FAC*0.5D0*PARU(180)**2* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - WID2=WIDS(25,2)*WIDS(36,2) - - ELSEIF(I.EQ.24.AND.IHIGG.EQ.2) THEN -C...H0 -> A0 + A0 - WDTP(I)=FAC*0.25D0*PARU(177)**2* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - WID2=WIDS(36,1) - -CMRENNA++ - ELSE -C...Add in SUSY decays (two-body) by rescaling by phase space factor. - RM10=RM1*SH/PMR**2 - RM20=RM2*SH/PMR**2 - WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) - WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) - IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN - WFAC=0D0 - ELSE - WFAC=WFAC/WFAC0 - ENDIF - WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) -CMRENNA-- - IF(KFC2.EQ.KFC1) THEN - WID2=WIDS(KFC1,1) - ELSE - KSGN1=2 - IF(KFDP(IDC,1).LT.0) KSGN1=3 - KSGN2=2 - IF(KFDP(IDC,2).LT.0) KSGN2=3 - WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 270 CONTINUE - - ELSEIF(KFLA.EQ.32) THEN -C...Z'0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - VINT(117)=0D0 - 280 CONTINUE - IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN - VINT(111)=0D0 - VINT(112)=0D0 - VINT(113)=0D0 - VINT(114)=0D0 - VINT(115)=0D0 - VINT(116)=0D0 - ENDIF - IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - KFAIC=1 - IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 - IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 - IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 - IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN - VPI=PARU(119+2*KFAIC) - API=PARU(120+2*KFAIC) - ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN - VPI=PARJ(178+2*KFAIC) - API=PARJ(179+2*KFAIC) - ELSE - VPI=PARJ(186+2*KFAIC) - API=PARJ(187+2*KFAIC) - ENDIF - SQMZ=PMAS(23,1)**2 - HZ=SHR*VINT(117) - SQMZP=PMAS(32,1)**2 - HZP=SHR*WDTP(0) - IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. - & MSTP(44).EQ.7) VINT(111)=1D0 - IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)= - & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) - IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)= - & 2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2) - IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) - IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)= - & 2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/ - & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2)) - IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2) - ENDIF - DO 290 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 290 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 290 - WID2=1D0 - IF(I.LE.16) THEN - IF(I.LE.8) THEN -C...Z'0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - IF(I.LE.2) THEN - VPF=PARU(123-2*MOD(I,2)) - APF=PARU(124-2*MOD(I,2)) - ELSEIF(I.LE.4) THEN - VPF=PARJ(182-2*MOD(I,2)) - APF=PARJ(183-2*MOD(I,2)) - ELSE - VPF=PARJ(190-2*MOD(I,2)) - APF=PARJ(191-2*MOD(I,2)) - ENDIF - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* - & PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z'0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - IF(I.LE.10) THEN - VPF=PARU(127-2*MOD(I,2)) - APF=PARU(128-2*MOD(I,2)) - ELSEIF(I.LE.12) THEN - VPF=PARJ(186-2*MOD(I,2)) - APF=PARJ(187-2*MOD(I,2)) - ELSE - VPF=PARJ(194-2*MOD(I,2)) - APF=PARJ(195-2*MOD(I,2)) - ENDIF - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+ - & APF**2*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* - & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* - & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)* - & VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)* - & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)* - & VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.2) THEN - FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 - FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34 - FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))* - & BE34 - FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))* - & BE34 - ENDIF - ELSEIF(I.EQ.17) THEN -C...Z'0 -> W+ + W- - WDTPZP=PARU(129)**2*XW1**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - IF(ICASE.EQ.1) THEN - WDTPZ=0D0 - WDTP(I)=FAC*WDTPZP - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=0D0 - FZZPF=0D0 - FZPZPF=WDTPZP - ENDIF - WID2=WIDS(24,1) - ELSEIF(I.EQ.18) THEN -C...Z'0 -> H+ + H- - CZC=2D0*(1D0-2D0*XW) - BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C - WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI* - & VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2* - & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)* - & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2* - & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0.25D0*BE34C - FGZF=0.25D0*PARU(142)*CZC*BE34C - FGZPF=0.25D0*PARU(143)*CZC*BE34C - FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C - FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C - FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C - ENDIF - WID2=WIDS(37,1) - ELSEIF(I.EQ.19) THEN -C...Z'0 -> Z0 + gamma. - ELSEIF(I.EQ.20) THEN -C...Z'0 -> Z0 + h0 - FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)* - & (3D0*RM1+0.25D0*FLAM**2)*FLAM - IF(ICASE.EQ.1) THEN - WDTPZ=0D0 - WDTP(I)=FAC*WDTPZP - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=0D0 - FZZPF=0D0 - FZPZPF=WDTPZP - ENDIF - WID2=WIDS(23,2)*WIDS(25,2) - ELSEIF(I.EQ.21.OR.I.EQ.22) THEN -C...Z' -> h0 + A0 or H0 + A0. - BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(I.EQ.21) THEN - CZAH=PARU(186) - CZPAH=PARU(188) - ELSE - CZAH=PARU(187) - CZPAH=PARU(189) - ENDIF - IF(ICASE.EQ.1) THEN - WDTPZ=CZAH**2*BE34C - WDTP(I)=FAC*CZPAH**2*BE34C - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH* - & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)* - & VINT(116))*BE34C - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=CZAH**2*BE34C - FZZPF=CZAH*CZPAH*BE34C - FZPZPF=CZPAH**2*BE34C - ENDIF - IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2) - IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2) - ENDIF - IF(ICASE.EQ.1) THEN - VINT(117)=VINT(117)+FAC*WDTPZ - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - ENDIF - IF(MDME(IDC,1).GT.0) THEN - IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. - & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. - & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2 - IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+ - & FGZF*WID2 - IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+ - & FGZPF*WID2 - IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2 - IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+ - & FZZPF*WID2 - IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2 - ENDIF - ENDIF - 290 CONTINUE - IF(MINT(61).GE.1) ICASE=3-ICASE - IF(ICASE.EQ.2) GOTO 280 - - ELSEIF(KFLA.EQ.34) THEN -C...W'+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 300 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 300 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300 - WID2=1D0 - IF(I.LE.20) THEN - IF(I.LE.16) THEN -C...W'+/- -> q + qbar' - FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)* - & VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W'+/- -> l+/- + nu - FCOF=PARU(133)**2+PARU(134)**2 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ELSEIF(I.EQ.21) THEN -C...W'+/- -> W+/- + Z0 - WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2) - ELSEIF(I.EQ.23) THEN -C...W'+/- -> W+/- + h0 - FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 300 CONTINUE - - ELSEIF(KFLA.EQ.37) THEN -C...H+/-: -C IF(MSTP(49).EQ.0) THEN - SHFS=SH -C ELSE -C SHFS=PMAS(37,1)**2 -C ENDIF - FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR - DO 310 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 310 - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - RM1=PMAS(KFC1,1)**2/SH - RM2=PMAS(KFC2,1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310 - WID2=1D0 - IF(I.LE.4) THEN -C...H+/- -> q + qbar' - RM1R=PYMRUN(KFDP(IDC,1),SH)**2/SH - RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH - WDTP(I)=FAC*3D0*RADC*MAX(0D0,(RM1R*PARU(141)**2+ - & RM2R/PARU(141)**2)*(1D0-RM1R-RM2R)-4D0*RM1R*RM2R)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) - IF(KFLR.GT.0) THEN - IF(I.EQ.3) WID2=WIDS(6,2) - IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2) - ELSE - IF(I.EQ.3) WID2=WIDS(6,3) - IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3) - ENDIF - ELSEIF(I.LE.8) THEN -C...H+/- -> l+/- + nu - WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)* - & (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) - IF(KFLR.GT.0) THEN - IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ELSEIF(I.EQ.9) THEN -C...H+/- -> W+/- + h0. - WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) - -CMRENNA++ - ELSE -C...Add in SUSY decays (two-body) by rescaling by phase space factor. - RM10=RM1*SH/PMR**2 - RM20=RM2*SH/PMR**2 - WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) - WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) - IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN - WFAC=0D0 - ELSE - WFAC=WFAC/WFAC0 - ENDIF - WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) -CMRENNA-- - KSGN1=2 - IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3 - KSGN2=2 - IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3 - WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 310 CONTINUE - - ELSEIF(KFLA.EQ.41) THEN -C...R: - FAC=(AEM/(12D0*XW))*SHR - DO 320 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 320 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320 - WID2=1D0 - IF(I.LE.6) THEN -C...R -> q + qbar' - FCOF=3D0*RADC - ELSEIF(I.LE.9) THEN -C...R -> l+ + l'- - FCOF=1D0 - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - IF(KFLR.GT.0) THEN - IF(I.EQ.4) WID2=WIDS(6,3) - IF(I.EQ.5) WID2=WIDS(7,3) - IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3) - IF(I.EQ.9) WID2=WIDS(17,3) - ELSE - IF(I.EQ.4) WID2=WIDS(6,2) - IF(I.EQ.5) WID2=WIDS(7,2) - IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2) - IF(I.EQ.9) WID2=WIDS(17,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 320 CONTINUE - - ELSEIF(KFLA.EQ.42) THEN -C...LQ (leptoquark). - FAC=(AEM/4D0)*PARU(151)*SHR - DO 330 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 330 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330 - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=1D0 - ILQQ=KFDP(IDC,1)*ISIGN(1,KFLR) - IF(ILQQ.GE.6) WID2=WIDS(ILQQ,2) - IF(ILQQ.LE.-6) WID2=WIDS(-ILQQ,3) - ILQL=KFDP(IDC,2)*ISIGN(1,KFLR) - IF(ILQL.GE.17) WID2=WID2*WIDS(ILQL,2) - IF(ILQL.LE.-17) WID2=WID2*WIDS(-ILQL,3) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 330 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+111.OR.KFLA.EQ.KTECHN+221) THEN -C...Techni-pi0 and techni-pi0': - FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR - DO 340 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 340 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - RM1=PM1**2/SH - RM2=PM2**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340 - WID2=1D0 -C...pi_tc -> g + g - IF(I.EQ.8) THEN - FACP=(AS/(4D0*PARU(1))*ITCM(1)/RTCM(1))**2 - & /(8D0*PARU(1))*SH*SHR - IF(KFLA.EQ.KTECHN+111) THEN - FACP=FACP*RTCM(9) - ELSE - FACP=FACP*RTCM(10) - ENDIF - WDTP(I)=FACP - ELSE -C...pi_tc -> f + fbar. - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PM1 - HM2=PM2 - IF(IKA.GE.4.AND.IKA.LE.6) THEN - FCOF=FCOF*RTCM(1+IKA)**2 - HM1=PYMRUN(KFDP(IDC,1),SH) - HM2=PYMRUN(KFDP(IDC,2),SH) - ELSEIF(IKA.EQ.15) THEN - FCOF=FCOF*RTCM(8)**2 - ENDIF - WDTP(I)=FAC*FCOF*(HM1+HM2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 340 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+211) THEN -C...pi+_tc - FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR - DO 350 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 350 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - PM3=0D0 - IF(I.EQ.5) PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) - RM1=PM1**2/SH - RM2=PM2**2/SH - RM3=PM3**2/SH - IF(SQRT(RM1)+SQRT(RM2)+SQRT(RM3).GT.1D0) GOTO 350 - WID2=1D0 -C...pi_tc -> f + f'. - FCOF=1D0 - IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC -C...pi_tc+ -> W b b~ - IF(I.EQ.5.AND.SHR.LT.PMAS(6,1)+PMAS(5,1)) THEN - FCOF=3D0*RADC - XMT2=PMAS(6,1)**2/SH - FACP=FAC/(4D0*PARU(1))*FCOF*XMT2*RTCM(7)**2 - KFC3=PYCOMP(KFDP(IDC,3)) - CHECK = SQRT(RM1)+SQRT(RM2)+SQRT(RM3) - CHECK = SQRT(RM1) - T0 = (1D0-CHECK**2)* - & (XMT2*(6D0*XMT2**2+3D0*XMT2*RM1-4D0*RM1**2)- - & (5D0*XMT2**2+2D0*XMT2*RM1-8D0*RM1**2))/(4D0*XMT2**2) - T1 = (1D0-XMT2)*(RM1-XMT2)*((XMT2**2+XMT2*RM1+4D0*RM1**2) - & -3D0*XMT2**2*(XMT2+RM1))/(2D0*XMT2**3) - T3 = RM1**2/XMT2**3*(3D0*XMT2-4D0*RM1+4D0*XMT2*RM1) - WDTP(I)=FACP*(T0 + T1*LOG((XMT2-CHECK**2)/(XMT2-1D0)) - & +T3*LOG(CHECK)) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - ELSE - WID2=WIDS(24,3) - ENDIF - ELSE - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PM1 - HM2=PM2 - IF(I.GE.1.AND.I.LE.5) THEN - IF(I.LE.2) THEN - FCOF=FCOF*RTCM(5)**2 - ELSEIF(I.LE.4) THEN - FCOF=FCOF*RTCM(6)**2 - ELSEIF(I.EQ.5) THEN - FCOF=FCOF*RTCM(7)**2 - ENDIF - HM1=PYMRUN(KFDP(IDC,1),SH) - HM2=PYMRUN(KFDP(IDC,2),SH) - ELSEIF(I.EQ.8) THEN - FCOF=FCOF*RTCM(8)**2 - ENDIF - WDTP(I)=FAC*FCOF*(HM1+HM2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 350 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+331) THEN -C...Techni-eta. - FAC=(SH/PARP(46)**2)*SHR - DO 360 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 360 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360 - WID2=1D0 - IF(I.LE.2) THEN - WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1)) - IF(I.EQ.2) WID2=WIDS(6,1) - ELSE - WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 360 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+113) THEN -C...Techni-rho0: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SHP=SH - CALL PYWIDX(23,SHP,WDTPP,WDTEP) - GMMZ=SHR*WDTPP(0) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 370 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 370 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370 - WID2=1D0 - IF(I.EQ.1) THEN -C...rho_tc0 -> W+ + W-. - WDTP(I)=FAC*RTCM(3)**4* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,1) - ELSEIF(I.EQ.2) THEN -C...rho_tc0 -> W+ + pi_tc-. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) - ELSEIF(I.EQ.3) THEN -C...rho_tc0 -> pi_tc+ + W-. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(24,3) - ELSEIF(I.EQ.4) THEN -C...rho_tc0 -> pi_tc+ + pi_tc-. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(PYCOMP(KTECHN+211),1) - ELSEIF(I.EQ.5) THEN -C...rho_tc0 -> gamma + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3 - WID2=WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.6) THEN -C...rho_tc0 -> gamma + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.7) THEN -C...rho_tc0 -> Z0 + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.8) THEN -C...rho_tc0 -> Z0 + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSE -C...rho_tc0 -> f + fbar. - WID2=1D0 - IF(I.LE.16) THEN - IA=I-8 - FCOF=3D0*RADC - IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) - ELSE - IA=I-6 - FCOF=1D0 - IF(IA.GE.17) WID2=WIDS(IA,1) - ENDIF - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* - & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( - & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 370 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+213) THEN -C...Techni-rho+/-: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SHP=SH - CALL PYWIDX(24,SHP,WDTPP,WDTEP) - GMMW=SHR*WDTPP(0) - FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR* - & (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) - DO 380 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 380 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380 - WID2=1D0 - IF(I.EQ.1) THEN -C...rho_tc+ -> W+ + Z0. - WDTP(I)=FAC*RTCM(3)**4* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(23,2) - ELSE - WID2=WIDS(24,3)*WIDS(23,2) - ENDIF - ELSEIF(I.EQ.2) THEN -C...rho_tc+ -> W+ + pi_tc0. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSE - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+111),2) - ENDIF - ELSEIF(I.EQ.3) THEN -C...rho_tc+ -> pi_tc+ + Z0. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMZ/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/XW1/24D0/RTCM(13)**2*SHR**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3*XW/XW1 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(23,2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(23,2) - ENDIF - ELSEIF(I.EQ.4) THEN -C...rho_tc+ -> pi_tc+ + pi_tc0. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(PYCOMP(KTECHN+111),2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(PYCOMP(KTECHN+111),2) - ENDIF - ELSEIF(I.EQ.5) THEN -C...rho_tc+ -> pi_tc+ + gamma - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3) - ENDIF - ELSEIF(I.EQ.6) THEN -C...rho_tc+ -> W+ + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSE - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+221),2) - ENDIF - ELSE -C...rho_tc+ -> f + fbar'. - IA=I-6 - WID2=1D0 - IF(IA.LE.16) THEN - FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2) - IF(IA.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3) - IF(IA.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSE - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 380 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+223) THEN -C...Techni-omega: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR*(2D0*RTCM(2)-1D0)**2 - SQMZ=PMAS(23,1)**2 - SHP=SH - CALL PYWIDX(23,SHP,WDTPP,WDTEP) - GMMZ=SHR*WDTPP(0) - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=-(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 390 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 390 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390 - WID2=1D0 - IF(I.EQ.1) THEN -C...omega_tc0 -> gamma + pi_tc0. - WDTP(I)=AEM/24D0/RTCM(12)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.2) THEN -C...omega_tc0 -> Z0 + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.3) THEN -C...omega_tc0 -> gamma + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* - & SHR**3 - WID2=WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.4) THEN -C...omega_tc0 -> Z0 + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.5) THEN -C...omega_tc0 -> W+ + pi_tc- - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ - & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) - ELSEIF(I.EQ.6) THEN -C...omega_tc0 -> pi_tc+ + W- - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ - & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2) - ELSEIF(I.EQ.7) THEN -C...omega_tc0 -> W+ + W-. - WDTP(I)=FAC*RTCM(3)**4*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,1) - ELSEIF(I.EQ.8) THEN -C...omega_tc0 -> pi_tc+ + pi_tc-. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(PYCOMP(KTECHN+211),1) - ELSE -C...omega_tc0 -> f + fbar. - WID2=1D0 - IF(I.LE.14) THEN - IA=I-8 - FCOF=3D0*RADC - IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) - ELSE - IA=I-6 - FCOF=1D0 - IF(IA.GE.17) WID2=WIDS(IA,1) - ENDIF - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=-0.5D0*(VI+AI) - VARI=-0.5D0*(VI-AI) - WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* - & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( - & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 390 CONTINUE - -C.....V8 -> quark anti-quark - ELSEIF(KFLA.EQ.KTECHN+100021) THEN - FAC=AS/6D0*SHR - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSEIF(ITCM(2).EQ.1) THEN - IMDL=2 - ENDIF - DO 400 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 400 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - RM1=PM1**2/SH - IF(RM1.GT.0.25D0) GOTO 400 - WID2=1D0 - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3**2 - ELSE - FMIX=TANT3**2 - ENDIF - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX - IF(I.EQ.6) WID2=WIDS(6,1) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 400 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+100111.OR.KFLA.EQ.KTECHN+200111) THEN - FAC=(1D0/(4D0*PARU(1)*RTCM(1)**2))*SHR - CLEBF=0D0 - DO 410 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 410 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410 - WID2=1D0 -C...pi_tc -> g + g - IF(I.EQ.7) THEN - IF(KFLA.EQ.KTECHN+100111) THEN - CLEBG=4D0/3D0 - ELSE - CLEBG=5D0/3D0 - ENDIF - FACP=(AS/(8D0*PARU(1))*ITCM(1)/RTCM(1))**2 - & /(2D0*PARU(1))*SH*SHR*CLEBG - WDTP(I)=FACP - ELSE -C...pi_tc -> f + fbar. - IF(I.EQ.6) WID2=WIDS(6,1) - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PYMRUN(KFDP(IDC,1),SH) - WDTP(I)=FAC*FCOF*HM1**2*CLEBF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 410 CONTINUE - - ELSEIF(KFLA.GE.KTECHN+100113.AND.KFLA.LE.KTECHN+400113) THEN - FAC=AS/6D0*SHR - ALPRHT=2.91D0*(3D0/ITCM(1)) - TANT3=RTCM(21) - SIN2T=2D0*TANT3/(TANT3**2+1D0) - SINT3=TANT3/SQRT(TANT3**2+1D0) - CSXPP=RTCM(22) - RM82=RTCM(27)**2 - X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0) - X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0) - X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- - & SINT3**2)*2D0 - X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- - & SINT3**2)*2D0 - CALL PYWIDX(KTECHN+100021,SH,WDTPP,WDTEP) - - IF(WDTPP(0).GT.RTCM(33)*SHR) WDTPP(0)=RTCM(33)*SHR - GMV8=SHR*WDTPP(0) - RMV8=PMAS(PYCOMP(KTECHN+100021),1) - FV8RE=SH*(SH-RMV8**2)/((SH-RMV8**2)**2+GMV8**2) - FV8IM=SH*GMV8/((SH-RMV8**2)**2+GMV8**2) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSE - IMDL=2 - ENDIF - DO 420 I=1,MDCY(KC,3) - IF(I.EQ.7.AND.(KFLA.EQ.KTECHN+200113.OR. - & KFLA.EQ.KTECHN+300113)) GOTO 420 - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 420 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 420 - WID2=1D0 - IF(I.LE.6) THEN - IF(I.EQ.6) WID2=WIDS(6,1) - XIG=1D0 - IF(KFLA.EQ.KTECHN+200113) THEN - XIG=0D0 - XIJ=X12 - ELSEIF(KFLA.EQ.KTECHN+300113) THEN - XIG=0D0 - XIJ=X21 - ELSEIF(KFLA.EQ.KTECHN+100113) THEN - XIJ=X11 - ELSE - XIJ=X22 - ENDIF - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3/SIN2T - ELSE - FMIX=-TANT3/SIN2T - ENDIF - XFAC=(XIG+FMIX*XIJ*FV8RE)**2+(FMIX*XIJ*FV8IM)**2 - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*AS/ALPRHT*XFAC - ELSEIF(I.EQ.7) THEN - WDTP(I)=SHR*AS**2/(4D0*ALPRHT) - ELSEIF(KFLA.EQ.KTECHN+400113.AND.I.LE.9) THEN - PSH=SHR*(1D0-RM1)/2D0 - WDTP(I)=AS/9D0*PSH**3/RM82 - IF(I.EQ.8) THEN - WDTP(I)=2D0*WDTP(I)*CSXPP**2 - WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) - ELSE - WDTP(I)=5D0*WDTP(I) - WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 420 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+1) THEN -C...d* excited quark. - FAC=(SH/RTCM(41)**2)*SHR - DO 430 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 430 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 430 - WID2=1D0 - IF(I.EQ.1) THEN -C...d* -> g + d. - WDTP(I)=FAC*AS*RTCM(45)**2/3D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...d* -> gamma + d. - QF=-RTCM(43)/2D0+RTCM(44)/6D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.3) THEN -C...d* -> Z0 + d. - QF=-RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.4) THEN -C...d* -> W- + u. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 430 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+2) THEN -C...u* excited quark. - FAC=(SH/RTCM(41)**2)*SHR - DO 440 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 440 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 440 - WID2=1D0 - IF(I.EQ.1) THEN -C...u* -> g + u. - WDTP(I)=FAC*AS*RTCM(45)**2/3D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...u* -> gamma + u. - QF=RTCM(43)/2D0+RTCM(44)/6D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.3) THEN -C...u* -> Z0 + u. - QF=RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.4) THEN -C...u* -> W+ + d. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,2) - IF(KFLR.LT.0) WID2=WIDS(24,3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 440 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+11) THEN -C...e* excited lepton. - FAC=(SH/RTCM(41)**2)*SHR - DO 450 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 450 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 450 - WID2=1D0 - IF(I.EQ.1) THEN -C...e* -> gamma + e. - QF=-RTCM(43)/2D0-RTCM(44)/2D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...e* -> Z0 + e. - QF=-RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.3) THEN -C...e* -> W- + nu. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 450 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+12) THEN -C...nu*_e excited neutrino. - FAC=(SH/RTCM(41)**2)*SHR - DO 460 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 460 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 460 - WID2=1D0 - IF(I.EQ.1) THEN -C...nu*_e -> Z0 + nu*_e. - QF=RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.2) THEN -C...nu*_e -> W+ + e. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,2) - IF(KFLR.LT.0) WID2=WIDS(24,3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 460 CONTINUE - - ELSEIF(KFLA.EQ.KDIMEN+39) THEN -C...G* (graviton resonance): - FAC=(PARP(50)**2/PARU(1))*SHR - DO 470 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 470 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 470 - WID2=1D0 - IF(I.LE.8) THEN -C...G* -> q + qbar - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* - & PYHFTH(SH,SH*RM1,1D0) - WDTP(I)=FAC*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))**3* - & (1D0+8D0*RM1/3D0)/320D0 - IF(I.EQ.6) WID2=WIDS(6,1) - IF(I.EQ.7.OR.I.EQ.8) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...G* -> l+ + l-, nu + nubar - FCOF=1D0 - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))**3* - & (1D0+8D0*RM1/3D0)/320D0 - IF(I.EQ.15.OR.I.EQ.16) WID2=WIDS(2+I,1) - ELSEIF(I.EQ.17) THEN -C...G* -> g + g. - WDTP(I)=FAC/20D0 - ELSEIF(I.EQ.18) THEN -C...G* -> gamma + gamma. - WDTP(I)=FAC/160D0 - ELSEIF(I.EQ.19) THEN -C...G* -> Z0 + Z0. - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ - & 14D0*RM1/3D0+4D0*RM1**2)/160D0 - WID2=WIDS(23,1) - ELSEIF(I.EQ.20) THEN -C...G* -> W+ + W-. - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ - & 14D0*RM1/3D0+4D0*RM1**2)/80D0 - WID2=WIDS(24,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 470 CONTINUE - - ELSEIF(KFLA.EQ.9900012.OR.KFLA.EQ.9900014.OR.KFLA.EQ.9900016) THEN -C...nu_eR, nu_muR, nu_tauR: righthanded Majorana neutrinos. - PMWR=MAX(1.001D0*SHR,PMAS(PYCOMP(9900024),1)) - FAC=(AEM**2/(768D0*PARU(1)*XW**2))*SHR**5/PMWR**4 - DO 480 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 480 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) - IF(PM1+PM2+PM3.GE.SHR) GOTO 480 - WID2=1D0 - IF(I.LE.9) THEN -C...nu_lR -> l- qbar q' - FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) - IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) - ELSEIF(I.LE.18) THEN -C...nu_lR -> l+ q qbar' - FCOF=3D0*RADC*VCKM((I-10)/3+1,MOD(I-10,3)+1) - IF(MOD(I-9,3).EQ.0) WID2=WIDS(6,3) - ELSE -C...nu_lR -> l- l'+ nu_lR' + charge conjugate. - FCOF=1D0 - WID2=WIDS(PYCOMP(KFDP(IDC,3)),2) - ENDIF - X=(PM1+PM2+PM3)/SHR - FX=1D0-8D0*X**2+8D0*X**6-X**8-24D0*X**4*LOG(X) - Y=(SHR/PMWR)**2 - FY=(12D0*(1D0-Y)*LOG(1D0-Y)+12D0*Y-6D0*Y**2-2D0*Y**3)/Y**4 - WDTP(I)=FAC*FCOF*FX*FY - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 480 CONTINUE - - ELSEIF(KFLA.EQ.9900023) THEN -C...Z_R0: - FAC=(AEM/(48D0*XW*XW1*(1D0-2D0*XW)))*SHR - DO 490 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 490 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 490 - WID2=1D0 - SYMMET=1D0 - IF(I.LE.6) THEN -C...Z_R0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0)*(1D0-2D0*XW) - VF=SIGN(1D0,EF+0.1D0)-4D0*EF*XW - FCOF=3D0*RADC - IF(I.EQ.6) WID2=WIDS(6,1) - ELSEIF(I.EQ.7.OR.I.EQ.10.OR.I.EQ.13) THEN -C...Z_R0 -> l+ + l- - AF=-(1D0-2D0*XW) - VF=-1D0+4D0*XW - FCOF=1D0 - ELSEIF(I.EQ.8.OR.I.EQ.11.OR.I.EQ.14) THEN -C...Z0 -> nu_L + nu_Lbar, assumed Majorana. - AF=-2D0*XW - VF=0D0 - FCOF=1D0 - SYMMET=0.5D0 - ELSEIF(I.LE.15) THEN -C...Z0 -> nu_R + nu_R, assumed Majorana. - AF=2D0*XW1 - VF=0D0 - FCOF=1D0 - WID2=WIDS(PYCOMP(KFDP(IDC,1)),1) - SYMMET=0.5D0 - ENDIF - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & SQRT(MAX(0D0,1D0-4D0*RM1))*SYMMET - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 490 CONTINUE - - ELSEIF(KFLA.EQ.9900024) THEN -C...W_R+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 500 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 500 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 500 - WID2=1D0 - IF(I.LE.9) THEN -C...W_R+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) - ELSE - IF(MOD(I,3).EQ.0) WID2=WIDS(6,3) - ENDIF - ELSEIF(I.LE.12) THEN -C...W_R+/- -> l+/- + nu_R - FCOF=1D0 - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 500 CONTINUE - - ELSEIF(KFLA.EQ.9900041) THEN -C...H_L++/--: - FAC=(1D0/(8D0*PARU(1)))*SHR - DO 510 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 510 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 510 - WID2=1D0 - IF(I.LE.6) THEN -C...H_L++/-- -> l+/- + l'+/- - FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ - & (IABS(KFDP(IDC,2))-9)/2)**2 - IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF - ELSEIF(I.EQ.7) THEN -C...H_L++/-- -> W_L+/- + W_L+/- - FCOF=0.5D0*PARP(190)**4*PARP(192)**2/PMAS(24,1)**2* - & (3D0*RM1+0.25D0/RM1-1D0) - WID2=WIDS(24,4+(1-KFLS)/2) - ENDIF - WDTP(I)=FAC*FCOF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 510 CONTINUE - - ELSEIF(KFLA.EQ.9900042) THEN -C...H_R++/--: - FAC=(1D0/(8D0*PARU(1)))*SHR - DO 520 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 520 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 520 - WID2=1D0 - IF(I.LE.6) THEN -C...H_R++/-- -> l+/- + l'+/- - FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ - & (IABS(KFDP(IDC,2))-9)/2)**2 - IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF - ELSEIF(I.EQ.7) THEN -C...H_R++/-- -> W_R+/- + W_R+/- - FCOF=PARP(191)**2*(3D0*RM1+0.25D0/RM1-1D0) - WID2=WIDS(PYCOMP(9900024),4+(1-KFLS)/2) - ENDIF - WDTP(I)=FAC*FCOF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 520 CONTINUE - - ENDIF - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - END - -C*********************************************************************** - -C...PYWIDX -C...Calculates full and partial widths of resonances. -C....copy of PYWIDT, used for techniparticle widths - - SUBROUTINE PYWIDX(KFLR,SH,WDTP,WDTE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT4/,/PYMSSM/,/PYTCSM/ -C...Local arrays and saved variables. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), - &WID2SV(3,2) - SAVE MOFSV,WIDWSV,WID2SV - DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ - -C...Compressed code and sign; mass. - KFLA=IABS(KFLR) - KFLS=ISIGN(1,KFLR) - KC=PYCOMP(KFLA) - SHR=SQRT(SH) - PMR=PMAS(KC,1) - -C...Reset width information. - DO 110 I=0,200 - WDTP(I)=0D0 - DO 100 J=0,5 - WDTE(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - -C...Common electroweak and strong constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - AEM=PYALEM(SH) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - AS=PYALPS(SH) - RADC=1D0+AS/PARU(1) - - IF(KFLA.EQ.23) THEN -C...Z0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - 120 CONTINUE - DO 130 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 130 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 130 - WID2=1D0 - IF(I.LE.8) THEN -C...Z0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & BE34 - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 130 CONTINUE - - - ELSEIF(KFLA.EQ.24) THEN -C...W+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 140 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 140 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 - WID2=1D0 - IF(I.LE.16) THEN -C...W+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W+/- -> l+/- + nu - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 140 CONTINUE - -C.....V8 -> quark anti-quark - ELSEIF(KFLA.EQ.KTECHN+100021) THEN - FAC=AS/6D0*SHR - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSEIF(ITCM(2).EQ.1) THEN - IMDL=2 - ENDIF - DO 150 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 150 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - RM1=PM1**2/SH - IF(RM1.GT.0.25D0) GOTO 150 - WID2=1D0 - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3**2 - ELSE - FMIX=TANT3**2 - ENDIF - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX - IF(I.EQ.6) WID2=WIDS(6,1) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 150 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYX2XG -C...Calculates the decay rate for ino -> ino + gauge boson. - - FUNCTION PYX2XG(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYX2XG,XM1,XM2,XM3,GX2,GLR - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMV2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMV2) - PYX2XG=C1/8D0/XMI3*SQRT(XL) - &*(GX2*(XL+3D0*XMV2*(XMI2+XMJ2-XMV2))- - &12D0*GLR*XM1*XM2*XMV2) - - RETURN - END - -C********************************************************************* - -C...PYX2XH -C...Calculates the decay rate for ino -> ino + H. - - FUNCTION PYX2XH(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYX2XH,XM1,XM2,XM3 - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMV2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMV2) - PYX2XH=C1/8D0/XMI3*SQRT(XL) - &*(GX2*(XMI2+XMJ2-XMV2)+ - &4D0*GLR*XM1*XM2) - - RETURN - END - -C********************************************************************* - -C...PYX3JT -C...Selects the kinematical variables of three-jet events. - - SUBROUTINE PYX3JT(NJET,CUT,KFL,ECM,X1,X2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array. - DIMENSION ZHUP(5,12) - -C...Coefficients of Zhu second order parametrization. - DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ - &18.29D0, 89.56D0, 4.541D0, -52.09D0, -109.8D0, 24.90D0, - &11.63D0, 3.683D0, 17.50D0,0.002440D0, -1.362D0,-0.3537D0, - &11.42D0, 6.299D0, -22.55D0, -8.915D0, 59.25D0, -5.855D0, - &-32.85D0, -1.054D0, -16.90D0,0.006489D0,-0.8156D0,0.01095D0, - &7.847D0, -3.964D0, -35.83D0, 1.178D0, 29.39D0, 0.2806D0, - &47.82D0, -12.36D0, -56.72D0, 0.04054D0,-0.4365D0, 0.6062D0, - &5.441D0, -56.89D0, -50.27D0, 15.13D0, 114.3D0, -18.19D0, - &97.05D0, -1.890D0, -139.9D0, 0.08153D0,-0.4984D0, 0.9439D0, - &-17.65D0, 51.44D0, -58.32D0, 70.95D0, -255.7D0, -78.99D0, - &476.9D0, 29.65D0, -239.3D0, 0.4745D0, -1.174D0, 6.081D0/ - -C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). - DILOG(X)=X+X**2/4D0+X**3/9D0+X**4/16D0+X**5/25D0+X**6/36D0+ - &X**7/49D0 - -C...Event type. Mass effect factors and other common constants. - MSTJ(120)=2 - MSTJ(121)=0 - PMQ=PYMASS(KFL) - QME=(2D0*PMQ/ECM)**2 - IF(MSTJ(109).NE.1) THEN - CUTL=LOG(CUT) - CUTD=LOG(1D0/CUT-2D0) - IF(MSTJ(109).EQ.0) THEN - CF=4D0/3D0 - CN=3D0 - TR=2D0 - WTMX=MIN(20D0,37D0-6D0*CUTD) - IF(MSTJ(110).EQ.2) WTMX=2D0*(7.5D0+80D0*CUT) - ELSE - CF=1D0 - CN=0D0 - TR=12D0 - WTMX=0D0 - ENDIF - -C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. - ALS2PI=PARU(118)/PARU(2) - WTOPT=0D0 - IF(MSTJ(111).EQ.1) WTOPT=(33D0-2D0*MSTU(112))/6D0* - & LOG(PARJ(169))*ALS2PI - WTMAX=MAX(0D0,1D0+WTOPT+ALS2PI*WTMX) - -C...Choose three-jet events in allowed region. - 100 NJET=3 - 110 Y13L=CUTL+CUTD*PYR(0) - Y23L=CUTL+CUTD*PYR(0) - Y13=EXP(Y13L) - Y23=EXP(Y23L) - Y12=1D0-Y13-Y23 - IF(Y12.LE.CUT) GOTO 110 - IF(Y13**2+Y23**2+2D0*Y12.LE.2D0*PYR(0)) GOTO 110 - -C...Second order corrections. - IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN - Y12L=LOG(Y12) - Y13M=LOG(1D0-Y13) - Y23M=LOG(1D0-Y23) - Y12M=LOG(1D0-Y12) - IF(Y13.LE.0.5D0) Y13I=DILOG(Y13) - IF(Y13.GE.0.5D0) Y13I=1.644934D0-Y13L*Y13M-DILOG(1D0-Y13) - IF(Y23.LE.0.5D0) Y23I=DILOG(Y23) - IF(Y23.GE.0.5D0) Y23I=1.644934D0-Y23L*Y23M-DILOG(1D0-Y23) - IF(Y12.LE.0.5D0) Y12I=DILOG(Y12) - IF(Y12.GE.0.5D0) Y12I=1.644934D0-Y12L*Y12M-DILOG(1D0-Y12) - WT1=(Y13**2+Y23**2+2D0*Y12)/(Y13*Y23) - WT2=CF*(-2D0*(CUTL-Y12L)**2-3D0*CUTL-1D0+3.289868D0+ - & 2D0*(2D0*CUTL-Y12L)*CUT/Y12)+ - & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2- - & 11D0*CUTL/6D0+67D0/18D0+1.644934D0-(2D0*CUTL-Y12L)*CUT/Y12+ - & (2D0*CUTL-Y13L)*CUT/Y13+(2D0*CUTL-Y23L)*CUT/Y23)+ - & TR*(2D0*CUTL/3D0-10D0/9D0)+ - & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ - & Y13L*(4D0*Y12**2+2D0*Y12*Y13+4D0*Y12*Y23+Y13*Y23)/ - & (Y12+Y23)**2+Y23L*(4D0*Y12**2+2D0*Y12*Y23+4D0*Y12*Y13+ - & Y13*Y23)/(Y12+Y13)**2)/WT1+ - & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+(CN-2D0*CF)* - & ((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* - & Y23M+1.644934D0-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* - & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934D0-Y12I-Y13I)/ - & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- - & 2D0*Y12L*Y12**2/(Y13+Y23)**2-4D0*Y12L*Y12/(Y13+Y23))/WT1- - & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934D0-Y13I-Y23I) - IF(1D0+WTOPT+ALS2PI*WT2.LE.0D0) MSTJ(121)=1 - IF(1D0+WTOPT+ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 - PARJ(156)=(WTOPT+ALS2PI*WT2)/(1D0+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=1D0-Y12 - IZA=0 - DO 120 IY=1,5 - IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) 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)/(1D0-ZY)+ZHUP(IZ,12)/ZY - ELSE - IZ=100D0*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)/(1D0-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)/(1D0-ZY)+ZHUP(IZ,12)/ZY - WT2=WTL+(WTU-WTL)*(100D0*CUT+1D0-IZ) - ENDIF - IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.0D0) MSTJ(121)=1 - IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 - PARJ(156)=(WTOPT+2D0*ALS2PI*WT2)/(1D0+WTOPT+2D0*ALS2PI*WT2) - ENDIF - -C...Impose mass cuts (gives two jets). For fixed jet number new try. - X1=1D0-Y23 - X2=1D0-Y13 - X3=1D0-Y12 - IF(4D0*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.5D0*QME**2+(0.5D0*QME+0.25D0*QME**2)*((1D0-X2)/(1D0-X1)+ - & (1D0-X1)/(1D0-X2)).GT.(X1**2+X2**2)*PYR(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(4D0*CUT**2+PYR(0)*((1D0-CUT)**2-4D0*CUT**2)) - IF(LOG((X3-CUT)/CUT).LE.PYR(0)*LOG((1D0-2D0*CUT)/CUT)) GOTO 140 - YD=SIGN(2D0*CUT*((X3-CUT)/CUT)**PYR(0)-X3,PYR(0)-0.5D0) - X1=1D0-0.5D0*(X3+YD) - X2=1D0-0.5D0*(X3-YD) - IF(4D0*(1D0-X1)*(1D0-X2)*(1D0-X3)/X3**2.LE.QME) NJET=2 - IF(MSTJ(102).GE.2) THEN - IF(X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)*PARJ(171).LT. - & X3**2*PYR(0)) NJET=2 - ENDIF - IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYX4JT -C...Selects the kinematical variables of four-jet events. - - SUBROUTINE PYX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local arrays. - DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) - -C...Common constants. Colour factors for QCD and Abelian gluon theory. - PMQ=PYMASS(KFL) - QME=(2D0*PMQ/ECM)**2 - CT=LOG(1D0/CUT-5D0) - IF(MSTJ(109).EQ.0) THEN - CF=4D0/3D0 - CN=3D0 - TR=2.5D0 - ELSE - CF=1D0 - CN=0D0 - TR=15D0 - ENDIF - -C...Choice of process (qqbargg or qqbarqqbar). - 100 NJET=4 - IT=1 - IF(PARJ(155).GT.PYR(0)) IT=2 - IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 - IF(IT.EQ.1) WTMX=0.7D0/CUT**2 - IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6D0/CUT**2 - IF(IT.EQ.2) WTMX=0.1125D0*CF*TR/CUT**2 - ID=1 - -C...Sample the five kinematical variables (for qqgg preweighted in y34). - 110 Y134=3D0*CUT+(1D0-6D0*CUT)*PYR(0) - Y234=3D0*CUT+(1D0-6D0*CUT)*PYR(0) - IF(IT.EQ.1) Y34=(1D0-5D0*CUT)*EXP(-CT*PYR(0)) - IF(IT.EQ.2) Y34=CUT+(1D0-6D0*CUT)*PYR(0) - IF(Y34.LE.Y134+Y234-1D0.OR.Y34.GE.Y134*Y234) GOTO 110 - VT=PYR(0) - CP=COS(PARU(1)*PYR(0)) - Y14=(Y134-Y34)*VT - Y13=Y134-Y14-Y34 - VB=Y34*(1D0-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) - Y24=0.5D0*(Y234-Y34)*(1D0-4D0*SQRT(MAX(0D0,VT*(1D0-VT)* - &VB*(1D0-VB)))*CP-(1D0-2D0*VT)*(1D0-2D0*VB)) - Y23=Y234-Y34-Y24 - Y12=1D0-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=0D0 - 120 IC=IC+1 - IF(IT.EQ.1) THEN - WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3D0*Y12*Y23*Y34+ - & 3D0*Y12*Y14*Y34+4D0*Y12**2*Y34-Y13*Y23*Y24+2D0*Y12*Y23*Y24- - & Y13*Y14*Y24-2D0*Y12*Y13*Y24+2D0*Y12**2*Y24+Y14*Y23**2+2D0*Y12* - & Y23**2+Y14**2*Y23+4D0*Y12*Y14*Y23+4D0*Y12**2*Y23+2D0*Y12*Y14**2+ - & 2D0*Y12*Y13*Y14+4D0*Y12**2*Y14+2D0*Y12**2*Y13+2D0*Y12**3)/ - & (2D0*Y13*Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24- - & Y14*Y23+Y12*Y13)/(Y13*Y134**2)+2D0*Y23*(1D0-Y13)/ - & (Y13*Y134*Y24)+Y34/(2D0*Y13*Y24) - WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2D0*Y12* - & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1D0+Y34)*Y124/(Y134*Y234*Y14* - & Y24)-(2D0*Y13*Y24+Y14**2+Y13*Y23+2D0*Y12*Y13)/(Y13*Y134*Y14)+ - & Y12*Y123*Y124/(2D0*Y13*Y14*Y23*Y24) - WTC(IC)=-(5D0*Y12*Y34**2+2D0*Y12*Y24*Y34+2D0*Y12*Y23*Y34+ - & 2D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+4D0*Y12**2*Y34-Y13*Y24**2+ - & Y14*Y23*Y24+Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24- - & 3D0*Y12*Y13*Y24-Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23- - & 3D0*Y12*Y14*Y23-Y12*Y13*Y23)/(4D0*Y134*Y234*Y34**2)+ - & (3D0*Y12*Y34**2-3D0*Y13*Y24*Y34+3D0*Y12*Y24*Y34+ - & 3D0*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6D0*Y12*Y14*Y34+ - & 2D0*Y12*Y13*Y34-2D0*Y12**2*Y34+Y14*Y23*Y24-3D0*Y13*Y23*Y24- - & 2D0*Y13*Y14*Y24+4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+ - & 3D0*Y14*Y23**2+2D0*Y14**2*Y23+2D0*Y14**2*Y12+ - & 2D0*Y12**2*Y14+6D0*Y12*Y14*Y23-2D0*Y12*Y13**2- - & 2D0*Y12**2*Y13)/(4D0*Y13*Y134*Y234*Y34) - WTC(IC)=WTC(IC)+(2D0*Y12*Y34**2-2D0*Y13*Y24*Y34+Y12*Y24*Y34+ - & 4D0*Y13*Y23*Y34+4D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+2D0*Y12**2*Y34- - & Y13*Y24**2+3D0*Y14*Y23*Y24+4D0*Y13*Y23*Y24-2D0*Y13*Y14*Y24+ - & 4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+2D0*Y14*Y23**2+4D0*Y13*Y23**2+ - & 2D0*Y13*Y14*Y23+2D0*Y12*Y14*Y23+4D0*Y12*Y13*Y23+2D0*Y12*Y14**2+ - & 4D0*Y12**2*Y13+4D0*Y12*Y13*Y14+2D0*Y12**2*Y14)/ - & (4D0*Y13*Y134*Y24*Y34)-(Y12*Y34**2-2D0*Y14*Y24*Y34- - & 2D0*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*Y34+Y12*Y14*Y34+ - & 2D0*Y12*Y13*Y34-2D0*Y14**2*Y24-4D0*Y13*Y14*Y24- - & 4D0*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14- - & Y12*Y13**2)/(2D0*Y13*Y34*Y134**2)+(Y12*Y34**2- - & 4D0*Y14*Y24*Y34-2D0*Y13*Y24*Y34-2D0*Y14*Y23*Y34- - & 4D0*Y13*Y23*Y34-4D0*Y12*Y14*Y34-4D0*Y12*Y13*Y34- - & 2D0*Y13*Y14*Y24+2D0*Y13**2*Y24+2D0*Y14**2*Y23- - & 2D0*Y13*Y14*Y23-Y12*Y14**2-6D0*Y12*Y13*Y14- - & Y12*Y13**2)/(4D0*Y34**2*Y134**2) - WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5D0*CN)*WTB(IC)+ - & CN*WTC(IC))/8D0 - ELSE - WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2D0*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+2D0*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.5D0*CN)*WTE(IC))/16D0 - 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.PYR(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*(2D0*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4D0*(WTC(1)+ - & WTC(2)+WTC(3)+WTC(4)))/(9D0*WTTOT) - IF(WTA(2)+WTA(4)+2D0*(WTC(2)+WTC(4)).GT.PYR(0)*(WTA(1)+WTA(2)+ - & WTA(3)+WTA(4)+2D0*(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))/(8D0*WTTOT) - IF(WTA(2)+WTA(4).GT.PYR(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.5D0*Y34*(WTC(1)+WTC(2)+WTC(3)+ - & WTC(4)).GT.PYR(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.5D0*(1D0-SQRT(1D0-QME/Y12)) - X1=1D0-(1D0-Q12)*Y234-Q12*Y134 - X4=1D0-(1D0-Q12)*Y134-Q12*Y234 - X2=1D0-Y124 - X12=(1D0-Q12)*Y13+Q12*Y23 - X14=Y12-0.5D0*QME - IF(Y134*Y234/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 - -C...qqbarqqbar events: string configuration, choose new flavour. - ELSE - IF(ID.EQ.1) THEN - WTR=PYR(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))/(16D0*WTTOT) - 140 KFLN=1+INT(5D0*PYR(0)) - IF(KFLN.NE.KFL.AND.0.2D0*PARJ(156).LE.PYR(0)) GOTO 140 - IF(KFLN.EQ.KFL.AND.1D0-0.8D0*PARJ(156).LE.PYR(0)) GOTO 140 - IF(KFLN.GT.MSTJ(104)) NJET=2 - PMQN=PYMASS(KFLN) - QMEN=(2D0*PMQN/ECM)**2 - -C...Mass cuts. Kinematical variables out. - IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1D0*QMEN) NJET=2 - IF(NJET.EQ.2) GOTO 150 - Q24=0.5D0*(1D0-SQRT(1D0-QME/Y24)) - Q13=0.5D0*(1D0-SQRT(1D0-QMEN/Y13)) - X1=1D0-(1D0-Q24)*Y123-Q24*Y134 - X4=1D0-(1D0-Q24)*Y134-Q24*Y123 - X2=1D0-(1D0-Q13)*Y234-Q13*Y124 - X12=(1D0-Q24)*((1D0-Q13)*Y14+Q13*Y34)+Q24*((1D0-Q13)*Y12+ - & Q13*Y23) - X14=Y24-0.5D0*QME - X34=(1D0-Q24)*((1D0-Q13)*Y23+Q13*Y12)+Q24*((1D0-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/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 - ENDIF - 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 - - RETURN - END - -C********************************************************************* - -C...PYXDIF -C...Gives the angular orientation of events. - - SUBROUTINE PYXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Charge. Factors depending on polarization for QED case. - QF=KCHG(KFL,1)/3D0 - POLL=1D0-PARJ(131)*PARJ(132) - POLD=PARJ(132)-PARJ(131) - IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN - HF1=POLL - HF2=0D0 - HF3=PARJ(133)**2 - HF4=0D0 - -C...Factors depending on flavour, energy and polarization for QFD case. - ELSE - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECM)**2) - AE=-1D0 - VE=4D0*PARU(102)-1D0 - AF=SIGN(1D0,QF) - VF=AF-4D0*QF*PARU(102) - HF1=QF**2*POLL-2D0*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ - & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2D0*VE*AE*POLD) - HF2=-2D0*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2D0*VF*AF*SFW*SFF**2* - & (2D0*VE*AE*POLL-(VE**2+AE**2)*POLD) - HF3=PARJ(133)**2*(QF**2-2D0*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* - & SFW*SFF**2*(VE**2-AE**2)) - HF4=-PARJ(133)**2*2D0*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* - & SFF*AE - ENDIF - -C...Mass factor. Differential cross-sections for two-jet events. - SQ2=SQRT(2D0) - QME=0D0 - IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. - &MSTJ(109).NE.1) QME=(2D0*PYMASS(KFL)/ECM)**2 - IF(NJET.EQ.2) THEN - SIGU=4D0*SQRT(1D0-QME) - SIGL=2D0*QME*SQRT(1D0-QME) - SIGT=0D0 - SIGI=0D0 - SIGA=0D0 - SIGP=4D0 - -C...Kinematical variables. Reduce four-jet event to three-jet one. - ELSE - IF(NJET.EQ.3) THEN - X1=2D0*P(NC+1,4)/ECM - X2=2D0*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=2D0*P(NC+1,4)/ECMR - X2=2D0*P(NC+4,4)/ECMR - ENDIF - -C...Differential cross-sections for three-jet (or reduced four-jet). - XQ=(1D0-X1)/(1D0-X2) - CT12=(X1*X2-2D0*X1-2D0*X2+2D0+QME)/SQRT((X1**2-QME)*(X2**2-QME)) - ST12=SQRT(1D0-CT12**2) - IF(MSTJ(109).NE.1) THEN - SIGU=2D0*X1**2+X2**2*(1D0+CT12**2)-QME*(3D0+CT12**2-X1-X2)- - & QME*X1/XQ+0.5D0*QME*((X2**2-QME)*ST12**2-2D0*X2)*XQ - SIGL=(X2*ST12)**2-QME*(3D0-CT12**2-2.5D0*(X1+X2)+X1*X2+QME)+ - & 0.5D0*QME*(X1**2-X1-QME)/XQ+0.5D0*QME*((X2**2-QME)*CT12**2- - & X2)*XQ - SIGT=0.5D0*(X2**2-QME-0.5D0*QME*(X2**2-QME)/XQ)*ST12**2 - SIGI=((1D0-0.5D0*QME*XQ)*(X2**2-QME)*ST12*CT12+ - & QME*(1D0-X1-X2+0.5D0*X1*X2+0.5D0*QME)*ST12/CT12)/SQ2 - SIGA=X2**2*ST12/SQ2 - SIGP=2D0*(X1**2-X2**2*CT12) - -C...Differential cross-sect for scalar gluons (no mass effects). - ELSE - X3=2D0-X1-X2 - XT=X2*ST12 - CT13=SQRT(MAX(0D0,1D0-(XT/X3)**2)) - SIGU=(1D0-PARJ(171))*(X3**2-0.5D0*XT**2)+ - & PARJ(171)*(X3**2-0.5D0*XT**2-4D0*(1D0-X1)*(1D0-X2)**2/X1) - SIGL=(1D0-PARJ(171))*0.5D0*XT**2+ - & PARJ(171)*0.5D0*(1D0-X1)**2*XT**2 - SIGT=(1D0-PARJ(171))*0.25D0*XT**2+ - & PARJ(171)*0.25D0*XT**2*(1D0-2D0*X1) - SIGI=-(0.5D0/SQ2)*((1D0-PARJ(171))*XT*X3*CT13+ - & PARJ(171)*XT*((1D0-2D0*X1)*X3*CT13-X1*(X1-X2))) - SIGA=(0.25D0/SQ2)*XT*(2D0*(1D0-X1)-X1*X3) - SIGP=X3**2-2D0*(1D0-X1)*(1D0-X2)/X1 - ENDIF - ENDIF - -C...Upper bounds for differential cross-section. - HF1A=ABS(HF1) - HF2A=ABS(HF2) - HF3A=ABS(HF3) - HF4A=ABS(HF4) - SIGMAX=(2D0*HF1A+HF3A+HF4A)*ABS(SIGU)+2D0*(HF1A+HF3A+HF4A)* - &ABS(SIGL)+2D0*(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGT)+2D0*SQ2* - &(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGI)+4D0*SQ2*HF2A*ABS(SIGA)+ - &2D0*HF2A*ABS(SIGP) - -C...Generate angular orientation according to differential cross-sect. - 100 CHI=PARU(2)*PYR(0) - CTHE=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2D0*CHI) - S2CHI=SIN(2D0*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2D0*(PHI-PARJ(134))) - S2PHI=SIN(2D0*(PHI-PARJ(134))) - SIG=((1D0+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ - &2D0*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ - &2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)*C2CHI*C2PHI-2D0*CTHE*S2CHI* - &S2PHI)*HF3-((1D0+CTHE**2)*C2CHI*S2PHI+2D0*CTHE*S2CHI*C2PHI)*HF4)* - &SIGT-2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE*(CTHE*CCHI*C2PHI- - &SCHI*S2PHI)*HF3+2D0*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ - &4D0*SQ2*STHE*CCHI*HF2*SIGA+2D0*CTHE*HF2*SIGP - IF(SIG.LT.SIGMAX*PYR(0)) GOTO 100 - - RETURN - END - -C********************************************************************* - -C...PYXJET -C...Selects number of jets in matrix element approach. - - SUBROUTINE PYXJET(ECM,NJET,CUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array and data. - DIMENSION ZHUT(5) - DATA ZHUT/3.0922D0, 6.2291D0, 7.4782D0, 7.8440D0, 8.2560D0/ - -C...Trivial result for two-jets only, including parton shower. - IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN - CUT=0D0 - -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=4D0/3D0 - IF(MSTJ(109).EQ.2) CF=1D0 - IF(MSTJ(111).EQ.0) THEN - Q2=ECM**2 - Q2R=ECM**2 - ELSEIF(MSTU(111).EQ.0) THEN - PARJ(169)=MIN(1D0,PARJ(129)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(169)=MIN(1D0,MAX(PARJ(129),(2D0*PARU(112)/ECM)**2)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, - & (2D0*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - -C...alpha_strong for R and R itself. - ALSPI=(3D0/4D0)*CF*PYALPS(Q2R)/PARU(1) - IF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1D0+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+ - & (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(168))*ALSPI**2) - ELSE - RQCD=1D0+ALSPI-(3D0/32D0+0.519D0*MSTU(118))*(4D0*ALSPI/3D0)**2 - ENDIF - -C...alpha_strong for jet rate. Initial value for y cut. - ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) - CUT=MAX(0.001D0,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.75D0/ALSPI))/2D0) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) - -C...Parametrization of first order three-jet cross-section. - 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25D0) THEN - PARJ(152)=0D0 - ELSE - PARJ(152)=(2D0*ALSPI/3D0)*((3D0-6D0*CUT+2D0*LOG(CUT))* - & LOG(CUT/(1D0-2D0*CUT))+(2.5D0+1.5D0*CUT-6.571D0)* - & (1D0-3D0*CUT)+5.833D0*(1D0-3D0*CUT)**2-3.894D0* - & (1D0-3D0*CUT)**3+1.342D0*(1D0-3D0*CUT)**4)/RQCD - IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) - & PARJ(152)=0D0 - 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.25D0) THEN - PARJ(153)=0D0 - ELSEIF(MSTJ(110).LE.1) THEN - CT=LOG(1D0/CUT-2D0) - PARJ(153)=ALSPI**2*CT**2*(2.419D0+0.5989D0*CT+0.6782D0*CT**2- - & 0.2661D0*CT**3+0.01159D0*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.01D0*IY).LT.0.0001D0) IZA=IY - 110 CONTINUE - IF(IZA.NE.0) THEN - ZHURAT=ZHUT(IZA) - ELSE - IZ=100D0*CUT - ZHURAT=ZHUT(IZ)+(100D0*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.25D0) PARJ(153)=PARJ(153)+ - & (33D0-2D0*MSTU(112))/12D0*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.125D0) THEN - PARJ(154)=0D0 - ELSE - CT=LOG(1D0/CUT-5D0) - IF(CUT.LE.0.018D0) THEN - XQQGG=6.349D0-4.330D0*CT+0.8304D0*CT**2 - IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(3.035D0-2.091D0*CT+ - & 0.4059D0*CT**2) - XQQQQ=1.25D0*(-0.1080D0+0.01486D0*CT+0.009364D0*CT**2) - IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ - ELSE - XQQGG=-0.09773D0+0.2959D0*CT-0.2764D0*CT**2+0.08832D0*CT**3 - IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(-0.04079D0+ - & 0.1340D0*CT-0.1326D0*CT**2+0.04365D0*CT**3) - XQQQQ=1.25D0*(0.003661D0-0.004888D0*CT-0.001081D0*CT**2+ - & 0.002093D0*CT**3) - IF(MSTJ(109).EQ.2) XQQQQ=8D0*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.0D0.AND. - & PARJ(169).LT.0.99D0) THEN - PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3D0/4D0)*CF*PYALPS(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.0499D0.AND.MSTJ(111).EQ.1.AND. - & PARJ(169).LT.0.99D0) THEN - PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) - GOTO 100 - ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0) THEN - CALL PYERRM(26, - & '(PYXJET:) no allowed y cut value for Zhu parametrization') - ENDIF - CUT=0.26D0*(4D0*CUT)**(PARJ(152)+PARJ(153)+ - & PARJ(154))**(-1D0/3D0) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) - GOTO 100 - ENDIF - -C...Scalar gluon (first order only). - ELSE - ALSPI=PYALPS(ECM**2)/PARU(1) - CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3D0/ALSPI)) - PARJ(152)=0D0 - IF(CUT.LT.0.25D0) PARJ(152)=(ALSPI/3D0)*((1D0-2D0*CUT)* - & LOG((1D0-2D0*CUT)/CUT)+0.5D0*(9D0*CUT**2-1D0)) - PARJ(153)=0D0 - PARJ(154)=0D0 - 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=PYR(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********************************************************************* - -C...PYXKFL -C...Selects flavour for produced qqbar pair. - - SUBROUTINE PYXKFL(KFL,ECM,ECMC,KFLC) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Calculate maximum weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RFMAX=4D0/9D0 - ELSE - POLL=1D0-PARJ(131)*PARJ(132) - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECMC)**2) - VE=4D0*PARU(102)-1D0 - HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) - HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) - RFMAX=MAX(4D0/9D0*POLL-4D0/3D0*(1D0-8D0*PARU(102)/3D0)*HF1I+ - & ((1D0-8D0*PARU(102)/3D0)**2+1D0)*HF1W,1D0/9D0*POLL+2D0/3D0* - & (-1D0+4D0*PARU(102)/3D0)*HF1I+((-1D0+4D0*PARU(102)/3D0)**2+ - & 1D0)*HF1W) - ENDIF - -C...Choose flavour. Gives charge and velocity. - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYXKFL:) caught in an infinite loop') - KFLC=0 - RETURN - ENDIF - KFLC=KFL - IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*PYR(0)) - MSTJ(93)=1 - PMQ=PYMASS(KFLC) - IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 100 - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-(2D0*PMQ/ECMC)**2)) - -C...Calculate weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RF=QF**2 - RFV=0.5D0*VQ*(3D0-VQ**2)*QF**2 - ELSE - VF=SIGN(1D0,QF)-4D0*QF*PARU(102) - RF=QF**2*POLL-2D0*QF*VF*HF1I+(VF**2+1D0)*HF1W - RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+VF**2*HF1W)+ - & VQ**3*HF1W - IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) - ENDIF - -C...Weighting or new event (radiative photon). Cross-section update. - IF(KFL.LE.0.AND.RF.LT.PYR(0)*RFMAX) GOTO 100 - PARJ(158)=PARJ(158)+1D0 - IF(ECMC.LT.2D0*PMQ+PARJ(127).OR.RFV.LT.PYR(0)*RF) KFLC=0 - IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 - IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1D0 - PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) - PARJ(148)=PARJ(144)*86.8D0/ECM**2 - - RETURN - END - -C********************************************************************* - -C...PYXTEE -C...Calculates total cross-section, including initial state -C...radiation effects. - - SUBROUTINE PYXTEE(KFL,ECM,XTOT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -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(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, - & (2D0*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - ALSPI=PYALPS(Q2R)/PARU(1) - -C...QCD corrections factor in R. - IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN - RQCD=1D0 - ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+(33D0-2D0*MSTU(112))/12D0* - & LOG(PARJ(168))*ALSPI**2) - ELSEIF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1D0+(3D0/4D0)*ALSPI - ELSE - RQCD=1D0+(3D0/4D0)*ALSPI-(3D0/32D0+0.519D0*MSTU(118))*ALSPI**2 - ENDIF - -C...Calculate Z0 width if default value not acceptable. - IF(MSTJ(102).GE.3) THEN - RVA=3D0*(3D0+(4D0*PARU(102)-1D0)**2)+6D0*RQCD*(2D0+ - & (1D0-8D0*PARU(102)/3D0)**2+(4D0*PARU(102)/3D0-1D0)**2) - DO 100 KFLC=5,6 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0- - & (2D0*PYMASS(KFLC)/ ECM)**2)) - IF(KFLC.EQ.5) VF=4D0*PARU(102)/3D0-1D0 - IF(KFLC.EQ.6) VF=1D0-8D0*PARU(102)/3D0 - RVA=RVA+3D0*RQCD*(0.5D0*VQ*(3D0-VQ**2)*VF**2+VQ**3) - 100 CONTINUE - PARJ(124)=PARU(101)*PARJ(123)*RVA/(48D0*PARU(102)* - & (1D0-PARU(102))) - ENDIF - -C...Calculate propagator and related constants for QFD case. - POLL=1D0-PARJ(131)*PARJ(132) - IF(MSTJ(102).GE.2) THEN - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECM)**2) - VE=4D0*PARU(102)-1D0 - SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) - SF1W=SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) - HF1I=SFI*SF1I - HF1W=SFW*SF1W - ENDIF - -C...Loop over different flavours: charge, velocity. - RTOT=0D0 - RQQ=0D0 - RQV=0D0 - RVA=0D0 - DO 110 KFLC=1,MAX(MSTJ(104),KFL) - IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 - MSTJ(93)=1 - PMQ=PYMASS(KFLC) - IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 110 - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1D0-(2D0*PMQ/ECM)**2) - -C...Calculate R and sum of charges for QED or QFD case. - RQQ=RQQ+3D0*QF**2*POLL - IF(MSTJ(102).LE.1) THEN - RTOT=RTOT+3D0*0.5D0*VQ*(3D0-VQ**2)*QF**2*POLL - ELSE - VF=SIGN(1D0,QF)-4D0*QF*PARU(102) - RQV=RQV-6D0*QF*VF*SF1I - RVA=RVA+3D0*(VF**2+1D0)*SF1W - RTOT=RTOT+3D0*(0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL- - & 2D0*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.8D0/ECM**2 - PARJ(146)=PARJ(142)*86.8D0/ECM**2 - PARJ(147)=PARJ(143)*86.8D0/ECM**2 - PARJ(148)=PARJ(147) - PARJ(157)=RSUM*RQCD - PARJ(158)=0D0 - PARJ(159)=0D0 - XTOT=PARJ(147) - IF(MSTJ(107).LE.0) RETURN - -C...Virtual cross-section. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) - ALE=2D0*LOG(ECM/PYMASS(11))-1D0 - SIGV=ALE/3D0+2D0*LOG(ECM**2/(PYMASS(13)*PYMASS(15)))/3D0-4D0/3D0+ - &1.526D0*LOG(ECM**2/0.932D0) - -C...Soft and hard radiative cross-section in QED case. - IF(MSTJ(102).LE.1) THEN - SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+2D0*SIGV - SIGS=ALE*(2D0*LOG(XKL)-LOG(1D0-XKL)-XKL) - SIGH=ALE*(2D0*LOG(XKU/XKL)-LOG((1D0-XKU)/(1D0-XKL))-(XKU-XKL)) - -C...Soft and hard radiative cross-section in QFD case. - ELSE - SZM=1D0-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - PARJ(161)=-RQQ/RSUM - PARJ(162)=-(RQQ+RQV+RVA)/RSUM - PARJ(163)=(RQV*(1D0-0.5D0*SZM-SFI)+RVA*(1.5D0-SZM-SFW))/RSUM - PARJ(164)=(RQV*SZW**2*(1D0-2D0*SFW)+RVA*(2D0*SFI+SZW**2- - & 4D0+3D0*SZM-SZM**2))/(SZW*RSUM) - SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+((2D0*RQQ+SFI*RQV)/ - & RSUM)*SIGV+(SZW*SFW*RQV/RSUM)*PARU(1)*20D0/9D0 - SIGS=ALE*(2D0*LOG(XKL)+PARJ(161)*LOG(1D0-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*(2D0*LOG(XKU/XKL)+PARJ(161)*LOG((1D0-XKU)/ - & (1D0-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*(1D0+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD - PARJ(144)=PARJ(157) - PARJ(148)=PARJ(144)*86.8D0/ECM**2 - XTOT=PARJ(148) - - RETURN - END - -C********************************************************************* - -C...PYXTOT -C...Parametrizes total, elastic and diffractive cross-sections -C...for different energies and beams. Donnachie-Landshoff for -C...total and Schuler-Sjostrand for elastic and diffractive. -C...Process code IPROC: -C...= 1 : p + p; -C...= 2 : pbar + p; -C...= 3 : pi+ + p; -C...= 4 : pi- + p; -C...= 5 : pi0 + p; -C...= 6 : phi + p; -C...= 7 : J/psi + p; -C...= 11 : rho + rho; -C...= 12 : rho + phi; -C...= 13 : rho + J/psi; -C...= 14 : phi + phi; -C...= 15 : phi + J/psi; -C...= 16 : J/psi + J/psi; -C...= 21 : gamma + p (DL); -C...= 22 : gamma + p (VDM). -C...= 23 : gamma + pi (DL); -C...= 24 : gamma + pi (VDM); -C...= 25 : gamma + gamma (DL); -C...= 26 : gamma + gamma (VDM). - - SUBROUTINE PYXTOT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/ -C...Local arrays. - DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20), - &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8), - &CEFFD(10,9),SIGTMP(6,0:5) - -C...Common constants. - DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/, - &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/, - &FACDD/0.0084D0/ - -C...Number of multiple processes to be evaluated (= 0 : undefined). - DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/ -C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta). - DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0, - &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0, - &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/ - DATA YPAR/ - &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0, - &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0, - &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/ - -C...Beam and target hadron class: -C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi. - DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/ - DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/ -C...Characteristic class masses, slope parameters, beta = sqrt(X). - DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/ - DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ - DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/ - -C...Fitting constants used in parametrizations of diffractive results. - DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ - DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ - DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/ - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0, - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0, - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0, - &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0, - &0.267D0, 0.0D0, -0.46D0, 75D0, 0.267D0, 0.0D0, -0.46D0, 75D0, - &0.232D0, 0.0D0, -0.46D0, 85D0, 0.267D0, 0.0D0, -0.48D0, 100D0, - &0.115D0, 0.0D0, -0.50D0, 90D0, 0.267D0, 6.0D0, -0.56D0, 420D0, - &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0, - &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0, - &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/ - DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/ - &3.11D0, -7.34D0, 9.71D0, 0.068D0, -0.42D0, 1.31D0, - &-1.37D0, 35.0D0, 118D0, 3.11D0, -7.10D0, 10.6D0, - &0.073D0, -0.41D0, 1.17D0, -1.41D0, 31.6D0, 95D0, - &3.12D0, -7.43D0, 9.21D0, 0.067D0, -0.44D0, 1.41D0, - &-1.35D0, 36.5D0, 132D0, 3.13D0, -8.18D0, -4.20D0, - &0.056D0, -0.71D0, 3.12D0, -1.12D0, 55.2D0, 1298D0, - &3.11D0, -6.90D0, 11.4D0, 0.078D0, -0.40D0, 1.05D0, - &-1.40D0, 28.4D0, 78D0, 3.11D0, -7.13D0, 10.0D0, - &0.071D0, -0.41D0, 1.23D0, -1.34D0, 33.1D0, 105D0, - &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0, 2.72D0, - &-1.13D0, 53.1D0, 995D0, 3.11D0, -7.39D0, 8.22D0, - &0.065D0, -0.44D0, 1.45D0, -1.36D0, 38.1D0, 148D0, - &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0, 3.32D0, - &-1.12D0, 55.6D0, 1472D0, 4.18D0, -29.2D0, 56.2D0, - &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/ - -C...Parameters. Combinations of the energy. - AEM=PARU(101) - PMTH=PARP(102) - S=VINT(2) - SRT=VINT(1) - SEPS=S**EPS - SETA=S**ETA - SLOG=LOG(S) - -C...Ratio of gamma/pi (for rescaling in parton distributions). - VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/ - &(XPAR(5)*SEPS+YPAR(5)*SETA) - VINT(317)=1D0 - IF(MINT(50).NE.1) RETURN - -C...Order flavours of incoming particles: KF1 < KF2. - IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN - KF1=IABS(MINT(11)) - KF2=IABS(MINT(12)) - IORD=1 - ELSE - KF1=IABS(MINT(12)) - KF2=IABS(MINT(11)) - IORD=2 - ENDIF - ISGN12=ISIGN(1,MINT(11)*MINT(12)) - -C...Find process number (for lookup tables). - IF(KF1.GT.1000) THEN - IPROC=1 - IF(ISGN12.LT.0) IPROC=2 - ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN - IPROC=3 - IF(ISGN12.LT.0) IPROC=4 - IF(KF1.EQ.111) IPROC=5 - ELSEIF(KF1.GT.100) THEN - IPROC=11 - ELSEIF(KF2.GT.1000) THEN - IPROC=21 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22 - ELSEIF(KF2.GT.100) THEN - IPROC=23 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24 - ELSE - IPROC=25 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26 - ENDIF - -C... Number of multiple processes to be stored; beam/target side. - NPR=NPROC(IPROC) - MINT(101)=1 - MINT(102)=1 - IF(NPR.EQ.3) THEN - MINT(100+IORD)=4 - ELSEIF(NPR.EQ.6) THEN - MINT(101)=4 - MINT(102)=4 - ENDIF - N1=0 - IF(MINT(101).EQ.4) N1=4 - N2=0 - IF(MINT(102).EQ.4) N2=4 - -C...Do not do any more for user-set or undefined cross-sections. - IF(MSTP(31).LE.0) RETURN - IF(NPR.EQ.0) CALL PYERRM(26, - &'(PYXTOT:) cross section for this process not yet implemented') - -C...Parameters. Combinations of the energy. - AEM=PARU(101) - PMTH=PARP(102) - S=VINT(2) - SRT=VINT(1) - SEPS=S**EPS - SETA=S**ETA - SLOG=LOG(S) - -C...Loop over multiple processes (for VDM). - DO 110 I=1,NPR - IF(NPR.EQ.1) THEN - IPR=IPROC - ELSEIF(NPR.EQ.3) THEN - IPR=I+4 - IF(KF2.LT.1000) IPR=I+10 - ELSEIF(NPR.EQ.6) THEN - IPR=I+10 - ENDIF - -C...Evaluate hadron species, mass, slope contribution and fit number. - IHA=IHADA(IPR) - IHB=IHADB(IPR) - PMA=PMHAD(IHA) - PMB=PMHAD(IHB) - BHA=BHAD(IHA) - BHB=BHAD(IHB) - ISD=IFITSD(IPR) - IDD=IFITDD(IPR) - -C...Skip if energy too low relative to masses. - DO 100 J=0,5 - SIGTMP(I,J)=0D0 - 100 CONTINUE - IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110 - -C...Total cross-section. Elastic slope parameter and cross-section. - SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA -C...P.L. elastic slope parameter different for rho and phi - IF(IHA.eq.2) then - PMVIRT=0.76849997 -C BEL=5.84/(1+(1/2.17)*(VINT(307)/(PMVIRT**2))**0.74)+4.5 -C To make things consistent with the calculation of R -C use PARP 165 / 166 - BEL=5.84/(1+(PARP(165))*(VINT(307)/(PMVIRT**2))**PARP(166))+4.5 -C ELSEIF(IHA.eq.3) then -C BEL=4.D0 - ELSE - BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0 - ENDIF - SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL -C...Diffractive scattering A + B -> X + B. - BSD=2D0*BHB - SQML=(PMA+PMTH)**2 - SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2) - SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ - & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) - BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S - SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/ - & (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB) - SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2) - -C...Diffractive scattering A + B -> A + X. - BSD=2D0*BHA - SQML=(PMB+PMTH)**2 - SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6) - SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ - & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) - BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S - SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/ - & (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX) - SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2) - -C...Order single diffractive correctly. - IF(IORD.EQ.2) THEN - SIGSAV=SIGTMP(I,2) - SIGTMP(I,2)=SIGTMP(I,3) - SIGTMP(I,3)=SIGSAV - ENDIF - -C...Double diffractive scattering A + B -> X1 + X2. - YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2) - DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2 - SUM1=DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0)/(2D0*ALP) - IF(YEFF.LE.0) SUM1=0D0 - SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2) - SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC)))) - SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC)))) - SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/ - & (2D0*ALP) - SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC)))) - SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC)))) - SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/ - & (2D0*ALP) - BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S - SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB*PMRC))) - SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)* - & LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX) - SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4) - -C...Non-diffractive by unitarity. - SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)- - & SIGTMP(I,4) - 110 CONTINUE - -C...Put temporary results in output array: only one process. - IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN - DO 120 J=0,5 - SIGT(0,0,J)=SIGTMP(1,J) - 120 CONTINUE - -C...Beam multiple processes. - ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN - IF(MINT(107).EQ.2) THEN - IF(MSTP(20).EQ.0) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.575 - ENDIF - IF(MSTP(20).GT.0) THEN -C VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.0 - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.575 - ENDIF - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20) - ENDIF - DO 140 I=1,4 - IF(MINT(107).EQ.2) THEN - CONV=(AEM/PARP(160+I))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - I1=MAX(1,I-1) - DO 130 J=0,5 - SIGT(I,0,J)=CONV*SIGTMP(I1,J) - 130 CONTINUE - 140 CONTINUE - DO 150 J=0,5 - SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) - 150 CONTINUE - -C...Target multiple processes. - ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN - IF(MINT(108).EQ.2) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20) - ENDIF - DO 170 I=1,4 - IF(MINT(108).EQ.2) THEN - CONV=(AEM/PARP(160+I))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - IV=MAX(1,I-1) - DO 160 J=0,5 - SIGT(0,I,J)=CONV*SIGTMP(IV,J) - 160 CONTINUE - 170 CONTINUE - DO 180 J=0,5 - SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J) - 180 CONTINUE - -C...Both beam and target multiple processes. - ELSE - IF(MINT(107).EQ.2) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) - ENDIF - IF(MINT(108).EQ.2) THEN - VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 - ELSE - VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+ - & VINT(308)))**MSTP(20) - ENDIF - DO 210 I1=1,4 - DO 200 I2=1,4 - IF(MINT(107).EQ.2) THEN - CONV=(AEM/PARP(160+I1))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - IF(MINT(108).EQ.2) THEN - CONV=CONV*(AEM/PARP(160+I2)) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2) - ELSE - CONV=0D0 - ENDIF - IF(I1.LE.2) THEN - IV=MAX(1,I2-1) - ELSEIF(I2.LE.2) THEN - IV=MAX(1,I1-1) - ELSEIF(I1.EQ.I2) THEN - IV=2*I1-2 - ELSE - IV=5 - ENDIF - DO 190 J=0,5 - JV=J - IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J - SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV) - 190 CONTINUE - 200 CONTINUE - 210 CONTINUE - DO 230 J=0,5 - DO 220 I=1,4 - SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J) - SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J) - 220 CONTINUE - SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) - 230 CONTINUE - ENDIF - -C...Scale up uniformly for Donnachie-Landshoff parametrization. - IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN - RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0) - DO 260 I1=0,N1 - DO 250 I2=0,N2 - DO 240 J=0,5 - SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J) - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - ENDIF - - RETURN - END - - -C********************************************************************* - -C...PYXXGA -C...Calculates chi0_i -> chi0_j + gamma. - - FUNCTION PYXXGA(C0,XM1,XM2,XMTR,XMTL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYXXGA,C0,XM1,XM2,XMTR,XMTL - DOUBLE PRECISION F1,F2 - - F1=(1D0+XMTR/(1D0-XMTR)*LOG(XMTR))/(1D0-XMTR) - F2=(1D0+XMTL/(1D0-XMTL)*LOG(XMTL))/(1D0-XMTL) - PYXXGA=C0*((XM1**2-XM2**2)/XM1)**3 - PYXXGA=PYXXGA*(2D0/3D0*(F1+F2)-13D0/12D0)**2 - - RETURN - END - -C********************************************************************* - -C...PYXXZ6 -C...Used in the calculation of inoi -> inoj + f + ~f. - - FUNCTION PYXXZ6(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYINTC/ - -C...Local variables. - COMPLEX*16 QLLS,QRRS,QRLS,QLRS,QLLU,QRRU,QLRT,QRLT - DOUBLE PRECISION PYXXZ6,X - DOUBLE PRECISION XM12,XM22,XM32,S,S13,WPROP2 - DOUBLE PRECISION WW,WF1,WF2,WFL1,WFL2 - DOUBLE PRECISION SIJ - DOUBLE PRECISION XMV,XMG,XMSU1,XMSU2,XMSD1,XMSD2 - DOUBLE PRECISION OL2 - DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL - INTEGER I - -C...Statement functions. -C...Integral from x to y of (t-a)(b-t) dt. - TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B) -C...Integral from x to y of (t-a)(b-t)/(t-c) dt. - TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))- - &LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A) -C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt. - TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+ - &(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C))) -C...Integral from x to y of (t-a)/(b-t) dt. - UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A) -C...Integral from x to y of 1/(t-a) dt. - TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A))) - - XM12=XXC(1)**2 - XM22=XXC(2)**2 - XM32=XXC(3)**2 - S=XXC(4)**2 - S13=X - - S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S) - S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)* - &( (X-XM22-S)**2 -4D0*XM22*S ) ) - - S23MIN=(S23AVE-S23DEL) - S23MAX=(S23AVE+S23DEL) - - XMSD1=XXC(5)**2 - XMSD2=XXC(7)**2 - XMSU1=XXC(6)**2 - XMSU2=XXC(8)**2 - - XMV=XXC(9) - XMG=XXC(10) - QLLS=CXC(1) - QLLU=CXC(2) - QLRS=CXC(3) - QLRT=CXC(4) - QRLS=CXC(5) - QRLT=CXC(6) - QRRS=CXC(7) - QRRU=CXC(8) - WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2 - SIJ=2D0*XXC(2)*XXC(4)*S13 - IF(XMV.LE.1000D0) THEN - OL2=ABS(QLLS)**2+ABS(QRRS)**2+ABS(QLRS)**2+ABS(QRLS)**2 - OLR=-2D0*DBLE(QLRS*DCONJG(QLLS)+QRLS*DCONJG(QRRS)) - WW=(OL2*2D0*TINT(S23MAX,S23MIN,XM22,S) - & +OLR*SIJ*(S23MAX-S23MIN))/WPROP2 - IF(XXC(5).LE.10000D0) THEN - WFL1=4D0*(DBLE(QLLS*DCONJG(QLLU))* - & TINT2(S23MAX,S23MIN,XM22,S,XMSD1)- - & .5D0*DBLE(QLLS*DCONJG(QLRT))*SIJ*TPROP(S23MAX,S23MIN,XMSD2)+ - & DBLE(QLRS*DCONJG(QLRT))*TINT2(S23MAX,S23MIN,XM22,S,XMSD2)- - & .5D0*DBLE(QLRS*DCONJG(QLLU))*SIJ*TPROP(S23MAX,S23MIN,XMSD1)) - & *(S13-XMV**2)/WPROP2 - ELSE - WFL1=0D0 - ENDIF - - IF(XXC(6).LE.10000D0) THEN - WFL2=4D0*(DBLE(QRRS*DCONJG(QRRU))* - & TINT2(S23MAX,S23MIN,XM22,S,XMSU1)- - & .5D0*DBLE(QRRS*DCONJG(QRLT))*SIJ*TPROP(S23MAX,S23MIN,XMSU2)+ - & DBLE(QRLS*DCONJG(QRLT))*TINT2(S23MAX,S23MIN,XM22,S,XMSU2)- - & .5D0*DBLE(QRLS*DCONJG(QRRU))*SIJ*TPROP(S23MAX,S23MIN,XMSU1)) - & *(S13-XMV**2)/WPROP2 - ELSE - WFL2=0D0 - ENDIF - ELSE - WW=0D0 - WFL1=0D0 - WFL2=0D0 - ENDIF - IF(XXC(5).LE.10000D0) THEN - WF1=2D0*ABS(QLLU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD1) - & +2D0*ABS(QLRT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD2) - & - 2D0*DBLE(QLRT*DCONJG(QLLU))* - & SIJ*UTINT(S23MAX,S23MIN,XMSD1,XM22+S-S13-XMSD2) - ELSE - WF1=0D0 - ENDIF - IF(XXC(6).LE.10000D0) THEN - WF2=2D0*ABS(QRRU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU1) - & +2D0*ABS(QRLT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU2) - & - 2D0*DBLE(QRLT*DCONJG(QRRU))* - & SIJ*UTINT(S23MAX,S23MIN,XMSU1,XM22+S-S13-XMSU2) - ELSE - WF2=0D0 - ENDIF - - PYXXZ6=(WW+WF1+WF2+WFL1+WFL2) - - IF(PYXXZ6.LT.0D0) THEN - WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ6 ' - WRITE(MSTU(11),*) XXc(1),XXc(2),XXc(3),XXc(4) - WRITE(MSTU(11),*) (XXc(I),I=5,8) - WRITE(MSTU(11),*) (XXc(I),I=9,12) - WRITE(MSTU(11),*) (XXc(I),I=13,16) - WRITE(MSTU(11),*) WW,WF1,WF2,WFL1,WFL2 - WRITE(MSTU(11),*) S23MIN,S23MAX - PYXXZ6=0D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYZDIS -C...Generates the longitudinal splitting variable z. - - SUBROUTINE PYZDIS(KFL1,KFL2,PR,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -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=1D0 - IF(KFLA.GE.10) FC=FC-PARJ(45) - IF(KFLB.GE.10) FC=FC+PARJ(45) - IF(MSTJ(11).GE.4.AND.(KFLH.EQ.4.OR.KFLH.EQ.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 - ENDIF - MC=1 - IF(ABS(FC-1D0).GT.0.01D0) MC=2 - -C...Determine position of maximum. Special cases for a = 0 or a = c. - IF(FA.LT.0.02D0) THEN - MA=1 - ZMAX=1D0 - IF(FC.GT.FB) ZMAX=FB/FC - ELSEIF(ABS(FC-FA).LT.0.01D0) THEN - MA=2 - ZMAX=FB/(FB+FC) - ELSE - MA=3 - ZMAX=0.5D0*(FB+FC-SQRT((FB-FC)**2+4D0*FA*FB))/(FC-FA) - IF(ZMAX.GT.0.9999D0.AND.FB.GT.100D0) ZMAX=MIN(ZMAX,1D0-FA/FB) - ENDIF - -C...Subdivide z range if distribution very peaked near endpoint. - MMAX=2 - IF(ZMAX.LT.0.1D0) THEN - MMAX=1 - ZDIV=2.75D0*ZMAX - IF(MC.EQ.1) THEN - FINT=1D0-LOG(ZDIV) - ELSE - ZDIVC=ZDIV**(1D0-FC) - FINT=1D0+(1D0-1D0/ZDIVC)/(FC-1D0) - ENDIF - ELSEIF(ZMAX.GT.0.85D0.AND.FB.GT.1D0) THEN - MMAX=3 - FSCB=SQRT(4D0+(FC/FB)**2) - ZDIV=FSCB-1D0/ZMAX-(FC/FB)*LOG(ZMAX*0.5D0*(FSCB+FC/FB)) - IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1D0-ZMAX) - ZDIV=MIN(ZMAX,MAX(0D0,ZDIV)) - FINT=1D0+FB*(1D0-ZDIV) - ENDIF - -C...Choice of z, preweighted for peaks at low or high z. - 100 Z=PYR(0) - FPRE=1D0 - IF(MMAX.EQ.1) THEN - IF(FINT*PYR(0).LE.1D0) THEN - Z=ZDIV*Z - ELSEIF(MC.EQ.1) THEN - Z=ZDIV**Z - FPRE=ZDIV/Z - ELSE - Z=(ZDIVC+Z*(1D0-ZDIVC))**(1D0/(1D0-FC)) - FPRE=(ZDIV/Z)**FC - ENDIF - ELSEIF(MMAX.EQ.3) THEN - IF(FINT*PYR(0).LE.1D0) THEN - Z=ZDIV+LOG(Z)/FB - FPRE=EXP(FB*(Z-ZDIV)) - ELSE - Z=ZDIV+Z*(1D0-ZDIV) - ENDIF - ENDIF - -C...Weighting according to correct formula. - IF(Z.LE.0D0.OR.Z.GE.1D0) GOTO 100 - FEXP=FC*LOG(ZMAX/Z)+FB*(1D0/ZMAX-1D0/Z) - IF(MA.GE.2) FEXP=FEXP+FA*LOG((1D0-Z)/(1D0-ZMAX)) - FVAL=EXP(MAX(-50D0,MIN(50D0,FEXP))) - IF(FVAL.LT.PYR(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=PYR(0) - IF(FC.GE.0D0.AND.FC.LE.1D0) THEN - IF(FC.GT.PYR(0)) Z=1D0-Z**(1D0/3D0) - ELSEIF(FC.GT.-1.AND.FC.LT.0D0) THEN - IF(-4D0*FC*Z*(1D0-Z)**2.LT.PYR(0)*((1D0-Z)**2-FC*Z)**2) - & GOTO 110 - ELSE - IF(FC.GT.0D0) Z=1D0-Z**(1D0/FC) - IF(FC.LT.0D0) Z=Z**(-1D0/FC) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...STRUCTM -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local variables - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - UPV=XX+QQ - DNV=XX+2D0*QQ - USEA=XX+3D0*QQ - DSEA=XX+4D0*QQ - STR=XX+5D0*QQ - CHM=XX+6D0*QQ - BOT=XX+7D0*QQ - TOP=XX+8D0*QQ - GLU=XX+9D0*QQ - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine STRUCTM in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...STRUCTP -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - &BOT,TOP,GLU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local variables - DOUBLE PRECISION XX,QQ2,P2,UPV,DNV,USEA,DSEA,STR,CHM,BOT, - &TOP,GLU - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - UPV=XX+QQ2 - DNV=XX+2D0*QQ2 - USEA=XX+3D0*QQ2 - DSEA=XX+4D0*QQ2 - STR=XX+5D0*QQ2 - CHM=XX+6D0*QQ2 - BOT=XX+7D0*QQ2 - TOP=XX+8D0*QQ2 - GLU=XX+9D0*QQ2 - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine STRUCTP in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...SUGRA -C...Dummy routine, to be removed when ISAJET (ISASUSY) is to be linked. - - SUBROUTINE SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,IMODL) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP - INTEGER IMODL -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ - &1X,'Dummy routine SUGRA in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...UPEVNT -C...Dummy routine, to be replaced by a user implementing external -C...processes. Depending on cross section model chosen, it either has -C...to generate a process of the type IDPRUP requested, or pick a type -C...itself and generate this event. The event is to be stored in the -C...HEPEUP commonblock, including (often) an event weight. - - SUBROUTINE UPEVNT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - - RETURN - END - -C********************************************************************* - -C...UPINIT -C...Dummy routine, to be replaced by a user implementing external -C...processes. Is supposed to fill the HEPRUP commonblock with info -C...on incoming beams and allowed processes. - - SUBROUTINE UPINIT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - - RETURN - END - -C********************************************************************* - -C...VISAJE -C...Dummy function, to be removed when ISAJET (ISASUSY) is to be linked. - - FUNCTION VISAJE() - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - CHARACTER*40 VISAJE - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Assign default value. - VISAJE='Undefined' - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ - &1X,'Dummy function VISAJE in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - SUBROUTINE RADGEN_EVENT - WRITE(6,*) ' %%% RADGEN_EVENT called' - RETURN - END -C - SUBROUTINE MKF2(DQ2,DX,A,Z,DF2,DF1) - DOUBLE PRECISION DX, DQ2, DF1, DF2 - INTEGER A, Z - WRITE(6,*) ' %%% MKF2 called' - RETURN - END -C - DOUBLE PRECISION FUNCTION pyth_xsec(dx, dQ2,dF1, dF2) - DOUBLE PRECISION DX, DQ2,DF1,DF2 - WRITE(6,*) ' %%% PYTH_XSEC called' - RETURN - END diff --git a/src/programs/Simulation/bggen/code/rnd_ini.F b/src/programs/Simulation/bggen/code/rnd_ini.F deleted file mode 100644 index 4e5a9fa1e3..0000000000 --- a/src/programs/Simulation/bggen/code/rnd_ini.F +++ /dev/null @@ -1,14 +0,0 @@ - SUBROUTINE RND_INI(ISEQ) -C--- RANLUX initialization (random number) - IMPLICIT NONE - INTEGER ISEQ - INTEGER k1,k2,lux -C - k1=0 - k2=0 - lux=3 - CALL RLUXGO(lux,ISEQ,k1,k2) -C - RETURN - END - diff --git a/src/programs/Simulation/bggen/code/rndm.F b/src/programs/Simulation/bggen/code/rndm.F deleted file mode 100644 index b5395f68c0..0000000000 --- a/src/programs/Simulation/bggen/code/rndm.F +++ /dev/null @@ -1,11 +0,0 @@ -C - REAL FUNCTION RNDM(X) - IMPLICIT NONE - REAL X - REAL a -C - CALL RANLUX(a,1) - RNDM=a - RETURN - END - diff --git a/src/programs/Simulation/bggen/code/saidcore.F b/src/programs/Simulation/bggen/code/saidcore.F deleted file mode 100644 index 59cf86fb19..0000000000 --- a/src/programs/Simulation/bggen/code/saidcore.F +++ /dev/null @@ -1,2063 +0,0 @@ -C -C --- SAID gamma+p --> pi N cross section -C -C From I.Strakovsky, D.Arndt -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C -C Usage: -C ee=E*1000. -C it=1 -C s=PRFAMP(ee,COSTH,IPROC,fr,fi,dx3) -C res=OBSPRD(it) -C -C --- E - photons energy (E<2 GeV) -C --- COSTH - cos of pion angle in CM -C --- IPROC = 1 - pi0 p -C 2 - pi+ n -C 3 ... is at the moment unclear to me -C Returns cross section in microbarn/ster for pion in CM -C -C *************************************************** - REAL FUNCTION PRFAMP(EGX,Z,IR,FRV,FIV,S3) -C IMPLICIT NONE -C SUBROUTINE TO GET "F" AMPLITUDES FOR PION-PHOTOPRODUCTION 11/93 ARNDT - REAL EGX,Z,FRV(4),FIV(4),S3 - INTEGER IR - COMMON/PRFA/EMR(6,2,6),EMI(6,2,6),NTL1(18),NTL2(18),TTLPN(18) - INTEGER NTL1,NTL2,TTLPN - REAL EMR,EMIT,TLPN - REAL F2(4),CIS(4,2),PP(20),PDP(20),EMPI(6,2,6) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C to add a calculation of observables 9/18/02 RAA - REAL ZM,EGM,C1,C3,SQ - INTEGER IRM,i,k,ii - DATA IRM,ZM,EGM,C1,C3,SQ/27,27.0,0.0,0,0,0/ -C SAVE IRM,ZM,EGM,C1,C3,SQ -C SAVE F2,CIS,PP,PDP,EMPI,II - SAVE -C write(6,*) 'EGX,Z,IR,II',EGX,Z,IR,II ! MYPRI - CS=Z - EG=ABS(EGX) - IF(IRM.NE.27) GO TO 1 - SQ=SQRT(2.0) - CIS(2,1)=SQ - CIS(2,2)=-SQ/3.0 - CIS(1,1)=1.0 - CIS(1,2)=2.0/3.0 - CIS(3,1)=SQ - CIS(3,2)=SQ/3.0 - CIS(4,1)=-1.0 - CIS(4,2)=2.0/3.0 - 1 IF(IR.NE.IRM) EGM=0.0 - IF(EGX.EQ.EGM) GO TO 2 -C write(6,*) 'EGX,EGM,IR,II',EGX,EGM,IR,II ! MYPRI - IRM=IR - C3=1.0 - C1=0.0 - IF(IR.GT.6) GO TO 12 - C1=1.0 - C3=0.0 - IF(IR.GT.4) GO TO 12 - I=IR - IF(I.LT.1) I=1 - C3=CIS(I,2) - C1=CIS(I,1) - 12 EGM=EGX - I=IR - IF(IR.LT.1) I=1 - IF(I.GT.4) I=4 - II=I - CALL PROPEC(EG,EMPI) - CALL PRSM02(EG,I,EMR,EMI,NTL1,TTLPN) - 2 IF(Z.EQ.ZM) GO TO 3 - ZM=Z - CALL PJDRV(Z,8,PP,PDP) - 3 CONTINUE -C write(6,*) FRV - DO k=1,4 -C write(6,*) 'k=',K - FRV(k)=0. - FIV(k)=0. - ENDDO -C write(6,*) 'EG,II,Z',EG,II,Z ! MYPRI - CALL FOPEC(EG,II,Z,FRV) - ME=3 - IF(IR.GT.2.AND.IR.LT.6) ME=5 - MM=ME+1 - LL=0 - 5 LL=LL+1 - IF(LL.GT.6) GO TO 98 - DO 9 M=1,6 - DO 9 J=1,2 - Z1=EMR(M,J,LL) - Z1P=EMPI(M,J,LL) - EMR(M,J,LL)=Z1-Z1P - EMPI(M,J,LL)=0.0 - 9 CONTINUE - ZL=LL-1 - EP=C3*EMR(1,2,LL)+C1*EMR(ME,2,LL) - EM=C3*EMR(1,1,LL)+C1*EMR(ME,1,LL) - BP=C3*EMR(2,2,LL)+C1*EMR(MM,2,LL) - BM=C3*EMR(2,1,LL)+C1*EMR(MM,1,LL) - EPI=C3*EMI(1,2,LL)+C1*EMI(ME,2,LL) - EMX=C3*EMI(1,1,LL)+C1*EMI(ME,1,LL) - BPI=C3*EMI(2,2,LL)+C1*EMI(MM,2,LL) - BMI=C3*EMI(2,1,LL)+C1*EMI(MM,1,LL) - FRV(1)=FRV(1)+PP(LL+1)*(ZL*BP+EP) - FIV(1)=FIV(1)+PP(LL+1)*(ZL*BPI+EPI) - IF(LL.EQ.1) GO TO 5 - IF(LL.LT.3) GO TO 6 - FRV(1)=FRV(1)+PP(LL-1)*((ZL+1.0)*BM+EM) - FIV(1)=FIV(1)+PP(LL-1)*((ZL+1.0)*BMI+EMX) - 6 FRV(2)=FRV(2)+PP(LL)*((ZL+1.0)*BP+ZL*BM) - FIV(2)=FIV(2)+PP(LL)*((ZL+1.0)*BPI+ZL*BMI) - FRV(3)=FRV(3)+PDP(LL+1)*(EP-BP) - FIV(3)=FIV(3)+PDP(LL+1)*(EPI-BPI) - IF(LL.LT.3) GO TO 7 - FRV(3)=FRV(3)+PDP(LL-1)*(EM+BM) - FIV(3)=FIV(3)+PDP(LL-1)*(EMX+BMI) - 7 FRV(4)=FRV(4)+PDP(LL)*(BP-EP-BM-EM) - FIV(4)=FIV(4)+PDP(LL)*(BPI-EPI-BMI-EMX) - GO TO 5 - 98 S=0.0 - DO 11 K=1,4 - F2(K)=FRV(K)**2+FIV(K)**2 - 11 S=S+F2(K) - CALL PRKIN(EG,IR,EPI,ZKCM,QCM) - S2=(1.0-Z**2) - S=F2(1)+F2(2)+S2*(F2(3)+F2(4))/2.0 - S=S-2.0*Z*(FRV(1)*FRV(2)+FIV(1)*FIV(2)) - S=S+S2*(FRV(1)*FRV(4)+FIV(1)*FIV(4)+FRV(2)*FRV(3)+FIV(2)*FIV(3)) - S=S+S2*Z*(FRV(3)*FRV(4)+FIV(3)*FIV(4)) - PRFAMP=S*QCM/ZKCM/100.0 - S3=F2(3)+F2(4)+2.0*Z*(FRV(3)*FRV(4)+FIV(3)*FIV(4)) - S3=S3*QCM/ZKCM/200.0*S2 -C convert F to H 9/18/02 - sh=sqrt((1.0-z)/2.0) - ch=sqrt(1.0-sh**2) - hrx(3)=sq*ch*sh**2*(FRV(3)-FRV(4)) - hrx(1)=-sq*sh*ch**2*(FRV(3)+FRV(4)) - hrx(2)=hrx(3)+sq*ch*(FRV(2)-FRV(1)) - hrx(4)=sq*sh*(FRV(2)+FRV(1))-hrx(1) - hix(3)=sq*ch*sh**2*(FIV(3)-FIV(4)) - hix(1)=-sq*sh*ch**2*(FIV(3)+FIV(4)) - hix(2)=hix(3)+sq*ch*(FIV(2)-FIV(1)) - hix(4)=sq*sh*(FIV(2)+FIV(1))-hix(1) - 99 RETURN - END -C **************************************************************** - SUBROUTINE PJDRV(Z,JMX,PP,PDP) - DIMENSION PP(20),PDP(20) -C GET LEGENDRE DERIVATIVE PP(1ST) AND PDP(2ND) - SAVE - JM=JMX - IF(JM.GT.20) JM=20 - J=0 - PJ=1.0 - PJM=0.0 - 1 J=J+1 - ZJ=J-1 - PP(J)=0.0 - PDP(J)=0.0 - IF(J.LT.2) GO TO 2 - PP(J)=ZJ*PJM+Z*PP(J-1) - IF(J.LT.3) GO TO 2 - PDP(J)=Z*PDP(J-1)+(ZJ+1.0)*PP(J-1) - 2 X=PJ - PJ=((2.0*ZJ+1.0)*Z*PJ-ZJ*PJM)/(ZJ+1.0) - PJM=X - IF(J.LT.JM) GO TO 1 - RETURN - END -C ************************************************ - SUBROUTINE FOPEC(EL,IR,Z,F) - DIMENSION F(4),EPX(4),E2X(4),GC(4),AA(4),BB(4),CC(4) - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ - DATA EPX,E2X/0.0,1.0,-1.0,0.0,1.0,0.0,1.0,0.0/ - DATA GC/-1.0,-1.0,-1.0,1.0/ -C SAVE EPX,E2X,GC,AA,BB,CC - SAVE - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - DT=-2.0*(ZT-Z) - DU=2.0*(ZU-Z) - GG=1000.0*GN/W - USCL=(W+WN)/2.0/Z1/Z2 - AA(1)=0.0 - AA(2)=0.0 - AA(3)=GG*Z2/Z1 - AA(4)=-GG*Z1*Q/Z2/ZK - BB(1)=-GG*W/Q/USCL/2.0 - BB(2)=GG*W/Z2**2/2.0/USCL - BB(3)=-AA(3) - BB(4)=-AA(4) - GG=GG*USCL - CC(1)=-GG*Z2**2/Q - CC(2)=GG - CC(3)=-GG*Z2**2/WN - CC(4)=-GG*Q/WN -C write(6,*) 'EL,IR,Z,F',EL,IR,Z,F ! MYPRI - E2=E2X(IR) - G=GC(IR) - IF(IR.EQ.2.OR.IR.EQ.3) G=G*SQ2 - EPI=EPX(IR) - U2=(UN+E2*(UP-UN)) - F(1)=G*(AA(1)*EPI/DT+(E2*BB(1)+U2*CC(1))/DU) - F(2)=G*(AA(2)*EPI/DT+(E2*BB(2)+U2*CC(2))/DU) - F(3)=G*(AA(3)*EPI/DT+(E2*BB(3)+U2*CC(3))/DU) - F(4)=G*(AA(4)*EPI/DT+(E2*BB(4)+U2*CC(4))/DU) - 99 RETURN - END -C ************************************************** - SUBROUTINE PRSM02(TLB,IR,EMR,EMI,NTL,TTLPN) -C get photo-production multipoles (from VPI analysis) -C Tlab=Photon LAB energy (MeV); IR=1(Pi0), 2(Pi+), 3(Pi-), 4(Pi0N) -C NTL(20) is a TITLE which is set on the 1st call to the subroutine -C EMR(6,2,6) is the REAL part (in mFm) and EMI is the IMAGINARY part -C of the multipole amplitudes. The INDEX (M,J,L) labels the state as fol -C M=1(pE3/2), 2(pM3/2), 3(pE1/2), 4(pM1/2), 5(nE1/2), 6(nM1/2) -C L=ORBITAL angular momentum, J=1(j=l-1/2) or 2(j=l+1/2). (actually L=l+ -C some examples: S11pE=(3,2,1) S31pE=(1,2,1) P33pM=(4,2,2) P33pE=(3,2, -C P11pM=(4,1,2) D15nM=(6,2,3) ..... - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - COMMON/PRKC/IPRK - DIMENSION PEM(15,6,2,6),EMR(6,2,6),EMI(6,2,6),NF(6,2,6),CCS(5) - C,EMPI(6,2,6),QL(12),NTL(13),NTC(13),PP(400),TPNR(4,8),TPNI(4,8) - DIMENSION TTLPN(15),PP1(70),PP2(70),PP3(70),PP4(70),PP5(66) - CHARACTER HTL*52 - INTEGER TTLPN - EQUIVALENCE (PP,PP1),(PP(71),PP2),(PP(141),PP3) - C,(PP(211),PP4),(PP(281),PP5) - DATA CCS/ 22.500, 0.000, 13.750, 0.000, 0.000/ - DATA IPRKX/ 1/ - DATA HTL/'SM02K 2000 MEV P(148) CHI/DP=35297/17571 '/ - DATA IMX/346/ - DATA PP1/ 0.25121E+13, 0.14625E+02,-0.12639E+03, 0.75187E+02, - C 0.00000E+00,-0.18097E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.59426E+01, 0.00000E+00,-0.63967E+02, 0.10470E+03, 0.21321E+13, - C-0.86934E+01, 0.10773E+01,-0.11660E+00, 0.00000E+00, 0.64122E+02, - C-0.86162E+01, 0.17660E+00, 0.00000E+00,-0.16826E+02, 0.15135E+01, - C 0.10282E+02, 0.25521E+13,-0.96450E+00, 0.23707E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00,-0.44563E+02, 0.65940E+02, 0.21212E+13, - C 0.61205E+01,-0.10655E+01,-0.56700E-01, 0.00000E+00, 0.15401E+03, - C-0.92590E+01, 0.21412E+13, 0.16290E+01,-0.92310E+00, 0.60700E-01, - C 0.00000E+00, 0.24447E+02,-0.21964E+01, 0.25612E+13, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.13333E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.93731E+01, 0.24122E+13,-0.10673E+01, - C 0.49582E+01, 0.00000E+00, 0.00000E+00,-0.15440E+01, 0.24222E+13, - C-0.13886E+02/ - DATA PP2/ 0.11655E+03,-0.13603E+04, 0.17137E+04, 0.34104E+02, - C 0.53811E+02,-0.16301E+02, 0.49180E+00, 0.00000E+00, 0.00000E+00, - C-0.98292E+02, 0.23824E+02, 0.25322E+13, 0.22764E+02,-0.72372E+02, - C 0.53892E+02, 0.00000E+00, 0.59900E+02,-0.69650E+02, 0.25422E+13, - C-0.16052E+02, 0.57929E+02,-0.62187E+02, 0.00000E+00, 0.00000E+00, - C-0.28311E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.59717E+01, 0.25522E+13,-0.40780E+01, 0.94920E+01, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.46976E+01, 0.25622E+13, 0.17593E+01, 0.25113E+13, 0.21683E+01, - C-0.31918E+02, 0.00000E+00, 0.00000E+00,-0.16604E+03, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.21527E+02, 0.00000E+00,-0.75828E+02, - C 0.16466E+03, 0.25213E+13,-0.10177E+02, 0.51979E+02,-0.86352E+02, - C 0.00000E+00, 0.33052E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.36886E+01, 0.00000E+00,-0.27140E+01, 0.25313E+13, 0.34127E+02, - C-0.89989E+02/ - DATA PP3/ 0.00000E+00, 0.00000E+00, 0.10452E+03,-0.10911E+03, - C 0.00000E+00, 0.00000E+00,-0.53911E+02, 0.14084E+03,-0.28059E+02, - C 0.34639E+02, 0.25413E+13,-0.40309E+02, 0.88893E+02,-0.54692E+02, - C 0.00000E+00, 0.18067E+03,-0.55538E+03, 0.42138E+03, 0.25513E+13, - C 0.16695E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.10387E+03, - C 0.11062E+03, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.77412E+01, 0.25613E+13,-0.65508E+01, 0.20229E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.25953E+01, 0.25123E+13,-0.25835E+02, 0.85524E+02,-0.70269E+02, - C 0.00000E+00,-0.34619E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.65460E+01, 0.25223E+13,-0.22901E+01, - C 0.25323E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.13747E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.68360E+00, - C 0.25423E+13, 0.43825E+01,-0.97807E+01, 0.00000E+00, 0.00000E+00, - C 0.00000E+00/ - DATA PP4/ 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.16460E+01, - C 0.00000E+00, 0.14276E+01, 0.25523E+13,-0.68300E-01, 0.25623E+13, - C 0.31487E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.17942E+02, - C 0.25114E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.31147E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.49006E+01, - C 0.25214E+13,-0.13890E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.82595E+02, 0.16338E+03, 0.25314E+13,-0.11818E+02, 0.13203E+02, - C 0.00000E+00, 0.00000E+00, 0.36882E+02,-0.38961E+02, 0.25414E+13, - C 0.14468E+01,-0.58022E+01, 0.00000E+00, 0.00000E+00, 0.10382E+02, - C 0.25514E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.46150E+01, 0.25614E+13, 0.21488E+01, 0.00000E+00, 0.00000E+00, - C 0.00000E+00,-0.56096E+01, 0.25124E+13,-0.32589E+01, 0.53944E+01, - C 0.25224E+13,-0.49784E+02, 0.19046E+03,-0.18472E+03, 0.00000E+00, - C 0.16002E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00/ - DATA PP5/ 0.22656E+01, 0.25324E+13, 0.13610E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.45565E+02,-0.65437E+02, - C 0.25424E+13,-0.42560E+00, 0.25524E+13, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.45573E+01, 0.25624E+13, 0.11595E+02, - C-0.21803E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.30548E+02, 0.00000E+00,-0.84679E+01, - C 0.25115E+13, 0.62770E+00, 0.25215E+13,-0.42580E+00, 0.25415E+13, - C-0.72950E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.11346E+02, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.12784E+01, 0.25615E+13, 0.91120E+00, 0.25225E+13, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.32608E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00,-0.55856E+01, 0.25425E+13,-0.34430E+00, - C 0.25625E+13, 0.12970E+00/ - DATA IRM,TLBX/-1,-27.0/ - DATA WN,WPIC,EPIMM,QB/938.256,139.65,0.0,0.0/ - DATA WPI,ZXM/135.04,0/ - SAVE - IF(TLBX.NE.-27.0) GO TO 10 - IPRK=IPRKX - GOM1=CCS(1) - GOM2=CCS(2) - GPI2=CCS(3) - GP1=CCS(4) - GP2=CCS(5) - DO 51 M=1,6 - DO 51 J=1,2 - DO 51 L=1,6 - NF(M,J,L)=0 - IF(L.GT.2) NF(M,J,L)=3 - EMR(M,J,L)=0.0 - EMI(M,J,L)=0.0 - EMPI(M,J,L)=0.0 - DO 51 K=1,15 - 51 PEM(K,M,J,L)=0.0 - DO 54 N=1,13 - 54 NTL(N)=NTC(N) - I=1 - 52 Z=PP(I)/1.E8 - NL=Z+0.1 - NFM=NL/1000 - NL=NL-1000*NFM - M=NL/100 - NL=NL-100*M - J=NL/10 - L=NL-10*J - NF(M,J,L)=NFM - K=0 - 53 I=I+1 - IF(I.GT.IMX) GO TO 10 - IF(PP(I).GT.1.E8) GO TO 52 - K=K+1 - PEM(K,M,J,L)=PP(I) - GO TO 53 -C 10 CONTINUE - 10 IF(TLB.EQ.TLBX.AND.IR.EQ.IRM) GO TO 97 - TLBX=TLB - IRM=IR - CALL PRKIN(TLB,IR,EPI,ZKCM,QCM) - EPX=EPI - IF(EPX.LT.0.0) EPX=0.0 - IF(EPX.EQ.EPIMM) GO TO 25 - EPIMM=EPX - S=(WN+WPIC)**2+2.0*WN*EPX - QB=WN*SQRT(EPX*(EPX+2.0*WPIC)/S) - CALL PRKIN(TLB,1,EPZ,ZKZ,Q0) - IF(IPRK.NE.1) EPZ=EPX - IF(EPZ.LT.0.5) EPZ=0.5 - CALL PNFIXD(EPX,0,TPNR,TPNI,TTLPN) - CALL PRBORN(TLB,EMPI,5) - 25 DO 11 MM=1,6 - DO 11 JJ=1,2 - DO 11 LL=1,6 - NNF=NF(MM,JJ,LL) - NROT=NNF/10 - NNF=NNF-10*NROT - DER=0. - DEI=0. - IF(QCM.LE.0.0) GO TO 12 - IF(NNF.LE.0) GO TO 12 - IF(NNF.GT.10) GO TO 12 - N=2 - IF(MM.GT.2) N=0 - N=N+JJ - IF(N.EQ.1.AND.LL.EQ.1) GO TO 12 - IF(N.EQ.3.AND.LL.EQ.1) GO TO 12 - TER=TPNR(N,LL) - TEI=TPNI(N,LL) -c mjl=100*mm+10*jj+ll-1 -C if(mjl.eq.320) write(*,224) tlb,ir,epx,epz -C 224 format(f8.2,i3,2f9.3) - 13 BRN=EMPI(MM,JJ,LL) - Z=EPX/WPI - IF(NNF.GT.4) Z=EPX/(EPX+800.0) - QK=QB/ZKCM - NEO=0 - IF(NNF.EQ.2) NEO=2 - IF(NNF.EQ.3) NEO=2 - IF(NNF.EQ.5) NEO=4 -C SUPPRESS ZR,ZB AT THRESHOLD BY QK**NEO - ZR=0.0 - IF(QB.LE.0.0) GO TO 24 - ZR=Z*(PEM(6,MM,JJ,LL)+Z*(PEM(7,MM,JJ,LL)+Z*PEM(8,MM,JJ,LL))) - ZR=(ZR+PEM(5,MM,JJ,LL))*WPI/QB - IF(LL.EQ.1) GO TO 24 - ZZ=1.0/QK - IF(IPRK.EQ.1) ZZ=QCM*ZKCM/QB**2 - ZR=ZR*ZZ**(LL-1) - 24 IF(NNF.GT.2) GO TO 1 - ZB=Z*(PEM(2,MM,JJ,LL)+Z*(PEM(3,MM,JJ,LL)+Z*PEM(4,MM,JJ,LL))) - ZB=ZB+PEM(1,MM,JJ,LL) - IF(LL.GT.1) ZB=ZB*QK**(LL-1) - GO TO 3 - 1 WX=2.0*WPI - ZX=SQRT(QCM**2+WX**2)/QCM - IF(ZX.NE.ZXM) CALL QJOFX(QL,ZX,8) - ZXM=ZX - ZB=PEM(1,MM,JJ,LL)*QL(LL)+PEM(2,MM,JJ,LL)*QL(LL+1) - ZB=ZX*(ZB+PEM(3,MM,JJ,LL)*QL(LL+2)+PEM(4,MM,JJ,LL)*QL(LL+3)) - 3 IF(NEO.GT.0) ZB=ZB*QK**NEO - IF(NEO.GT.0) ZR=ZR*QK**NEO - ZB=ZB+BRN - IF(LL.EQ.1) GO TO 32 - ZZ=1.0 - IF(IPRK.NE.1) GO TO 33 - ZZ=QCM/Q0 - 33 ZB=ZB*ZZ**(LL-1) - 32 DER=ZB*(1.0-TEI)+ZR*TER - DEI=ZB*TER+ZR*TEI - ZPR=PEM(9,MM,JJ,LL)+Z*PEM(10,MM,JJ,LL) - ZPI=PEM(11,MM,JJ,LL)+Z*PEM(12,MM,JJ,LL) - SGR=TEI-TER**2-TEI**2 - IF(SGR.LE.0.0001) GO TO 12 - IF(NROT.NE.2) GO TO 2 - DER=DER+ZPR*SGR - DEI=DEI+ZPI*SGR - GO TO 12 - 2 ZPR=ZPR*SGR*0.0174532 - Z=DEI - S=SIN(ZPR) - C=COS(ZPR) - DEI=C*Z+S*DER - DER=C*DER-S*Z - 12 EMR(MM,JJ,LL)=DER - EMI(MM,JJ,LL)=DEI -C if(mjl.ne.320) go to 11 -C write(*,223) tlb,epz,ir,iprk,ter,tei,zr,zb,brn,der,dei -C 223 format(2f7.2,2i3,/7f9.4) - 11 CONTINUE - 97 RETURN - END -C ****************************************************** - SUBROUTINE PNFIXD(EX,IRR,TRZ,TIZ,NTL) -C Get SAID partial waves. Parameters are in DATA statements -C E is Tlab(MeV), IR=0(PiN),1(Pi+P),2(Pi-P),3(Cxs) -C T(N,L) is PW for l=L-1, and N=1(I=1/2,J-), 2(I=1/2,J+),3(I=3/2,J-) -C and 4(I=3/2,J+) eg (N,L)=(2,1) for S11, (4,1) for S31, (4,2) for P33 -C (1,4) for F15 ....... -C NTL is set on 1st call and is a "title" for the SAID solution encoded - DIMENSION PP(309),NNTL(13),PP1(70),PP2(70),PP3(70),PP4(70) - C,PP5(29) - DIMENSION TR(4,8),TI(4,8),NFM(4,8),P(30,4,8),TRZ(4,8),TIZ(4,8) - DIMENSION NTL(13),W1(3),W2(3),DW2(3),V(8,3),VI(8,3),BPL(8) - CHARACTER HTL*52 - EQUIVALENCE (PP,PP1),(PP(71),PP2),(PP(141),PP3) - C,(PP(211),PP4),(PP(281),PP5) - DATA HTL/'FA01 606075 47250/23862 P+=22177/10447 P-=19250/ 955'/ - DATA IMX/309/ - DATA PP1/ 0.12100E+11, 0.41288E+00,-0.13924E+01, 0.13877E+01, - C 0.31046E+00, 0.17271E+04, 0.00000E+00, 0.17986E+01,-0.11787E+01, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.74568E+00, 0.00000E+00, 0.72014E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.17839E+02, 0.42738E+02, - C 0.00000E+00, 0.00000E+00, 0.29133E+00,-0.12634E+03,-0.17319E+04, - C-0.34065E+00, 0.43100E+11, 0.55000E+03, 0.14100E+11,-0.23745E+00, - C-0.40815E+01, 0.24988E+01, 0.45263E+01, 0.00000E+00,-0.69706E+01, - C 0.19502E+02,-0.32668E+02, 0.64469E+02, 0.20457E+01, 0.11200E+11, - C-0.14944E+01, 0.14949E+02,-0.20730E+02, 0.87321E+01, 0.00000E+00, - C 0.56328E+01,-0.41320E+01, 0.23247E+01, 0.13954E+00, 0.13365E+01, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.76876E+01, 0.73057E+01, - C 0.18855E+00, 0.12200E+11,-0.55000E+00, 0.71356E-01,-0.23340E+01, - C 0.77392E+01, 0.00000E+00,-0.54956E+01, 0.12286E+02,-0.40895E+01, - C 0.12199E+02/ - DATA PP2/ 0.13200E+11,-0.10257E+01, 0.14949E+01,-0.17620E+02, - C 0.21060E+02, 0.00000E+00,-0.73219E+01, 0.12156E+02, 0.00000E+00, - C 0.40128E+01, 0.14200E+11, 0.20881E+01,-0.35999E+01, 0.20928E+00, - C 0.00000E+00, 0.13799E+04, 0.26112E+01,-0.17167E+01, 0.41016E+01, - C-0.25959E+01, 0.84030E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.18774E+01, 0.12122E+01, 0.11300E+11, 0.77035E+00, 0.40153E+00, - C-0.16197E+00, 0.00000E+00, 0.00000E+00, 0.82027E+01, 0.00000E+00, - C-0.84116E+02, 0.16688E+03, 0.64067E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.77289E+00, 0.00000E+00, - C 0.17007E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97351E+00, - C 0.12300E+11, 0.64725E+00,-0.10737E+01, 0.17166E+01,-0.24625E+00, - C 0.00000E+00, 0.55684E+00, 0.56053E+01,-0.43311E+02, 0.70823E+02, - C 0.11410E+01/ - DATA PP3/ 0.13300E+11, 0.31341E+00,-0.15511E+01, 0.12276E+01, - C 0.00000E+00, 0.00000E+00, 0.20157E+01, 0.34136E+00,-0.96421E+01, - C 0.16231E+02, 0.10519E+01, 0.14300E+11,-0.41618E+00, 0.55328E-01, - C 0.40027E+00, 0.00000E+00, 0.00000E+00,-0.11796E+01, 0.22979E+01, - C-0.12290E+02, 0.15086E+02, 0.00000E+00,-0.82172E+00, 0.11400E+11, - C 0.27747E+00, 0.12220E+01, 0.24501E+00,-0.47759E+00, 0.00000E+00, - C 0.88028E+01, 0.00000E+00,-0.11498E+03, 0.16499E+03, 0.91327E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.12633E+00,-0.92953E+02,-0.17944E+04, 0.12400E+11,-0.72357E-01, - C 0.12544E-02, 0.68633E-01, 0.00000E+00, 0.00000E+00, 0.81698E+00, - C 0.00000E+00, 0.15558E+02,-0.13594E+02, 0.13400E+11, 0.38952E-01, - C-0.92170E+00, 0.58149E+00, 0.00000E+00, 0.00000E+00, 0.17256E+01, - C 0.00000E+00/ - DATA PP4/-0.14663E+02, 0.19257E+02, 0.10322E+01, 0.14400E+11, - C 0.53698E+00,-0.58597E+00, 0.22586E+01, 0.00000E+00, 0.00000E+00, - C-0.17342E+01, 0.52315E+01,-0.19563E+02, 0.22496E+02, 0.11500E+11, - C 0.15721E+00, 0.89538E+00,-0.10520E+00, 0.00000E+00, 0.00000E+00, - C 0.14820E+01, 0.00000E+00,-0.79882E+01, 0.74380E+01, 0.12500E+11, - C 0.22720E+00,-0.62682E+00, 0.63407E+00, 0.00000E+00, 0.00000E+00, - C 0.10044E+01, 0.00000E+00,-0.51328E+01, 0.49378E+01, 0.13500E+11, - C 0.12831E+00,-0.83336E+00, 0.59115E+00, 0.00000E+00, 0.00000E+00, - C 0.83169E+00, 0.14500E+11,-0.68775E-01, 0.12994E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.78717E+00, 0.11600E+11, - C 0.17199E+00, 0.10118E+01,-0.18166E+01, 0.34438E+01, 0.00000E+00, - C 0.33512E+01, 0.00000E+00, 0.30161E+02,-0.22767E+02, 0.12600E+11, - C 0.87780E-01,-0.10616E+01, 0.20919E+01,-0.11497E+01, 0.13600E+11, - C 0.10591E+00,-0.33431E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.67893E+00/ - DATA PP5/ 0.14600E+11, 0.23625E+00, 0.53320E+00,-0.16009E+01, - C 0.12428E+01, 0.00000E+00, 0.47710E+00, 0.11700E+11, 0.18644E+00, - C 0.19469E+00, 0.12700E+11, 0.18686E+00,-0.37530E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.54649E+00, 0.13700E+11, - C 0.14004E+00, 0.22806E+00,-0.47070E+00, 0.00000E+00, 0.00000E+00, - C 0.76494E+00, 0.14700E+11, 0.10472E+00, 0.48230E+00,-0.30032E+00/ - DATA W1/139.65,139.65,938.256/ - DATA W2/938.256,1212.0,547.3/ - DATA DW2/1.0,102.0,0.01/ - DATA NNL,NCH,WI,WT/8,3,139.65,938.256/ - DATA IRM,EM,S11L,NSTRT/-1,0.0,0.0,0/ - DATA WSUB,ETH/150.0,5.0/ - SAVE - IF(NSTRT.EQ.1) GO TO 1 - DO 51 L=1,8 - DO 51 N=1,4 - NFM(N,L)=0 - TR(N,L)=0.0 - TI(N,L)=0.0 - DO 51 J=1,30 - 51 P(J,N,L)=0.0 - NSTRT=1 - DO 54 N=1,13 - 54 NTL(N)=NNTL(N) - I=1 - 52 Z=PP(I)/1.E8 - NL=Z+0.1 - NF=NL/100 - NL=NL-100*NF - N=NL/10 - L=NL-10*N -C IF(N.EQ.3.AND.L.EQ.1) NF=0 - NFM(N,L)=NF - J=0 - 53 I=I+1 - IF(I.GT.IMX) GO TO 1 - IF(PP(I).GT.1.E8) GO TO 52 - J=J+1 - P(J,N,L)=PP(I) - IF(J.EQ.1.AND.N.EQ.3.AND.L.EQ.1) WSUB=PP(I) - GO TO 53 - 1 E=EX - IF(E.LT.ETH) E=ETH - IF(EM.NE.E) IRM=-27 - IF(TR(2,1).NE.S11L) IRM=-27 - IF(IRR.EQ.IRM) GO TO 98 - IRM=IRR - IR=IRR - IF(IR.GT.3) IR=IR-3 - EM=E - TLB=E - DO 55 L=1,8 - DO 55 N=1,4 - TR(N,L)=0.0 - 55 TI(N,L)=0.0 - IF(IR.LT.0.OR.IR.GT.3) GO TO 99 -C SMALLEST ENERGIES SEEM TO BREED TROUBLE -C IF(TLB.LT.0.2) GO TO 99 - W=SQRT((WI+WT)**2+2.*TLB*WT) - QPQ=(W**2-1074.7**2)*(W**2-804.6**2) - QPQ=SQRT(QPQ/(W**2-(WI+WT)**2)/(W**2-(WT-WI)**2)) - DO 7 N=1,NCH - WSU=W1(N)+W2(N) - WC=WI+WT+140.0 - IF(N.EQ.1) WC=WSU-WSUB - GU=-DW2(N)/2. - IF(N.EQ.1.) GU=0. - WIM=0.0 - 13 CALL CMFN(W,WIM,WC,WSU,GU,NNL,V(1,N),VI(1,N)) - IF(V(1,N).NE.0.0) GO TO 7 - WIM=WIM+1.0 - GO TO 13 - 7 CONTINUE - ETA=IR - IF(ETA.GT.1.0) ETA=-1.0 - XKMEV=SQRT(TLB*(TLB+2.0*WI)/((1.0+WI/WT)**2+2.0*TLB/WT)) - IF(IR.EQ.3) XKMEV=XKMEV*SQRT(QPQ) - XKM=197.32/XKMEV - PZR=SQRT(XKMEV**2+W2(1)**2) - QZR=SQRT(XKMEV**2+W1(1)**2) - ETA=ETA*.007297348*(QZR*PZR+XKMEV**2)/XKMEV/(PZR+QZR) -C PUT COULOMB BARRIER FACTORS INTO VI(L,5) 8/26/82 ARNDT - IF(ETA.GT.100.) ETA=100. - Z=2.*3.1415927*ETA - BL=1. - IF(ETA.NE.0.) BL=Z/(EXP(Z)-1.) - Z=0. - ZZ=SQRT(QPQ) - DO 8 L=1,NNL - BPL(L)=BL - Z=Z+1. - IF(IR.NE.3) GO TO 8 - BPL(L)=SQRT(BL)*ZZ - ZZ=ZZ*QPQ - 8 BL=BL*(1.+(ETA/Z)**2) - DO 9 LL=1,NNL - DO 9 NN=1,4 - NNF=NFM(NN,LL) - TRX=0. - TIX=0. - NL=10*NN+LL-1 - IF(NN.EQ.1.AND.LL.EQ.1) GO TO 9 - IF(NN.EQ.3.AND.LL.EQ.1) GO TO 9 - IF(NNF.EQ.1) CALL TMCM(TLB,NL,IRR,P(1,NN,LL),V,VI,TRX,TIX) -C ENCODE C-M K-MTX FIT FOR FORM 4 9/23/81 ARNDT - IF(NNF.EQ.1) GO TO 14 - IF(NNF.LT.3.OR.NNF.GT.6) GO TO 10 - BL=BPL(LL) - IF(BL.EQ.0.0) BL=1.0 - CER=V(LL,1) - CEI=VI(LL,1) - LI=LL - IF(NN.EQ.1.OR.NN.EQ.3) LI=LL-2 - IF(LI.LT.1) LI=LI+2 - IF(LL.EQ.1) LI=3 - NIL=2 - IF(NIL.GT.NCH) NIL=NCH - CIR=V(LI,NIL) - CII=VI(LI,NIL) - WTH=W1(1)+W2(1) - WPITH=WTH+140. - WCM=SQRT(WTH**2+2.*W2(1)*TLB) - Z=(WCM-WPITH)/1000. - ZZ=1. - ZE=0.0 - WKP=P(5,NN,LL) - DRL=1.0 -C MASS-SPLIT K-MTX POLE PIECE FOR P33 1/95 ARNDT - IF(WKP.EQ.0.0) GO TO 34 - DWK=P(18,NN,LL)/2.0 - IF(NL.NE.41) DWK=0.0 - IF(BL.GT.1.0001) WKP=WKP+DWK - IF(BL.LT.0.9999) WKP=WKP-DWK - ZZ=WKP-WTH - DRL=WKP-WCM - DGK=P(17,NN,LL)/2.0 - IF(DWK.EQ.0.0) DGK=0.0 - IF(DGK.EQ.0.0) GO TO 34 - IF(BL.GT.1.0001) ZE=DGK - IF(BL.LT.0.9999) ZE=-DGK - 34 CONTINUE - IF(NNF.GT.2) Z=(WCM-WTH)/1000.0 - LIP=LI+2 - IF(LIP.GT.8) LIP=LIP-2 - DO 12 J=1,4 - ZE=ZE+P(J,NN,LL)*ZZ - 12 ZZ=ZZ*Z - ZEI=0. - DIM=0. - DO 31 J=1,3 - IF(J.NE.3) GO TO 33 - CIR=V(LIP,2) - CII=VI(LIP,2) - IF(NNF.EQ.3.OR.NNF.EQ.5) GO TO 33 - CIR=V(LL,3) - CII=VI(LL,3) - 33 CONTINUE -C IF(CII.LT.0.0) CII=0.0 - K=2+4*J - Z0=Z*P(K,NN,LL)+Z**2*P(K+1,NN,LL) - IF(Z0.EQ.0.0) GO TO 31 - ZZ=P(K+2,NN,LL)+Z*P(K+3,NN,LL) - IF(NNF.GT.4) ZZ=ZZ*Z - DIR=1.0-CIR*ZZ - DII=-CII*ZZ - Z2R=Z0**2*CIR - Z2I=CII*Z0**2 - ZZ=Z2R - Z2R=ZZ*DRL-Z2I*DIM - Z2I=ZZ*DIM+Z2I*DRL - ZZ=ZE - ZE=ZE*DIR-ZEI*DII+Z2R - ZEI=ZZ*DII+ZEI*DIR+Z2I - ZZ=DRL - DRL=DRL*DIR-DIM*DII - DIM=ZZ*DII+DIM*DIR - 31 CONTINUE - DRL=DRL-CER*ZE+CEI*ZEI - DIM=DIM-CER*ZEI-CEI*ZE - D2=DRL**2+DIM**2 - Z=CEI/D2 - TRX=Z*(ZE*DRL+ZEI*DIM) - TIX=Z*(ZEI*DRL-ZE*DIM) - 14 IF(IRR.GT.3) BL=1.0 - IF(BL.EQ.1.0) GO TO 11 - IF(BL.GT.1.0.AND.NL.EQ.41) CALL ETA33(TLB,TRX,TIX) - CALL PWCC(TLB,TRX,TIX,NL,BL,NFM(3,1),IRR) - 11 IF(TIX.GE.1.0) TRX=0.0 - IF(TIX.GT.1.0) TIX=1.0 - IF(NNF.NE.1) CALL ADDRES(E,TRX,TIX,NL,P(19,NN,LL)) - IF(TIX.GE.TRX**2+TIX**2) GO TO 10 - D2=1.0+TRX**2+TIX**2-2.0*TIX - IF(D2.LT.1.E-20) WRITE(7,224) TLB,WCM,TRX,TIX - 224 FORMAT(' TLB, WCM=',2F8.2,' TR,TI=',2F9.5) - IF(D2.LT.1.E-20) GO TO 10 - Z=TRX/D2 - TRX=Z/(1.+Z**2) - TIX=Z*TRX - 10 TR(NN,LL)=TRX - 9 TI(NN,LL)=TIX - S11L=TR(2,1) - IF(WI.GT.150.0) GO TO 98 - IF(NFM(3,1).NE.4) GO TO 98 -C add in f13 corrections for S11, P13 ONLY for TROMBERG - L=1 - CALL TROMF13(TLB,L,IR,TR(2,L),TI(2,L),TR(4,L),TI(4,L)) - L=2 - CALL TROMF13(TLB,L,IR,TR(2,L),TI(2,L),TR(4,L),TI(4,L)) - S11L=TR(2,1) - 98 Z=1.0 - IF(EX.LT.ETH) Z=EX/ETH - ZZ=SQRT(Z) - DO 97 L=1,8 - IF(L.GT.1) ZZ=ZZ*Z - DO 97 N=1,4 - TRZ(N,L)=TR(N,L) - TIZ(N,L)=TI(N,L) - IF(Z.EQ.1.0) GO TO 97 - TRZ(N,L)=ZZ*TR(N,L) - TIZ(N,L)=TRZ(N,L)**2 - 97 CONTINUE - 99 RETURN - END -C ********************************************************* - SUBROUTINE TMCM(TLB,NL,IRR,P,V,VI,TRX,TIX) -C Coupled-Channel CM-K-mtx for FORM=1 9/3/01 RAA - DIMENSION V(8,3),VI(8,3),P(30) - DIMENSION TRL(10),TIM(10),ARC(10),AIC(10),RR(20),RI(20) - C,CCR(4),CCI(4),RH(4) - DATA WI,WT/139.65,938.256/ - SAVE - NN=NL/10 - LL=NL-10*NN+1 - IRX=IRR - IF(IRR.GT.3) IRX=IRR-3 -C ??? don't know WHAT this is - WSE=WI+WT - WRL=SQRT(WSE**2+2.0*WT*TLB) -C do 4x4 K-matrix to channels pipi, pid, pieta(or pid+) -C P= K11(4), WkP, K12(2), K22(2), K13(2), K23(2), K33(2) -C K14(2), K24(2), K34(2), K44(2), dWk, dGk, addres(4) - LI=LL - IF(NN.EQ.1.OR.NN.EQ.3) LI=LL-2 - IF(LI.LT.1) LI=LI+2 - IF(LL.EQ.1) LI=3 - LIP=LI+2 - ZZR=(WRL-WSE)/1000.0 - Z2R=ZZR**2 - WKP=P(5) - IF(IRX.EQ.2.OR.IRX.EQ.3) WKP=WKP+P(25) - WKPR=1.0 - IF(WKP.NE.0.0) WKPR=(WKP-WRL)/1000.0 - NCX=4 - IF(NN.GT.2) NCX=3 - JMX=NCX*(NCX+1) - JMX=JMX/2 - DO 2 J=2,JMX - K=2*J+2 - ZR=P(K)*ZZR+P(K+1)*Z2R - IF(J.LT.7.OR.J.GT.9) GO TO 2 - ZR=P(K)+(WRL/1000.0-1.4)*P(K+1) - 2 ARC(J)=ZR*WKPR - ZR=1.0 - GE=0.0 - IF(WKP.EQ.0.0) GO TO 9 - ZR=(WKP-WSE)/1000.0 - IF(IRX.EQ.2.OR.IRX.EQ.3) GE=P(24)/1000.0 - 9 DO 3 K=1,4 - GE=GE+P(K)*ZR - 3 ZR=ZR*ZZR - ARC(1)=GE - IF(ARC(7).EQ.0.0) NCX=3 - IF(ARC(4).EQ.0.0.AND.NCX.EQ.3) NCX=2 - IF(ARC(2).EQ.0.0.AND.NCX.EQ.2) NCX=1 - JD=1 - CRX=V(LL,1) - CIX=VI(LL,1) - DO 4 J=1,NCX - IF(J.EQ.2) CRX=V(LI,2) - IF(J.EQ.2) CIX=VI(LI,2) - IF(J.EQ.3) CRX=V(LIP,2) - IF(J.EQ.3) CIX=VI(LIP,2) - IF(J.EQ.4) CRX=V(LL,3) - IF(J.EQ.4) CIX=VI(LL,3) - CCR(J)=CRX - CCI(J)=CIX - DO 5 K=1,J - TRL(JD)=-ARC(JD) - TIM(JD)=0.0 - 5 JD=JD+1 - D2=CRX**2+CIX**2 - TRL(JD-1)=WKPR*CRX/D2-ARC(JD-1) - TIM(JD-1)=-WKPR*CIX/D2 - 4 CONTINUE - CALL CMSINV(TRL,TIM,RR,RI,NCX) - JK=1 - DO 6 J=1,NCX - JD=J*(J-1) - JD=JD/2 - RH(J)=CCI(J) - IF(RH(J).LT.0.0) RH(J)=0.0 - RH(J)=SQRT(RH(J)) - DO 6 K=1,J - KD=K*(K-1) - KD=KD/2 - ZR=0.0 - ZI=0.0 - DO 7 M=1,NCX - MD=M*(M-1) - MD=MD/2 - JM=JD+M - IF(M.GT.J) JM=MD+J - MK=KD+M - IF(M.GT.K) MK=MD+K - ZR=ZR+ARC(JM)*RR(MK) - ZI=ZI+ARC(JM)*RI(MK) - 7 CONTINUE - DCR=CCR(K) - DCI=CCI(K) - D2=DCR**2+DCI**2 - TRX=RH(J)*RH(K)*(DCR*ZR+DCI*ZI)/D2 - TIX=RH(J)*RH(K)*(DCR*ZI-DCI*ZR)/D2 - IF(IRX.LT.5) GO TO 8 - IF(JK.EQ.7) GO TO 99 - 6 JK=JK+1 - 8 KP1=26 - CALL ADDRES(TLB,TRX,TIX,NL,P(KP1)) - IF(IRX.GT.1.AND.NL.EQ.41) CALL ETA33(TLB,TRX,TIX) -C KILL BARRIER FACTOR IF HADRONIC IS NEEDED - if(nl.ne.41) go to 99 - 99 RETURN - END -C ********************************************************* - SUBROUTINE CMSINV(AR,AI,AIR,AII,N) - DIMENSION AR(10),AI(10),AIR(20),AII(20),WR(60),WI(60) - SAVE -C INVERT COMPLEX-SYMMETRIC MATRIX -C MATRICES ARE STORED A11,A12,A22,A13,... N=ORDER OF MATRIX -C G=INV OF DIAGONAL ELEMENT (M) M=SINGULAR ORDER W=WORKING SPACE - M=0 - JD=0 - GR=0.0 - GI=0.0 - 1 M=M+1 - JD=JD+M - GR=AR(JD) - GI=AI(JD) - IF(M.EQ.1) GO TO 2 - MM=M-1 - CALL MCMCV(AIR,AII,AR(JD-MM),AI(JD-MM),WR,WI,MM) - JJ=JD-M - DO 3 K=1,MM - JJ=JJ+1 - GR=GR-AR(JJ)*WR(K)+AI(JJ)*WI(K) - 3 GI=GI-AR(JJ)*WI(K)-AI(JJ)*WR(K) - 2 D2=GR**2+GI**2 - IF(D2.LT.1.E-9) D2=1.E-9 -C Note!! This is to take care of SINGULAR K-mtx 9/12/01 RAA - GR=GR/D2 - GI=-GI/D2 - AIR(JD)=GR - AII(JD)=GI - IF(M.EQ.1) GO TO 5 - J0=1 - DO 4 J=1,MM - ZR=GR*WR(J)-GI*WI(J) - ZI=GR*WI(J)+GI*WR(J) - KK=JD-M+J - AIR(KK)=-ZR - AII(KK)=-ZI - DO 4 K=1,J - ZZR=ZR*WR(K)-ZI*WI(K) - ZZI=ZR*WI(K)+ZI*WR(K) - AIR(J0)=AIR(J0)+ZZR - AII(J0)=AII(J0)+ZZI - 4 J0=J0+1 - 5 IF(M.LT.N) GO TO 1 - RETURN - END -C ********************************* - SUBROUTINE MCMCV(AR,AI,VR,VI,PR,PI,N) -C MULTIPLY COMPLEX MATRIX(A) ON COMPLEX VECTOR(V) TO GET PRODUCT(P) - DIMENSION AR(20),AI(20),VR(20),VI(20),PR(20),PI(20) - J0=0 - DO 1 J=1,N - ZR=0.0 - ZI=0.0 - DO 2 I=1,J - IJ=J0+I - ZR=ZR+AR(IJ)*VR(I)-AI(IJ)*VI(I) - 2 ZI=ZI+AR(IJ)*VI(I)+AI(IJ)*VR(I) - IF(J.GE.N) GO TO 3 - JP=J+1 - DO 4 I=JP,N - IJ=I*(I-1) - IJ=IJ/2+J - ZR=ZR+AR(IJ)*VR(I)-AI(IJ)*VI(I) - 4 ZI=ZI+AR(IJ)*VI(I)+AI(IJ)*VR(I) - 3 PR(J)=ZR - PI(J)=ZI - 1 J0=J0+J - RETURN - END -C ******************************************* - SUBROUTINE PWCC(TLB,TRX,TIX,NL,BL,NCC,IRZ) - DATA WI,PI/139.65,3.1415927/ -C NCC=5(NO CC), 4(Nordita S,P waves Tl<500), 6(Barrier+"h") -C otherwise use "Barrier" multiplication of K(Hadronic) - IF(TLB.LT.0.5) GO TO 99 - IF(BL.EQ.1.) GO TO 99 - IF(NCC.EQ.5) GO TO 99 - IF(NCC.LT.6) GO TO 2 -C Try adding "H" correction to Eff-Rng Charge-corrections 5/8/00 - T2=TRX**2+TIX**2 - D2=1.0+T2-2.0*TIX - ZHR=TRX/D2 - ZHI=(TIX-T2)/D2 - B=SQRT(TLB*(TLB+2.0*WI))/(TLB+WI) - E=1.0/B/137.06 - IF(BL.GT.1.0) E=-E - h=0.0 - XX=0.0 - Z=1.0 - DO 3 J=1,10 - XX=XX+1.0/Z/(1.0+(E/Z)**2) - 3 Z=Z+1.0 - Z=2.0*PI*E - IF(Z.GT.80.0) Z=80.0 - C2=Z/(EXP(Z)-1.0) - H=2.0*E*(E**2*XX-0.57721-ALOG(ABS(E)))*BL/C2 - IF(NCC.EQ.7) H=0.0 - ZHR=ZHR - ZHI=ZHI - DR=1.0-ZHR*H - DI=-ZHI*H - D2=DR**2+DI**2 - ZCR=BL*(ZHR*DR+ZHI*DI)/D2 - ZCI=BL*(ZHI*DR-ZHR*DI)/D2 - Z2=ZCR**2+ZCI**2 - D=1.0+Z2+2.0*ZCI - TRX=ZCR/D - TIX=(ZCI+Z2)/D - GO TO 99 - 2 CONTINUE - IF(NCC.NE.4.AND.NCC.NE.2) GO TO 1 -C Nordita corrections to S,P waves for Tl<550, otherwise Barrier - IF(TLB.GE.535.0) GO TO 1 - NN=NL/10 - LL=NL-10*NN+1 - IF(LL.GT.NCC/2) GO TO 1 -C Nordita for S-waves(NNC=2), or S+P-waves(NCC=4) -C Use Barrier factors for all but S-waves MP 5/16/00 Nuts!! - DD=0.0174532*DTROMB(NL,IRZ,TLB) - S=SIN(DD) - C=COS(DD) - TCR=S*C - TCI=S**2 - SR=1.0-2.0*TIX - SI=2.0*TRX - TRX=TRX+SR*TCR-SI*TCI - TIX=TIX+SR*TCI+SI*TCR - GO TO 99 - 1 DR=1.-TIX*(1.-BL) - DI=TRX*(1.-BL) - D2=(DR**2+DI**2)/BL - Z=TRX - TRX=(Z*DR+TIX*DI)/D2 - TIX=(TIX*DR-Z*DI)/D2 - 99 RETURN - END -C *************************************** - FUNCTION DTROMB(NL,IS,T) -C DO QUADRATIC TABLE LOOKUP OF TROMBERG PHASES -C K=1(S31),2(P31),3(P33) Pi+P -C 4(S11),5(S31),6(P31),7(P13),8(P33) Pi-P/CXS -C n.b.!! corrections adjusted so corr = del_nuc - del_had -C (Tromborg had -1/3, -2/3 factors for I=3,1 pi- corrections) -C TI = 10(25)535 MEV -C modified June 16/00 by M.M. Pavan -c Aug 21/01 by MMP include P31- (Helv.Phys.Acta51,584,1978) - DIMENSION F(176) - DATA F/0.110, 0.093, 0.091, 0.100, 0.100, 0.110, 0.121, 0.120 - + , 0.131, 0.130, 0.130, 0.130, 0.130, 0.132, 0.136, 0.139 - + , 0.141, 0.143, 0.143, 0.143, 0.142, 0.140 - + , 0.010, 0.012, 0.024, 0.040, 0.049, 0.068, 0.074, 0.090 - + , 0.092, 0.105, 0.116, 0.124, 0.129, 0.135, 0.141, 0.148 - + , 0.156, 0.164, 0.173, 0.182, 0.192, 0.202 - + ,-0.043,-0.120,-0.277,-0.517,-0.870,-1.287,-1.450,-1.117 - + ,-0.616,-0.229, 0.009, 0.153, 0.234, 0.289, 0.310, 0.317 - + , 0.327, 0.329, 0.324, 0.312, 0.292, 0.265 - + , 0.238, 0.177, 0.129, 0.096, 0.069, 0.042, 0.016, 0.000 - + ,-0.010,-0.024,-0.030,-0.041,-0.057,-0.070,-0.081,-0.091 - + ,-0.100,-0.109,-0.117,-0.123,-0.129,-0.134 - + ,-0.206,-0.145,-0.111,-0.098,-0.090,-0.084,-0.082,-0.080 - + ,-0.076,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.061 - + ,-0.058,-0.055,-0.052,-0.049,-0.046,-0.043 - + ,-0.022,-0.051,-0.076,-0.096,-0.112,-0.126,-0.135,-0.144 - + ,-0.152,-0.160,-0.170,-0.179,-0.187,-0.195,-0.202,-0.208 - + ,-0.215,-0.220,-0.224,-0.229,-0.232,-0.235 - + ,-0.007,-0.021,-0.038,-0.057,-0.072,-0.092,-0.103,-0.114 - + ,-0.129,-0.139,-0.151,-0.161,-0.176,-0.194,-0.215,-0.236 - + ,-0.253,-0.268,-0.282,-0.295,-0.306,-0.315 - + , 0.154, 0.346, 0.543, 0.746, 0.945, 1.020, 0.737, 0.230 - + ,-0.154,-0.344,-0.405,-0.409,-0.386,-0.358,-0.322,-0.285 - + ,-0.253,-0.223,-0.195,-0.168,-0.143,-0.119/ - SAVE -C-----Initialize - DTROMB=0.0 - K=0 -C-----Ignore if PW not covered by Tromborg - IF(IS.LT.1.OR.IS.GT.3) GO TO 99 - IF(T.GT.550.0) GO TO 99 -C-----Select PW - IF(NL.EQ.40) K=1 - IF(NL.EQ.31.AND.IS.EQ.1) K=2 - IF(NL.EQ.41) K=3 - IF(NL.EQ.20) K=4 - IF(NL.EQ.40.AND.IS.GT.1) K=5 - IF(NL.EQ.31.AND.IS.GT.1) K=6 - IF(NL.EQ.21.AND.IS.GT.1) K=7 - IF(NL.EQ.41.AND.IS.GT.1) K=8 -C-----Ignore if PW not covered by Tromborg - IF(K.EQ.0) GO TO 99 -C-----Find PW and energy TI near energy T -C-----n.b. need 3 points for quadratic interp. - I=(T-10.0)/25.0 - I=I+2 - IF(I.GT.21) I=21 - TI=25*I-15 - I=22*(K-1)+I -c-----Interpolate to energy T using nearest 3 PWs - F0=F(I) - FM=F(I-1)-F0 - FP=F(I+1)-F0 -C WRITE(*,222) T,I,K,TI,F0,FM,FP -C 222 FORMAT(' T=',F5.1,' I,K,TI=',2I3,F6.1,' F0,FM,FP=',3F7.3) - ZM=-25.0 - ZP=25.0 - Z=T-TI - D=ZM*ZP*(ZP-ZM) - A=(ZP**2*FM-ZM**2*FP)/D - B=(ZM*FP-ZP*FM)/D - DTROMB=F0+Z*(A+Z*B) - 99 RETURN - END -C ************************************************************** - SUBROUTINE TROMF13(TL,L,MM,T1R,T1I,T3R,T3I) -C add corrections to S11 and P13 for Tromberg's f13 5/16/01 RAA - DIMENSION P(21),I1(6),NI(6) - DATA P/0.039,0.366,0.4165,0.0,5.112,-44.511,66.85,70.59 - C,-0.1514,-0.211,0.475,9.98,55.499,-54.3 - C,0.0,0.0,-16.82,13482.0,-55386.0,27.6,-36.73/ - DATA I1/1,4,9,12,15,20/ - DATA NI/3,5,3,3,5,2/ - SAVE - IF(TL.GT.550.0) GO TO 99 - IF(L.GT.2) GO TO 99 - IF(MM.LT.2) GO TO 99 - ID=1 - IF(L.GT.1) ID=2 - IF(L.GT.1.AND.TL.GT.250.0) ID=3 - NID=NI(ID) - ID=I1(ID) - IE=4 - IF(L.GT.1) IE=5 - IF(L.GT.1.AND.TL.GT.180.0) IE=6 - NIE=NI(IE) - IE=I1(IE) - Z=TL/1000.0 - ZZ=1.0 - D13=0.0 - DO 1 I=1,NID - D13=D13+P(ID+I-1)*ZZ - 1 ZZ=ZZ*Z - ZZ=1.0 - E13=0.0 - DO 2 I=1,NIE - E13=E13+P(IE+I-1)*ZZ - 2 ZZ=ZZ*Z - E13=E13/10000.0 - D13=0.0174532*D13 -C write(*,222) tl,l,mm,t1r,t1i,t3r,t3i,d13,e13 -C 222 format(f7.2,2i3,' t1=',2f7.4,' t3=',2f7.4,' d13,e13=',2e12.4) - FCT=-1.333333 - IF(MM.EQ.3) FCT=-FCT/2.0 - ZR=E13*FCT - ZI=D13*FCT - D1=ATAN(T1I/(T1R+1.0E-8)) - D3=ATAN(T3I/(T3R+1.0E-12)) - IF(D3.LT.0.0) D3=D3+3.1415927 - ZZR=COS(D1+D3) - ZZI=SIN(D1+D3) - T1R=T1R+ZR*ZZR-ZI*ZZI - T1I=T1I+ZR*ZZI+ZI*ZZR - 99 RETURN - END -C **************************************************** - SUBROUTINE ADDRES(E,TR,TI,NL,P) -C add resonance "bump" to partial-wave 8/94 Arndt - DIMENSION P(30) - DATA WPI,WN/139.65,938.256/ - SAVE - IF(P(2).GT.0.0) GO TO 10 - DRL=1.0 - DIM=0.0 - WR=SQRT((WPI+WN)**2+2.0*WN*E) - WI=0.0 - CALL ADDRES2(WR,WI,DRL,DIM,TR,TI,NL,P) - GO TO 99 - 10 GT=P(2) - GE=P(1)*GT - IF(GE.EQ.0.0) GO TO 99 - GI=GT-GE - IF(GI.LE.0.0) GI=0.0 - ER=P(3) - IF(ER.EQ.0.0) GO TO 99 -C Z=SQRT(2.0*E**2/(E**2+ER**2)) - Z=2.0*E/(ER+E) - RE=SQRT(Z) - N=NL/10 - LE=NL-10*N - IF(LE.LT.0.OR.LE.GT.8) LE=1 - IF(LE.GT.0) RE=RE*Z**LE - RI=(E-150.0)/(ER-150.0) - IF(RI.LT.0.0) RI=0.0 - RI=RE*RI**3 - GE=GE*RE - GI=GI*RI - GT=GE+GI - Z=ER-E - D=Z**2+GT**2 - ZR=GE*Z/D - ZI=GE*GT/D - IF(P(4).EQ.0.0) GO TO 1 - SR=1.0-2.0*ZI - SI=2.0*ZR - Z2=ZR**2+ZI**2 - ZE=P(4)*Z2 - D2=1.0+ZE**2 - ZR=ZR+(SR*ZE-SI*ZE**2)/D2 - ZI=ZI+(SR*ZE**2+SI*ZE)/D2 - 1 SR=1.0-2.0*TI - SI=2.0*TR - TR=TR+SR*ZR-SI*ZI - TI=TI+SR*ZI+SI*ZR - 99 RETURN - END -C ****************************************************** - SUBROUTINE ADDRES2(WR,WI,DRL,DIM,TR,TI,NL,P) -C ADD RESONANCE FOR COMPLEX(WR,WI) ENERGY 10/18/94 ARNDT - DIMENSION P(4) - DATA WE,WIN/1078.0,1218.0/ - SAVE - GT=-P(2) - IF(GT.LT.20.0) GO TO 99 - WRES=ABS(P(3)) - GE=P(1)*GT - GI=GT-GE - IF(GI.LT.0.0) GI=0.0 - GE=GT-GI - N=NL/10 - LE=NL-10*N - D=1.0/(WR**2+WI**2) - ZR=1.0-D*WE*WR - ZIR=1.0-D*WIN*WR - Z=1.0-WE/WRES - ZZ=1.0-WIN/WRES - ZR=ZR/Z - ZIR=ZIR/ZZ - IF(WR.LT.WIN) ZIR=0.0 - IF(WI.EQ.0.0) GO TO 1 - ZI=D*WE*WI/Z - ZII=D*WIN*WI/ZZ - RER=ZR - REI=ZI - CALL SQZ(RER,REI) - RIR=ZIR**2-ZII**2 - RII=ZIR*ZII*2.0 - IF(LE.LT.1) GO TO 2 - DO 3 L=1,LE - Z=RER - RER=Z*ZR-REI*ZI - 3 REI=Z*ZI+REI*ZR - GO TO 2 - 1 REI=0.0 - IF(ZR.LE.0.0) ZR=0.0 - RER=SQRT(ZR) - IF(LE.GT.0) RER=RER*ZR**LE - RIR=ZIR**2 - RII=0.0 - 2 GER=GE*RER - GEI=GE*REI - IF(P(3).GT.0.0) GO TO 8 - ZR=(WR-WE)/(WRES-WE) - ZI=WI/(WRES-WE) - Z=GER - GER=Z*ZR-GI*ZI - GEI=ZR*GEI+Z*ZI - 8 GIR=GI*RIR - GII=GI*RII - GTR=GER+GIR - GTI=GEI+GII - DR=WRES-WR+GTI - DI=-WI-GTR - Z=DRL - DRL=Z*DR-DI*DIM - DIM=Z*DI+DR*DIM - D2=DR**2+DI**2 - TRR=(GER*DR+GEI*DI)/D2 - TRI=(GEI*DR-GER*DI)/D2 - IF(P(4).EQ.0.0) GO TO 5 - SR=1.0-2.0*TRI - SI=2.0*TRR - ZB=P(4)*GER**2/((WRES-WR)**2+GTR**2) - TBR=ZB/(1.0+ZB**2) - TBI=TBR*ZB - TRR=TRR+SR*TBR-SI*TBI - TRI=TRI+SR*TBI+SI*TBR - 5 SR=1.0-2.0*TI - SI=2.0*TR - TR=TR+SR*TRR-SI*TRI - TI=TI+SR*TRI+SI*TRR - 99 RETURN - END -C **************************************************** - SUBROUTINE ETA33(X,TR,TI) - DIMENSION P(4) - DATA P/70.71,160.1,221.0,0.0307/ -C CORRECTS PI-P,CXS P33 FOR N-G CROSS SECTION X=TLAB 11/91 ARNDT - SAVE - BW=P(1)**2/((X-P(2))**2+P(1)**2) - Z=X**2/(X**2+P(3)**2) - YS=P(4)*BW*Z - ETA=1.0-YS - TR=ETA*TR - TI=ETA*TI+(1.0-ETA)/2.0 - RETURN - END -C ********************************************************* - SUBROUTINE PRKIN(E,IRR,EPI,ZKCM,QCM) -C GET PION-PHOTOPRODUCTION KINEMATIC PARAMETERS - COMMON/PRKC/IPRK - DATA WP,WN,WPI0,WPIC/938.256,939.65,135.04,139.65/ - DATA EPIT/10.0/ - SAVE - IR=IRR - IF(IR.EQ.5) IR=1 - WT=WP - IF(IR.GT.2) WT=WN - WX=WP - IF(IR.EQ.2.OR.IR.EQ.4) WX=WN - WPI=WPI0 - IF(IR.EQ.2.OR.IR.EQ.3) WPI=WPIC - ZKCM=E/SQRT(1.0+2.0*E/WT) - S=WT*(WT+2.0*E) - QCM=0.0 - EPI=0.0 - STH=(WPI+WX)**2 - IF(S.LE.STH) GO TO 99 - QCM=SQRT((S-STH)*(S-(WPI-WX)**2)/4.0/S) - EPI=(S-STH)/2.0/WX - IF(IPRK.EQ.1) GO TO 99 -C the following makes Epi dependent upon Wcm and independent of charge -C channel. Generally used for solutions before April 1996. RAA - EPI=(S-(WP+WPIC)**2)/2.0/WP - IF(EPI.GE.EPIT) GO TO 99 - ST=(WP+WPIC)**2+2.0*EPIT*WP - Z=(S-STH)/(ST-STH) -C "STRETCH OUT" THRESHOLD BELOW EPI=10 MEV - EPI=EPIT*Z**2 - 99 RETURN - END -C *********************************************************** - SUBROUTINE PRBORN(EPI,EM,NF) - DIMENSION EM(6,2,6) - SAVE - CALL PROPEC(EPI,EM) - CALL PRNPOL(EPI,EM) - IF(NF.LT.3) GO TO 99 - CALL PREPV(EPI,EM) - CALL PROMEGA(EPI,EM) - IF(NF.LT.5) GO TO 99 - CALL PRRHO(EPI,EM) - 99 RETURN - END -C *********************************************************** - SUBROUTINE PROPEC(EL,EM) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),AA(4),BB(4),CC(4),F(12,4),QT(12) - C,QU(12),EM(6,2,6) - REAL qtmp - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ -C GN=SQRT(ALFA*G2)*HBARC = SQRT(13.75/137)*197.32 - DATA B,GPI2M/0,13.75/ - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 EM(M,J,L)=0.0 - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - GG=1000.0*GN/W - USCL=(W+WN)/2.0/Z1/Z2 - AA(1)=0.0 - AA(2)=0.0 - AA(3)=GG*Z2/Z1 - AA(4)=-GG*Z1*Q/Z2/ZK - BB(1)=-GG*W/Q/USCL/2.0 - BB(2)=GG*W/Z2**2/2.0/USCL - BB(3)=-AA(3) - BB(4)=-AA(4) - GG=GG*USCL - CC(1)=-GG*Z2**2/Q - CC(2)=GG - CC(3)=-GG*Z2**2/WN - CC(4)=-GG*Q/WN - CALL QJOFX(QT,ZT,8) - CALL QJOFX(QU,-ZU,8) - S=-1.0 - DO 11 L=1,8 - QU(L)=S*QU(L) - 11 S=-S - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - A=AA(K) - IF(I.GT.1) A=2.0*A/3.0 - IF(I.NE.2) A=-A - IF(I.EQ.1) B=CC(K)*(UN-UP)-BB(K) - IF(I.EQ.2) B=-(CC(K)*(2.0*UN+UP)+BB(K))/3.0 - IF(I.EQ.3) B=-(CC(K)*(2.0*UP+UN)+2.0*BB(K))/3.0 - DO 3 L=1,8 - 3 F(L,K)=(A*QT(L)+B*QU(L))/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF(L.GT.6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - EM(M,1,L)=E/ZL - GO TO 4 - 5 L=0 - 6 L=L+1 - IF(L.GT.6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) -C in order to bypass the boundary violation (L-1=0 !), 0 is used -C (I have no better idea) 12 nov 2007 E.Ch. -C - qtmp=0. - IF(L.GT.1) qtmp=F(L-1,3) - EE=ZL/(2.0*ZL+1.0)*(qtmp-F(L+1,3)) - E=E+EE - EM(M,2,L)=E/(ZL+1.0) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF(L.GT.6) GO TO 9 - ZL=L-1 - EM(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - GO TO 8 - 9 L=1 - 10 L=L+1 - IF(L.GT.6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - EM(M,2,L)=E/(ZL+1.0) - GO TO 10 - 2 CONTINUE - 99 RETURN - END -C ************************************************************** - SUBROUTINE PRNPOL(EL,EM) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EM(6,2,6) - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ -C GN=SQRT(ALFA*G2)*HBARC = SQRT(13.75/137)*197.32 -C ADD NUCLEON POLE TERMS TO OPEC EMS - DATA GPI2M/13.75/ - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - GG=1000.0*GN/W/4.0/WN - ZM=Z1*Z2 - ZD=Z1/Z2 - EM(1,2,1)=EM(1,2,1)+GG*ZM*(UP-UN) - EM(2,1,2)=EM(2,1,2)+GG*(UP-UN)*Q*ZK/ZM - UB=(2.0*UN+UP)/3.0 - EM(3,2,1)=EM(3,2,1)+GG*(2.0*ZM*WN/(W+WN)-UP*ZK/ZD+UB*ZM) - EM(4,1,2)=EM(4,1,2)-GG*(2.0*Q*ZD*WN/(W+WN)+UP*Q*ZD-UB*Q*ZK/ZM) - UB=(2.0*UP+UN)/3.0 - EM(5,2,1)=EM(5,2,1)+GG*(UB*ZM-UN*ZK/ZD) - EM(6,1,2)=EM(6,1,2)+GG*(UB*Q*ZK/ZM-UN*Q*ZD) - 99 RETURN - END -C ************************************************************ - SUBROUTINE PREPV(EL,EM) -C ADD EXTRA TERM FOR PV COUPLING - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - REAL MN,MPI,MUN,MUP,G - DATA MN,MPI,PI,GPI2M/938.256,135.04,3.1415927,13.75/ - DATA MUP,MUN,CE,GN/1.793,-1.913,315.65,62.51/ -C G=SQRT(4*PI*G**2) CE=1000*SQRT(ALFA*G**2)=1000*SQRT(13.65/137) - DIMENSION EM(6,2,6) - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - CE=1000.0*GN - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - EM(1,2,1)=EM(1,2,1)+CE*(MUP-MUN)*Z1*Z2*(WC-MN)/8.0/WC/MN**2 - EM(3,2,1)=EM(3,2,1) - & +CE*(2.0*MUP+MUN)*Z1*Z2*(WC-MN)/12.0/WC/MN**2 - EM(5,2,1)=EM(5,2,1) - & +CE*(MUP+2.0*MUN)*Z1*Z2*(WC-MN)/12.0/WC/MN**2 - EM(2,1,2)=EM(2,1,2) - & -CE*(MUP-MUN)*(WC-MN)*RQ*Z1/Z2/8.0/WC/MN**2 - EM(4,1,2)=EM(4,1,2) - & -CE*(2.0*MUP+MUN)*(WC-MN)*RQ*Z1/Z2/12.0/WC/MN**2 - EM(6,1,2)=EM(6,1,2) - & -CE*(MUP+2.0*MUN)*(WC-MN)*RQ*Z1/Z2/12.0/WC/MN**2 - RETURN - END -C ********************************************************** - SUBROUTINE PROMEGA(EL,EM) -C* -C* PROGRAM TO CALCULATE T-CHANEL OMEGA CHANGE TERM -C* THE CORRESPONDING EXEC FILE IS GOOS - IMPLICIT REAL (A-H,O-Z) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),ET(6,2,6),EM(6,2,6),F(12,4) - REAL QL(12),MN,MPI,C,BB(4),ZL,ZZ,MW - REAL EL,E1,E2,PI,LW,G1W,G2W,G1,G2,E - REAL qtmp - DATA PI/3.1415926/ - DATA MN,MPI,MW/938.256,135.04,782.6/ - DATA G1W,G2W/16.0,0.0/ - DATA B/0/ - SAVE -C IF(GOMS.NE.27) GO TO 20 -C GOMS=28.0 - G1W=GOM1 - G2W=GOM2 - 20 IF(G1W.EQ.0.0) GO TO 99 - LW=0.36 - LW=LW*SQRT(4.0*PI*1.0/137.0) - G1=197.3*LW*G1W/0.1395 - G2=197.3*LW*G2W/0.1395 - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - C=(WC-MN)/(8.0*PI*WC) - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - BW=(MW**2+2.0*RK*EPI-MPI**2)/(2.0*RK*RQ) - C1=C*G1 - C2=C*G2 - BB(1)=C1*Z1*Z2/RK/RQ*(WC-MN-RK*EPI/(WC-MN)+RK*RQ*BW/(WC-MN)) - BB(2)=C1*Z1/Z2/RK*(WC+MN-RK*EPI/(WC+MN)+RK*RQ*BW/(WC+MN)) - BB(3)=-C1*Z1*Z2/RK - BB(4)=-C1*Z1/Z2*RQ/RK - BB(1)=BB(1)-C2*Z1*Z2*MW**2/(2.0*RQ*RK*MN) - BB(2)=BB(2)+C2*(Z1/Z2)*MW**2/(2.0*RK*MN) - BB(3)=BB(3)+C2*Z1*Z2*(WC-MN)/(RK*2.0*MN) - BB(4)=BB(4)-C2*Z1/Z2*RQ*(WC+MN)/(2.0*MN*RK) - CALL QJOFX(QL,BW,8) - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 ET(M,J,L)=0.0 - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - IF (I .EQ. 1) B=BB(K) - IF (I .EQ. 2) B=BB(K)/3.0 - IF (I .EQ. 3) B=-BB(K)/3.0 - DO 3 L=1,8 - 3 F(L,K)=B*QL(L)/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF (L .GT. 6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - ET(M,1,L)=E/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 4 - 5 L=0 - 6 L=L+1 - IF (L .GT. 6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) -C in order to bypass the boundary violation (L-1=0 !), 0 is used -C (I have no better idea) 12 nov 2007 E.Ch. -C - qtmp=0. - IF(L.GT.1) qtmp=F(L-1,3) - EE=ZL/(2.0*ZL+1.0)*(qtmp-F(L+1,3)) - E=E+EE - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF (L .GT. 6) GO TO 9 - ZL=L-1 - ET(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 8 - 9 L=1 - 10 L=L+1 - IF (L .GT. 6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 10 - 2 CONTINUE - EM(1,2,1)=EM(1,2,1)-0.5*C1*Z1*Z2/(WC-MN) - EM(2,1,2)=EM(2,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN) - EM(3,2,1)=EM(3,2,1)-0.5*C1*Z1*Z2/(WC-MN)/3.0 - EM(4,1,2)=EM(4,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)/3.0 - EM(5,2,1)=EM(5,2,1)+0.5*C1*Z1*Z2/(WC-MN)/3.0 - EM(6,1,2)=EM(6,1,2)+0.5*C1*Z1/Z2*RQ/(WC+MN)/3.0 - 99 RETURN - END -C ***************************************** - SUBROUTINE PRRHO(EL,EM) - IMPLICIT REAL (A-H,O-Z) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),ET(6,2,6),EM(6,2,6),F(12,4) - REAL QL(12),MN,MPI,C,BB(4),ZL,ZZ,MP - REAL EL,E1,E2,PI,LP,GP1,GP2,G1,G2,E - DATA MN,MPI,MP/938.256,135.04,770.0/ - DATA B/0/ - SAVE - IF(GP1.EQ.0.0) GO TO 99 - PI=4.0*ATAN(1.0) - LP=0.12 - LP=LP*SQRT(4.0*PI*1.0/137.0) - G1=197.3*LP*GP1/0.1395 - G2=197.3*LP*GP2/0.1395 - G2=G1*GP2 - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - C=(WC-MN)/(8.0*PI*WC) - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - BW=(MP**2+2.0*RK*EPI-MPI**2)/(2.0*RK*RQ) - C1=C*G1 - C2=C*G2 - BB(1)=C1*Z1*Z2/RK/RQ*(WC-MN-RK*EPI/(WC-MN)+RK*RQ*BW/(WC-MN)) - BB(2)=C1*Z1/Z2/RK*(WC+MN-RK*EPI/(WC+MN)+RK*RQ*BW/(WC+MN)) - BB(3)=-C1*Z1*Z2/RK - BB(4)=-C1*Z1/Z2*RQ/RK - BB(1)=BB(1)+C2*Z1*Z2*MP**2/(2.0*RQ*RK*MN) - BB(2)=BB(2)-C2*(Z1/Z2)*MP**2/(2.0*RK*MN) - BB(3)=BB(3)+C2*Z1*Z2*(WC-MN)/(RK*2.0*MN) - BB(4)=BB(4)-C2*Z1/Z2*RQ*(WC+MN)/(2.0*MN*RK) - CALL QJOFX(QL,BW,8) - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 ET(M,J,L)=0.0 - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - IF (I .EQ. 1) B=0.0 - IF (I .EQ. 2) B=BB(K) - IF (I .EQ. 3) B=BB(K) - DO 3 L=1,8 - 3 F(L,K)=B*QL(L)/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF (L .GT. 6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - ET(M,1,L)=E/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 4 - 5 L=0 - 6 L=L+1 - IF (L .GT. 6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) - EE=ZL/(2.0*ZL+1.0)*(F(L-1,3)-F(L+1,3)) - E=E+EE - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF (L .GT. 6) GO TO 9 - ZL=L-1 - ET(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 8 - 9 L=1 - 10 L=L+1 - IF (L .GT. 6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 10 - 2 CONTINUE - EM(3,2,1)=EM(3,2,1)-0.5*C1*Z1*Z2/(WC-MN)-0.5*C2*Z1*Z2/MN - EM(4,1,2)=EM(4,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)+0.5*C2*Z1/Z2*RQ/MN - EM(5,2,1)=EM(5,2,1)-0.5*C1*Z1*Z2/(WC-MN)-0.5*C2*Z1*Z2/MN - EM(6,1,2)=EM(6,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)+0.5*C2*Z1/Z2*RQ/MN - 99 RETURN - END -C ****************************************************** - SUBROUTINE QJOFX(QS,Y,LMAX) -C VERWEST ALGORITHMS, MOD 6/86 FOR LARGE X ARNDT - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - REAL QS,Y,CN,ZN,ZL - DIMENSION QL(12),QS(12) - X=Y - IWRIT=6 - IF(LMAX.LT.2) LMAX=1 - LL=LMAX+1 - DO 1 L=1,LL - 1 QS(L)=0. - IF(X.LT.2.) GO TO 5 -C POWER SERIES IN 1/X ARNDT 6/17/86 - Z=1./X - ZZ=Z - ZN=-1. - 20 ZN=ZN+2. - CN=ZZ/ZN - DO 21 L=1,LL - ZL=L - QS(L)=QS(L)+CN - CN=CN*Z*(ZN+ZL-1.)/(ZN+2.*ZL) - IF(CN.LT.1.E-30) GO TO 22 - 21 CONTINUE - 22 ZZ=ZZ*Z**2 - IF(ZZ.GT.1.E-30) GO TO 20 - GO TO 2 - 5 L=LMAX - DO 100 II=1,2 - IF (X.LT.1.030) GO TO 600 -C ** ENTERING LARGE X EXPANSION - Z=1./(X+DSQRT(X*X-1.)) - ALF=2.*Z - DO 3 I=1,L - 3 ALF=DBLE(I)/DBLE(2*I+1)*ALF*2.*Z - CTOT=1. - CNOW=1. - DO 4 I=1,100 - CNOW=DBLE((2*I-1)*(I+L))/DBLE(2*I*I+2*I*L+I)*CNOW*Z*Z - CTOT=CTOT+CNOW - IF (CNOW/CTOT.LT.1.E-7 ) GO TO 99 - 4 CONTINUE - WRITE(IWRIT,333) - 99 QLOFX=ALF*CTOT - GO TO 601 -C ** ENTERING SMALL X EXPANSION - 600 Z=1.-1./X/X - SUM=0. - CNOW=1. - FNOW=DLOG(4.D0)-DLOG(Z) - IF (L.EQ.0) GO TO 299 - DO 18 JJ=1,L - 18 FNOW=FNOW-2./DBLE(JJ) - 299 DO 48 I=01,100 - SUM=SUM+CNOW*FNOW - IF (DABS(CNOW*FNOW/SUM ).LT.1.E-7 ) GO TO 199 - CNOW=CNOW*DBLE((L+2*I)*(L+2*I-1))/4./DBLE(I*I)*Z - 48 FNOW=FNOW+2.*(1./DBLE(I)-1./DBLE(L+2*I-1)-1./DBLE(2*I+L)) - 199 QLOFX=.5/(X**(L+1))*SUM - 601 QL(II)=QLOFX - 100 L=L-1 - QJ1=QL(2) - QJ2=QL(1) - QS(LMAX+1)=QJ2 - QS(LMAX)=QJ1 - DO 999 IOP=2,LMAX - J=LMAX-IOP+1 - QJ=(DBLE(2*J+1)*QJ1*X-DBLE(J+1)*QJ2)/DBLE(J) - QS(J)=QJ - QJ2=QJ1 - 999 QJ1=QJ - 333 FORMAT (' WARNING **** QLS MAY NOT BE RIGHT *** SUM ENDED') - 2 RETURN - END -C ********************************************************* - SUBROUTINE CMFN(WR,WI,WZ,WTR,WTI,LMX,CR,CI) -C CHEW-MANDELSTAM FUNCTIONS 7/17/80 ARNDT -C INT(0,1) OF X**(L+1/2)/PI/(X-Z) -C Z=(W-WT)/(W-WZ) - DIMENSION CR(20),CI(20) - DATA PI/3.1415927/ - DATA ZC/2./ - SAVE - IF(LMX.GT.10) LMX=10 - DO 10 L=1,LMX - CR(L)=0. - 10 CI(L)=0. - DR=WR-ABS(WZ) - D2=DR**2+WI**2 - IF(D2.LT.1.) GO TO 99 - ZR=((WR-WTR)*DR+WI*(WI-WTI))/D2 - ZI=(DR*(WI-WTI)-WI*(WR-WTR))/D2 - AR=ZR - AI=ZI - CALL SQZ(AR,AI) - IF(WZ.LT.0..AND.ZI.LT.0.) AR=-AR - IF(WZ.LT.0..AND.ZI.LT.0.) AI=-AI - Z2=ZR**2+ZI**2 - IF(Z2.LT.ZC**2) GO TO 11 -C USE POWER SERIES FOR Z GTO INF - RR=ZR/Z2 - RI=-ZI/Z2 - L=0 - 12 TL=2*L - TL=(TL+3.)/2. - SR=-RR/PI/TL - SI=-RI/PI/TL - TR=SR - TI=SI - RT=SQRT(TR**2+TI**2) - DO 13 N=1,20 - R=TL/(TL+1.) - Z=TR - TR=R*(RR*Z-RI*TI) - TI=R*(RI*Z+RR*TI) - SR=SR+TR - SI=SI+TI - IF(R*RT.LT.1.E-6) GO TO 14 - 13 TL=TL+1. - 14 L=L+1 - CR(L)=SR - CI(L)=SI - IF(L.GE.LMX) GO TO 99 - GO TO 12 - 11 A2=AR**2+AI**2 - D=1.+A2+2.*AR - ZZR=(1.-A2)/D - ZZI=-2.*AI/D - CALL ALG(ZZR,ZZI) - BR=2./PI-AI+(AR*ZZR-AI*ZZI)/PI - BI=AR+(AR*ZZI+AI*ZZR)/PI - ZL=.5 - L=0 - 1 L=L+1 - CR(L)=BR - CI(L)=BI - IF(L.GE.LMX) GO TO 99 - ZL=ZL+1. - ZZ=BR - BR=ZR*BR-ZI*BI+1./PI/ZL - BI=ZI*ZZ+ZR*BI - GO TO 1 - 99 RETURN - END -C ********************************************************** - SUBROUTINE ALG(ZR,ZI) -C TAKE NATURAL LOG OF Z BRANCH CUT AT Z=0 TAKEN TO LEFT - DATA PI/3.1415927/ - SAVE - IF(ZR.EQ.0.) ZR=1.E-10 - ZM=ZR**2+ZI**2 - PHI=ATAN(ZI/ZR) - IF(ZR.GT.0.) GO TO 1 - IF(ZI.GE.0.) PHI=PHI+PI - IF(ZI.LT.0.) PHI=PHI-PI - 1 ZR=ALOG(ZM)/2. - ZI=PHI - RETURN - END -C ************************************************************** - SUBROUTINE SQZ(ZR,ZI) -C SQRT(Z) BRANCH CUT TAKEN TO LEFT OF Z=0 - DATA PI/3.1415927/ - SAVE - ZM=SQRT(SQRT(ZR**2+ZI**2)) - IF(ZR.EQ.0.) ZR=1.E-10 - PHI=ATAN(ZI/ZR) - IF(ZR.GT.0.) GO TO 1 - IF(ZI.LT.0.) PHI=PHI-PI - IF(ZI.GT.0.) PHI=PHI+PI - 1 PHI=PHI/2. - ZR=ZM*COS(PHI) - ZI=ZM*SIN(PHI) - RETURN - END -C *************************************************************** - FUNCTION OBSPRD(IT) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C OBSERV FOR PI-N PHOTOPRODUCTION HRX, HIX ARE AMPLITUDES IN UNITS -C of milli-Fermis -C IT=OBSERVABLE TYPE= 1(DSG), 2(P), 3(S), 4(T), 5(SGT) 6(G), 7(H) -C IT=8(EMRI), 9(E), 10(F), 11(OX), 12(OZ), 13(CX), 14(CZ), 15(TX) -C IT=16(TZ), 17(LX), 18(LZ), 19(ST3), 20(ST1), 21(ST31) -C IT=22(DX1), 23(DX3), 24(DX13) -C IT=25-32 Ox,Oz,Cx,Cz,Tx,Tz,Lx,Lz as measured -C in a RH lab system (z(u) along N and x(u) along y cross z) -C ROTATIONS to lab frame are from Yerevan group(Ox, Oz) -C COS(THR)=C*CN-G*S*SN ; C=cos(th(pi,cm)), CN=cos(th(N,lab)) -C G=(Eg+M)/W Lorentz factor from cm->lab -C CN=G(ALF-C)/SQRT(G**2*(ALF-C)**2+S**2) ALF=B*SQRT(1+M**2/Q**2) - DIMENSION H2(4) - data wpr,wpi/938.256,135.04/ - SAVE - IF(IT.GT.10.AND.IT.LT.19) OBSPRD=PROBSL(IT) - IF(IT.GT.24) OBSPRD=PROBSL(IT) - IF(IT.GT.10.AND.IT.LT.19) GO TO 99 - IF(IT.GT.24) GO TO 99 - QK=QCM/ZKCM - OBSPRD=0.0 - IF(IT.EQ.8) GO TO 99 - IF(IT.EQ.5.AND.THTA.LE.0.0) GO TO 99 - IF(IT.GT.18.AND.IT.LT.22) GO TO 99 - DSG=0.0 - DO 1 K=1,4 - H2(K)=HRX(K)**2+HIX(K)**2 - 1 DSG=DSG+H2(K) - IF(IT.EQ.5) GO TO 3 - IF(IT.EQ.22) DSG=H2(2)+H2(4) - IF(IT.EQ.23) DSG=H2(1)+H2(3) - IF(IT.EQ.24) DSG=H2(2)+H2(4)-H2(1)-H2(3) - IF(IT.GT.21) DSG=2.0*DSG - OBSPRD=QK*DSG/200.0 - IF(IT.GT.21) GO TO 99 - 30 GO TO (99,2,3,4,99,6,7,99,31,32),IT - 2 X=HIX(3)*HRX(1)-HIX(1)*HRX(3)+HIX(4)*HRX(2)-HIX(2)*HRX(4) - GO TO 8 - 3 X=HRX(1)*HRX(4)+HIX(1)*HIX(4)-HRX(2)*HRX(3)-HIX(2)*HIX(3) - GO TO 8 - 4 X=HRX(2)*HIX(1)-HRX(1)*HIX(2)-HRX(3)*HIX(4)+HIX(3)*HRX(4) - GO TO 8 - 6 X=HIX(4)*HRX(1)-HRX(4)*HIX(1)+HRX(2)*HIX(3)-HRX(3)*HIX(2) - GO TO 8 - 7 X=HIX(3)*HRX(1)-HRX(3)*HIX(1)+HIX(2)*HRX(4)-HRX(2)*HIX(4) - GO TO 8 - 31 X=(H2(4)-H2(1)-H2(3)+H2(2))/2.0 - GO TO 8 - 32 X=HRX(4)*HRX(3)+HIX(4)*HIX(3)+HRX(1)*HRX(2)+HIX(1)*HIX(2) - 8 OBSPRD=X/DSG*2.0 - IF(IT.EQ.5) OBSPRD=(1.0-OBSPRD)/(1.0+OBSPRD) - 99 RETURN - END -C ************************************* - FUNCTION PROBSL(IT) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C OBSERV FOR PI-N PHOTOPRODUCTION HRX, HIX ARE AMPLITUDES IN UNITS -C of milli-Fermis -C IT=OBSERVABLE TYPE= 1(DSG), 2(P), 3(S), 4(T), 5(SGT) 6(G), 7(H) -C IT=8(EMRI), 9(E), 10(F), 11(OX), 12(OZ), 13(CX), 14(CZ), 15(TX) -C IT=16(TZ), 17(LX), 18(LZ), 19(ST3), 20(ST1), 21(ST31) -C IT=22(DX1), 23(DX3), 24(DX13) -C IT=25-32 Ox,Oz,Cx,Cz,Tx,Tz,Lx,Lz as measured -C in a RH lab system (z(u) along N and x(u) along y cross z) -C ROTATIONS to lab frame are from Yerevan group(Ox, Oz) -C COS(THR)=C*CN-G*S*SN ; C=cos(th(pi,cm)), CN=cos(th(N,lab)) -C G=(Eg+M)/W Lorentz factor from cm->lab -C CN=G(ALF-C)/SQRT(G**2*(ALF-C)**2+S**2) ALF=B*SQRT(1+M**2/Q**2) - DIMENSION H2(4),GTH(10) - SAVE - PROBSL=0.0 - DSG=0.0 - DO 1 K=1,4 - H2(K)=HRX(K)**2+HIX(K)**2 - 1 DSG=DSG+H2(K) - IF(DSG.LE.0.0) GO TO 99 - ITT=IT-10 - IF(ITT.GT.10) ITT=ITT-14 - IUV=ITT/2 - IUV=ITT-2*IUV -C IUV=0(Cz), 1(Cx) .... - GO TO (33,33,35,35,37,37,39,39) ITT - 33 V=HRX(4)*HIX(3)-HIX(4)*HRX(3)+HRX(1)*HIX(2)-HIX(1)*HRX(2) -C Ox, Oz go here - U=HIX(1)*HRX(4)-HRX(1)*HIX(4)+HIX(3)*HRX(2)-HRX(3)*HIX(2) - GO TO 7 - 35 V=-HRX(4)*HRX(2)-HIX(4)*HIX(2)-HRX(1)*HRX(3)-HIX(1)*HIX(3) -C Cx, Cz go here - U=(H2(4)-H2(1)-H2(2)+H2(3))/2.0 - GO TO 7 - 37 V=HRX(1)*HRX(4)+HIX(1)*HIX(4)+HRX(2)*HRX(3)+HIX(2)*HIX(3) -C Tx, Tz go here - U=HRX(1)*HRX(2)+HIX(1)*HIX(2)-HRX(4)*HRX(3)-HIX(4)*HIX(3) - GO TO 7 - 39 V=HRX(4)*HRX(2)+HIX(4)*HIX(2)-HRX(1)*HRX(3)-HIX(1)*HIX(3) -C Lx, Lz go here - U=(H2(1)+H2(4)-H2(2)-H2(3))/2.0 - 7 CONTINUE - UP=U - VP=V - IF(IT.LT.20) GO TO 8 -C multiply by signs in table II of Knochlein... -C change signs of Cx, Cz - IF(ITT.EQ.3.OR.ITT.EQ.4) V=-V - IF(ITT.EQ.3.OR.ITT.EQ.4) U=-U -c nflag=pem(14,6,2,6)+0.1 -c ninv=nflag/10 -c nfg=nflag-10*ninv -c nflag=0(do cm quantities), 1(U,V), 2(U,-V), 3(-U,V), 4(-U,-V) -c nflag=5(UP=RUU, VP=RUV) -c nflag=10*ninv+nflag. ninv=0(R,A xform), 1(identity), 2(oz, ox) -c if(nfg.gt.2) U=-U -c if(nfg.eq.2.or.nfg.eq.4) v=-v -c nv=ninv - NV=0 -c nv=pem(19,6,2,6) - THTA=57.296*ACOS(CS) - CALL XFORM(EG,THTA,NV,U,V,UP,VP,D) - 8 X=UP - IF(IUV.EQ.1) X=VP - PROBSL=X/DSG*2.0 - 99 RETURN - END -C ************************************* - SUBROUTINE XFORM(EG,THT,NFRM,U,V,UP,VP,D) -C transform cm variables U,V (eg Cz,Cx) into UP,VP - dimension s4(3) - DATA WPR,WPI,EGM/938.256,135.04,0.0/ - SAVE - UP=U - VP=V -C No Xformation if NFRM = 1 -c IF(NFRM.EQ.1) GO TO 99 -C get kinematic factors - IF(EG.EQ.EGM) GO TO 1 - S=WPR**2+2.0*WPR*EG - Q2=(S-(WPR+WPI)**2)*(S-(WPR-WPI)**2)/4.0/S - B=EG/(EG+WPR) - BN=SQRT(Q2/(Q2+WPR**2)) - G=1.0/SQRT(1.0-B**2) - GN=1.0/SQRT(1.0-BN**2) - ALF=B/BN - 1 EGM=EG -c get angle factors C,S=COS(THT),SIN(THT) CN,SN=COS(thN),.. -c THT=PION cm angle, thN=NUCLEON lab angle - C=COS(0.0174532*THT) - S=SQRT(1.0-C**2) - CN=G*(ALF-C) - Z=CN**2+S**2 - CN=CN/SQRT(Z) - SN=SQRT(ABS(1.0-CN**2)) -C Yerevan(Ox, Oz) Xformation. This is a simple rotation so RVV -C is just COS(ROT) (they use a RH lab system) RAA 2/18/02 -C Consistent with Gilman if one starts with (-Cx, -Cz) in cm system -C as prescribed by Knochlein.., Photo and Electroproduction of eta -C Mesons Z.Phys(1992) - RVV=C*CN-G*S*SN -C P2=Q2*Z -C BL=SQRT(P2/(P2+WPR**2)) -C GL=1.0/SQRT(1.0-BL**2) -C Z=G*GN*(B*BN-C) -C RVV=C*CN-G*S*SN -C RVU=GN*S*CN-SN*Z -C ZKX=C*SN+G*S*CN -C ZKZ=-GN*S*SN-CN*Z -C ZKX0=G*B*S -C ZKZ0=G*GN*(B*C-BN) -C RUU=GL*(ZKZ-BL*ZKZ0) -C RUV=-GL*(ZKX-BL*ZKX0) -C This is a simple rotation so RUU=cos, Rvu=sin, Ruv=-sin, Ruu=Rvv - RUU=RVV - RVU=SQRT(ABS(1.0-RUU**2)) - if(nfrm.eq.1) rvu=-rvu - RUV=-RVU -c if(nfrm.ne.3) go to 3 -c rvv=-rvv -c rvu=-rvu -C use Gilman rotation (=180-th(Yerevan)) -c ruu=-ruu -c rvv=ruu -c rvu=sqrt(1.0-ruu**2) -c if(nfrm.eq.5) rvu=-rvu -c ruv=-ruv - 3 UP=RUU*U+RUV*V - VP=RVV*V+RVU*U - D=RUU*RVV-RUV*RVU - 99 RETURN - END diff --git a/src/programs/Simulation/bggen/code/saide.F b/src/programs/Simulation/bggen/code/saide.F deleted file mode 100644 index b6f9c6e58e..0000000000 --- a/src/programs/Simulation/bggen/code/saide.F +++ /dev/null @@ -1,43 +0,0 @@ - REAL FUNCTION SAIDE(ENA,IREACA,ICUTA) -C -C--- Cross section (SAID) in mbarn -C - IMPLICIT NONE - REAL SAIDXSECA,ENA,STMP,SIMPSF - EXTERNAL STMP - INTEGER IREACA,ICUTA -C - COMMON/CSAID/ EN,COST,IREAC,ICUT - REAL EN,COST - INTEGER IREAC,ICUT -C - EN=ENA - IREAC=IREACA - ICUT=ICUTA - SAIDE=SIMPSF(STMP,-1.,1.,100)*2*3.1416 -C write(6,*) 'e,ireac,icut,saide=',en,ireac,icut,saide -C - SAIDE=SAIDE/1000. -C - END -C - REAL FUNCTION STMP(X) - REAL X -C - COMMON/CSAID/ EN,COST,IREAC,ICUT - REAL EN,COST - INTEGER IREAC,ICUT - REAL sum - INTEGER i -C - COST=X - sum=0. - DO i=1,2 - IF(IREAC.EQ.0.OR.i.EQ.IREAC) THEN - sum=sum+SAIDXSECA(EN,COST,i,ICUT) - ENDIF - ENDDO - STMP=sum -C write(6,*) STMP -C - END diff --git a/src/programs/Simulation/bggen/code/saidxseca.F b/src/programs/Simulation/bggen/code/saidxseca.F deleted file mode 100644 index ce0e8de382..0000000000 --- a/src/programs/Simulation/bggen/code/saidxseca.F +++ /dev/null @@ -1,62 +0,0 @@ - REAL FUNCTION SAIDXSECA(E,COSTH,IPROC,ICUT) -C -C --- SAID gamma+p --> pi N cross section -C --- E - photons energy (E<2000 MeV) -C --- COSTH - cos of pion angle in CM -C --- IPROC = 1 - pi0 p -C 2 - pi+ n -C 3 ... is at the moment unclear to me -C Returns cross section in microbarn/ster for pion in CM -C -C--- SAID parametrization (the version I have) seems not to work above 2 GeV -C--- ELSA measurement gives 3.7 mub at 2 GeV and 1.25 nub at 3 GeV: -C For ICUT>0 (emx=2 GeV) I use exp(-1.*(E-emx))*SAID(emx) -C -C From I.Strakovsky, D.Arndt -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C -C -C -C - IMPLICIT NONE - REAL E,COSTH - INTEGER IPROC,ICUT -C - REAL PRFAMP,OBSPRD - EXTERNAL PRFAMP,OBSPRD -C - REAL ee,fr(4),fi(4),dx3,res,fac,emx - INTEGER it -C - emx=2. - fac=1. - ee=E - IF(ICUT.GT.0.AND.ee.GT.emx) THEN - fac=EXP(-1.*(ee-emx)) - ee=emx - ENDIF -C - ee=ee*1000. - it=1 - res=0. - IF(ee.GT.155.) THEN - CALL SAIDGET(ee,COSTH,IPROC) - res=OBSPRD(it) -C res=10. - ELSE - res=0. - ENDIF - SAIDXSECA=res*fac -C - RETURN - END -C - SUBROUTINE SAIDGET(E,COSTH,IPROC) - IMPLICIT NONE - REAL E,COSTH,PRFAMP - INTEGER IPROC - REAL fr(4),fi(4),dx3,s -C - s=PRFAMP(E,COSTH,IPROC,fr(1),fi(1),dx3) - RETURN - END diff --git a/src/programs/Simulation/bggen/code/simpsf.F b/src/programs/Simulation/bggen/code/simpsf.F deleted file mode 100644 index 9b02baf034..0000000000 --- a/src/programs/Simulation/bggen/code/simpsf.F +++ /dev/null @@ -1,46 +0,0 @@ - REAL FUNCTION SIMPSF(FUN,X1,X2,N2) - IMPLICIT NONE -C -C === Integrate FUN between X1-X2 using Simpson method -C === N2 - number of intervals, even -C - REAL FUN,X1,X2 -C EXTERNAL FUN - INTEGER N2 -C - REAL step - DOUBLE PRECISION s1,s2,s - INTEGER i,n -C - SIMPSF=0. - IF(N2.LT.3) THEN - WRITE(6,*) ' *** SIMPSF error - N2=',N2 - GO TO 999 - ENDIF - IF(X1.GE.X2) THEN - WRITE(6,*) ' *** SIMPSF error - X1,X2=',X1,X2 - GO TO 999 - ENDIF -C - n=N2 - IF(MOD(N2,2).NE.0) n=n+1 - step=(X2-X1)/n -C - s1=0. - s2=0. -C - DO i=1,n-1,2 - s1=s1+DBLE(FUN(X1+step*i)) - ENDDO -C - DO i=2,n-2,2 - s2=s2+DBLE(FUN(X1+step*i)) - ENDDO -C - s=(DBLE(FUN(X1))+DBLE(FUN(X2))+s1*4.D0+s2*2.D0)*DBLE(step)/3.D0 - SIMPSF=s -C - 999 RETURN - END - - diff --git a/src/programs/Simulation/bggen/fix_warnings.py b/src/programs/Simulation/bggen/fix_warnings.py deleted file mode 100755 index 46afd23c29..0000000000 --- a/src/programs/Simulation/bggen/fix_warnings.py +++ /dev/null @@ -1,153 +0,0 @@ -#!/usr/bin/python -# -# Dec. 18, 2013 David Lawrence -# -# This script is an attempt to automatically fix the -# over 500 warnings emitted when compiling bggen. These -# fill the nightly build messages and obscure any issues -# with our code. It was not completely successful in that -# numerous warnings still remain. Some of them are not -# easily fixed. I'm adding this script here in case it -# is useful as a starting point for someone else trying -# to fix the issues. -# -# To use this, first create a file with warning messages -# by running make or scons -u. I did this on ifarm1102 using -# gfortran 4.4.6 so other compilers might give differently -# formatted warnings which would cause this script to fail. -# -# scons -u > scons.out -# -# or -# -# make > scons.txt -# -# (I actually only tried it with the scons method) -# It's also worth nothing that I think I only ran this after -# having built everything once, then changed the pythia_h.F -# file so it was the only one contributing warnings. If -# all files are compiled, then one should modify this to -# only consider changes to the pythia_h.F file. -# -# Next, us this script to create a new pythia_h.F -# file. This should be run from the bggen directory -# (not bggen/code). -# -# ./fix_warnings.py -# -# This will use the scons.out and code/pythia_h.F files to -# generate a new pythia_h.F file in the current directory. -# (Therefore, you should probably not run this from the "code" -# directory. -# -# When it is done, move the new pythia_h.F file into the -# code directory, replcing the existing one: -# -# mv pythia_h.F code -# -# - -from collections import deque - -# Read in entire pythia_h.F file -f = open('code/pythia_h.F', 'r') -infile = f.read().split('\n') -f.close() - -# Replace any tabs with spaces -for i in range(1, len(infile)): - infile[i] = infile[i].replace('\t', ' ') - -f = open('scons.out', 'r') -prev= deque(['','','','','']) -for line in f: - prev.popleft() - prev.append(line) - - if 'Warning: Unused variable' in line: - first = line.find("'")+1 - last = line.find("'", first) - var = line[first:last].upper() - - first = prev[0].find('bggen/code/') + 11 - last = prev[0].find(':', first) - fname = prev[0][first:last] - - first = last + 1 - last = prev[0].find('.', first) - line_num = int(prev[0][first:last])-1 - - print "var=%s in %s at line %d" % (var, fname, line_num) - - - # Copy line of interest to working variable - s = infile[line_num] - - # Remember if the line ends with a comma - ends_with_comma = s.endswith(',') - - # if variable was array, we need to cut the "(XXX)" out too - first = s.find(var) - last = first + len(var) - if last0 - GEANT particle type -C P1,P2,TH1,TH2 - momentum and angle limits -C - IMPLICIT NONE - INTEGER IFL,KTYP - REAL P1,P2,TH1,TH2 -C - INCLUDE ? -C - INTEGER nm,im(4),i,j,k,ip,nn - REAL bm(4),pm(4,4),ef - REAL pp(4),pf,th,qq -C - EV_STAT=0. -C - DO j=1,4 - pp(j)=0. - ENDDO - nn=0 -C - DO ip=1,NP - IF(ITYP(1,ip).GT.0) THEN - IF(KTYP.EQ.0.OR.KTYP.EQ.ITYP(1,ip)) THEN - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip)**2 - ENDDO - pf=SQRT(qq) - th=ACOS(POUT(3,ip)/pf)*180./3.1416 - IF(pf.GE.P1 .AND.pf.LE.P2.AND. - + th.GE.TH1.AND.th.LE.TH2) THEN - DO j=1,3 - pp(j)=pp(j)+POUT(j,ip) - ENDDO - pp(4)=pp(4)+SQRT(qq+AM(ip)**2) - nn=nn+1 - ENDIF - ENDIF - ENDIF - ENDDO - -C - IF(IFL.EQ.0) THEN - EV_STAT=nn - ELSE IF(IFL.GE.1.AND.IFL.LE.4) THEN - EV_STAT=pp(IFL) - ENDIF -C - RETURN - END diff --git a/src/programs/Simulation/bggen/paw/example_1.kumac b/src/programs/Simulation/bggen/paw/example_1.kumac deleted file mode 100644 index 288a410c27..0000000000 --- a/src/programs/Simulation/bggen/paw/example_1.kumac +++ /dev/null @@ -1,48 +0,0 @@ -MACRO example_1 -* -* --- example running on the bggen ntuple -* - idnt=9 - - clo 2 - h/fil 2 bggen.nt 0 -x - zone 2 2 - opt logy - 1dh 100 'energy' 700 0.1 12.1 - nt/pl //lun2/[idnt].pin(3,1) ! -100 - atit 'Photon energy, GeV' 'Events/bin' - 1dh 101 'energy' 150 0.1 3.1 - h/cop 101 102 - - nt/pl //lun2/[idnt].pin(3,1) ! -101 - atit 'Photon energy, GeV' 'Events/bin' - - col=0 - do i=1,10 - col=[col]+1 - if [col]=5 then - col=[col]+1 - endif - if [col]>7 then - col=1 - endif - set hcol [col] - nt/pl //lun2/[idnt].pin(3,1) iproc=[i] ! ! ! N 102 - h/pl 102 s - set hcol 1 - - enddo -exitm - opt logy - 1dh 110 'cos(theta)' 200 -1. 1. - nt/pl //lun2/[idnt].p_kin.f(1,3,2) iproc=5.and.np>3 - atit '-t' 'Events' - opt liny - nt/pl //lun2/[idnt].p_kin.f(2,5,4) iproc=4.and.np>3 -110 - atit 'cos(theta) decays, rho' 'Events' - - nt/pl //lun2/[idnt].efm.f(3,4,0,0)%efm.f(4,5,0,0) iproc=3.and.np>3.and.1.53.and.1.53.and.1.5Called by : GDECAY,GDECA3 * -C. * Author M.Hansroul ********* * -C. * * -C. ****************************************************************** -C. - DIMENSION BETA(4),PA(4),PB(4) -C. -C. ------------------------------------------------------------------ -C. - BETPA = BETA(1)*PA(1) + BETA(2)*PA(2) + BETA(3)*PA(3) - BPGAM = (BETPA * BETA(4)/(BETA(4) + 1.) - PA(4)) * BETA(4) - PB(1) = PA(1) + BPGAM * BETA(1) - PB(2) = PA(2) + BPGAM * BETA(2) - PB(3) = PA(3) + BPGAM * BETA(3) - PB(4) =(PA(4) - BETPA) * BETA(4) - END diff --git a/src/programs/Simulation/bggen/paw/last.kumac b/src/programs/Simulation/bggen/paw/last.kumac deleted file mode 100644 index 0592a4dc3d..0000000000 --- a/src/programs/Simulation/bggen/paw/last.kumac +++ /dev/null @@ -1,182 +0,0 @@ -*** Begin of history file: Tue Apr 28 10:44:23 2009 -shell cat last.kumac.old1 -h/fil 2 bggen.nt 0 -x -nt/lis //lun2 - nt/pl //lun2/9.ev_stat.f(0,8,0.1,12.,2.,110.) ! 1000 1 -zone 2 2 -h/cr/prof 101 ' ' 120 0.15 12.15 -1 100 -h/cr/prof 101 ' ' 120 0.15 12.15 -1 100 - nt/pl //lun2/9.ev_stat.f(0,8,0.1,12.,2.,110.) ! 1000 1 -nt/loop //lun2/9 bgg_pri.f(0)>-1 3 1 -nt/loop //lun2/9 bgg_pri.f(0)>-1 20 1 - nt/pl //lun2/9.pin(3,1) ! 1000 1 - nt/pl //lun2/9.pin(3,1) ! 1000 1 - nt/pl //lun2/9.pin(3,1) 8-1 1000 1 -nt/pri 9 - nt/pl //lun2/9.p_kin_auto.f(1,14) 8-1 1000 1 -nt/pl //lun2/9.p_kin_auto.f(1,14) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -opt liny - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -211 -loca -1dh 212 'efm' 200 0 1 - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -212 -1dh 212 'efm' 240 0 1.2 - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -212 -loca - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -211 - nt/scan //lun2/9 80 100 ! ! sqrt(p_kin_auto.f(2,14)) - nt/scan //lun2/9 80 1000 ! ! sqrt(p_kin_auto.f(2,14)) - nt/scan //lun2/9 10 1000 ! ! sqrt(p_kin_auto.f(2,14)) -mess $sigma(sqrt(0.938**2+2*8*0.938)) -mess $sigma(sqrt(0.938**2+2*9*0.938)) - nt/scan //lun2/9 80 1000 ! ! p_kin_auto.f(2,14) -mess $sigma(sqrt(0.938**2+2*8*0.938)) -mess $sigma(sqrt(0.938**2+2*9*0.938)) -1dh 213 'efm' 400 3.9 4.3 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -213 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -212 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -212 -h/pl 213 -loca - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 100 1 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -nt/loop //lun2/9 8-1 200 1 -nt/loop //lun2/9 8-1 2000 1 -nt/loop //lun2/9 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 100 1 -nt/pl //lun2/9.ityp(3,1) 8-1 100 1 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -h/pl 211 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 80 -211 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -opla -zone 2 2 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -211 -1dh 214 'efm' 400 0 4 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -214 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 60 -214 -clops -1dh 215 'efm' 400 0 4 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -214 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 60 -215 -max 214 450 -max 215 450 -opla -zone 2 2 -h/pl 215 -h/pl 214 -clops -shell -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 -shell -h/cop 215 231 -h/cop 215 232 -h/cop 215 233 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 30 -231 -h/pl 231 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 110 -232 -nt/pl //lun2/9.ityp(3,1) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 110 -232 -h/pl 232 -max 232 0 -h/pl 232 -max 232 -1 -h/pl 232 -max 232 1 -h/pl 232 -max 232 100 -h/pl 232 -max 232 60 -h/pl 232 -nt/pl //lun2/9.ityp(3,1) 11-1 -dir -shell ls -alF -shell ls -alFL -nt/pl //lun2/9.ityp(3,1) -set csiz 0.4 -nt/pl //lun2/9.ityp(3,1) -nt/pl //lun2/9.ityp(3,1) 11-1 -2dh 302 'p-th' 120 0 120 120 0 12 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 1000000 -h/pl 302 -1dh 300 'p' 120 0 12. -nt/pl //lun2/9.part_kin.f(0,8,0,300) -h/pl 300 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) -h/pl 100000- -h/pl 1000000 -h/pl 300 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 302 -nt/pl //lun2/9.part_kin.f(2,9,0,302) -h/pl 302 -2dh 302 'p-th' 180 0 180 120 0 12 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 302 -nt/pl //lun2/9.part_kin.f(0,0,2214,300) -h/pl 302 -nt/pl //lun2/9.part_kin.f(0,0,2214,302) -h/pl 302 -*** End of history file: Thu Apr 30 17:11:53 2009 diff --git a/src/programs/Simulation/bggen/paw/p_kin.f b/src/programs/Simulation/bggen/paw/p_kin.f deleted file mode 100644 index ace8f44e74..0000000000 --- a/src/programs/Simulation/bggen/paw/p_kin.f +++ /dev/null @@ -1,105 +0,0 @@ - REAL FUNCTION P_KIN(IFL,K1,K2) -C -C--- Kinematic variables: -C -C IFL=1 - -t (target --> -(K1-targ)**2) -C =2 - cos(th) of K1 in CM of K2 with respect to the K2 direction -C K2=0 - in CM -C - IMPLICIT NONE - INTEGER IFL,K1,K2,K3,K4 -C - INCLUDE ? -C - INTEGER i,j,kf1,kf2 - REAL var,qq,en1,en2,dir(3),p1(5),p2(5),pp1,pp2,px(4),pa(4) - + ,bet(4),ptar(5) -C - P_KIN=-20. - kf1=0 - kf2=0 - IF(K1.GE.1.AND.K1.LE.NP) THEN - kf1=1 - qq=0. - DO j=1,3 - p1(j)=POUT(j,K1) - qq=qq+p1(j)**2 - ENDDO - p1(4)=SQRT(qq+AM(K1)**2) - p1(5)=SQRT(qq) - ENDIF - IF(K2.GE.1.AND.K2.LE.NP) THEN - kf2=1 - qq=0. - DO j=1,3 - p2(j)=POUT(j,K2) - qq=qq+p2(j)**2 - ENDDO - p2(4)=SQRT(qq+AM(K2)**2) - p2(5)=SQRT(qq) - ENDIF - DO j=1,3 - ptar(j)=PIN(j,2) - ENDDO - ptar(5)=SQRT(ptar(1)**2+ptar(2)**2+ptar(3)**2) - ptar(4)=SQRT(ptar(5)**2+AMIN(2)**2) - - IF(kf1.EQ.0) GO TO 999 - var=-20. - - IF(IFL.EQ.1) THEN -C - var=AM(K1)**2+AMIN(2)**2-2.*p1(4)*ptar(4) - DO j=1,3 - var=var+2.*p1(j)*ptar(j) - ENDDO - var=-var -C - ELSE IF(IFL.EQ.2) THEN -C - IF(kf2.EQ.0) THEN - pp1=0. - pp2=0. - DO j=1,3 - p2(j)=POUT(j,1)+POUT(j,2) - pp1=pp1+POUT(j,1)**2 - pp2=pp2+POUT(j,2)**2 - ENDDO - p2(5)=SQRT(p2(1)**2+p2(2)**2+p2(3)**2) - p2(4)=SQRT(pp1+AM(1)**2)+SQRT(pp2+AM(2)**2) - ENDIF -C - IF(p2(5).GT.0.) THEN - DO j=1,3 - dir(j)=p2(j)/p2(5) - ENDDO - ELSE - dir(1)=0. - dir(2)=0. - dir(3)=1. - ENDIF - - DO j=1,3 - bet(j)=p2(j)/p2(4) - ENDDO - bet(4)=1./SQRT(1.-bet(1)**2-bet(2)**2-bet(3)**2) -C - CALL GLOREN(bet,p1(1),px(1)) - qq=0. - var=0. - DO j=1,3 - qq=qq+px(j)**2 - var=var+px(j)*dir(j) - ENDDO - var=var/SQRT(qq) ! COS(th) -C write(6,FMT='(5F10.4)') p2,var - ENDIF -C - P_KIN=var -C - 999 RETURN -C - END -C - INCLUDE 'efmass.f' - INCLUDE 'gloren.f' diff --git a/src/programs/Simulation/bggen/paw/p_kin_auto.f b/src/programs/Simulation/bggen/paw/p_kin_auto.f deleted file mode 100644 index 7c5b068450..0000000000 --- a/src/programs/Simulation/bggen/paw/p_kin_auto.f +++ /dev/null @@ -1,93 +0,0 @@ - REAL FUNCTION P_KIN_AUTO(IFL,KGEAN) -C -C--- Find the recoil candidate, the type ABS(KGEAN) (=14 - proton) -C--- KGEAN>0 - not originated from a resonance -C--- <0 - all -C--- Kinematic variables: -C -C IFL=1 - -t -C =2 - eff. mass of the rest -C - IMPLICIT NONE - INTEGER IFL,KGEAN -C - INCLUDE ? -C - INTEGER ip,ip1,ipm,i,j - REAL var,qq,en1,en2,p1(5),p2(5),tt,efmr,ptar(5) -C - P_KIN_AUTO=-20. - IF(KGEAN.EQ.0) GO TO 999 - ip1=0 - DO ip=1,NP - IF(ITYP(1,ip).EQ.ABS(KGEAN)) THEN - ipm=ITYP(4,ip) - IF(KGEAN.LT.0) THEN - ip1=ip - ELSE - IF(ipm.EQ.0) THEN - ip1=ip - ELSE IF(ipm.GT.0.AND.ipm.LE.NP) THEN -C IF(ABS(ITYP(4,ipm)).LE.100) THEN - IF(ABS(ITYP(4,ipm)).EQ.0) THEN - ip1=ip - ENDIF - ENDIF - ENDIF - ENDIF - ENDDO -C - IF(ip1.GT.0) THEN - qq=0. - DO j=1,3 - p1(j)=POUT(j,ip1) - qq=qq+p1(j)**2 - ENDDO - p1(4)=SQRT(qq+AM(ip1)**2) - p1(5)=SQRT(qq) -C - DO j=1,4 - p2(j)=0. - ENDDO - DO ip=1,NP - IF(ip.NE.ip1) THEN - IF(ITYP(1,ip).GT.0.AND.ITYP(5,ip).EQ.0) THEN - qq=0. - DO j=1,3 - p2(j)=p2(j)+POUT(j,ip) - qq=qq+POUT(j,ip)**2 - ENDDO - en2=SQRT(qq+AM(ip)**2) - p2(4)=p2(4)+en2 - ENDIF - ENDIF - ENDDO -C - qq=0. - DO j=1,3 - ptar(j)=PIN(j,2) - qq=qq+PIN(j,2)**2 - ENDDO - ptar(4)=SQRT(qq+AMIN(2)**2) -C - efmr=SQRT(p2(4)**2-p2(1)**2-p2(2)**2-p2(3)**2) - tt=AM(ip1)+AMIN(2)**2-2.*ptar(4)*p1(4) - DO j=1,3 - tt=tt+2.*ptar(j)*p1(j) - ENDDO -C - IF(IFL.EQ.1) THEN - var=-tt - ELSE IF(IFL.EQ.2) THEN - var=efmr - ENDIF - P_KIN_AUTO=var -C - ENDIF -C - 999 RETURN -C - END -C -C INCLUDE 'efmass.f' -C INCLUDE 'gloren.f' diff --git a/src/programs/Simulation/bggen/paw/part_kin.f b/src/programs/Simulation/bggen/paw/part_kin.f deleted file mode 100644 index 026683b076..0000000000 --- a/src/programs/Simulation/bggen/paw/part_kin.f +++ /dev/null @@ -1,67 +0,0 @@ - REAL FUNCTION PART_KIN(IFL,KGEANT,KPYTH,IDH) -C -C-- Fills IDH with the kin. parameters of all tracks of a given type -C IFL=0 - p -C =1 - theta (degrees) -C =2 - p(Y)-theta(x)(degrees) -C KTYP>0 - GEANT particle type -C <=0 use KPYTH - PYTHIA KF type -C - IMPLICIT NONE - INTEGER IFL,KGEANT,KPYTH,IDH -C - INCLUDE ? - LOGICAL HEXIST -C - INTEGER ip,j,ifirst,ievstart,nfind,ifind - REAL pf,th,qq - DATA ifirst/1/ - DATA ievstart/0/ -C - IF(ifirst.EQ.1.OR.IDNEVT.EQ.ievstart) THEN - IF(IDH.NE.0.AND.HEXIST(IDH)) THEN - CALL HRESET(IDH,' ') - ievstart=IDNEVT - ELSE - WRITE(6,*) ' *** ERROR: no histogram ID=',IDH - ENDIF - ENDIF - ifirst=0 -C - nfind=0 -C - DO ip=1,NP - ifind=0 - IF(KGEANT.GT.0) THEN - IF(KGEANT.EQ.ITYP(1,ip)) THEN - ifind=1 - ENDIF - ELSE IF(KPYTH.NE.0) THEN - IF(KPYTH.EQ.ITYP(3,ip)) THEN - ifind=1 - ENDIF - ENDIF -C write(6,*) ifind,KGEANT,KPYTH,ITYP(1,ip),ITYP(3,ip) - IF(ifind.NE.0) THEN - nfind=nfind+1 - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip)**2 - ENDDO - pf=SQRT(qq) - th=ACOS(POUT(3,ip)/pf)*180./3.1416 -C - IF(IFL.EQ.0) THEN - CALL HFILL(IDH,pf,0.,1.) - ELSE IF(IFL.EQ.1) THEN - CALL HFILL(IDH,th,0.,1.) - ELSE IF(IFL.EQ.2) THEN - CALL HFILL(IDH,th,pf,1.) - ENDIF - ENDIF - ENDDO -C - PART_KIN=nfind -C - RETURN - END diff --git a/src/programs/Simulation/bggen/paw/pi_plot.f b/src/programs/Simulation/bggen/paw/pi_plot.f deleted file mode 100644 index d5dbcd403e..0000000000 --- a/src/programs/Simulation/bggen/paw/pi_plot.f +++ /dev/null @@ -1,204 +0,0 @@ - REAL FUNCTION pi_plot(IFL,KGEANT,KPYTH,IDH) -C -C-- Fills IDH with the kin. parameters of all photons from pi0 or eta decay. -c -c photons in fcal selected with energies > fcal_thresh -c photons in bcal selected with energies > bcal_thresh - -c idh with pi0s with photons in fcal only -c idh+1 with pi0s with photons in bcal only -c idh+2 with pi0s with one photon in fcal, one photon in bcal -c idh+3 with pi0s failing above cuts -c -C IFL=0 - p -C =1 - theta (degrees) -C =2 - p(Y)-theta(x)(degrees) -c KGEANT >0 GENAT particle type -C KTYP>0 - GEANT particle type -C <=0 use KPYTH - PYTHIA KF type -c IDH - number of histogram to be filled -c -c function based on part_kin, but to plot photons from pi0 (or eta) decay. -c Elton Smith 2/8/11 -c -C - IMPLICIT NONE - INTEGER IFL,KGEANT,KPYTH,IDH -C - INCLUDE ? - LOGICAL HEXIST -C - INTEGER ip,j,ifirst,ievstart,nfind,ifind,icnt - REAL thcut, fcal_thresh, bcal_thresh - INTEGER jj,nkind, ip1, ip2, itopol - REAL pf1,th1,qq,pf2,th2, ivmass - LOGICAL fcal1, fcal2, bcal1, bcal2 - DATA ifirst/1/ - data icnt /0/ - DATA ievstart/0/ - DATA thcut /10./ -c DATA fcal_thresh, bcal_thresh /0.2, 0.2/ - DATA fcal_thresh, bcal_thresh /0.5, 0.5/ -c DATA fcal_thresh, bcal_thresh /0.1, 0.06/ -c -c count entries -c - icnt = icnt + 1 -c -c valid codes are: -c KGEANT = 7, KPYTH = 111 (pi0) -c KGEANT = 17, KPYTH = 221 (eta) -c - if (KGEANT.eq.7) then - KPYTH = 111 - elseif (KGEANT.eq.17) then - KPYTH = 221 - elseif (KPYTH.eq.111) then - KGEANT = 7 - elseif (KPYTH.eq.221) then - KGEANT = 17 - else -c -c invalid codes -cc - write (6,*) ' *** pi_plot illegal code KGEANT, KPYTH =' , - 1 KGEANT,KPYTH - pi_plot =0 - return - endif -c -C - IF(ifirst.EQ.1.OR.IDNEVT.EQ.ievstart) THEN - IF (IDH.NE.0.AND.HEXIST(IDH) .or.HEXIST(IDH+1).or. - 1 HEXIST(IDH+2).or.HEXIST(IDH+3)) THEN - CALL HRESET(IDH,' ') - CALL HRESET(IDH+1,' ') - CALL HRESET(IDH+2,' ') - CALL HRESET(IDH+3,' ') - ievstart=IDNEVT - ELSE - WRITE(6,*) ' *** ERROR: no histogram ID=', - 1 IDH,idh+1,idh+2,idh+3 - ENDIF - ENDIF - ifirst=0 -C - nfind=0 - itopol =0 -C - DO ip=1,NP - ifind=0 -c -c find pi0 or eta -c - IF(KPYTH.EQ.ITYP(3,ip)) THEN - ip1 = ityp(5,ip) - ip2 = ityp(6,ip) - -c write(6,*) ifind,KGEANT,KPYTH,(ITYP(jj,ip),jj=1,6) -c -c check decay products are photons -c - If (ip2.eq.ip1+1) then - if ( ityp(3,ip1).eq. 22 .and. ityp(3,ip2).eq.22) then - - nfind=nfind+1 - ifind = 1 -c - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip1)**2 - ENDDO - pf1=SQRT(qq) - th1=ACOS(POUT(3,ip1)/pf1)*180./3.1416 -c - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip2)**2 - ENDDO - pf2=SQRT(qq) - th2=ACOS(POUT(3,ip2)/pf2)*180./3.1416 - -c write (6,*) 'ip1, pf1, th1=',ip1,pf1,th1, -c 1 ' ip2, pf2,th2=',ip2,pf2,th2 -c -c invariant mass -c - ivmass = sqrt(2*(pf1*pf2 - pout(1,ip1)*pout(1,ip2) - 1 - pout(2,ip1)*pout(2,ip2) - 2 - pout(3,ip1)*pout(3,ip2) )) -c write (6,*) ' ivmass =', ivmass - - -c -c determine topology -c nominal: fcal 1-11 deg, bcal 11-126 deg -c - fcal1 = th1.gt.1 .and. th1.lt.11.and. pf1.gt.fcal_thresh - fcal2 = th2.gt.1 .and. th2.lt.11.and.pf2.gt.fcal_thresh - bcal1 = th1.gt.11 .and. th1.lt.126.and. pf1.gt.bcal_thresh - bcal2 = th2.gt.11 .and. th2.lt.126.and.pf2.gt.bcal_thresh - if (fcal1 .and. fcal2) then - itopol = 1 -c write (6,*) ' fcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - elseif (bcal1 .and. bcal2) then - itopol = 2 -c write (6,*) ' bcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - elseif (fcal1.and. bcal2 .or. bcal1.and.fcal2) then - itopol = 3 -c write (6,*) ' fcal-bcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - else - itopol = 4 -c write (6,*) ' None th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - endif - - endif - - - endif - ENDIF - - IF(ifind.NE.0) THEN -C - IF(IFL.EQ.0) THEN - if (itopol .eq. 1) then - CALL HFILL(IDH,pf1,0.,1.) - CALL HFILL(IDH,pf2,0.,1.) - elseif (itopol .eq. 2) then - CALL HFILL(IDH+1,pf1,0.,1.) - CALL HFILL(IDH+1,pf2,0.,1.) - elseif (itopol .eq. 3) then - CALL HFILL(IDH+2,pf1,0.,1.) - CALL HFILL(IDH+2,pf2,0.,1.) - else - CALL HFILL(IDH+3,pf1,0.,1.) - CALL HFILL(IDH+3,pf2,0.,1.) - endif -c - ELSE IF(IFL.EQ.1) THEN - if (itopol .eq. 1) then - CALL HFILL(IDH,th1,0.,1.) - CALL HFILL(IDH,th2,0.,1.) - elseif (itopol .eq. 2) then - CALL HFILL(IDH+1,th1,0.,1.) - CALL HFILL(IDH+1,th2,0.,1.) - elseif (itopol .eq. 3) then - CALL HFILL(IDH+2,th1,0.,1.) - CALL HFILL(IDH+2,th2,0.,1.) - else - CALL HFILL(IDH+3,th1,0.,1.) - CALL HFILL(IDH+3,th2,0.,1.) - endif - - ELSE IF(IFL.EQ.2) THEN - CALL HFILL(IDH,th1,pf1,1.) - ENDIF - ENDIF - ENDDO -C -c if (nfind.gt.0) write (6,*) -c 1 ' icnt, idnevt, nfind, itopol=', icnt, idnevt,nfind, itopol - pi_plot = nfind*10 + itopol -C - RETURN - END diff --git a/src/programs/Simulation/bggen/paw/plot_pi0_photons.kumac b/src/programs/Simulation/bggen/paw/plot_pi0_photons.kumac deleted file mode 100644 index 5100d489eb..0000000000 --- a/src/programs/Simulation/bggen/paw/plot_pi0_photons.kumac +++ /dev/null @@ -1,145 +0,0 @@ -macro plot_pi0_photons -* -* Plot histograms obtained using pi_plot from the bggen.nt file -* 02/09/11 ES -* -* Note: the input bggen file should be produced assigning the negative values for pi0 (-7) and -* eta (-17) in the pythia-geant.map file to allow decays in pythia (via bggen). -* -* -* set options -* -hi/create/title_global 'BGGEN (E=1-6 GeV) [p]^0! /10 MeV/s, E[g]"G#0.5GeV' -* hi/create/title_global 'BGGEN (E=1-6 GeV) [c] /10 MeV/s, E[g]"G#0.5GeV' -* hi/create/title_global 'BGGEN (E=1-10GeV) [p]^0! /10 MeV/s E"G#0.1,0.06GeV' -* hi/create/title_global 'BGGEN (E=1-10GeV) [c] /10 MeV/s, E"G#0.1,0.06GeV' -option ndate -option nbox -* set stat 1111111 -set stat 1111 -option stat -set fit 111 -option fit -option ngrid -* -* plotting options -* -* set * -set xmgl 4. -set ymgl 4. -set asiz 0.4 -* set xlab 2. -set xlab 1.25 -set ylab 1. -set xsiz 20. -set xmgl 3. -set ymgl 3. -set ysiz 20. -set gsiz 0.4 -* -* set font definitions to bold roman -* -set CFON -21 -set GFON -21 -set LFON -21 -set TFON -21 -set VFON -21 -set txfp -21 -set SMGU 0.02 -set SMGR 0.02 -set CSIZ 0.33 -set VSIZ 0.3 -set TSIZ 0.35 -set YHTI 0.9 -set HWID 3.0 -set BWID 3.0 -* -zone -* -* get ntuple -* -h/file 2 bggen.nt 0 -x -* -* define histograms per 10 MeV -emin=0 -emax=4 -thetamin=0 -thetamax=180 -* -message emin=[emin] emax=[emax], thetamin=[thetamin] thetamax=[thetamax] -* -* momentum -* -1dh 100 'E[g] (GeV), fcal only photons' 400 [emin] [emax] -1dh 101 'E[g] (GeV), bcal only photons' 400 [emin] [emax] -1dh 102 'E[g] (GeV), fcal and bcal photons' 400 [emin] [emax] -1dh 103 'E[g] (GeV), failed photons' 400 0 4 -* -* angle -* -* 1dh 100 '[q] (deg), fcal only photons' 180 [thetamin] [thetamax] -* 1dh 101 '[q] (deg), bcal only photons' 180 [thetamin] [thetamax] -* 1dh 102 '[q] (deg), fcal and bcal photons' 180 [thetamin] [thetamax] -* 1dh 103 '[q] (deg), failed photons' 180 [thetamin] [thetamax] -* -npts1 = 1001 -* wait -ymin=0 -ymax=10000 -* KPHYTH flags gamma=22, pi0=111, eta=221 -nevents=999999999 -* -nt/plot //lun2/9.pi_plot.f(0,0,111,100) pin(3,1).gt.1.and.pin(3,1).lt.6 [nevents] -* nt/plot //lun2/9.pi_plot.f(0,0,221,100) pin(3,1).gt.1.and.pin(3,1).lt.6 [nevents] -* nt/plot //lun2/9.pi_plot.f(1,0,111,100) ! [nevents] -* nt/plot //lun2/9.pi_plot.f(1,0,221,100) ! [nevents] -* -zone 2 2 -* -* open metafile -* -for/file 66 plot_pi0_photons_E1-6.ps -meta 66 -111 -* for/file 66 plot_pi0_photons_angle_cut2.eps -* meta 66 -113 -* -* -option stat -option logy -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Fcal only p (GeV)' 'Photons/10 MeV/s' -* hi/plot 100 's' -hi/plot 100 -* igset chhe 0.3 -* exe window#push -* itx 0 1.1 'Angle "G# 10 deg' -* exe window#pop -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Bcal only p (GeV)' 'Photons/10 MeV/s' -* hi/plot 101 's' -hi/plot 101 -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Fcal and Bcal p (GeV)' 'Photons/10 MeV/s' -* hi/plot 102 's' -hi/plot 102 -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Failed p (GeV)' 'Photons/10 MeV/s' -* hi/plot 103 's' -hi/plot 103 - -* -* -* - close 66 -* -exitm -return - diff --git a/src/programs/Simulation/bggen/run/fort.15 b/src/programs/Simulation/bggen/run/fort.15 deleted file mode 120000 index 32480f7b00..0000000000 --- a/src/programs/Simulation/bggen/run/fort.15 +++ /dev/null @@ -1 +0,0 @@ -run.ffr \ No newline at end of file diff --git a/src/programs/Simulation/bggen/run/particle.dat b/src/programs/Simulation/bggen/run/particle.dat deleted file mode 100644 index 309fc4b507..0000000000 --- a/src/programs/Simulation/bggen/run/particle.dat +++ /dev/null @@ -1,21 +0,0 @@ -* # mass width decay prod decay angle - 1 0.0 0. 0 0 0 0 - 2 0.000511 0. 0 0 0 0 - 3 0.000511 0. 0 0 0 0 - 4 0.0 0. 0 0 0 0 - 5 0.1057 0. 0 0 0 0 - 6 0.1057 0. 0 0 0 0 - 7 0.1350 0. 0 0 0 0 - 8 0.1396 0. 0 0 0 0 - 9 0.1396 0. 0 0 0 0 - 13 0.9396 0. 0 0 0 0 - 14 0.9383 0. 0 0 0 0 - 17 0.5475 0. 0 0 0 0 - 33 0.782 0. 0 0 0 0 - 34 1.0194 0. 0 0 0 0 - 35 0.9578 0. 0 0 0 0 - 42 0.7755 0. 0 0 0 0 - 43 0.7755 0. 0 0 0 0 - 44 0.7755 0. 0 0 0 0 - 80 0.7755 0.151 9 8 0 1 - 82 1.232 0.118 14 8 0 0 diff --git a/src/programs/Simulation/bggen/run/pythia-geant.map b/src/programs/Simulation/bggen/run/pythia-geant.map deleted file mode 100644 index cf78fab658..0000000000 --- a/src/programs/Simulation/bggen/run/pythia-geant.map +++ /dev/null @@ -1,41 +0,0 @@ -! GEANT --> PYTHIA map -! GEANT type= id >0 (regular) - PYTHIA decays are forbidden -! type=-id PYTHIA decays are allowed -! GEANT PYTHIA Comment -! type KF - 1 22 ! gamma - 2 -11 ! e+ - 3 11 ! e- - 4 12 ! neutrino - 5 -13 ! mu+ - 6 13 ! mu- - 7 111 ! pi0 - 8 211 ! pi+ - 9 -211 ! pi- - 10 130 ! K0L - 11 321 ! K+ - 12 -321 ! K- - 13 2112 ! neutron - 14 2212 ! proton - 15 -2212 ! antiproton - 16 310 ! K0S - 17 221 ! eta - 18 3122 ! Lambda0 - 19 3222 ! Sigma+ - 20 3212 ! Sigma0 - 21 3112 ! Sigma- - 22 3322 ! Xi0 - 23 3312 ! Xi- - 24 3334 ! Omega- - 25 -2112 ! antineutron - 26 -3122 ! antiLambda0 - 27 -3112 ! antiSigma- - 28 -3212 ! antiSigma0 - 29 -3222 ! antiSigma+ - 30 -3322 ! antiXi0 - 31 -3312 ! antiXi+ - 32 -3334 ! antiOmega+ --80 113 ! rho 0 --81 223 ! omega0 --82 2224 ! Delta++ - diff --git a/src/programs/Simulation/bggen/run/pythia.dat b/src/programs/Simulation/bggen/run/pythia.dat deleted file mode 100644 index 4c3a7afc86..0000000000 --- a/src/programs/Simulation/bggen/run/pythia.dat +++ /dev/null @@ -1,52 +0,0 @@ -! below follows commands sent to PYGIVE -msel=2 -MSTP(13)=2 -! MSTP(17)=6 -! MSTP(20)=4 -MSTP(20)=0 -! MSTP(38)=4 -! MSTP(51)=11 ! if pdflib is linked than non pythia-pdfs are available, -! like MSTP(51)=4046 -MSTP(58)=4 -! MSTP(61)=0 -! MSTP(71)=0 -! MSTP(81)=0 -! MSTP(82)=1 -MSTP(92)=4 -MSTP(101)=1 -MSTP(121)=1 -! ----------- Now all the PARPs ----------- -! PARP(2)=3.5 ! ecm, E_gamma =6.06 GeV -PARP(2)=2.54739 ! ecm, E_gamma =3.00 GeV -PARP(18)=0.17 -PARP(89)=1000 -PARP(91)=0.40 -PARP(93)=2. -PARP(99)=0.40 -PARP(102)=0.5 -PARP(103)=0.5 -PARP(104)=0.3 -PARP(111)=0. -PARP(121)=2. -PARP(161)=3.00 -PARP(162)=24.6 -PARP(165)=0.47679 -PARP(166)=0.67597 -! ----------- Now come all the switches for Jetset ----------- -PARJ(1)=0.029 -PARJ(2)=0.283 -PARJ(3)=1.20 -PARJ(21)= 0.40 -PARJ(23)=0.03 -PARJ(41)= 1.94 -PARJ(42)= 0.544 -PARJ(45 )= 1.05 -!---------------------------------------------------------------------- -MSTJ(12)=1 -MSTJ(45)=4 -MSTU(112)=4 -MSTU(113)=4 -MSTU(114)=4 -! ----------- Now all the CKINs for pythia ----------- -CKIN(1)=1. -CKIN(66)=100.0 ! Max for Q^2 diff --git a/src/programs/Simulation/bggen/run/run.ffr b/src/programs/Simulation/bggen/run/run.ffr deleted file mode 100644 index 390edafa48..0000000000 --- a/src/programs/Simulation/bggen/run/run.ffr +++ /dev/null @@ -1,25 +0,0 @@ -LIST -C -C === INPUT file for BGGEN -C -TRIG 395000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -- writing out events -C HDDM simple ntuple -WROUT 1 0 0 - -NPRIEV 100 number of events to print -EPHLIM 0.15 10. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 10. electron beam energy -EPEAK 9.999 coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm -DCOLLIM 0.005 collimator diameter in m - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -RUNNO 2 specify run number - -STOP diff --git a/src/programs/Simulation/bggen_jpsi/Makefile b/src/programs/Simulation/bggen_jpsi/Makefile deleted file mode 100644 index 6dd418dd6b..0000000000 --- a/src/programs/Simulation/bggen_jpsi/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -DIRS += code - -include $(HALLD_HOME)/src/BMS/Makefile.dirs diff --git a/src/programs/Simulation/bggen_jpsi/README b/src/programs/Simulation/bggen_jpsi/README deleted file mode 100644 index f46e164ae0..0000000000 --- a/src/programs/Simulation/bggen_jpsi/README +++ /dev/null @@ -1,170 +0,0 @@ - E.Chudakov Jan 17, 2008 - - This directory contains the code and tools to generate the photoproduction - of hadronic events in a wide energy range of E>0.15 GeV, matching the total - photoproduction cross section. It can be used to calculate the hadronic - background for GLUEX etc. - The photon beam spectrum is calculated using the code from R.Jones for - the coherent bremsstrahlung. - - There are two effective energy ranges: - 1) E>3 GeV : PYTHIA is used - 2) 0.15 PYTHIA particle codes - - particle.dat - a list of particle properties used for the low energy mode (2) - - One file is used to control the job and to set the number of events to simulate, - the energy range etc. - - fort.15 linked to run.ffr - list of commands and definitions in the FFREAD format - An example of the file is attached: -------------------------------------------------------------------- -LIST -C -C === INPUT file for BGGEN -C -TRIG 395000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -RUNNO 9000 run number of generated events, default is two -C -C -- writing out events -C HDDM simple ntuple -WROUT 1 1 1 - -NPRIEV 100 number of events to print -EPHLIM 0.15 12. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 12. electron beam energy -EPEAK 9. coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -STOP -------------------------------------------------------------------- - - - - Compilation: - > cd code - > make - makes ./.bin/bggen - - - Running: - > cd ../run/ - > ../code/.bin/*/bggen > log - - Output files: - - bggen.his - histograms - - 1) bggen.hddm - HDDM file with events - 2) bggen.dat - sequential file with events - 3) bggen.nt - CW-ntuple with events - See the flag WROUT. - - - In order to study the output one can use the ntuple: - > cd ../paw/ - PAW> exec example_1 - plots several variables of interest - - A code to read the output file bggen.dat: - > cd ../paw/ - > make - > ./bgg_read.exe - - An example of the event printout is attached. - The first 2 lines describe the beam and the target particles: - 1) GEANT code - 2) Particle Data Group code (PDG) = KF (PYTHIA) - 3) mass - 4)-6) - 3-momentum - The next lines are the secondary particles: - 1) # - 2) GEANT code - 3)-7) PYTHIA-type codes: - - k1 =1 - final particle, <>1 - intermediate particle (not to be used with GEANT) - - k2 =KF=PDG code - - k3 >0 - reference to the origin particle #=k3 - - k4 >0 - the first # of the decay product - - k5 >0 - the last # of the decay product - 8) mass - 9)-11) - 3-momentum - - Event 95 Process= 0 PYTHIA - GEANT PDG mass Px Py Pz - beam 1 22 0.0000 0.000 0.000 11.896 - target 14 2212 0.9383 0.000 0.000 0.000 - # GEANT k1 kf=PDG origin decay pr mass Px Py Pz - 1 0 12 -2 0 5 5 0.3300 -0.098 0.112 2.564 - 2 0 11 2 0 5 5 0.3300 0.104 -0.043 0.364 - 3 0 12 2 0 8 8 0.3300 0.098 -0.112 9.123 - 4 0 11 2101 0 8 8 0.5793 -0.104 0.043 -0.156 - 5 0 11 91 1 6 7 0.9954 0.006 0.069 2.929 - 6 9 1 -211 5 0 0 0.1396 0.060 0.212 1.116 - 7 0 11 213 5 13 14 0.6969 -0.054 -0.143 1.813 - 8 0 11 92 3 9 12 3.8021 -0.006 -0.069 8.968 - 9 17 1 221 8 0 0 0.5475 0.226 0.286 1.786 - 10 8 1 211 8 0 0 0.1396 0.157 -0.346 4.118 - 11 0 11 331 8 15 17 0.9579 0.101 0.016 1.864 - 12 13 1 2112 8 0 0 0.9396 -0.491 -0.025 1.199 - 13 8 1 211 7 0 0 0.1396 -0.009 -0.169 1.788 - 14 7 1 111 7 0 0 0.1350 -0.045 0.026 0.025 - 15 7 1 111 11 0 0 0.1350 0.105 0.085 0.225 - 16 7 1 111 11 0 0 0.1350 0.117 -0.065 0.373 - 17 17 1 221 11 0 0 0.5475 -0.120 -0.004 1.266 - Event 96 Process= 1 p pi0 - beam 1 22 0.0000 0.000 0.000 0.267 - target 14 2212 0.9383 0.000 0.000 0.000 - 1 14 1 2212 0 0 0 0.9383 0.067 -0.114 0.334 - 2 7 1 111 0 0 0 0.1350 -0.067 0.114 -0.067 - Event 97 Process= 4 p rho0 - beam 1 22 0.0000 0.000 0.000 1.387 - target 14 2212 0.9383 0.000 0.000 0.000 - 1 14 1 2212 0 0 0 0.9383 0.363 0.120 0.715 - 2 0 10 113 0 3 4 0.7616 -0.363 -0.120 0.673 - 3 8 1 211 2 0 0 0.1396 -0.063 0.245 0.473 - 4 9 1 -211 2 0 0 0.1396 -0.300 -0.365 0.200 - - - The output printout contains: - ==================================================================================================== - Events Simulated: 10000 Reference interaction rate: 394.67 kHz - process events fraction range - ---------------------------------------------------------------------------------------------------- - 0 PYTHIA 2161 21.6 % 3.000 - write out the HDDS file (events) (F) -C (2)>0 - write out a sequential file -C (3)>0 - write out an ntuple file - + ,LUNWR ! (1) LUN for HDDS file -C (2) LUN for the sequential file -C (3) LUN for the ntuple file - + ,IRND_SEQ ! the random number sequence (each integer number gives a different sequence) (F) - + ,NPRIEV ! number of events to print - + ,IDBEAM ! histogram ID for the beam (=0 - fixed energy) (F) - + ,NHBEA ! number of bins in IDBEAM - + ,IFPYTH ! PYTHIA is used - + ,IDLOWEN ! <>0 - starting ID of histograms for the low energy generator - + ,ISIMUL ! =0 - regular BGGEN (background low_en+PYTHIA), =1 - J/psi - + ,IPINIT ! 1:2 initial particles GEANT numbers (1 - photon, 14 - proton) (F) - INTEGER IPLUND ! PYTHIA particle codes (KF) - + ,IDECLUND ! =0 - forbid the decays of this particle in PYTHIA - INTEGER KCGEAN ! GEANT code for the PYTHIA internal code KC (with sign) - REAL EPH_LIM ! limits on the photon beam energy GeV (F) - + ,EELEC ! electron beam energy (F) - + ,EPEAK ! energy of the coherent peak (the right edge) (F) - + ,DCOLL ! collimator diameter (m) (F) - + ,ZCOLL ! distance to the collimator (cm) (F) - + ,EPYMIN ! minimal energy for PYTHIA, (F) -C below that the low energy generator is used -C the value may be adjusted to the bin boundary of IDBEA - + ,ELOWMIN ! minimal energy for the low energy generator (F) - + ,RATESEC ! reference interation rate (Hz), calculated - + ,VERTEX ! Vertex set in HDDM output file (cm) n.b. 0,0,0 is the default which means hdgeant will use its default, 0,0,65 -C - - diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_end.F b/src/programs/Simulation/bggen_jpsi/code/bg_end.F deleted file mode 100644 index 59cc121b8f..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_end.F +++ /dev/null @@ -1,39 +0,0 @@ - SUBROUTINE BG_END -C -C--- End of the job for BG simulation -C - IMPLICIT NONE -C - INCLUDE 'bg_ctrl.inc' -C - INTEGER icycle,lun,lrec,idnt,iost -C - IF(IWROUT(1).NE.0) THEN - CALL CLOSE_HDDM_OUTPUT - ENDIF -C - IF(IWROUT(2).NE.0) THEN - CLOSE(UNIT=LUNWR(2)) - WRITE(6,*) ' Closed output data file LUN=',LUNWR(2) - ENDIF -C - IF(IWROUT(3).NE.0) THEN - icycle=0 - idnt=9 - CALL HCDIR('//bgkin',' ') - CALL HROUT(idnt,icycle,' ') - CALL HREND('bgkin') - CLOSE(UNIT=LUNWR(3)) - WRITE(6,*) ' Closed output ntuple file LUN=',LUNWR(3) - ENDIF -C - lun=9 - lrec=1024 - CALL HROPEN(lun,'HISOUT','bggen.his','N',lrec,iost) - CALL HROUT(0,icycle,' ') - CALL HREND('HISOUT') - CLOSE(UNIT=lun) - WRITE(6,*) ' Histograms written to file bggen.his' -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_eve.F b/src/programs/Simulation/bggen_jpsi/code/bg_eve.F deleted file mode 100644 index 5a990697b2..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_eve.F +++ /dev/null @@ -1,154 +0,0 @@ - SUBROUTINE BG_EVE(IPRI) -C -C--- Simulates one BG event -C IPRI>0 - print this event -C - IMPLICIT NONE - INTEGER IPRI -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_evec.inc' -C - REAL HRNDM1 - LOGICAL HEXIST -C - INTEGER i,j,ip,ierr,lout,idnt - REAL ebeam - CHARACTER cent(2)*6,cproc*16 -C - REAL ptmp1(4,2),ptmp2(4,MXTRA) ! auxill. arrays to simplify the HDDM mapping - INTEGER ifl1(6,2),ifl2(6,MXTRA) -C -C ------------------------------------------------------------------ -C - lout=6 - IEVPROC=-1 - INDUM(1)=0 - INDUM(2)=0 - cent(1)='beam ' - cent(2)='target' -C -C--- Beam energy -C - IF(IDBEAM.EQ.0.OR..NOT.HEXIST(IDBEAM)) GO TO 999 -C - ebeam=HRNDM1(IDBEAM) -C -C--- Beam/target definitions -C -c ITPIN(1,1)=1 ! beam GEANT type -c ITPIN(1,2)=14 ! beam target type - ITPIN(1,1)=IPINIT(1) ! beam GEANT type - ITPIN(1,2)=IPINIT(2) ! beam target type - ITPIN(2,1)=IPLUND(ITPIN(1,1)) ! KF types - ITPIN(2,2)=IPLUND(ITPIN(1,2)) -C - DO i=1,2 - AMIN(i)=AM_PART(ITPIN(1,i)) - ENDDO - DO i=1,3 - PIN(i,1)=0. - PIN(i,2)=0. - ENDDO - PIN(3,1)=ebeam -C - NTRA=0 -C -C--- Choose the package -C - ierr=0 - IF(ISIMUL.EQ.0) THEN - IF(ebeam.LT.EPYMIN) THEN -C - CALL LOWEN_EVE(ierr) - IF(IEVPROC.GT.0) cproc=CNPROC(IEVPROC) -C - ELSE -C - CALL PYTH_EVE(ierr) - cproc='PYTHIA' -C - ENDIF -C - ELSEIF(ISIMUL.EQ.1) THEN - CALL REAC_EVE(ierr) - ENDIF - - IF(ierr.NE.0) GO TO 999 -C -C--- Remove the GEANT type for the decaying particles (KF type is retained) -C needed to avoid copying these particles into GEANT -C - DO i=1,NTRA - IF(ITPTRA(2,i).NE.1.AND.ITPTRA(3,i).NE.0) ITPTRA(1,i)=0 - ENDDO -C -C--- Print the event -C - IF(IPRI.NE.0) THEN - WRITE(lout,1000) IEVENT,IEVPROC,cproc - 1000 FORMAT(' Event ',I6,' Process=',I4,3X,A16) - WRITE(lout,1005) - + (cent(i),(ITPIN(j,i),j=1,2),AMIN(i),(PIN(j,i),j=1,3),i=1,2) - 1005 FORMAT(1X,A6,3X,I3,2X,I5,3X,4X,F8.4,3X,3F8.3) - WRITE(lout,1010) - + (i,(ITPTRA(j,i),j=1,6),AMTRA(i),(PTRA(j,i),j=1,3),i=1,NTRA) - 1010 FORMAT(1X,I3,3X,I3,I6,2X,I5,3X,3I4,4X,F8.4,3X,3F8.3) - ENDIF -C -C--- Output file for HDDM -C - IF(IWROUT(1).NE.0) THEN - DO i=1,2 - DO j=1,6 - ifl1(j,i)=0 - ENDDO - ifl1(1,i)=ITPIN(1,i) - ifl1(3,i)=ITPIN(2,i) - DO j=1,3 - ptmp1(j,i)=PIN(j,i) - ENDDO - ptmp1(4,i)=SQRT(ptmp1(1,i)**2+ptmp1(2,i)**2+ptmp1(3,i)**2 - + +AMIN(i)**2) - ENDDO - DO i=1,NTRA - DO j=1,6 - ifl2(j,i)=ITPTRA(j,i) - ENDDO -C - DO j=1,3 - ptmp2(j,i)=PTRA(j,i) - ENDDO - ptmp2(4,i)=SQRT(ptmp2(1,i)**2+ptmp2(2,i)**2+ptmp2(3,i)**2 - + +AMTRA(i)**2) - ENDDO - CALL WRITE_HDDM_EVENT(RUNNO, IEVENT,IEVPROC - + ,ifl1(1,1),ptmp1(1,1) - + ,NTRA,ifl2(1,1),ptmp2(1,1)) -C write(6,1010) (i,(ifl1(j,i),j=1,6),(ptmp1(j,i),j=1,4),i=1,2) -C write(6,1010) (i,(ifl2(j,i),j=1,6),(ptmp2(j,i),j=1,4),i=1,NTRA) - ENDIF -C -C--- Sequential output file -C - IF(IWROUT(2).NE.0) THEN - WRITE(LUNWR(2)) IEVENT,IEVPROC - + ,(( ITPIN(j,i),j=1,2), AMIN(i),( PIN(j,i),j=1,3),i=1,2) - + ,NTRA,((ITPTRA(j,i),j=1,6),AMTRA(i),(PTRA(j,i),j=1,3),i=1,NTRA) - ENDIF -C -C--- NTUPLE -C - IF(IWROUT(3).NE.0) THEN - idnt=9 - CALL HFNT(idnt) - ENDIF -C - 999 CONTINUE -C write(6,*) ebeam,IEVPROC,ibin,xstot,xssum,NTRA -C - END -C - diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_evec.inc b/src/programs/Simulation/bggen_jpsi/code/bg_evec.inc deleted file mode 100644 index b130acd15a..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_evec.inc +++ /dev/null @@ -1,23 +0,0 @@ -C -C--- Simulated event -C - INTEGER MXTRA - PARAMETER (MXTRA=100) - COMMON/EV_RECORD/ IEVENT,INDUM(2),IEVPROC - + ,ITPIN(2,2),AMIN(2),PIN(3,2) - + ,NTRA - + ,ITPTRA(6,MXTRA),AMTRA(MXTRA),PTRA(3,MXTRA) - INTEGER IEVENT ! event number - + ,INDUM ! dummies (for later use) - + ,IEVPROC ! the process number (=0 - PYTHIA) - + ,ITPIN ! (1,k)=GEANT type, (2,k) - KF (LUND), k=1 - beam, =2 -target - + ,NTRA ! number of particles including the beam and the target - + ,ITPTRA ! (1,k) track type (GEANT), (2-6,k) - LUND flags (KS,decays) - REAL AMIN ! masses of the beam and the target - + ,PIN ! (1-3,k) - 3-momenta, k=1 - beam, k=2 - target - + ,AMTRA ! secondary particles' masses - + ,PTRA ! 3-momenta - -C - - diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_hddm.c b/src/programs/Simulation/bggen_jpsi/code/bg_hddm.c deleted file mode 100644 index 044138f8eb..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_hddm.c +++ /dev/null @@ -1,158 +0,0 @@ -#include - -#include "HDDM/hddm_s.h" - -s_iostream_t* hddmOutputStream=NULL; - -void bg_getvertex_(float myvertex[3]); - -typedef struct { - int geantid; - int mech; /* what do the values of this correspond to */ - int kfid; - int parent; - int firstdaughter; - int lastdaughter; -} keve_t; - -typedef struct { - float px; - float py; - float pz; - float en; -} peve_t; - -/*----------------- -// open_hddm_output_ -//-----------------*/ -void open_hddm_output_(const char *outputfile, int len) -{ - /* Copy FORTRAN string into a C-style string */ - char outfile[256]; - strncpy(outfile, outputfile, len); - outfile[len]=0; - - /* Open output file */ - hddmOutputStream = init_s_HDDM(outfile); - if (! hddmOutputStream) { - fprintf(stderr, "Unable to open output file \"%s\" for writing.\n", outfile); - exit(-3); - } - - printf("Opened HDDM file \"%s\" for writing ...\n", outfile); -} - -/*----------------- -// close_hddm_output_ -//-----------------*/ -void close_hddm_output_(void) -{ - /* Close output file */ - close_s_HDDM(hddmOutputStream); - - printf("Closed HDDM output file\n"); -} - -/*----------------- -// write_hddm_event_ -//-----------------*/ -void write_hddm_event_(int *runno, int *iev, int *iproc, - keve_t *kin, peve_t *pin, - int *ntra, keve_t *keve, peve_t *peve) -{ - /* Loop over events */ - int i; - static int Nevents = 0; - static int Nevents_written = 0; - int runNumber = *runno; - float vertex[3]={0.0, 0.0, 0.0}; - - Nevents++; - - /* Start a new event */ - s_PhysicsEvents_t* pes; - s_Reactions_t* rs; - s_Beam_t* bs; - s_Momentum_t *mom; - s_Properties_t *prop; - s_Target_t* ts; - s_Vertices_t* vs; - s_Origin_t* origin; - s_Products_t* ps; - - s_HDDM_t *thisOutputEvent = make_s_HDDM(); - thisOutputEvent->physicsEvents = pes = make_s_PhysicsEvents(1); - pes->mult = 1; - pes->in[0].runNo = runNumber; - pes->in[0].eventNo = Nevents; - pes->in[0].reactions = rs = make_s_Reactions(1); - rs->mult = 1; - rs->in[0].type = *iproc; - - rs->in[0].beam = bs = make_s_Beam(); - bs->type = kin[0].geantid; - bs->momentum = mom = make_s_Momentum(); - mom->px = pin[0].px; - mom->py = pin[0].py; - mom->pz = pin[0].pz; - mom->E = pin[0].en; - bs->properties = prop = make_s_Properties(); - prop->charge = 0.0; - prop->mass = 0.0; - - rs->in[0].target = ts = make_s_Target(); - ts->type = kin[1].geantid; - ts->momentum = mom = make_s_Momentum(); - mom->px = pin[1].px; - mom->py = pin[1].py; - mom->pz = pin[1].pz; - mom->E = pin[1].en; - ts->properties = prop = make_s_Properties(); - prop->charge = +1; - prop->mass = 0.938272; /* this should be derived from type ... */ - - rs->in[0].vertices = vs = make_s_Vertices(1); - vs->mult = 1; - vs->in[0].origin = origin = make_s_Origin(); - vs->in[0].products = ps = make_s_Products(*ntra); - ps->mult = 0; - - // Copy vertex values from FORTRAN common block - bg_getvertex_(vertex); - - origin->t = 0.0; - origin->vx = vertex[0]; - origin->vy = vertex[1]; - origin->vz = vertex[2]; - - for (i=0; i < *ntra; i++) { - /* double E2; unused so commented out 12/18/2013 DL */ - //if(keve[i].geantid==0)continue; - - ps->in[ps->mult].type = keve[i].geantid; - ps->in[ps->mult].mech = keve[i].mech; - ps->in[ps->mult].pdgtype = keve[i].kfid; - ps->in[ps->mult].id = i+1; - ps->in[ps->mult].parentid = keve[i].parent; - - - ps->in[ps->mult].momentum = make_s_Momentum(); - ps->in[ps->mult].momentum->px = peve[i].px; - ps->in[ps->mult].momentum->py = peve[i].py; - ps->in[ps->mult].momentum->pz = peve[i].pz; - ps->in[ps->mult].momentum->E = peve[i].en; - ps->mult++; - } - - if ( *ntra > 0) { - Nevents_written++; - if (flush_s_HDDM(thisOutputEvent, hddmOutputStream) != 0) { - fprintf(stderr,"Error - write failed to output hddm file " - "after %d events were written.\n", Nevents_written); - exit(2); - } - if (Nevents_written%10000 == 0) - printf("Wrote event %d events (%d generated)\n", - Nevents_written, Nevents); - } -} diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_ini.F b/src/programs/Simulation/bggen_jpsi/code/bg_ini.F deleted file mode 100644 index 1cbd51ae0e..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_ini.F +++ /dev/null @@ -1,299 +0,0 @@ - SUBROUTINE BG_INI(IERR) -C -C--- Initialize the FFREAD and the relevant variables -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_reac.inc' -C - INTEGER mxffr,jffr - PARAMETER (mxffr=10000) - COMMON/CFREAD/ jffr(mxffr) -C - INTEGER ier -C - INTEGER i,j,lun,lout,iost,ip,kd(4),kf,lenc,idgea - REAL am,wg - CHARACTER cline*132 -C - lout=6 - IERR=1 -C - write(*,*) 'HI' -C - CALL HBOOK_INI -C - NEVENT=0 - RUNNO=2 - IWROUT(1)=1 - IWROUT(2)=0 - IWROUT(3)=0 - IRND_SEQ=0 - NPRIEV=0 - EPH_LIM(1)=0.15 - EPH_LIM(2)=12. - EELEC=12. ! electron energy - EPEAK=9. ! peak right edge - ZCOLL=7600. - DCOLL=0.0034 - EPYMIN=3. ! min energy for PYTHIA - ELOWMIN=0.15 - ISIMUL=0 ! regular BG (=1 - J/psi) - IPINIT(1)=1 ! photon - IPINIT(2)=14 ! proton -C - LUNWR(1)=0 ! HDDS file - LUN not used - LUNWR(2)=2 ! sequential file - LUNWR(3)=3 ! NTUPLE file -C - DO i=1,2 - IPREAC(i)=-1 - ENDDO - TSLREAC=-1. - ELREAC(1)=-1. - ELREAC(2)=-1. - NPXREAC=0 - DO i=1,MXPNTR - XSREAC(i)=0. - ESREAC(i)=0. - ENDDO -C--- Redefine FFREAD settings -C - CALL FFINIT(mxffr) - CALL FFSET('LINP',15) - CALL FFSET('LOUT',6) - CALL FFSET('SIZE',16) - CALL FFSET('LENG',120) -C - CALL FFKEY('TRIG' , NEVENT , 1,'INTEGER') - CALL FFKEY('RUNNO' , RUNNO , 1,'INTEGER') - CALL FFKEY('WROUT' , IWROUT(1) , 3,'INTEGER') - CALL FFKEY('RNDMSEQ' , IRND_SEQ , 1,'INTEGER') - CALL FFKEY('NPRIEV' , NPRIEV , 1,'INTEGER') - CALL FFKEY('EPHLIM' , EPH_LIM(1) , 2,'REAL') - CALL FFKEY('EELEC' , EELEC , 1,'REAL') - CALL FFKEY('EPEAK' , EPEAK , 1,'REAL') - CALL FFKEY('ZCOLLIM' , ZCOLL , 1,'REAL') - CALL FFKEY('DCOLLIM' , DCOLL , 1,'REAL') - CALL FFKEY('EPYTHMIN' , EPYMIN , 1,'REAL') - CALL FFKEY('ELOWMIN' , ELOWMIN , 1,'REAL') - CALL FFKEY('VERTEX' , VERTEX(1) , 3,'REAL') - CALL FFKEY('SIMUL' , ISIMUL , 1,'INTEGER') - CALL FFKEY('PARTINIT' , IPINIT(1) , 2,'INTEGER') - CALL FFKEY('REACPAR' , IPREAC(1) , MXPNTR+6,'MIXED') -C - CALL FFGO -C -C -C--- Read the particle masses (GEANT numbering) -C -cc - DO ip=1,MXPART - IFLPART(ip)=0 - AM_PART(ip)=0. - WG_PART(ip)=0. - DO i=1,4 - KD_PART(i,ip)=0 - ENDDO - ENDDO -C - lun=9 - OPEN(lun,FILE='particle.dat',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file particle.dat' - GO TO 999 - ENDIF - 10 READ(lun,FMT='(A)',IOSTAT=iost) cline - IF(iost.EQ.0) THEN -C - IF(cline(1:1).NE.'*'.AND.cline(1:1).NE.'C') THEN - READ(cline,*) ip,am,wg,kd -C write(6,*) ip,am,wg,kd - IF(ip.GT.0.AND.ip.LE.MXPART) THEN - IFLPART(ip)=1 - AM_PART(ip)=am - WG_PART(ip)=wg - DO i=1,4 - KD_PART(i,ip)=kd(i) - ENDDO - ELSE - WRITE(lout,*) ' --- ERROR: Reading file particle.dat ', - + 'GEANT index is out of range ',ip - ENDIF - ENDIF -C - GO TO 10 -C - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file particle.dat' - GO TO 999 - ENDIF -C - DO i=1,2 - ier=1 - IF(IPINIT(i).GT.0.OR.IPINIT(i).LE.MXPART) THEN - IF(IFLPART(IPINIT(i)).NE.0) THEN - ier=0 - ENDIF - ENDIF - IF(ier.NE.0) THEN - WRITE(6,1001) i,IPINIT(i) - 1001 FORMAT(' *** Init. error: PARTINIT:',I1,I5,' not defined') - GO TO 999 - ENDIF - ENDDO -C -C--- Read the GEANT<->PYTHIA particle table -C - DO i=1,MXPGEANT - IPLUND(i)=0 - IDECLUND(i)=0 - ENDDO - DO i=-MXPKC,MXPKC - KCGEAN(i)=0 - ENDDO -C - OPEN(lun,FILE='pythia-geant.map',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file pythia-geant.map' - GO TO 999 - ENDIF - 15 READ(lun,'(A)',IOSTAT=iost) cline - IF(iost.EQ.0) THEN -C - lenc=0 - DO i=1,LEN_TRIM(cline) - IF(cline(i:i).EQ.'!') GO TO 20 - lenc=i - ENDDO - 20 CONTINUE - IF(lenc.GE.3) THEN - READ(cline(1:lenc),*) j,kf - idgea=ABS(j) - ENDIF - IF(idgea.GT.0.AND.idgea.LE.MXPGEANT) THEN - IF(kf.NE.0) THEN - IPLUND(idgea) =kf - IF(j.LT.0) IDECLUND(idgea)=1 - ENDIF - ENDIF -C - GO TO 15 -C - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file pythia-geant.map' - GO TO 999 - ENDIF - CLOSE(lun) -C - CALL RND_INI(IRND_SEQ) ! random number initialization -C - IF(EPH_LIM(1).LT.ELOWMIN) THEN - WRITE(6,1005) ELOWMIN - 1005 FORMAT(' --- Initialization warning: EPH_LIM(1) is set' - + ,' to ELOWMIN:',F10.4) - EPH_LIM(1)=ELOWMIN - ENDIF -C - IF(EPH_LIM(1).GT.EPH_LIM(2)) THEN - WRITE(6,1000) EPH_LIM - 1000 FORMAT(' *** Initialization error: energy limits:',2F10.4) - GO TO 999 - ELSE IF(EPH_LIM(1).EQ.EPH_LIM(2)) THEN -C -C--- Increase E2 slightly in order to make a valid histogram -C - EPH_LIM(2)=EPH_LIM(1)*1.0001 -C - ELSE -C -C--- Bremsstrahlung beam: the E0 and Epeak should be cosistent -C - IF(EELEC.LT.EPH_LIM(2)) THEN - WRITE(6,1010) EELEC,EPH_LIM(2) - 1010 FORMAT(' *** Initialization error: EeEe:',2F10.4) - GO TO 999 - ENDIF -C - ENDIF -C - IF(ISIMUL.EQ.1) THEN ! J/psi and other binary reactions - ier=0 - DO i=1,2 - IF(IPREAC(i).LT.1.OR.IPREAC(i).GT.MXPART) ier=1 - ENDDO - IF(ELREAC(1).GT.EPH_LIM(2).OR.ELREAC(2).LT.EPH_LIM(1).OR. - + ELREAC(1).LT.0..OR.ELREAC(2).LT.0.) ier=2 - IF(NPXREAC.LT.2) ier=3 - IF(ier.NE.0) THEN - WRITE(6,1030) IPREAC,TSLREAC,ELREAC,NPXREAC - 1030 FORMAT(' *** Initialization error REAC: :',4I4,3E11.3,I6) - GO TO 999 - ENDIF - DO i=1,NPXREAC - ESREAC(i)=ELREAC(1)+(ELREAC(2)-ELREAC(1))/(NPXREAC-1)*(i-1) -C write(6,*) i,ESREAC(i) - ENDDO -C - ENDIF -C -C--- Beam spectrum -C - IDBEAM=9000 - NHBEA=0 - CALL COHBEAM_INI(IDBEAM,EELEC,EPEAK,EPH_LIM,ZCOLL,DCOLL) -C -C--- Pythia -C - IFPYTH=0 - IF(EPH_LIM(2).GT.EPYMIN) THEN - CALL PYTH_INI(ier) - IF(ier.NE.0) GO TO 999 - IFPYTH=1 - ENDIF -C -C--- Low energy processes -C - IDLOWEN=0 - IF(EPH_LIM(1).LT.EPYMIN) THEN - IDLOWEN=10000 - CALL LOWEN_INI(ier) - IF(ier.NE.0) GO TO 999 - ENDIF -C -C--- Output file for HDDM -C - IF(IWROUT(1).NE.0) THEN - CALL OPEN_HDDM_OUTPUT('bggen.hddm') - ENDIF -C -C--- Sequential output file -C - IF(IWROUT(2).NE.0) THEN - OPEN(LUNWR(2),FILE='bggen.dat',STATUS='UNKNOWN' - + ,FORM='UNFORMATTED') - ENDIF -C -C--- NTUPLE -C - IF(IWROUT(3).NE.0) THEN - CALL BG_NTUP_INI(ier) - IF(ier.NE.0) GO TO 999 - ENDIF -C - IERR=0 - 999 RETURN - END - - diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_ntup_ini.F b/src/programs/Simulation/bggen_jpsi/code/bg_ntup_ini.F deleted file mode 100644 index c1fde1742c..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_ntup_ini.F +++ /dev/null @@ -1,42 +0,0 @@ - SUBROUTINE BG_NTUP_INI(IERR) -C -C--- Initialize the ntuple -C - IMPLICIT NONE - INTEGER IERR -C - COMMON/QUEST/ IQUEST(100) - INTEGER IQUEST -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER lrec,idnt,iost - CHARACTER cpar*3 -C - IERR=1 - lrec=2048 - IQUEST(10)=128000 - CALL HROPEN(LUNWR(3),'bgkin','bggen.nt','N',lrec,iost) - IF(iost.NE.0) THEN - WRITE(6,*)'*** ERROR opening NTUPLE, iost=',iost - GO TO 999 - ENDIF - idnt=9 - CALL HBNT(idnt,'BGkinem',' ') - CALL HBNAME(idnt,'run',IEVENT,'ieve') - CALL HBNAME(idnt,'run',INDUM(1),'irun') - CALL HBNAME(idnt,'run',INDUM(2),'iend[-120,120]') - CALL HBNAME(idnt,'bgki',IEVPROC,'iproc') - CALL HBNAME(idnt,'bgki',ITPIN(1,1) ,'itypin(2,2)') - CALL HBNAME(idnt,'bgki',AMIN(1) ,'amin(2)') - CALL HBNAME(idnt,'bgki',PIN(1,1),'pin(3,2)') - WRITE(cpar,FMT='(I3)') MXTRA - CALL HBNAME(idnt,'bgki',NTRA,'np[0,'//cpar//']') - CALL HBNAME(idnt,'bgki',ITPTRA(1,1) ,'ityp(6,np)') - CALL HBNAME(idnt,'bgki',AMTRA(1) ,'am(np)') - CALL HBNAME(idnt,'bgki',PTRA(1,1),'pout(3,np)') -C - IERR=0 - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_partc.inc b/src/programs/Simulation/bggen_jpsi/code/bg_partc.inc deleted file mode 100644 index 79bc4c63d3..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_partc.inc +++ /dev/null @@ -1,16 +0,0 @@ -C -C--- Particle masses -C - INTEGER MXPART - PARAMETER (MXPART=100) - COMMON/BG_PARTC/ AM_PART(MXPART),WG_PART(MXPART) - + ,KD_PART(4,MXPART),IFLPART(MXPART) - REAL AM_PART ! (i) - particle mass GeV/c^2, i - GEANT number - + ,WG_PART ! full widths - + ,KD_PART ! (1-3) decay products (one decay allowed) -C ! (4) =0 - decay uniform in theta, =1 - like rho (sin**2), =2 - J/Psi-type - INTEGER IFLPART ! >0 if defined - -C - - diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_proc.inc b/src/programs/Simulation/bggen_jpsi/code/bg_proc.inc deleted file mode 100644 index 423c191572..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_proc.inc +++ /dev/null @@ -1,10 +0,0 @@ -C -C--- BG processes definitions -C - INTEGER MXPROC,MXOUT - PARAMETER (MXPROC=10,MXOUT=6) - COMMON/BG_PROC/ ITYPROC(MXOUT,MXPROC) - COMMON/BG_PROC1/ CNPROC(MXPROC) -C - INTEGER ITYPROC ! (1:6,iproc) - GEANT types (or 0) of the secondary particles for process iproc - CHARACTER CNPROC*16 ! (iproc) - the process description (name) diff --git a/src/programs/Simulation/bggen_jpsi/code/bg_reac.inc b/src/programs/Simulation/bggen_jpsi/code/bg_reac.inc deleted file mode 100644 index 04bcc14909..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bg_reac.inc +++ /dev/null @@ -1,15 +0,0 @@ -C -C--- A binary reaction definition: gamma+A-->B(recoil)+C -C - INTEGER MXPNTR - PARAMETER (MXPNTR=3000) - COMMON/BG_REAC/ IPREAC(2),TSLREAC,ELREAC(2),NPXREAC - + ,XSREAC(MXPNTR),ESREAC(MXPNTR) -C - INTEGER IPREAC ! (1:2) - GEANT types of the secondary particles (=0 - photon) (F) - + ,NPXREAC ! number of points in the array of energies/cross_sections (F) - REAL TSLREAC ! t-slope 1/(GeV/C)**2, ds/dt~exp(-TSLREAC*t) (F) - + ,ELREAC ! (1:2) min,max of the beam energy (F) - + ,ESREAC ! energies ELREAC(1)+(ELREAC(2)-ELREAC(1))/(NPXREAC-1)*i - + ,XSREAC ! (1:NPXREAC) cross sections in the points ESREAC (F) -C diff --git a/src/programs/Simulation/bggen_jpsi/code/bggen.cc b/src/programs/Simulation/bggen_jpsi/code/bggen.cc deleted file mode 100644 index 9df9598292..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bggen.cc +++ /dev/null @@ -1,11 +0,0 @@ - - -extern "C" void bggen_(void); - -int main(int narg, char *argv[]) -{ - bggen_(); - - return 0; -} - diff --git a/src/programs/Simulation/bggen_jpsi/code/bggen_F.F b/src/programs/Simulation/bggen_jpsi/code/bggen_F.F deleted file mode 100644 index 167528466e..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/bggen_F.F +++ /dev/null @@ -1,94 +0,0 @@ -C -C--- Simulates "background" photoproduction by a coherent Bremsstrahlung beam -C Reaction: gamma+p -C Control flags are read from fort.15 (FFREAD) -C E>3 GeV (can be changed in fort.15) - use PYTHIA -C E<3 GeV - a coctail of several dominating photoproduction processes -C -C Includes: a) calculation of the coherent+incoherent photon energy spectra -C b) parametrization for the cross sections: -C - full (formula fit to data) -C - p pi0, n pi+ - using SAID -C - p 2pi, n 2pi, p eta, p 3pi, n 3pi (formula fit to data) -C c) simulation if unbiased (equal weight) events in a given beam energy range: -C - beam energy simulated (beam spectrum times the total cross section) -C - the process is chosen randomly accordingly to the their probabilities -C -C--- Input: file "fort.15" -C the number of events, the beam energy range, the distance to the collimator etc -C file "particle.dat" contains a table for particle masses (GEANT numbering) -C -C - SUBROUTINE BGGEN -C - IMPLICIT NONE -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER ierr,iev,ipri,i - INTEGER nproc(0:MXPROC) - CHARACTER cnam(0:MXPROC)*16,cmom*18 -C -C ------------------------------------------------------------------ -C - CALL BG_INI(ierr) - IF(ierr.NE.0) GO TO 999 -C - DO i=0,MXPROC - nproc(i)=0 - ENDDO - IEVENT=0 -C - DO iev=1,NEVENT -C - IEVENT=iev - ipri=0 - IF(iev.LE.NPRIEV) ipri=1 -C - CALL BG_EVE(ipri) -C - IF(IEVPROC.GE.0.AND.IEVPROC.LE.MXPROC) THEN - nproc(IEVPROC)=nproc(IEVPROC)+1 - ENDIF -C - ENDDO -C - WRITE(6,1980) - 1980 FORMAT(///1X,100('=')) - WRITE(6,1990) NEVENT,RATESEC/1000. - 1990 FORMAT(' Events Simulated: ',I9,5X,'Reference interaction rate:' - + ,F12.2,' kHz') - IF(NEVENT.GT.0) THEN - cnam(0)='PYTHIA ' - DO i=1,MXPROC - cnam(i)=CNPROC(i) - ENDDO - WRITE(6,2000) - 2000 FORMAT(' process ',16X,' events fraction range') - WRITE(6,2005) - 2005 FORMAT(1X,100('-')) - DO i=0,MXPROC - cmom=' ' - IF(i.EQ.0) THEN - WRITE(cmom,2006) EPYMIN,EPH_LIM(2) - 2006 FORMAT(F5.2,'lab rotation matrix - rotate(1,1)=1 - rotate(1,2)=0 - rotate(1,3)=0 - rotate(2,1)=0 - rotate(2,2)=1 - rotate(2,3)=0 - rotate(3,1)=0 - rotate(3,2)=0 - rotate(3,3)=1 - call rotmat(rotate,0d0,dpi/2,0d0) !point (1,0,0) along beam - call rotmat(rotate,0d0,0d0,dpi/4) !point (0,1,1) vertically - call rotmat(rotate,-thx,0d0,0d0) !the goniometer-x rotation - call rotmat(rotate,0d0,-thy,0d0) !the goniometer-y rotation - write(6,2000) (rotate(1,j),j=1,3) - write(6,2000) (rotate(2,j),j=1,3) - write(6,2000) (rotate(3,j),j=1,3) -2000 format(3f12.6) - end - - real function cohrat(x) - real x - include 'cobrems.inc' - real yc,yi - yc=dNcdx(x) - yi=dNidx(x) - cohrat=(yc+yi)/(yi+1e-30) - end - - real function dNtdx(x) - real x - include 'cobrems.inc' - dNtdx=dNcdx(x)+dNidx(x) - end - - real function dNtdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - dNtdx3=dNcdx(x)+dNidx(x) - end - - real function dNtdk(k) - real k - include 'cobrems.inc' - dNtdk=dNtdx(k/E)/E - end - - real function dNcdx(x) - real x - include 'cobrems.inc' - real phi - phi=dpi/4 - dNcdx=2*dpi*dNcdxdp(x,phi) - end - - real function dNcdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - real phi - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - phi=dpi/4 - dNcdx3=2*dpi*dNcdxdp(x,phi) - end - - real function dNcdxdp(x,phi) - real x,phi - include 'cobrems.inc' - integer h,k,l - double precision ReS,ImS,S2 - double precision q2,qT2,q(3),qdota - real xmax,theta2,FF,sum - integer hmin,kmin,lmin - real q3min - integer i - real sigma0 - sigma0=16*dpi*t*Z**2*alpha**3*E*(hbarc/a**2)*(hbarc/a/me)**4 - q2points=0 - q3min=1 - sum=0 - do h=0,0 - do k=-10,10 - do l=-10,10 -c do k=-2,-2 -c do l=-2,-2 - if (h/2*2.eq.h) then - if (k/2*2.ne.k) then - goto 10 - elseif (l/2*2.ne.l) then - goto 10 - elseif ((h+k+l)/4*4.ne.h+k+l) then - goto 10 - endif - elseif (k/2*2.eq.k) then - goto 10 - elseif (l/2*2.eq.l) then - goto 10 - endif - ReS=0 - ImS=0 - do i=1,nsites - qdota=2*dpi*(h*ucell(1,i) + k*ucell(2,i) + l*ucell(3,i)) - ReS=ReS+cos(qdota) - ImS=ImS+sin(qdota) - enddo - S2=ReS**2+ImS**2 - if (S2.lt.1e-4) then - goto 10 - endif - qnorm=2*dpi*hbarc/a - q(1)=qnorm*(rotate(1,1)*h + rotate(1,2)*k + rotate(1,3)*l) - q(2)=qnorm*(rotate(2,1)*h + rotate(2,2)*k + rotate(2,3)*l) - q(3)=qnorm*(rotate(3,1)*h + rotate(3,2)*k + rotate(3,3)*l) - q2=q(1)**2+q(2)**2+q(3)**2 - qT2=q(1)**2+q(2)**2 - xmax=2*E*q(3) - xmax=xmax/(xmax+me**2) - if ((x.gt.xmax).or.(xmax.gt.1)) then - goto 10 - else -c write(6,*) h,k,l,S2 -c write(6,*) q2,xmax - endif - if (q(3).lt.q3min) then - q3min=q(3) - hmin=h - kmin=k - lmin=l - endif - theta2=(1-x)*xmax/(x*(1-xmax)) - 1 - FF=1/(1+q2*betaFF**2) - sum=sum+sigma0*qT2*S2*exp(-Aphonon*q2)*(FF*betaFF**2)**2 - + * ((1-x)/(x*(1+theta2))**2) - + * ((1+(1-x)**2) - + - 8*(theta2/(1+theta2)**2)*(1-x)*cos(phi)**2) - + * acceptance(theta2) -c + * polarization(x,theta2) -C comment out the preceding line to disable polarization -RTJ - q2points=q2points+1 - q2theta2(q2points)=theta2 - q2weight(q2points)=sum -10 continue - enddo - enddo - enddo - dNcdxdp=sum -c if (q3min.lt.1) write(6,*) hmin,kmin,lmin,' best plane at',x - end - - real function dNidx(x) - real x - include 'cobrems.inc' - integer iter,niter - real theta2 !numerical integration over d(theta**2) over [0,inf] - real u,du !is transformed by u=1/(1+theta**2) to d(u) over [0,1] - niter=50 - dNidx=0 - if (x.gt.1) then - return - endif - du=1./niter - do iter=1,niter - u=(iter-0.5)/niter - theta2=(1-u)/u - dNidx=dNidx+dNidxdt2(x,theta2)*du/u**2 - enddo -c write(6,*) dNidx - end - -C In the following paper, a closed form is given for the integral that -C is being performed analytically by dNidx. I include this second form -C here in case some time it might be useful as a cross check. -C -C "Coherent bremsstrahlung in crystals as a tool for producing high -C energy photon beams to be used in photoproduction experiments at -C CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. -C -C Note: in this paper they have swapped subscripts for coherent and -C incoherent intensities. This is not very helpful to the reader! -C -C The result is some 15% lower radiation rate than the result of dNidx. -C I take the latter to be more detailed (because it gives a more -C realistic behaviour at the endpoint and agrees better with the PDG -C radiation length for carbon). Most of this deficiency is remedied -C by simply replacing Z**2 in the cross section with Z*(Z+zeta) as -C recommended by Kaune et.al., and followed by the PDG in their fit -C to radiation lengths. -C -C WARNING -C dNidx and dNBidx give the incoherent radiation rate for crystalline -C radiators. If you take the incoherent radiation formulae here and -C integrate them you will NOT obtain the radiation length for amorphous -C radiators; it will be overestimated by some 15%. The reason is that -C the part of the integral in q-space that is covered by the discrete -C sum has been subtracted to avoid double-counting with the coherent -C part. If you were to spin the crystal fast enough, the coherent -C spectrum would average out to yield the remaining 15% with a spectral -C shape resembling the Bethe-Heitler result. - - real function dNBidx(x) - real x - include 'cobrems.inc' - real psiC1,psiC2 - real AoverB2,Tfact - real zeta - AoverB2=Aphonon/betaFF**2 - Tfact=-(1+AoverB2)*exp(AoverB2)*EXPINT(AoverB2) - psiC1=2*(2*log(betaFF*me)+Tfact+2) - psiC2=psiC1-2/3. - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - dNBidx=nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + * (psiC1*(1+(1-x)**2) - psiC2*(1-x)*2/3.) - end - - real function dNidxdt2(x,theta2) - real x,theta2 - include 'cobrems.inc' - real MSchiff,delta,zeta - delta=1.02 - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - MSchiff=1/(((me*x)/(2*E*(1-x)))**2 + 1/(betaFF*me*(1+theta2))**2) - dNidxdt2=2*nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + *( ((1+(1-x)**2)-4*theta2*(1-x)/(1+theta2)**2)/(1+theta2)**2 - + *(log(MSchiff) - 2*delta*Z/(Z+zeta)) - + + 16*theta2*(1-x)/(1+theta2)**4 - (2-x)**2/(1+theta2)**2 ) - + * acceptance(theta2) -c write(6,*) dNidxdt2 - end - - real function rpara(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rpara=0.5*((1+1-x)**2)*(1+theta2)**2 - + -8*theta2*(1-x)*cos(phi)**2 - + -8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function rortho(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rortho=0.5*x**2*(1+theta2)**2 - + +8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function polarization(x,theta2) - real x,theta2 - include 'cobrems.inc' - polarization=2*(1-x)/((1+theta2)**2*((1-x)**2+1) - 4*theta2*(1-x)) - end - - real function acceptance(theta2) - real theta2 - include 'cobrems.inc' - REAL sig(4) - real u,var0,varMS,thetaC - real pu,du2,u0,u1,u2 - integer iter,niter - real theta -Comment out the following lines to enable collimation -RTJ - acceptance=1 -C write(6,*) sqrt(theta2) -C return -Comment out the preceding lines to enable collimation -RTJ - acceptance=0 - niter=50 - theta=sqrt(theta2) - thetaC=collim/(2*D)*(E/me) - var0=(spot/D*(E/me))**2 - varMS=sigma2MS(t)*(E/me)**2 - sig(1)=sqrt(var0) - sig(2)=sqrt(varMS) - if (theta.lt.thetaC) then - u1=thetaC-theta - if (u1**2/(var0+varMS).gt.20) then - acceptance=1 - return - endif - do iter=1,niter - u=u1*(iter-0.5)/niter - u2=u**2 - du2=2*u*u1/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=acceptance + pu*du2 - enddo - endif - u0=abs(theta-thetaC) - u1=abs(theta+thetaC) - do iter=1,niter - u=u0+(u1-u0)*(iter-0.5)/niter - u2=u**2 - du2=2*u*(u1-u0)/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=acceptance + pu*du2/dpi - + * atan2(sqrt((theta2-(thetaC-u)**2)*((thetaC+u)**2-theta2)), - + theta2-thetaC**2+u2) - enddo - end - - subroutine rotmat(matrix,thx,thy,thz) - double precision matrix(3,3),thx,thy,thz -C Matrix(out) = Rx(thx) Ry(thy) Rz(thz) Matrix(in) -C with rotations understood in the passive sense - double precision x,y,z - double precision sint,cost - integer i - if (thz.ne.0) then - sint=sin(thz) - cost=cos(thz) - do i=1,3 - x=matrix(1,i) - y=matrix(2,i) - matrix(1,i)=cost*x+sint*y - matrix(2,i)=-sint*x+cost*y - enddo - endif - if (thy.ne.0) then - sint=-sin(thy) - cost=cos(thy) - do i=1,3 - x=matrix(1,i) - z=matrix(3,i) - matrix(1,i)=cost*x+sint*z - matrix(3,i)=-sint*x+cost*z - enddo - endif - if (thx.ne.0) then - sint=sin(thx) - cost=cos(thx) - do i=1,3 - y=matrix(2,i) - z=matrix(3,i) - matrix(2,i)=cost*y+sint*z - matrix(3,i)=-sint*y+cost*z - enddo - endif - end - - subroutine convol(nbins) - integer nbins - include 'cobrems.inc' - REAL hisx(10000),hisy(10000),sig(4) - real norm(10000),result(10000) - real x,x0,x1,dx - real alph,dalph - real var0,varMS - real term - integer i,ii,j - x0=hisx(1) - x1=hisx(nbins) - var0=(mospread**2+(emitx/spot)**2) - varMS=sigma2MS(t) - sig(3)=sqrt(var0)*E/me - sig(4)=sqrt(varMS)*E/me -C--Here we have to guess which characteristic angle alph inside the crystal -C is dominantly responsible for the coherent photons in this bin in x. -C I just use the smallest of the two angles, but this does not work when -C both angles are small, and you have to be more clever -- BEWARE!!! -C--In any case, fine-tuning below the mosaic spread limit makes no sense. - alph=min(abs(thx),abs(thy)) - if (alph.eq.0) then - alph=max(abs(thx),abs(thy)) - else - alph=max(alph,mospread) - endif - - do j=1,nbins - norm(j)=0 - result(j)=0 - do i=-nbins,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0)) - else - term=exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0) - endif - term=term*alph/x - norm(j)=norm(j)+term - enddo - enddo - -c write(6,*) norm - - do i=-nbins,nbins - if (i.lt.1) then - ii=1-i - else - ii=i - endif - do j=1,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0)) - else - term=exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0) - endif - term=term*alph/x - result(ii)=result(ii)+term*hisy(j)/norm(j) - enddo - enddo - - do i=1,nbins - if (abs(result(i)).gt.1e-35) then - hisy(i)=result(i) - else - hisy(i)=0 - endif - enddo - end - - real function sigma2MS(tt) - real tt - sigma2MS=sigma2MS_Geant(tt) - end - - real function sigma2MS_Kaune(tt) - real tt - include 'cobrems.inc' -C--Multiple scattering formula of Kaune et.al. -c with a correction factor from a multiple-scattering calculation -c taking into account the atomic and nuclear form factors for carbon. - -c--Note by RTJ, Oct. 13, 2008: -c I think this formula overestimates multiple scattering in thin targets -c like these diamond radiators, because it scales simply like sqrt(tt). -c Although the leading behavior is sqrt(tt/radlen), it should increase -c faster than that because of the 1/theta**2 tail of the Rutherford -c distribution that makes the central gaussian region swell with increasing -c number of scattering events. For comparison, I include below the PDG -c formula (sigma2MS), the Moliere formula used in the Geant3 simulation -c of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for -c thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 -c (sigma2MS_Hanson). The latter two separate the gaussian part from the -c tails in different ways, but both agree that the central part is much -c more narrow than the formulation by Kaune et.al. below. - - carboncor=4.2/4.6 - sigma2MS_Kaune=8*dpi*nsites*alpha**2*Z**2*tt*(hbarc/(E*a))**2/a - + *log(183*Z**(-1/3.)) - + *carboncor - end - - real function sigma2MS_pdg(tt) - real tt - include 'cobrems.inc' -C--The PDG formula instead (with beta=1, charge=1) -c This formula is said to be within 11% for t > 1e-3 rad.len. - sigma2MS_pdg=(13.6e-3/E)**2*(tt/radlen) - + *(1+0.038*log(tt/radlen))**2 - end - - real function sigma2MS_Geant(tt) - real tt - include 'cobrems.inc' -C--Geant3 formula for the rms multiple-scattering angle -c This formula is based on the theory of Moliere scattering. It contains -c a cutoff parameter F that is used for the fractional integral of the -c scattering probability distribution that is included in computing the -c rms. This is needed because the complete distribution of scattering -c angles connects smoothly from a central gaussian (small-angle -c multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford -c scattering regime) through the so-called plural scattering region. - F=0.98 ! probability cutoff in definition of sigma2MS - density=3.534 ! g/cm^3 - chi2cc=(0.39612e-2)**2*(Z*(Z+1))*(density/12) ! GeV^2/m - chi2c=chi2cc*(tt/E**2) - rBohr=0.52917721e-10 ! m - chi2alpha=1.13*(hbarc/(E*rBohr*0.885))**2 - + *Z**(2/3.)*(1+3.34*(alpha*Z)**2) - omega0=chi2c/(1.167*chi2alpha) ! mean number of scatters - gnu=omega0/(2*(1-F)) - sigma2MS_Geant=chi2c/(1+F**2)*((1+gnu)/gnu*log(1+gnu)-1) - end - - real function sigma2MS_Hanson(tt) - real tt - include 'cobrems.inc' -C--Formulation of the rms projected angle attributed to Hanson et.al. -c in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere -c theory used to give the 1/e angular width of the scattering distribution. -c In the paper, though, they compare it with experiment for a variety of -c metal foils down to 1e-4 rad.len. in thickness, and show excellent -c agreement with the gaussian approximation out to 4 sigma or so. I -c like this paper because of the excellent agreement between the theory -c and experimental data. - density=3.534 ! g/cm^3 - ttingcm=tt*100*density - Atomicweight=12 - EinMeV=E*1000 - theta2max=0.157*Z*(Z+1)/Atomicweight*(ttingcm/EinMeV**2) - theta2screen=theta2max*Atomicweight*(1+3.35*(Z*alpha)**2) - + /(7800*(Z+1)*Z**(1/3.)*ttingcm) - BminuslogB=log(theta2max/theta2screen)-0.154 - Blast=1 - do i=1,999 - B=BminuslogB+log(Blast) - if (B.lt.1.2) then - B=1.21 - goto 10 - elseif (abs(B-Blast).gt.1e-6) then - Blast=B - else - goto 10 - endif - enddo - 10 continue - sigma2MS_Hanson=theta2max*(B-1.2)/2 - end diff --git a/src/programs/Simulation/bggen_jpsi/code/cobrems.inc b/src/programs/Simulation/bggen_jpsi/code/cobrems.inc deleted file mode 100644 index af193b8441..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/cobrems.inc +++ /dev/null @@ -1,15 +0,0 @@ -C units: length in m; energy,momentum,mass in GeV; angles in radians - common /cophys/dpi,me,alpha,hbarc - real me,alpha,hbarc - double precision dpi - integer nsites - parameter (nsites=8) - common /cotarg/Z,a,radlen,Aphonon,mospread,betaFF,ucell(3,nsites) - real Z,a,radlen,Aphonon,mospread,betaFF,ucell - common /cosetup/thx,thy,rotate(3,3),E,emitx,emity,spot,Erms, - + D,t,collim - double precision thx,thy,rotate - real E,emitx,emity,Erms,spot,D,t,collim - common /coQ2list/q2points,q2theta2(1000),q2weight(1000) - integer q2points - real q2theta2,q2weight diff --git a/src/programs/Simulation/bggen_jpsi/code/cohbeam_ini.F b/src/programs/Simulation/bggen_jpsi/code/cohbeam_ini.F deleted file mode 100644 index deaea4db47..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/cohbeam_ini.F +++ /dev/null @@ -1,84 +0,0 @@ -C - SUBROUTINE COHBEAM_INI(ID,E0,EP,ELIM,ZCOLLIM,COLDIAM) -C -C--- Photoproduction by the coherent Brem. beam -C--- ID - histogram with the dN/dE*sigma(E), -C where dN/dE - coh. Brem., sigma(E) - total photoprod. on protons -C E0 - e- energy -C EP - coherent peak energy -C ELIM - energy limits -C ZCOLLIM - distance to the collimator -C COLDIAM - collimator diameter -C - IMPLICIT NONE - INTEGER ID - REAL E0,EP,ELIM(2),ZCOLLIM,COLDIAM -C - INCLUDE 'bg_ctrl.inc' -C - REAL DNIDX,DNCDX,GPXSECT,getxsec -C - INTEGER i,nb,ibrem - REAL emn,emx,flx,xsec,dx,de,e,xstot,xlum,ecurr,targth,frate,vv -C - ibrem=1 - IF(ELIM(2).LT.ELIM(1)*1.006) ibrem=0 -C -C--- Initialize the coherent Bremsstrahlung -C - targth=30. ! target thickness - ecurr=2.25E-6 ! beam current on a 20um crystal - the "high luminosity" setting - xlum=ecurr/1.6E-19*targth*0.071*0.602 ! luminosity factor: 2.25uA on 20um (1.7e-4 RL) crystal, 30 cm LH2 (1/b) -C - IF(ibrem.NE.0) THEN - CALL COBREMS(E0,EP,ZCOLLIM/100.,COLDIAM) ! collimator distance in m - ENDIF -C - emn=ELIM(1) - emx=ELIM(2) - de=MIN(0.005,emx-emn) - dx=de/E0 - nb=INT((emx-emn)/de+0.001) - NHBEA=nb -C - CALL HBOOK1(ID ,'Beam flux dn/dE*sigma(E)' ,nb,emn,emx,0.) - CALL HBOOK1(ID+10,'Total cross section in mb',nb,emn,emx,0.) - CALL HBOOK1(ID+11,'Beam flux dn/dE' ,nb,emn,emx,0.) -C - frate=0. - DO i=1,nb - e=ELIM(1)+(i-0.5)*de - IF(ISIMUL.EQ.1) THEN - xstot=getxsec(e) - ELSE - xstot=GPXSECT(e)*1.E-3 ! x-sec in b - ENDIF - IF(ibrem.NE.0) THEN - flx=(DNIDX(e/E0)+DNCDX(e/E0))*dx/de - vv=xstot*flx*xlum - frate=frate+vv*de - CALL HF1(ID+11,e,flx) - ELSE - vv=1. - ENDIF - CALL HF1(ID ,e,vv) - CALL HF1(ID+10,e,xstot) - ENDDO -C CALL HPRINT(ID) -C - RATESEC=0. - IF(ibrem.NE.0) THEN - RATESEC=frate - WRITE(6,FMT='(//10X,''Rates:'')') - WRITE(6,1000) ecurr*1.E6,emn,emx - 1000 FORMAT(10X,'Beam: ',F8.2,' uA e-, gamma in ',2F6.2,' GeV') - WRITE(6,1005) targth - 1005 FORMAT(10X,'Target: ',F8.2,' cm LH2') - WRITE(6,1010) frate/1000. - 1010 FORMAT(10X,'Interaction rate: ',F8.1,' kHz') - ENDIF -C - CALL HCOPY(ID,ID+1,' ') ! a copy of the final histogram to be used for HRNDM1 -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/gbrwign.F b/src/programs/Simulation/bggen_jpsi/code/gbrwign.F deleted file mode 100644 index f85c4260e4..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gbrwign.F +++ /dev/null @@ -1,38 +0,0 @@ - REAL FUNCTION GBRWIGN(DUMMY) -C. -C. ****************************************************************** -C. * * -C. * Breit-Wigner distribution * -C. * ==>Called by : GDECAY * -C. * * -C. ****************************************************************** -C. - IMPLICIT NONE - REAL DUMMY - REAL RNDM - INTEGER itry - REAL gg,gm,xrn,pi,de -C. -C. ------------------------------------------------------------------ -C -C-- Create Lorentz distributed energy with FWHM HBAR/TLIFE. -C-- (via integral-transformation of Lorentz-distribution) -C-- (M.Guckes) -C f(E)=gamma/2pi/(E**2+gamma**2/4) - non relativistic -C--- Modified by E.Ch. May 2007 - itry=0 - 10 itry=itry+1 -C CALL GRNDM(rndm,1) -C gamma=3.291086E-25/TLIFE*2. - de=1./2.*TAN(3.1416*(RNDM(de)-0.5)) -C write(6,*) itry,gamma,de - IF(ABS(de).GT.2.0) THEN - IF(itry.LT.1000) GO TO 10 - WRITE(6,*) ' *** GBRWIGN: too many tries for tau=' - + ,itry - de=0. - ENDIF - GBRWIGN=de -C - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/gdecan.F b/src/programs/Simulation/bggen_jpsi/code/gdecan.F deleted file mode 100644 index 1362cfe199..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gdecan.F +++ /dev/null @@ -1,227 +0,0 @@ -* $Header: /afs/cern.ch/exp/compass/src/cvs/comgeant/code/src/omgbatch/ompro/gdecan.F,v 1.1.1.1 1997/06/02 17:39:52 fdr Exp $ -* $Log: gdecan.F,v $ -* Revision 1.1.1.1 1997/06/02 17:39:52 fdr -* Comgeant Monte-Carlo -* -* Revision 3.2.0.1 1996/11/07 19:23:23 las -* First CVS version. -* -*CMZ : 06/03/96 16.55.41 by E.Chudakov -*-- Author : Adapted from FOWL by D.Barberis, Uni.HD, 4/10/89. -*-- Updated by E.Chudakov (random numbers, SAVE...) 02/01/95 -*-- Updated by E.Chudakov (equal weights) 06/03/96 -C - SUBROUTINE GDECAN(NPFOWL,TEFOWL,AMFOWL,WTFOWL,PCFOWL) -*--- -* Phase-space decay into N particles. -* -* Input: -* NPFOWL number of decay particles -* TEFOWL mass of decaying particle -* AMFOWL(1:NPFOWL) masses of decay products -* WTFOWL<=0. diff. weights of events -* WTFOWL>0. equal (=1.) weights of events -* Output: -* WTFOWL weight of the event (or not changed) -* PCFOWL(1:4,1:NPFOWL) four-momentum of decay products -* -* Adapted from FOWL by D.Barberis, Uni.HD, 4/10/89. -*--- -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id: gdecan.F,v 1.1.1.1 1997/06/02 17:39:52 fdr Exp $'/ -C#endif - DIMENSION AMFOWL(NPFOWL), PCFOWL(4,NPFOWL) - COMMON /SHUFFL/ RNO(50), NTNM4, NTM2, NTM1 - PARAMETER ( MXFOWL = 20 ) - DIMENSION PD(MXFOWL), EMM(MXFOWL), EMS(MXFOWL), SM(MXFOWL) - DIMENSION AMSAVE(MXFOWL) - REAL wgtinim,rrr - INTEGER ntry -C - SAVE ETC,NPSAVE,AMSAVE,SM,TECMTM,WTMAXQ,EMS,EMM -C - DATA TWOPI / 6.2831853073 / - DATA ETC / -1. / -*--- Initialization. - wgtinim=WTFOWL - ntry=0 - WTFOWL = 0. - CALL VZERO(PCFOWL,4*NPFOWL) - IF (NPFOWL.LT.2.OR.NPFOWL.GT.MXFOWL) GO TO 900 -*--- Check if same as last time, if so skip first part. - IF (TEFOWL.EQ.ETC) THEN - IF (NPFOWL.EQ.NPSAVE) THEN - DO 150 I=1,NPFOWL - IF (AMFOWL(I).NE.AMSAVE(I)) GO TO 151 - 150 CONTINUE - GO TO 300 - ENDIF - ENDIF - 151 ETC = TEFOWL - NPSAVE = NPFOWL - CALL UCOPY(AMFOWL,AMSAVE,NPFOWL) -C PRINT 9001, NPFOWL,TEFOWL,(AMFOWL(I),I=1,NPFOWL) -C 9001 FORMAT(2X,I3,'-BODY PHASESPACE BY FOWL',4X,F8.5,' going to ' -C + ,(6F8.5)) - NTM1 = NPFOWL - 1 - NTM2 = NTM1 - 1 - NTP1 = NPFOWL + 1 - NTNM4 = 3 * NPFOWL - 4 - EMM(1) = AMFOWL(1) - TM = 0.0 - DO 200 I=1,NPFOWL - EMS(I) = AMFOWL(I)**2 - TM = TM + AMFOWL(I) - SM(I) = TM - 200 CONTINUE -*--- Constants depending on TEFOWL. - TECMTM = TEFOWL - TM - EMM(NPFOWL) = TEFOWL -*--- Constant cross-section as function of TEFOWL. - EMMAX = TECMTM + AMFOWL(1) - EMMIN = 0.0 - WTMAX = 1.0 - DO 350 I=2,NPFOWL - EMMIN = EMMIN + AMFOWL(I-1) - EMMAX = EMMAX + AMFOWL(I) - WTMAX = WTMAX * OPDK(EMMAX,EMMIN,AMFOWL(I)) - 350 CONTINUE - WTMAXQ = 1.0 / WTMAX -*--- Calculation of WT based on effective masses EMM. - 300 CALL ORANGNR -*--- ORANGNR fills RNO with 3*NPFOWL-4 random numbers, -*--- of which the first NPFOWL-2 are ordered. - IF (NTM2.GT.0) THEN - DO 508 J=2,NTM1 - EMM(J) = RNO(J-1) * (TECMTM) + SM(J) - 508 CONTINUE - ENDIF - WTFOWL = WTMAXQ - IR = NTM2 - DO 530 I=1,NTM1 - PD(I) = OPDK(EMM(I+1),EMM(I),AMFOWL(I+1)) - WTFOWL = WTFOWL * PD(I) - 530 CONTINUE -C -C--- Try again in order to get rid of the weight? -C - IF(wgtinim.GT.1.E-10) THEN - ntry=ntry+1 - IF(ntry.LT.10000) THEN - CALL GRNDM(rrr,1) - IF(rrr.GT.WTFOWL/wgtinim) GO TO 300 - ENDIF - ENDIF -C -*--- Complete specification of event (Raubold-Lynch method). - PCFOWL(1,1) = 0.0 - PCFOWL(2,1) = PD(1) - PCFOWL(3,1) = 0.0 - DO 570 I=2,NPFOWL - PCFOWL(1,I) = 0.0 - PCFOWL(2,I) = -PD(I-1) - PCFOWL(3,I) = 0.0 - IR = IR + 1 - BANG = TWOPI * RNO(IR) - CB = COS(BANG) - SB = SIN(BANG) - IR = IR + 1 - C = 2.0 * RNO(IR) - 1.0 - S = SQRT(1.0-C*C) - IF (I.LT.NPFOWL) THEN - ESYS = SQRT(PD(I)**2+EMM(I)**2) - BETA = PD(I) / ESYS - GAMA = ESYS / EMM(I) - DO 568 J=1,I - AA = PCFOWL(1,J)**2 + PCFOWL(2,J)**2 + PCFOWL(3,J)**2 - PCFOWL(4,J) = SQRT(AA+EMS(J)) - CALL OROTES2(C,S,CB,SB,PCFOWL(1,J)) - PSAVE = GAMA * ( PCFOWL(2,J) + BETA * PCFOWL(4,J) ) - PCFOWL(2,J) = PSAVE - 568 CONTINUE - ELSE - 1567 DO 1568 J=1,I - AA = PCFOWL(1,J)**2 + PCFOWL(2,J)**2 + PCFOWL(3,J)**2 - PCFOWL(4,J) = SQRT(AA+EMS(J)) - CALL OROTES2(C,S,CB,SB,PCFOWL(1,J)) - 1568 CONTINUE - ENDIF - 570 CONTINUE - 900 RETURN - END - FUNCTION OPDK(A,B,C) -* -*-- CMS momentum for a two-body decay ( A --> B + C ) -* - A2 = A*A - B2 = B*B - C2 = C*C - PD = A2 + (B2-C2)**2/A2 - 2.0*(B2+C2) - IF (PD.LT.0.) THEN - PRINT 900, A, B, C, PD - PD=0. - ENDIF - OPDK = 0.5 * SQRT(PD) - RETURN - 900 FORMAT('0PDK : A,B,C,PD =',4E15.7) - END - SUBROUTINE ORANGNR -* -*--- Assembles random numbers for one event. -* - COMMON /SHUFFL/ RNO(50), NTNM4, NTM2, NTM1 -C DO i= 1,NTM2 -C RNO(I) = RNDM(DUMMY) -C END DO -C - CALL GRNDM(RNO(1),NTM2) -C -*--- Order the first NTM2 random numbers -*--- two is a special case (faster) - IF (NTM2-2) 200,160,110 - 110 KM1 = NTM2 - 1 - DO 150 I= 1, KM1 - IQUIT = 0 - NI = NTM2 - I - DO 140 J= 1, NI - IF (RNO(J) - RNO(J+1)) 140,140,120 - 120 SAV = RNO(J) - RNO(J) = RNO(J+1) - RNO(J+1) = SAV - IQUIT = 1 - 140 CONTINUE - IF (IQUIT) 200,200,150 - 150 CONTINUE - GO TO 200 - 160 IF (RNO(1).LE.RNO(2)) GO TO 200 - SAV = RNO(1) - RNO(1) = RNO(2) - RNO(2) = SAV - 200 CONTINUE -*--- Choose the rest of the random numbers. -C DO 300 I= NTM1, NTNM4 -C 300 RNO(I) = RNDM(DUMMY) -C -C DO i= NTM1,NTNM4 -C RNO(I) = RNDM(DUMMY) -C END DO - CALL GRNDM(RNO(NTM1),NTNM4-NTM1+1) -C - RETURN - END - SUBROUTINE OROTES2(C,S,C2,S2,PCF) -* -*--- This subroutine does two rotations (xy and xz). -* - DIMENSION PCF(4) - SA = PCF(1) - SB = PCF(2) - A = SA*C - SB*S - PCF(2) = SA*S + SB*C - B = PCF(3) - PCF(1) = A*C2 - B*S2 - PCF(3) = A*S2 + B*C2 - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/getxsec.F b/src/programs/Simulation/bggen_jpsi/code/getxsec.F deleted file mode 100644 index 63b95e7278..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/getxsec.F +++ /dev/null @@ -1,23 +0,0 @@ - REAL FUNCTION GETXSEC(E) -C -C--- Return the cross section (in barns) from the input table -C--- Interpolated -C - IMPLICIT NONE - REAL E,DIVDIF - INTEGER ipol -C - INCLUDE 'bg_reac.inc' -C - GETXSEC=0. -C write(6,*) E,ELREAC - IF(E.LT.ELREAC(1).OR.E.GT.ELREAC(2)) GO TO 999 -C - ipol=3 - GETXSEC=DIVDIF(XSREAC(1),ESREAC(1),NPXREAC,E,ipol)*1.E-9 ! nb -->b -C i=(E-ELREAC(1))/((ELREAC(2)-ELREAC(1))/(NPXREAC-1))+0.1 -C i=i+1 -C write(6,*) E,i,ESREAC(i),XSREAC(i) -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/gloren.F b/src/programs/Simulation/bggen_jpsi/code/gloren.F deleted file mode 100644 index 141f5cc2c1..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gloren.F +++ /dev/null @@ -1,34 +0,0 @@ - SUBROUTINE GLOREN(BETA,PA,PB) -C. -C. ****************************************************************** -C. * * -C * Routine to transform momentum and energy from the * -C * Lorentz frame A to the Lorentz frame B * -C * * -C * PA(1) * -C * PA(2) Momentum components in frame A * -C * PA(3) * -C * PA(4) Energy * -C * PB(..) same quantities in frame B * -C * * -C * BETA(1) Components of velocity of frame B * -C * BETA(2) as seen from frame A * -C * BETA(3) * -C * BETA(4) 1./SQRT(1.-BETA**2) * -C. * * -C. * ==>Called by : GDECAY,GDECA3 * -C. * Author M.Hansroul ********* * -C. * * -C. ****************************************************************** -C. - DIMENSION BETA(4),PA(4),PB(4) -C. -C. ------------------------------------------------------------------ -C. - BETPA = BETA(1)*PA(1) + BETA(2)*PA(2) + BETA(3)*PA(3) - BPGAM = (BETPA * BETA(4)/(BETA(4) + 1.) - PA(4)) * BETA(4) - PB(1) = PA(1) + BPGAM * BETA(1) - PB(2) = PA(2) + BPGAM * BETA(2) - PB(3) = PA(3) + BPGAM * BETA(3) - PB(4) =(PA(4) - BETPA) * BETA(4) - END diff --git a/src/programs/Simulation/bggen_jpsi/code/gpxcosthr.F b/src/programs/Simulation/bggen_jpsi/code/gpxcosthr.F deleted file mode 100644 index f8076bb702..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gpxcosthr.F +++ /dev/null @@ -1,301 +0,0 @@ - SUBROUTINE GPXCOSTHR(IPROC,E0,TMN,TMX,COSTH,IERR) -C -C=== Generates a random value for COS(TH) in CM, -C using various functions: -C polinomial distrubutions: -C cos(th)=X=a(0)+a(1)*X+a(2)*X**2, where -C a(i)=b(0,i)+b(1,i)*E0+b(2,i)*E0**2+b(3,i)*E0**3 -C the factors b are stored -C -C--- Input: E0 - energy -C IPROC - process -C TMN,TMX (-t to the target) for the -t-dependence simulation -C Output: COSTH - COS(th) in CM - random value, for the 1-st secondary particle (should be the baryon) -C IERR >0 - error (not defined) -C - IMPLICIT NONE -C - INTEGER IPROC,IERR - REAL E0,COSTH,TMN,TMX -C - REAL RNDM - DOUBLE PRECISION DPOLFMY,DINT_F2 - EXTERNAL DPOLFMY,DINT_F2 -C - COMMON/CFUN_COS/ DFPA(10) - DOUBLE PRECISION DFPA -C - INTEGER i,j,npol,maxf - + ,iset ! array index for the polynomial coefficients for this process - + ,npar ! the number of parameters in the final distribution function - + ,ivar ! distribution used, =1 - cos(th), =2 - -t - + ,ifun ! function used used, =1 - polynomial, =2 - exp(a+b*x)+c converted to a*exp(bx)+c - REAL rnd,xx,tt,qq - + ,csign ! +1 or -1 multiplication factor for COSTH, depending on the data used -> baryon - DOUBLE PRECISION da(3),de0,dx,dx0,dxlim(2),dd - + ,df,dfe,df1,df2,dmin,dnorm - + ,dq(4),dtmp(4),dr(2),dl(2),dv,dres,dintg -C - COMPLEX*16 dz(3) -C - INTEGER mxpro,mxpar,mxfun - PARAMETER (mxpro=3,mxpar=3,mxfun=2) - REAL bb(4,mxpar,mxpro) ! polynomial coefficients for cos,t functions coefficients - + ,elim(2,mxpro) ! energy limits for these polynomilas. beyond them the edge value is taken - INTEGER nparf(mxfun) -C - DATA bb/ - + 10.22637, -4.23276, 0.81462, 0. ! p rho: (proc=4) - + ,-39.04430, 29.35012, -6.47698, 0. ! - + ,46.54426, -38.59182, 8.25751, 0. ! - + , 6.24956, -1.58878, 0.08898, 0. ! Delta++ pi- (5) - + ,16.14728, -24.19744, 6.55671, 0. ! - + , 7.32414, -1.37016, -0.63512, 0. ! - + ,-0.68852, 2.80721, -1.90364, 0.36498 ! p eta (proc=8) - + ,-1.09740, 1.69941, -0.67707, 0.11149 - + , 3.53044, -8.35135, 5.66832, -1.08696 - + / - DATA elim/ - + 1.5, 2.5 - + ,1.25, 2.4 - + ,0.75, 3.0 - + / - DATA nparf/3,3/ -C -C ------------------------------------------------------------------ -C - IERR=1 - COSTH=0. - IF(IPROC.LT.3.OR.IPROC.GT.12) GO TO 999 - IERR=2 -C - iset=0 - IF(IPROC.EQ.4) THEN ! p rho - iset=1 - npol=3 - ivar=2 - ifun=2 - csign=1. - ELSE IF(IPROC.EQ.5) THEN ! Delta++ pi- - iset=2 - npol=3 - ivar=2 - ifun=2 - csign=1. - ELSE IF(IPROC.EQ.8) THEN ! p eta - iset=3 - npol=4 - ivar=1 - ifun=1 - csign=-1. - ENDIF -C - IF(iset.EQ.0) GO TO 999 - IERR=3 - npar=nparf(ifun) -C -C--- Calculate the polynomial coefficients for the given energy -C - de0=DBLE(E0) - IF(E0.LT.elim(1,iset)) de0=elim(1,iset) - IF(E0.GT.elim(2,iset)) de0=elim(2,iset) - DO i=1,npar - DO j=1,npol - dtmp(j)=DBLE(bb(j,i,iset)) - ENDDO -C write(6,*) 'dtmp=',(dtmp(i),i=1,npol) - da(i)=DPOLFMY(npol,dtmp(1),de0) - ENDDO -C - IF(ifun.EQ.2) THEN -C -C--- convert to a*exp(bx)+c -C - da(1)=EXP(da(1)) - ENDIF -C write(6,*) 'da=',(da(i),i=1,npar) -C -C--- Limits of the variable -C - IF(ivar.EQ.1) THEN ! cos(th) - dxlim(1)=-1.D0 - dxlim(2)= 1.D0 - ELSE IF(ivar.EQ.2) THEN ! -t - dxlim(1)=TMN - dxlim(2)=TMX - ENDIF -C -C--- For the polynomial function (ifun=1) sure that the function is positive in the full range of the variable -C -C write(6,*) 'ifun,ivar,npol,npar=',ifun,ivar,npol,npar - IF(ifun.EQ.1) THEN ! p2 is assumed... - IF(da(3).LT.0.D0.AND. - + da(2)**2-4.D0*da(1)*da(3).LT.0.D0) GO TO 999 ! all the curve is negative - IERR=4 - dfe=1.D0 - IF(ABS(da(3)).GT.1.D-10) THEN ! there is an extremum - dx0=-da(1)/2.D0/da(3) - IF(dx0.GT.dxlim(1).AND.dx0.LT.dxlim(2)) THEN ! extremum is inside the interval - dfe=DPOLFMY(3,da(1),dx0) - ENDIF - ENDIF - df1=DPOLFMY(3,da(1),dxlim(1)) - df2=DPOLFMY(3,da(1),dxlim(2)) - dmin=MIN(dfe,df1,df2) - IF(dmin.LT.0.D0) THEN ! if needed, add a constant to the function in order to make it positive - da(1)=da(1)-dmin+1.D-15 - ENDIF - ENDIF -C -C--- Normalize the function -C - dd=dxlim(2)-dxlim(1) -C write(6,*) 'da=',(da(i),i=1,npar),dd - IF(ifun.EQ.1) THEN - dnorm=da(1)*dd+da(2)/2.D0*(dxlim(2)**2-dxlim(1)**2) - + +da(3)/3.D0*(dxlim(2)**3-dxlim(1)**3) - DO i=1,npar - da(i)=da(i)/dnorm - ENDDO - ELSE IF(ifun.EQ.2) THEN - dnorm=da(3)*dd - IF(ABS(da(2)).GT.1.D-8) THEN - dnorm=dnorm+ - + da(1)/da(2)*(EXP(da(2)*dxlim(2))-EXP(da(2)*dxlim(1))) - ELSE - dnorm=dnorm+da(1)*dd - ENDIF - da(1)=da(1)/dnorm - da(3)=da(3)/dnorm - ENDIF -C write(6,*) 'da=',(da(i),i=1,npar),dnorm -C -C--- Calculate the integral function crossing with rnd -C - rnd=RNDM(rnd) -C - IF(ifun.EQ.1) THEN -C -C--- Integral -C - dtmp(1)=0.D0 - dtmp(2)=da(1) - dtmp(3)=da(2)/2. - dtmp(4)=da(3)/3. - df=DPOLFMY(4,dtmp(1),dxlim(1)) - dtmp(1)=-df ! the integral function is 0 at the left edge -C -C--- The integral function factors are in reverse order to match the cernlib routine -C - DO i=1,4 - dq(i)=dtmp(5-i) - ENDDO - -C - dq(4)=dq(4)-DBLE(rnd) -C - CALL DMULLZ(dq(1),3,1000,dz) -C - DO i=1,3 - dr(1)=DBLE(dz(i)) - dr(2)=DIMAG(dz(i)) - IF(ABS(dr(2)).LT.1.D-10) THEN - IF(dr(1).GE.dxlim(1).AND.dr(1).LE.dxlim(2)) THEN - IERR=0 - xx=REAL(dr(1)) ! solution found - ENDIF - ENDIF - ENDDO - ELSE IF(ifun.EQ.2) THEN -C -C--- Integral function -C - dl(1)=dxlim(1) - dl(2)=dxlim(2) - IF(ABS(da(2)).LT.1E-8) THEN - xx=dl(1)+DBLE(rnd)*(dl(2)-dl(1)) - IERR=0 - ELSE - DFPA(1)=da(1)/da(2) - DFPA(2)=da(2) - DFPA(3)=da(3) - DFPA(4)=0.D0 - DFPA(4)=-DINT_F2(dl(1),0) ! the function should be 0 at dl(1) - dintg=DINT_F2(dl(2),0) - IF(dintg.LT.1.D0) THEN - DFPA(1)=DFPA(1)/dintg - DFPA(3)=DFPA(3)/dintg - DFPA(4)=DFPA(4)/dintg - ENDIF - DFPA(4)=DFPA(4)-DBLE(rnd) ! zero crossing -C - maxf=5000 - CALL DZERO(dl(1),dl(2),dv,dres,1.D-5,maxf,DINT_F2) - xx=REAL(dv) - IF(ABS(dres).GT.ABS(dl(2)-dl(1))) THEN - WRITE(6,FMT= - + '('' *** GPXCOSTHR random generator failed '',3D12.5)') - + ,dres,dl - WRITE(6,FMT='(10D12.4)') (da(i),i=1,3),(DFPA(i),i=1,4) - WRITE(6,FMT='(10D12.4)') - + DINT_F2(dl(1),0),DINT_F2(dl(2),0) - ELSE - IERR=0 - ENDIF - ENDIF - ENDIF -C - IF(IERR.NE.0) GO TO 999 -C - IF(ivar.EQ.1) THEN - COSTH=xx - ELSE IF(ivar.EQ.2) THEN ! calculate the polar angle in CM - tt=xx -C t=m1**2+m3**2-2E1*E3+2p1*p3*ct - COSTH=0. - qq=(TMX-TMN)/2. -C write(6,*) 'tmn=',TMN,TMX,qq - IF(qq.GT.0.) COSTH=(tt-(TMX+TMN)/2.)/qq - ENDIF - COSTH=COSTH*csign -C - 999 CONTINUE -C - END -C - DOUBLE PRECISION FUNCTION DPOLFMY(N,DA,DX) -C--- Polynomial function - IMPLICIT NONE - INTEGER N,i - DOUBLE PRECISION DA(N),DX,dp,dres -C - dres=0.D0 - dp=1.D0 - DO i=1,N - dres=dres+DA(i)*dp - dp=dp*DX - ENDDO - DPOLFMY=dres - RETURN - END -C - DOUBLE PRECISION FUNCTION DINT_F2(DX,IFL) -C--- Integral Function of a*EXP(b*x)+c - IMPLICIT NONE - INTEGER IFL - DOUBLE PRECISION DX - COMMON/CFUN_COS/ DFPA(10) - DOUBLE PRECISION DFPA - INTEGER ntry - SAVE ntry -C - DINT_F2=DFPA(1)*EXP(DFPA(2)*DX)+DFPA(3)*DX+DFPA(4) - IF(IFL.EQ.1) THEN - ntry=1 - ELSE IF(IFL.EQ.2) THEN - ntry=ntry+1 - ELSE IF(IFL.EQ.3) THEN -C WRITE(6,*) ' DZERO calls=',ntry - ENDIF - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/gpxsecp.F b/src/programs/Simulation/bggen_jpsi/code/gpxsecp.F deleted file mode 100644 index c5c35ba330..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gpxsecp.F +++ /dev/null @@ -1,144 +0,0 @@ - REAL FUNCTION GPXSECP(E,IPROC) -C -C--- This function describes the partial gamma+p cross section, say gamma p --> p pi+ pi- -C--- process: 1,2 - SAID (called from elsewhere) -C 3 - p pi+ pi- no resonances -C 4 - p rho0 -C 5 - Delta++ pi- -C 6 - p pi0 pi0 -C 7 - n pi+ pi0 -C 8 - p eta -C 9 - p pi+ pi- pi0 -C 10 - n 2pi+ pi- -C 11 - p pi+ pi- full -C - IMPLICIT NONE - REAL E - INTEGER IPROC -C - COMMON/PAWPAR/ PARA(20) - REAL PARA -C VECTOR PAR(20) -C VECTOR IPFIT(10) -C - REAL GP_F1,GP_F2,GP_F3,GP_F4 -C - INTEGER ig,i,k,npar,mxp,ipro,ifit - PARAMETER (mxp=11) - REAL f1,f2,e0,ered,ff - REAL parf1(4,mxp) - DATA parf1/4*0. - + ,4*0. - + ,4*0. - + ,0.8199,0.0268,4.405 ,62.52 - + ,0.0914,3.5619,0.4100,2.1426 - + ,0.3611,0.0250,18.74 ,15.333 - + ,0.4545,0.0597,18.74 ,15.333 - + ,0.4782,6.8940,0.0794,2.038 - + ,0.0529,0.994 ,23.72 ,0.0 - + ,0.0050,0.4652,1525. ,0.0 - + ,0.3768,0.0693,18.74 ,15.333 - + / -C - ifit=0 - npar=2 - ipro=IPROC -C ifit=IPFIT(1) -C npar=IPFIT(2) -C ipro=IPFIT(3) -C write(6,*) ifit,npar,ipro -C - IF(ifit.EQ.2) THEN - DO i=1,npar -C PARA(i)=PAR(i) - ENDDO - ENDIF - IF(ifit.NE.0) THEN - k=0 - DO i=1,4 - k=k+1 -C IF(k.LE.npar) parf1(i,ipro)=PARA(k) - ENDDO - ENDIF -C - IF(ipro.LE.2) THEN ! SAID - GPXSECP=0. - ELSEIF(ipro.EQ.3) THEN ! subtraction 11-4-5 - ff= GP_F1(parf1(1,11),E) - ff=ff-GP_F1(parf1(1,4) ,E) - ff=ff-GP_F4(parf1(1,5) ,E) - GPXSECP=ff - ELSE IF(ipro.EQ.5) THEN -C - GPXSECP=GP_F4(parf1(1,ipro),E) -C - ELSE IF(ipro.LE.7.OR.ipro.EQ.11) THEN -C - GPXSECP=GP_F1(parf1(1,ipro),E) -C - ELSE IF(ipro.EQ.8) THEN -C - GPXSECP=GP_F2(parf1(1,ipro),E) -C - ELSE IF(ipro.LE.11) THEN -C - GPXSECP=GP_F3(parf1(1,ipro),E) -C - ENDIF -C - IF(GPXSECP.LE.0.) GPXSECP=1.E-9 -C - END -C - REAL FUNCTION GP_F1(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=P(1) - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(2)**2*ATAN(ered**2*P(3))/3.14*2. - f2=1.+P(4)/E - GP_F1=f1*f2 - END -C - REAL FUNCTION GP_F2(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.68 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*EXP(-(E-0.6)**2/2*P(2)**2) - f2=P(3)**2*EXP(-(E-1.1)*P(4)) - GP_F2=(f1+f2)*ered - END -C - REAL FUNCTION GP_F3(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.55 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*ATAN(ered**2*P(2))/3.14*2. - f2=1.+P(3)/E - GP_F3=f1*f2 - END -C - REAL FUNCTION GP_F4(P,E) - IMPLICIT NONE - REAL P(*),E - REAL e0,ered,f1,f2 -C - e0=0.4 - ered=E-e0 - IF(ered.LT.0.) ered=0. - f1=P(1)**2*EXP(1.-((E-0.8)*P(2))**6)*ATAN(ered**2*100) - f2=P(3)**2*EXP(-ered*P(4))*ered - GP_F4=f1+f2 - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/gpxsect.F b/src/programs/Simulation/bggen_jpsi/code/gpxsect.F deleted file mode 100644 index d374350d51..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/gpxsect.F +++ /dev/null @@ -1,64 +0,0 @@ - REAL FUNCTION GPXSECT(E) -C -C--- This function describes the total gamma+p cross section at 0.18-100 GeV -C - IMPLICIT NONE - REAL E -C -C COMMON/PAWPAR/ PARA(20) -C REAL PARA -C VECTOR PAR(20) -C VECTOR IPFIT(10) - REAL PAR(20),PARA(20) - INTEGER IPFIT(10) -C - INTEGER mxgaus,ig,i,k - PARAMETER (mxgaus=3) - REAL pgaus(3,mxgaus) - REAL f1,f2,f3,e0 - REAL parf1(2),parf2(2) - DATA pgaus/0.43,0.32,0.055 - + ,0.13,0.73,0.130 - + ,0.08,1.08,0.080/ - DATA parf1/0.119,21.3/ - DATA parf2/0.114,1.04/ -C - IPFIT(1)=0 - IF(IPFIT(1).EQ.2) THEN - DO i=1,13 - PARA(i)=PAR(i) - ENDDO - ENDIF - IF(IPFIT(1).NE.0) THEN - k=0 - DO i=1,2 - k=k+1 - parf1(i)=PARA(k) - ENDDO - DO i=1,2 - k=k+1 - parf2(i)=PARA(k) - ENDDO - DO ig=1,mxgaus - DO i=1,3 - k=k+1 - pgaus(i,ig)=PARA(k) - ENDDO - ENDDO - ENDIF -C - e0=0.15 -C - f3=0 - DO ig=1,mxgaus - f3=f3+pgaus(1,ig)*exp(-(E-pgaus(2,ig))**2/pgaus(3,ig)**2/2.) - ENDDO -C - f1=parf1(1)*ATAN((E-e0)*parf1(2))/3.14*2 - f2=parf2(1)*(E-e0)*EXP(-E*parf2(2)) -C - GPXSECT=f1+f2+f3 - IF(GPXSECT.LT.0.) GPXSECT=0. -C - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/grndm.F b/src/programs/Simulation/bggen_jpsi/code/grndm.F deleted file mode 100644 index 6a3fc5f4e1..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/grndm.F +++ /dev/null @@ -1,14 +0,0 @@ -C -C--- GEANT random function, redefined (RNDM - is in fact RANLUX) -C - SUBROUTINE GRNDM(X,N) - IMPLICIT NONE - INTEGER N !,i - REAL X(N) -C - CALL RANLUX(X(1),N) -C DO i=1,N -C X(i)=RNDM(i) -C ENDDO -C - END diff --git a/src/programs/Simulation/bggen_jpsi/code/hbook_ini.F b/src/programs/Simulation/bggen_jpsi/code/hbook_ini.F deleted file mode 100644 index 83c00bad4b..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/hbook_ini.F +++ /dev/null @@ -1,20 +0,0 @@ - SUBROUTINE HBOOK_INI -C -C--- Initialize the HBOOK -C -C - IMPLICIT NONE -C - INTEGER mxpawc - PARAMETER (mxpawc=1000000) - COMMON/PAWC/ HMEM(mxpawc) - REAL HMEM -C -C - CALL HLIMIT(mxpawc) -C - CALL HBOOK1(9900,'',200,-10,0,0.) -c - RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/include/amf2com.inc b/src/programs/Simulation/bggen_jpsi/code/include/amf2com.inc deleted file mode 100644 index 62c4a02eb3..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/amf2com.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision taa,tm,sfm0 - common/amf2/taa,tm(8,6),sfm0(8) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/bseocom.inc b/src/programs/Simulation/bggen_jpsi/code/include/bseocom.inc deleted file mode 100644 index 48f80011dc..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/bseocom.inc +++ /dev/null @@ -1,4 +0,0 @@ - double precision ois,oir,oi12,eeis,eeir,eei12, - + eei1i2,eb,eeb,tm3 - common/bseo/ois,oir,oi12,eeis,eeir,eei12, - + eei1i2,eb,eeb,tm3(6,4,3) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/cmpcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/cmpcom.inc deleted file mode 100644 index 55dbfd99c1..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/cmpcom.inc +++ /dev/null @@ -1,5 +0,0 @@ - double precision amp,amp2,ap,ap2,aml,aml2,al2,amc2,amh, - + amt,rtara,rtarz,fermom,amm,amn,chbar,barn - integer isf20 - common/cmp/amp,amp2,ap,ap2,aml,aml2,al2,amc2,amh, - + amt,rtara,rtarz,fermom,amm,amn,chbar,barn,isf20 diff --git a/src/programs/Simulation/bggen_jpsi/code/include/concom.inc b/src/programs/Simulation/bggen_jpsi/code/include/concom.inc deleted file mode 100644 index 8bd52235e5..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/concom.inc +++ /dev/null @@ -1,8 +0,0 @@ - real PIE,ALPHA,CHBAR,APRMAS,AMUMAS,AELMAS - double precision DMUPR2,DMUNE2,DPI,DALPI,DCMOTT,DCTSAI,DP26 - double precision DP23,DC1,DC2,DC3,DC4,DC5,DCE,DCM,DCSPEN -C CONSANTS COMMON -C ...MAS= PARTICLE MASSES - COMMON /CONCOM/ PIE,ALPHA,CHBAR,APRMAS,AMUMAS,AELMAS - 1 ,DMUPR2,DMUNE2,DPI,DALPI,DCMOTT,DCTSAI,DP26 - 2 ,DP23,DC1,DC2,DC3,DC4,DC5,DCE,DCM,DCSPEN(14) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/deltacom.inc b/src/programs/Simulation/bggen_jpsi/code/include/deltacom.inc deleted file mode 100644 index 6359b947d7..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/deltacom.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision delta5 - common/delta5/delta5 diff --git a/src/programs/Simulation/bggen_jpsi/code/include/density.inc b/src/programs/Simulation/bggen_jpsi/code/include/density.inc deleted file mode 100644 index 91194ee3ea..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/density.inc +++ /dev/null @@ -1,14 +0,0 @@ - integer nt - integer ntdis,ntpho - integer ntx,nty - parameter(ntdis=35) - parameter(ntpho=44) - parameter(nt=ntpho) - - real*4 denstk,width - real*4 densdis,widdis - real*4 denspho,widpho -* make these arrays large enough for all cases - common/density/ntx,nty,denstk(nt,nt,245,3),width(nt,nt,7,3) - & ,densdis(ntdis,ntdis,245,3),widdis(ntdis,ntdis,7,3) - & ,denspho(ntpho,ntpho,245,3),widpho(ntpho,ntpho,7,3) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/double.inc b/src/programs/Simulation/bggen_jpsi/code/include/double.inc deleted file mode 100644 index 5d798976f5..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/double.inc +++ /dev/null @@ -1 +0,0 @@ - IMPLICIT DOUBLE PRECISION (D) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/gamcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/gamcom.inc deleted file mode 100644 index 26600ecc72..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/gamcom.inc +++ /dev/null @@ -1,8 +0,0 @@ - double precision DSTK,DCTK,DOM,DQ2,DW1J,DW2J,DTK,DPHK - + ,DSITKM,DSIMJ,DCVTKM - + ,DCVMJ,DDELMJ,DDETKM - integer NDXTKM,NDXMJ - COMMON /GAMCOM/ DSTK,DCTK,DOM,DQ2,DW1J,DW2J,DTK,DPHK - + ,DSITKM(245,80),DSIMJ(80),DCVTKM(245,80) - + ,DCVMJ(80),DDELMJ(80),DDETKM(245,80) - + ,NDXTKM(80),NDXMJ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/intcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/intcom.inc deleted file mode 100644 index 46fff5bcd9..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/intcom.inc +++ /dev/null @@ -1,2 +0,0 @@ - integer ISUMMJ - COMMON /INTCOM/ ISUMMJ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/kincom.inc b/src/programs/Simulation/bggen_jpsi/code/include/kincom.inc deleted file mode 100644 index 49e0403292..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/kincom.inc +++ /dev/null @@ -1,15 +0,0 @@ - double precision DM,DM2,DMT,DMT2,DELTA,DEL1 - 1 ,DXX,DYY,DNUNU,DQ2Q2,DCTR,DTR,DSP - 2 ,DES,DES2,DSVEK,DSVEK2,DCTS,DSTS,DTS - 3 ,DEP,DEP2,DPVEK,DPVEK2,DCTP,DSTP,DTP - 4 ,DU2,DU0,DUVEK,DUVEK2 - 5 ,DMJ,DFTSAI -C THIS COMMON CONTAINS KINEMATICAL VARIABLES FOR A GIVEN MUON ARM -C AND A GIVEN TARGET MASS. IT IS FILLED IN THE ROUTINE RADKIN. -C (EXCEPT DMJ WHICH IS FILLED LATER) - COMMON /KINCOM/ DM,DM2,DMT,DMT2,DELTA,DEL1 - 1 ,DXX,DYY,DNUNU,DQ2Q2,DCTR,DTR,DSP - 2 ,DES,DES2,DSVEK,DSVEK2,DCTS,DSTS,DTS - 3 ,DEP,DEP2,DPVEK,DPVEK2,DCTP,DSTP,DTP - 4 ,DU2,DU0,DUVEK,DUVEK2 - 5 ,DMJ,DFTSAI diff --git a/src/programs/Simulation/bggen_jpsi/code/include/leptou.inc b/src/programs/Simulation/bggen_jpsi/code/include/leptou.inc deleted file mode 100644 index f902ced340..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/leptou.inc +++ /dev/null @@ -1,9 +0,0 @@ -* -* to avoid variable conflictions, a second keep element is necessary -* with the same common block name (see LPTOU2) -* - COMMON /LEPTOU/ CUT(14),LST(40),PARL(30), - & X,Y,W2,Q2,U - REAL CUT,PARL,X,Y,W2,Q2,U - INTEGER LST - SAVE /LEPTOU/ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/mcRadCor.inc b/src/programs/Simulation/bggen_jpsi/code/include/mcRadCor.inc deleted file mode 100644 index a3b92170fb..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/mcRadCor.inc +++ /dev/null @@ -1,46 +0,0 @@ - INTEGER mcRadCor, - + mcRadCor_9999 - INTEGER mcRadCor_ID - CHARACTER*4 mcRadCor_cType - REAL mcRadCor_XTrue, - + mcRadCor_YTrue, - + mcRadCor_NuTrue, - + mcRadCor_Q2True, - + mcRadCor_W2True, - + mcRadCor_ThetaBrems, - + mcRadCor_PhiBrems, - + mcRadCor_SigRad, - + mcRadCor_SigCor, - + mcRadCor_SigCorErr, - + mcRadCor_TailIne, - + mcRadCor_TailEla, - + mcRadCor_TailCoh, - + mcRadCor_Vacuum, - + mcRadCor_Vertex, - + mcRadCor_Small, - + mcRadCor_RedFac, - + mcRadCor_EBrems - - COMMON /mcRadCor/ mcRadCor, - + mcRadCor_ID, - + mcRadCor_cType, - + mcRadCor_XTrue, - + mcRadCor_YTrue, - + mcRadCor_NuTrue, - + mcRadCor_Q2True, - + mcRadCor_W2True, - + mcRadCor_ThetaBrems, - + mcRadCor_PhiBrems, - + mcRadCor_SigRad, - + mcRadCor_SigCor, - + mcRadCor_SigCorErr, - + mcRadCor_TailIne, - + mcRadCor_TailEla, - + mcRadCor_TailCoh, - + mcRadCor_Vacuum, - + mcRadCor_Vertex, - + mcRadCor_Small, - + mcRadCor_RedFac, - + mcRadCor_EBrems, - + mcRadCor_9999 - diff --git a/src/programs/Simulation/bggen_jpsi/code/include/mc_set.inc b/src/programs/Simulation/bggen_jpsi/code/include/mc_set.inc deleted file mode 100644 index a0e579c2c0..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/mc_set.inc +++ /dev/null @@ -1,52 +0,0 @@ - common /common_mc_set/ - + mcSet_EneBeam, - + mcSet_TarA, - + mcSet_TarZ, - + mcSet_Q2Min, - + mcSet_Q2Max, - + mcSet_YMin, - + mcSet_YMax, - + qedrad, - + Model, - + genSet_FStruct, - + genSet_R, - + mcSet_PTarget, - + mcSet_PBeam, - + mcSet_XMin, - + mcSet_XMax - save /common_mc_set/ - - integer - + qedrad, - + Model, - + mcSet_TarA, - + mcSet_TarZ - - real - + mcSet_EneBeam, - + mcSet_Q2Min, - + mcSet_Q2Max, - + mcSet_YMin, - + mcSet_YMax, - + mcSet_XMin, - + mcSet_XMax - - character*4 - + genSet_FStruct, - + genSet_R, - + mcSet_PBeam, - + mcSet_PTarget - - common /mcevnt/ - + weight, - + genq2, gennu, genx, geny, genw2, - + genthe, genphi, geneprim, genpprim, - + genpx, genpy, genpz, - + genvx, genvy, genvz - save /mcevnt/ - - real weight, ! event weight - + genq2, gennu, genx, geny, genw2, ! vertex kinematics - + genthe, genphi, geneprim, genpprim, ! scattered lepton - + genpx, genpy, genpz, ! scat lepton 3-vector - + genvx, genvy, genvz diff --git a/src/programs/Simulation/bggen_jpsi/code/include/mconsp.inc b/src/programs/Simulation/bggen_jpsi/code/include/mconsp.inc deleted file mode 100644 index 7dd4bd0476..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/mconsp.inc +++ /dev/null @@ -1,17 +0,0 @@ - - double precision PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS - double precision EMMU,PMASS,AVO,NMASS - - parameter (PI = 3.14159265358979324D0) - parameter (TWOPI = 6.28318530717958648D0) - parameter (PIBY2 = 1.57079632679489662D0) - parameter (DEGRAD = 0.0174532925199432958D0) - parameter (RADDEG = 57.2957795130823209D0) - parameter (CLIGHT = 29979245800.D0) - parameter (BIG = 10000000000.D0) - parameter (EMASS = 0.0005109990615D0) - parameter (EMMU = 0.105658387D0) - parameter (PMASS = 0.9382723128D0) - parameter (AVO = 0.60221367D0) - parameter (NMASS = 0.939566D0) -* diff --git a/src/programs/Simulation/bggen_jpsi/code/include/phiout.inc b/src/programs/Simulation/bggen_jpsi/code/include/phiout.inc deleted file mode 100644 index 4ea0eb1c0d..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/phiout.inc +++ /dev/null @@ -1,7 +0,0 @@ - double precision DPHI,DSUMPH,DDEPHI - + ,DEG,DTHG,DPHIG,DPLABG - integer KMP - character*4 vertextype - COMMON /PHIOUT/ DPHI(61),DSUMPH(61),DDEPHI(61) - + ,DEG,DTHG,DPHIG,DPLABG(3),KMP, - + vertextype diff --git a/src/programs/Simulation/bggen_jpsi/code/include/polcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/polcom.inc deleted file mode 100644 index a0940ecfde..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/polcom.inc +++ /dev/null @@ -1,2 +0,0 @@ - double precision as,bs,cs,ae,be,ce,apn,apq,dk2ks,dksp1,dapks - common/pol/as,bs,cs,ae,be,ce,apn,apq,dk2ks,dksp1,dapks diff --git a/src/programs/Simulation/bggen_jpsi/code/include/ppicom.inc b/src/programs/Simulation/bggen_jpsi/code/include/ppicom.inc deleted file mode 100644 index e31168cd23..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/ppicom.inc +++ /dev/null @@ -1,3 +0,0 @@ - double precision pi,pi2,alfa - integer i1,i2 - common/p/pi,pi2,alfa,i1(8),i2(8) diff --git a/src/programs/Simulation/bggen_jpsi/code/include/py6int1.inc b/src/programs/Simulation/bggen_jpsi/code/include/py6int1.inc deleted file mode 100644 index 36ed984f29..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/py6int1.inc +++ /dev/null @@ -1,8 +0,0 @@ - -C----------------------------------------------------------------- - -C...Internal variables. - COMMON/PYINT1/MINT(400),VINT(400) - INTEGER MINT - DOUBLE PRECISION VINT - SAVE/PYINT1/ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/py6pars.inc b/src/programs/Simulation/bggen_jpsi/code/include/py6pars.inc deleted file mode 100644 index b9d5b37cd3..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/py6pars.inc +++ /dev/null @@ -1,8 +0,0 @@ - -C----------------------------------------------------------------- - -C...Parameters. - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - INTEGER MSTP,MSTI - DOUBLE PRECISION PARP,PARI - SAVE/PYPARS/ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/py6strf.inc b/src/programs/Simulation/bggen_jpsi/code/include/py6strf.inc deleted file mode 100644 index b535eedcd7..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/py6strf.inc +++ /dev/null @@ -1,7 +0,0 @@ -* -* to avoid variable conflictions, a second keep element is necessary -* with the same common block name (see LPTOU2) -* - COMMON /py6strf/ py6f1, py6f2, py6R - DOUBLE PRECISION py6f1, py6f2, py6R - SAVE /py6strf/ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/pypars.inc b/src/programs/Simulation/bggen_jpsi/code/include/pypars.inc deleted file mode 100644 index 32b330b859..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/pypars.inc +++ /dev/null @@ -1,4 +0,0 @@ - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - INTEGER MSTP,MSTI - double precision PARP,PARI - SAVE /PYPARS/ diff --git a/src/programs/Simulation/bggen_jpsi/code/include/radgen.inc b/src/programs/Simulation/bggen_jpsi/code/include/radgen.inc deleted file mode 100644 index 31feab1099..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/radgen.inc +++ /dev/null @@ -1,26 +0,0 @@ - real radgen_xmin, radgen_xmax, radgen_ymin, radgen_ymax - - parameter (radgen_xmin=1.0e-09) - parameter (radgen_xmax=0.99) - parameter (radgen_ymin=0.05) - parameter (radgen_ymax=0.95) - - double precision sigrad,tine,tnuc,tpro,tbor,demin,phipoi - + ,sig1g,sigcor,vac,vertex,small,redfac - + ,dsts,dcts - + ,taout,rrout,dsitkm,dcvtkm,ddetkm,dsigmr,drcurr,ddeler - - integer ntk,nrr,itkcur,iphi,ndxtkm - - real sigradu, sigradp, sig1gu, sig1gp - - common /rgencom/sigrad,tine,tnuc,tpro,tbor,demin - + ,sig1g,sigcor,vac,vertex,small,redfac - + ,dsts,dcts - + ,phipoi,taout,rrout - + ,dsitkm(400,3),dcvtkm(400,3),ddetkm(400,3) - + ,dsigmr(200,400),drcurr(200,400),ddeler(200,400) - + ,ntk,nrr ,itkcur,iphi,ndxtkm(3) - + ,sigradu, sigradp, sig1gu, sig1gp - - diff --git a/src/programs/Simulation/bggen_jpsi/code/include/radgenkeys.inc b/src/programs/Simulation/bggen_jpsi/code/include/radgenkeys.inc deleted file mode 100644 index 9fd8f5a095..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/radgenkeys.inc +++ /dev/null @@ -1,4 +0,0 @@ - - integer ixytest, kill_elas_res - real plrun,pnrun - common/radgenkeys/plrun,pnrun,ixytest,kill_elas_res diff --git a/src/programs/Simulation/bggen_jpsi/code/include/sxycom.inc b/src/programs/Simulation/bggen_jpsi/code/include/sxycom.inc deleted file mode 100644 index 35f45e3554..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/sxycom.inc +++ /dev/null @@ -1,4 +0,0 @@ - double precision s,x,sx,sxp,y,ym,w2,als,alx,alm,aly, - + sqls,sqlx,sqly,sqlm,allm,an,tamin,tamax,xs,ys,tpl,tmi - common/sxy/s,x,sx,sxp,y,ym,w2,als,alx,alm,aly, - + sqls,sqlx,sqly,sqlm,allm,an,tamin,tamax,xs,ys,tpl,tmi diff --git a/src/programs/Simulation/bggen_jpsi/code/include/tailcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/tailcom.inc deleted file mode 100644 index 2ef5ea75dc..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/tailcom.inc +++ /dev/null @@ -1,9 +0,0 @@ - real pl,pn - integer ita,isf1,isf2,isf3,ire - double precision qfor,q2bin,ffnuc,un,qn - integer nqbin,nndummy - - common/tail/un,pl,pn,qn,ita,isf1,isf2,isf3,ire - COMMON /FORCOM/ QFOR,Q2BIN,NQBIN,nndummy,FFNUC(600) - - diff --git a/src/programs/Simulation/bggen_jpsi/code/include/xytabcom.inc b/src/programs/Simulation/bggen_jpsi/code/include/xytabcom.inc deleted file mode 100644 index a182ae5575..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/include/xytabcom.inc +++ /dev/null @@ -1,39 +0,0 @@ - real x,y - + ,sig1g_u,sigrad_u - + ,tbor_u,tine_u,tnuc_u,tpro_u - + ,sig1g_p,sigrad_p - + ,tbor_p,tine_p,tnuc_p,tpro_p - + ,vac_u,vertex_u,small_u,redfac_u - + ,sig1g_udis,sigrad_udis - + ,tbor_udis,tine_udis,tnuc_udis,tpro_udis - + ,sig1g_pdis,sigrad_pdis - + ,tbor_pdis,tine_pdis,tnuc_pdis,tpro_pdis - + ,vac_udis,vertex_udis,small_udis,redfac_udis - + ,sig1g_upho,sigrad_upho - + ,tbor_upho,tine_upho,tnuc_upho,tpro_upho - + ,sig1g_ppho,sigrad_ppho - + ,tbor_ppho,tine_ppho,tnuc_ppho,tpro_ppho - + ,vac_upho,vertex_upho,small_upho,redfac_upho - common/xytab/x(nt),y(nt) - + ,sig1g_u(nt,nt),sigrad_u(nt,nt),tbor_u(nt,nt) - + ,tine_u(nt,nt),tnuc_u(nt,nt),tpro_u(nt,nt) - + ,sig1g_p(nt,nt),sigrad_p(nt,nt),tbor_p(nt,nt) - + ,tine_p(nt,nt),tnuc_p(nt,nt),tpro_p(nt,nt) - + ,vac_u(nt,nt),vertex_u(nt,nt),small_u(nt,nt) - + ,redfac_u(nt,nt) - + ,sig1g_udis(ntdis,ntdis),sigrad_udis(ntdis,ntdis) - + ,tbor_udis(ntdis,ntdis),tine_udis(ntdis,ntdis) - + ,tnuc_udis(ntdis,ntdis),tpro_udis(ntdis,ntdis) - + ,sig1g_pdis(ntdis,ntdis),sigrad_pdis(ntdis,ntdis) - + ,tbor_pdis(ntdis,ntdis),tine_pdis(ntdis,ntdis) - + ,tnuc_pdis(ntdis,ntdis),tpro_pdis(ntdis,ntdis) - + ,vac_udis(ntdis,ntdis),vertex_udis(ntdis,ntdis) - + ,small_udis(ntdis,ntdis),redfac_udis(ntdis,ntdis) - + ,sig1g_upho(ntpho,ntpho),sigrad_upho(ntpho,ntpho) - + ,tbor_upho(ntpho,ntpho),tine_upho(ntpho,ntpho) - + ,tnuc_upho(ntpho,ntpho),tpro_upho(ntpho,ntpho) - + ,sig1g_ppho(ntpho,ntpho),sigrad_ppho(ntpho,ntpho) - + ,tbor_ppho(ntpho,ntpho),tine_ppho(ntpho,ntpho) - + ,tnuc_ppho(ntpho,ntpho),tpro_ppho(ntpho,ntpho) - + ,vac_upho(ntpho,ntpho),vertex_upho(ntpho,ntpho) - + ,small_upho(ntpho,ntpho),redfac_upho(ntpho,ntpho) diff --git a/src/programs/Simulation/bggen_jpsi/code/lowen_eve.F b/src/programs/Simulation/bggen_jpsi/code/lowen_eve.F deleted file mode 100644 index 82ec26b266..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/lowen_eve.F +++ /dev/null @@ -1,291 +0,0 @@ - SUBROUTINE LOWEN_EVE(IERR) -C -C--- Simulates 1 event of low energy (<3 GeV) photoproduction -C Reaction: gamma+p -C IDLOWEN - is the starting number of a set of predefined histograms with E,cos(th) distributions -C -C Processes: -C 1) p pi0 -C 2) n pi+ -C 3) p pi+ pi- non res -C 4) p rho0 -C 5) Delta++ pi- -C 6) p pi0 pi0 -C 7) n pi+ pi0 -C 8) p eta -C 9) p pi+ pi- pi0 -C 10) n pi+ pi+ pi- -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_evec.inc' -C - REAL HRNDM1,RNDM,HI,GBRWIGN - LOGICAL HEXIST -C - INTEGER i,j,ip,np,ibin,nproc,iproc,ityp,ihi,ierr1,ntry,ires - + ,id1,ifla,ityd,ntry1,ihel,np1 - REAL ebeam,xstot,xssum,xstmp,rnd,ecm,ecm2,bet(4),qq,ct,st,phi,wgt - + ,twopi - + ,amtot ! sum of the masses - + ,pcmm(4) ! 4-mom of the mesons - + ,betm(4) ! vel of CM as seen from the rest frame of the mesons - + ,ppf,epf1,epf2,ppi,tt,tmn,tmx,amdec,amd(6),xfac,pcms(4),par(6) - + ,wdm -C - REAL ami(2),pcmi(4,2),plabi(4,2) - + ,am(MXOUT),pcm(4,MXOUT),plab(4,MXOUT) - + ,wgt4mx(MXPROC) ! max weight for the 4-body process (potentially, for each process) - INTEGER ity(MXOUT),ndec(MXOUT),kdec(3,MXOUT),kdectyp(MXOUT) - + ,it1dec(MXOUT),itorig(MXOUT) -C - DATA wgt4mx/10*-1./ -C -C ------------------------------------------------------------------ -C - IERR=1 - IEVPROC=-1 - nproc=MXPROC ! number of defined processes -C -C--- Beam energy -C - ebeam=PIN(3,1) - CALL HXI(IDBEAM,ebeam,ibin) ! get ibin - the bin number for this energy -C - NTRA=0 -C -C--- Initial state (beam goes along Z - no rotation applied) -C - DO i=1,2 - ami(i)=AMIN(i) - DO j=1,3 - plabi(j,i)=PIN(j,i) - ENDDO - qq=plabi(1,i)**2+plabi(2,i)**2+plabi(3,i)**2 - plabi(4,i)=SQRT(qq+ami(i)**2) - ENDDO - DO j=1,4 - pcms(j)=plabi(j,1)+plabi(j,2) - ENDDO -C -C write(6,*) 'ami', ami,plab(4,1),plab(4,2) - ecm2=ami(1)**2+ami(2)**2+2.*plabi(4,1)*plabi(4,2) - ecm=SQRT(ecm2) -C -C--- Choose a process -C - xstot=HI(IDBEAM+10,ibin) - xssum=HI(IDLOWEN+15,ibin) ! sum of all processes -C write(6,*) ' xstot..', IEVENT,xstot,xssum - IF(xstot.LE.0.) GO TO 999 ! no simulation (low energy?) - IF(xssum.LE.0.) GO TO 999 -C - xstmp=0. - rnd=RNDM(xstmp) - iproc=1 - DO i=1,nproc-1 - xstmp=xstmp+HI(IDLOWEN+10000*iproc,ibin)/xssum - IF(xstmp.GE.rnd) GO TO 20 - iproc=i+1 - ENDDO - 20 CONTINUE -C - IEVPROC=iproc -C - ntry=0 - 30 np=0 - ntry=ntry+1 - amtot=0. - ires=0 - DO ip=1,MXOUT - ityp=ITYPROC(ip,IEVPROC) - IF(ityp.GT.0.AND.ityp.LE.MXPART) THEN - np=np+1 - ity(np)=ityp - am(np)=AM_PART(ityp) - amdec=0. - ndec(np)=0 - itorig(np)=0 - it1dec(np)=0 - DO i=1,3 - ityd=KD_PART(i,ityp) - IF(ityd.GT.0.AND.ityd.LE.MXPART) THEN - ndec(np)=ndec(np)+1 - kdec(ndec(np),np)=ityd - amdec=amdec+AM_PART(ityd) - ENDIF - ENDDO - kdectyp(np)=KD_PART(4,ityp) - IF(WG_PART(ityp).GT.0.) THEN - ires=1 - ntry1=0 - 35 ntry1=ntry1+1 - wdm=WG_PART(ityp)*GBRWIGN(am) -C write(6,*) am(np),wdm,amdec - IF(am(np)+wdm.LT.amdec+0.01) THEN - IF(ntry1.LT.1000) GO TO 35 - WRITE(6,*) ' *** BGGEN_EVE unsuff mass for decay ' - + ,ityp,am(np),wdm,am(np)+wdm,amdec - GO TO 999 - ENDIF - am(np)=am(np)+wdm - ENDIF - amtot=amtot+am(np) - ENDIF - ENDDO -C write(6,*) ' np..', np,amtot,ecm-0.01 - IF(np.LT.1) GO TO 999 - IF(amtot.GE.ecm-0.01) THEN - IF(ntry.LT.1000) GO TO 30 - GO TO 999 - ENDIF -C - DO i=1,3 - bet(i)=(plabi(i,1)+plabi(i,2))/(plabi(4,1)+plabi(4,2)) - ENDDO - bet(4)=(plabi(4,1)+plabi(4,2))/ecm - DO i=1,2 - CALL GLOREN(bet,plabi(1,i),pcmi(1,i)) - ENDDO - DO i=1,3 - bet(i)=-bet(i) - ENDDO -C -C--- Treat the kinematics as 2-body one, in CM -C - twopi=ACOS(0.)*4. - ierr1=1 - IF(np.EQ.2) THEN -C IF(IEVPROC.LE.2.OR. ! SAID -C + IEVPROC.EQ.6 ! eta -C + ) THEN -C--- In CM: momentum and energies of the particles -C - epf1=(ecm2+am(1)**2-am(2)**2)/2./ecm - ppf =SQRT(epf1**2-am(1)**2) ! final momentum - ppi=SQRT(pcmi(4,2)**2-ami(2)**2) ! initial momentum - IF(ppf.LE.0.) GO TO 999 -C - id1=IDLOWEN+10000*IEVPROC - ihi=0 - IF(HEXIST(id1+1)) THEN - ihi=INT(HI(id1+1,ibin)+0.1) - IF(ihi.GT.0) THEN - ct= HRNDM1(id1+10+ihi) - ct=-ct ! first particle is the recoil - invert the COS(TH) - ierr1=0 - ENDIF - ENDIF - IF(ierr1.NE.0) THEN - qq=ami(2)**2+am(1)**2-2.*epf1*pcmi(4,2) - tmn=-(qq+2.*ppf*ppi) - tmx=-(qq-2.*ppf*ppi) - CALL GPXCOSTHR(IEVPROC,ebeam,tmn,tmx,ct,ierr1) ! generated for the secondary baryon - ENDIF - IF(ierr1.NE.0) THEN - WRITE(6,*) ' *** Error in simulating COS(TH) ',ierr1 - + ,' proc=',IEVPROC - ENDIF -C - st=SQRT(1.-ct**2) - phi=twopi*RNDM(st) -C -C--- 2-body -C - pcm(4,1)=epf1 -C - pcm(1,1)=ppf*st*COS(phi) - pcm(2,1)=ppf*st*SIN(phi) - pcm(3,1)=ppf*ct -C - DO i=1,3 - pcm(i,2)=-pcm(i,1) - ENDDO - pcm(4,2)=ecm-pcm(4,1) -C -C--- Boost to Lab -C - DO i=1,2 - CALL GLOREN(bet,pcm(1,i),plab(1,i)) - ENDDO -C -C--- Decays? -C - DO i=1,2 - IF(ndec(i).GT.0) THEN - it1dec(i)=np+1 - DO j=1,ndec(i) - amd(j)=AM_PART(kdec(j,i)) - am (np+j)=amd(j) - ity(np+j)=kdec(j,i) - ndec(np+j)=0 - itorig(np+j)=i - it1dec(np+j)=0 - ENDDO - IF(ndec(i).EQ.2) THEN ! 2-body decay - ihel=kdectyp(i) ! decay angle flag =0 - unoform, =1 - rho-like, =2 - j/psi-like - CALL OMDECA2(plab(1,i),amd(1),ihel,plab(1,np+1)) - ELSE IF(ndec(i).EQ.3) THEN - CALL OMDECA3(plab(1,i),amd(1),0.,plab(1,np+1)) - ENDIF - np=np+ndec(i) - ENDIF - ENDDO -C - ELSE IF(np.EQ.3) THEN -C - xfac=0. - CALL OMDECA3(pcms(1),am(1),xfac,plab(1,1)) -C - ELSE IF(np.EQ.4) THEN -C -C--- Phase space: -C - IF(wgt4mx(IEVPROC).LT.0.) THEN ! initialize the max weight - DO i=1,20000 - wgt=0. - CALL GDECAN(np,ecm,am,wgt,pcm(1,1)) - wgt4mx(IEVPROC)=MAX(wgt4mx(IEVPROC),wgt) - ENDDO - wgt4mx(IEVPROC)=wgt4mx(IEVPROC)*1.2 - ENDIF - wgt=wgt4mx(IEVPROC) - CALL GDECAN(np,ecm,am,wgt,pcm(1,1)) - DO i=1,np - CALL GLOREN(bet,pcm(1,i),plab(1,i)) - ENDDO -C - ENDIF -C - DO i=1,np - DO j=1,3 - PTRA(j,i)=plab(j,i) - ENDDO - AMTRA(i)=am(i) - ITPTRA(1,i)=ity(i) - DO j=2,6 - ITPTRA(j,i)=0 - ENDDO -C write(6,*) i,ity(i),MXPGEANT,IPLUND(ity(i)),itorig(i),it1dec(i) - IF(ity(i).GT.0.AND.ity(i).LE.MXPGEANT) THEN - ITPTRA(3,i)=IPLUND(ity(i)) - ENDIF - ITPTRA(4,i)=itorig(i) - ITPTRA(5,i)=it1dec(i) - IF(it1dec(i).GT.0) ITPTRA(6,i)=it1dec(i)+ndec(i)-1 - ITPTRA(2,i)=1 - IF(it1dec(i).NE.0) ITPTRA(2,i)=10 ! indicates that this particle should not be used in GEANT - ENDDO - NTRA=np -C - IERR=0 - 999 CONTINUE -C write(6,*) ebeam,IEVPROC,ibin,xstot,xssum,NTRA -C - END -C - diff --git a/src/programs/Simulation/bggen_jpsi/code/lowen_ini.F b/src/programs/Simulation/bggen_jpsi/code/lowen_ini.F deleted file mode 100644 index c4e27b7618..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/lowen_ini.F +++ /dev/null @@ -1,142 +0,0 @@ - SUBROUTINE LOWEN_INI(IERR) -C -C--- Low energy photoproduction initialization -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_proc.inc' - INCLUDE 'bg_partc.inc' -C - REAL SAIDE,SAIDXSECA,GPXSECP - LOGICAL HEXIST -C - INTEGER i,j,nb,ipro,npro,id1,idt,ncth,icth,ihi,lun,iost - + ip,lout - REAL emn,emx,flx1,flx2,flx,xsec,dx,de,e,dcth,cth - + ,xlum,ecurr,xsth,targth,frate -C - CHARACTER tit*132,cpro*2,cenr*4,cline*132 -C - CHARACTER cnampro(MXPROC)*16 - DATA cnampro/'p pi0 ' - + ,'n pi+ ' - + ,'p pi+ pi- ' - + ,'p rho0 ' - + ,'Delta++ pi- ' - + ,'p pi0 pi0 ' - + ,'n pi+ pi0 ' - + ,'p eta ' - + ,'p pi+ pi- pi0 ' - + ,'n pi+ pi+ pi- ' - + / -C - INTEGER itypr(MXOUT,MXPROC) - DATA itypr/14, 7, 0, 0, 0, 0 - + ,13, 8, 0, 0, 0, 0 - + ,14, 8, 9, 0, 0, 0 - + ,14,80, 0, 0, 0, 0 - + ,82, 9, 0, 0, 0, 0 - + ,14, 7, 7, 0, 0, 0 - + ,13, 8, 7, 0, 0, 0 - + ,14,17, 0, 0, 0, 0 - + ,14, 8, 9, 7, 0, 0 - + ,13, 8, 8, 9, 0, 0 - + / -C - IERR=1 - lout=6 -C - DO i=1,MXPROC - CNPROC(i)=cnampro(i) - DO j=1,MXOUT - ITYPROC(j,i)=itypr(j,i) - ENDDO - ENDDO -C -C - IF(NHBEA.LT.1) THEN - WRITE(6,1010) NHBEA - 1010 FORMAT(' *** Initialization error: NHBEA=',I6) - GO TO 999 - ENDIF -C - emn=EPH_LIM(1) - emx=MIN(EPYMIN,EPH_LIM(2)) -C -C--- Adjust the emx to the bin boundary -C - de=(EPH_LIM(2)-EPH_LIM(1))/NHBEA - nb=INT((emx-emn)/de) - emx=emn+nb*de - EPYMIN=emx -C -C--- Initialize the processes -C - npro=10 ! number of defined processes - ncth=100 ! number of bins in the COS(th) distribution - dcth=2./ncth - DO ipro=1,npro - id1=IDLOWEN+10000*ipro - WRITE(cpro,FMT='(I2)') ipro - CALL HBOOK1(id1,'X-section for process '//cpro,nb,emn,emx,0.) -C -C--- Define the COS(TH) plots? -C - IF(ipro.LE.2.OR. ! SAID - + ipro.EQ.8) THEN ! eta - CALL HBOOK1(id1+1,'refer for COS(TH) for process '//cpro - + ,nb,emn,emx,0.) - ENDIF -C - DO i=1,nb - e=emn+(i-0.5)*de -C -C--- Full x-section -C - IF(ipro.LE.2) THEN -C -C--- SAID is used -C - xsec=SAIDE(e,ipro,1) ! SAID cross section, supressed above 2 GeV - ihi=i - ELSE - xsec=GPXSECP(e,ipro) ! x-sec in mb - ihi=0 -C CALL GPXCOSTH(e,ipro,0.,ihi,xsth) ! check the COS(th) distribution - ENDIF -C - CALL HF1(id1,e,xsec) - CALL HF1(id1+1,e,REAL(ihi)) -C -C--- Get the cos(th) distributions -C - idt=id1+10+ihi - IF(ihi.NE.0.AND..NOT.HEXIST(idt)) THEN ! fill the COS(th) distrib if not yet filled - WRITE(cenr,FMT='(I4)') i - CALL HBOOK1(idt,'COS(TH), proc '//cpro//' energy '//cenr - + ,ncth,-1.,1.,0.) - DO icth=1,ncth - cth=-1.+(icth-0.5)*dcth - IF(ipro.LE.2) THEN - xsth=SAIDXSECA(e,cth,ipro,1) - ELSE -C CALL GPXCOSTH(e,ipro,cth,ihi,xsth) ! get the COS(th) distribution - ENDIF - CALL HF1(idt,cth,xsth) - ENDDO - ENDIF - ENDDO -C - IF(ipro.EQ.1) THEN - CALL HCOPY(id1,IDLOWEN+15,'X-section for all process ') - ELSE - CALL HOPERA(id1,'+',IDLOWEN+15,IDLOWEN+15,1.,1.) - ENDIF -C - ENDDO -C - IERR=0 - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/omdeca2.F b/src/programs/Simulation/bggen_jpsi/code/omdeca2.F deleted file mode 100644 index fd48699174..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/omdeca2.F +++ /dev/null @@ -1,133 +0,0 @@ - SUBROUTINE OMDECA2(P0,AM,IHEL,POUT) -C -C--- 2-body decay -C -C--- Input: P0 - initial 4-vector, P0**2 - mass(energy) of the initial state, -C defined in the "LAB" frame -C AM(1:2) - masses of the products -C IHEL: =0 - cos(th) (to P0 direction) uniform of the 1-st particle -C =1 - sin(th)**2=(1-cos(th)**2) - for 1-->0+0 rho -C =2 - (1+cos(th)**2) - for 2-->1/2+1/2 psi -C -C Output: POUT(1:4,1:2) - the secondary 4-momenta -C -C - - IMPLICIT NONE - REAL P0(4),AM(2),POUT(4,2) - INTEGER IHEL -C - REAL RNDM,ORNDPOLY -C - REAL pp(4,2) ! CM, Z looks along P0 - + ,pcm(4,2) ! CM, lab orientation - + ,bet(4) - + ,ecms,ecm,epf1,ppf,ct,st,phi - + ,rot(3,3),poly(10),xlim(2),p0m,twopi - INTEGER i,j -C -C--- -C - DO i=1,2 - DO j=1,4 - POUT(j,i)=0. - ENDDO - ENDDO -C - ecms=P0(4)**2-P0(1)**2-P0(2)**2-P0(3)**2 - IF(ecms.LE.0.) THEN - WRITE(6,*) ' *** OMDECA2 space-like initial vector ',ecms,P0 - GO TO 999 - ENDIF - ecm=SQRT(ecms) - IF(ecm.LE.AM(1)+AM(2)) THEN - WRITE(6,*) ' *** OMDECA2 below threshold ',ecm,AM - GO TO 999 - ENDIF -C - epf1=(ecms+AM(1)**2-AM(2)**2)/2./ecm - ppf=SQRT(epf1**2-AM(1)**2) -C - IF(IHEL.EQ.0) THEN - ct=-1.+2.*RNDM(ct) - ELSE - xlim(1)=-1. - xlim(2)= 1. - IF(IHEL.EQ.1) THEN - poly(1)= 1. ! 1-ct**2 rho 1 --> 0 0 - poly(2)= 0. ! - poly(3)=-1. ! - ELSE IF(IHEL.EQ.2) THEN - poly(1)= 1. ! 1+ct**2 jpsi 1 --> 1/2 1/2 - poly(2)= 0. ! - poly(3)= 1. ! - ENDIF - ct=ORNDPOLY(2,poly,xlim) - IF(ct.LT.-2.) THEN - WRITE(6,*) ' *** OMDECA2 ct= ',ct,ecm,IHEL - GO TO 999 - ENDIF - IF(ABS(ct).GT.1.) THEN - WRITE(6,*) ' *** OMDECA2 err ct= ',ct,ecm,IHEL - ENDIF - ENDIF -C - twopi=ACOS(0.)*4. -C - st=SQRT(1.-ct**2) - phi=twopi*RNDM(st) -C -C--- 2-body -C - pp(4,1)=epf1 -C - pp(1,1)=ppf*st*COS(phi) - pp(2,1)=ppf*st*SIN(phi) - pp(3,1)=ppf*ct -C - DO j=1,3 - pp(j,2)=-pp(j,1) - ENDDO - pp(4,2)=ecm-pp(4,1) -C -C--- Rotate to the frame where Z goes along P0 -C - p0m=SQRT(P0(1)**2+P0(2)**2+P0(3)**2) - IF(p0m.GT.0.00001) THEN - CALL OMROTS(P0,rot) - DO i=1,2 - CALL OMROTV(pp(1,i),rot,pcm(1,i)) - pcm(4,i)=pp(4,i) - ENDDO -C write(6,FMT='(A4,4F10.4)') 'p0= ' ,(P0 (j),j=1,4) -C write(6,FMT='(3F10.4)') ct,pp(3,1)/ppf -C + ,(pcm(1,1)*P0(1)+pcm(2,1)*P0(2)+pcm(3,1)*P0(3))/ppf/p0m - ELSE - DO i=1,2 - DO j=1,4 - pcm(j,i)=pp(j,i) - ENDDO - ENDDO - ENDIF -C -C--- Boost to Lab -C - bet(4)=p0(4)/ecm - DO j=1,3 - bet(j)=-P0(j)/P0(4) - ENDDO - DO i=1,2 - CALL GLOREN(bet,pcm(1,i),POUT(1,i)) - ENDDO -C -C write(6,*) 'p0=',p0,ecm -C write(6,FMT='(3F10.4)') rot -C write(6,FMT='(4F10.5)') bet -C write(6,FMT='(A4,4F10.4)') ('pp= ' ,(pp (j,i),j=1,4),i=1,2) -C write(6,FMT='(A4,4F10.4)') ('pcm=' ,(pcm(j,i),j=1,4),i=1,2) -C write(6,FMT='(A4,4F10.4)')'dif=',(P0(j)-POUT(j,1)-POUT(j,2),j=1,4) -C write(6,FMT='(A4,4F10.4)') ('lab=' ,(POUT(j,i),j=1,4),i=1,2) -C - 999 RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/omdeca3.F b/src/programs/Simulation/bggen_jpsi/code/omdeca3.F deleted file mode 100644 index 7b350e9c3d..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/omdeca3.F +++ /dev/null @@ -1,181 +0,0 @@ - SUBROUTINE OMDECA3(P0,AM,XFAC,POUT) -C -C--- 3-body phase space decays/reactions -C -C--- Input: P0 - initial 4-vector, P0**2 - mass(energy) of the initial state, -C defined in the "LAB" frame -C AM(1:3) - masses of the products -C XFAC: generate the COS(TH) (of 23 to P0 direction in CM) as EXP(XFAC*COSTH) -C =0. - uniform distribution form -1 to 1 -C -C Output: POUT(1:4,1:3) - the secondary 4-momenta -C -C -C==== Method: dG = const * dm12**2 * dm23**2 -C==== 1) simulate m12**2,m23**2 in the allowed intervals, independently -C 2) reject kinematically forbidden combinations (no reordering of random numbers) -C 2) using m23**2: -C calculate e1a,p1a in CM of 1+2+3 -C calculate e2b,p2b in CM of 2+3 -C 1 is sent along -Z -C 2) calculate the COS(TH) of m23 decay in its CM, from m12 and e1a,p1a,e2b,p2b -C 3) if no solution exists - jump to 1) -C 4) rotate the event (3 random angles) -C - IMPLICIT NONE - REAL P0(4),AM(3),XFAC,POUT(4,3) -C - REAL RNDM -C - REAL pp(4,3) ! CM, 1 along -Z, 2,3 - in ZX plane - + ,ppv(4,3) ! CM, in this frame Z is along P0 - + ,vm(3) ! direction of the 23 combination in CM, LAB angles - + ,am12s,am23s,am12,am23,rnd(2),q,ams(3),ecm,ecms - + ,p1a,e1a,p2b,e2b,costh,bet,gam,twopi,phi,phi2,ct,st - + ,rot(3,3),p0m,betap(4) - INTEGER i,j,ntry -C -C--- -C - DO i=1,3 - DO j=1,4 - POUT(j,i)=0. - ENDDO - ENDDO - ecms=P0(4)**2-P0(1)**2-P0(2)**2-P0(3)**2 - IF(ecms.LE.0.) THEN - WRITE(6,*) ' *** OMDECA3 space-like initial vector ',ecms,P0 - GO TO 999 - ENDIF - ecm=SQRT(ecms) - IF(ecm.LE.AM(1)+AM(2)+AM(3)) THEN - WRITE(6,*) ' *** OMDECA3 below threshold ',ecm,AM - GO TO 999 - ENDIF - DO i=1,3 - ams(i)=AM(i)**2 - ENDDO - ntry=0 -C - 10 ntry=ntry+1 - IF(ntry.GT.10000) THEN - WRITE(6,*) ' *** OMDECA3 error - long looping, ntry=',ntry - GO TO 999 - ENDIF - DO i=1,2 - rnd(i)=RNDM(rnd(i)) - ENDDO - q=(AM(1)+AM(2))**2 - am12s=q+rnd(1)*((ecm-AM(3))**2-q) - q=(AM(2)+AM(3))**2 - am23s=q+rnd(2)*((ecm-AM(1))**2-q) - am12=SQRT(am12s) - am23=SQRT(am23s) -C - q=ecms+ams(1)+ams(2)+ams(3)-am12s - IF(am23s.GE.q-(AM(1)+AM(3))**2) GO TO 10 - IF(am23s.LE.q- (ecm-AM(2))**2) GO TO 10 -C - e1a=(ecms+ams(1)-am23s)/2./ecm - p1a=SQRT(e1a**2-ams(1)) - e2b=(am23s+ams(2)-ams(3))/2./am23 - p2b=SQRT(e2b**2-ams(2)) -C -C--- am23 goes along Z -C--- Lorentz boost to am23: -C - bet=p1a/(ecm-e1a) - gam=(ecm-e1a)/am23 -C - costh=(am12s-ams(1)-ams(2)-2.*gam*e2b*(e1a+bet*p1a))/ - + (2.*gam*p2b*(p1a+bet*e1a)) - IF(ABS(costh).GT.1.) GO TO 10 -C - DO i=1,3 - DO j=1,4 - pp(j,i)=0. - ENDDO - ENDDO -C - pp(3,1)=-p1a - pp(4,1)= e1a - pp(1,2)= p2b*SQRT(1.-costh**2) - pp(3,2)= gam*(p2b*costh+bet*e2b) - pp(4,2)= gam*(e2b +bet*p2b*costh) - DO i=1,3 - pp(i,3)=-pp(i,1)-pp(i,2) - ENDDO - pp(4,3)=ecm-pp(4,1)-pp(4,2) -C - twopi=4.*ACOS(0.) -C -C--- Rotate 2,3 around Z -C - phi2=twopi*RNDM(twopi) - DO i=2,3 - q=pp(1,i) - pp(1,i)=q*COS(phi2) - pp(2,i)=q*SIN(phi2) - ENDDO -C -C--- Random polar angle (apply exponential COSTH-dep, if needed) -C - IF(ABS(XFAC).GT.0.001) THEN - ct=LOG(EXP(-XFAC)+RNDM(ct)*(EXP(XFAC)-EXP(-XFAC)))/XFAC - ELSE - ct=-1.+RNDM(ct)*2. - ENDIF -C - phi=twopi*RNDM(phi) - st=SQRT(1.-ct**2) - vm(1)=st*COS(phi) ! the direction of 23 combination in LAB, CM - vm(2)=st*SIN(phi) - vm(3)=ct -C - CALL OMROTS(vm,rot) ! rotate the momenta to this frame - DO i=1,3 - CALL OMROTV(pp(1,i),rot,ppv(1,i)) - ppv(4,i)=pp(4,i) - ENDDO -C -C--- Rotate to the frame where Z goes along P0 -C - p0m=SQRT(P0(1)**2+P0(2)**2+P0(3)**2) - IF(p0m.GT.0.00001) THEN - CALL OMROTS(P0,rot) - DO i=1,3 - CALL OMROTV(ppv(1,i),rot,pp(1,i)) - pp(4,i)=ppv(4,i) - ENDDO - ELSE - DO i=1,3 - DO j=1,4 - pp(j,i)=ppv(j,i) - ENDDO - ENDDO - ENDIF -C -C--- Lorentz boost to P0 -C - q=0. - DO i=1,3 - betap(i)=-P0(i)/P0(4) - q=q+betap(i)**2 - ENDDO -C - IF(q.GT.1.E-10) THEN - betap(4)=P0(4)/ecm - DO i=1,3 - CALL GLOREN(betap(1),pp(1,i),POUT(1,i)) - ENDDO - ELSE - DO i=1,3 - DO j=1,3 - POUT(j,i)=pp(j,i) - ENDDO - ENDDO - ENDIF -C - 999 RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/omrots.F b/src/programs/Simulation/bggen_jpsi/code/omrots.F deleted file mode 100644 index 14e36bfe95..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/omrots.F +++ /dev/null @@ -1,85 +0,0 @@ -* $Header:$ -* $Log:$ -* - SUBROUTINE OMROTS(V,ROT) -C -C ****************************************************************** -C * * -C * Fill a rotation matrix V=ROT*V1 * -C * INPUT: V - 3 vector * -C * OUTPUT: ROT - rotation matrix (V1 looks along Z) * -C * * -C * ==>Called by : kinematics programs * -C * * -C ****************************************************************** -C - IMPLICIT NONE - REAL V(3),ROT(3,3) -C -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id:$'/ -C#endif -C - INTEGER i,j,mn,mx,m3 - REAL ptot,vn(3),vx(3),q -C -C ------------------------------------------------------------------ -C - ptot=SQRT(V(1)**2+V(2)**2+V(3)**2) - IF(ptot.GT.0.) THEN - - DO i=1,3 - vn(i)=V(i)/ptot - ROT(3,i)=vn(i) - ENDDO -C -C--- Define X-Y (arbitrary) - a vector normal to vn -C - mn=1 - DO i=2,3 - IF(ABS(vn(i)).LT.ABS(vn(mn))) mn=i - ENDDO - mx=3 - DO i=1,2 - IF(ABS(vn(i)).GT.ABS(vn(mx))) mx=i - ENDDO - m3=mn+1 - IF(m3.GT.3) m3=m3-3 - IF(m3.EQ.mx) m3=m3+1 - IF(m3.GT.3) m3=m3-3 -C--- condition: vx*vn=0. - vx(mx)=0. - vx(mn)=1. - vx(m3)=0. - IF(vn(m3).NE.0.) vx(m3)=-vn(mn)*vx(mn)/vn(m3) - q=SQRT(1.+vx(m3)**2) - DO i=1,3 - vx(i)=vx(i)/q - ENDDO -C - DO i=1,3 - ROT(1,i)=vx(i) - ENDDO -C -C--- Y-coord -C - ROT(2,1)= vn(2)*vx(3)-vn(3)*vx(2) - ROT(2,2)=-vn(1)*vx(3)+vn(3)*vx(1) - ROT(2,3)= vn(1)*vx(2)-vn(2)*vx(1) -C - ELSE - DO i=1,3 - DO j=1,3 - IF(j.EQ.i) THEN - ROT(j,i)=1. - ELSE - ROT(j,i)=0. - ENDIF - ENDDO - ENDDO - ENDIF -C - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/omrotv.F b/src/programs/Simulation/bggen_jpsi/code/omrotv.F deleted file mode 100644 index f72b415185..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/omrotv.F +++ /dev/null @@ -1,41 +0,0 @@ -* $Header:$ -* $Log:$ -* - SUBROUTINE OMROTV(V1,ROT,V2) -C -C ****************************************************************** -C * * -C * Vector rotation V1 ==> V2 using ROT matrix * -C * * -C * ==>Called by : OMKINE * -C * * -C ****************************************************************** -C - IMPLICIT NONE - REAL V1(3),ROT(3,3),V2(3) -C -C#if defined OMGEANT_VERSION -C CHARACTER*80 VersionString -C DATA VersionString / -C & '$Id:$'/ -C#endif -C - INTEGER i,j -C -C ------------------------------------------------------------------ -C - DO i=1,3 - V2(i)=0. - DO j=1,3 - V2(i)=V2(i)+ROT(j,i)*V1(j) - ENDDO - ENDDO -C - RETURN - END - - - - - - diff --git a/src/programs/Simulation/bggen_jpsi/code/orndpoly.F b/src/programs/Simulation/bggen_jpsi/code/orndpoly.F deleted file mode 100644 index 2b49c641be..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/orndpoly.F +++ /dev/null @@ -1,97 +0,0 @@ - REAL FUNCTION ORNDPOLY(NP,RP,XLIM) -C -C--- Generate a random number to a polynomial distribution (NP<3): -C RP(0)+RP(1)*X**1+...+RP(NP)*X**NP -C in an interval XLIM(1):XLIM(2) - IMPLICIT NONE - INTEGER NP - REAL RP(0:NP),XLIM(2) -C - REAL RNDM -C - INTEGER i,j,np1,np2,nsol,nrusf - REAL p(0:20) ! - integral polynomial - + ,anorm,xx,qq,rnd,xres(20) -C - DOUBLE PRECISION dp(0:20),dx(10),dd -C - ORNDPOLY=-9999. - xx=0. - IF(NP.LT.0) GO TO 999 - IF(XLIM(1).GE.XLIM(2)) GO TO 999 -C -C--- Integrate the polynomial -C - np1=NP+1 - p(0)=0. - DO i=1,np1 - p(i)=RP(i-1)/REAL(i) - p(0)=p(0)-p(i)*XLIM(1)**i ! normalization: =0 at XLIM(1) - ENDDO -C - anorm=0. - DO i=0,np1 - anorm=anorm+p(i)*XLIM(2)**i ! normalization: =1 at XLIM(2) - ENDDO - np2=1 ! the real power of the polynomial - DO i=0,np1 - p(i)=p(i)/anorm - IF(ABS(p(i)).GT.1.E-15) np2=i - ENDDO -C - IF(np2.LT.1) GO TO 999 -C - rnd=RNDM(dx) - p(0)=p(0)-rnd -C - nsol=0 - IF(np2.EQ.1) THEN ! flat distr - xx=XLIM(1)+rnd*(XLIM(2)-XLIM(1)) - nsol=1 -C - ELSE IF(np2.EQ.2) THEN ! linear -C - qq=p(1)**2-4.*p(0)*p(2) - IF(qq.LT.0.) THEN - WRITE(6,*) ' *** ORNDPOLY err 1, NP=',NP - GO TO 999 - ENDIF - xres(1)=(-p(1)-SQRT(qq))/(2.*p(2)) - xres(2)=(-p(1)+SQRT(qq))/(2.*p(2)) - DO i=1,2 - IF(xres(i).GE.XLIM(1).AND.xres(i).LE.XLIM(2)) THEN - xx=xres(i) - nsol=nsol+1 - ENDIF - ENDDO -C - ELSE IF(np2.EQ.3) THEN ! 2-nd, 3-rd for the integral -C - DO i=0,np2-1 - dp(i)=p(i)/p(np2) - ENDDO -C - CALL DRTEQ3(dp(2),dp(1),dp(0),dx,dd) -C - nrusf=1 ! number of real non degenerated solutions - IF(dd.EQ.0.D0) nrusf=2 - IF(dd.LT.0.D0) nrusf=3 - DO i=1,nrusf - xres(i)=dx(i) - IF(xres(i).GE.XLIM(1).AND.xres(i).LE.XLIM(2)) THEN - xx=xres(i) - nsol=nsol+1 - ENDIF - ENDDO -C - ENDIF - IF(nsol.GT.1) THEN - WRITE(6,*) ' *** ORNDPOLY several solutions NP,nsol=',NP,nsol - GO TO 999 - ELSE IF(nsol.EQ.1) THEN - ORNDPOLY=xx - ENDIF -C -C - 999 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/parp_ini.F b/src/programs/Simulation/bggen_jpsi/code/parp_ini.F deleted file mode 100644 index f892a830e1..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/parp_ini.F +++ /dev/null @@ -1,14 +0,0 @@ - SUBROUTINE PARP_INI(IAD,VAL) -C -C--- For PYTHIA: set a PARP value -C - IMPLICIT NONE - INTEGER IAD - REAL VAL -C - INCLUDE 'include/pypars.inc' -C - IF(IAD.GT.0.AND.IAD.LE.200) THEN - PARP(IAD)=VAL - ENDIF - END diff --git a/src/programs/Simulation/bggen_jpsi/code/pyr.F b/src/programs/Simulation/bggen_jpsi/code/pyr.F deleted file mode 100644 index 07488b9567..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/pyr.F +++ /dev/null @@ -1,11 +0,0 @@ -C - DOUBLE PRECISION FUNCTION PYR(IX) - IMPLICIT NONE - INTEGER IX - REAL a -C - CALL RANLUX(a,1) - PYR=DBLE(a) - RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/pyth_eve.F b/src/programs/Simulation/bggen_jpsi/code/pyth_eve.F deleted file mode 100644 index 9fd4b0ff3e..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/pyth_eve.F +++ /dev/null @@ -1,58 +0,0 @@ - SUBROUTINE PYTH_EVE(IERR) -C -C--- Simulates 1 PYTHIA event -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_evec.inc' -C - INTEGER PYK,PYCOMP - DOUBLE PRECISION PYP - EXTERNAL PYK,PYP,PYCOMP -C - REAL beamen -C - INTEGER i,j,nlnd,ilnd,kf,kc -C -C ------------------------------------------------------------------ -C -C--- Variable energy? -C - beamen=PIN(3,1) - IF(NHBEA.GT.1) THEN - CALL PARP_INI(171,beamen/EPH_LIM(2)) ! the relative energy for this event - ENDIF -C - CALL PYEVNT - CALL PYEDIT(15) ! filter out some intermediate entries - nlnd=PYK(0,1) - NTRA=nlnd -C - DO ilnd=1,MIN(nlnd,MXTRA) - DO i=1,5 - ITPTRA(i+1,ilnd)=PYK(ilnd,i) - ENDDO - kf=ITPTRA(3,ilnd) - kc=PYCOMP(kf) - IF(kf.LT.0) kc=-kc -C write(6,*) ilnd,kf,kc,MXPKC,KCGEAN(kc) - IF(ABS(kc).LE.MXPKC) THEN - ITPTRA(1,ilnd)=KCGEAN(kc) - ELSE - ITPTRA(1,ilnd)=0 - ENDIF - DO i=1,3 - PTRA(i,ilnd)=REAL(PYP(ilnd,i)) - ENDDO - AMTRA(ilnd)=REAL(PYP(ilnd,5)) -C - ENDDO -C - IEVPROC=0 - IERR=0 - 999 CONTINUE -C - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/pyth_ini.F b/src/programs/Simulation/bggen_jpsi/code/pyth_ini.F deleted file mode 100644 index 810933324b..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/pyth_ini.F +++ /dev/null @@ -1,89 +0,0 @@ - SUBROUTINE PYTH_INI(IERR) -C -C--- Initilize PYTHIA -C Reaction: gamma+p -C--- Input: /phctrl/ beam energy -C file "pythia-geant.dat" contains a table for PYTHIA<->GEANT particle code conversion -C file "pythia.dat" - redefinition of PYTHIA parameters (from HERMES, adapted to GLUEX) -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' -C - INTEGER PYCOMP - EXTERNAL PYCOMP -C - DOUBLE PRECISION dbeam - CHARACTER cpar*100 -C - INTEGER lun,lout,i,j,lenc,kf,kc,ks,iost -C -C ------------------------------------------------------------------ -C - IERR=1 -C - lun=9 - lout=6 -C -C--- KF/KC/GEANT mapping -C - DO i=1,MXPGEANT - kf=IPLUND(i) - IF(kf.NE.0) THEN - kc=PYCOMP(kf) - IF(kc.GT.0.AND.kc.LE.MXPKC) THEN - IF(kf.LT.0) kc=-kc - KCGEAN(kc)=i - kc=ABS(kc) -C write(lout,FMT='(10I8)') i,kf,kc -C -C--- Forbid the decays for particles with GEANT code -C - IF(IDECLUND(i).EQ.0) THEN - WRITE(cpar,1000) kc,0 - 1000 FORMAT('MDCY(',I4,',1)=',I2) - CALL PYGIVE(cpar) - ENDIF - ENDIF - ENDIF - ENDDO -C -C--- Read the pythia settings for JLab energies -C - OPEN(lun,FILE='pythia.dat',STATUS='OLD',IOSTAT=iost - + ,FORM='FORMATTED') - IF(iost.NE.0) THEN - WRITE(lout,*) ' *** ERROR: Missing file pythia.dat' - GO TO 999 - ENDIF - 30 READ(lun,'(A)',IOSTAT=iost) cpar - IF(iost.EQ.0) THEN - CALL PYGIVE(cpar) - GO TO 30 - ELSE IF(iost.GT.0) THEN - WRITE(lout,*) ' *** ERROR: Reading file pythia.dat' - GO TO 999 - ENDIF - CLOSE(lun) -C -C--- Variable energy? -C - IF(NHBEA.GT.1) THEN - cpar='MSTP(171)=1' - CALL PYGIVE(cpar) - cpar='MSTP(172)=1' - CALL PYGIVE(cpar) - ENDIF -C -C--- Initialize PYTHIA -C - dbeam=DBLE(EPH_LIM(2)) -C - CALL PYINIT('FIXT','gamma','p+',dbeam) -C - IERR=0 - 999 CONTINUE -C - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/pythia_h.F b/src/programs/Simulation/bggen_jpsi/code/pythia_h.F deleted file mode 100644 index e2cf26454c..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/pythia_h.F +++ /dev/null @@ -1,62285 +0,0 @@ - -C********************************************************************* - -C...PDFSET -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE PDFSET(PARM,VALUE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local arrays and character variables. - CHARACTER*20 PARM(20) - DOUBLE PRECISION VALUE(20) - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - PARM(20)=PARM(1) - VALUE(20)=VALUE(1) - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine PDFSET in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PY1ENT -C...Stores one parton/particle in commonblock PYJETS. - - SUBROUTINE PY1ENT(IP,KF,PE,THE,PHI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)) CALL PYERRM(21, - &'(PY1ENT:) writing outside PYJETS memory') - KC=PYCOMP(KF) - IF(KC.EQ.0) CALL PYERRM(12,'(PY1ENT:) unknown flavour code') - -C...Find mass. Reset K, P and V vectors. - PM=0D0 - IF(MSTU(10).EQ.1) PM=P(IPA,5) - IF(MSTU(10).GE.2) PM=PYMASS(KF) - DO 100 J=1,5 - K(IPA,J)=0 - P(IPA,J)=0D0 - V(IPA,J)=0D0 - 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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY2ENT -C...Stores two partons/particles in their CM frame, -C...with the first along the +z axis. - - SUBROUTINE PY2ENT(IP,KF1,KF2,PECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-1) CALL PYERRM(21, - &'(PY2ENT:) writing outside PYJETS memory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - IF(KC1.EQ.0.OR.KC2.EQ.0) CALL PYERRM(12, - &'(PY2ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - DO 110 I=IPA,IPA+1 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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 PYERRM(2, - & '(PY2ENT:) 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 PYERRM(13, - &'(PY2ENT:) energy smaller than sum of masses') - PA=SQRT(MAX(0D0,(PECM**2-PM1**2-PM2**2)**2-(2D0*PM1*PM2)**2))/ - &(2D0*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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY2FRM -C...An interface from a two-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY2FRM(IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(2) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSE - CALL PYERRM(16,'(PY2FRM:) more than one fermion') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSE - CALL PYERRM(16,'(PY2FRM:) more than one antifermion') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I1.EQ.0.OR.I2.EQ.0) THEN - CALL PYERRM(16,'(PY2FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1) THEN - CALL PYERRM(6,'(PY2FRM:) fermions arranged in wrong order') - ENDIF - -C...Check whether fermion pair is quarks or leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY2FRM:) fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Do colour joining and parton showers. - IP1=I1 - IP2=I2 - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 110 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 110 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 120 I=1,NTAU - K(INTAU(I),1)=1 - 120 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PY3ENT -C...Stores 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. - - SUBROUTINE PY3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-2) CALL PYERRM(21, - &'(PY3ENT:) writing outside PYJETS memory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - KC3=PYCOMP(KF3) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL PYERRM(12, - &'(PY3ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - PM3=0D0 - IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) - IF(MSTU(10).GE.2) PM3=PYMASS(KF3) - DO 110 I=IPA,IPA+2 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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 PYERRM(2,'(PY3ENT:) 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.5D0*X1*PECM.LE.PM1.OR.0.5D0*(2D0-X1-X3)*PECM.LE.PM2.OR. - &0.5D0*X3*PECM.LE.PM3) MKERR=1 - PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) - PA2=SQRT(MAX(1D-10,(0.5D0*(2D0-X1-X3)*PECM)**2-PM2**2)) - PA3=SQRT(MAX(1D-10,(0.5D0*X3*PECM)**2-PM3**2)) - CTHE2=(PA3**2-PA1**2-PA2**2)/(2D0*PA1*PA2) - CTHE3=(PA2**2-PA1**2-PA3**2)/(2D0*PA1*PA3) - IF(ABS(CTHE2).GE.1.001D0.OR.ABS(CTHE3).GE.1.001D0) MKERR=1 - CTHE3=MAX(-1D0,MIN(1D0,CTHE3)) - IF(MKERR.NE.0) CALL PYERRM(13, - &'(PY3ENT:) 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(1D0-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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY4ENT -C...Stores 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. - - SUBROUTINE PY4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Standard checks. - MSTU(28)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - IPA=MAX(1,IABS(IP)) - IF(IPA.GT.MSTU(4)-3) CALL PYERRM(21, - &'(PY4ENT:) writing outside PYJETS momory') - KC1=PYCOMP(KF1) - KC2=PYCOMP(KF2) - KC3=PYCOMP(KF3) - KC4=PYCOMP(KF4) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL PYERRM(12, - &'(PY4ENT:) unknown flavour code') - -C...Find masses. Reset K, P and V vectors. - PM1=0D0 - IF(MSTU(10).EQ.1) PM1=P(IPA,5) - IF(MSTU(10).GE.2) PM1=PYMASS(KF1) - PM2=0D0 - IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) - IF(MSTU(10).GE.2) PM2=PYMASS(KF2) - PM3=0D0 - IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) - IF(MSTU(10).GE.2) PM3=PYMASS(KF3) - PM4=0D0 - IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) - IF(MSTU(10).GE.2) PM4=PYMASS(KF4) - DO 110 I=IPA,IPA+3 - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 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.0D0) - & THEN - ELSE - CALL PYERRM(2,'(PY4ENT:) 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.5D0*X1*PECM.LE.PM1.OR.0.5D0*X2*PECM.LE.PM2.OR. - &0.5D0*(2D0-X1-X2-X4)*PECM.LE.PM3.OR.0.5D0*X4*PECM.LE.PM4) - &MKERR=1 - PA1=SQRT(MAX(1D-10,(0.5D0*X1*PECM)**2-PM1**2)) - PA2=SQRT(MAX(1D-10,(0.5D0*X2*PECM)**2-PM2**2)) - PA4=SQRT(MAX(1D-10,(0.5D0*X4*PECM)**2-PM4**2)) - X24=X1+X2+X4-1D0-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 - CTHE4=(X1*X4-2D0*X14)*PECM**2/(4D0*PA1*PA4) - IF(ABS(CTHE4).GE.1.002D0) MKERR=1 - CTHE4=MAX(-1D0,MIN(1D0,CTHE4)) - STHE4=SQRT(1D0-CTHE4**2) - CTHE2=(X1*X2-2D0*X12)*PECM**2/(4D0*PA1*PA2) - IF(ABS(CTHE2).GE.1.002D0) MKERR=1 - CTHE2=MAX(-1D0,MIN(1D0,CTHE2)) - STHE2=SQRT(1D0-CTHE2**2) - CPHI2=((X2*X4-2D0*X24)*PECM**2-4D0*PA2*CTHE2*PA4*CTHE4)/ - &MAX(1D-8*PECM**2,4D0*PA2*STHE2*PA4*STHE4) - IF(ABS(CPHI2).GE.1.05D0) MKERR=1 - CPHI2=MAX(-1D0,MIN(1D0,CPHI2)) - IF(MKERR.EQ.1) CALL PYERRM(13, - &'(PY4ENT:) 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(1D0-CPHI2**2)*(-1D0)**INT(PYR(0)+0.5D0) - 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 PYEXEC - - RETURN - END - -C********************************************************************* - -C...PY4FRM -C...An interface from a four-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY4FRM(ATOTSQ,A1SQ,A2SQ,ISTRAT,IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(4) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - I3=0 - I4=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSE - CALL PYERRM(16,'(PY4FRM:) more than two fermions') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4FRM:) more than two antifermions') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I3.EQ.0.OR.I4.EQ.0) THEN - CALL PYERRM(16,'(PY4FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN - CALL PYERRM(6,'(PY4FRM:) fermions arranged in wrong order') - ENDIF - -C...Check which fermion pairs are quarks and which leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY4FRM:) first fermion pair inconsistent') - ENDIF - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQL34=1 - ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN - IQL34=2 - ELSE - CALL PYERRM(16,'(PY4FRM:) second fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Decide on dipole pairing. - IP1=I1 - IP2=I2 - IP3=I3 - IP4=I4 - IF(IQL12.EQ.IQL34) THEN - R1SQ=A1SQ - R2SQ=A2SQ - DELTA=ATOTSQ-A1SQ-A2SQ - IF(ISTRAT.EQ.1) THEN - IF(DELTA.GT.0D0) R1SQ=R1SQ+DELTA - IF(DELTA.LT.0D0) R2SQ=MAX(0D0,R2SQ+DELTA) - ELSEIF(ISTRAT.EQ.2) THEN - IF(DELTA.GT.0D0) R2SQ=R2SQ+DELTA - IF(DELTA.LT.0D0) R1SQ=MAX(0D0,R1SQ+DELTA) - ENDIF - IF(R2SQ.GT.PYR(0)*(R1SQ+R2SQ)) THEN - IP2=I4 - IP4=I2 - ENDIF - ENDIF - -C...If colour reconnection then bookkeep W+W- or Z0Z0 -C...and copy q qbar q qbar consecutively. - IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN - K(N+1,1)=11 - K(N+1,3)=IP1 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,1)=11 - K(N+2,3)=IP3 - K(N+2,4)=N+5 - K(N+2,5)=N+6 - IF(K(IP1,2)+K(IP2,2).EQ.0) THEN - K(N+1,2)=23 - K(N+2,2)=23 - MINT(1)=22 - ELSEIF(PYCHGE(K(IP1,2)).GT.0) THEN - K(N+1,2)=24 - K(N+2,2)=-24 - MINT(1)=25 - ELSE - K(N+1,2)=-24 - K(N+2,2)=24 - MINT(1)=25 - ENDIF - DO 110 J=1,5 - K(N+3,J)=K(IP1,J) - K(N+4,J)=K(IP2,J) - K(N+5,J)=K(IP3,J) - K(N+6,J)=K(IP4,J) - P(N+1,J)=P(IP1,J)+P(IP2,J) - P(N+2,J)=P(IP3,J)+P(IP4,J) - P(N+3,J)=P(IP1,J) - P(N+4,J)=P(IP2,J) - P(N+5,J)=P(IP3,J) - P(N+6,J)=P(IP4,J) - V(N+1,J)=V(IP1,J) - V(N+2,J)=V(IP3,J) - V(N+3,J)=V(IP1,J) - V(N+4,J)=V(IP2,J) - V(N+5,J)=V(IP3,J) - V(N+6,J)=V(IP4,J) - 110 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+5,3)=N+2 - K(N+6,3)=N+2 -C...Remove original q qbar q qbar and update counters. - K(IP1,1)=K(IP1,1)+10 - K(IP2,1)=K(IP2,1)+10 - K(IP3,1)=K(IP3,1)+10 - K(IP4,1)=K(IP4,1)+10 - IW1=N+1 - IW2=N+2 - NSD1=N+2 - IP1=N+3 - IP2=N+4 - IP3=N+5 - IP4=N+6 - N=N+6 - ENDIF - -C...Do colour joinings and parton showers. - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - NAFT1=N - IF(IQL34.EQ.1) THEN - IJOIN(1)=IP3 - IJOIN(2)=IP4 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN - PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- - & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 - CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) - ENDIF - -C...Optionally do colour reconnection. - MINT(32)=0 - MSTI(32)=0 - IF(MSTP(115).GE.1.AND.IQL12.EQ.1.AND.IQL34.EQ.1) THEN - CALL PYRECO(IW1,IW2,NSD1,NAFT1) - MSTI(32)=MINT(32) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 120 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 120 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 130 I=1,NTAU - K(INTAU(I),1)=1 - 130 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PY4JET -C...An interface from a four-parton generator to include -C...parton showers and hadronization. - - SUBROUTINE PY4JET(PMAX,IRAD,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),PTOT(4),BETA(3) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final partons. - I1=0 - I2=0 - I3=0 - I4=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.KFA.EQ.21) THEN - IF(K(I,2).GT.0.AND.K(I,2).LE.6) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two quarks') - ENDIF - ELSEIF(K(I,2).LT.0) THEN - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two antiquarks') - ENDIF - ELSE - IF(I3.EQ.0) THEN - I3=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSE - CALL PYERRM(16,'(PY4JET:) more than two gluons') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I1.EQ.0.OR.I2.EQ.0.OR.I3.EQ.0.OR.I4.EQ.0) THEN - CALL PYERRM(16,'(PY4JET:) event contains too few partons') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3) THEN - CALL PYERRM(6,'(PY4JET:) partons arranged in wrong order') - ENDIF - -C...Check whether second pair are quarks or gluons. - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQG34=1 - ELSEIF(K(I3,2).EQ.21.AND.K(I4,2).EQ.21) THEN - IQG34=2 - ELSE - CALL PYERRM(16,'(PY4JET:) second parton pair inconsistent') - ENDIF - -C...Boost partons to their cm frame. - DO 110 J=1,4 - PTOT(J)=P(I1,J)+P(I2,J)+P(I3,J)+P(I4,J) - 110 CONTINUE - ECM=SQRT(MAX(0D0,PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2)) - DO 120 J=1,3 - BETA(J)=PTOT(J)/PTOT(4) - 120 CONTINUE - CALL PYROBO(I1,I1,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I2,I2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I3,I3,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(I4,I4,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - NSAV=N - -C...Decide and set up shower history for q qbar q' qbar' events. - IF(IQG34.EQ.1) THEN - W1=PY4JTW(0,I1,I3,I4) - W2=PY4JTW(0,I2,I3,I4) - IF(W1.GT.PYR(0)*(W1+W2)) THEN - CALL PY4JTS(0,I1,I3,I4,I2,QMAX) - ELSE - CALL PY4JTS(0,I2,I3,I4,I1,QMAX) - ENDIF - -C...Decide and set up shower history for q qbar g g events. - ELSE - W1=PY4JTW(I1,I3,I2,I4) - W2=PY4JTW(I1,I4,I2,I3) - W3=PY4JTW(0,I3,I1,I4) - W4=PY4JTW(0,I4,I1,I3) - W5=PY4JTW(0,I3,I2,I4) - W6=PY4JTW(0,I4,I2,I3) - W7=PY4JTW(0,I1,I3,I4) - W8=PY4JTW(0,I2,I3,I4) - WR=(W1+W2+W3+W4+W5+W6+W7+W8)*PYR(0) - IF(W1.GT.WR) THEN - CALL PY4JTS(I1,I3,I2,I4,0,QMAX) - ELSEIF(W1+W2.GT.WR) THEN - CALL PY4JTS(I1,I4,I2,I3,0,QMAX) - ELSEIF(W1+W2+W3.GT.WR) THEN - CALL PY4JTS(0,I3,I1,I4,I2,QMAX) - ELSEIF(W1+W2+W3+W4.GT.WR) THEN - CALL PY4JTS(0,I4,I1,I3,I2,QMAX) - ELSEIF(W1+W2+W3+W4+W5.GT.WR) THEN - CALL PY4JTS(0,I3,I2,I4,I1,QMAX) - ELSEIF(W1+W2+W3+W4+W5+W6.GT.WR) THEN - CALL PY4JTS(0,I4,I2,I3,I1,QMAX) - ELSEIF(W1+W2+W3+W4+W5+W6+W7.GT.WR) THEN - CALL PY4JTS(0,I1,I3,I4,I2,QMAX) - ELSE - CALL PY4JTS(0,I2,I3,I4,I1,QMAX) - ENDIF - ENDIF - -C...Boost back original partons and mark them as deleted. - CALL PYROBO(I1,I1,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I2,I2,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(I4,I4,0D0,0D0,BETA(1),BETA(2),BETA(3)) - K(I1,1)=K(I1,1)+10 - K(I2,1)=K(I2,1)+10 - K(I3,1)=K(I3,1)+10 - K(I4,1)=K(I4,1)+10 - -C...Rotate shower initiating partons to be along z axis. - PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) - CALL PYROBO(NSAV+1,NSAV+6,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) - CALL PYROBO(NSAV+1,NSAV+6,-THE,0D0,0D0,0D0,0D0) - -C...Set up copy of shower initiating partons as on mass shell. - DO 140 I=N+1,N+2 - DO 130 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=V(I1,J) - 130 CONTINUE - K(I,1)=1 - K(I,2)=K(I-6,2) - 140 CONTINUE - IF(K(NSAV+1,2).EQ.K(I1,2)) THEN - K(N+1,3)=I1 - P(N+1,5)=P(I1,5) - K(N+2,3)=I2 - P(N+2,5)=P(I2,5) - ELSE - K(N+1,3)=I2 - P(N+1,5)=P(I2,5) - K(N+2,3)=I1 - P(N+2,5)=P(I1,5) - ENDIF - PABS=SQRT(MAX(0D0,(ECM**2-P(N+1,5)**2-P(N+2,5)**2)**2- - &(2D0*P(N+1,5)*P(N+2,5))**2))/(2D0*ECM) - P(N+1,3)=PABS - P(N+1,4)=SQRT(PABS**2+P(N+1,5)**2) - P(N+2,3)=-PABS - P(N+2,4)=SQRT(PABS**2+P(N+2,5)**2) - N=N+2 - -C...Decide whether to allow or not photon radiation in showers. -C...Connect up colours. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - IJOIN(1)=N-1 - IJOIN(2)=N - CALL PYJOIN(2,IJOIN) - -C...Decide on maximum virtuality and do parton shower. - IF(PMAX.LT.PARJ(82)) THEN - PQMAX=QMAX - ELSE - PQMAX=PMAX - ENDIF - CALL PYSHOW(NSAV+1,-100,PQMAX) - -C...Rotate and boost back system. - CALL PYROBO(NSAV+1,N,THE,PHI,BETA(1),BETA(2),BETA(3)) - -C...Do fragmentation and decays. - CALL PYEXEC - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PY4JTS -C...Auxiliary to PY4JET, to set up chosen configuration. - - SUBROUTINE PY4JTS(IA1,IA2,IA3,IA4,IA5,QMAX) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - SAVE /PYJETS/ - -C...Reset info. - DO 110 I=N+1,N+6 - DO 100 J=1,5 - K(I,J)=0 - V(I,J)=V(IA2,J) - 100 CONTINUE - K(I,1)=16 - 110 CONTINUE - -C...First case: when both original partons radiate. -C...N+1 -> (IA1=N+3) + (IA2=N+4), N+2 -> (IA3=N+5) + (IA4=N+6). - IF(IA1.NE.0) THEN - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA1,2) - K(N+2,2)=K(IA3,2) - K(N+3,2)=K(IA1,2) - K(N+4,2)=K(IA2,2) - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA1 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA3 - K(N+2,4)=N+5 - K(N+2,5)=N+6 - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+5,3)=N+2 - K(N+6,3)=N+2 - -C...Set up momenta for new partons. - DO 120 J=1,5 - P(N+1,J)=P(IA1,J)+P(IA2,J) - P(N+2,J)=P(IA3,J)+P(IA4,J) - P(N+3,J)=P(IA1,J) - P(N+4,J)=P(IA2,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 120 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - QMAX=MIN(P(N+1,5),P(N+2,5)) - -C...Second case: q radiates twice. -C...N+1 -> (IA2=N+4) + N+3, N+3 -> (IA3=N+5) + (IA4=N+6), -C...IA5=N+2 does not radiate. - ELSEIF(K(IA2,2).EQ.21) THEN - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA3,2) - K(N+2,2)=K(IA5,2) - K(N+3,2)=K(IA3,2) - K(N+4,2)=K(IA2,2) - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA3 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA5 - K(N+3,3)=N+1 - K(N+3,4)=N+5 - K(N+3,5)=N+6 - K(N+4,3)=N+1 - K(N+5,3)=N+3 - K(N+6,3)=N+3 - -C...Set up momenta for new partons. - DO 130 J=1,5 - P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) - P(N+2,J)=P(IA5,J) - P(N+3,J)=P(IA3,J)+P(IA4,J) - P(N+4,J)=P(IA2,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 130 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+3,5)=SQRT(MAX(0D0,P(N+3,4)**2-P(N+3,1)**2-P(N+3,2)**2- - & P(N+3,3)**2)) - QMAX=P(N+3,5) - -C...Third case: q radiates g, g branches. -C...N+1 -> (IA2=N+3) + N+4, N+4 -> (IA3=N+5) + (IA4=N+6), -C...IA5=N+2 does not radiate. - ELSE - -C...Set up flavour and history pointers for new partons. - K(N+1,2)=K(IA2,2) - K(N+2,2)=K(IA5,2) - K(N+3,2)=K(IA2,2) - K(N+4,2)=21 - K(N+5,2)=K(IA3,2) - K(N+6,2)=K(IA4,2) - K(N+1,3)=IA2 - K(N+1,4)=N+3 - K(N+1,5)=N+4 - K(N+2,3)=IA5 - K(N+3,3)=N+1 - K(N+4,3)=N+1 - K(N+4,4)=N+5 - K(N+4,5)=N+6 - K(N+5,3)=N+4 - K(N+6,3)=N+4 - -C...Set up momenta for new partons. - DO 140 J=1,5 - P(N+1,J)=P(IA2,J)+P(IA3,J)+P(IA4,J) - P(N+2,J)=P(IA5,J) - P(N+3,J)=P(IA2,J) - P(N+4,J)=P(IA3,J)+P(IA4,J) - P(N+5,J)=P(IA3,J) - P(N+6,J)=P(IA4,J) - 140 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+4,5)=SQRT(MAX(0D0,P(N+4,4)**2-P(N+4,1)**2-P(N+4,2)**2- - & P(N+4,3)**2)) - QMAX=P(N+4,5) - - ENDIF - N=N+6 - - RETURN - END - -C********************************************************************* - -C...PY4JTW -C...Auxiliary to PY4JET, to evaluate weight of configuration. - - FUNCTION PY4JTW(IA1,IA2,IA3,IA4) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - SAVE /PYJETS/ - -C...First case: when both original partons radiate. -C...IA1 /= 0: N+1 -> IA1 + IA2, N+2 -> IA3 + IA4. - IF(IA1.NE.0) THEN - DO 100 J=1,4 - P(N+1,J)=P(IA1,J)+P(IA2,J) - P(N+2,J)=P(IA3,J)+P(IA4,J) - 100 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - Z1=P(IA1,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2-P(IA1,5)**2) - Z2=P(IA3,4)/P(N+2,4) - WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2-P(IA3,5)**2) - -C...Second case: when one original parton radiates to three. -C...IA1 = 0: N+1 -> IA2 + N+2, N+2 -> IA3 + IA4. - ELSE - DO 110 J=1,4 - P(N+2,J)=P(IA3,J)+P(IA4,J) - P(N+1,J)=P(N+2,J)+P(IA2,J) - 110 CONTINUE - P(N+1,5)=SQRT(MAX(0D0,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- - & P(N+1,3)**2)) - P(N+2,5)=SQRT(MAX(0D0,P(N+2,4)**2-P(N+2,1)**2-P(N+2,2)**2- - & P(N+2,3)**2)) - IF(K(IA2,2).EQ.21) THEN - Z1=P(N+2,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- - & P(IA3,5)**2) - ELSE - Z1=P(IA2,4)/P(N+1,4) - WT1=(4D0/3D0)*((1D0+Z1**2)/(1D0-Z1))/(P(N+1,5)**2- - & P(IA2,5)**2) - ENDIF - Z2=P(IA3,4)/P(N+2,4) - IF(K(IA2,2).EQ.21) THEN - WT2=(4D0/3D0)*((1D0+Z2**2)/(1D0-Z2))/(P(N+2,5)**2- - & P(IA3,5)**2) - ELSEIF(K(IA3,2).EQ.21) THEN - WT2=3D0*((1D0-Z2*(1D0-Z2))**2/(Z2*(1D0-Z2)))/P(N+2,5)**2 - ELSE - WT2=0.5D0*(Z2**2+(1D0-Z2)**2) - ENDIF - ENDIF - -C...Total weight. - PY4JTW=WT1*WT2 - - RETURN - END - -C********************************************************************* - -C...PY6FRM -C...An interface from a six-fermion generator to include -C...parton showers and hadronization. - - SUBROUTINE PY6FRM(P12,P13,P21,P23,P31,P32,PTOP,IRAD,ITAU,ICOM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION IJOIN(2),INTAU(6),BETA(3),BETAO(3),BETAN(3) - -C...Call PYHEPC to convert input from HEPEVT to PYJETS common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(2) - ENDIF - -C...Loop through entries and pick up all final fermions/antifermions. - I1=0 - I2=0 - I3=0 - I4=0 - I5=0 - I6=0 - DO 100 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 - KFA=IABS(K(I,2)) - IF((KFA.GE.1.AND.KFA.LE.6).OR.(KFA.GE.11.AND.KFA.LE.16)) THEN - IF(K(I,2).GT.0) THEN - IF(I1.EQ.0) THEN - I1=I - ELSEIF(I3.EQ.0) THEN - I3=I - ELSEIF(I5.EQ.0) THEN - I5=I - ELSE - CALL PYERRM(16,'(PY6FRM:) more than three fermions') - ENDIF - ELSE - IF(I2.EQ.0) THEN - I2=I - ELSEIF(I4.EQ.0) THEN - I4=I - ELSEIF(I6.EQ.0) THEN - I6=I - ELSE - CALL PYERRM(16,'(PY6FRM:) more than three antifermions') - ENDIF - ENDIF - ENDIF - 100 CONTINUE - -C...Check that event is arranged according to conventions. - IF(I5.EQ.0.OR.I6.EQ.0) THEN - CALL PYERRM(16,'(PY6FRM:) event contains too few fermions') - ENDIF - IF(I2.LT.I1.OR.I3.LT.I2.OR.I4.LT.I3.OR.I5.LT.I4.OR.I6.LT.I5) THEN - CALL PYERRM(6,'(PY6FRM:) fermions arranged in wrong order') - ENDIF - -C...Check which fermion pairs are quarks and which leptons. - IF(IABS(K(I1,2)).LT.10.AND.IABS(K(I2,2)).LT.10) THEN - IQL12=1 - ELSEIF(IABS(K(I1,2)).GT.10.AND.IABS(K(I2,2)).GT.10) THEN - IQL12=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) first fermion pair inconsistent') - ENDIF - IF(IABS(K(I3,2)).LT.10.AND.IABS(K(I4,2)).LT.10) THEN - IQL34=1 - ELSEIF(IABS(K(I3,2)).GT.10.AND.IABS(K(I4,2)).GT.10) THEN - IQL34=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) second fermion pair inconsistent') - ENDIF - IF(IABS(K(I5,2)).LT.10.AND.IABS(K(I6,2)).LT.10) THEN - IQL56=1 - ELSEIF(IABS(K(I5,2)).GT.10.AND.IABS(K(I6,2)).GT.10) THEN - IQL56=2 - ELSE - CALL PYERRM(16,'(PY6FRM:) third fermion pair inconsistent') - ENDIF - -C...Decide whether to allow or not photon radiation in showers. - MSTJ(41)=2 - IF(IRAD.EQ.0) MSTJ(41)=1 - -C...Allow dipole pairings only among leptons and quarks separately. - P12D=P12 - P13D=0D0 - IF(IQL34.EQ.IQL56) P13D=P13 - P21D=0D0 - IF(IQL12.EQ.IQL34) P21D=P21 - P23D=0D0 - IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P23D=P23 - P31D=0D0 - IF(IQL12.EQ.IQL34.AND.IQL12.EQ.IQL56) P31D=P31 - P32D=0D0 - IF(IQL12.EQ.IQL56) P32D=P32 - -C...Decide whether t+tbar. - ITOP=0 - IF(PYR(0).LT.PTOP) THEN - ITOP=1 - -C...If t+tbar: reconstruct t's. - IT=N+1 - ITB=N+2 - DO 110 J=1,5 - K(IT,J)=0 - K(ITB,J)=0 - P(IT,J)=P(I1,J)+P(I3,J)+P(I4,J) - P(ITB,J)=P(I2,J)+P(I5,J)+P(I6,J) - V(IT,J)=0D0 - V(ITB,J)=0D0 - 110 CONTINUE - K(IT,1)=1 - K(ITB,1)=1 - K(IT,2)=6 - K(ITB,2)=-6 - P(IT,5)=SQRT(MAX(0D0,P(IT,4)**2-P(IT,1)**2-P(IT,2)**2- - & P(IT,3)**2)) - P(ITB,5)=SQRT(MAX(0D0,P(ITB,4)**2-P(ITB,1)**2-P(ITB,2)**2- - & P(ITB,3)**2)) - N=N+2 - -C...If t+tbar: colour join t's and let them shower. - IJOIN(1)=IT - IJOIN(2)=ITB - CALL PYJOIN(2,IJOIN) - PMTTS=(P(IT,4)+P(ITB,4))**2-(P(IT,1)+P(ITB,1))**2- - & (P(IT,2)+P(ITB,2))**2-(P(IT,3)+P(ITB,3))**2 - CALL PYSHOW(IT,ITB,SQRT(MAX(0D0,PMTTS))) - -C...If t+tbar: pick up the t's after shower. - ITNEW=IT - ITBNEW=ITB - DO 120 I=ITB+1,N - IF(K(I,2).EQ.6) ITNEW=I - IF(K(I,2).EQ.-6) ITBNEW=I - 120 CONTINUE - -C...If t+tbar: loop over two top systems. - DO 200 IT1=1,2 - IF(IT1.EQ.1) THEN - ITO=IT - ITN=ITNEW - IBO=I1 - IW1=I3 - IW2=I4 - ELSE - ITO=ITB - ITN=ITBNEW - IBO=I2 - IW1=I5 - IW2=I6 - ENDIF - IF(IABS(K(IBO,2)).NE.5) CALL PYERRM(6, - & '(PY6FRM:) not b in t decay') - -C...If t+tbar: find boost from original to new top frame. - DO 130 J=1,3 - BETAO(J)=P(ITO,J)/P(ITO,4) - BETAN(J)=P(ITN,J)/P(ITN,4) - 130 CONTINUE - -C...If t+tbar: boost copy of b by t shower and connect it in colour. - N=N+1 - IB=N - K(IB,1)=3 - K(IB,2)=K(IBO,2) - K(IB,3)=ITN - DO 140 J=1,5 - P(IB,J)=P(IBO,J) - V(IB,J)=0D0 - 140 CONTINUE - CALL PYROBO(IB,IB,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(IB,IB,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - K(IB,4)=MSTU(5)*ITN - K(IB,5)=MSTU(5)*ITN - K(ITN,4)=K(ITN,4)+IB - K(ITN,5)=K(ITN,5)+IB - K(ITN,1)=K(ITN,1)+10 - K(IBO,1)=K(IBO,1)+10 - -C...If t+tbar: construct W recoiling against b. - N=N+1 - IW=N - DO 150 J=1,5 - K(IW,J)=0 - V(IW,J)=0D0 - 150 CONTINUE - K(IW,1)=1 - KCHW=PYCHGE(K(IW1,2))+PYCHGE(K(IW2,2)) - IF(IABS(KCHW).EQ.3) THEN - K(IW,2)=ISIGN(24,KCHW) - ELSE - CALL PYERRM(16,'(PY6FRM:) fermion pair inconsistent with W') - ENDIF - K(IW,3)=IW1 - -C...If t+tbar: construct W momentum, including boost by t shower. - DO 160 J=1,4 - P(IW,J)=P(IW1,J)+P(IW2,J) - 160 CONTINUE - P(IW,5)=SQRT(MAX(0D0,P(IW,4)**2-P(IW,1)**2-P(IW,2)**2- - & P(IW,3)**2)) - CALL PYROBO(IW,IW,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(IW,IW,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - -C...If t+tbar: boost b and W to top rest frame. - DO 170 J=1,3 - BETA(J)=(P(IB,J)+P(IW,J))/(P(IB,4)+P(IW,4)) - 170 CONTINUE - CALL PYROBO(IB,IB,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(IW,IW,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - -C...If t+tbar: let b shower and pick up modified W. - PMTS=(P(IB,4)+P(IW,4))**2-(P(IB,1)+P(IW,1))**2- - & (P(IB,2)+P(IW,2))**2-(P(IB,3)+P(IW,3))**2 - CALL PYSHOW(IB,IW,SQRT(MAX(0D0,PMTS))) - DO 180 I=IW,N - IF(IABS(K(I,2)).EQ.24) IWM=I - 180 CONTINUE - -C...If t+tbar: take copy of W decay products. - DO 190 J=1,5 - K(N+1,J)=K(IW1,J) - P(N+1,J)=P(IW1,J) - V(N+1,J)=V(IW1,J) - K(N+2,J)=K(IW2,J) - P(N+2,J)=P(IW2,J) - V(N+2,J)=V(IW2,J) - 190 CONTINUE - K(IW1,1)=K(IW1,1)+10 - K(IW2,1)=K(IW2,1)+10 - K(IWM,1)=K(IWM,1)+10 - K(IWM,4)=N+1 - K(IWM,5)=N+2 - K(N+1,3)=IWM - K(N+2,3)=IWM - IF(IT1.EQ.1) THEN - I3=N+1 - I4=N+2 - ELSE - I5=N+1 - I6=N+2 - ENDIF - N=N+2 - -C...If t+tbar: boost W decay products, first by effects of t shower, -C...then by those of b shower. b and its shower simple boost back. - CALL PYROBO(N-1,N,0D0,0D0,-BETAO(1),-BETAO(2),-BETAO(3)) - CALL PYROBO(N-1,N,0D0,0D0,BETAN(1),BETAN(2),BETAN(3)) - CALL PYROBO(N-1,N,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - CALL PYROBO(N-1,N,0D0,0D0,-P(IW,1)/P(IW,4), - & -P(IW,2)/P(IW,4),-P(IW,3)/P(IW,4)) - CALL PYROBO(N-1,N,0D0,0D0,P(IWM,1)/P(IWM,4), - & P(IWM,2)/P(IWM,4),P(IWM,3)/P(IWM,4)) - CALL PYROBO(IB,IB,0D0,0D0,BETA(1),BETA(2),BETA(3)) - CALL PYROBO(IW,N,0D0,0D0,BETA(1),BETA(2),BETA(3)) - 200 CONTINUE - ENDIF - -C...Decide on dipole pairing. - IP1=I1 - IP3=I3 - IP5=I5 - PRN=PYR(0)*(P12D+P13D+P21D+P23D+P31D+P32D) - IF(ITOP.EQ.1.OR.PRN.LT.P12D) THEN - IP2=I2 - IP4=I4 - IP6=I6 - ELSEIF(PRN.LT.P12D+P13D) THEN - IP2=I2 - IP4=I6 - IP6=I4 - ELSEIF(PRN.LT.P12D+P13D+P21D) THEN - IP2=I4 - IP4=I2 - IP6=I6 - ELSEIF(PRN.LT.P12D+P13D+P21D+P23D) THEN - IP2=I4 - IP4=I6 - IP6=I2 - ELSEIF(PRN.LT.P12D+P13D+P21D+P23D+P31D) THEN - IP2=I6 - IP4=I2 - IP6=I4 - ELSE - IP2=I6 - IP4=I4 - IP6=I2 - ENDIF - -C...Do colour joinings and parton showers -C...(except ones already made for t+tbar). - IF(ITOP.EQ.0) THEN - IF(IQL12.EQ.1) THEN - IJOIN(1)=IP1 - IJOIN(2)=IP2 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL12.EQ.1.OR.IRAD.EQ.1) THEN - PM12S=(P(IP1,4)+P(IP2,4))**2-(P(IP1,1)+P(IP2,1))**2- - & (P(IP1,2)+P(IP2,2))**2-(P(IP1,3)+P(IP2,3))**2 - CALL PYSHOW(IP1,IP2,SQRT(MAX(0D0,PM12S))) - ENDIF - ENDIF - IF(IQL34.EQ.1) THEN - IJOIN(1)=IP3 - IJOIN(2)=IP4 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL34.EQ.1.OR.IRAD.EQ.1) THEN - PM34S=(P(IP3,4)+P(IP4,4))**2-(P(IP3,1)+P(IP4,1))**2- - & (P(IP3,2)+P(IP4,2))**2-(P(IP3,3)+P(IP4,3))**2 - CALL PYSHOW(IP3,IP4,SQRT(MAX(0D0,PM34S))) - ENDIF - IF(IQL56.EQ.1) THEN - IJOIN(1)=IP5 - IJOIN(2)=IP6 - CALL PYJOIN(2,IJOIN) - ENDIF - IF(IQL56.EQ.1.OR.IRAD.EQ.1) THEN - PM56S=(P(IP5,4)+P(IP6,4))**2-(P(IP5,1)+P(IP6,1))**2- - & (P(IP5,2)+P(IP6,2))**2-(P(IP5,3)+P(IP6,3))**2 - CALL PYSHOW(IP5,IP6,SQRT(MAX(0D0,PM56S))) - ENDIF - -C...Do fragmentation and decays. Possibly except tau decay. - IF(ITAU.EQ.0) THEN - NTAU=0 - DO 210 I=1,N - IF(IABS(K(I,2)).EQ.15.AND.K(I,1).EQ.1) THEN - NTAU=NTAU+1 - INTAU(NTAU)=I - K(I,1)=11 - ENDIF - 210 CONTINUE - ENDIF - CALL PYEXEC - IF(ITAU.EQ.0) THEN - DO 220 I=1,NTAU - K(INTAU(I),1)=1 - 220 CONTINUE - ENDIF - -C...Call PYHEPC to convert output from PYJETS to HEPEVT common. - IF(ICOM.EQ.0) THEN - MSTU(28)=0 - CALL PYHEPC(1) - ENDIF - - END - -C********************************************************************* - -C...PYADSH -C...Administers the generation of successive final-state showers -C...in external processes. - - SUBROUTINE PYADSH(NFIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ -C...Local array. - DIMENSION IBEG(100),KSAV(100,5),PSUM(4),BETA(3) - -C...Set primary vertex. - DO 100 J=1,5 - V(MINT(83)+5,J)=0D0 - V(MINT(83)+6,J)=0D0 - V(MINT(84)+1,J)=0D0 - V(MINT(84)+2,J)=0D0 - 100 CONTINUE - -C...Isolate systems of particles with the same mother. - NSYS=0 - IMS=-1 - DO 140 I=MINT(84)+3,NFIN - IM=K(I,3) - IF(IM.GT.0.AND.IM.LE.MINT(84)) IM=K(IM,3) - IF(IM.NE.IMS) THEN - NSYS=NSYS+1 - IBEG(NSYS)=I - IMS=IM - ENDIF - -C...Set production vertices. - IF(IM.LE.MINT(83)+6.OR.(IM.GT.MINT(84).AND.IM.LE.MINT(84)+2)) - & THEN - DO 110 J=1,4 - V(I,J)=0D0 - 110 CONTINUE - ELSE - DO 120 J=1,4 - V(I,J)=V(IM,J)+V(IM,5)*P(IM,J)/P(IM,5) - 120 CONTINUE - ENDIF - IF(MSTP(125).GE.1) THEN - IDOC=I-MSTP(126)+4 - DO 130 J=1,5 - V(IDOC,J)=V(I,J) - 130 CONTINUE - ENDIF - 140 CONTINUE - -C...End loop over systems. Return if no showers to be performed. - IBEG(NSYS+1)=NFIN+1 - IF(MSTP(71).LE.0) RETURN - -C...Loop through systems of particles; check that sensible size. - DO 260 ISYS=1,NSYS - NSIZ=IBEG(ISYS+1)-IBEG(ISYS) - IF(NSIZ.EQ.1.AND.ISYS.EQ.1) THEN - ELSEIF(NSIZ.LE.1) THEN - CALL PYERRM(2,'(PYADSH:) only one particle in system') - ELSEIF(NSIZ.GT.80) THEN - CALL PYERRM(2,'(PYADSH:) more than 80 particles in system') - ELSE - -C...Save status codes and daughters of showering pair; reset them. - DO 150 J=1,4 - PSUM(J)=0D0 - 150 CONTINUE - DO 170 II=1,NSIZ - I=IBEG(ISYS)-1+II - KSAV(II,1)=K(I,1) - IF(K(I,1).GT.10) THEN - K(I,1)=1 - IF(KSAV(II,1).EQ.14) K(I,1)=3 - ENDIF - IF(KSAV(II,1).LE.10) THEN - ELSEIF(K(I,1).EQ.1) THEN - KSAV(II,4)=K(I,4) - KSAV(II,5)=K(I,5) - K(I,4)=0 - K(I,5)=0 - ELSE - KSAV(II,4)=MOD(K(I,4),MSTU(5)) - KSAV(II,5)=MOD(K(I,5),MSTU(5)) - K(I,4)=K(I,4)-KSAV(II,4) - K(I,5)=K(I,5)-KSAV(II,5) - ENDIF - DO 160 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 160 CONTINUE - 170 CONTINUE - -C...Perform shower. - QMAX=SQRT(MAX(0D0,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2- - & PSUM(3)**2)) - IF(ISYS.EQ.1) QMAX=MIN(QMAX,SQRT(PARP(71))*VINT(55)) - NSAV=N - IF(NSIZ.EQ.2) THEN - CALL PYSHOW(IBEG(ISYS),IBEG(ISYS)+1,QMAX) - ELSE - CALL PYSHOW(IBEG(ISYS),-NSIZ,QMAX) - ENDIF - -C...Look up showered copies of original showering particles. - DO 250 II=1,NSIZ - I=IBEG(ISYS)-1+II - IMV=I - IF(N.EQ.NSAV.OR.K(I,1).LE.10) THEN - ELSEIF(K(I,1).EQ.11) THEN - 180 IMV=MOD(K(IMV,4),MSTU(5)) - IF(K(IMV,1).EQ.11) GOTO 180 - ELSE - KDA1=MOD(K(I,4),MSTU(5)) - KDA2=MOD(K(I,5),MSTU(5)) - DO 190 I3=I+1,N - IF(K(I3,2).EQ.K(I,2).AND.(I3.EQ.KDA1.OR.I3.EQ.KDA2)) - & THEN - IMV=I3 - KDA1=MOD(K(I3,4),MSTU(5)) - KDA2=MOD(K(I3,5),MSTU(5)) - ENDIF - 190 CONTINUE - ENDIF - -C...Restore daughter info of original partons to showered copies. - IF(KSAV(II,1).GT.10) K(IMV,1)=KSAV(II,1) - IF(KSAV(II,1).LE.10) THEN - ELSEIF(K(I,1).EQ.1) THEN - K(IMV,4)=KSAV(II,4) - K(IMV,5)=KSAV(II,5) - ELSE - K(IMV,4)=K(IMV,4)+KSAV(II,4) - K(IMV,5)=K(IMV,5)+KSAV(II,5) - ENDIF - -C...Reset mother info of existing daughters to showered copies. - DO 200 I3=IBEG(ISYS+1),NFIN - IF(K(I3,3).EQ.I) K(I3,3)=IMV - IF(K(I3,1).EQ.3.OR.K(I3,1).EQ.14) THEN - IF(K(I3,4)/MSTU(5).EQ.I) K(I3,4)=K(I3,4)+MSTU(5)*(IMV-I) - IF(K(I3,5)/MSTU(5).EQ.I) K(I3,5)=K(I3,5)+MSTU(5)*(IMV-I) - ENDIF - 200 CONTINUE - -C...Boost all original daughters to new frame of showered copy. - IF(IMV.NE.I) THEN - DO 210 J=1,3 - BETA(J)=(P(IMV,J)-P(I,J))/(P(IMV,4)+P(I,4)) - 210 CONTINUE - FAC=2D0/(1D0+BETA(1)**2+BETA(2)**2+BETA(3)**2) - DO 220 J=1,3 - BETA(J)=FAC*BETA(J) - 220 CONTINUE - DO 240 I3=IBEG(ISYS+1),NFIN - IMO=I3 - 230 IMO=K(IMO,3) - IF(MSTP(128).LE.0) THEN - IF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) GOTO 230 - IF(IMO.EQ.I.OR.(K(I,3).LE.MINT(84).AND.IMO.EQ.K(I,3))) - & CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - ELSE - IF(IMO.EQ.IMV) THEN - CALL PYROBO(I3,I3,0D0,0D0,BETA(1),BETA(2),BETA(3)) - ELSEIF(IMO.GT.0.AND.IMO.NE.I.AND.IMO.NE.K(I,3)) THEN - GOTO 230 - ENDIF - ENDIF - 240 CONTINUE - ENDIF - 250 CONTINUE - -C...End of loop over showering systems - ENDIF - 260 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYALEM -C...Calculates the running alpha_electromagnetic. - - FUNCTION PYALEM(Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -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)/(3D0*PARU(1)) - IF(MSTU(101).LE.0.OR.Q2.LT.2D-6) THEN - RPIGG=0D0 - ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN - RPIGG=0D0 - ELSEIF(MSTU(101).EQ.2) THEN - RPIGG=1D0-PARU(101)/PARU(103) - ELSEIF(Q2.LT.0.09D0) THEN - RPIGG=AEMPI*(13.4916D0+LOG(Q2))+0.00835D0*LOG(1D0+Q2) - ELSEIF(Q2.LT.9D0) THEN - RPIGG=AEMPI*(16.3200D0+2D0*LOG(Q2))+ - & 0.00238D0*LOG(1D0+3.927D0*Q2) - ELSEIF(Q2.LT.1D4) THEN - RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00165D0+ - & 0.00299D0*LOG(1D0+Q2) - ELSE - RPIGG=AEMPI*(13.4955D0+3D0*LOG(Q2))+0.00221D0+ - & 0.00293D0*LOG(1D0+Q2) - ENDIF - -C...Calculate running alpha_em. - PYALEM=PARU(101)/(1D0-RPIGG) - PARU(108)=PYALEM - - RETURN - END - -C********************************************************************* - -C...PYALPS -C...Gives the value of alpha_strong. - - FUNCTION PYALPS(Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Constant alpha_strong trivial. Pick artificial Lambda. - IF(MSTU(111).LE.0) THEN - PYALPS=PARU(111) - MSTU(118)=MSTU(112) - PARU(117)=0.2D0 - IF(Q2.GT.0.04D0) PARU(117)=SQRT(Q2)*EXP(-6D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))) - 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)**(2D0/(33D0-2D0*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)**(2D0/(33D0-2D0*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=(33D0-2D0*NF)/6D0 - ALGQ=LOG(MAX(1.0001D0,Q2EFF/ALAM2)) - IF(MSTU(111).EQ.1) THEN - PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) - ELSE - B1=(153D0-19D0*NF)/6D0 - PYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1D0-B1*LOG(ALGQ)/ - & (B0**2*ALGQ))) - ENDIF - MSTU(118)=NF - PARU(118)=PYALPS - - RETURN - END - -C********************************************************************* - -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) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - 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=PARU(1)-PYANGL - ELSEIF(X.LT.0D0) THEN - PYANGL=-PARU(1)-PYANGL - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYAPPS -C...Uses approximate analytical formulae to determine the full set of -C...MSSM parameters from SUGRA input. -C...See M. Drees and S.P. Martin, hep-ph/9504124 - - SUBROUTINE PYAPPS - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/ - - IMSS(5)=0 - IMSS(8)=0 - XMT=PMAS(6,1) - XMZ2=PMAS(23,1)**2 - XMW2=PMAS(24,1)**2 - TANB=RMSS(5) - BETA=ATAN(TANB) - XW=PARU(102) - XMG=RMSS(1) - XMG2=XMG*XMG - XM0=RMSS(8) - XM02=XM0*XM0 - AT=-RMSS(16) - RMSS(15)=AT - RMSS(17)=AT - SINB=TANB/SQRT(TANB**2+1D0) - COSB=SINB/TANB - - DTERM=XMZ2*COS(2D0*BETA) - XMER=SQRT(XM02+0.15D0*XMG2-XW*DTERM) - XMEL=SQRT(XM02+0.52D0*XMG2-(0.5D0-XW)*DTERM) - RMSS(6)=XMEL - RMSS(7)=XMER - XMUR=SQRT(PYRNMQ(2,2D0/3D0*XW*DTERM)) - XMDR=SQRT(PYRNMQ(3,-1D0/3D0*XW*DTERM)) - XMUL=SQRT(PYRNMQ(1,(0.5D0-2D0/3D0*XW)*DTERM)) - XMDL=SQRT(PYRNMQ(1,-(0.5D0-1D0/3D0*XW)*DTERM)) - DO 100 I=1,5,2 - PMAS(PYCOMP(KSUSY1+I),1)=XMDL - PMAS(PYCOMP(KSUSY2+I),1)=XMDR - PMAS(PYCOMP(KSUSY1+I+1),1)=XMUL - PMAS(PYCOMP(KSUSY2+I+1),1)=XMUR - 100 CONTINUE - XARG=XMEL**2-XMW2*ABS(COS(2D0*BETA)) - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - XARG=SQRT(XARG) - ENDIF - DO 110 I=11,15,2 - PMAS(PYCOMP(KSUSY1+I),1)=XMEL - PMAS(PYCOMP(KSUSY2+I),1)=XMER - PMAS(PYCOMP(KSUSY1+I+1),1)=XARG - PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 - 110 CONTINUE - RMT=PYMRUN(6,PMAS(6,1)**2) - XTOP=(RMT/150D0/SINB)**2*(.9D0*XM02+2.1D0*XMG2+ - &(1D0-(RMT/190D0/SINB)**3)*(.24D0*AT**2+AT*XMG)) - RMB=PYMRUN(5,PMAS(6,1)**2) - XBOT=(RMB/150D0/COSB)**2*(.9D0*XM02+2.1D0*XMG2+ - &(1D0-(RMB/190D0/COSB)**3)*(.24D0*AT**2+AT*XMG)) - XTAU=1D-4/COSB**2*(XM02+0.15D0*XMG2+AT**2/3D0) - ATP=AT*(1D0-(RMT/190D0/SINB)**2)+XMG*(3.47D0-1.9D0*(RMT/190D0/ - &SINB)**2) - RMSS(16)=-ATP - XMU2=-.5D0*XMZ2+(SINB**2*(XM02+.52D0*XMG2-XTOP)- - &COSB**2*(XM02+.52D0*XMG2-XBOT-XTAU/3D0))/(COSB**2-SINB**2) - XMA2=2D0*(XM02+.52D0*XMG2+XMU2)-XTOP-XBOT-XTAU/3D0 - XMU=SIGN(SQRT(XMU2),RMSS(4)) - RMSS(4)=XMU - IF(XMA2.GT.0D0) THEN - RMSS(19)=SQRT(XMA2) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: PSEUDOSCALAR MASS**2 < 0 ' - STOP - ENDIF - ARG=XM02+0.15D0*XMG2-2D0*XTAU/3D0-XW*DTERM - IF(ARG.GT.0D0) THEN - RMSS(14)=SQRT(ARG) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: RIGHT STAU MASS**2 < 0 ' - STOP - ENDIF - ARG=XM02+0.52D0*XMG2-XTAU/3D0-(0.5D0-XW)*DTERM - IF(ARG.GT.0D0) THEN - RMSS(13)=SQRT(ARG) - ELSE - WRITE(MSTU(11),*) ' PYAPPS:: LEFT STAU MASS**2 < 0 ' - STOP - ENDIF - ARG=PYRNMQ(1,-(XBOT+XTOP)/3D0) - IF(ARG.GT.0D0) THEN - RMSS(10)=SQRT(ARG) - ELSE - RMSS(10)=-SQRT(-ARG) - ENDIF - ARG=PYRNMQ(2,-2D0*XTOP/3D0) - IF(ARG.GT.0D0) THEN - RMSS(12)=SQRT(ARG) - ELSE - RMSS(12)=-SQRT(-ARG) - ENDIF - ARG=PYRNMQ(3,-2D0*XBOT/3D0) - IF(ARG.GT.0D0) THEN - RMSS(11)=SQRT(ARG) - ELSE - RMSS(11)=-SQRT(-ARG) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYBESQ -C...Calculates the momentum shift in a system of two particles assuming -C...the relative momentum squared should be shifted to Q2NEW. NI is the -C...last position occupied in /PYJETS/. - - SUBROUTINE PYBESQ(I1,I2,NI,Q2OLD,Q2NEW) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) -C SAVE /PYJETS/,/PYDAT1/ -C...Local arrays and data. - DIMENSION DP(5) - SAVE HC1 - - IF(MSTJ(55).EQ.0) THEN - DQ2=Q2NEW-Q2OLD - DP2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ - & (P(I1,3)-P(I2,3))**2 - DP12=P(I1,1)**2+P(I1,2)**2+P(I1,3)**2 - & -P(I2,1)**2-P(I2,2)**2-P(I2,3)**2 - SE=P(I1,4)+P(I2,4) - DE=P(I1,4)-P(I2,4) - DQ2SE=DQ2+SE**2 - DA=SE*DE*DP12-DP2*DQ2SE - DB=DP2*DQ2SE-DP12**2 - HA=(DA+SQRT(MAX(DA**2+DQ2*(DQ2+SE**2-DE**2)*DB,0D0)))/(2D0*DB) - DO 100 J=1,3 - PD=HA*(P(I1,J)-P(I2,J)) - P(NI+1,J)=PD - P(NI+2,J)=-PD - 100 CONTINUE - RETURN - ENDIF - - K(NI+1,1)=1 - K(NI+2,1)=1 - DO 110 J=1,5 - P(NI+1,J)=P(I1,J) - P(NI+2,J)=P(I2,J) - DP(J)=P(I1,J)+P(I2,J) - 110 CONTINUE - -C...Boost to cms and rotate first particle to z-axis - CALL PYROBO(NI+1,NI+2,0.0D0,0.0D0, - &-DP(1)/DP(4),-DP(2)/DP(4),-DP(3)/DP(4)) - PHI=PYANGL(P(NI+1,1),P(NI+1,2)) - THE=PYANGL(P(NI+1,3),SQRT(P(NI+1,1)**2+P(NI+1,2)**2)) - S=Q2NEW+(P(I1,5)+P(I2,5))**2 - PZ=0.5D0*SQRT(Q2NEW*(S-(P(I1,5)-P(I2,5))**2)/S) - P(NI+1,1)=0.0D0 - P(NI+1,2)=0.0D0 - P(NI+1,3)=PZ - P(NI+1,4)=SQRT(PZ**2+P(I1,5)**2) - P(NI+2,1)=0.0D0 - P(NI+2,2)=0.0D0 - P(NI+2,3)=-PZ - P(NI+2,4)=SQRT(PZ**2+P(I2,5)**2) - DP(4)=SQRT(DP(1)**2+DP(2)**2+DP(3)**2+S) - CALL PYROBO(NI+1,NI+2,THE,PHI, - &DP(1)/DP(4),DP(2)/DP(4),DP(3)/DP(4)) - - DO 120 J=1,3 - P(NI+1,J)=P(NI+1,J)-P(I1,J) - P(NI+2,J)=P(NI+2,J)-P(I2,J) - 120 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYBKSB -C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 -C...processes. - - SUBROUTINE PYBKSB(A,N,NP,INDX,B) - IMPLICIT NONE - INTEGER N,NP,INDX(N) - COMPLEX*16 A(NP,NP),B(N) - INTEGER I,II,J,LL - COMPLEX*16 SUM - - II=0 - DO 110 I=1,N - LL=INDX(I) - SUM=B(LL) - B(LL)=B(I) - IF (II.NE.0)THEN - DO 100 J=II,I-1 - SUM=SUM-A(I,J)*B(J) - 100 CONTINUE - ELSE IF (ABS(SUM).NE.0D0) THEN - II=I - ENDIF - B(I)=SUM - 110 CONTINUE - DO 130 I=N,1,-1 - SUM=B(I) - DO 120 J=I+1,N - SUM=SUM-A(I,J)*B(J) - 120 CONTINUE - B(I)=SUM/A(I,I) - 130 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYBOEI -C...Modifies an event so as to approximately take into account -C...Bose-Einstein effects according to a simple phenomenological -C...parametrization. - - SUBROUTINE PYBOEI(NSAV) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYINT1/ -C...Local arrays and data. - DIMENSION DPS(4),KFBE(9),NBE(0:10),BEI(100),BEI3(100), - &BEIW(100),BEI3W(100) - DATA KFBE/211,-211,111,321,-321,130,310,221,331/ -C...Statement function: squared invariant mass. - SDIP(I,J)=((P(I,4)+P(J,4))**2-(P(I,3)+P(J,3))**2- - &(P(I,2)+P(J,2))**2-(P(I,1)+P(J,1))**2) - -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)=0D0 - 100 CONTINUE - DO 120 I=1,N - KFA=IABS(K(I,2)) - IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22) - & .AND.K(I,3).GT.0) THEN - KFMA=IABS(K(K(I,3),2)) - IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) - ENDIF - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 - DO 110 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 110 CONTINUE - 120 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-DPS(1)/DPS(4),-DPS(2)/DPS(4), - &-DPS(3)/DPS(4)) - PECM=0D0 - 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...Check if we have separated strings - -C...Reserve copy of particles by species at end of record. - IWP=0 - IWN=0 - NBE(0)=N+MSTU(3) - NMAX=NBE(0) - SMMIN=PECM - DO 190 IBE=1,MIN(10,MSTJ(52)+1) - NBE(IBE)=NBE(IBE-1) - DO 180 I=NSAV+1,N - IF(IBE.EQ.MIN(10,MSTJ(52)+1)) THEN - DO 140 IIBE=1,IBE-1 - IF(K(I,2).EQ.KFBE(IIBE)) GOTO 180 - 140 CONTINUE - ELSE - IF(K(I,2).NE.KFBE(IBE)) GOTO 180 - ENDIF - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 180 - IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYBOEI:) no more memory left in PYJETS') - RETURN - ENDIF - NBE(IBE)=NBE(IBE)+1 - NMAX=NBE(IBE) - K(NBE(IBE),1)=I - K(NBE(IBE),2)=0 - K(NBE(IBE),3)=0 - K(NBE(IBE),4)=0 - K(NBE(IBE),5)=0 - P(NBE(IBE),1)=0.0D0 - P(NBE(IBE),2)=0.0D0 - P(NBE(IBE),3)=0.0D0 - P(NBE(IBE),4)=0.0D0 - P(NBE(IBE),5)=0.0D0 - SMMIN=MIN(SMMIN,P(I,5)) -C...Check if particles comes from different W's or Z's - IF((MSTJ(53).NE.0.OR.MSTJ(56).GT.0).AND.MINT(32).EQ.0) THEN - IM=I - 150 IF(K(IM,3).GT.0) THEN - IM=K(IM,3) - IF(ABS(K(IM,2)).NE.24.AND.K(IM,2).NE.23) GOTO 150 - K(NBE(IBE),5)=IM - IF(IWP.EQ.0.AND.K(IM,2).EQ.24) IWP=IM - IF(IWN.EQ.0.AND.K(IM,2).EQ.-24) IWN=IM - IF(IWP.EQ.0.AND.K(IM,2).EQ.23) IWP=IM - IF(IWN.EQ.0.AND.K(IM,2).EQ.23.AND.IM.NE.IWP) IWN=IM - ENDIF - ENDIF -C...Check if particles comes from different strings. - IF(PARJ(94).GT.0.0D0) THEN - IM=I - 160 IF(K(IM,3).GT.0) THEN - IM=K(IM,3) - IF(K(IM,2).NE.92.AND.K(IM,2).NE.91) GOTO 160 - K(NBE(IBE),5)=IM - ENDIF - ENDIF - DO 170 J=1,3 - P(NBE(IBE),J)=0D0 - V(NBE(IBE),J)=0D0 - 170 CONTINUE - P(NBE(IBE),5)=-1.0D0 - 180 CONTINUE - 190 CONTINUE - IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 510 - -C...Calculate separation between W+ and W- or between two Z0's. -C...No separation if there has been re-connections. - SIGW=PARJ(93) - IF(IWP.GT.0.AND.IWN.GT.0.AND.MSTJ(56).GT.0.AND.MINT(32).EQ.0) THEN - IF(K(IWP,2).EQ.23) THEN - DMW=PMAS(23,1) - DGW=PMAS(23,2) - ELSE - DMW=PMAS(24,1) - DGW=PMAS(24,2) - ENDIF - DMP=P(IWP,5) - DMN=P(IWN,5) - TAUPD=DMP/SQRT((DMP**2-DMW**2)**2+(DGW*(DMP**2)/DMW)**2) - TAUND=DMN/SQRT((DMN**2-DMW**2)**2+(DGW*(DMN**2)/DMW)**2) - TAUP=-TAUPD*LOG(PYR(IDUM)) - TAUN=-TAUND*LOG(PYR(IDUM)) - DXP=TAUP*PYP(IWP,8)/DMP - DXN=TAUN*PYP(IWN,8)/DMN - DX=DXP+DXN - SIGW=1.0D0/(1.0D0/PARJ(93)+REAL(MSTJ(56))*DX) - IF(PARJ(94).LT.0.0D0) SIGW=1.0D0/(1.0D0/SIGW-1.0D0/PARJ(94)) - ENDIF - -C...Add separation between strings. - IF(PARJ(94).GT.0.0D0) THEN - SIGW=1.0D0/(1.0D0/SIGW+1.0D0/PARJ(94)) - IWP=-1 - IWN=-1 - ENDIF - - IF(MSTJ(57).EQ.1.AND.MSTJ(54).LT.0) THEN - DO 220 IBE=1,MIN(9,MSTJ(52)) - DO 210 I1M=NBE(IBE-1)+1,NBE(IBE) - Q2MIN=PECM**2 - I1=K(I1M,1) - DO 200 I2M=NBE(IBE-1)+1,NBE(IBE) - IF(I2M.EQ.I1M) GOTO 200 - I2=K(I2M,1) - Q2=(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 - IF(Q2.GT.0.0D0.AND.Q2.LT.Q2MIN) THEN - Q2MIN=Q2 - ENDIF - 200 CONTINUE - P(I1M,5)=Q2MIN - 210 CONTINUE - 220 CONTINUE - ENDIF - -C...Tabulate integral for subsequent momentum shift. - DO 400 IBE=1,MIN(9,MSTJ(52)) - IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 270 - IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) - & .LE.1) GOTO 270 - 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 270 - IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 270 - IF(IBE.EQ.1) PMHQ=2D0*PYMASS(211) - IF(IBE.EQ.4) PMHQ=2D0*PYMASS(321) - IF(IBE.EQ.8) PMHQ=2D0*PYMASS(221) - IF(IBE.EQ.9) PMHQ=2D0*PYMASS(331) - QDEL=0.1D0*MIN(PMHQ,PARJ(93)) - QDEL3=0.1D0*MIN(PMHQ,PARJ(93)*3.0D0) - QDELW=0.1D0*MIN(PMHQ,SIGW) - QDEL3W=0.1D0*MIN(PMHQ,SIGW*3.0D0) - IF(MSTJ(51).EQ.1) THEN - NBIN=MIN(100,NINT(9D0*PARJ(93)/QDEL)) - NBIN3=MIN(100,NINT(27D0*PARJ(93)/QDEL3)) - NBINW=MIN(100,NINT(9D0*SIGW/QDELW)) - NBIN3W=MIN(100,NINT(27D0*SIGW/QDEL3W)) - BEEX=EXP(0.5D0*QDEL/PARJ(93)) - BEEX3=EXP(0.5D0*QDEL3/(3.0D0*PARJ(93))) - BEEXW=EXP(0.5D0*QDELW/SIGW) - BEEX3W=EXP(0.5D0*QDEL3W/(3.0D0*SIGW)) - BERT=EXP(-QDEL/PARJ(93)) - BERT3=EXP(-QDEL3/(3.0D0*PARJ(93))) - BERTW=EXP(-QDELW/SIGW) - BERT3W=EXP(-QDEL3W/(3.0D0*SIGW)) - ELSE - NBIN=MIN(100,NINT(3D0*PARJ(93)/QDEL)) - NBIN3=MIN(100,NINT(9D0*PARJ(93)/QDEL3)) - NBINW=MIN(100,NINT(3D0*SIGW/QDELW)) - NBIN3W=MIN(100,NINT(9D0*SIGW/QDEL3W)) - ENDIF - DO 230 IBIN=1,NBIN - QBIN=QDEL*(IBIN-0.5D0) - BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12D0)/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) - 230 CONTINUE - DO 240 IBIN=1,NBIN3 - QBIN=QDEL3*(IBIN-0.5D0) - BEI3(IBIN)=QDEL3*(QBIN**2+QDEL3**2/12D0)/SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEX3=BEEX3*BERT3 - BEI3(IBIN)=BEI3(IBIN)*BEEX3 - ELSE - BEI3(IBIN)=BEI3(IBIN)*EXP(-(QBIN/(3.0D0*PARJ(93)))**2) - ENDIF - IF(IBIN.GE.2) BEI3(IBIN)=BEI3(IBIN)+BEI3(IBIN-1) - 240 CONTINUE - DO 250 IBIN=1,NBINW - QBIN=QDELW*(IBIN-0.5D0) - BEIW(IBIN)=QDELW*(QBIN**2+QDELW**2/12D0)/SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEXW=BEEXW*BERTW - BEIW(IBIN)=BEIW(IBIN)*BEEXW - ELSE - BEIW(IBIN)=BEIW(IBIN)*EXP(-(QBIN/SIGW)**2) - ENDIF - IF(IBIN.GE.2) BEIW(IBIN)=BEIW(IBIN)+BEIW(IBIN-1) - 250 CONTINUE - DO 260 IBIN=1,NBIN3W - QBIN=QDEL3W*(IBIN-0.5D0) - BEI3W(IBIN)=QDEL3W*(QBIN**2+QDEL3W**2/12D0)/ - & SQRT(QBIN**2+PMHQ**2) - IF(MSTJ(51).EQ.1) THEN - BEEX3W=BEEX3W*BERT3W - BEI3W(IBIN)=BEI3W(IBIN)*BEEX3W - ELSE - BEI3W(IBIN)=BEI3W(IBIN)*EXP(-(QBIN/(3.0D0*SIGW))**2) - ENDIF - IF(IBIN.GE.2) BEI3W(IBIN)=BEI3W(IBIN)+BEI3W(IBIN-1) - 260 CONTINUE - -C...Loop through particle pairs and find old relative momentum. - 270 DO 390 I1M=NBE(IBE-1)+1,NBE(IBE)-1 - I1=K(I1M,1) - DO 380 I2M=I1M+1,NBE(IBE) - IF(MSTJ(53).EQ.1.AND.K(I1M,5).NE.K(I2M,5)) GOTO 380 - IF(MSTJ(53).EQ.2.AND.K(I1M,5).EQ.K(I2M,5)) GOTO 380 - I2=K(I2M,1) - Q2OLD=(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 - IF(Q2OLD.LE.0.0D0) GOTO 380 - QOLD=SQRT(Q2OLD) - -C...Calculate new relative momentum. - QMOV=0.0D0 - QMOV3=0.0D0 - QMOVW=0.0D0 - QMOV3W=0.0D0 - IF(QOLD.LT.1D-3*QDEL) THEN - GOTO 280 - ELSEIF(QOLD.LE.QDEL) THEN - QMOV=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN-0.1D0)*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 - 280 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV))**(2D0/3D0) - IF(QOLD.LT.1D-3*QDEL3) THEN - GOTO 290 - ELSEIF(QOLD.LE.QDEL3) THEN - QMOV3=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN3-0.1D0)*QDEL3) THEN - RBIN3=QOLD/QDEL3 - IBIN3=RBIN3 - RINP3=(RBIN3**3-IBIN3**3)/(3*IBIN3*(IBIN3+1)+1) - QMOV3=(BEI3(IBIN3)+RINP3*(BEI3(IBIN3+1)-BEI3(IBIN3)))* - & SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOV3=BEI3(NBIN3)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 290 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3))**(2D0/3D0) - RSCALE=1.0D0 - IF(MSTJ(54).EQ.2) - & RSCALE=1.0D0-EXP(-(QOLD/(2D0*PARJ(93)))**2) - IF((IWP.NE.-1.AND.MSTJ(56).LE.0).OR.IWP.EQ.0.OR.IWN.EQ.0.OR. - & K(I1M,5).EQ.K(I2M,5)) GOTO 320 - - IF(QOLD.LT.1D-3*QDELW) THEN - GOTO 300 - ELSEIF(QOLD.LE.QDELW) THEN - QMOVW=QOLD/3D0 - ELSEIF(QOLD.LT.(NBINW-0.1D0)*QDELW) THEN - RBINW=QOLD/QDELW - IBINW=RBINW - RINPW=(RBINW**3-IBINW**3)/(3*IBINW*(IBINW+1)+1) - QMOVW=(BEIW(IBINW)+RINPW*(BEIW(IBINW+1)-BEIW(IBINW)))* - & SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOVW=BEIW(NBINW)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 300 Q2NEW=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOVW))**(2D0/3D0) - IF(QOLD.LT.1D-3*QDEL3W) THEN - GOTO 310 - ELSEIF(QOLD.LE.QDEL3W) THEN - QMOV3W=QOLD/3D0 - ELSEIF(QOLD.LT.(NBIN3W-0.1D0)*QDEL3W) THEN - RBIN3W=QOLD/QDEL3W - IBIN3W=RBIN3W - RINP3W=(RBIN3W**3-IBIN3W**3)/(3*IBIN3W*(IBIN3W+1)+1) - QMOV3W=(BEI3W(IBIN3W)+RINP3W*(BEI3W(IBIN3W+1)- - & BEI3W(IBIN3W)))*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ELSE - QMOV3W=BEI3W(NBIN3W)*SQRT(Q2OLD+PMHQ**2)/Q2OLD - ENDIF - 310 Q2NEW3=Q2OLD*(QOLD/(QOLD+3D0*PARJ(92)*QMOV3W))**(2D0/3D0) - IF(MSTJ(54).EQ.2) - & RSCALE=1.0D0-EXP(-(QOLD/(2D0*SIGW))**2) - - 320 CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW) - DO 330 J=1,3 - P(I1M,J)=P(I1M,J)+P(NMAX+1,J) - P(I2M,J)=P(I2M,J)+P(NMAX+2,J) - 330 CONTINUE - IF(MSTJ(54).GE.1) THEN - CALL PYBESQ(I1,I2,NMAX,Q2OLD,Q2NEW3) - DO 340 J=1,3 - V(I1M,J)=V(I1M,J)+P(NMAX+1,J)*RSCALE - V(I2M,J)=V(I2M,J)+P(NMAX+2,J)*RSCALE - 340 CONTINUE - ELSEIF(MSTJ(54).LE.-1) THEN - EDEL=P(I1,4)+P(I2,4)- - & SQRT(MAX(Q2NEW-Q2OLD+(P(I1,4)+P(I2,4))**2,0.0D0)) - A2=(P(I1,1)-P(I2,1))**2+(P(I1,2)-P(I2,2))**2+ - & (P(I1,3)-P(I2,3))**2 - WMAX=-1.0D20 - MI3=0 - MI4=0 - S12=SDIP(I1,I2) - SM1=(P(I1,5)+SMMIN)**2 - DO 360 I3M=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - IF(I3M.EQ.I1M.OR.I3M.EQ.I2M) GOTO 360 - IF(MSTJ(53).EQ.1.AND.K(I3M,5).NE.K(I1M,5)) GOTO 360 - IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. - & K(I3M,5).NE.K(I1M,5)) GOTO 360 - I3=K(I3M,1) - IF(K(I3,2).EQ.K(I1,2)) GOTO 360 - S13=SDIP(I1,I3) - S23=SDIP(I2,I3) - SM3=(P(I3,5)+SMMIN)**2 - IF(MSTJ(54).EQ.-2) THEN - WI=(MIN(S12*SM3,S13*MIN(SM1,SM3), - & S23*MIN(SM1,SM3))*SM1) - ELSE - WI=((P(I1,4)+P(I2,4)+P(I3,4))**2- - & (P(I1,3)+P(I2,3)+P(I3,3))**2- - & (P(I1,2)+P(I2,2)+P(I3,2))**2- - & (P(I1,1)+P(I2,1)+P(I3,1))**2) - ENDIF - IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) THEN - IF (WMAX*WI.GE.(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2)))) - & GOTO 360 - ELSE - IF(WMAX*WI.GE.1.0) GOTO 360 - ENDIF - DO 350 I4M=I3M+1,NBE(MIN(10,MSTJ(52)+1)) - IF(I4M.EQ.I1M.OR.I4M.EQ.I2M) GOTO 350 - IF(MSTJ(53).EQ.1.AND.K(I4M,5).NE.K(I1M,5)) GOTO 350 - IF(MSTJ(53).EQ.-2.AND.K(I1M,5).EQ.K(I2M,5).AND. - & K(I4M,5).NE.K(I1M,5)) GOTO 350 - I4=K(I4M,1) - IF(K(I3,2).EQ.K(I4,2).OR.K(I4,2).EQ.K(I1,2)) - & GOTO 350 - IF((P(I3,4)+P(I4,4)+EDEL)**2.LT. - & (P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ - & (P(I3,3)+P(I4,3))**2+(P(I3,5)+P(I4,5))**2) - & GOTO 350 - IF(MSTJ(54).EQ.-2) THEN - S14=SDIP(I1,I4) - S24=SDIP(I2,I4) - S34=SDIP(I3,I4) - W=S12*MIN(MIN(S23,S24),MIN(S13,S14))*S34 - W=MIN(W,S13*MIN(MIN(S23,S34),S12)*S24) - W=MIN(W,S14*MIN(MIN(S24,S34),S12)*S23) - W=MIN(W,MIN(S23,S24)*S13*S14) - W=1.0D0/W - ELSE -C...weight=1-cos(theta)/mtot2 - S1234=(P(I1,4)+P(I2,4)+P(I3,4)+P(I4,4))**2- - & (P(I1,3)+P(I2,3)+P(I3,3)+P(I4,3))**2- - & (P(I1,2)+P(I2,2)+P(I3,2)+P(I4,2))**2- - & (P(I1,1)+P(I2,1)+P(I3,1)+P(I4,1))**2 - W=1.0D0/S1234 - IF(W.LE.WMAX) GOTO 350 - ENDIF - IF(MSTJ(57).EQ.1.AND.P(I3M,5).GT.0) - & W=W*(1.0D0-EXP(-P(I3M,5)/(PARJ(93)**2))) - IF(MSTJ(57).EQ.1.AND.P(I4M,5).GT.0) - & W=W*(1.0D0-EXP(-P(I4M,5)/(PARJ(93)**2))) - IF(W.LE.WMAX) GOTO 350 - MI3=I3M - MI4=I4M - WMAX=W - 350 CONTINUE - 360 CONTINUE - IF(MI4.EQ.0) GOTO 380 - I3=K(MI3,1) - I4=K(MI4,1) - EOLD=P(I3,4)+P(I4,4) - ENEW=EOLD+EDEL - P2=(P(I3,1)+P(I4,1))**2+(P(I3,2)+P(I4,2))**2+ - & (P(I3,3)+P(I4,3))**2 - Q2NEWP=MAX(0.0D0,ENEW**2-P2-(P(I3,5)+P(I4,5))**2) - Q2OLDP=MAX(0.0D0,EOLD**2-P2-(P(I3,5)+P(I4,5))**2) - CALL PYBESQ(I3,I4,NMAX,Q2OLDP,Q2NEWP) - DO 370 J=1,3 - V(MI3,J)=V(MI3,J)+P(NMAX+1,J) - V(MI4,J)=V(MI4,J)+P(NMAX+2,J) - 370 CONTINUE - ENDIF - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - -C...Shift momenta and recalculate energies. - ESUMP=0.0D0 - ESUM=0.0D0 - PROD=0.0D0 - DO 430 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - I=K(IM,1) - ESUMP=ESUMP+P(I,4) - DO 410 J=1,3 - P(I,J)=P(I,J)+P(IM,J) - 410 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - ESUM=ESUM+P(I,4) - DO 420 J=1,3 - PROD=PROD+V(IM,J)*P(I,J)/P(I,4) - 420 CONTINUE - 430 CONTINUE - - PARJ(96)=0.0D0 - IF(MSTJ(54).NE.0.AND.PROD.NE.0.0D0) THEN - 440 ALPHA=(ESUMP-ESUM)/PROD - PARJ(96)=PARJ(96)+ALPHA - PROD=0.0D0 - ESUM=0.0D0 - DO 470 IM=NBE(0)+1,NBE(MIN(10,MSTJ(52)+1)) - I=K(IM,1) - DO 450 J=1,3 - P(I,J)=P(I,J)+ALPHA*V(IM,J) - 450 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - ESUM=ESUM+P(I,4) - DO 460 J=1,3 - PROD=PROD+V(IM,J)*P(I,J)/P(I,4) - 460 CONTINUE - 470 CONTINUE - IF(PROD.NE.0.0D0.AND.ABS(ESUMP-ESUM)/PECM.GT.0.00001D0) - & GOTO 440 - ENDIF - -C...Rescale all momenta for energy conservation. - PES=0D0 - PQS=0D0 - DO 480 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 480 - PES=PES+P(I,4) - PQS=PQS+P(I,5)**2/P(I,4) - 480 CONTINUE - PARJ(95)=PES-PECM - FAC=(PECM-PQS)/(PES-PQS) - DO 500 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 500 - DO 490 J=1,3 - P(I,J)=FAC*P(I,J) - 490 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 500 CONTINUE - -C...Boost back to correct reference frame. - 510 CALL PYROBO(0,0,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) - DO 520 I=1,N - IF(K(I,1).LT.0) K(I,1)=-K(I,1) - 520 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYBOOK -C...Books a histogram. - - SUBROUTINE PYBOOK(ID,TITLE,NX,XL,XU) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Local character variables. - CHARACTER TITLE*(*), TITFX*60 - -C...Check that input is sensible. Find initial address in memory. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYBOOK:) not allowed histogram number') - IF(NX.LE.0.OR.NX.GT.100) CALL PYERRM(28, - &'(PYBOOK:) not allowed number of bins') - IF(XL.GE.XU) CALL PYERRM(28, - &'(PYBOOK:) x limits in wrong order') - INDX(ID)=IHIST(4) - IHIST(4)=IHIST(4)+28+NX - IF(IHIST(4).GT.IHIST(2)) CALL PYERRM(28, - &'(PYBOOK:) out of histogram space') - IS=INDX(ID) - -C...Store histogram size and reset contents. - BIN(IS+1)=NX - BIN(IS+2)=XL - BIN(IS+3)=XU - BIN(IS+4)=(XU-XL)/NX - CALL PYNULL(ID) - -C...Store title by conversion to integer to double precision. - TITFX=TITLE//' ' - DO 100 IT=1,20 - BIN(IS+8+NX+IT)=256**2*ICHAR(TITFX(3*IT-2:3*IT-2))+ - & 256*ICHAR(TITFX(3*IT-1:3*IT-1))+ICHAR(TITFX(3*IT:3*IT)) - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYCBA2 -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE -C CBABK2, WHICH IS A COMPLEX VERSION OF BALBAK, -C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). -C -C THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX GENERAL -C MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING -C BALANCED MATRIX DETERMINED BY CBAL. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY CBAL. -C -C SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS -C AND SCALING FACTORS USED BY CBAL. -C -C M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS TO BE -C BACK TRANSFORMED IN THEIR FIRST M COLUMNS. -C -C ON OUTPUT -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE TRANSFORMED EIGENVECTORS -C IN THEIR FIRST M COLUMNS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCBA2(NM,N,LOW,IGH,SCALE,M,ZR,ZI) - - INTEGER I,J,K,M,N,II,NM,IGH,LOW - DOUBLE PRECISION SCALE(4),ZR(4,4),ZI(4,4) - DOUBLE PRECISION S - - IF (M .EQ. 0) GOTO 150 - IF (IGH .EQ. LOW) GOTO 120 -C - DO 110 I = LOW, IGH - S = SCALE(I) -C .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED -C IF THE FOREGOING STATEMENT IS REPLACED BY -C S=1.0D0/SCALE(I). .......... - DO 100 J = 1, M - ZR(I,J) = ZR(I,J) * S - ZI(I,J) = ZI(I,J) * S - 100 CONTINUE -C - 110 CONTINUE -C .......... FOR I=LOW-1 STEP -1 UNTIL 1, -C IGH+1 STEP 1 UNTIL N DO -- .......... - 120 DO 140 II = 1, N - I = II - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 - IF (I .LT. LOW) I = LOW - II - K = SCALE(I) - IF (K .EQ. I) GOTO 140 -C - DO 130 J = 1, M - S = ZR(I,J) - ZR(I,J) = ZR(K,J) - ZR(K,J) = S - S = ZI(I,J) - ZI(I,J) = ZI(K,J) - ZI(K,J) = S - 130 CONTINUE -C - 140 CONTINUE -C - 150 RETURN - END - -C********************************************************************* - -C...PYCBAL -C...Auxiliary to PYEICG -C -C THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE -C CBALANCE, WHICH IS A COMPLEX VERSION OF BALANCE, -C NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). -C -C THIS SUBROUTINE BALANCES A COMPLEX MATRIX AND ISOLATES -C EIGENVALUES WHENEVER POSSIBLE. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX MATRIX TO BE BALANCED. -C -C ON OUTPUT -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE BALANCED MATRIX. -C -C LOW AND IGH ARE TWO INTEGERS SUCH THAT AR(I,J) AND AI(I,J) -C ARE EQUAL TO ZERO IF -C (1) I IS GREATER THAN J AND -C (2) J=1,...,LOW-1 OR I=IGH+1,...,N. -C -C SCALE CONTAINS INFORMATION DETERMINING THE -C PERMUTATIONS AND SCALING FACTORS USED. -C -C SUPPOSE THAT THE PRINCIPAL SUBMATRIX IN ROWS LOW THROUGH IGH -C HAS BEEN BALANCED, THAT P(J) DENOTES THE INDEX INTERCHANGED -C WITH J DURING THE PERMUTATION STEP, AND THAT THE ELEMENTS -C OF THE DIAGONAL MATRIX USED ARE DENOTED BY D(I,J). THEN -C SCALE(J) = P(J), FOR J = 1,...,LOW-1 -C = D(J,J) J = LOW,...,IGH -C = P(J) J = IGH+1,...,N. -C THE ORDER IN WHICH THE INTERCHANGES ARE MADE IS N TO IGH+1, -C THEN 1 TO LOW-1. -C -C NOTE THAT 1 IS RETURNED FOR IGH IF IGH IS ZERO FORMALLY. -C -C THE ALGOL PROCEDURE EXC CONTAINED IN CBALANCE APPEARS IN -C CBAL IN LINE. (NOTE THAT THE ALGOL ROLES OF IDENTIFIERS -C K,L HAVE BEEN REVERSED.) -C -C ARITHMETIC IS REAL THROUGHOUT. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCBAL(NM,N,AR,AI,LOW,IGH,SCALE) - - INTEGER I,J,K,L,M,N,JJ,NM,IGH,LOW,IEXC - DOUBLE PRECISION AR(4,4),AI(4,4),SCALE(4) - DOUBLE PRECISION C,F,G,R,S,B2,RADIX - LOGICAL NOCONV - - RADIX = 16.0D0 -C - B2 = RADIX * RADIX - K = 1 - L = N - GOTO 150 -C .......... IN-LINE PROCEDURE FOR ROW AND -C COLUMN EXCHANGE .......... - 100 SCALE(M) = J - IF (J .EQ. M) GOTO 130 -C - DO 110 I = 1, L - F = AR(I,J) - AR(I,J) = AR(I,M) - AR(I,M) = F - F = AI(I,J) - AI(I,J) = AI(I,M) - AI(I,M) = F - 110 CONTINUE -C - DO 120 I = K, N - F = AR(J,I) - AR(J,I) = AR(M,I) - AR(M,I) = F - F = AI(J,I) - AI(J,I) = AI(M,I) - AI(M,I) = F - 120 CONTINUE -C - 130 IF(IEXC.EQ.1) GOTO 140 - IF(IEXC.EQ.2) GOTO 180 -C .......... SEARCH FOR ROWS ISOLATING AN EIGENVALUE -C AND PUSH THEM DOWN .......... - 140 IF (L .EQ. 1) GOTO 320 - L = L - 1 -C .......... FOR J=L STEP -1 UNTIL 1 DO -- .......... - 150 DO 170 JJ = 1, L - J = L + 1 - JJ -C - DO 160 I = 1, L - IF (I .EQ. J) GOTO 160 - IF (AR(J,I) .NE. 0.0D0 .OR. AI(J,I) .NE. 0.0D0) GOTO 170 - 160 CONTINUE -C - M = L - IEXC = 1 - GOTO 100 - 170 CONTINUE -C - GOTO 190 -C .......... SEARCH FOR COLUMNS ISOLATING AN EIGENVALUE -C AND PUSH THEM LEFT .......... - 180 K = K + 1 -C - 190 DO 210 J = K, L -C - DO 200 I = K, L - IF (I .EQ. J) GOTO 200 - IF (AR(I,J) .NE. 0.0D0 .OR. AI(I,J) .NE. 0.0D0) GOTO 210 - 200 CONTINUE -C - M = K - IEXC = 2 - GOTO 100 - 210 CONTINUE -C .......... NOW BALANCE THE SUBMATRIX IN ROWS K TO L .......... - DO 220 I = K, L - 220 SCALE(I) = 1.0D0 -C .......... ITERATIVE LOOP FOR NORM REDUCTION .......... - 230 NOCONV = .FALSE. -C - DO 310 I = K, L - C = 0.0D0 - R = 0.0D0 -C - DO 240 J = K, L - IF (J .EQ. I) GOTO 240 - C = C + DABS(AR(J,I)) + DABS(AI(J,I)) - R = R + DABS(AR(I,J)) + DABS(AI(I,J)) - 240 CONTINUE -C .......... GUARD AGAINST ZERO C OR R DUE TO UNDERFLOW .......... - IF (C .EQ. 0.0D0 .OR. R .EQ. 0.0D0) GOTO 310 - G = R / RADIX - F = 1.0D0 - S = C + R - 250 IF (C .GE. G) GOTO 260 - F = F * RADIX - C = C * B2 - GOTO 250 - 260 G = R * RADIX - 270 IF (C .LT. G) GOTO 280 - F = F / RADIX - C = C / B2 - GOTO 270 -C .......... NOW BALANCE .......... - 280 IF ((C + R) / F .GE. 0.95D0 * S) GOTO 310 - G = 1.0D0 / F - SCALE(I) = SCALE(I) * F - NOCONV = .TRUE. -C - DO 290 J = K, N - AR(I,J) = AR(I,J) * G - AI(I,J) = AI(I,J) * G - 290 CONTINUE -C - DO 300 J = 1, L - AR(J,I) = AR(J,I) * F - AI(J,I) = AI(J,I) * F - 300 CONTINUE -C - 310 CONTINUE -C - IF (NOCONV) GOTO 230 -C - 320 LOW = K - IGH = L - RETURN - END - -C********************************************************************* - -C...PYCDIV -C...Auxiliary to PYCMQR -C -C COMPLEX DIVISION, (CR,CI) = (AR,AI)/(BR,BI) -C - - SUBROUTINE PYCDIV(AR,AI,BR,BI,CR,CI) - - DOUBLE PRECISION AR,AI,BR,BI,CR,CI - DOUBLE PRECISION S,ARS,AIS,BRS,BIS - - S = DABS(BR) + DABS(BI) - ARS = AR/S - AIS = AI/S - BRS = BR/S - BIS = BI/S - S = BRS**2 + BIS**2 - CR = (ARS*BRS + AIS*BIS)/S - CI = (AIS*BRS - ARS*BIS)/S - RETURN - END - -C********************************************************************* - -C...PYCELL -C...Provides a simple way of jet finding in eta-phi-ET coordinates, -C...as used for calorimeters at hadron colliders. - - SUBROUTINE PYCELL(NJET) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Loop over all particles. Find cell that was hit by given particle. - PTLRAT=1D0/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=PYCOMP(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.PYCHGE(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.5D0* - & (ETA/PARU(51)+1D0)))) - PHI=PYANGL(P(I,1),P(I,2)) - IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5D0* - & (PHI/PARU(1)+1D0)))) - 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 PYERRM(11,'(PYCELL:) no more memory left in PYJETS') - 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(-2D0*LOG(MAX(1D-10,PYR(0)))*PEI)* - & COS(PARU(2)*PYR(0)) - IF(PEF.LT.0D0.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.0D0) 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=0D0 - 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 PYERRM(11,'(PYCELL:) no more memory left in PYJETS') - 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)=0D0 - P(NJ,4)=0D0 - P(NJ,5)=0D0 - -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)=0D0 - 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=0D0 - 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)=0D0 - 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)=0D0 - 260 CONTINUE - ELSEIF(MSTU(54).GE.3) THEN - DO 270 I=N+1,N+NJET - P(I,5)=SQRT(MAX(0D0,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)=MAX(0,NJET) - IF(MSTU(43).GE.2) N=N+MAX(0,NJET) - - RETURN - END - -C********************************************************************* - -C...PYCHGE -C...Gives three times the charge for a particle/parton. - - FUNCTION PYCHGE(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT2/ - -C...Read out charge and change sign for antiparticle. - PYCHGE=0 - KC=PYCOMP(KF) - IF(KC.NE.0) PYCHGE=KCHG(KC,1)*ISIGN(1,KF) - - RETURN - END - -C********************************************************************* - -C...PYCJDC -C...Calculate decay widths for the charginos (admixtures of -C...charged Wino and charged Higgsino. - -C...Input: KCIN = KF code for particle -C...Output: XLAM = widths -C... IDLAM = KF codes for decay particles -C... IKNT = number of decay channels defined -C...AUTHOR: STEPHEN MRENNA -C...Last change: -C...10-16-95: force decay chi^+_1 -> chi^0_1 e+ nu_e -C...when CHIENU .NE. 0 - - SUBROUTINE PYCJDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -CC &SFMIX(16,4), -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP - COMPLEX*16 CAL,CBL,CAR,CBR,CA,CB - INTEGER KFIN,KCIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, - &XMZ,XMZ2,AXMJ,AXMI - DOUBLE PRECISION S12MIN,S12MAX - DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2,XMK - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I,BETA,ALFA - DOUBLE PRECISION PYX2XH,PYX2XG - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,IH,J,IJ,I,IKNT - INTEGER ITH(3) - INTEGER ITHC - DOUBLE PRECISION ETAH(3),DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA,TANB - - DOUBLE PRECISION PYALEM,PI,PYALPS - DOUBLE PRECISION FCOL - INTEGER KF1,KF2,ISF - INTEGER KFNCHI(4),KFCCHI(2) - - DOUBLE PRECISION TEMP - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - DATA ITH/25,35,36/ - DATA ITHC/37/ - DATA ETAH/1D0,1D0,-1D0/ - DATA SR2/1.4142136D0/ - DATA PI/3.141592654D0/ - DATA PREC/1D-2/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XMZ2=XMZ**2 - XW=1D0-XMW2/XMZ2 - XW1=1D0-XW - TANW = SQRT(XW/XW1) - -C...1 OR 2 DEPENDING ON CHARGINO TYPE - IX=1 - IF(KFIN.EQ.KFCCHI(2)) IX=2 - KCIN=PYCOMP(KFIN) - - XMI=SMW(IX) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - TANB=RMSS(5) - BETA=ATAN(TANB) - CBETA=COS(BETA) - SBETA=TANB*CBETA - ALFA=RMSS(18) - - DO 110 I=1,2 - DO 100 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - -C...GRAVITINO DECAY MODES - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) -C SINW=SQRT(XW) -C COSW=SQRT(1D0-XW) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR+XMW) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*( - & .5D0*(ABS(VMIXC(IX,1))**2+ABS(UMIXC(IX,1))**2)+ - & .5D0*((ABS(VMIXC(IX,2))*SBETA)**2+(ABS(UMIXC(IX,2))*CBETA)**2))* - & (1D0-XMW2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(37,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=37 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(.5D0*((ABS(VMIXC(IX,2))*CBETA)**2+ - & (ABS(UMIXC(IX,2))*SBETA)**2)) - & *(1D0-PMAS(37,1)**2/XMI2)**4 - ENDIF - ENDIF - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS - IF(IX.EQ.1) GOTO 170 - XMJ=SMW(1) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - -C...CHI_2+ -> CHI_1+ + Z0 - IF(AXMI.GE.AXMJ+XMZ) THEN - LKNT=LKNT+1 - IJ=1 - OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- - & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 - ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- - & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - -C...CHARGED LEPTONS - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IA=11 - JA=12 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - XXC(9)=PMAS(23,1) - XXC(10)=PMAS(23,2) - IJ=1 - OLPP=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))- - & VMIXC(IJ,2)*DCONJG(VMIXC(IX,2))/2D0 - ORPP=-UMIXC(IX,1)*DCONJG(UMIXC(IJ,1))- - & UMIXC(IX,2)*DCONJG(UMIXC(IJ,2))/2D0 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=11 - IDLAM(LKNT,3)=-11 - IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-13 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-15 - ENDIF - ENDIF - -C...NEUTRINOS - 120 CONTINUE - IA=12 - JA=11 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(7)=-DCMPLX(EI/XW1)*OLPP - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(12,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=12 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=14 - IDLAM(LKNT,3)=-14 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(16,1)) THEN - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=16 - IDLAM(LKNT,3)=-16 - ENDIF - -C...D-TYPE QUARKS - 130 CONTINUE - IA=1 - JA=2 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-VMIXC(IJ,1)*DCONJG(VMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF - -C...U-TYPE QUARKS - 140 CONTINUE - IA=2 - JA=1 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=1D6 - CXC(1)=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - CXC(2)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - CXC(4)=-UMIXC(IJ,1)*DCONJG(UMIXC(IX,1))*DCMPLX(T3I/XW) - CXC(5)=-DCMPLX(EI/XW1)*ORPP - CXC(6)=DCMPLX(0D0,0D0) - CXC(7)=-DCMPLX(EI/XW1)*OLPP - CXC(8)=DCMPLX(0D0,0D0) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 150 CONTINUE - ENDIF - -C...CHI_2+ -> CHI_1+ + H0_K - EH(2)=COS(ALFA) - EH(1)=SIN(ALFA) - EH(3)=-SBETA - DH(2)=-SIN(ALFA) - DH(1)=COS(ALFA) - DH(3)=COS(BETA) - DO 160 IH=1,3 - XMH=PMAS(ITH(IH),1) - XMH2=XMH**2 -C...NO 3-BODY OPTION - IF(AXMI.GE.AXMJ+XMH) THEN - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMJ2,XMH2) - OLPP=(VMIXC(2,1)*DCONJG(UMIXC(1,2))*EH(IH) - - & VMIXC(2,2)*DCONJG(UMIXC(1,1))*DH(IH))/SR2 - ORPP=(DCONJG(VMIXC(1,1))*UMIXC(2,2)*EH(IH) - - & DCONJG(VMIXC(1,2))*UMIXC(2,1)*DH(IH))/SR2 - XMK=XMJ*ETAH(IH) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(1) - IDLAM(LKNT,2)=ITH(IH) - IDLAM(LKNT,3)=0 - ENDIF - 160 CONTINUE - -C...CHI1 JUMPS TO HERE - 170 CONTINUE - -C...CHI+_I -> CHI0_J + W+ - DO 220 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - IF(AXMI.GE.AXMJ+XMW) THEN - LKNT=LKNT+1 - DO 180 I=1,4 - ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) - 180 CONTINUE - CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- - & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2) - CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ - & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2) - GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 - GLR=DBLE(CXC(1)*DCONJG(CXC(3))) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 -C...LEPTONS - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - DO 190 I=1,4 - ZMIXC(IJ,I)=DCMPLX(ZMIX(IJ,I),ZMIXI(IJ,I)) - 190 CONTINUE - CXC(1)=(DCONJG(ZMIXC(IJ,2))*VMIXC(IX,1)- - & DCONJG(ZMIXC(IJ,4))*VMIXC(IX,2)/SR2)/SR2 - CXC(3)=(ZMIXC(IJ,2)*DCONJG(UMIXC(IX,1))+ - & ZMIXC(IJ,3)*DCONJG(UMIXC(IX,2))/SR2)/SR2 - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - IA=11 - JA=12 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IX,1)*DCONJG(ZMIXC(IJ,1)*(EJ-T3J)* - & TANW+ZMIXC(IJ,2)*T3J)/SR2 - CXC(4)=-DCONJG(UMIXC(IX,1))*( - & ZMIXC(IJ,1)*(EI-T3I)*TANW+ZMIXC(IJ,2)*T3I)/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(9)=PMAS(24,1) - XXC(10)=PMAS(24,2) -CCC IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) -C...1/(2PI)**3*/(32*M**3)*G^4, G^2/(4*PI)= AEM/XW, -C...--> 1/(16PI)/M**3*(AEM/XW)**2 - IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN - LKNT=LKNT+1 - TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-11 - IDLAM(LKNT,3)=12 -C...ONLY DECAY CHI+1 -> E+ NU_E - IF( IMSS(12).NE. 0 ) GOTO 260 - IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-13 - IDLAM(LKNT,3)=14 - ENDIF - ENDIF - IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN - LKNT=LKNT+1 - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - TEMP=PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)*TEMP - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-15 - IDLAM(LKNT,3)=16 - ENDIF - -C...NOW, DO THE QUARKS - 200 CONTINUE - IA=1 - JA=2 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IX,1)*DCONJG(ZMIXC(IJ,1)*(EJ-T3J)* - & TANW+ZMIXC(IJ,2)*T3J) - CXC(4)=-DCONJG(UMIXC(IX,1))*( - & ZMIXC(IJ,1)*(EI-T3I)*TANW+ZMIXC(IJ,2)*T3I) - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 210 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-1 - IDLAM(LKNT,3)=2 - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=-3 - IDLAM(LKNT,3)=4 - ENDIF - ENDIF - 210 CONTINUE - ENDIF - 220 CONTINUE - -C...CHI+_I -> CHI0_J + H+ - DO 230 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - XMHP=PMAS(ITHC,1) - IF(AXMI.GE.AXMJ+XMHP) THEN - LKNT=LKNT+1 - OLPP=CBETA*(ZMIXC(IJ,4)*DCONJG(VMIXC(IX,1))+(ZMIXC(IJ,2)+ - & ZMIXC(IJ,1)*TANW)*DCONJG(VMIXC(IX,2))/SR2) - ORPP=SBETA*(DCONJG(ZMIXC(IJ,3))*UMIXC(IX,1)- - & (DCONJG(ZMIXC(IJ,2))+DCONJG(ZMIXC(IJ,1))*TANW)* - & UMIXC(IX,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=ITHC - IDLAM(LKNT,3)=0 - ELSE - - ENDIF - 230 CONTINUE - -C...2-BODY DECAYS TO FERMION SFERMION - DO 240 J=1,16 - IF(J.GE.7.AND.J.LE.10) GOTO 240 - IF(MOD(J,2).EQ.0) THEN - KF1=KSUSY1+J-1 - ELSE - KF1=KSUSY1+J+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - XMF=PMAS(J,1) - IF(J.LE.6) THEN - FCOL=3D0 - ELSE - FCOL=1D0 - ENDIF - -C...U~ D_L - IF(MOD(J,2).EQ.0) THEN - XMFP=PMAS(J-1,1) - CAL=UMIXC(IX,1) - CBL=-XMF*VMIXC(IX,2)/XMW/SBETA/SR2 - CAR=-XMFP*UMIXC(IX,2)/XMW/CBETA/SR2 - CBR=0D0 - ISF=J-1 - ELSE - XMFP=PMAS(J+1,1) - CAL=VMIXC(IX,1) - CBL=-XMF*UMIXC(IX,2)/XMW/CBETA/SR2 - CBR=0D0 - CAR=-XMFP*VMIXC(IX,2)/XMW/SBETA/SR2 - ISF=J+1 - ENDIF - -C...~U_L D - IF(AXMI.GE.XMF+XMSF1) THEN - LKNT=LKNT+1 - XMA2=XMSF1**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - CA=CAL*SFMIX(ISF,1)+CAR*SFMIX(ISF,2) - CB=CBL*SFMIX(ISF,1)+CBR*SFMIX(ISF,2) - XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,3)=0 - IF(MOD(J,2).EQ.0) THEN - IDLAM(LKNT,1)=-KF1 - IDLAM(LKNT,2)=J - ELSE - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=-J - ENDIF - ENDIF - -C...U~ D_R - IF(AXMI.GE.XMF+XMSF2) THEN - LKNT=LKNT+1 - XMA2=XMSF2**2 - XMB2=XMF**2 - CA=CAL*SFMIX(ISF,3)+CAR*SFMIX(ISF,4) - CB=CBL*SFMIX(ISF,3)+CBR*SFMIX(ISF,4) - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,3)=0 - IF(MOD(J,2).EQ.0) THEN - IDLAM(LKNT,1)=-KF2 - IDLAM(LKNT,2)=J - ELSE - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=-J - ENDIF - ENDIF - 240 CONTINUE - -C...3-BODY DECAY TO Q Q~' GLUINO, ONLY IF IT CANNOT PROCEED THROUGH -C...A 2-BODY -- 2-BODY CHAIN - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - IF(AXMI.GE.XMJ) THEN - AXMJ=ABS(XMJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) - XXC(9)=1D6 - XXC(10)=0D0 - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) - ORPP=DCONJG(OLPP) - CXC(1)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX(0D0,0D0) - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - CXC(2)=UMIXC(IX,1)*OLPP/SR2 - CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 250 - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=-1 - IDLAM(LKNT,3)=2 - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=-3 - IDLAM(LKNT,3)=4 - ENDIF - ENDIF - 250 CONTINUE - ENDIF - -C...R-violating decay modes (SKANDS). - CALL PYRVCH(KFIN,XLAM,IDLAM,LKNT) - - 260 IKNT=LKNT - XLAM(0)=0D0 - DO 270 I=1,IKNT - XLAM(0)=XLAM(0)+XLAM(I) - IF(XLAM(I).LT.0D0) THEN - WRITE(MSTU(11),*) ' XLAM(I) = ',XLAM(I),KCIN, - & (IDLAM(I,J),J=1,3) - XLAM(I)=0D0 - ENDIF - 270 CONTINUE - IF(XLAM(0).EQ.0D0) THEN - XLAM(0)=1D-6 - WRITE(MSTU(11),*) ' XLAM(0) = ',XLAM(0) - WRITE(MSTU(11),*) LKNT - WRITE(MSTU(11),*) (XLAM(J),J=1,LKNT) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYCLUS -C...Subdivides the particle content of an event into jets/clusters. - - SUBROUTINE PYCLUS(NJET) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays and saved variables. - 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))*2D0*P(I1,5)*P(I2,5)/(0.0001D0+P(I1,5)+P(I2,5))**2 - R2M(I1,I2)=2D0*P(I1,4)*P(I2,4)*(1D0-(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)=2D0*MIN(P(I1,4),P(I2,4))**2*(1D0-(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)=0D0 - 100 CONTINUE - PSS=0D0 - PIMASS=PMAS(PYCOMP(211),1) - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 140 - ENDIF - IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYCLUS:) no more memory left in PYJETS') - 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)=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS - 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(0D0,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 PYERRM(8,'(PYCLUS:) 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.25D0*PARU(43) - IF(NP.LE.MSTU(47)+2) RINIT=0D0 - 170 RINIT=0.8D0*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)=0D0 - 190 CONTINUE - DO 210 I=N+NP+1,N+2*NP - IF(P(I,5).GT.2D0*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.2D0*RINIT) NPRE=1 - IF(RINIT.GE.0.2D0*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=0D0 - 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.2D0*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=0D0 - PSJT=0D0 - 310 IF(MSTU(46).LE.1) THEN - DO 330 I=N+1,N+NJET - DO 320 J=1,4 - V(I,J)=0D0 - 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=0D0 - 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=2D0*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=0D0 - 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=0D0 - 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)=-1D0 - 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=0D0 - 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,0D0)) - DO 560 J=1,5 - V(I,J)=0D0 - 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)=0D0 - IF(IEMP.NE.0) THEN - CALL PYERRM(8,'(PYCLUS:) failed to reconstruct as requested') - NJET=-1 - RETURN - ENDIF - IF(MSTU(43).LE.1) MSTU(3)=MAX(0,NJET) - IF(MSTU(43).GE.2) N=N+MAX(0,NJET) - NSAV=NJET - - RETURN - END - -C********************************************************************* - -C...PYCMQ2 -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE -C ALGOL PROCEDURE COMLR2, NUM. MATH. 16, 181-204(1970) BY PETERS -C AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 372-395(1971). -C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS -C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. -C -C THIS SUBROUTINE FINDS THE EIGENVALUES AND EIGENVECTORS -C OF A COMPLEX UPPER HESSENBERG MATRIX BY THE QR -C METHOD. THE EIGENVECTORS OF A COMPLEX GENERAL MATRIX -C CAN ALSO BE FOUND IF CORTH HAS BEEN USED TO REDUCE -C THIS GENERAL MATRIX TO HESSENBERG FORM. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C ORTR AND ORTI CONTAIN INFORMATION ABOUT THE UNITARY TRANS- -C FORMATIONS USED IN THE REDUCTION BY CORTH, IF PERFORMED. -C ONLY ELEMENTS LOW THROUGH IGH ARE USED. IF THE EIGENVECTORS -C OF THE HESSENBERG MATRIX ARE DESIRED, SET ORTR(J) AND -C ORTI(J) TO 0.0D0 FOR THESE ELEMENTS. -C -C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. -C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN FURTHER -C INFORMATION ABOUT THE TRANSFORMATIONS WHICH WERE USED IN THE -C REDUCTION BY CORTH, IF PERFORMED. IF THE EIGENVECTORS OF -C THE HESSENBERG MATRIX ARE DESIRED, THESE ELEMENTS MAY BE -C ARBITRARY. -C -C ON OUTPUT -C -C ORTR, ORTI, AND THE UPPER HESSENBERG PORTIONS OF HR AND HI -C HAVE BEEN DESTROYED. -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR -C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT -C FOR INDICES IERR+1,...,N. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS. THE EIGENVECTORS -C ARE UNNORMALIZED. IF AN ERROR EXIT IS MADE, NONE OF -C THE EIGENVECTORS HAS BEEN FOUND. -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED -C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. -C -C CALLS PYCDIV FOR COMPLEX DIVISION. -C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED OCTOBER 1989. -C -C MESHED OVERFLOW CONTROL WITH VECTORS OF ISOLATED ROOTS (10/19/89 BSG) -C MESHED OVERFLOW CONTROL WITH TRIANGULAR MULTIPLY (10/30/89 BSG) -C - - SUBROUTINE PYCMQ2(NM,N,LOW,IGH,ORTR,ORTI,HR,HI,WR,WI,ZR,ZI,IERR) - - INTEGER I,J,K,L,M,N,EN,II,JJ,LL,NM,NN,IGH,IP1, - X ITN,ITS,LOW,LP1,ENM1,IEND,IERR - DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), - X ORTR(4),ORTI(4) - DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, - X PYTHAG - - IERR = 0 -C .......... INITIALIZE EIGENVECTOR MATRIX .......... - DO 110 J = 1, N -C - DO 100 I = 1, N - ZR(I,J) = 0.0D0 - ZI(I,J) = 0.0D0 - 100 CONTINUE - ZR(J,J) = 1.0D0 - 110 CONTINUE -C .......... FORM THE MATRIX OF ACCUMULATED TRANSFORMATIONS -C FROM THE INFORMATION LEFT BY CORTH .......... - IEND = IGH - LOW - 1 - IF (IEND.LT.0) GOTO 220 - IF (IEND.EQ.0) GOTO 170 -C .......... FOR I=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... - DO 160 II = 1, IEND - I = IGH - II - IF (ORTR(I) .EQ. 0.0D0 .AND. ORTI(I) .EQ. 0.0D0) GOTO 160 - IF (HR(I,I-1) .EQ. 0.0D0 .AND. HI(I,I-1) .EQ. 0.0D0) GOTO 160 -C .......... NORM BELOW IS NEGATIVE OF H FORMED IN CORTH .......... - NORM = HR(I,I-1) * ORTR(I) + HI(I,I-1) * ORTI(I) - IP1 = I + 1 -C - DO 120 K = IP1, IGH - ORTR(K) = HR(K,I-1) - ORTI(K) = HI(K,I-1) - 120 CONTINUE -C - DO 150 J = I, IGH - SR = 0.0D0 - SI = 0.0D0 -C - DO 130 K = I, IGH - SR = SR + ORTR(K) * ZR(K,J) + ORTI(K) * ZI(K,J) - SI = SI + ORTR(K) * ZI(K,J) - ORTI(K) * ZR(K,J) - 130 CONTINUE -C - SR = SR / NORM - SI = SI / NORM -C - DO 140 K = I, IGH - ZR(K,J) = ZR(K,J) + SR * ORTR(K) - SI * ORTI(K) - ZI(K,J) = ZI(K,J) + SR * ORTI(K) + SI * ORTR(K) - 140 CONTINUE -C - 150 CONTINUE -C - 160 CONTINUE -C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... - 170 L = LOW + 1 -C - DO 210 I = L, IGH - LL = MIN0(I+1,IGH) - IF (HI(I,I-1) .EQ. 0.0D0) GOTO 210 - NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) - YR = HR(I,I-1) / NORM - YI = HI(I,I-1) / NORM - HR(I,I-1) = NORM - HI(I,I-1) = 0.0D0 -C - DO 180 J = I, N - SI = YR * HI(I,J) - YI * HR(I,J) - HR(I,J) = YR * HR(I,J) + YI * HI(I,J) - HI(I,J) = SI - 180 CONTINUE -C - DO 190 J = 1, LL - SI = YR * HI(J,I) + YI * HR(J,I) - HR(J,I) = YR * HR(J,I) - YI * HI(J,I) - HI(J,I) = SI - 190 CONTINUE -C - DO 200 J = LOW, IGH - SI = YR * ZI(J,I) + YI * ZR(J,I) - ZR(J,I) = YR * ZR(J,I) - YI * ZI(J,I) - ZI(J,I) = SI - 200 CONTINUE -C - 210 CONTINUE -C .......... STORE ROOTS ISOLATED BY CBAL .......... - 220 DO 230 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 230 - WR(I) = HR(I,I) - WI(I) = HI(I,I) - 230 CONTINUE -C - EN = IGH - TR = 0.0D0 - TI = 0.0D0 - ITN = 30*N -C .......... SEARCH FOR NEXT EIGENVALUE .......... - 240 IF (EN .LT. LOW) GOTO 430 - ITS = 0 - ENM1 = EN - 1 -C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT -C FOR L=EN STEP -1 UNTIL LOW DO -- .......... - 250 DO 260 LL = LOW, EN - L = EN + LOW - LL - IF (L .EQ. LOW) GOTO 270 - TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) - X + DABS(HR(L,L)) + DABS(HI(L,L)) - TST2 = TST1 + DABS(HR(L,L-1)) - IF (TST2 .EQ. TST1) GOTO 270 - 260 CONTINUE -C .......... FORM SHIFT .......... - 270 IF (L .EQ. EN) GOTO 420 - IF (ITN .EQ. 0) GOTO 550 - IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 290 - SR = HR(EN,EN) - SI = HI(EN,EN) - XR = HR(ENM1,EN) * HR(EN,ENM1) - XI = HI(ENM1,EN) * HR(EN,ENM1) - IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 300 - YR = (HR(ENM1,ENM1) - SR) / 2.0D0 - YI = (HI(ENM1,ENM1) - SI) / 2.0D0 - CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) - IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 280 - ZZR = -ZZR - ZZI = -ZZI - 280 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) - SR = SR - XR - SI = SI - XI - GOTO 300 -C .......... FORM EXCEPTIONAL SHIFT .......... - 290 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) - SI = 0.0D0 -C - 300 DO 310 I = LOW, EN - HR(I,I) = HR(I,I) - SR - HI(I,I) = HI(I,I) - SI - 310 CONTINUE -C - TR = TR + SR - TI = TI + SI - ITS = ITS + 1 - ITN = ITN - 1 -C .......... REDUCE TO TRIANGLE (ROWS) .......... - LP1 = L + 1 -C - DO 330 I = LP1, EN - SR = HR(I,I-1) - HR(I,I-1) = 0.0D0 - NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) - XR = HR(I-1,I-1) / NORM - WR(I-1) = XR - XI = HI(I-1,I-1) / NORM - WI(I-1) = XI - HR(I-1,I-1) = NORM - HI(I-1,I-1) = 0.0D0 - HI(I,I-1) = SR / NORM -C - DO 320 J = I, N - YR = HR(I-1,J) - YI = HI(I-1,J) - ZZR = HR(I,J) - ZZI = HI(I,J) - HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR - HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI - HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR - HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI - 320 CONTINUE -C - 330 CONTINUE -C - SI = HI(EN,EN) - IF (SI .EQ. 0.0D0) GOTO 350 - NORM = PYTHAG(HR(EN,EN),SI) - SR = HR(EN,EN) / NORM - SI = SI / NORM - HR(EN,EN) = NORM - HI(EN,EN) = 0.0D0 - IF (EN .EQ. N) GOTO 350 - IP1 = EN + 1 -C - DO 340 J = IP1, N - YR = HR(EN,J) - YI = HI(EN,J) - HR(EN,J) = SR * YR + SI * YI - HI(EN,J) = SR * YI - SI * YR - 340 CONTINUE -C .......... INVERSE OPERATION (COLUMNS) .......... - 350 DO 390 J = LP1, EN - XR = WR(J-1) - XI = WI(J-1) -C - DO 370 I = 1, J - YR = HR(I,J-1) - YI = 0.0D0 - ZZR = HR(I,J) - ZZI = HI(I,J) - IF (I .EQ. J) GOTO 360 - YI = HI(I,J-1) - HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - 360 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 370 CONTINUE -C - DO 380 I = LOW, IGH - YR = ZR(I,J-1) - YI = ZI(I,J-1) - ZZR = ZR(I,J) - ZZI = ZI(I,J) - ZR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - ZI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - ZR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - ZI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 380 CONTINUE -C - 390 CONTINUE -C - IF (SI .EQ. 0.0D0) GOTO 250 -C - DO 400 I = 1, EN - YR = HR(I,EN) - YI = HI(I,EN) - HR(I,EN) = SR * YR - SI * YI - HI(I,EN) = SR * YI + SI * YR - 400 CONTINUE -C - DO 410 I = LOW, IGH - YR = ZR(I,EN) - YI = ZI(I,EN) - ZR(I,EN) = SR * YR - SI * YI - ZI(I,EN) = SR * YI + SI * YR - 410 CONTINUE -C - GOTO 250 -C .......... A ROOT FOUND .......... - 420 HR(EN,EN) = HR(EN,EN) + TR - WR(EN) = HR(EN,EN) - HI(EN,EN) = HI(EN,EN) + TI - WI(EN) = HI(EN,EN) - EN = ENM1 - GOTO 240 -C .......... ALL ROOTS FOUND. BACKSUBSTITUTE TO FIND -C VECTORS OF UPPER TRIANGULAR FORM .......... - 430 NORM = 0.0D0 -C - DO 440 I = 1, N -C - DO 440 J = I, N - TR = DABS(HR(I,J)) + DABS(HI(I,J)) - IF (TR .GT. NORM) NORM = TR - 440 CONTINUE -C - IF (N .EQ. 1 .OR. NORM .EQ. 0.0D0) GOTO 560 -C .......... FOR EN=N STEP -1 UNTIL 2 DO -- .......... - DO 500 NN = 2, N - EN = N + 2 - NN - XR = WR(EN) - XI = WI(EN) - HR(EN,EN) = 1.0D0 - HI(EN,EN) = 0.0D0 - ENM1 = EN - 1 -C .......... FOR I=EN-1 STEP -1 UNTIL 1 DO -- .......... - DO 490 II = 1, ENM1 - I = EN - II - ZZR = 0.0D0 - ZZI = 0.0D0 - IP1 = I + 1 -C - DO 450 J = IP1, EN - ZZR = ZZR + HR(I,J) * HR(J,EN) - HI(I,J) * HI(J,EN) - ZZI = ZZI + HR(I,J) * HI(J,EN) + HI(I,J) * HR(J,EN) - 450 CONTINUE -C - YR = XR - WR(I) - YI = XI - WI(I) - IF (YR .NE. 0.0D0 .OR. YI .NE. 0.0D0) GOTO 470 - TST1 = NORM - YR = TST1 - 460 YR = 0.01D0 * YR - TST2 = NORM + YR - IF (TST2 .GT. TST1) GOTO 460 - 470 CONTINUE - CALL PYCDIV(ZZR,ZZI,YR,YI,HR(I,EN),HI(I,EN)) -C .......... OVERFLOW CONTROL .......... - TR = DABS(HR(I,EN)) + DABS(HI(I,EN)) - IF (TR .EQ. 0.0D0) GOTO 490 - TST1 = TR - TST2 = TST1 + 1.0D0/TST1 - IF (TST2 .GT. TST1) GOTO 490 - DO 480 J = I, EN - HR(J,EN) = HR(J,EN)/TR - HI(J,EN) = HI(J,EN)/TR - 480 CONTINUE -C - 490 CONTINUE -C - 500 CONTINUE -C .......... END BACKSUBSTITUTION .......... -C .......... VECTORS OF ISOLATED ROOTS .......... - DO 520 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 520 -C - DO 510 J = I, N - ZR(I,J) = HR(I,J) - ZI(I,J) = HI(I,J) - 510 CONTINUE -C - 520 CONTINUE -C .......... MULTIPLY BY TRANSFORMATION MATRIX TO GIVE -C VECTORS OF ORIGINAL FULL MATRIX. -C FOR J=N STEP -1 UNTIL LOW DO -- .......... - DO 540 JJ = LOW, N - J = N + LOW - JJ - M = MIN0(J,IGH) -C - DO 540 I = LOW, IGH - ZZR = 0.0D0 - ZZI = 0.0D0 -C - DO 530 K = LOW, M - ZZR = ZZR + ZR(I,K) * HR(K,J) - ZI(I,K) * HI(K,J) - ZZI = ZZI + ZR(I,K) * HI(K,J) + ZI(I,K) * HR(K,J) - 530 CONTINUE -C - ZR(I,J) = ZZR - ZI(I,J) = ZZI - 540 CONTINUE -C - GOTO 560 -C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT -C CONVERGED AFTER 30*N ITERATIONS .......... - 550 IERR = EN - 560 RETURN - END - -C********************************************************************* - -C...PYCMQR -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A UNITARY ANALOGUE OF THE -C ALGOL PROCEDURE COMLR, NUM. MATH. 12, 369-376(1968) BY MARTIN -C AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 396-403(1971). -C THE UNITARY ANALOGUE SUBSTITUTES THE QR ALGORITHM OF FRANCIS -C (COMP. JOUR. 4, 332-345(1962)) FOR THE LR ALGORITHM. -C -C THIS SUBROUTINE FINDS THE EIGENVALUES OF A COMPLEX -C UPPER HESSENBERG MATRIX BY THE QR METHOD. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C HR AND HI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX UPPER HESSENBERG MATRIX. -C THEIR LOWER TRIANGLES BELOW THE SUBDIAGONAL CONTAIN -C INFORMATION ABOUT THE UNITARY TRANSFORMATIONS USED IN -C THE REDUCTION BY CORTH, IF PERFORMED. -C -C ON OUTPUT -C -C THE UPPER HESSENBERG PORTIONS OF HR AND HI HAVE BEEN -C DESTROYED. THEREFORE, THEY MUST BE SAVED BEFORE -C CALLING COMQR IF SUBSEQUENT CALCULATION OF -C EIGENVECTORS IS TO BE PERFORMED. -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. IF AN ERROR -C EXIT IS MADE, THE EIGENVALUES SHOULD BE CORRECT -C FOR INDICES IERR+1,...,N. -C -C IERR IS SET TO -C ZERO FOR NORMAL RETURN, -C J IF THE LIMIT OF 30*N ITERATIONS IS EXHAUSTED -C WHILE THE J-TH EIGENVALUE IS BEING SOUGHT. -C -C CALLS PYCDIV FOR COMPLEX DIVISION. -C CALLS PYCSRT FOR COMPLEX SQUARE ROOT. -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCMQR(NM,N,LOW,IGH,HR,HI,WR,WI,IERR) - - INTEGER I,J,L,N,EN,LL,NM,IGH,ITN,ITS,LOW,LP1,ENM1,IERR - DOUBLE PRECISION HR(4,4),HI(4,4),WR(4),WI(4) - DOUBLE PRECISION SI,SR,TI,TR,XI,XR,YI,YR,ZZI,ZZR,NORM,TST1,TST2, - X PYTHAG - - IERR = 0 - IF (LOW .EQ. IGH) GOTO 130 -C .......... CREATE REAL SUBDIAGONAL ELEMENTS .......... - L = LOW + 1 -C - DO 120 I = L, IGH - LL = MIN0(I+1,IGH) - IF (HI(I,I-1) .EQ. 0.0D0) GOTO 120 - NORM = PYTHAG(HR(I,I-1),HI(I,I-1)) - YR = HR(I,I-1) / NORM - YI = HI(I,I-1) / NORM - HR(I,I-1) = NORM - HI(I,I-1) = 0.0D0 -C - DO 100 J = I, IGH - SI = YR * HI(I,J) - YI * HR(I,J) - HR(I,J) = YR * HR(I,J) + YI * HI(I,J) - HI(I,J) = SI - 100 CONTINUE -C - DO 110 J = LOW, LL - SI = YR * HI(J,I) + YI * HR(J,I) - HR(J,I) = YR * HR(J,I) - YI * HI(J,I) - HI(J,I) = SI - 110 CONTINUE -C - 120 CONTINUE -C .......... STORE ROOTS ISOLATED BY CBAL .......... - 130 DO 140 I = 1, N - IF (I .GE. LOW .AND. I .LE. IGH) GOTO 140 - WR(I) = HR(I,I) - WI(I) = HI(I,I) - 140 CONTINUE -C - EN = IGH - TR = 0.0D0 - TI = 0.0D0 - ITN = 30*N -C .......... SEARCH FOR NEXT EIGENVALUE .......... - 150 IF (EN .LT. LOW) GOTO 320 - ITS = 0 - ENM1 = EN - 1 -C .......... LOOK FOR SINGLE SMALL SUB-DIAGONAL ELEMENT -C FOR L=EN STEP -1 UNTIL LOW D0 -- .......... - 160 DO 170 LL = LOW, EN - L = EN + LOW - LL - IF (L .EQ. LOW) GOTO 180 - TST1 = DABS(HR(L-1,L-1)) + DABS(HI(L-1,L-1)) - X + DABS(HR(L,L)) + DABS(HI(L,L)) - TST2 = TST1 + DABS(HR(L,L-1)) - IF (TST2 .EQ. TST1) GOTO 180 - 170 CONTINUE -C .......... FORM SHIFT .......... - 180 IF (L .EQ. EN) GOTO 300 - IF (ITN .EQ. 0) GOTO 310 - IF (ITS .EQ. 10 .OR. ITS .EQ. 20) GOTO 200 - SR = HR(EN,EN) - SI = HI(EN,EN) - XR = HR(ENM1,EN) * HR(EN,ENM1) - XI = HI(ENM1,EN) * HR(EN,ENM1) - IF (XR .EQ. 0.0D0 .AND. XI .EQ. 0.0D0) GOTO 210 - YR = (HR(ENM1,ENM1) - SR) / 2.0D0 - YI = (HI(ENM1,ENM1) - SI) / 2.0D0 - CALL PYCSRT(YR**2-YI**2+XR,2.0D0*YR*YI+XI,ZZR,ZZI) - IF (YR * ZZR + YI * ZZI .GE. 0.0D0) GOTO 190 - ZZR = -ZZR - ZZI = -ZZI - 190 CALL PYCDIV(XR,XI,YR+ZZR,YI+ZZI,XR,XI) - SR = SR - XR - SI = SI - XI - GOTO 210 -C .......... FORM EXCEPTIONAL SHIFT .......... - 200 SR = DABS(HR(EN,ENM1)) + DABS(HR(ENM1,EN-2)) - SI = 0.0D0 -C - 210 DO 220 I = LOW, EN - HR(I,I) = HR(I,I) - SR - HI(I,I) = HI(I,I) - SI - 220 CONTINUE -C - TR = TR + SR - TI = TI + SI - ITS = ITS + 1 - ITN = ITN - 1 -C .......... REDUCE TO TRIANGLE (ROWS) .......... - LP1 = L + 1 -C - DO 240 I = LP1, EN - SR = HR(I,I-1) - HR(I,I-1) = 0.0D0 - NORM = PYTHAG(PYTHAG(HR(I-1,I-1),HI(I-1,I-1)),SR) - XR = HR(I-1,I-1) / NORM - WR(I-1) = XR - XI = HI(I-1,I-1) / NORM - WI(I-1) = XI - HR(I-1,I-1) = NORM - HI(I-1,I-1) = 0.0D0 - HI(I,I-1) = SR / NORM -C - DO 230 J = I, EN - YR = HR(I-1,J) - YI = HI(I-1,J) - ZZR = HR(I,J) - ZZI = HI(I,J) - HR(I-1,J) = XR * YR + XI * YI + HI(I,I-1) * ZZR - HI(I-1,J) = XR * YI - XI * YR + HI(I,I-1) * ZZI - HR(I,J) = XR * ZZR - XI * ZZI - HI(I,I-1) * YR - HI(I,J) = XR * ZZI + XI * ZZR - HI(I,I-1) * YI - 230 CONTINUE -C - 240 CONTINUE -C - SI = HI(EN,EN) - IF (SI .EQ. 0.0D0) GOTO 250 - NORM = PYTHAG(HR(EN,EN),SI) - SR = HR(EN,EN) / NORM - SI = SI / NORM - HR(EN,EN) = NORM - HI(EN,EN) = 0.0D0 -C .......... INVERSE OPERATION (COLUMNS) .......... - 250 DO 280 J = LP1, EN - XR = WR(J-1) - XI = WI(J-1) -C - DO 270 I = L, J - YR = HR(I,J-1) - YI = 0.0D0 - ZZR = HR(I,J) - ZZI = HI(I,J) - IF (I .EQ. J) GOTO 260 - YI = HI(I,J-1) - HI(I,J-1) = XR * YI + XI * YR + HI(J,J-1) * ZZI - 260 HR(I,J-1) = XR * YR - XI * YI + HI(J,J-1) * ZZR - HR(I,J) = XR * ZZR + XI * ZZI - HI(J,J-1) * YR - HI(I,J) = XR * ZZI - XI * ZZR - HI(J,J-1) * YI - 270 CONTINUE -C - 280 CONTINUE -C - IF (SI .EQ. 0.0D0) GOTO 160 -C - DO 290 I = L, EN - YR = HR(I,EN) - YI = HI(I,EN) - HR(I,EN) = SR * YR - SI * YI - HI(I,EN) = SR * YI + SI * YR - 290 CONTINUE -C - GOTO 160 -C .......... A ROOT FOUND .......... - 300 WR(EN) = HR(EN,EN) + TR - WI(EN) = HI(EN,EN) + TI - EN = ENM1 - GOTO 150 -C .......... SET ERROR -- ALL EIGENVALUES HAVE NOT -C CONVERGED AFTER 30*N ITERATIONS .......... - 310 IERR = EN - 320 RETURN - END - -C********************************************************************* - -C...PYCOMP -C...Compress the standard KF codes for use in mass and decay arrays; -C...also checks whether a given code actually is defined. - - FUNCTION PYCOMP(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ -C...Local arrays and saved data. - DIMENSION KFORD(100:500),KCORD(101:500) - SAVE KFORD,KCORD,NFORD,KFLAST,KCLAST - -C...Whenever necessary reorder codes for faster search. - IF(MSTU(20).EQ.0) THEN - NFORD=100 - KFORD(100)=0 - DO 120 I=101,500 - KFA=KCHG(I,4) - IF(KFA.LE.100) GOTO 120 - NFORD=NFORD+1 - DO 100 I1=NFORD-1,0,-1 - IF(KFA.GE.KFORD(I1)) GOTO 110 - KFORD(I1+1)=KFORD(I1) - KCORD(I1+1)=KCORD(I1) - 100 CONTINUE - 110 KFORD(I1+1)=KFA - KCORD(I1+1)=I - 120 CONTINUE - MSTU(20)=1 - KFLAST=0 - KCLAST=0 - ENDIF - -C...Fast action if same code as in latest call. - IF(KF.EQ.KFLAST) THEN - PYCOMP=KCLAST - RETURN - ENDIF - -C...Starting values. Remove internal diquark flags. - PYCOMP=0 - KFA=IABS(KF) - IF(MOD(KFA/10,10).EQ.0.AND.KFA.LT.100000 - & .AND.MOD(KFA/1000,10).GT.0) KFA=MOD(KFA,10000) - -C...Simple cases: direct translation. - IF(KFA.GT.KFORD(NFORD)) THEN - ELSEIF(KFA.LE.100) THEN - PYCOMP=KFA - -C...Else binary search. - ELSE - IMIN=100 - IMAX=NFORD+1 - 130 IAVG=(IMIN+IMAX)/2 - IF(KFORD(IAVG).GT.KFA) THEN - IMAX=IAVG - IF(IMAX.GT.IMIN+1) GOTO 130 - ELSEIF(KFORD(IAVG).LT.KFA) THEN - IMIN=IAVG - IF(IMAX.GT.IMIN+1) GOTO 130 - ELSE - PYCOMP=KCORD(IAVG) - ENDIF - ENDIF - -C...Check if antiparticle allowed. - IF(PYCOMP.NE.0.AND.KF.LT.0) THEN - IF(KCHG(PYCOMP,3).EQ.0) PYCOMP=0 - ENDIF - -C...Save codes for possible future fast action. - KFLAST=KF - KCLAST=PYCOMP - - RETURN - END - -C********************************************************************* - -C...PYCRTH -C...Auxiliary to PYEICG. -C -C THIS SUBROUTINE IS A TRANSLATION OF A COMPLEX ANALOGUE OF -C THE ALGOL PROCEDURE ORTHES, NUM. MATH. 12, 349-368(1968) -C BY MARTIN AND WILKINSON. -C HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). -C -C GIVEN A COMPLEX GENERAL MATRIX, THIS SUBROUTINE -C REDUCES A SUBMATRIX SITUATED IN ROWS AND COLUMNS -C LOW THROUGH IGH TO UPPER HESSENBERG FORM BY -C UNITARY SIMILARITY TRANSFORMATIONS. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX. -C -C LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING -C SUBROUTINE CBAL. IF CBAL HAS NOT BEEN USED, -C SET LOW=1, IGH=N. -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX INPUT MATRIX. -C -C ON OUTPUT -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE HESSENBERG MATRIX. INFORMATION -C ABOUT THE UNITARY TRANSFORMATIONS USED IN THE REDUCTION -C IS STORED IN THE REMAINING TRIANGLES UNDER THE -C HESSENBERG MATRIX. -C -C ORTR AND ORTI CONTAIN FURTHER INFORMATION ABOUT THE -C TRANSFORMATIONS. ONLY ELEMENTS LOW THROUGH IGH ARE USED. -C -C CALLS PYTHAG FOR DSQRT(A*A + B*B) . -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYCRTH(NM,N,LOW,IGH,AR,AI,ORTR,ORTI) - - INTEGER I,J,M,N,II,JJ,LA,MP,NM,IGH,KP1,LOW - DOUBLE PRECISION AR(4,4),AI(4,4),ORTR(4),ORTI(4) - DOUBLE PRECISION F,G,H,FI,FR,SCALE,PYTHAG - - LA = IGH - 1 - KP1 = LOW + 1 - IF (LA .LT. KP1) GOTO 210 -C - DO 200 M = KP1, LA - H = 0.0D0 - ORTR(M) = 0.0D0 - ORTI(M) = 0.0D0 - SCALE = 0.0D0 -C .......... SCALE COLUMN (ALGOL TOL THEN NOT NEEDED) .......... - DO 100 I = M, IGH - 100 SCALE = SCALE + DABS(AR(I,M-1)) + DABS(AI(I,M-1)) -C - IF (SCALE .EQ. 0.0D0) GOTO 200 - MP = M + IGH -C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... - DO 110 II = M, IGH - I = MP - II - ORTR(I) = AR(I,M-1) / SCALE - ORTI(I) = AI(I,M-1) / SCALE - H = H + ORTR(I) * ORTR(I) + ORTI(I) * ORTI(I) - 110 CONTINUE -C - G = DSQRT(H) - F = PYTHAG(ORTR(M),ORTI(M)) - IF (F .EQ. 0.0D0) GOTO 120 - H = H + F * G - G = G / F - ORTR(M) = (1.0D0 + G) * ORTR(M) - ORTI(M) = (1.0D0 + G) * ORTI(M) - GOTO 130 -C - 120 ORTR(M) = G - AR(M,M-1) = SCALE -C .......... FORM (I-(U*UT)/H) * A .......... - 130 DO 160 J = M, N - FR = 0.0D0 - FI = 0.0D0 -C .......... FOR I=IGH STEP -1 UNTIL M DO -- .......... - DO 140 II = M, IGH - I = MP - II - FR = FR + ORTR(I) * AR(I,J) + ORTI(I) * AI(I,J) - FI = FI + ORTR(I) * AI(I,J) - ORTI(I) * AR(I,J) - 140 CONTINUE -C - FR = FR / H - FI = FI / H -C - DO 150 I = M, IGH - AR(I,J) = AR(I,J) - FR * ORTR(I) + FI * ORTI(I) - AI(I,J) = AI(I,J) - FR * ORTI(I) - FI * ORTR(I) - 150 CONTINUE -C - 160 CONTINUE -C .......... FORM (I-(U*UT)/H)*A*(I-(U*UT)/H) .......... - DO 190 I = 1, IGH - FR = 0.0D0 - FI = 0.0D0 -C .......... FOR J=IGH STEP -1 UNTIL M DO -- .......... - DO 170 JJ = M, IGH - J = MP - JJ - FR = FR + ORTR(J) * AR(I,J) - ORTI(J) * AI(I,J) - FI = FI + ORTR(J) * AI(I,J) + ORTI(J) * AR(I,J) - 170 CONTINUE -C - FR = FR / H - FI = FI / H -C - DO 180 J = M, IGH - AR(I,J) = AR(I,J) - FR * ORTR(J) - FI * ORTI(J) - AI(I,J) = AI(I,J) + FR * ORTI(J) - FI * ORTR(J) - 180 CONTINUE -C - 190 CONTINUE -C - ORTR(M) = SCALE * ORTR(M) - ORTI(M) = SCALE * ORTI(M) - AR(M,M-1) = -G * AR(M,M-1) - AI(M,M-1) = -G * AI(M,M-1) - 200 CONTINUE -C - 210 RETURN - END - -C********************************************************************* - -C...PYCSRT -C...Auxiliary to PYCMQR -C -C (YR,YI) = COMPLEX DSQRT(XR,XI) -C BRANCH CHOSEN SO THAT YR .GE. 0.0 AND SIGN(YI) .EQ. SIGN(XI) -C - - SUBROUTINE PYCSRT(XR,XI,YR,YI) - - DOUBLE PRECISION XR,XI,YR,YI - DOUBLE PRECISION S,TR,TI,PYTHAG - - TR = XR - TI = XI - S = DSQRT(0.5D0*(PYTHAG(TR,TI) + DABS(TR))) - IF (TR .GE. 0.0D0) YR = S - IF (TI .LT. 0.0D0) S = -S - IF (TR .LE. 0.0D0) YI = S - IF (TR .LT. 0.0D0) YR = 0.5D0*(TI/YI) - IF (TR .GT. 0.0D0) YI = 0.5D0*(TI/YR) - RETURN - END - -C********************************************************************* - -C...PYCT5L -C...Auxiliary function for parametrization of CTEQ5L. -C...Author: J. Pumplin 9/99. - -C...CTEQ5M1 and CTEQ5L Parton Distribution Functions -C...in Parametrized Form -C... September 15, 1999 -C -C...Ref: "GLOBAL QCD ANALYSIS OF PARTON STRUCTURE OF THE NUCLEON: -C... CTEQ5 PPARTON DISTRIBUTIONS" -C...hep-ph/9903282 - -C...The CTEQ5M1 set given here is an updated version of the original -C...CTEQ5M set posted, in the table version, on the Web page of CTEQ. -C...The differences between CTEQ5M and CTEQ5M1 are insignificant for -C...almost all applications. -C...The improvement is in the QCD evolution which is now more -C...accurate, and which agrees completely with the benchmark work -C...of the HERA 96/97 Workshop. -C...The differences between the parametrized and the corresponding -C...table versions (on which it is based) are of similar order as -C...between the two version. - -C...!! Because accurate parametrizations over a wide range of (x,Q) -C...is hard to obtain, only the most widely used sets CTEQ5M and -C...CTEQ5L are available in parametrized form for now. - -C...These parametrizations were obtained by Jon Pumplin. - -C Iset PDF Description Alpha_s(Mz) Lam4 Lam5 -C ------------------------------------------------------------------- -C 1 CTEQ5M1 Standard NLO MSbar scheme 0.118 326 226 -C 3 CTEQ5L Leading Order 0.127 192 146 -C ------------------------------------------------------------------- -C...Note the Qcd-lambda values given for CTEQ5L is for the leading -C...order form of Alpha_s!! Alpha_s(Mz) gives the absolute -C...calibration. - -C...The two Iset value are adopted to agree with the standard table -C...versions. - -C...Range of validity: -C...The range of (x, Q) covered by this parametrization of the QCD -C...evolved parton distributions is 1E-6 < x < 1 ; -C...1.1 GeV < Q < 10 TeV. Of course, the PDF's are constrained by -C...data only in a subset of that region; and the assumed DGLAP -C...evolution is unlikely to be valid for all of it either. - -C...The range of (x, Q) used in the CTEQ5 round of global analysis is -C...approximately 0.01 < x < 0.75 ; and 4 GeV^2 < Q^2 < 400 GeV^2 for -C...fixed target experiments; 0.0001 < x < 0.3 from HERA data; and -C...Q^2 up to 40,000 GeV^2 from Tevatron inclusive Jet data. - - FUNCTION PYCT5L(IFL,X,Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - - PARAMETER (NEX=8, NLF=2) - DIMENSION AM(0:NEX,0:NLF,-5:2) - DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) - DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) - DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) - DIMENSION AF(0:NEX) - - DATA MEXVEC( 2) / 8 / - DATA MLFVEC( 2) / 2 / - DATA UT1VEC( 2) / 0.4971265E+01 / - DATA UT2VEC( 2) / -0.1105128E+01 / - DATA ALFVEC( 2) / 0.2987216E+00 / - DATA QMAVEC( 2) / 0.0000000E+00 / - DATA (AM( 0,K, 2),K=0, 2) - & / 0.5292616E+01, -0.2751910E+01, -0.2488990E+01 / - DATA (AM( 1,K, 2),K=0, 2) - & / 0.9714424E+00, 0.1011827E-01, -0.1023660E-01 / - DATA (AM( 2,K, 2),K=0, 2) - & / -0.1651006E+02, 0.7959721E+01, 0.8810563E+01 / - DATA (AM( 3,K, 2),K=0, 2) - & / -0.1643394E+02, 0.5892854E+01, 0.9348874E+01 / - DATA (AM( 4,K, 2),K=0, 2) - & / 0.3067422E+02, 0.4235796E+01, -0.5112136E+00 / - DATA (AM( 5,K, 2),K=0, 2) - & / 0.2352526E+02, -0.5305168E+01, -0.1169174E+02 / - DATA (AM( 6,K, 2),K=0, 2) - & / -0.1095451E+02, 0.3006577E+01, 0.5638136E+01 / - DATA (AM( 7,K, 2),K=0, 2) - & / -0.1172251E+02, -0.2183624E+01, 0.4955794E+01 / - DATA (AM( 8,K, 2),K=0, 2) - & / 0.1662533E-01, 0.7622870E-02, -0.4895887E-03 / - - DATA MEXVEC( 1) / 8 / - DATA MLFVEC( 1) / 2 / - DATA UT1VEC( 1) / 0.2612618E+01 / - DATA UT2VEC( 1) / -0.1258304E+06 / - DATA ALFVEC( 1) / 0.3407552E+00 / - DATA QMAVEC( 1) / 0.0000000E+00 / - DATA (AM( 0,K, 1),K=0, 2) - & / 0.9905300E+00, -0.4502235E+00, 0.1624441E+00 / - DATA (AM( 1,K, 1),K=0, 2) - & / 0.8867534E+00, 0.1630829E-01, -0.4049085E-01 / - DATA (AM( 2,K, 1),K=0, 2) - & / 0.8547974E+00, 0.3336301E+00, 0.1371388E+00 / - DATA (AM( 3,K, 1),K=0, 2) - & / 0.2941113E+00, -0.1527905E+01, 0.2331879E+00 / - DATA (AM( 4,K, 1),K=0, 2) - & / 0.3384235E+02, 0.3715315E+01, 0.8276930E+00 / - DATA (AM( 5,K, 1),K=0, 2) - & / 0.6230115E+01, 0.3134639E+01, -0.1729099E+01 / - DATA (AM( 6,K, 1),K=0, 2) - & / -0.1186928E+01, -0.3282460E+00, 0.1052020E+00 / - DATA (AM( 7,K, 1),K=0, 2) - & / -0.8545702E+01, -0.6247947E+01, 0.3692561E+01 / - DATA (AM( 8,K, 1),K=0, 2) - & / 0.1724598E-01, 0.7120465E-02, 0.4003646E-04 / - - DATA MEXVEC( 0) / 8 / - DATA MLFVEC( 0) / 2 / - DATA UT1VEC( 0) / -0.4656819E+00 / - DATA UT2VEC( 0) / -0.2742390E+03 / - DATA ALFVEC( 0) / 0.4491863E+00 / - DATA QMAVEC( 0) / 0.0000000E+00 / - DATA (AM( 0,K, 0),K=0, 2) - & / 0.1193572E+03, -0.3886845E+01, -0.1133965E+01 / - DATA (AM( 1,K, 0),K=0, 2) - & / -0.9421449E+02, 0.3995885E+01, 0.1607363E+01 / - DATA (AM( 2,K, 0),K=0, 2) - & / 0.4206383E+01, 0.2485954E+00, 0.2497468E+00 / - DATA (AM( 3,K, 0),K=0, 2) - & / 0.1210557E+03, -0.3015765E+01, -0.1423651E+01 / - DATA (AM( 4,K, 0),K=0, 2) - & / -0.1013897E+03, -0.7113478E+00, 0.2621865E+00 / - DATA (AM( 5,K, 0),K=0, 2) - & / -0.1312404E+01, -0.9297691E+00, -0.1562531E+00 / - DATA (AM( 6,K, 0),K=0, 2) - & / 0.1627137E+01, 0.4954111E+00, -0.6387009E+00 / - DATA (AM( 7,K, 0),K=0, 2) - & / 0.1537698E+00, -0.2487878E+00, 0.8305947E+00 / - DATA (AM( 8,K, 0),K=0, 2) - & / 0.2496448E-01, 0.2457823E-02, 0.8234276E-03 / - - DATA MEXVEC(-1) / 8 / - DATA MLFVEC(-1) / 2 / - DATA UT1VEC(-1) / 0.3862583E+01 / - DATA UT2VEC(-1) / -0.1265969E+01 / - DATA ALFVEC(-1) / 0.2457668E+00 / - DATA QMAVEC(-1) / 0.0000000E+00 / - DATA (AM( 0,K,-1),K=0, 2) - & / 0.2647441E+02, 0.1059277E+02, -0.9176654E+00 / - DATA (AM( 1,K,-1),K=0, 2) - & / 0.1990636E+01, 0.8558918E-01, 0.4248667E-01 / - DATA (AM( 2,K,-1),K=0, 2) - & / -0.1476095E+02, -0.3276255E+02, 0.1558110E+01 / - DATA (AM( 3,K,-1),K=0, 2) - & / -0.2966889E+01, -0.3649037E+02, 0.1195914E+01 / - DATA (AM( 4,K,-1),K=0, 2) - & / -0.1000519E+03, -0.2464635E+01, 0.1964849E+00 / - DATA (AM( 5,K,-1),K=0, 2) - & / 0.3718331E+02, 0.4700389E+02, -0.2772142E+01 / - DATA (AM( 6,K,-1),K=0, 2) - & / -0.1872722E+02, -0.2291189E+02, 0.1089052E+01 / - DATA (AM( 7,K,-1),K=0, 2) - & / -0.1628146E+02, -0.1823993E+02, 0.2537369E+01 / - DATA (AM( 8,K,-1),K=0, 2) - & / -0.1156300E+01, -0.1280495E+00, 0.5153245E-01 / - - DATA MEXVEC(-2) / 7 / - DATA MLFVEC(-2) / 2 / - DATA UT1VEC(-2) / 0.1895615E+00 / - DATA UT2VEC(-2) / -0.3069097E+01 / - DATA ALFVEC(-2) / 0.5293999E+00 / - DATA QMAVEC(-2) / 0.0000000E+00 / - DATA (AM( 0,K,-2),K=0, 2) - & / -0.6556775E+00, 0.2490190E+00, 0.3966485E-01 / - DATA (AM( 1,K,-2),K=0, 2) - & / 0.1305102E+01, -0.1188925E+00, -0.4600870E-02 / - DATA (AM( 2,K,-2),K=0, 2) - & / -0.2371436E+01, 0.3566814E+00, -0.2834683E+00 / - DATA (AM( 3,K,-2),K=0, 2) - & / -0.6152826E+01, 0.8339877E+00, -0.7233230E+00 / - DATA (AM( 4,K,-2),K=0, 2) - & / -0.8346558E+01, 0.2892168E+01, 0.2137099E+00 / - DATA (AM( 5,K,-2),K=0, 2) - & / 0.1279530E+02, 0.1021114E+00, 0.5787439E+00 / - DATA (AM( 6,K,-2),K=0, 2) - & / 0.5858816E+00, -0.1940375E+01, -0.4029269E+00 / - DATA (AM( 7,K,-2),K=0, 2) - & / -0.2795725E+02, -0.5263392E+00, 0.1290229E+01 / - - DATA MEXVEC(-3) / 7 / - DATA MLFVEC(-3) / 2 / - DATA UT1VEC(-3) / 0.3753257E+01 / - DATA UT2VEC(-3) / -0.1113085E+01 / - DATA ALFVEC(-3) / 0.3713141E+00 / - DATA QMAVEC(-3) / 0.0000000E+00 / - DATA (AM( 0,K,-3),K=0, 2) - & / 0.1580931E+01, -0.2273826E+01, -0.1822245E+01 / - DATA (AM( 1,K,-3),K=0, 2) - & / 0.2702644E+01, 0.6763243E+00, 0.7231586E-02 / - DATA (AM( 2,K,-3),K=0, 2) - & / -0.1857924E+02, 0.3907500E+01, 0.5850109E+01 / - DATA (AM( 3,K,-3),K=0, 2) - & / -0.3044793E+02, 0.2639332E+01, 0.5566644E+01 / - DATA (AM( 4,K,-3),K=0, 2) - & / -0.4258011E+01, -0.5429244E+01, 0.4418946E+00 / - DATA (AM( 5,K,-3),K=0, 2) - & / 0.3465259E+02, -0.5532604E+01, -0.4904153E+01 / - DATA (AM( 6,K,-3),K=0, 2) - & / -0.1658858E+02, 0.2923275E+01, 0.2266286E+01 / - DATA (AM( 7,K,-3),K=0, 2) - & / -0.1149263E+02, 0.2877475E+01, -0.7999105E+00 / - - DATA MEXVEC(-4) / 7 / - DATA MLFVEC(-4) / 2 / - DATA UT1VEC(-4) / 0.4400772E+01 / - DATA UT2VEC(-4) / -0.1356116E+01 / - DATA ALFVEC(-4) / 0.3712017E-01 / - DATA QMAVEC(-4) / 0.1300000E+01 / - DATA (AM( 0,K,-4),K=0, 2) - & / -0.8293661E+00, -0.3982375E+01, -0.6494283E-01 / - DATA (AM( 1,K,-4),K=0, 2) - & / 0.2754618E+01, 0.8338636E+00, -0.6885160E-01 / - DATA (AM( 2,K,-4),K=0, 2) - & / -0.1657987E+02, 0.1439143E+02, -0.6887240E+00 / - DATA (AM( 3,K,-4),K=0, 2) - & / -0.2800703E+02, 0.1535966E+02, -0.7377693E+00 / - DATA (AM( 4,K,-4),K=0, 2) - & / -0.6460216E+01, -0.4783019E+01, 0.4913297E+00 / - DATA (AM( 5,K,-4),K=0, 2) - & / 0.3141830E+02, -0.3178031E+02, 0.7136013E+01 / - DATA (AM( 6,K,-4),K=0, 2) - & / -0.1802509E+02, 0.1862163E+02, -0.4632843E+01 / - DATA (AM( 7,K,-4),K=0, 2) - & / -0.1240412E+02, 0.2565386E+02, -0.1066570E+02 / - - DATA MEXVEC(-5) / 6 / - DATA MLFVEC(-5) / 2 / - DATA UT1VEC(-5) / 0.5562568E+01 / - DATA UT2VEC(-5) / -0.1801317E+01 / - DATA ALFVEC(-5) / 0.4952010E-02 / - DATA QMAVEC(-5) / 0.4500000E+01 / - DATA (AM( 0,K,-5),K=0, 2) - & / -0.6031237E+01, 0.1992727E+01, -0.1076331E+01 / - DATA (AM( 1,K,-5),K=0, 2) - & / 0.2933912E+01, 0.5839674E+00, 0.7509435E-01 / - DATA (AM( 2,K,-5),K=0, 2) - & / -0.8284919E+01, 0.1488593E+01, -0.8251678E+00 / - DATA (AM( 3,K,-5),K=0, 2) - & / -0.1925986E+02, 0.2805753E+01, -0.3015446E+01 / - DATA (AM( 4,K,-5),K=0, 2) - & / -0.9480483E+01, -0.9767837E+00, -0.1165544E+01 / - DATA (AM( 5,K,-5),K=0, 2) - & / 0.2193195E+02, -0.1788518E+02, 0.9460908E+01 / - DATA (AM( 6,K,-5),K=0, 2) - & / -0.1327377E+02, 0.1201754E+02, -0.6277844E+01 / - - IF(Q .LE. QMAVEC(IFL)) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - IF(X .GE. 1.D0) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - TMP = LOG(Q/ALFVEC(IFL)) - IF(TMP .LE. 0.D0) THEN - PYCT5L = 0.D0 - RETURN - ENDIF - - SB = LOG(TMP) - SB1 = SB - 1.2D0 - SB2 = SB1*SB1 - - DO 110 I = 0, NEX - AF(I) = 0.D0 - SBX = 1.D0 - DO 100 K = 0, MLFVEC(IFL) - AF(I) = AF(I) + SBX*AM(I,K,IFL) - SBX = SB1*SBX - 100 CONTINUE - 110 CONTINUE - - Y = -LOG(X) - U = LOG(X/0.00001D0) - - PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) - PART2 = AF(0)*(1.D0 - X) + AF(3)*X - PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) - PART4 = UT1VEC(IFL)*LOG(1.D0-X) + - & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) - - PYCT5L = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) - -C...Include threshold factor. - PYCT5L = PYCT5L * (1.D0 - QMAVEC(IFL)/Q) - - RETURN - END - -C********************************************************************* - -C...PYCT5M -C...Auxiliary function for parametrization of CTEQ5M1. -C...Author: J. Pumplin 9/99. - - FUNCTION PYCT5M(IFL,X,Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - - PARAMETER (NEX=8, NLF=2) - DIMENSION AM(0:NEX,0:NLF,-5:2) - DIMENSION ALFVEC(-5:2), QMAVEC(-5:2) - DIMENSION MEXVEC(-5:2), MLFVEC(-5:2) - DIMENSION UT1VEC(-5:2), UT2VEC(-5:2) - DIMENSION AF(0:NEX) - - DATA MEXVEC( 2) / 8 / - DATA MLFVEC( 2) / 2 / - DATA UT1VEC( 2) / 0.5141718E+01 / - DATA UT2VEC( 2) / -0.1346944E+01 / - DATA ALFVEC( 2) / 0.5260555E+00 / - DATA QMAVEC( 2) / 0.0000000E+00 / - DATA (AM( 0,K, 2),K=0, 2) - & / 0.4289071E+01, -0.2536870E+01, -0.1259948E+01 / - DATA (AM( 1,K, 2),K=0, 2) - & / 0.9839410E+00, 0.4168426E-01, -0.5018952E-01 / - DATA (AM( 2,K, 2),K=0, 2) - & / -0.1651961E+02, 0.9246261E+01, 0.5996400E+01 / - DATA (AM( 3,K, 2),K=0, 2) - & / -0.2077936E+02, 0.9786469E+01, 0.7656465E+01 / - DATA (AM( 4,K, 2),K=0, 2) - & / 0.3054926E+02, 0.1889536E+01, 0.1380541E+01 / - DATA (AM( 5,K, 2),K=0, 2) - & / 0.3084695E+02, -0.1212303E+02, -0.1053551E+02 / - DATA (AM( 6,K, 2),K=0, 2) - & / -0.1426778E+02, 0.6239537E+01, 0.5254819E+01 / - DATA (AM( 7,K, 2),K=0, 2) - & / -0.1909811E+02, 0.3695678E+01, 0.5495729E+01 / - DATA (AM( 8,K, 2),K=0, 2) - & / 0.1889751E-01, 0.5027193E-02, 0.6624896E-03 / - - DATA MEXVEC( 1) / 8 / - DATA MLFVEC( 1) / 2 / - DATA UT1VEC( 1) / 0.4138426E+01 / - DATA UT2VEC( 1) / -0.3221374E+01 / - DATA ALFVEC( 1) / 0.4960962E+00 / - DATA QMAVEC( 1) / 0.0000000E+00 / - DATA (AM( 0,K, 1),K=0, 2) - & / 0.1332497E+01, -0.3703718E+00, 0.1288638E+00 / - DATA (AM( 1,K, 1),K=0, 2) - & / 0.7544687E+00, 0.3255075E-01, -0.4706680E-01 / - DATA (AM( 2,K, 1),K=0, 2) - & / -0.7638814E+00, 0.5008313E+00, -0.9237374E-01 / - DATA (AM( 3,K, 1),K=0, 2) - & / -0.3689889E+00, -0.1055098E+01, -0.4645065E+00 / - DATA (AM( 4,K, 1),K=0, 2) - & / 0.3991610E+02, 0.1979881E+01, 0.1775814E+01 / - DATA (AM( 5,K, 1),K=0, 2) - & / 0.6201080E+01, 0.2046288E+01, 0.3804571E+00 / - DATA (AM( 6,K, 1),K=0, 2) - & / -0.8027900E+00, -0.7011688E+00, -0.8049612E+00 / - DATA (AM( 7,K, 1),K=0, 2) - & / -0.8631305E+01, -0.3981200E+01, 0.6970153E+00 / - DATA (AM( 8,K, 1),K=0, 2) - & / 0.2371230E-01, 0.5372683E-02, 0.1118701E-02 / - - DATA MEXVEC( 0) / 8 / - DATA MLFVEC( 0) / 2 / - DATA UT1VEC( 0) / -0.1026789E+01 / - DATA UT2VEC( 0) / -0.9051707E+01 / - DATA ALFVEC( 0) / 0.9462977E+00 / - DATA QMAVEC( 0) / 0.0000000E+00 / - DATA (AM( 0,K, 0),K=0, 2) - & / 0.1191990E+03, -0.8548739E+00, -0.1963040E+01 / - DATA (AM( 1,K, 0),K=0, 2) - & / -0.9449972E+02, 0.1074771E+01, 0.2056055E+01 / - DATA (AM( 2,K, 0),K=0, 2) - & / 0.3701064E+01, -0.1167947E-02, 0.1933573E+00 / - DATA (AM( 3,K, 0),K=0, 2) - & / 0.1171345E+03, -0.1064540E+01, -0.1875312E+01 / - DATA (AM( 4,K, 0),K=0, 2) - & / -0.1014453E+03, -0.5707427E+00, 0.4511242E-01 / - DATA (AM( 5,K, 0),K=0, 2) - & / 0.6365168E+01, 0.1275354E+01, -0.4964081E+00 / - DATA (AM( 6,K, 0),K=0, 2) - & / -0.3370693E+01, -0.1122020E+01, 0.5947751E-01 / - DATA (AM( 7,K, 0),K=0, 2) - & / -0.5327270E+01, -0.9293556E+00, 0.6629940E+00 / - DATA (AM( 8,K, 0),K=0, 2) - & / 0.2437513E-01, 0.1600939E-02, 0.6855336E-03 / - - DATA MEXVEC(-1) / 8 / - DATA MLFVEC(-1) / 2 / - DATA UT1VEC(-1) / 0.5243571E+01 / - DATA UT2VEC(-1) / -0.2870513E+01 / - DATA ALFVEC(-1) / 0.6701448E+00 / - DATA QMAVEC(-1) / 0.0000000E+00 / - DATA (AM( 0,K,-1),K=0, 2) - & / 0.2428863E+02, 0.1907035E+01, -0.4606457E+00 / - DATA (AM( 1,K,-1),K=0, 2) - & / 0.2006810E+01, -0.1265915E+00, 0.7153556E-02 / - DATA (AM( 2,K,-1),K=0, 2) - & / -0.1884546E+02, -0.2339471E+01, 0.5740679E+01 / - DATA (AM( 3,K,-1),K=0, 2) - & / -0.2527892E+02, -0.2044124E+01, 0.1280470E+02 / - DATA (AM( 4,K,-1),K=0, 2) - & / -0.1013824E+03, -0.1594199E+01, 0.2216401E+00 / - DATA (AM( 5,K,-1),K=0, 2) - & / 0.8070930E+02, 0.1792072E+01, -0.2164364E+02 / - DATA (AM( 6,K,-1),K=0, 2) - & / -0.4641050E+02, 0.1977338E+00, 0.1273014E+02 / - DATA (AM( 7,K,-1),K=0, 2) - & / -0.3910568E+02, 0.1719632E+01, 0.1086525E+02 / - DATA (AM( 8,K,-1),K=0, 2) - & / -0.1185496E+01, -0.1905847E+00, -0.8744118E-03 / - - DATA MEXVEC(-2) / 7 / - DATA MLFVEC(-2) / 2 / - DATA UT1VEC(-2) / 0.4782210E+01 / - DATA UT2VEC(-2) / -0.1976856E+02 / - DATA ALFVEC(-2) / 0.7558374E+00 / - DATA QMAVEC(-2) / 0.0000000E+00 / - DATA (AM( 0,K,-2),K=0, 2) - & / -0.6216935E+00, 0.2369963E+00, -0.7909949E-02 / - DATA (AM( 1,K,-2),K=0, 2) - & / 0.1245440E+01, -0.1031510E+00, 0.4916523E-02 / - DATA (AM( 2,K,-2),K=0, 2) - & / -0.7060824E+01, -0.3875283E-01, 0.1784981E+00 / - DATA (AM( 3,K,-2),K=0, 2) - & / -0.7430595E+01, 0.1964572E+00, -0.1284999E+00 / - DATA (AM( 4,K,-2),K=0, 2) - & / -0.6897810E+01, 0.2620543E+01, 0.8012553E-02 / - DATA (AM( 5,K,-2),K=0, 2) - & / 0.1507713E+02, 0.2340307E-01, 0.2482535E+01 / - DATA (AM( 6,K,-2),K=0, 2) - & / -0.1815341E+01, -0.1538698E+01, -0.2014208E+01 / - DATA (AM( 7,K,-2),K=0, 2) - & / -0.2571932E+02, 0.2903941E+00, -0.2848206E+01 / - - DATA MEXVEC(-3) / 7 / - DATA MLFVEC(-3) / 2 / - DATA UT1VEC(-3) / 0.4518239E+01 / - DATA UT2VEC(-3) / -0.2690590E+01 / - DATA ALFVEC(-3) / 0.6124079E+00 / - DATA QMAVEC(-3) / 0.0000000E+00 / - DATA (AM( 0,K,-3),K=0, 2) - & / -0.2734458E+01, -0.7245673E+00, -0.6351374E+00 / - DATA (AM( 1,K,-3),K=0, 2) - & / 0.2927174E+01, 0.4822709E+00, -0.1088787E-01 / - DATA (AM( 2,K,-3),K=0, 2) - & / -0.1771017E+02, -0.1416635E+01, 0.8467622E+01 / - DATA (AM( 3,K,-3),K=0, 2) - & / -0.4972782E+02, -0.3348547E+01, 0.1767061E+02 / - DATA (AM( 4,K,-3),K=0, 2) - & / -0.7102770E+01, -0.3205337E+01, 0.4101704E+00 / - DATA (AM( 5,K,-3),K=0, 2) - & / 0.7169698E+02, -0.2205985E+01, -0.2463931E+02 / - DATA (AM( 6,K,-3),K=0, 2) - & / -0.4090347E+02, 0.2103486E+01, 0.1416507E+02 / - DATA (AM( 7,K,-3),K=0, 2) - & / -0.2952639E+02, 0.5376136E+01, 0.7825585E+01 / - - DATA MEXVEC(-4) / 7 / - DATA MLFVEC(-4) / 2 / - DATA UT1VEC(-4) / 0.2783230E+01 / - DATA UT2VEC(-4) / -0.1746328E+01 / - DATA ALFVEC(-4) / 0.1115653E+01 / - DATA QMAVEC(-4) / 0.1300000E+01 / - DATA (AM( 0,K,-4),K=0, 2) - & / -0.1743872E+01, -0.1128921E+01, -0.2841969E+00 / - DATA (AM( 1,K,-4),K=0, 2) - & / 0.3345755E+01, 0.3187765E+00, 0.1378124E+00 / - DATA (AM( 2,K,-4),K=0, 2) - & / -0.2037615E+02, 0.4121687E+01, 0.2236520E+00 / - DATA (AM( 3,K,-4),K=0, 2) - & / -0.4703104E+02, 0.5353087E+01, -0.1455347E+01 / - DATA (AM( 4,K,-4),K=0, 2) - & / -0.1060230E+02, -0.1551122E+01, -0.1078863E+01 / - DATA (AM( 5,K,-4),K=0, 2) - & / 0.5088892E+02, -0.8197304E+01, 0.8083451E+01 / - DATA (AM( 6,K,-4),K=0, 2) - & / -0.2819070E+02, 0.4554086E+01, -0.5890995E+01 / - DATA (AM( 7,K,-4),K=0, 2) - & / -0.1098238E+02, 0.2590096E+01, -0.8062879E+01 / - - DATA MEXVEC(-5) / 6 / - DATA MLFVEC(-5) / 2 / - DATA UT1VEC(-5) / 0.1619654E+02 / - DATA UT2VEC(-5) / -0.3367346E+01 / - DATA ALFVEC(-5) / 0.5109891E-02 / - DATA QMAVEC(-5) / 0.4500000E+01 / - DATA (AM( 0,K,-5),K=0, 2) - & / -0.6800138E+01, 0.2493627E+01, -0.1075724E+01 / - DATA (AM( 1,K,-5),K=0, 2) - & / 0.3036555E+01, 0.3324733E+00, 0.2008298E+00 / - DATA (AM( 2,K,-5),K=0, 2) - & / -0.5203879E+01, -0.8493476E+01, -0.4523208E+01 / - DATA (AM( 3,K,-5),K=0, 2) - & / -0.1524239E+01, -0.3411912E+01, -0.1771867E+02 / - DATA (AM( 4,K,-5),K=0, 2) - & / -0.1099444E+02, 0.1320930E+01, -0.2353831E+01 / - DATA (AM( 5,K,-5),K=0, 2) - & / 0.1699299E+02, -0.3565802E+02, 0.3566872E+02 / - DATA (AM( 6,K,-5),K=0, 2) - & / -0.1465793E+02, 0.2703365E+02, -0.2176372E+02 / - - IF(Q .LE. QMAVEC(IFL)) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - IF(X .GE. 1.D0) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - TMP = LOG(Q/ALFVEC(IFL)) - IF(TMP .LE. 0.D0) THEN - PYCT5M = 0.D0 - RETURN - ENDIF - - SB = LOG(TMP) - SB1 = SB - 1.2D0 - SB2 = SB1*SB1 - - DO 110 I = 0, NEX - AF(I) = 0.D0 - SBX = 1.D0 - DO 100 K = 0, MLFVEC(IFL) - AF(I) = AF(I) + SBX*AM(I,K,IFL) - SBX = SB1*SBX - 100 CONTINUE - 110 CONTINUE - - Y = -LOG(X) - U = LOG(X/0.00001D0) - - PART1 = AF(1)*Y**(1.D0+0.01D0*AF(4))*(1.D0+ AF(8)*U) - PART2 = AF(0)*(1.D0 - X) + AF(3)*X - PART3 = X*(1.D0-X)*(AF(5)+AF(6)*(1.D0-X)+AF(7)*X*(1.D0-X)) - PART4 = UT1VEC(IFL)*LOG(1.D0-X) + - & AF(2)*LOG(1.D0+EXP(UT2VEC(IFL))-X) - - PYCT5M = EXP(LOG(X) + PART1 + PART2 + PART3 + PART4) - -C...Include threshold factor. - PYCT5M = PYCT5M * (1.D0 - QMAVEC(IFL)/Q) - - RETURN - END - -C********************************************************************* - -C...PYCTEQ -C...Gives the CTEQ 3 parton distribution function sets in -C...parametrized form, of October 24, 1994. -C...Authors: H.L. Lai, J. Botts, J. Huston, J.G. Morfin, J.F. Owens, -C...J. Qiu, W.K. Tung and H. Weerts. - - FUNCTION PYCTEQ (ISET, IPRT, X, Q) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Data on Lambda values of fits, minimum Q and quark masses. - DIMENSION ALM(3), QMS(4:6) - DATA ALM / 0.177D0, 0.239D0, 0.247D0 / - DATA QMN / 1.60D0 /, (QMS(I), I=4,6) / 1.60D0, 5.00D0, 180.0D0 / - -C....Check flavour thresholds. Set up QI for SB. - IP = IABS(IPRT) - IF(IP .GE. 4) THEN - IF(Q .LE. QMS(IP)) THEN - PYCTEQ = 0D0 - RETURN - ENDIF - QI = QMS(IP) - ELSE - QI = QMN - ENDIF - -C...Use "standard lambda" of parametrization program for expansion. - ALAM = ALM (ISET) - SBL = LOG(Q/ALAM) / LOG(QI/ALAM) - SB = LOG (SBL) - SB2 = SB*SB - SB3 = SB2*SB - -C...Expansion for CTEQ3L. - IF(ISET .EQ. 1) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.1907D+00+0.4205D-01*SB +0.2752D+00*SB2- - & 0.3171D+00*SB3) - A1= 0.4611D+00+0.2331D-01*SB -0.3403D-01*SB2+0.3174D-01*SB3 - A2= 0.3504D+01+0.5739D+00*SB +0.2676D+00*SB2-0.1553D+00*SB3 - A3= 0.7452D+01-0.6742D+01*SB +0.2849D+01*SB2-0.1964D+00*SB3 - A4= 0.1116D+01-0.3435D+00*SB +0.2865D+00*SB2-0.1288D+00*SB3 - A5= 0.6659D-01+0.2714D+00*SB -0.2688D+00*SB2+0.2763D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp( 0.1141D+00+0.4764D+00*SB -0.1745D+01*SB2+ - & 0.7728D+00*SB3) - A1= 0.4275D+00-0.1290D+00*SB +0.3609D+00*SB2-0.1689D+00*SB3 - A2= 0.3000D+01+0.2946D+01*SB -0.4117D+01*SB2+0.1989D+01*SB3 - A3=-0.1302D+01+0.2322D+01*SB -0.4258D+01*SB2+0.2109D+01*SB3 - A4= 0.2586D+01-0.1920D+00*SB -0.3754D+00*SB2+0.2731D+00*SB3 - A5=-0.2251D+00-0.5374D+00*SB +0.2245D+01*SB2-0.1034D+01*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.7631D+00-0.7241D+00*SB -0.1170D+01*SB2+ - & 0.5343D+00*SB3) - A1=-0.3573D+00+0.3469D+00*SB -0.3396D+00*SB2+0.9188D-01*SB3 - A2= 0.5604D+01+0.7458D+00*SB -0.5082D+00*SB2+0.1844D+00*SB3 - A3= 0.1549D+02-0.1809D+02*SB +0.1162D+02*SB2-0.3483D+01*SB3 - A4= 0.9881D+00+0.1364D+00*SB -0.4421D+00*SB2+0.2051D+00*SB3 - A5=-0.9505D-01+0.3259D+01*SB -0.1547D+01*SB2+0.2918D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2449D+01-0.3513D+01*SB +0.4529D+01*SB2- - & 0.2031D+01*SB3) - A1=-0.4050D+00+0.3411D+00*SB -0.3669D+00*SB2+0.1109D+00*SB3 - A2= 0.7470D+01-0.2982D+01*SB +0.5503D+01*SB2-0.2419D+01*SB3 - A3= 0.1503D+02+0.1638D+01*SB -0.8772D+01*SB2+0.3852D+01*SB3 - A4= 0.1137D+01-0.1006D+01*SB +0.1485D+01*SB2-0.6389D+00*SB3 - A5=-0.5299D+00+0.3160D+01*SB -0.3104D+01*SB2+0.1219D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.2740D+01-0.7987D-01*SB -0.9015D+00*SB2- - & 0.9872D-01*SB3) - A1=-0.3909D+00+0.1244D+00*SB -0.4487D-01*SB2+0.1277D-01*SB3 - A2= 0.9163D+01+0.2823D+00*SB -0.7720D+00*SB2-0.9360D-02*SB3 - A3= 0.1080D+02-0.3915D+01*SB -0.1153D+01*SB2+0.2649D+01*SB3 - A4= 0.9894D+00-0.1647D+00*SB -0.9426D-02*SB2+0.2945D-02*SB3 - A5=-0.3395D+00+0.6998D+00*SB +0.7000D+00*SB2-0.6730D-01*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3640D+01+0.1250D+01*SB -0.2914D+01*SB2+ - & 0.8390D+00*SB3) - A1=-0.3595D+00-0.5259D-01*SB +0.3122D+00*SB2-0.1642D+00*SB3 - A2= 0.7305D+01+0.9727D+00*SB -0.9788D+00*SB2-0.5193D-01*SB3 - A3= 0.1198D+02-0.1799D+02*SB +0.2614D+02*SB2-0.1091D+02*SB3 - A4= 0.9882D+00-0.6101D+00*SB +0.9737D+00*SB2-0.4935D+00*SB3 - A5=-0.1186D+00-0.3231D+00*SB +0.3074D+01*SB2-0.1274D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1122D+01*Exp(-0.3718D+01-0.1335D+01*SB + - & 0.1651D-01*SB2) - A1=-0.4719D+00+0.7509D+00*SB -0.8420D+00*SB2+0.2901D+00*SB3 - A2= 0.6194D+01-0.1641D+01*SB +0.4907D+01*SB2-0.2523D+01*SB3 - A3= 0.4426D+01-0.4270D+01*SB +0.6581D+01*SB2-0.3474D+01*SB3 - A4= 0.2683D+00+0.9876D+00*SB -0.7612D+00*SB2+0.1780D+00*SB3 - A5=-0.4547D+00+0.4410D+01*SB -0.3712D+01*SB2+0.1245D+01*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9838D+00*Exp(-0.2548D+01-0.7660D+01*SB + - & 0.3702D+01*SB2) - A1=-0.3122D+00-0.2120D+00*SB +0.5716D+00*SB2-0.3773D+00*SB3 - A2= 0.6257D+01-0.8214D-01*SB -0.2537D+01*SB2+0.2981D+01*SB3 - A3=-0.6723D+00+0.2131D+01*SB +0.9599D+01*SB2-0.7910D+01*SB3 - A4= 0.9169D-01+0.4295D-01*SB -0.5017D+00*SB2+0.3811D+00*SB3 - A5= 0.2402D+00+0.2656D+01*SB -0.1586D+01*SB2+0.2880D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1001D+01*Exp(-0.6934D+01+0.3050D+01*SB - - & 0.6943D+00*SB2) - A1=-0.1713D+00-0.5167D+00*SB +0.1241D+01*SB2-0.1703D+01*SB3 - A2= 0.6169D+01+0.3023D+01*SB -0.1972D+02*SB2+0.1069D+02*SB3 - A3= 0.4439D+01-0.1746D+02*SB +0.1225D+02*SB2+0.8350D+00*SB3 - A4= 0.5458D+00-0.4586D+00*SB +0.9089D+00*SB2-0.4049D+00*SB3 - A5= 0.3207D+01-0.3362D+01*SB +0.5877D+01*SB2-0.7659D+01*SB3 - ENDIF - -C...Expansion for CTEQ3M. - ELSEIF(ISET .EQ. 2) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.2259D+00+0.1237D+00*SB +0.3035D+00*SB2- - & 0.2935D+00*SB3) - A1= 0.5085D+00+0.1651D-01*SB -0.3592D-01*SB2+0.2782D-01*SB3 - A2= 0.3732D+01+0.4901D+00*SB +0.2218D+00*SB2-0.1116D+00*SB3 - A3= 0.7011D+01-0.6620D+01*SB +0.2557D+01*SB2-0.1360D+00*SB3 - A4= 0.8969D+00-0.2429D+00*SB +0.1811D+00*SB2-0.6888D-01*SB3 - A5= 0.8636D-01+0.2558D+00*SB -0.3082D+00*SB2+0.2535D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp(-0.7266D+00-0.1584D+01*SB +0.1259D+01*SB2- - & 0.4305D-01*SB3) - A1= 0.5285D+00-0.3721D+00*SB +0.5150D+00*SB2-0.1697D+00*SB3 - A2= 0.4075D+01+0.8282D+00*SB -0.4496D+00*SB2+0.2107D+00*SB3 - A3= 0.3279D+01+0.5066D+01*SB -0.9134D+01*SB2+0.2897D+01*SB3 - A4= 0.4399D+00-0.5888D+00*SB +0.4802D+00*SB2-0.1664D+00*SB3 - A5= 0.3678D+00-0.8929D+00*SB +0.1592D+01*SB2-0.5713D+00*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.2318D+00-0.9779D+00*SB -0.3783D+00*SB2+ - & 0.1037D-01*SB3) - A1=-0.2916D+00+0.1754D+00*SB -0.1884D+00*SB2+0.6116D-01*SB3 - A2= 0.5349D+01+0.7460D+00*SB +0.2319D+00*SB2-0.2622D+00*SB3 - A3= 0.6920D+01-0.3454D+01*SB +0.2027D+01*SB2-0.7626D+00*SB3 - A4= 0.1013D+01+0.1423D+00*SB -0.1798D+00*SB2+0.1872D-01*SB3 - A5=-0.5465D-01+0.2303D+01*SB -0.9584D+00*SB2+0.3098D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2328D+01-0.3061D+01*SB +0.3620D+01*SB2- - & 0.1602D+01*SB3) - A1=-0.3358D+00+0.3198D+00*SB -0.4210D+00*SB2+0.1571D+00*SB3 - A2= 0.8478D+01-0.3112D+01*SB +0.5243D+01*SB2-0.2255D+01*SB3 - A3= 0.1971D+02+0.3389D+00*SB -0.5268D+01*SB2+0.2099D+01*SB3 - A4= 0.1128D+01-0.4701D+00*SB +0.7779D+00*SB2-0.3506D+00*SB3 - A5=-0.4708D+00+0.3341D+01*SB -0.3375D+01*SB2+0.1353D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.2906D+01-0.1069D+00*SB -0.1055D+01*SB2+ - & 0.2496D+00*SB3) - A1=-0.2875D+00+0.6571D-01*SB -0.1987D-01*SB2-0.1800D-02*SB3 - A2= 0.9854D+01-0.2715D+00*SB -0.7407D+00*SB2+0.2888D+00*SB3 - A3= 0.1583D+02-0.7687D+01*SB +0.3428D+01*SB2-0.3327D+00*SB3 - A4= 0.9763D+00+0.7599D-01*SB -0.2128D+00*SB2+0.6852D-01*SB3 - A5=-0.8444D-02+0.9434D+00*SB +0.4152D+00*SB2-0.1481D+00*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3780D+01+0.2499D+01*SB -0.4962D+01*SB2+ - & 0.1936D+01*SB3) - A1=-0.2639D+00-0.1575D+00*SB +0.3584D+00*SB2-0.1646D+00*SB3 - A2= 0.8082D+01+0.2794D+01*SB -0.5438D+01*SB2+0.2321D+01*SB3 - A3= 0.1811D+02-0.2000D+02*SB +0.1951D+02*SB2-0.6904D+01*SB3 - A4= 0.9822D+00+0.4972D+00*SB -0.8690D+00*SB2+0.3415D+00*SB3 - A5= 0.1772D+00-0.6078D+00*SB +0.3341D+01*SB2-0.1473D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1122D+01*Exp(-0.4232D+01-0.1808D+01*SB + - & 0.5348D+00*SB2) - A1=-0.2824D+00+0.5846D+00*SB -0.7230D+00*SB2+0.2419D+00*SB3 - A2= 0.5683D+01-0.2948D+01*SB +0.5916D+01*SB2-0.2560D+01*SB3 - A3= 0.2051D+01+0.4795D+01*SB -0.4271D+01*SB2+0.4174D+00*SB3 - A4= 0.1737D+00+0.1717D+01*SB -0.1978D+01*SB2+0.6643D+00*SB3 - A5= 0.8689D+00+0.3500D+01*SB -0.3283D+01*SB2+0.1026D+01*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9906D+00*Exp(-0.1496D+01-0.6576D+01*SB + - & 0.1569D+01*SB2) - A1=-0.2140D+00-0.6419D-01*SB -0.2741D-02*SB2+0.3185D-02*SB3 - A2= 0.5781D+01+0.1049D+00*SB -0.3930D+00*SB2+0.5174D+00*SB3 - A3=-0.9420D+00+0.5511D+00*SB +0.8817D+00*SB2+0.1903D+01*SB3 - A4= 0.2418D-01+0.4232D-01*SB -0.1244D-01*SB2-0.2365D-01*SB3 - A5= 0.7664D+00+0.1794D+01*SB -0.4917D+00*SB2-0.1284D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1000D+01*Exp(-0.8460D+01+0.1154D+01*SB + - & 0.8838D+01*SB2) - A1=-0.4316D-01-0.2976D+00*SB +0.3174D+00*SB2-0.1429D+01*SB3 - A2= 0.4910D+01+0.2273D+01*SB +0.5631D+01*SB2-0.1994D+02*SB3 - A3= 0.1190D+02-0.2000D+02*SB -0.2000D+02*SB2+0.1292D+02*SB3 - A4= 0.5771D+00-0.2552D+00*SB +0.7510D+00*SB2+0.6923D+00*SB3 - A5= 0.4402D+01-0.1627D+01*SB -0.2085D+01*SB2-0.6737D+01*SB3 - ENDIF - -C...Expansion for CTEQ3D. - ELSEIF(ISET .EQ. 3) THEN - IF(IPRT .EQ. 2) THEN - A0=Exp( 0.2148D+00+0.5814D-01*SB +0.2734D+00*SB2- - & 0.2902D+00*SB3) - A1= 0.4810D+00+0.1657D-01*SB -0.3800D-01*SB2+0.3125D-01*SB3 - A2= 0.3509D+01+0.3923D+00*SB +0.4010D+00*SB2-0.1932D+00*SB3 - A3= 0.7055D+01-0.6552D+01*SB +0.3466D+01*SB2-0.5657D+00*SB3 - A4= 0.1061D+01-0.3453D+00*SB +0.4089D+00*SB2-0.1817D+00*SB3 - A5= 0.8687D-01+0.2548D+00*SB -0.2967D+00*SB2+0.2647D+00*SB3 - ELSEIF(IPRT .EQ. 1) THEN - A0=Exp( 0.3961D+00+0.4914D+00*SB -0.1728D+01*SB2+ - & 0.7257D+00*SB3) - A1= 0.4162D+00-0.1419D+00*SB +0.3680D+00*SB2-0.1618D+00*SB3 - A2= 0.3248D+01+0.3028D+01*SB -0.4307D+01*SB2+0.1920D+01*SB3 - A3=-0.1100D+01+0.2184D+01*SB -0.3820D+01*SB2+0.1717D+01*SB3 - A4= 0.2082D+01-0.2756D+00*SB +0.3043D+00*SB2-0.1260D+00*SB3 - A5=-0.4822D+00-0.5706D+00*SB +0.2243D+01*SB2-0.9760D+00*SB3 - ELSEIF(IPRT .EQ. 0) THEN - A0=Exp(-0.4665D+00-0.7554D+00*SB -0.3323D+00*SB2- - & 0.2734D-04*SB3) - A1=-0.3359D+00+0.2395D+00*SB -0.2377D+00*SB2+0.7059D-01*SB3 - A2= 0.5451D+01+0.6086D+00*SB +0.8606D-01*SB2-0.1425D+00*SB3 - A3= 0.1026D+02-0.9352D+01*SB +0.4879D+01*SB2-0.1150D+01*SB3 - A4= 0.9935D+00-0.5017D-01*SB -0.1707D-01*SB2-0.1464D-02*SB3 - A5=-0.4160D-01+0.2305D+01*SB -0.1063D+01*SB2+0.3211D+00*SB3 - ELSEIF(IPRT .EQ. -1) THEN - A0=Exp(-0.2714D+01-0.2868D+01*SB +0.3700D+01*SB2- - & 0.1671D+01*SB3) - A1=-0.3893D+00+0.3341D+00*SB -0.3897D+00*SB2+0.1420D+00*SB3 - A2= 0.8359D+01-0.3267D+01*SB +0.5327D+01*SB2-0.2245D+01*SB3 - A3= 0.2359D+02-0.5669D+01*SB -0.4602D+01*SB2+0.3153D+01*SB3 - A4= 0.1106D+01-0.4745D+00*SB +0.7739D+00*SB2-0.3417D+00*SB3 - A5=-0.5557D+00+0.3433D+01*SB -0.3390D+01*SB2+0.1354D+01*SB3 - ELSEIF(IPRT .EQ. -2) THEN - A0=Exp(-0.3323D+01+0.2296D+00*SB -0.1109D+01*SB2+ - & 0.2223D+00*SB3) - A1=-0.3410D+00+0.8847D-01*SB -0.1111D-01*SB2-0.5927D-02*SB3 - A2= 0.9753D+01-0.5182D+00*SB -0.4670D+00*SB2+0.1921D+00*SB3 - A3= 0.1977D+02-0.1600D+02*SB +0.9481D+01*SB2-0.1864D+01*SB3 - A4= 0.9818D+00+0.2839D-02*SB -0.1188D+00*SB2+0.3584D-01*SB3 - A5=-0.7934D-01+0.1004D+01*SB +0.3704D+00*SB2-0.1220D+00*SB3 - ELSEIF(IPRT .EQ. -3) THEN - A0=Exp(-0.3985D+01+0.2855D+01*SB -0.5208D+01*SB2+ - & 0.1937D+01*SB3) - A1=-0.3337D+00-0.1150D+00*SB +0.3691D+00*SB2-0.1709D+00*SB3 - A2= 0.7968D+01+0.3641D+01*SB -0.6599D+01*SB2+0.2642D+01*SB3 - A3= 0.1873D+02-0.1999D+02*SB +0.1734D+02*SB2-0.5813D+01*SB3 - A4= 0.9731D+00+0.5082D+00*SB -0.8780D+00*SB2+0.3231D+00*SB3 - A5=-0.5542D-01-0.4189D+00*SB +0.3309D+01*SB2-0.1439D+01*SB3 - ELSEIF(IPRT .EQ. -4) THEN - A0=SB** 0.1105D+01*Exp(-0.3952D+01-0.1901D+01*SB + - & 0.5137D+00*SB2) - A1=-0.3543D+00+0.6055D+00*SB -0.6941D+00*SB2+0.2278D+00*SB3 - A2= 0.5955D+01-0.2629D+01*SB +0.5337D+01*SB2-0.2300D+01*SB3 - A3= 0.1933D+01+0.4882D+01*SB -0.3810D+01*SB2+0.2290D+00*SB3 - A4= 0.1806D+00+0.1655D+01*SB -0.1893D+01*SB2+0.6395D+00*SB3 - A5= 0.4790D+00+0.3612D+01*SB -0.3152D+01*SB2+0.9684D+00*SB3 - ELSEIF(IPRT .EQ. -5) THEN - A0=SB** 0.9818D+00*Exp(-0.1825D+01-0.7464D+01*SB + - & 0.2143D+01*SB2) - A1=-0.2604D+00-0.1400D+00*SB +0.1702D+00*SB2-0.8476D-01*SB3 - A2= 0.6005D+01+0.6275D+00*SB -0.2535D+01*SB2+0.2219D+01*SB3 - A3=-0.9067D+00+0.1149D+01*SB +0.1974D+01*SB2+0.4716D+01*SB3 - A4= 0.3915D-01+0.5945D-01*SB -0.9844D-01*SB2+0.2783D-01*SB3 - A5= 0.5500D+00+0.1994D+01*SB -0.6727D+00*SB2-0.1510D+00*SB3 - ELSEIF(IPRT .EQ. -6) THEN - A0=SB** 0.1002D+01*Exp(-0.8553D+01+0.3793D+00*SB + - & 0.9998D+01*SB2) - A1=-0.5870D-01-0.2792D+00*SB +0.6526D+00*SB2-0.1984D+01*SB3 - A2= 0.4716D+01+0.4473D+00*SB +0.1128D+02*SB2-0.1937D+02*SB3 - A3= 0.1289D+02-0.1742D+02*SB -0.1983D+02*SB2-0.9274D+00*SB3 - A4= 0.5647D+00-0.2732D+00*SB +0.1074D+01*SB2+0.5981D+00*SB3 - A5= 0.4390D+01-0.1262D+01*SB -0.9026D+00*SB2-0.9394D+01*SB3 - ENDIF - ENDIF - -C...Calculation of x * f(x, Q). - PYCTEQ = MAX(0D0, A0 *(X**A1) *((1D0-X)**A2) *(1D0+A3*(X**A4)) - & *(LOG(1D0+1D0/X))**A5 ) - - RETURN - END -C********************************************************************* -C********************************************************************* -C* ** -C* July 2004 ** -C* ** -C* The Lund Monte Carlo ** -C* ** -C* PYTHIA version 6.2 ** -C* ** -C* Torbjorn Sjostrand ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 48 16 ** -C* E-mail torbjorn@thep.lu.se ** -C* ** -C* SUSY and Technicolor parts by ** -C* Stephen Mrenna ** -C* Computing Division, Simulations Group ** -C* Fermi National Accelerator Laboratory ** -C* MS 234, Batavia, IL 60510, USA ** -C* phone + 1 - 630 - 840 - 2556 ** -C* E-mail mrenna@fnal.gov ** -C* ** -C* Baryon and lepton number violation parts by ** -C* Peter Skands ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 31 92 ** -C* E-mail zeiler@thep.lu.se ** -C* ** -C* PYTHIA 7 efforts coordinated by ** -C* Leif Lonnblad ** -C* Department of Theoretical Physics ** -C* Lund University ** -C* Solvegatan 14A, S-223 62 Lund, Sweden ** -C* phone +46 - 46 - 222 77 80 ** -C* E-mail leif@thep.lu.se ** -C* ** -C* Several parts are written by Hans-Uno Bengtsson ** -C* PYSHOW is written together with Mats Bengtsson ** -C* PYMAEL is written by Emanuel Norrbin ** -C* advanced popcorn baryon production written by Patrik Eden ** -C* code for virtual photons mainly written by Christer Friberg ** -C* code for low-mass strings mainly written by Emanuel Norrbin ** -C* Bose-Einstein code mainly written by Leif Lonnblad ** -C* CTEQ parton distributions are by the CTEQ collaboration ** -C* GRV 94 parton distributions are by Glueck, Reya and Vogt ** -C* SaS photon parton distributions together with Gerhard Schuler ** -C* g + g and q + qbar -> t + tbar + H code by Zoltan Kunszt ** -C* MSSM Higgs mass calculation code by M. Carena, ** -C* J.R. Espinosa, M. Quiros and C.E.M. Wagner ** -C* PYGAUS adapted from CERN library (K.S. Kolbig) ** -C* ** -C* The latest program version and documentation is found on WWW ** -C* http://www.thep.lu.se/~torbjorn/Pythia.html ** -C* ** -C* Copyright Torbjorn Sjostrand, Lund 2004 ** -C* ** -C********************************************************************* -C********************************************************************* -C * -C List of subprograms in order of appearance, with main purpose * -C (S = subroutine, F = function, B = block data) * -C * -C B PYDATA to contain all default values * -C S PYTEST to test the proper functioning of the package * -C S PYHEPC to convert between /PYJETS/ and /HEPEVT/ records * -C * -C S PYINIT to administer the initialization procedure * -C S PYEVNT to administer the generation of an event * -C S PYSTAT to print cross-section and other information * -C S PYINRE to initialize treatment of resonances * -C S PYINBM to read in beam, target and frame choices * -C S PYINKI to initialize kinematics of incoming particles * -C S PYINPR to set up the selection of included processes * -C S PYXTOT to give total, elastic and diffractive cross-sect. * -C S PYMAXI to find differential cross-section maxima * -C S PYPILE to select multiplicity of pileup events * -C S PYSAVE to save alternatives for gamma-p and gamma-gamma * -C S PYGAGA to handle lepton -> lepton + gamma branchings * -C S PYRAND to select subprocess and kinematics for event * -C S PYSCAT to set up kinematics and colour flow of event * -C S PYSSPA to simulate initial state spacelike showers * -C S PYMEMX auxiliary to PYSSPA for ME correction maximum * -C S PYMEWT auxiliary to PYSSPA for matrix element correction * -C S PYUPRE to rearranges contents of the HEPEUP commonblock * -C S PYADSH to administrate sequential final-state showers * -C S PYRESD to perform resonance decays * -C S PYMULT to generate multiple interactions * -C S PYREMN to add on target remnants * -C S PYDIFF to set up kinematics for diffractive events * -C S PYDISG to set up kinematics, remnant and showers for DIS * -C S PYDOCU to compute cross-sections and handle documentation * -C S PYFRAM to perform boosts between different frames * -C S PYWIDT to calculate full and partial widths of resonances * -C S PYOFSH to calculate partial width into off-shell channels * -C S PYRECO to handle colour reconnection in W+W- events * -C S PYKLIM to calculate borders of allowed kinematical region * -C S PYKMAP to construct value of kinematical variable * -C S PYSIGH to calculate differential cross-sections * -C S PYSGQC auxiliary to PYSIGH for QCD processes * -C S PYSGHF auxiliary to PYSIGH for heavy flavour processes * -C S PYSGWZ auxiliary to PYSIGH for W and Z processes * -C S PYSGHG auxiliary to PYSIGH for Higgs processes * -C S PYSGSU auxiliary to PYSIGH for supersymmetry processes * -C S PYSGTC auxiliary to PYSIGH for technicolor processes * -C S PYSGEX auxiliary to PYSIGH for various exotic processes * -C S PYPDFU to evaluate parton distributions * -C S PYPDFL to evaluate parton distributions at low x and Q^2 * -C S PYPDEL to evaluate electron parton distributions * -C S PYPDGA to evaluate photon parton distributions (generic) * -C S PYGGAM to evaluate photon parton distributions (SaS sets) * -C S PYGVMD to evaluate VMD part of photon parton distributions * -C S PYGANO to evaluate anomalous part of photon pdf's * -C S PYGBEH to evaluate Bethe-Heitler part of photon pdf's * -C S PYGDIR to evaluate direct contribution to photon pdf's * -C S PYPDPI to evaluate pion parton distributions * -C S PYPDPR to evaluate proton parton distributions * -C F PYCTEQ to evaluate the CTEQ 3 proton parton distributions * -C S PYGRVL to evaluate the GRV 94L proton parton distributions * -C S PYGRVM to evaluate the GRV 94M proton parton distributions * -C S PYGRVD to evaluate the GRV 94D proton parton distributions * -C F PYGRVV auxiliary to the PYGRV* routines * -C F PYGRVW auxiliary to the PYGRV* routines * -C F PYGRVS auxiliary to the PYGRV* routines * -C F PYCT5L to evaluate the CTEQ 5L proton parton distributions * -C F PYCT5M to evaluate the CTEQ 5M1 proton parton distributions * -C S PYPDPO to evaluate old proton parton distributions * -C F PYHFTH to evaluate threshold factor for heavy flavour * -C S PYSPLI to find flavours left in hadron when one removed * -C F PYGAMM to evaluate ordinary Gamma function Gamma(x) * -C S PYWAUX to evaluate auxiliary functions W1(s) and W2(s) * -C S PYI3AU to evaluate auxiliary function I3(s,t,u,v) * -C F PYSPEN to evaluate Spence (dilogarithm) function Sp(x) * -C S PYQQBH to evaluate matrix element for g + g -> Q + Qbar + H * -C S PYSTBH to evaluate matrix element for t + b + H processes * -C * PYTBH* auxiliaries to PYSTBH * -C * -C S PYMSIN to initialize the supersymmetry simulation * -C S PYAPPS to determine MSSM parameters from SUGRA input * -C S PYSUGI to determine MSSM parameters using ISASUSY * -C F PYRNMQ to determine running squark masses * -C S PYTHRG to calculate sfermion third-gen. mass eigenstates * -C S PYINOM to calculate neutralino/chargino mass eigenstates * -C F PYRNM3 to determine running M3, gluino mass * -C S PYEIG4 to calculate eigenvalues and -vectors in 4*4 matrix * -C S PYHGGM to determine Higgs mass spectrum * -C S PYSUBH to determine Higgs masses in the MSSM * -C S PYPOLE to determine Higgs masses in the MSSM * -C S PYRGHM auxiliary to PYPOLE * -C S PYGFXX auxiliary to PYRGHM * -C F PYFINT auxiliary to PYPOLE * -C F PYFISB auxiliary to PYFINT * -C S PYSFDC to calculate sfermion decay partial widths * -C S PYGLUI to calculate gluino decay partial widths * -C S PYTBBN to calculate 3-body decay of gluino to neutralino * -C S PYTBBC to calculate 3-body decay of gluino to chargino * -C S PYNJDC to calculate neutralino decay partial widths * -C S PYCJDC to calculate chargino decay partial widths * -C F PYXXZ6 auxiliary for ino 3-body decays * -C F PYXXGA auxiliary for ino -> ino + gamma decay * -C F PYX2XG auxiliary for ino -> ino + gauge boson decay * -C F PYX2XH auxiliary for ino -> ino + Higgs decay * -C S PYHEXT to calculate non-SM Higgs decay partial widths * -C F PYH2XX auxiliary for H -> ino + ino decay * -C F PYGAUS to perform Gaussian integration * -C F PYGAU2 copy of PYGAUS to allow two-dimensional integration * -C F PYSIMP to perform Simpson integration * -C F PYLAMF to evaluate the lambda kinematics function * -C S PYTBDY to perform 3-body decay of gauginos * -C S PYTECM to calculate techni_rho/omega masses * -C S PYEICG to calculate eigenvalues of a 4*4 complex matrix * -C S PYCMQR auxiliary to PYEICG * -C S PYCMQ2 auxiliary to PYEICG * -C S PYCDIV auxiliary to PYCMQR * -C S PYCSRT auxiliary to PYCMQR * -C S PYTHAG auxiliary to PYCMQR * -C S PYCBAL auxiliary to PYEICG * -C S PYCBA2 auxiliary to PYEICG * -C S PYCRTH auxiliary to PYEICG * -C S PYLDCM auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * -C S PYBKSB auxiliary to PYSIGH, for technicolor in QCD 2 -> 2 * -C S PYWIDX to calculate decay widths from within PYWIDT * -C S PYRVSF to calculate R-violating sfermion decay widths * -C S PYRVNE to calculate R-violating neutralino decay widths * -C S PYRVCH to calculate R-violating chargino decay widths * -C S PYRVGL to calculate R-violating gluino decay widths * -C F PYRVSB auxiliary to PYRVSF * -C S PYRVGW to calculate R-Violating 3-body widths * -C F PYRVI1 auxiliary to PYRVGW, to do PS integration for res. * -C F PYRVI2 auxiliary to PYRVGW, to do PS integration for LR-int.* -C F PYRVI3 auxiliary to PYRVGW, to do PS X integral for int. * -C F PYRVG1 auxiliary to PYRVI1, general matrix element, res. * -C F PYRVG2 auxiliary to PYRVI2, general matrix element, LR-int. * -C F PYRVG3 auxiliary to PYRVI3, to do PS Y integral for int. * -C F PYRVG4 auxiliary to PYRVG3, general matrix element, int. * -C F PYRVR auxiliary to PYRVG1, Breit-Wigner * -C F PYRVS auxiliary to PYRVG2 & PYRVG4 * -C * -C S PY1ENT to fill one entry (= parton or particle) * -C S PY2ENT to fill two entries * -C S PY3ENT to fill three entries * -C S PY4ENT to fill four entries * -C S PY2FRM to interface to generic two-fermion generator * -C S PY4FRM to interface to generic four-fermion generator * -C S PY6FRM to interface to generic six-fermion generator * -C S PY4JET to generate a shower from a given 4-parton config * -C S PY4JTW to evaluate the weight od a shower history for above * -C S PY4JTS to set up the parton configuration for above * -C S PYJOIN to connect entries with colour flow information * -C S PYGIVE to fill (or query) commonblock variables * -C S PYEXEC to administrate fragmentation and decay chain * -C S PYPREP to rearrange showered partons along strings * -C S PYSTRF to do string fragmentation of jet system * -C S PYJURF to find boost to string junction rest frame * -C S PYINDF to do independent fragmentation of one or many jets * -C S PYDECY to do the decay of a particle * -C S PYDCYK to select parton and hadron flavours in decays * -C S PYKFDI to select parton and hadron flavours in fragm * -C S PYNMES to select number of popcorn mesons * -C S PYKFIN to calculate falvour prod. ratios from input params. * -C S PYPTDI to select transverse momenta in fragm * -C S PYZDIS to select longitudinal scaling variable in fragm * -C S PYSHOW to do timelike parton shower evolution * -C F PYMAEL auxiliary to PYSHOW, with gluon emission ME's * -C S PYBOEI to include Bose-Einstein effects (crudely) * -C S PYBESQ auxiliary to PYBOEI * -C F PYMASS to give the mass of a particle or parton * -C F PYMRUN to give the running MSbar mass of a quark * -C S PYNAME to give the name of a particle or parton * -C F PYCHGE to give three times the electric charge * -C F PYCOMP to compress standard KF flavour code to internal KC * -C S PYERRM to write error messages and abort faulty run * -C F PYALEM to give the alpha_electromagnetic value * -C F PYALPS to give the alpha_strong value * -C F PYANGL to give the angle from known x and y components * -C F PYR to provide a random number generator * -C S PYRGET to save the state of the random number generator * -C S PYRSET to set the state of the random number generator * -C S PYROBO to rotate and/or boost an event * -C S PYEDIT to remove unwanted entries from record * -C S PYLIST to list event record or particle data * -C S PYLOGO to write a logo * -C S PYUPDA to update particle data * -C F PYK to provide integer-valued event information * -C F PYP to provide real-valued event information * -C S PYSPHE to perform sphericity analysis * -C S PYTHRU to perform thrust analysis * -C S PYCLUS to perform three-dimensional cluster analysis * -C S PYCELL to perform cluster analysis in (eta, phi, E_T) * -C S PYJMAS to give high and low jet mass of event * -C S PYFOWO to give Fox-Wolfram moments * -C S PYTABU to analyze events, with tabular output * -C * -C S PYEEVT to administrate the generation of an e+e- event * -C S PYXTEE to give the total cross-section at given CM energy * -C S PYRADK to generate initial state photon radiation * -C S PYXKFL to select flavour of primary qqbar pair * -C S PYXJET to select (matrix element) jet multiplicity * -C S PYX3JT to select kinematics of three-jet event * -C S PYX4JT to select kinematics of four-jet event * -C S PYXDIF to select angular orientation of event * -C S PYONIA to perform generation of onium decay to gluons * -C * -C S PYBOOK to book a histogram * -C S PYFILL to fill an entry in a histogram * -C S PYFACT to multiply histogram contents by a factor * -C S PYOPER to perform operations between histograms * -C S PYHIST to print and reset all histograms * -C S PYPLOT to print a single histogram * -C S PYNULL to reset contents of a single histogram * -C S PYDUMP to dump histogram contents onto a file * -C * -C S PYKCUT dummy routine for user kinematical cuts * -C S PYEVWT dummy routine for weighting events * -C S UPINIT dummy routine to initialize user processes * -C S UPEVNT dummy routine to generate a user process event * -C S PDFSET dummy routine to be removed when using PDFLIB * -C S STRUCTM dummy routine to be removed when using PDFLIB * -C S STRUCTP dummy routine to be removed when using PDFLIB * -C S SUGRA dummy routine to be removed when linking with ISAJET * -C F VISAJE dummy functn. to be removed when linking with ISAJET * -C S PYTAUD dummy routine for interface to tau decay libraries * -C S PYTIME dummy routine for giving date and time * -C * -C********************************************************************* - -C...PYDATA -C...Default values for switches and parameters, -C...and particle, decay and process data. - - BLOCK DATA PYDATA - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYDATR/MRPY(6),RRPY(100) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/,/PYSUBS/, - &/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/, - &/PYINT6/,/PYINT7/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYTCSM/,/PYBINS/ - -C...PYDAT1, containing status codes and most parameters. - DATA MSTU/ - & 0, 0, 0, 4000,10000, 500, 8000, 0, 0, 2, - 1 6, 1, 1, 0, 0, 1, 0, 0, 0, 0, - 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, - 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 7 30*0, - 1 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 2 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, - & 80*0/ - DATA (PARU(I),I=1,100)/ - & 3.141592653589793D0, 6.283185307179586D0, - & 0.197327D0, 5.06773D0, 0.389380D0, 2.56819D0, 4*0D0, - 1 0.001D0, 0.09D0, 0.01D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 3 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 4 2.0D0, 1.0D0, 0.25D0, 2.5D0, 0.05D0, - 4 0D0, 0D0, 0.0001D0, 0D0, 0D0, - 5 2.5D0,1.5D0,7.0D0,1.0D0,0.5D0,2.0D0,3.2D0, 0D0, 0D0, 0D0, - 6 40*0D0/ - DATA (PARU(I),I=101,200)/ - & 0.00729735D0, 0.232D0, 0.007764D0, 1.0D0, 1.16639D-5, - & 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0.20D0, 0.25D0, 1.0D0, 4.0D0, 10D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 -0.693D0, -1.0D0, 0.387D0, 1.0D0, -0.08D0, - 2 -1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, - 3 1.0D0,-1.0D0, 1.0D0,-1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 4 5.0D0, 1.0D0, 1.0D0, 0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, - 5 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 6 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 7 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, - 8 1.0D0, 1.0D0, 1.0D0, 0.0D0, 0.0D0, 1.0D0, 1.0D0, 0D0,0D0,0D0, - 9 0D0, 0D0, 0D0, 0D0, 1.0D0, 0D0, 0D0, 0D0, 0D0, 0D0/ - DATA MSTJ/ - & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, - 1 4, 2, 0, 1, 0, 2, 2, 10, 0, 0, - 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, - 5 0, 3, 0, 2, 0, 0, 1, 0, 0, 0, - 6 40*0, - & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, - 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, - 2 80*0/ - DATA PARJ/ - & 0.10D0, 0.30D0, 0.40D0, 0.05D0, 0.50D0, - & 0.50D0, 0.50D0, 0.6D0, 1.2D0, 0.6D0, - 1 0.50D0,0.60D0,0.75D0, 0D0, 0D0, 0D0, 0D0, 1.0D0, 1.0D0, 0D0, - 2 0.36D0, 1.0D0,0.01D0, 2.0D0,1.0D0,0.4D0, 0D0, 0D0, 0D0, 0D0, - 3 0.10D0, 1.0D0, 0.8D0, 1.5D0,0D0,2.0D0,0.2D0, 0D0,0.08D0,1D0, - 4 0.3D0, 0.58D0, 0.5D0, 0.9D0,0.5D0,1.0D0,1.0D0,1.5D0,1D0,10D0, - 5 0.77D0, 0.77D0, 0.77D0, -0.05D0, -0.005D0, - 5 0D0, 0D0, 0D0, 1.0D0, 0D0, - 6 4.5D0, 0.7D0, 0D0,0.003D0, 0.5D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, - 7 10D0, 1000D0, 100D0, 1000D0, 0D0, 0.7D0,10D0, 0D0,0D0,0.5D0, - 8 0.29D0, 1.0D0, 1.0D0, 0D0, 10D0, 10D0, 0D0, 0D0, 0D0,1D-4, - 9 0.02D0, 1.0D0, 0.2D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - & 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 2 1.0D0, 0.25D0,91.187D0,2.489D0, 0.01D0, - 2 2.0D0, 1.0D0, 0.25D0,0.002D0, 0D0, - 3 0D0, 0D0, 0D0, 0D0, 0.01D0, 0.99D0, 0D0, 0D0, 0.2D0, 0D0, - 4 10*0D0, - 5 10*0D0, - 6 10*0D0, - 7 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, -0.693D0, - 8 -1.0D0, 0.387D0, 1.0D0, -0.08D0, -1.0D0, - 8 1.0D0, 1.0D0, -0.693D0, -1.0D0, 0.387D0, - 9 1.0D0, -0.08D0, -1.0D0, 1.0D0, 1.0D0, - 9 5*0D0/ - -C...PYDAT2, with particle data and flavour treatment parameters. - DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, - &-3,0,-3,6*0,3,9*0,3,2*0,3,4*0,-1,41*0,2,-1,20*0,3*3,7*0,3*3,3*0, - &3*3,3*0,3*3,6*0,3*3,3*0,3*3,4*0,-2,-3,2*1,2*0,4,2*3,6,2*-2,2*-3, - &0,2*1,2*0,2*3,-2,2*-3,2*0,-3,2*1,2*0,3,0,2*4,2*3,2*6,3,2*1,2*0, - &2*3,2*0,4,2*3,2*6,2*3,6,2*-2,2*-3,0,-3,0,2*1,2*0,2*3,0,3,2*-2, - &2*-3,2*0,2*-3,0,2*1,2*0,2*3,2*0,2*3,-2,2*-3,2*0,2*-3,2*0,-3,2*0, - &2*3,4*0,2*3,2*0,2*3,2*0,2*3,4*0,2*3,2*0,2*3,3*0,3,2*0,3,0,3,0,3, - &2*0,3,0,3,3*0,-1,2,-1,2,-1,2,-3,0,-3,0,-3,4*0,3,2*0,3,0,-1,2,-1, - &2,-1,2,-3,0,-3,0,-3,2*0,3,3*0,3,8*0,-1,2,-3,6*0,3,2*6,0,3,4*0,3, - &139*0/ - DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,20*0,1,107*0,-1,0,2*-1, - &2*0,-1,3*0,2*-1,3*0,2*-1,4*0,-1,5*0,2*-1,4*0,2*-1,5*0,2*-1,6*0, - &-1,7*0,2*-1,5*0,2*-1,6*0,2*-1,7*0,2*-1,8*0,-1,56*0,6*1,6*0,2,7*0, - &6*1,9*0,2,3*0,2,0,5*2,2*1,156*0/ - DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,3*0, - &2*1,39*0,1,0,2*1,20*0,3*1,4*0,6*1,3*0,9*1,3*0,12*1,4*0,100*1,2*0, - &2*1,2*0,4*1,2*0,6*1,2*0,8*1,3*0,1,0,2*1,0,3*1,0,4*1,3*0,12*1,3*0, - &1,2*0,1,0,12*1,0,1,3*0,1,8*0,4*1,5*0,3*1,0,1,3*0,2*1,139*0/ - DATA (KCHG(I,4),I= 1, 290)/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15, - &16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36, - &37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57, - &58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78, - &79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99, - &100,110,111,113,115,130,211,213,215,221,223,225,310,311,313,315, - &321,323,325,331,333,335,411,413,415,421,423,425,431,433,435,441, - &443,445,511,513,515,521,523,525,531,533,535,541,543,545,551,553, - &555,990,1103,1114,2101,2103,2112,2114,2203,2212,2214,2224,3101, - &3103,3112,3114,3122,3201,3203,3212,3214,3222,3224,3303,3312,3314, - &3322,3324,3334,4101,4103,4112,4114,4122,4132,4201,4203,4212,4214, - &4222,4224,4232,4301,4303,4312,4314,4322,4324,4332,4334,4403,4412, - &4414,4422,4424,4432,4434,4444,5101,5103,5112,5114,5122,5132,5142, - &5201,5203,5212,5214,5222,5224,5232,5242,5301,5303,5312,5314,5322, - &5324,5332,5334,5342,5401,5403,5412,5414,5422,5424,5432,5434,5442, - &5444,5503,5512,5514,5522,5524,5532,5534,5542,5544,5554,10111, - &10113,10211,10213,10221,10223,10311,10313,10321,10323,10331, - &10333,10411,10413,10421,10423,10431,10433,10441,10443,10511, - &10513,10521,10523,10531,10533,10541,10543,10551,10553,20113, - &20213,20223,20313,20323,20333,20413,20423,20433,20443,20513/ - DATA (KCHG(I,4),I= 291, 500)/20523,20533,20543,20553,100443, - &100553,1000001,1000002,1000003,1000004,1000005,1000006,1000011, - &1000012,1000013,1000014,1000015,1000016,1000021,1000022,1000023, - &1000024,1000025,1000035,1000037,1000039,2000001,2000002,2000003, - &2000004,2000005,2000006,2000011,2000012,2000013,2000014,2000015, - &2000016,3000111,3000211,3000221,3000331,3000113,3000213,3000223, - &3100021,3100111,3200111,3100113,3200113,3300113,3400113,4000001, - &4000002,4000011,4000012,5000039,9900012,9900014,9900016,9900023, - &9900024,9900041,9900042,9900110,9900210,9900220,9900330,9900440, - &9902110,9902210,139*0/ - DATA (PMAS(I,1),I= 1, 217)/2*0.33D0,0.5D0,1.5D0,4.8D0,175D0, - &2*400D0,2*0D0,0.00051D0,0D0,0.10566D0,0D0,1.777D0,0D0,400D0, - &5*0D0,91.188D0,80.45D0,115D0,6*0D0,500D0,900D0,500D0,3*300D0, - &3*0D0,5000D0,200D0,40*0D0,1D0,2D0,5D0,16*0D0,0.13498D0,0.7685D0, - &1.318D0,0.49767D0,0.13957D0,0.7669D0,1.318D0,0.54745D0,0.78194D0, - &1.275D0,2*0.49767D0,0.8961D0,1.432D0,0.4936D0,0.8916D0,1.425D0, - &0.95777D0,1.0194D0,1.525D0,1.8693D0,2.01D0,2.46D0,1.8645D0, - &2.0067D0,2.46D0,1.9685D0,2.1124D0,2.5735D0,2.9798D0,3.09688D0, - &3.5562D0,5.2792D0,5.3248D0,5.83D0,5.2789D0,5.3248D0,5.83D0, - &5.3693D0,5.4163D0,6.07D0,6.594D0,6.602D0,7.35D0,9.4D0,9.4603D0, - &9.9132D0,0D0,0.77133D0,1.234D0,0.57933D0,0.77133D0,0.93957D0, - &1.233D0,0.77133D0,0.93827D0,1.232D0,1.231D0,0.80473D0,0.92953D0, - &1.19744D0,1.3872D0,1.11568D0,0.80473D0,0.92953D0,1.19255D0, - &1.3837D0,1.18937D0,1.3828D0,1.09361D0,1.3213D0,1.535D0,1.3149D0, - &1.5318D0,1.67245D0,1.96908D0,2.00808D0,2.4521D0,2.5D0,2.2849D0, - &2.4703D0,1.96908D0,2.00808D0,2.4535D0,2.5D0,2.4529D0,2.5D0, - &2.4656D0,2.15432D0,2.17967D0,2.55D0,2.63D0,2.55D0,2.63D0,2.704D0, - &2.8D0,3.27531D0,3.59798D0,3.65648D0,3.59798D0,3.65648D0, - &3.78663D0,3.82466D0,4.91594D0,5.38897D0,5.40145D0,5.8D0,5.81D0, - &5.641D0,5.84D0,7.00575D0,5.38897D0,5.40145D0,5.8D0,5.81D0,5.8D0/ - DATA (PMAS(I,1),I= 218, 500)/5.81D0,5.84D0,7.00575D0,5.56725D0, - &5.57536D0,5.96D0,5.97D0,5.96D0,5.97D0,6.12D0,6.13D0,7.19099D0, - &6.67143D0,6.67397D0,7.03724D0,7.0485D0,7.03724D0,7.0485D0, - &7.21101D0,7.219D0,8.30945D0,8.31325D0,10.07354D0,10.42272D0, - &10.44144D0,10.42272D0,10.44144D0,10.60209D0,10.61426D0, - &11.70767D0,11.71147D0,15.11061D0,0.9835D0,1.231D0,0.9835D0, - &1.231D0,1D0,1.17D0,1.429D0,1.29D0,1.429D0,1.29D0,2*1.4D0,2.272D0, - &2.424D0,2.272D0,2.424D0,2.5D0,2.536D0,3.4151D0,3.46D0,5.68D0, - &5.73D0,5.68D0,5.73D0,5.92D0,5.97D0,7.25D0,7.3D0,9.8598D0,9.875D0, - &2*1.23D0,1.282D0,2*1.402D0,1.427D0,2*2.372D0,2.56D0,3.5106D0, - &2*5.78D0,6.02D0,7.3D0,9.8919D0,3.686D0,10.0233D0,32*500D0, - &3*110D0,350D0,3*210D0,500D0,125D0,250D0,400D0,2*350D0,300D0, - &4*400D0,1000D0,3*500D0,1200D0,750D0,2*200D0,7*0D0,139*0D0/ - DATA (PMAS(I,2),I= 1, 500)/5*0D0,1.39816D0,16*0D0,2.47813D0, - &2.07115D0,0.00367D0,6*0D0,14.54029D0,0D0,16.66099D0,8.38842D0, - &3.3752D0,4.17669D0,3*0D0,417.29147D0,0.39162D0,60*0D0,0.151D0, - &0.107D0,2*0D0,0.149D0,0.107D0,0D0,0.00843D0,0.185D0,2*0D0, - &0.0505D0,0.109D0,0D0,0.0498D0,0.098D0,0.0002D0,0.00443D0,0.076D0, - &2*0D0,0.023D0,2*0D0,0.023D0,2*0D0,0.015D0,0.0013D0,0D0,0.002D0, - &2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,2*0D0,0.02D0,5*0D0,0.12D0, - &3*0D0,0.12D0,2*0D0,2*0.12D0,3*0D0,0.0394D0,4*0D0,0.036D0,0D0, - &0.0358D0,2*0D0,0.0099D0,0D0,0.0091D0,74*0D0,0.06D0,0.142D0, - &0.06D0,0.142D0,0D0,0.36D0,0.287D0,0.09D0,0.287D0,0.09D0,0.25D0, - &0.08D0,0.05D0,0.02D0,0.05D0,0.02D0,0.05D0,0D0,0.014D0,0.01D0, - &8*0.05D0,0D0,0.01D0,2*0.4D0,0.025D0,2*0.174D0,0.053D0,3*0.05D0, - &0.0009D0,4*0.05D0,3*0D0,19*1D0,0D0,7*1D0,0D0,1D0,0D0,1D0,0D0, - &0.02911D0,0.01741D0,0.04536D0,0.09511D0,0.8686D0,0.62395D0, - &0.19192D0,123.27638D0,0.02296D0,0.18886D0,23.26819D0,2.86306D0, - &0D0,3.45903D0,2.59359D0,2.59687D0,0.42896D0,0.41912D0,0.14153D0, - &2*0.00098D0,0.00097D0,26.7245D0,21.74916D0,0.88159D0,0.88001D0, - &7*0D0,139*0D0/ - DATA (PMAS(I,3),I= 1, 500)/5*0D0,13.98156D0,16*0D0,24.78129D0, - &20.71149D0,0.03669D0,6*0D0,145.40294D0,0D0,166.60993D0, - &83.88423D0,33.75195D0,41.76694D0,3*0D0,4172.91467D0,3.91621D0, - &60*0D0,0.4D0,0.25D0,2*0D0,0.4D0,0.25D0,0D0,0.1D0,0.17D0,2*0D0, - &0.2D0,0.12D0,0D0,0.2D0,0.12D0,0.002D0,0.015D0,0.2D0,2*0D0,0.12D0, - &2*0D0,0.12D0,2*0D0,0.05D0,0.005D0,0D0,0.01D0,2*0D0,0.05D0,2*0D0, - &0.05D0,2*0D0,0.05D0,2*0D0,0.05D0,5*0D0,0.14D0,3*0D0,0.14D0,2*0D0, - &2*0.14D0,3*0D0,0.04D0,4*0D0,0.035D0,0D0,0.035D0,2*0D0,0.05D0,0D0, - &0.05D0,74*0D0,0.05D0,0.25D0,0.05D0,0.25D0,0D0,0.2D0,0.4D0, - &0.005D0,0.4D0,0.01D0,0.35D0,0.001D0,0.1D0,0.08D0,0.1D0,0.08D0, - &0.1D0,0D0,0.05D0,0.02D0,6*0.1D0,0.05D0,0.1D0,0D0,0.02D0,2*0.3D0, - &0.05D0,2*0.3D0,0.02D0,2*0.1D0,0.03D0,0.001D0,4*0.1D0,3*0D0, - &19*10D0,0.00001D0,7*10D0,0.00001D0,10D0,0.00001D0,10D0,0.00001D0, - &0.29108D0,0.17412D0,0.45362D0,0.95114D0,8.68604D0,6.23946D0, - &1.91923D0,450D0,0.22959D0,1.88863D0,232.68185D0,28.63059D0,0D0, - &34.59032D0,25.93594D0,25.96873D0,4.28961D0,4.19124D0,1.41528D0, - &0.00977D0,0.00976D0,0.00973D0,267.24501D0,217.49162D0,8.81592D0, - &8.80013D0,7*0D0,139*0D0/ - DATA (PMAS(I,4),I= 1, 500)/12*0D0,658654D0,0D0,0.0872D0,68*0D0, - &0.1D0,0.387D0,16*0D0,0.00003D0,2*0D0,15500D0,7804.5D0,5*0D0, - &26.762D0,3*0D0,3709D0,5*0D0,0.317D0,2*0D0,0.1244D0,2*0D0,0.14D0, - &5*0D0,0.468D0,2*0D0,0.462D0,2*0D0,0.483D0,2*0D0,0.15D0,18*0D0, - &44.34D0,0D0,78.88D0,4*0D0,23.96D0,2*0D0,49.1D0,0D0,87.1D0,0D0, - &24.6D0,4*0D0,0.0618D0,0.029D0,6*0D0,0.106D0,6*0D0,0.019D0,2*0D0, - &7*0.1D0,4*0D0,0.342D0,2*0.387D0,6*0D0,2*0.387D0,6*0D0,0.387D0, - &0D0,0.387D0,2*0D0,8*0.387D0,0D0,9*0.387D0,112*0D0,139*0D0/ - DATA PARF/ - & 0.5D0,0.25D0, 0.5D0,0.25D0, 1D0, 0.5D0, 0D0, 0D0, 0D0, 0D0, - 1 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 2 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 3 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 4 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 5 0.5D0, 0D0, 0.5D0, 0D0, 1D0, 1D0, 0D0, 0D0, 0D0, 0D0, - 6 0.75D0, 0.5D0, 0D0,0.1667D0,0.0833D0,0.1667D0,0D0,0D0,0D0, 0D0, - 7 0D0, 0D0, 1D0,0.3333D0,0.6667D0,0.3333D0,0D0,0D0,0D0, 0D0, - 8 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 9 0.0099D0, 0.0056D0, 0.199D0, 1.23D0, 4.17D0, 165D0, 4*0D0, - & 0.325D0,0.325D0,0.5D0,1.6D0, 5.0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 1 0D0,0.11D0,0.16D0,0.048D0,0.50D0,0.45D0,0.55D0,0.60D0,0D0,0D0, - 2 0.2D0, 0.1D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 3 60*0D0, - 4 0.2D0, 0.5D0, 8*0D0, - 5 1800*0D0/ - DATA ((VCKM(I,J),J=1,4),I=1,4)/ - & 0.95113D0, 0.04884D0, 0.00003D0, 0.00000D0, - & 0.04884D0, 0.94940D0, 0.00176D0, 0.00000D0, - & 0.00003D0, 0.00176D0, 0.99821D0, 0.00000D0, - & 0.00000D0, 0.00000D0, 0.00000D0, 1.00000D0/ - -C...PYDAT3, with particle decay parameters and data. - DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0, - &4*1,3*0,2*1,40*0,3*1,16*0,3*1,2*0,9*1,0,32*1,2*0,1,3*0,1,2*0,2*1, - &2*0,3*1,2*0,4*1,0,5*1,2*0,4*1,2*0,5*1,2*0,6*1,0,7*1,2*0,5*1,2*0, - &6*1,2*0,7*1,2*0,8*1,0,75*1,0,7*1,0,1,0,1,0,26*1,146*0/ - DATA (MDCY(I,2),I= 1, 351)/1,9,17,25,33,41,56,66,2*0,76,80,82, - &87,89,143,145,150,2*0,153,162,174,190,210,6*0,289,0,311,334,420, - &503,3*0,530,539,40*0,540,541,545,16*0,554,556,561,570,579,581, - &583,590,598,604,613,615,617,620,630,636,639,650,656,667,673,736, - &739,747,808,810,818,851,853,857,858,861,863,899,900,908,944,945, - &953,992,993,997,1028,1029,1033,1034,1043,2*0,1045,3*0,1046,2*0, - &1049,1052,2*0,1053,1055,1058,2*0,1062,1063,1066,1069,0,1072,1077, - &1079,1082,1084,2*0,1088,1089,1090,1166,2*0,1170,1171,1172,1173, - &1174,2*0,1178,1179,1181,1182,1184,1188,0,1189,1193,1197,1201, - &1205,1209,1213,2*0,1217,1218,1219,1236,1245,2*0,1254,1255,1256, - &1257,1258,1267,2*0,1276,1277,1278,1279,1280,1289,1290,2*0,1299, - &1308,1317,1326,1335,1344,1353,1362,0,1371,1380,1389,1398,1407, - &1416,1425,1434,1443,1452,1453,1454,1455,1456,1461,1464,1466,1471, - &1473,1478,1485,1489,1491,1493,1495,1497,1499,1501,1503,1504,1506, - &1508,1510,1512,1514,1516,1518,1520,1522,1523,1525,1527,1541,1543, - &1545,1549,1551,1553,1555,1557,1559,1561,1563,1565,1567,1578,1592, - &1637,1661,1706,1730,1775,1802,1833,1859,1891,1917,1949,1975,2162, - &2331,2595,2826,3106,3402,0,3657,3706,3734,3783,3811,3860,3888,0, - &3924,0,3960,0,3996,4004,4012,4020,4023,4047,4073,4097,4103,4110, - &4117,4124,4130,4136,4145,4149,4153,4156,4158,4178,4200,4222,4244/ - DATA (MDCY(I,2),I= 352, 500)/4259,4271,4278,146*0/ - DATA (MDCY(I,3),I= 1, 500)/5*8,15,2*10,2*0,4,2,5,2,54,2,5,3, - &2*0,9,12,16,20,79,6*0,22,0,23,86,83,27,3*0,9,1,40*0,1,4,9,16*0,2, - &5,2*9,2*2,7,8,6,9,2*2,3,10,6,3,11,6,11,6,63,3,8,61,2,8,33,2,4,1, - &3,2,36,1,8,36,1,8,39,1,4,31,1,4,1,9,2,2*0,1,3*0,3,2*0,3,1,2*0,2, - &3,4,2*0,1,3*3,0,5,2,3,2,4,2*0,2*1,76,4,2*0,4*1,4,2*0,1,2,1,2,4,1, - &0,7*4,2*0,2*1,17,2*9,2*0,4*1,2*9,2*0,4*1,9,1,9,2*0,8*9,0,9*9,4*1, - &5,3,2,5,2,5,7,4,7*2,1,9*2,1,2*2,14,2*2,4,9*2,11,14,45,24,45,24, - &45,27,31,26,32,26,32,26,187,169,264,231,280,296,255,0,49,28,49, - &28,49,28,36,0,36,0,36,0,3*8,3,24,26,24,6,3*7,2*6,9,2*4,3,2,20, - &3*22,15,12,2*7,146*0/ - DATA (MDME(I,1),I= 1,8000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, - &7*1,-1,1,7*-1,8*1,2*-1,8*1,2*-1,73*1,-1,2*1,-1,5*1,0,2*-1,6*1,0, - &2*-1,3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,85*1, - &2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,200*1,2*-1,2*1,-1, - &1249*1,2*-1,377*1,2*-1,1868*1,2*-1,6*1,2*-1,9*1,-1,3*1,-1,3*1, - &5*-1,3*1,-1,14*1,2*-1,6*1,2*-1,67*1,2*-1,6*1,2*-1,111*1,3716*0/ - DATA (MDME(I,2),I= 1,8000)/43*102,4*0,102,0,6*53,3*102,4*0,102, - &2*0,3*102,4*0,102,2*0,6*102,42,6*102,2*42,2*0,8*41,2*0,36*41, - &8*102,0,102,0,102,2*0,21*102,8*32,8*0,16*32,4*0,8*32,9*0,62*53, - &8*32,14*0,16*32,7*0,8*32,16*0,62*53,8*32,13*0,62*53,4*32,5*0, - &18*53,6*32,4*0,12,2*42,2*11,9*42,0,2,3,15*0,4*42,5*0,3,12*0,2, - &3*0,1,0,3,16*0,2*3,15*0,2*42,2*3,18*0,2*3,3*0,1,11*0,22*42,41*0, - &2*3,9*0,16*42,45*0,3,10*0,10*42,20*0,2*13,6*0,12,2*0,12,0,12, - &14*42,16*0,48,3*13,2*42,9*0,14*42,16*0,48,3*13,2*42,9*0,14*42, - &19*0,48,3*13,2*42,6*0,2*11,28*42,5*0,32,3*0,4*32,2*4,0,32,45*0, - &14*42,52*0,10*13,2*42,2*11,4*0,2*42,2*11,6*0,2*42,2*11,0,2*42, - &2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11,2*42,2*11, - &2*0,3*42,8*0,48,3*13,20*42,4*0,18*42,4*0,9*42,0,162*42,50*0,2*12, - &17*0,2*32,33*0,12,9*0,32,2*0,12,11*0,4*32,2*4,5*0,2404*53,4*32, - &3*0,6*32,3*0,4*32,3*0,4*32,8*0,8*32,14*0,16*32,12*0,8*32,8*0, - &46*32,3*53,12*0,8*32,12*0,66*51,6*32,9*0,9*32,3733*0/ - DATA (BRAT(I) ,I= 1, 346)/43*0D0,0.00003D0,0.001765D0, - &0.998205D0,35*0D0,1D0,6*0D0,0.1783D0,0.1735D0,0.1131D0,0.2494D0, - &0.003D0,0.09D0,0.0027D0,0.01D0,0.0014D0,0.0012D0,2*0.00025D0, - &0.0071D0,0.012D0,0.0004D0,0.00075D0,0.00006D0,2*0.00078D0, - &0.0034D0,0.08D0,0.011D0,0.0191D0,0.00006D0,0.005D0,0.0133D0, - &0.0067D0,0.0005D0,0.0035D0,0.0006D0,0.0015D0,0.00021D0,0.0002D0, - &0.00075D0,0.0001D0,0.0002D0,0.0011D0,3*0.0002D0,0.00022D0, - &0.0004D0,0.0001D0,2*0.00205D0,2*0.00069D0,0.00025D0,0.00051D0, - &0.00025D0,35*0D0,0.153995D0,0.11942D0,0.153984D0,0.119259D0, - &0.152272D0,3*0D0,0.033576D0,0.066806D0,0.033576D0,0.066806D0, - &0.0335D0,0.066806D0,2*0D0,0.321369D0,0.016494D0,2*0D0,0.016502D0, - &0.320615D0,2*0D0,0.00001D0,0.000591D0,6*0D0,2*0.108166D0, - &0.108087D0,0D0,0.000001D0,0D0,0.000349D0,0.048707D0,0.768308D0, - &4*0D0,0.000227D0,0.064048D0,0D0,0.040621D0,0.002043D0,0.000615D0, - &0.006981D0,0.068099D0,62*0D0,0.145835D0,0.113276D0,0.145835D0, - &0.113271D0,0.145781D0,0.049002D0,2*0D0,0.032025D0,0.063642D0, - &0.032025D0,0.063642D0,0.032022D0,0.063642D0,8*0D0,0.251225D0, - &0.0129D0,0.000006D0,0D0,0.0129D0,0.250764D0,0.00038D0,0D0, - &0.000008D0,0.000465D0,0.215418D0,5*0D0,2*0.085312D0,0.08531D0, - &7*0D0,0.000049D0,0.000774D0,5*0D0,0.000074D0,0D0,0.000417D0/ - DATA (BRAT(I) ,I= 347, 651)/0.000015D0,0.000061D0,0.30671D0, - &0.689011D0,0D0,0.002889D0,69*0D0,0.000001D0,0.000121D0, - &0.001924D0,4*0D0,0.000001D0,0.000184D0,0D0,0.003106D0,0.000015D0, - &0.000003D0,2*0D0,0.994646D0,66*0D0,0.000021D0,0.090135D0,2*0D0, - &0.000013D0,0.003714D0,0D0,0.906117D0,18*0D0,3*0.215119D0, - &0.214724D0,2*0D0,0.06996D0,0.069959D0,0D0,2*1D0,2*0.08D0,0.76D0, - &0.08D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,0.988D0,0.012D0,0.998739D0,0.00079D0,0.00038D0, - &0.000046D0,0.000045D0,2*0.34725D0,0.144D0,0.104D0,0.0245D0, - &2*0.01225D0,0.0028D0,0.0057D0,0.2112D0,0.1256D0,2*0.1939D0, - &2*0.1359D0,0.002D0,0.001D0,0.0006D0,0.999877D0,0.000123D0, - &0.99955D0,0.00045D0,2*0.34725D0,0.144D0,0.104D0,0.049D0,0.0028D0, - &0.0057D0,0.3923D0,0.321D0,0.2317D0,0.0478D0,0.0049D0,0.0013D0, - &0.0003D0,0.0007D0,0.89D0,0.08693D0,0.0221D0,0.00083D0, - &2*0.00007D0,0.564D0,0.282D0,0.072D0,0.028D0,0.023D0,2*0.0115D0, - &0.005D0,0.003D0,0.6861D0,0.3139D0,2*0.5D0,0.665D0,0.333D0, - &0.002D0,0.333D0,0.166D0,0.168D0,0.084D0,0.087D0,0.043D0,0.059D0, - &2*0.029D0,0.002D0,0.6352D0,0.2116D0,0.0559D0,0.0173D0,0.0482D0, - &0.0318D0,0.666D0,0.333D0,0.001D0,0.332D0,0.166D0,0.168D0,0.084D0, - &0.086D0,0.043D0,0.059D0,2*0.029D0,2*0.002D0,0.437D0,0.208D0/ - DATA (BRAT(I) ,I= 652, 823)/0.302D0,0.0302D0,0.0212D0,0.0016D0, - &0.48947D0,0.34D0,3*0.043D0,0.027D0,0.0126D0,0.0013D0,0.0003D0, - &0.00025D0,0.00008D0,0.444D0,2*0.222D0,0.104D0,2*0.004D0,0.07D0, - &0.065D0,2*0.005D0,2*0.011D0,5*0.001D0,0.07D0,0.065D0,2*0.005D0, - &2*0.011D0,5*0.001D0,0.026D0,0.019D0,0.066D0,0.041D0,0.045D0, - &0.076D0,0.0073D0,2*0.0047D0,0.026D0,0.001D0,0.0006D0,0.0066D0, - &0.005D0,2*0.003D0,2*0.0006D0,2*0.001D0,0.006D0,0.005D0,0.012D0, - &0.0057D0,0.067D0,0.008D0,0.0022D0,0.027D0,0.004D0,0.019D0, - &0.012D0,0.002D0,0.009D0,0.0218D0,0.001D0,0.022D0,0.087D0,0.001D0, - &0.0019D0,0.0015D0,0.0028D0,0.683D0,0.306D0,0.011D0,0.3D0,0.15D0, - &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.034D0,0.027D0, - &2*0.002D0,2*0.004D0,2*0.002D0,0.034D0,0.027D0,2*0.002D0, - &2*0.004D0,2*0.002D0,0.0365D0,0.045D0,0.073D0,0.062D0,3*0.021D0, - &0.0061D0,0.015D0,0.025D0,0.0088D0,0.074D0,0.0109D0,0.0041D0, - &0.002D0,0.0035D0,0.0011D0,0.001D0,0.0027D0,2*0.0016D0,0.0018D0, - &0.011D0,0.0063D0,0.0052D0,0.018D0,0.016D0,0.0034D0,0.0036D0, - &0.0009D0,0.0006D0,0.015D0,0.0923D0,0.018D0,0.022D0,0.0077D0, - &0.009D0,0.0075D0,0.024D0,0.0085D0,0.067D0,0.0511D0,0.017D0, - &0.0004D0,0.0028D0,0.619D0,0.381D0,0.3D0,0.15D0,0.16D0,0.08D0, - &0.13D0,0.06D0,0.08D0,0.04D0,0.01D0,2*0.02D0,0.03D0,2*0.005D0/ - DATA (BRAT(I) ,I= 824, 991)/2*0.02D0,0.03D0,2*0.005D0,0.015D0, - &0.037D0,0.028D0,0.079D0,0.095D0,0.052D0,0.0078D0,4*0.001D0, - &0.028D0,0.033D0,0.026D0,0.05D0,0.01D0,4*0.005D0,0.25D0,0.0952D0, - &0.94D0,0.06D0,2*0.4D0,2*0.1D0,1D0,0.0602D0,0.0601D0,0.8797D0, - &0.135D0,0.865D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.02D0, - &0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0, - &0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0,0.0135D0, - &0.025D0,0.0004D0,0.0007D0,0.0008D0,0.0014D0,0.0019D0,0.0025D0, - &0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0, - &0.16D0,0.08D0,0.13D0,0.06D0,0.08D0,0.04D0,0.02D0,0.055D0, - &2*0.005D0,0.008D0,0.012D0,0.02D0,0.055D0,2*0.005D0,0.008D0, - &0.012D0,0.01D0,0.03D0,0.0035D0,0.011D0,0.0055D0,0.0042D0,0.009D0, - &0.018D0,0.015D0,0.0185D0,0.0135D0,0.025D0,0.0004D0,0.0007D0, - &0.0008D0,0.0014D0,0.0019D0,0.0025D0,0.4291D0,0.08D0,0.07D0, - &0.02D0,0.015D0,0.005D0,1D0,0.3D0,0.15D0,0.16D0,0.08D0,0.13D0, - &0.06D0,0.08D0,0.04D0,0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0, - &0.02D0,0.055D0,2*0.005D0,0.008D0,0.012D0,0.01D0,0.03D0,0.0035D0, - &0.011D0,0.0055D0,0.0042D0,0.009D0,0.018D0,0.015D0,0.0185D0, - &0.0135D0,0.025D0,2*0.0002D0,0.0007D0,2*0.0004D0,0.0014D0,0.001D0, - &0.0009D0,0.0025D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0/ - DATA (BRAT(I) ,I= 992,1183)/1D0,2*0.3D0,2*0.2D0,0.047D0,0.122D0, - &0.006D0,0.012D0,0.035D0,0.012D0,0.035D0,0.003D0,0.007D0,0.15D0, - &0.037D0,0.008D0,0.002D0,0.05D0,0.015D0,0.003D0,0.001D0,0.014D0, - &0.042D0,0.014D0,0.042D0,0.24D0,0.065D0,0.012D0,0.003D0,0.001D0, - &0.002D0,0.001D0,0.002D0,0.014D0,0.003D0,1D0,2*0.3D0,2*0.2D0,1D0, - &0.0252D0,0.0248D0,0.0267D0,0.015D0,0.045D0,0.015D0,0.045D0, - &0.7743D0,0.029D0,0.22D0,0.78D0,1D0,0.331D0,0.663D0,0.006D0, - &0.663D0,0.331D0,0.006D0,1D0,0.999D0,0.001D0,0.88D0,2*0.06D0, - &0.639D0,0.358D0,0.002D0,0.001D0,1D0,0.88D0,2*0.06D0,0.516D0, - &0.483D0,0.001D0,0.88D0,2*0.06D0,0.9988D0,0.0001D0,0.0006D0, - &0.0004D0,0.0001D0,0.667D0,0.333D0,0.9954D0,0.0011D0,0.0035D0, - &0.333D0,0.667D0,0.676D0,0.234D0,0.085D0,0.005D0,2*1D0,0.018D0, - &2*0.005D0,0.003D0,0.002D0,2*0.006D0,0.018D0,2*0.005D0,0.003D0, - &0.002D0,2*0.006D0,0.0066D0,0.025D0,0.016D0,0.0088D0,2*0.005D0, - &0.0058D0,0.005D0,0.0055D0,4*0.004D0,2*0.002D0,2*0.004D0,0.003D0, - &0.002D0,2*0.003D0,3*0.002D0,2*0.001D0,0.002D0,2*0.001D0, - &2*0.002D0,0.0013D0,0.0018D0,5*0.001D0,4*0.003D0,2*0.005D0, - &2*0.002D0,2*0.001D0,2*0.002D0,2*0.001D0,0.2432D0,0.057D0, - &2*0.035D0,0.15D0,2*0.075D0,0.03D0,2*0.015D0,2*0.08D0,0.76D0, - &0.08D0,4*1D0,2*0.08D0,0.76D0,0.08D0,1D0,2*0.5D0,1D0,2*0.5D0/ - DATA (BRAT(I) ,I=1184,1377)/2*0.08D0,0.76D0,0.08D0,1D0,2*0.08D0, - &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,3*0.08D0, - &0.76D0,3*0.08D0,0.76D0,3*0.08D0,0.76D0,0.08D0,2*1D0,2*0.105D0, - &0.04D0,0.0077D0,0.02D0,0.0235D0,0.0285D0,0.0435D0,0.0011D0, - &0.0022D0,0.0044D0,0.4291D0,0.08D0,0.07D0,0.02D0,0.015D0,0.005D0, - &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, - &2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0, - &4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0,0.015D0, - &0.005D0,4*1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,1D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0, - &0.015D0,0.005D0,2*0.105D0,0.04D0,0.5D0,0.08D0,0.14D0,0.01D0/ - DATA (BRAT(I) ,I=1378,1580)/0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,2*0.105D0,0.04D0, - &0.5D0,0.08D0,0.14D0,0.01D0,0.015D0,0.005D0,4*1D0,0.52D0,0.26D0, - &0.11D0,2*0.055D0,0.333D0,0.334D0,0.333D0,0.667D0,0.333D0,0.28D0, - &0.14D0,0.313D0,0.157D0,0.11D0,0.667D0,0.333D0,0.28D0,0.14D0, - &0.313D0,0.157D0,0.11D0,0.36D0,0.18D0,0.03D0,2*0.015D0,2*0.2D0, - &4*0.25D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,0.667D0, - &0.333D0,4*0.5D0,0.007D0,0.993D0,1D0,0.667D0,0.333D0,0.667D0, - &0.333D0,0.667D0,0.333D0,0.667D0,0.333D0,8*0.5D0,0.02D0,0.98D0, - &1D0,4*0.5D0,3*0.146D0,3*0.05D0,0.15D0,2*0.05D0,4*0.024D0,0.066D0, - &0.667D0,0.333D0,0.667D0,0.333D0,4*0.25D0,0.667D0,0.333D0,0.667D0, - &0.333D0,2*0.5D0,0.273D0,0.727D0,0.667D0,0.333D0,0.667D0,0.333D0, - &4*0.5D0,0.35D0,0.65D0,2*0.0083D0,0.1866D0,0.324D0,0.184D0, - &0.027D0,0.001D0,0.093D0,0.087D0,0.078D0,0.0028D0,3*0.014D0/ - DATA (BRAT(I) ,I=1581,4149)/0.008D0,0.024D0,0.008D0,0.024D0, - &0.425D0,0.02D0,0.185D0,0.088D0,0.043D0,0.067D0,0.066D0,2404*0D0, - &0.017431D0,0.054048D0,0.857694D0,2*0D0,0.00025D0,0.070578D0,0D0, - &0.022748D0,0.026576D0,0.359486D0,0.561581D0,2*0D0,0.000104D0, - &0.029504D0,0.011185D0,0.034681D0,0.550354D0,2*0D0,0.00016D0, - &0.045287D0,0.358333D0,0.445781D0,0D0,0.554219D0,0.144051D0, - &2*0.351902D0,0D0,0.082107D0,0.029566D0,0.001511D0,0.000726D0, - &0.004518D0,0.006522D0,0.004518D0,0.006522D0,0.004513D0,3*0D0, - &0.002908D0,0.000973D0,0.002908D0,0.000973D0,0.002908D0, - &0.000973D0,2*0D0,0.143982D0,0.489888D0,0.1951D0,0D0,0.114302D0, - &0.008426D0,0.014868D0,0.000763D0,2*0D0,0.000763D0,0.01484D0, - &0.000003D0,2*0D0,0.000027D0,0.001945D0,5*0D0,3*0.00503D0,0D0, - &0.133776D0,0.003284D0,0.37169D0,0.006838D0,2*0.030954D0, - &0.00163D0,0D0,0.047224D0,0.073737D0,0.047224D0,0.073732D0, - &0.047179D0,3*0D0,0.034761D0,0.009166D0,0.034761D0,0.009166D0, - &0.034759D0,0.009166D0,2*0D0,4*0.009069D0,0.510147D0,0.453576D0, - &6*0D0,1D0,6*0D0,1D0,4*0.001128D0,0.571047D0,0.382288D0, - &0.042153D0,4*0.016597D0,0.93361D0,0D0,4*0.016597D0,0.93361D0,0D0, - &4*0.05515D0,0.34469D0,0D0,0.228998D0,0.164208D0,0.041503D0, - &0.850973D0,0.005411D0,0.045025D0,0.098591D0,0.849898D0/ - DATA (BRAT(I) ,I=4150,4280)/0.021617D0,0.030018D0,0.098466D0, - &0.294448D0,0.10945D0,0.596102D0,0.389906D0,0.610094D0,3*0.0633D0, - &0.063299D0,0.063295D0,0.056281D0,2*0D0,6*0.020495D0,2*0D0, - &0.327919D0,0.04099D0,0.045236D0,0.090112D0,0.19874D0,0.010204D0, - &0.000003D0,0.010205D0,0.198356D0,0.000151D0,0.000006D0, - &0.000367D0,0.081967D0,0.19874D0,0.010204D0,0.000003D0,0.010205D0, - &0.198356D0,0.000151D0,0.000006D0,0.000367D0,0.081967D0,4*0D0, - &0.198776D0,0.010206D0,0.000003D0,0.010207D0,0.19839D0,0.000151D0, - &0.000006D0,0.000367D0,0.081893D0,0.198776D0,0.010206D0, - &0.000003D0,0.010207D0,0.19839D0,0.000151D0,0.000006D0,0.000367D0, - &0.081893D0,4*0D0,0.199344D0,0.010234D0,0.000003D0,0.010236D0, - &0.198928D0,0.000149D0,0.000006D0,0.000368D0,0.080733D0, - &0.199344D0,0.010234D0,0.000003D0,0.010236D0,0.198928D0, - &0.000149D0,0.000006D0,0.000368D0,0.080733D0,4*0D0,0.184738D0, - &0.104588D0,0.184738D0,0.104587D0,0.184731D0,0.09582D0,0.022902D0, - &0.008429D0,0.015602D0,0.022902D0,0.008429D0,0.015602D0, - &0.022902D0,0.008429D0,0.015602D0,0.28959D0,0.01487D0,0.000008D0, - &0.01487D0,0.289061D0,0.000492D0,0.000009D0,0.000536D0,0.27911D0, - &2*0.037151D0,0.03715D0,0.090266D0,2*0.001805D0,0.090266D0, - &0.001805D0,0.812263D0,0.00179D0,0.090428D0,0.001809D0,0.001808D0/ - DATA (BRAT(I) ,I=4281,8000)/0.090428D0,0.001808D0,0.81372D0,0D0, - &3716*0D0/ - DATA (KFDP(I,1),I= 1, 377)/21,22,23,4*-24,25,21,22,23,4*24,25, - &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, - &4*24,25,37,1000022,1000023,1000025,1000035,1000021,1000039,21,22, - &23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,-24,25,23,24,-12, - &22,23,-24,25,23,24,-12,-14,48*16,22,23,-24,25,23,24,22,23,-24,25, - &-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,1,2, - &3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11,-13, - &-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1000022, - &2*1000023,3*1000025,4*1000035,2*1000024,2*1000037,1000001, - &2000001,1000001,-1000001,1000002,2000002,1000002,-1000002, - &1000003,2000003,1000003,-1000003,1000004,2000004,1000004, - &-1000004,1000005,2000005,1000005,-1000005,1000006,2000006, - &1000006,-1000006,1000011,2000011,1000011,-1000011,1000012, - &2000012,1000012,-1000012,1000013,2000013,1000013,-1000013, - &1000014,2000014,1000014,-1000014,1000015,2000015,1000015, - &-1000015,1000016,2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,12, - &13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5,4*-7,-11,-13, - &-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,25,24, - &37,23,25,36,1000022,2*1000023,3*1000025,4*1000035,2*1000024, - &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002/ - DATA (KFDP(I,1),I= 378, 580)/1000002,-1000002,1000003,2000003, - &1000003,-1000003,1000004,2000004,1000004,-1000004,1000005, - &2000005,1000005,-1000005,1000006,2000006,1000006,-1000006, - &1000011,2000011,1000011,-1000011,1000012,2000012,1000012, - &-1000012,1000013,2000013,1000013,-1000013,1000014,2000014, - &1000014,-1000014,1000015,2000015,1000015,-1000015,1000016, - &2000016,1000016,-1000016,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23, - &24,23,25,24,37,1000022,2*1000023,3*1000025,4*1000035,2*1000024, - &2*1000037,1000001,2000001,1000001,-1000001,1000002,2000002, - &1000002,-1000002,1000003,2000003,1000003,-1000003,1000004, - &2000004,1000004,-1000004,1000005,2000005,1000005,-1000005, - &1000006,2000006,1000006,-1000006,1000011,2000011,1000011, - &-1000011,1000012,2000012,1000012,-1000012,1000013,2000013, - &1000013,-1000013,1000014,2000014,1000014,-1000014,1000015, - &2000015,1000015,-1000015,1000016,2000016,1000016,-1000016,-1,-3, - &-5,-7,-11,-13,-15,-17,24,2*1000022,2*1000023,2*1000025,2*1000035, - &1000006,2000006,1000006,2000006,-1000001,-1000003,-1000011, - &-1000013,-1000015,-2000015,1,2,3,4,5,6,11,13,15,2,82,-11,-13,2*2, - &-12,-14,-16,2*-2,2*-4,-2,-4,2*22,211,111,221,13,11,213,-213,221, - &223,321,130,310,111,331,111,211,-12,12,-14,14,211,111,22,-13,-11/ - DATA (KFDP(I,1),I= 581, 992)/2*211,213,113,221,223,321,211,331, - &22,111,211,2*22,211,22,111,211,22,211,221,111,11,211,111,2*211, - &321,130,310,221,111,211,111,130,310,321,2*311,321,311,323,313, - &323,313,321,3*311,-13,3*211,12,14,311,2*321,311,321,313,323,313, - &323,311,4*321,211,111,3*22,111,321,130,-213,113,213,211,22,111, - &11,13,211,321,130,310,221,211,111,11*-11,11*-13,-311,-313,-311, - &-313,-20313,2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223, - &2*333,-311,-313,2*-321,211,-311,-321,333,-311,-313,-321,211, - &2*-321,2*-311,-321,211,113,421,2*411,421,411,423,413,423,413,421, - &411,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,-313,2*-311, - &-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,3*-321,-311, - &-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,-321,3*-311, - &211,113,321,2*421,411,421,413,423,413,423,411,421,-15,5*-11, - &5*-13,221,331,333,221,331,333,10221,211,213,211,213,321,323,321, - &323,2212,221,331,333,221,2*2,2*431,421,411,423,413,82,11,13,82, - &443,82,6*12,6*14,2*16,3*-411,3*-413,2*-411,2*-413,2*441,2*443, - &2*20443,2*2,2*4,2,4,511,521,511,523,513,523,513,521,511,6*12, - &6*14,2*16,3*-421,3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2, - &2*4,2,4,521,511,521,513,523,513,523,511,521,6*12,6*14,2*16, - &3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,531/ - DATA (KFDP(I,1),I= 993,1402)/521,511,523,513,16,2*4,2*12,2*14, - &2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,2*-1,541,511,521, - &513,523,21,11,13,15,1,2,3,4,21,22,553,21,2112,2212,2*2112,2212, - &2112,2*2212,2112,-12,3122,3212,3112,2212,2*2112,-12,2*3122,3222, - &3112,2212,2112,2212,3122,3222,3212,3122,3112,-12,-14,-12,3322, - &3312,2*3122,3212,3322,3312,3122,3322,3312,-12,2*4122,7*-11,7*-13, - &2*2224,2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322, - &3324,2*2224,7*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214, - &2*3222,2*3224,4*2,3,2*2,1,2*2,-11,-13,2*2,4*4122,-11,-13,2*2, - &3*4132,3*4232,-11,-13,2*2,4332,-11,-13,2*2,-11,-13,2*2,-11,-13, - &2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,-11,-13,2*2,2*5122,-12, - &-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,4*5122,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,2*5132,2*5232,-12,-14,-16, - &2*-2,2*-4,-2,-4,5332,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, - &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2, - &2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, - &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, - &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16, - &2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2/ - DATA (KFDP(I,1),I=1403,1713)/2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2, - &-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,-12, - &-14,-16,2*-2,2*-4,-2,-4,-12,-14,-16,2*-2,2*-4,-2,-4,221,223,221, - &223,211,111,321,130,310,213,113,-213,321,311,321,311,323,313, - &2*311,321,311,321,313,323,321,211,111,321,130,310,2*211,313,-313, - &323,-323,421,411,423,413,411,421,413,423,411,421,423,413,443, - &2*82,521,511,523,513,511,521,513,523,521,511,523,513,511,521,513, - &523,553,2*21,213,-213,113,213,10211,10111,-10211,2*221,213,2*113, - &-213,2*321,2*311,113,323,2*313,323,313,-313,323,-323,423,2*413, - &2*423,413,443,82,523,2*513,2*523,2*513,523,553,21,11,13,82,4*443, - &10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,10551,20553,555, - &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &1000002,2000002,1000002,2000002,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, - &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000001, - &2000001,1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3, - &1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6, - &1000039,1000024,1000037,1000022,1000023,1000025,1000035,1000003/ - DATA (KFDP(I,1),I=1714,1984)/2000003,1000003,2000003,1000021, - &3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024,-1000037,1000022, - &1000023,1000025,1000035,1000006,2000006,1000006,2000006,1000021, - &3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13,14,13,16,15,16, - &15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037,1000022,1000023, - &1000025,1000035,1000005,2000005,1000005,2000005,1000021,1000022, - &1000016,-1000015,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, - &-1000037,1000022,1000023,1000025,1000035,1000012,2000012,1000012, - &2*12,2*14,2*16,3*-14,3*-16,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000011,2000011,1000011, - &2000011,3*-13,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,1000014,2000014,1000014,2000014, - &2*12,2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000013,2000013,1000013, - &2000013,3*-11,3*-15,3*-1,3*-3,3*-5,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,1000016,2000016,1000016,2000016, - &2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,1000039,1000024, - &1000037,1000022,1000023,1000025,1000035,1000015,2000015,1000015, - &2000015,3*-11,3*-13,3*-1,3*-3,3*-5,1000039,1000001,-1000001, - &2000001,-2000001,1000002,-1000002,2000002,-2000002,1000003/ - DATA (KFDP(I,1),I=1985,2321)/-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,6*1000022,6*1000023,6*1000025, - &6*1000035,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000037,-1000037,1000037,-1000037,1000037,-1000037,-12,12,-11,11, - &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12, - &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13, - &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14, - &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15, - &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16, - &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2, - &-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039,4,1,-12,12,-12,12,-12,12, - &-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14,14,-14,14,-14,14, - &-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12,12,-11,11,-12,12, - &-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11, - &-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14,14,-13,13,-14,14, - &-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13, - &-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16,16,-15,15,-16,16, - &-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15, - &-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2,-2,2,-2,2,-4,4,-4/ - DATA (KFDP(I,1),I=2322,2573)/4,-4,4,-6,6,-6,6,-6,6,5*1000039, - &16*1000022,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000037, - &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037, - &1000037,-1000037,1000037,-1000037,1000024,-1000024,1000037, - &-1000037,1000001,-1000001,2000001,-2000001,1000002,-1000002, - &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, - &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, - &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, - &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, - &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, - &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, - &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, - &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, - &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16/ - DATA (KFDP(I,1),I=2574,2892)/16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4, - &-4,4,-6,6,-6,6,-6,6,2*1000039,6*1000022,6*1000023,6*1000025, - &6*1000035,1000022,1000023,1000025,1000035,1000002,2000002, - &-1000001,-2000001,1000004,2000004,-1000003,-2000003,1000006, - &2000006,-1000005,-2000005,1000012,2000012,-1000011,-2000011, - &1000014,2000014,-1000013,-2000013,1000016,2000016,-1000015, - &-2000015,2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, - &-12,12,-11,-12,12,-11,-14,-13,-14,-13,-14,-13,-14,14,-13,-14,14, - &-13,-14,14,-13,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15,-16,-15, - &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12, - &-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-14,2*-13,14, - &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14, - &-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16,2*-15,16,-16,2*-15,16, - &-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16, - &-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1,2,-1,3*2,-1,2*4,-3, - &3*4,-3,2*6,5*1000039,16*1000022,16*1000023,1000024,-1000024, - &1000024,-1000024,1000024,-1000024,1000024,-1000024,1000024, - &-1000024,1000024,-1000024,1000037,-1000037,1000037,-1000037, - &1000037,-1000037,1000037,-1000037,1000037,-1000037,1000037, - &-1000037,1000024,-1000024,1000037,-1000037,1000001,-1000001/ - DATA (KFDP(I,1),I=2893,3182)/2000001,-2000001,1000002,-1000002, - &2000002,-2000002,1000003,-1000003,2000003,-2000003,1000004, - &-1000004,2000004,-2000004,1000005,-1000005,2000005,-2000005, - &1000006,-1000006,2000006,-2000006,1000011,-1000011,2000011, - &-2000011,1000012,-1000012,2000012,-2000012,1000013,-1000013, - &2000013,-2000013,1000014,-1000014,2000014,-2000014,1000015, - &-1000015,2000015,-2000015,1000016,-1000016,2000016,-2000016, - &5*1000021,-12,12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14, - &14,-14,14,-14,14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16, - &16,-16,16,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12, - &12,-11,11,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14, - &14,-13,13,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16, - &16,-15,15,-2,2,-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,5*1000039, - &16*1000022,16*1000023,16*1000025,1000024,-1000024,1000024, - &-1000024,1000024,-1000024,1000024,-1000024,1000024,-1000024, - &1000024,-1000024,1000037,-1000037,1000037,-1000037,1000037, - &-1000037,1000037,-1000037,1000037,-1000037,1000037,-1000037/ - DATA (KFDP(I,1),I=3183,3459)/1000024,-1000024,1000037,-1000037, - &1000001,-1000001,2000001,-2000001,1000002,-1000002,2000002, - &-2000002,1000003,-1000003,2000003,-2000003,1000004,-1000004, - &2000004,-2000004,1000005,-1000005,2000005,-2000005,1000006, - &-1000006,2000006,-2000006,1000011,-1000011,2000011,-2000011, - &1000012,-1000012,2000012,-2000012,1000013,-1000013,2000013, - &-2000013,1000014,-1000014,2000014,-2000014,1000015,-1000015, - &2000015,-2000015,1000016,-1000016,2000016,-2000016,5*1000021,-12, - &12,-12,12,-12,12,-12,12,-12,12,-12,12,-14,14,-14,14,-14,14,-14, - &14,-14,14,-14,14,-16,16,-16,16,-16,16,-16,16,-16,16,-16,16,-12, - &12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11, - &11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-12,12,-11,11,-14, - &14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13, - &13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-14,14,-13,13,-16, - &16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15, - &15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-16,16,-15,15,-2,2, - &-2,2,-2,2,-4,4,-4,4,-4,4,-6,6,-6,6,-6,6,2*1000039,15*1000024, - &6*1000022,6*1000023,6*1000025,6*1000035,1000022,1000023,1000025, - &1000035,1000002,2000002,-1000001,-2000001,1000004,2000004, - &-1000003,-2000003,1000006,2000006,-1000005,-2000005,1000012/ - DATA (KFDP(I,1),I=3460,3782)/2000012,-1000011,-2000011,1000014, - &2000014,-1000013,-2000013,1000016,2000016,-1000015,-2000015, - &2*1000021,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11,-12,12,-11, - &-12,12,-11,-14,14,-13,-14,14,-13,-14,14,-13,-14,14,-13,-14,14, - &-13,-14,14,-13,-16,16,-15,-16,16,-15,-16,16,-15,-16,16,-15,-16, - &16,-15,-16,16,-15,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, - &2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12,2*-11,12,-12, - &2*-11,12,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14, - &2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-14,2*-13,14,-16, - &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,-16, - &2*-15,16,-16,2*-15,16,-16,2*-15,16,-16,2*-15,16,2,-1,2,-1,2*2,-1, - &2,-1,3*2,-1,2*4,-3,3*4,-3,2*6,1000039,-1000024,-1000037,1000022, - &1000023,1000025,1000035,4*1000001,1000002,2000002,1000002, - &2000002,1000021,3*-12,3*-14,3*-16,12,11,12,11,12,11,14,13,14,13, - &14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039,1000024,1000037, - &1000022,1000023,1000025,1000035,4*1000002,1000001,2000001, - &1000001,2000001,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039, - &-1000024,-1000037,1000022,1000023,1000025,1000035,4*1000003, - &1000004,2000004,1000004,2000004,1000021,3*-12,3*-14,3*-16,12,11, - &12,11,12,11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6/ - DATA (KFDP(I,1),I=3783,4127)/1000039,1000024,1000037,1000022, - &1000023,1000025,1000035,4*1000004,1000003,2000003,1000003, - &2000003,1000021,3*-11,3*-13,3*-15,2*-1,-3,1000039,-1000024, - &-1000037,1000022,1000023,1000025,1000035,4*1000005,1000006, - &2000006,1000006,2000006,1000021,3*-12,3*-14,3*-16,12,11,12,11,12, - &11,14,13,14,13,14,13,16,15,16,15,16,15,2*-2,2*-4,2*-6,1000039, - &1000024,1000037,1000022,1000023,1000025,1000035,4*1000006, - &1000005,2000005,1000005,2000005,1000021,3*-11,3*-13,3*-15,2*-1, - &-3,1000039,-1000024,-1000037,1000022,1000023,1000025,1000035, - &4*1000011,1000012,2000012,1000012,2000012,2*12,2*14,2*16,3*-14, - &3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037,1000022,1000023, - &1000025,1000035,4*1000013,1000014,2000014,1000014,2000014,2*12, - &2*14,2*16,3*-12,3*-16,3*-2,3*-4,3*-6,1000039,-1000024,-1000037, - &1000022,1000023,1000025,1000035,4*1000015,1000016,2000016, - &1000016,2000016,2*12,2*14,2*16,3*-12,3*-14,3*-2,3*-4,3*-6,3,4,5, - &6,11,13,15,21,2*4,2,4,24,-11,-13,-15,3,4,5,6,11,13,15,21,5,6,21, - &2*24,2*3000211,2*22,2*23,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, - &2*24,3*3000211,24,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,22,23,22, - &23,24,3000211,24,3000211,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18, - &1,2,3,4,5,6,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4,5,6,21,1,2,3,4/ - DATA (KFDP(I,1),I=4128,8000)/5,6,1,2,3,4,5,6,1,2,3,4,5,6,21, - &3100111,3200111,21,22,23,-24,21,22,23,24,22,23,-24,23,24,1,2,3,4, - &5,6,7,8,11,12,13,14,15,16,17,18,21,22,23,24,9*11,9*-11,2*11, - &2*-11,9*13,9*-13,2*13,2*-13,9*15,9*-15,2*15,2*-15,1,2,3,4,5,6,11, - &12,9900012,13,14,9900014,15,16,9900016,3*-1,3*-3,3*-5,-11,-13, - &-15,3*-11,2*-13,-15,24,3*-11,2*-13,-15,9900024,3716*0/ - DATA (KFDP(I,2),I= 1, 339)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, - &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,6*1000006,3*7, - &2,4,6,8,7,4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14, - &13,11,13,-211,-213,-211,-213,-211,-213,-211,-213,2*-211,-321, - &-323,-321,2*-323,3*-321,4*-211,-213,-211,-213,-211,-213,-211, - &-213,-211,-213,3*-211,-213,4*-211,-323,-321,2*-211,2*-321,3*-211, - &2*15,16,15,16,15,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, - &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, - &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, - &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, - &-24,2*1000022,1000023,1000022,1000023,1000025,1000022,1000023, - &1000025,1000035,-1000024,-1000037,-1000024,-1000037,-1000001, - &2*-2000001,2000001,-1000002,2*-2000002,2000002,-1000003, - &2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, - &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, - &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, - &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, - &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, - &-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37,22,25,2*36,2,4,6,8, - &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25,-1,-2,-3,-4,-5,-6/ - DATA (KFDP(I,2),I= 340, 533)/-7,-8,-11,-13,-15,-17,21,22,2*23, - &-24,2*25,-37,-24,3*36,2*1000022,1000023,1000022,1000023,1000025, - &1000022,1000023,1000025,1000035,-1000024,-1000037,-1000024, - &-1000037,-1000001,2*-2000001,2000001,-1000002,2*-2000002,2000002, - &-1000003,2*-2000003,2000003,-1000004,2*-2000004,2000004,-1000005, - &2*-2000005,2000005,-1000006,2*-2000006,2000006,-1000011, - &2*-2000011,2000011,-1000012,2*-2000012,2000012,-1000013, - &2*-2000013,2000013,-1000014,2*-2000014,2000014,-1000015, - &2*-2000015,2000015,-1000016,2*-2000016,2000016,-1,-2,-3,-4,-5,-6, - &-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,-37,-24,2*1000022, - &1000023,1000022,1000023,1000025,1000022,1000023,1000025,1000035, - &-1000024,-1000037,-1000024,-1000037,-1000001,2*-2000001,2000001, - &-1000002,2*-2000002,2000002,-1000003,2*-2000003,2000003,-1000004, - &2*-2000004,2000004,-1000005,2*-2000005,2000005,-1000006, - &2*-2000006,2000006,-1000011,2*-2000011,2000011,-1000012, - &2*-2000012,2000012,-1000013,2*-2000013,2000013,-1000014, - &2*-2000014,2000014,-1000015,2*-2000015,2000015,-1000016, - &2*-2000016,2000016,2,4,6,8,12,14,16,18,25,1000024,1000037, - &1000024,1000037,1000024,1000037,1000024,1000037,2*-1000005, - &2*-2000005,1000002,1000004,1000012,1000014,2*1000016,-3,-4,-5,-6/ - DATA (KFDP(I,2),I= 534, 938)/-7,-8,-13,-15,-17,11,-82,12,14,-1, - &-3,11,13,15,1,4,3,4,1,3,22,11,-211,2*22,-13,-11,-211,211,111,211, - &-321,130,310,22,2*111,-211,11,-11,13,-13,-211,111,22,14,12,111, - &22,111,3*211,-311,22,211,22,111,-211,211,11,-211,13,22,-211,111, - &-211,22,111,-11,-211,111,2*-211,-321,130,310,221,111,-211,111, - &2*0,-211,111,22,-211,111,-211,111,-211,211,-213,113,223,221,14, - &111,211,111,-11,-13,211,111,22,211,111,211,111,2*211,213,113,223, - &221,22,-211,111,113,223,22,111,-321,310,211,111,2*-211,221,22, - &-11,-13,-211,-321,130,310,221,-211,111,11*12,11*14,2*211,2*213, - &211,20213,2*321,2*323,211,213,211,213,211,213,211,213,211,213, - &211,213,3*211,213,211,2*321,8*211,2*113,3*211,111,22,211,111,211, - &111,4*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213, - &211,2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310, - &211,-211,4*211,321,4*211,113,2*211,-321,111,22,-211,111,-211,111, - &-211,211,-211,211,16,5*12,5*14,3*211,3*213,211,2*111,2*113, - &2*-311,2*-313,-2112,3*321,323,2*-1,22,111,321,311,321,311,-82, - &-11,-13,-82,22,-82,6*-11,6*-13,2*-15,211,213,20213,211,213,20213, - &431,433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,22, - &-211,111,-211,111,-211,211,-211,211,6*-11,6*-13,2*-15,211,213, - &20213,211,213,20213,431,433,431,433,321,323,321,323,321,323,-1/ - DATA (KFDP(I,2),I= 939,1352)/-4,-3,-4,-1,-3,22,211,111,211,111, - &4*211,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,433,431, - &433,221,331,333,221,331,333,221,331,333,-1,-4,-3,-4,-1,-3,22, - &-321,-311,-321,-311,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,-4,-3, - &-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,411,421,411,421,21, - &-11,-13,-15,-1,-2,-3,-4,2*21,22,21,2*-211,111,22,111,211,22,211, - &-211,11,2*-211,111,-211,111,22,11,22,111,-211,211,111,211,22,211, - &111,211,-211,22,11,13,11,-211,2*111,2*22,111,211,-321,-211,111, - &11,2*-211,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,211, - &213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,-211, - &-213,111,221,331,113,223,333,10221,111,221,331,113,223,211,213, - &211,213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203, - &3201,3203,2203,2101,2103,12,14,-1,-3,2*111,2*211,12,14,-1,-3,22, - &111,2*22,111,22,12,14,-1,-3,22,12,14,-1,-3,12,14,-1,-3,12,14,-1, - &-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,12,14,-1,-3,2*-211,11,13, - &15,-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,11,13,15,1,4,3, - &4,1,3,11,13,15,1,4,3,4,1,3,2*111,2*211,11,13,15,1,4,3,4,1,3,11, - &13,15,1,4,3,4,1,3,4*22,11,13,15,1,4,3,4,1,3,22,11,13,15,1,4,3,4, - &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, - &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3/ - DATA (KFDP(I,2),I=1353,1815)/11,13,15,1,4,3,4,1,3,11,13,15,1,4,3, - &4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4, - &1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1, - &3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3,11,13,15,1,4,3,4,1,3, - &2*111,2*211,-211,111,-321,130,310,-211,111,211,-211,111,-213,113, - &-211,111,223,211,111,213,113,211,111,223,-211,111,-321,130,310, - &2*-211,-311,311,-321,321,211,111,211,111,-211,111,-211,111,311, - &2*321,311,22,2*-82,-211,111,-211,111,211,111,211,111,-321,-311, - &-321,-311,411,421,411,421,22,2*21,-211,2*211,111,-211,111,2*211, - &111,-211,211,111,211,-321,2*-311,-321,22,-211,111,211,111,-311, - &311,-321,321,211,111,-211,111,321,311,22,-82,-211,111,211,111, - &-321,-311,411,421,22,21,-11,-13,-82,211,111,221,111,4*22,-11,-13, - &-15,-1,-2,-3,-4,2*21,211,111,3*22,1,2*2,4*1,2*-24,2*-37,2*1,3,5, - &1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3, - &-5,2,2*1,4*2,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3, - &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, - &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,2*24,2*37,4,1,3,5,1,3,5,1,3,5,-3, - &2*-5,5,2*6,4*5,2*-24,2*-37,5,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3, - &4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6,2*5,4*6,2*24,2*37,6,4,-15, - &16,1,3,5,1,3,5,1,3,5,-3,2*-5,11,2*12,4*11,2*-24,-37,13,15,11,15/ - DATA (KFDP(I,2),I=1816,2317)/11,13,11,13,15,11,13,15,1,3,5,1,3,5, - &1,3,5,12,2*11,4*12,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5, - &13,2*14,4*13,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, - &5,1,3,5,1,3,5,14,2*13,4*14,2*24,2*37,11,13,15,11,13,15,1,3,5,1,3, - &5,1,3,5,15,2*16,4*15,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, - &13,15,1,3,5,1,3,5,1,3,5,16,2*15,4*16,2*24,2*37,11,13,15,11,13,15, - &1,3,5,1,3,5,1,3,5,21,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5, - &5,-5,5,-6,6,-6,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6,1,3,5,2,4,6, - &1,-1,3,-3,5,-5,1,-1,3,-3,5,-5,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3, - &-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2, - &-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5, - &-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4, - &-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1, - &-3,3,-1,1,-1,1,-3,3,22,23,25,35,36,-1,-3,-13,13,-13,13,-13,13, - &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, - &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, - &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, - &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, - &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3/ - DATA (KFDP(I,2),I=2318,2770)/3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22, - &23,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,-24,24,11, - &-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15,-15,1,-1,3, - &-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4,-4,4,-5,5,-5, - &5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13,13,-14,14,-14, - &14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13, - &-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1, - &1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6, - &6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5, - &5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4, - &4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3, - &3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,24,37,24,-11,-13,-15,-1,-3,24, - &-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,4*37, - &2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13,2*14,2*-15,2*16,-1, - &-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15,16,2*-15,16,-15, - &6*-11,-15,16,2*-15,16,2*-15,16,-15,6*-11,6*-13,-1,-2,-1,2,-1,-2, - &-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5, - &-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, - &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1/ - DATA (KFDP(I,2),I=2771,3221)/2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4, - &-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1, - &2*4,-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,22,23,25,35,36,22,23,11,13, - &15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4, - &25,35,36,-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13, - &-13,15,-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3, - &-4,4,-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13, - &-13,13,-14,14,-14,14,-15,15,-15,15,-16,16,-16,16,1,3,5,2,4,-13, - &13,-13,13,-13,13,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11,-15, - &15,-15,15,-15,15,-11,11,-11,11,-11,11,-13,13,-13,13,-13,13,-1,1, - &-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6, - &-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3, - &-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2,2, - &-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5, - &-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,22,23,25,35,36, - &22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14, - &16,1,3,5,2,4,25,35,36,22,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36, - &-24,24,11,-11,13,-13,15,-15,1,-1,3,-3,-24,24,11,-11,13,-13,15, - &-15,1,-1,3,-3,-37,37,-37,37,-1,1,-1,1,-2,2,-2,2,-3,3,-3,3,-4,4, - &-4,4,-5,5,-5,5,-6,6,-6,6,-11,11,-11,11,-12,12,-12,12,-13,13,-13/ - DATA (KFDP(I,2),I=3222,3669)/13,-14,14,-14,14,-15,15,-15,15,-16, - &16,-16,16,1,3,5,2,4,-13,13,-13,13,-13,13,-15,15,-15,15,-15,15, - &-11,11,-11,11,-11,11,-15,15,-15,15,-15,15,-11,11,-11,11,-11,11, - &-13,13,-13,13,-13,13,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3, - &3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-2,2,-1,1,-2, - &2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4,4,-5,5,-6,6,-5,5,-6,6,-5, - &5,-6,6,-1,1,-2,2,-1,1,-2,2,-1,1,-2,2,-3,3,-4,4,-3,3,-4,4,-3,3,-4, - &4,-5,5,-6,6,-5,5,-6,6,-5,5,-6,6,-1,1,-1,1,-3,3,-1,1,-1,1,-3,3,-1, - &1,-1,1,-3,3,24,37,23,11,13,15,12,14,16,1,3,5,2,4,25,35,36,24,-11, - &-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11,-13,-15,-1,-3,24,-11, - &-13,-15,-1,-3,4*37,2*-1,2*2,2*-3,2*4,2*-5,2*6,2*-11,2*12,2*-13, - &2*14,2*-15,2*16,-1,-3,-13,14,2*-13,14,2*-13,14,-13,-15,16,2*-15, - &16,2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-15,16,2*-15,16, - &2*-15,16,-15,-11,12,2*-11,12,2*-11,12,-11,-13,14,2*-13,14,2*-13, - &14,-13,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3, - &-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2, - &-1,-2,-1,2,-3,-4,-3,4,-3,-4,-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5, - &6,-5,-6,-5,6,-1,-2,-1,2,-1,-2,-1,2,-1,-2,-1,2,-3,-4,-3,4,-3,-4, - &-3,4,-3,-4,-3,4,-5,-6,-5,6,-5,-6,-5,6,-5,-6,-5,6,2,-1,2,-1,2*4, - &-3,4,-3,3*6,-5,2*4,-3,3*6,-5,2*6,1,2*2,4*1,23,25,35,36,2*-24/ - DATA (KFDP(I,2),I=3670,4136)/2*-37,2*1,3,5,1,3,5,1,3,5,1,2,3,4,5, - &6,1,2,3,4,5,6,1,2,3,4,5,6,-3,-5,-3,-5,-3,-5,2,2*1,4*2,23,25,35, - &36,2*24,2*37,2,1,3,5,1,3,5,1,3,5,-3,2*-5,3,2*4,4*3,23,25,35,36, - &2*-24,2*-37,3,1,3,5,1,3,5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4, - &5,6,-1,-5,-1,-5,-1,-5,4,2*3,4*4,23,25,35,36,2*24,2*37,4,1,3,5,1, - &3,5,1,3,5,-3,2*-5,5,2*6,4*5,23,25,35,36,2*-24,2*-37,5,1,3,5,1,3, - &5,1,3,5,1,2,3,4,5,6,1,2,3,4,5,6,1,2,3,4,5,6,-1,-3,-1,-3,-1,-3,6, - &2*5,4*6,23,25,35,36,2*24,2*37,6,1,3,5,1,3,5,1,3,5,-3,2*-5,11, - &2*12,4*11,23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11, - &13,15,1,3,5,1,3,5,1,3,5,13,2*14,4*13,23,25,35,36,2*-24,2*-37,13, - &15,11,15,11,13,11,13,15,11,13,15,1,3,5,1,3,5,1,3,5,15,2*16,4*15, - &23,25,35,36,2*-24,2*-37,13,15,11,15,11,13,11,13,15,11,13,15,1,3, - &5,1,3,5,1,3,5,-3,-4,-5,-6,-11,-13,-15,21,-1,-3,2*-5,5,12,14,16, - &-3,-4,-5,-6,-11,-13,-15,21,-5,-6,21,-24,-3000211,-24,-3000211, - &3000111,3000221,3000111,3000221,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12, - &-13,-14,-15,-16,-17,-18,23,3000111,23,3000111,22,3000221,2,4,6,8, - &2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,2*3000111,2*3000221,-3000211, - &2*-24,-3000211,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16, - &-17,-18,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6, - &21,-1,-2,-3,-4,-5,-6,21,-1,-2,-3,-4,-5,-6,-1,-2,-3,-4,-5,-6,-1/ - DATA (KFDP(I,2),I=4137,8000)/-2,-3,-4,-5,-6,3*21,3*1,4*2,1,2*11, - &2*12,11,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18, - &21,22,23,-24,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-13,2*15,3*-1,3*-3, - &3*-5,3*1,3*3,3*5,2*-11,2*15,3*-1,3*-3,3*-5,3*1,3*3,3*5,2*-11, - &2*13,-1,-2,-3,-4,-5,-6,-11,-12,9900012,-13,-14,9900014,-15,-16, - &9900016,2,4,6,2,4,6,2,4,6,9900012,9900014,9900016,-11,-13,-15, - &-13,2*-15,24,-11,-13,-15,-13,2*-15,9900024,3716*0/ - DATA (KFDP(I,3),I= 1,1021)/81*0,14,6*0,2*16,2*0,6*111,310,130, - &2*0,3*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, - &2*113,221,2*113,2*213,-213,113,2*111,310,130,310,130,2*310,130, - &402*0,4*3,4*4,1,4,3,2*2,0,-11,8*0,-211,5*0,2*111,211,-211,211, - &-211,10*0,111,4*0,2*111,-211,-11,11,-13,22,111,3*0,22,3*0,111, - &211,4*0,111,11*0,111,-211,6*0,-211,3*111,7*0,111,-211,5*0,2*221, - &3*0,111,5*0,111,11*0,-311,-313,-311,-321,-313,-323,111,221,331, - &113,223,-311,-313,-311,-321,-313,-323,111,221,331,113,223,22*0, - &111,113,2*211,-211,-311,211,111,3*211,-211,7*211,7*0,111,-211, - &111,-211,-321,-323,-311,-321,-313,-323,-211,-213,-321,-323,-311, - &-321,-313,-323,-211,-213,22*0,111,113,-311,2*-211,211,-211,310, - &-211,2*111,211,2*-211,-321,-211,2*211,-211,111,-211,2*211,6*0, - &111,-211,111,-211,0,221,331,333,321,311,221,331,333,321,311,20*0, - &3,13*0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, - &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, - &111,-211,-421,-423,-10423,-10421,-20423,-425,-421,-423,-10423, - &-10421,-20423,-425,-421,-423,16*0,-4,-1,-4,-3,2*-2,5*0,111,-211, - &111,-211,-431,-433,-10433,-10431,-20433,-435,-431,-433,-10433, - &-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,-3,2*-2,8*0,441,443, - &441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,533,531,533,3,2,3,2/ - DATA (KFDP(I,3),I=1022,2223)/511,513,511,513,1,2,13*0,2*21,11*0, - &2112,6*0,2212,12*0,2*3122,3212,10*0,3322,2*0,3122,3212,3214,2112, - &2114,2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,6*0, - &4*3,4*0,4*3,6*0,4*3,0,28*3,2*0,3*4122,8*0,4,1,4,3,2*2,4*4,1,4,3, - &2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*0,4*4,1,4,3, - &2*2,0,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, - &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, - &3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2, - &4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4,3,2*2,4*4,1,4, - &3,2*2,31*0,211,111,45*0,-211,2*111,-211,3*111,-211,111,211,30*0, - &-211,111,13*0,2*21,-211,111,199*0,2*5,210*0,-1,-3,-5,-2,-4,-6,-1, - &-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-1,-3,-5,-2,-4,-6,-2,2,-4,4,-6, - &6,-2,2,-4,4,-6,6,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3, - &-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,-3,3, - &-5,5,-5,5,5*0,11,12,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, - &-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11, - &-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ - DATA (KFDP(I,3),I=2224,2783)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3, - &-5,5,-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14, - &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, - &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,3*0,12,14,16,2,4,0,12,14,16,2, - &4,0,12,14,16,2,4,0,12,14,16,2,4,28*0,2,4,12,-11,11,14,-13,13,16, - &-15,15,12,-11,11,14,-13,13,16,-15,15,12,11,14,13,16,15,12,-11,11, - &14,-13,13,16,-15,15,12,11,14,13,16,15,12,11,14,13,16,15,2*2,1,-1, - &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1/ - DATA (KFDP(I,3),I=2784,3354)/2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,3,-3,5,-5,1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,7*0, - &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14, - &-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16,-2,2,-4,4,2*0,-12,12, - &-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5, - &-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,-3,3,-5,5,-5,5,7*0,-11,-13,-15,-12,-14,-16, - &-1,-3,-5,-2,-4,5*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0, - &-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4,5*0,-12,12,-14,14,-16,16, - &-2,2,-4,4,2*0,-12,12,-14,14,-16,16,-2,2,-4,4,52*0,-1,-3,-5,-2,-4, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15, - &11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,11,-11,13,-13,15,-15,1, - &-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1, - &-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3, - &-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,1,-1,1,-1,3,-3,3/ - DATA (KFDP(I,3),I=3355,8000)/-3,5,-5,5,-5,1,-1,1,-1,3,-3,3,-3,5, - &-5,5,-5,1,-1,1,-1,3,-3,3,-3,5,-5,5,-5,-3,3,-5,5,-5,5,-3,3,-5,5, - &-5,5,-3,3,-5,5,-5,5,3*0,-11,-13,-15,-12,-14,-16,-1,-3,-5,-2,-4, - &4*0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4,0,12,14,16,2,4, - &28*0,2,4,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16, - &-15,15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15, - &15,12,-11,11,14,-13,13,16,-15,15,12,-11,11,14,-13,13,16,-15,15, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1, - &2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3, - &2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5, - &2*2,1,-1,2*4,3,-3,2*6,5,-5,2*2,1,-1,2*4,3,-3,2*6,5,-5,3,-3,5,-5, - &1,3,-3,5,-5,1,3,5,-5,1,5,-5,1,3,5,-5,1,3,351*0,-5,169*0,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900014,2*9900016,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900016,2,4,6,2, - &4,6,2,4,6,-2,-4,-6,-2,-4,-6,-2,-4,-6,2*9900012,2*9900014,3757*0/ - DATA (KFDP(I,4),I= 1,8000)/94*0,4*111,6*0,111,2*0,-211,0,-211, - &3*0,111,2*-211,0,111,0,2*111,113,221,2*111,-213,-211,211,113, - &6*111,310,2*130,402*0,13*81,41*0,-11,10*0,111,-211,4*0,111,62*0, - &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, - &-211,2*211,2*-211,13*0,-211,111,-211,111,4*0,-211,111,-211,111, - &34*0,111,-211,3*111,3*-211,2*111,3*-211,14*0,-321,-311,3*0,-321, - &-311,20*0,-3,43*0,6*1,39*0,6*2,42*0,6*3,14*0,8*4,4*0,4*-5,4*0, - &2*-5,67*0,-211,111,5*0,-211,111,52*0,2101,2103,2*2101,6*0,4*81, - &4*0,4*81,6*0,4*81,0,28*81,13*0,6*2101,18*81,4*0,18*81,4*0,9*81,0, - &162*81,31*0,-211,111,6516*0/ - DATA (KFDP(I,5),I= 1,8000)/96*0,2*111,17*0,111,7*0,2*111,0, - &3*111,0,111,597*0,-211,2*111,-211,111,-211,111,65*0,111,-211, - &3*111,-211,111,7193*0/ - -C...PYDAT4, with particle names (character strings). - DATA (CHAF(I,1),I= 1, 100)/'d','u','s','c','b','t','b''','t''', - &2*' ','e-','nu_e','mu-','nu_mu','tau-','nu_tau','tau''-', - &'nu''_tau',2*' ','g','gamma','Z0','W+','h0',6*' ','Z''0','Z"0', - &'W''+','H0','A0','H+',' ','Graviton',' ','R0','LQ_ue',38*' ', - &'specflav','rndmflav','phasespa','c-hadron','b-hadron',2*' ', - &'junction',' ','system','cluster','string','indep.','CMshower', - &'SPHEaxis','THRUaxis','CLUSjet','CELLjet','table',' '/ - DATA (CHAF(I,1),I= 101, 202)/'reggeon','pi0', - &'rho0','a_20','K_L0','pi+','rho+','a_2+','eta','omega','f_2', - &'K_S0','K0','K*0','K*_20','K+','K*+','K*_2+','eta''','phi', - &'f''_2','D+','D*+','D*_2+','D0','D*0','D*_20','D_s+','D*_s+', - &'D*_2s+','eta_c','J/psi','chi_2c','B0','B*0','B*_20','B+','B*+', - &'B*_2+','B_s0','B*_s0','B*_2s0','B_c+','B*_c+','B*_2c+','eta_b', - &'Upsilon','chi_2b','pomeron','dd_1','Delta-','ud_0','ud_1','n0', - &'Delta0','uu_1','p+','Delta+','Delta++','sd_0','sd_1','Sigma-', - &'Sigma*-','Lambda0','su_0','su_1','Sigma0','Sigma*0','Sigma+', - &'Sigma*+','ss_1','Xi-','Xi*-','Xi0','Xi*0','Omega-','cd_0', - &'cd_1','Sigma_c0','Sigma*_c0','Lambda_c+','Xi_c0','cu_0','cu_1', - &'Sigma_c+','Sigma*_c+','Sigma_c++','Sigma*_c++','Xi_c+','cs_0', - &'cs_1','Xi''_c0','Xi*_c0','Xi''_c+','Xi*_c+','Omega_c0', - &'Omega*_c0','cc_1','Xi_cc+','Xi*_cc+','Xi_cc++','Xi*_cc++'/ - DATA (CHAF(I,1),I= 203, 332)/'Omega_cc+','Omega*_cc+', - &'Omega*_ccc++','bd_0','bd_1','Sigma_b-','Sigma*_b-','Lambda_b0', - &'Xi_b-','Xi_bc0','bu_0','bu_1','Sigma_b0','Sigma*_b0','Sigma_b+', - &'Sigma*_b+','Xi_b0','Xi_bc+','bs_0','bs_1','Xi''_b-','Xi*_b-', - &'Xi''_b0','Xi*_b0','Omega_b-','Omega*_b-','Omega_bc0','bc_0', - &'bc_1','Xi''_bc0','Xi*_bc0','Xi''_bc+','Xi*_bc+','Omega''_bc0', - &'Omega*_bc0','Omega_bcc+','Omega*_bcc+','bb_1','Xi_bb-', - &'Xi*_bb-','Xi_bb0','Xi*_bb0','Omega_bb-','Omega*_bb-', - &'Omega_bbc0','Omega*_bbc0','Omega*_bbb-','a_00','b_10','a_0+', - &'b_1+','f_0','h_1','K*_00','K_10','K*_0+','K_1+','f''_0','h''_1', - &'D*_0+','D_1+','D*_00','D_10','D*_0s+','D_1s+','chi_0c','h_1c', - &'B*_00','B_10','B*_0+','B_1+','B*_0s0','B_1s0','B*_0c+','B_1c+', - &'chi_0b','h_1b','a_10','a_1+','f_1','K*_10','K*_1+','f''_1', - &'D*_1+','D*_10','D*_1s+','chi_1c','B*_10','B*_1+','B*_1s0', - &'B*_1c+','chi_1b','psi''','Upsilon''','~d_L','~u_L','~s_L', - &'~c_L','~b_1','~t_1','~e_L-','~nu_eL','~mu_L-','~nu_muL', - &'~tau_1-','~nu_tauL','~g','~chi_10','~chi_20','~chi_1+', - &'~chi_30','~chi_40','~chi_2+','~Gravitino','~d_R','~u_R','~s_R', - &'~c_R','~b_2','~t_2','~e_R-','~nu_eR','~mu_R-','~nu_muR', - &'~tau_2-','~nu_tauR','pi_tc0','pi_tc+','pi''_tc0','eta_tc0'/ - DATA (CHAF(I,1),I= 333, 500)/'rho_tc0','rho_tc+','omega_tc', - &'V8_tc','pi_22_1_tc','pi_22_8_tc','rho_11_tc','rho_12_tc', - &'rho_21_tc','rho_22_tc','d*','u*','e*-','nu*_e0','Graviton*', - &'nu_Re','nu_Rmu','nu_Rtau','Z_R0','W_R+','H_L++','H_R++', - &'rho_diff0','pi_diffr+','omega_di','phi_diff','J/psi_di', - &'n_diffr0','p_diffr+',139*' '/ - DATA (CHAF(I,2),I= 1, 205)/'dbar','ubar','sbar','cbar','bbar', - &'tbar','b''bar','t''bar',2*' ','e+','nu_ebar','mu+','nu_mubar', - &'tau+','nu_taubar','tau''+','nu''_taubar',5*' ','W-',9*' ', - &'W''-',2*' ','H-',3*' ','Rbar0','LQ_uebar',39*' ','rndmflavbar', - &' ','c-hadronbar','b-hadronbar',20*' ','pi-','rho-','a_2-',4*' ', - &'Kbar0','K*bar0','K*_2bar0','K-','K*-','K*_2-',3*' ','D-','D*-', - &'D*_2-','Dbar0','D*bar0','D*_2bar0','D_s-','D*_s-','D*_2s-', - &3*' ','Bbar0','B*bar0','B*_2bar0','B-','B*-','B*_2-','B_sbar0', - &'B*_sbar0','B*_2sbar0','B_c-','B*_c-','B*_2c-',4*' ','dd_1bar', - &'Deltabar+','ud_0bar','ud_1bar','nbar0','Deltabar0','uu_1bar', - &'pbar-','Deltabar-','Deltabar--','sd_0bar','sd_1bar','Sigmabar+', - &'Sigma*bar+','Lambdabar0','su_0bar','su_1bar','Sigmabar0', - &'Sigma*bar0','Sigmabar-','Sigma*bar-','ss_1bar','Xibar+', - &'Xi*bar+','Xibar0','Xi*bar0','Omegabar+','cd_0bar','cd_1bar', - &'Sigma_cbar0','Sigma*_cbar0','Lambda_cbar-','Xi_cbar0','cu_0bar', - &'cu_1bar','Sigma_cbar-','Sigma*_cbar-','Sigma_cbar--', - &'Sigma*_cbar--','Xi_cbar-','cs_0bar','cs_1bar','Xi''_cbar0', - &'Xi*_cbar0','Xi''_cbar-','Xi*_cbar-','Omega_cbar0', - &'Omega*_cbar0','cc_1bar','Xi_ccbar-','Xi*_ccbar-','Xi_ccbar--', - &'Xi*_ccbar--','Omega_ccbar-','Omega*_ccbar-','Omega*_cccbar-'/ - DATA (CHAF(I,2),I= 206, 325)/'bd_0bar','bd_1bar','Sigma_bbar+', - &'Sigma*_bbar+','Lambda_bbar0','Xi_bbar+','Xi_bcbar0','bu_0bar', - &'bu_1bar','Sigma_bbar0','Sigma*_bbar0','Sigma_bbar-', - &'Sigma*_bbar-','Xi_bbar0','Xi_bcbar-','bs_0bar','bs_1bar', - &'Xi''_bbar+','Xi*_bbar+','Xi''_bbar0','Xi*_bbar0','Omega_bbar+', - &'Omega*_bbar+','Omega_bcbar0','bc_0bar','bc_1bar','Xi''_bcbar0', - &'Xi*_bcbar0','Xi''_bcbar-','Xi*_bcbar-','Omega''_bcba', - &'Omega*_bcbar0','Omega_bccbar-','Omega*_bccbar-','bb_1bar', - &'Xi_bbbar+','Xi*_bbbar+','Xi_bbbar0','Xi*_bbbar0','Omega_bbbar+', - &'Omega*_bbbar+','Omega_bbcbar0','Omega*_bbcbar0', - &'Omega*_bbbbar+',2*' ','a_0-','b_1-',2*' ','K*_0bar0','K_1bar0', - &'K*_0-','K_1-',2*' ','D*_0-','D_1-','D*_0bar0','D_1bar0', - &'D*_0s-','D_1s-',2*' ','B*_0bar0','B_1bar0','B*_0-','B_1-', - &'B*_0sbar0','B_1sbar0','B*_0c-','B_1c-',3*' ','a_1-',' ', - &'K*_1bar0','K*_1-',' ','D*_1-','D*_1bar0','D*_1s-',' ', - &'B*_1bar0','B*_1-','B*_1sbar0','B*_1c-',3*' ','~d_Lbar', - &'~u_Lbar','~s_Lbar','~c_Lbar','~b_1bar','~t_1bar','~e_L+', - &'~nu_eLbar','~mu_L+','~nu_muLbar','~tau_1+','~nu_tauLbar',3*' ', - &'~chi_1-',2*' ','~chi_2-',' ','~d_Rbar','~u_Rbar','~s_Rbar', - &'~c_Rbar','~b_2bar','~t_2bar','~e_R+','~nu_eRbar','~mu_R+'/ - DATA (CHAF(I,2),I= 326, 500)/'~nu_muRbar','~tau_2+', - &'~nu_tauRbar',' ','pi_tc-',3*' ','rho_tc-',8*' ','d*bar','u*bar', - &'e*bar+','nu*_ebar0',5*' ','W_R-','H_L--','H_R--',' ', - &'pi_diffr-',3*' ','n_diffrbar0','p_diffrbar-',139*' '/ - -C...PYDATR, with initial values for the random number generator. - DATA MRPY/19780503,0,0,97,33,0/ - -C...Default values for allowed processes and kinematics constraints. - DATA MSEL/1/ - DATA MSUB/500*0/ - DATA ((KFIN(I,J),J=-40,40),I=1,2)/16*0,4*1,4*0,6*1,5*0,5*1,0, - &5*1,5*0,6*1,4*0,4*1,16*0,16*0,4*1,4*0,6*1,5*0,5*1,0,5*1,5*0, - &6*1,4*0,4*1,16*0/ - DATA CKIN/ - & 2.0D0, -1.0D0, 0.0D0, -1.0D0, 1.0D0, - & 1.0D0, -10D0, 10D0, -40D0, 40D0, - 1 -40D0, 40D0, -40D0, 40D0, -40D0, - 1 40D0, -1.0D0, 1.0D0, -1.0D0, 1.0D0, - 2 0.0D0, 1.0D0, 0.0D0, 1.0D0, -1.0D0, - 2 1.0D0, -1.0D0, 1.0D0, 0D0, 0D0, - 3 2.0D0, -1.0D0, 0D0, 0D0, 0.0D0, - 3 -1.0D0, 0.0D0, -1.0D0, 4.0D0, -1.0D0, - 4 12.0D0, -1.0D0, 12.0D0, -1.0D0, 12.0D0, - 4 -1.0D0, 12.0D0, -1.0D0, 0D0, 0D0, - 5 0.0D0, -1.0D0, 0.0D0, -1.0D0, 0.0D0, - 5 -1.0D0, 0D0, 0D0, 0D0, 0D0, - 6 0.0001D0, 0.99D0, 0.0001D0, 0.99D0, 0D0, - 6 -1D0, 0D0, -1D0, 0D0, -1D0, - 7 0D0, -1D0, 0.0001D0, 0.99D0, 0.0001D0, - 7 0.99D0, 2D0, -1D0, 0D0, 0D0, - 8 120*0D0/ - -C...Default values for main switches and parameters. Reset information. - DATA (MSTP(I),I=1,100)/ - & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, - 1 1, 0, 1, 30, 0, 1, 4, 3, 4, 3, - 2 1, 0, 1, 0, 0, 0, 0, 0, 0, 1, - 3 1, 8, 0, 1, 0, 2, 1, 5, 2, 0, - 4 2, 1, 3, 7, 3, 1, 1, 0, 1, 0, - 5 7, 1, 3, 1, 5, 1, 1, 5, 1, 7, - 6 2, 3, 2, 2, 1, 5, 2, 1, 0, 0, - 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8 1, 1, 100, 0, 0, 2, 0, 0, 0, 0, - 9 1, 3, 1, 3, 0, 0, 0, 0, 0, 0/ - DATA (MSTP(I),I=101,200)/ - & 3, 1, 0, 0, 0, 0, 0, 0, 0, 0, - 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, - 2 0, 1, 2, 1, 1, 100, 0, 0, 10, 0, - 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, - 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 7 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, - 8 6, 225, 2004, 07, 01, 0, 0, 0, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA (PARP(I),I=1,100)/ - & 0.25D0, 10D0, 8*0D0, - 1 0D0, 0D0, 1.0D0, 0.01D0, 0.5D0, 1.0D0, 1.0D0, 0.4D0, 2*0D0, - 2 10*0D0, - 3 1.5D0,2.0D0,0.075D0,1.0D0,0.2D0,0D0,1.0D0,0.70D0,0.006D0,0D0, - 4 0.02D0,2.0D0,0.10D0,1000D0,2054D0,123D0,246D0,50D0,0D0,0.054D0, - 5 10*0D0, - 6 0.25D0, 1.0D0,0.25D0, 1.0D0, 2.0D0,1D-3, 1.0D0,1D-3,2*0D0, - 7 4.0D0, 0.25D0, 8*0D0, - 8 1.90D0, 1.90D0, 0.5D0, 0.2D0, 0.33D0, - 8 0.66D0, 0.7D0, 0.5D0, 1000D0, 0.16D0, - 9 1.0D0,0.40D0,5.0D0,1.0D0,0D0,3.0D0,1.0D0,0.75D0,1.0D0,5.0D0/ - DATA (PARP(I),I=101,200)/ - & 0.5D0, 0.28D0, 1.0D0, 0.8D0, 0D0, 0D0, 0D0, 0D0, 0D0, 1D0, - 1 2.0D0, 3*0D0, 1.5D0, 0.5D0, 0.6D0, 2.5D0, 2.0D0, 1.0D0, - 2 1.0D0, 0.4D0, 8*0D0, - 3 0.01D0, 9*0D0, - 4 10*0D0, - 5 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, 0D0, - 6 2.20D0, 23.6D0, 18.4D0, 11.5D0, 0.5D0, 0D0, 0D0, 0D0, 2*0D0, - 7 0D0, 0D0, 0D0, 1.0D0, 6*0D0, - 8 0.1D0, 0.01D0, 0.01D0, 0.01D0, 0.1D0, 0.01D0, 0.01D0, 0.01D0, - 8 0.3D0, 0.64D0, - 9 0.64D0, 5.0D0, 8*0D0/ - DATA MSTI/200*0/ - DATA PARI/200*0D0/ - DATA MINT/400*0/ - DATA VINT/400*0D0/ - -C...Constants for the generation of the various processes. - DATA (ISET(I),I=1,100)/ - & 1, 1, 1, -1, 3, -1, -1, 3, -2, 2, - 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2, - 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2, - 3 2, 2, 2, 2, 2, 2, -1, -1, -1, -1, - 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 5 -1, -1, 2, 2, -1, -1, -1, 2, -1, -1, - 6 -1, -1, -1, -1, -1, -1, -1, 2, 2, 2, - 7 4, 4, 4, -1, -1, 4, 4, -1, -1, 2, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, - 9 0, 0, 0, 0, 0, 9, -2, -2, 8, -2/ - DATA (ISET(I),I=101,200)/ - & -1, 1, 1, 1, 1, 2, 2, 2, -2, 2, - 1 2, 2, 2, 2, 2, -1, -1, -1, -2, -2, - 2 5, 5, 5, 5, -2, -2, -2, -2, -2, -2, - 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 4 1, 1, 1, 1, 1, 1, 1, 1, 1, -2, - 5 1, 1, 1, -2, -2, 1, 1, 1, -2, -2, - 6 2, 2, 2, 2, 2, 2, 2, 2, 2, -2, - 7 2, 2, 5, 5, -2, 2, 2, 5, 5, -2, - 8 5, 5, 2, 2, 2, 5, 5, 2, 2, 2, - 9 1, 1, 1, 2, 2, -2, -2, -2, -2, -2/ - DATA (ISET(I),I=201,300)/ - & 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 1 2, 2, 2, 2, -2, 2, 2, 2, 2, 2, - 2 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 3 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 4 2, 2, 2, 2, -1, 2, 2, 2, 2, 2, - 5 2, 2, 2, 2, -1, 2, -1, 2, 2, -2, - 6 2, 2, 2, 2, 2, -1, -1, -1, -1, -1, - 7 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 9 2, 2, 2, 2, 2, 2, 2, 2, 2, 2/ - DATA (ISET(I),I=301,500)/ - & 2, 39*-2, - 4 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, - 5 5, 5, 1, 1, -1, -1, -1, -1, -1, -1, - 6 2, 2, 2, 2, 2, 2, 2, 2, -1, 2, - 7 2, 2, 2, 2, 2, 2, 2, -1, -1, -1, - 8 2, 2, 2, 2, 2, 2, 2, 2, -2, -2, - 9 1, 1, 2, 2, 2, 5*-2, - & 5, 5, 98*-2/ - DATA ((KFPR(I,J),J=1,2),I=1,50)/ - & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0, - & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0, - 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23, - 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24, - 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24, - 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23, - 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, - 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/ - DATA ((KFPR(I,J),J=1,2),I=51,100)/ - 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 21, 21, 24, 24, 23, 24, - 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22, - 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 211, - 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 8 443, 21,10441, 21,20443, 21, 445, 21, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=101,150)/ - & 23, 0, 25, 0, 25, 0,10441, 0, 445, 0, - & 443, 22, 443, 21, 443, 22, 0, 0, 22, 25, - 1 21, 25, 0, 25, 21, 25, 22, 22, 21, 22, - 1 22, 23, 23, 23, 24, 24, 0, 0, 0, 0, - 2 25, 6, 25, 6, 25, 0, 25, 0, 0, 0, - 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 3 0, 21, 0, 21, 0, 22, 0, 22, 0, 0, - 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 4 32, 0, 34, 0, 37, 0, 41, 0, 42, 0, - 4 4000011, 0, 4000001, 0, 4000002, 0, 3000331, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=151,200)/ - 5 35, 0, 35, 0, 35, 0, 0, 0, 0, 0, - 5 36, 0, 36, 0, 36, 0, 0, 0, 0, 0, - 6 6, 37, 42, 0, 42, 42, 42, 42, 11, 0, - 6 11, 0, 0, 4000001, 0, 4000002, 0, 4000011, 0, 0, - 7 23, 35, 24, 35, 35, 0, 35, 0, 0, 0, - 7 23, 36, 24, 36, 36, 0, 36, 0, 0, 0, - 8 35, 6, 35, 6, 21, 35, 0, 35, 21, 35, - 8 36, 6, 36, 6, 21, 36, 0, 36, 21, 36, - 9 3000113, 0, 3000213, 0, 3000223, 0, 11, 0, 11, 0, - 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ - DATA ((KFPR(I,J),J=1,2),I=201,240)/ - & 1000011, 1000011, 2000011, 2000011, 1000011, - & 2000011, 1000013, 1000013, 2000013, 2000013, - & 1000013, 2000013, 1000015, 1000015, 2000015, - & 2000015, 1000015, 2000015, 1000011, 1000012, - 1 1000015, 1000016, 2000015, 1000016, 1000012, - 1 1000012, 1000016, 1000016, 0, 0, - 1 1000022, 1000022, 1000023, 1000023, 1000025, - 1 1000025, 1000035, 1000035, 1000022, 1000023, - 2 1000022, 1000025, 1000022, 1000035, 1000023, - 2 1000025, 1000023, 1000035, 1000025, 1000035, - 2 1000024, 1000024, 1000037, 1000037, 1000024, - 2 1000037, 1000022, 1000024, 1000023, 1000024, - 3 1000025, 1000024, 1000035, 1000024, 1000022, - 3 1000037, 1000023, 1000037, 1000025, 1000037, - 3 1000035, 1000037, 1000021, 1000022, 1000021, - 3 1000023, 1000021, 1000025, 1000021, 1000035/ - DATA ((KFPR(I,J),J=1,2),I=241,280)/ - 4 1000021, 1000024, 1000021, 1000037, 1000021, - 4 1000021, 1000021, 1000021, 0, 0, - 4 1000002, 1000022, 2000002, 1000022, 1000002, - 4 1000023, 2000002, 1000023, 1000002, 1000025, - 5 2000002, 1000025, 1000002, 1000035, 2000002, - 5 1000035, 1000001, 1000024, 2000005, 1000024, - 5 1000001, 1000037, 2000005, 1000037, 1000002, - 5 1000021, 2000002, 1000021, 0, 0, - 6 1000006, 1000006, 2000006, 2000006, 1000006, - 6 2000006, 1000006, 1000006, 2000006, 2000006, - 6 0, 0, 0, 0, 0, - 6 0, 0, 0, 0, 0, - 7 1000002, 1000002, 2000002, 2000002, 1000002, - 7 2000002, 1000002, 1000002, 2000002, 2000002, - 7 1000002, 2000002, 1000002, 1000002, 2000002, - 7 2000002, 1000002, 1000002, 2000002, 2000002/ - DATA ((KFPR(I,J),J=1,2),I=281,350)/ - 8 1000005, 1000002, 2000005, 2000002, 1000005, - 8 2000002, 1000005, 1000002, 2000005, 2000002, - 8 1000005, 2000002, 1000005, 1000005, 2000005, - 8 2000005, 1000005, 1000005, 2000005, 2000005, - 9 1000005, 1000005, 2000005, 2000005, 1000005, - 9 2000005, 1000005, 1000021, 2000005, 1000021, - 9 1000005, 2000005, 37, 25, 37, - 9 35, 36, 25, 36, 35, - & 37, 37, 78*0, - 4 9900041, 0, 9900042, 0, 9900041, - 4 11, 9900042, 11, 9900041, 13, - 4 9900042, 13, 9900041, 15, 9900042, - 4 15, 9900041, 9900041, 9900042, 9900042/ - DATA ((KFPR(I,J),J=1,2),I=351,500)/ - 5 9900041, 0, 9900042, 0, 9900023, - 5 0, 9900024, 0, 0, 0, - 5 0, 0, 0, 0, 0, - 5 0, 0, 0, 0, 0, - 6 24, 24, 24, 3000211, 3000211, - 6 3000211, 22, 3000111, 22, 3000221, - 6 23, 3000111, 23, 3000221, 24, - 6 3000211, 0, 0, 24, 23, - 7 24, 3000111, 3000211, 23, 3000211, - 7 3000111, 22, 3000211, 23, 3000211, - 7 24, 3000111, 24, 3000221, 0, - 7 0, 0, 0, 0, 0, - 8 0, 0, 0, 0, 21, 21, 0, 21, 0, 0, - 8 21, 21, 0, 0, 0, 0, 0, 0, 0, 0, - 9 5000039, 0, 5000039, 0, 21, - 9 5000039, 0, 5000039, 21, 5000039, - 9 10*0, - & 37, 6, 37, 6, 196*0/ - DATA COEF/10000*0D0/ - DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ - &4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2, - &3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2, - &3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1, - &3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0, - &4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3, - &2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2, - &4,0,0,0,4,0,1,3,0,0,3,0,2,4,3,0,3,4,0,0,1,0,0,1,0,0,3,4,2,0,0,2, - &3,0,0,0,1,0,0,0,0,0,3,0,2,0,0,0,2,0,3,1,2,0,0,0,3,2,1,0,1,0,0,0, - &4,4,3,3,2,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, - &0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ - -C...Treatment of resonances. - DATA (MWID(I) ,I= 1, 500)/5*0,3*1,8*0,1,5*0,3*1,6*0,1,0,4*1, - &3*0,2*1,254*0,19*2,0,7*2,0,2,0,2,0,26*1,146*0/ - -C...Character constants: name of processes. - DATA PROC(0)/ 'All included subprocesses '/ - DATA (PROC(I),I=1,20)/ - &'f + fbar -> gamma*/Z0 ', 'f + fbar'' -> W+/- ', - &'f + fbar -> h0 ', 'gamma + W+/- -> W+/- ', - &'Z0 + Z0 -> h0 ', 'Z0 + W+/- -> W+/- ', - &' ', 'W+ + W- -> h0 ', - &' ', 'f + f'' -> f + f'' (QFD) ', - 1'f + f'' -> f + f'' (QCD) ','f + fbar -> f'' + fbar'' ', - 1'f + fbar -> g + g ', 'f + fbar -> g + gamma ', - 1'f + fbar -> g + Z0 ', 'f + fbar'' -> g + W+/- ', - 1'f + fbar -> g + h0 ', 'f + fbar -> gamma + gamma ', - 1'f + fbar -> gamma + Z0 ', 'f + fbar'' -> gamma + W+/- '/ - DATA (PROC(I),I=21,40)/ - 2'f + fbar -> gamma + h0 ', 'f + fbar -> Z0 + Z0 ', - 2'f + fbar'' -> Z0 + W+/- ', 'f + fbar -> Z0 + h0 ', - 2'f + fbar -> W+ + W- ', 'f + fbar'' -> W+/- + h0 ', - 2'f + fbar -> h0 + h0 ', 'f + g -> f + g ', - 2'f + g -> f + gamma ', 'f + g -> f + Z0 ', - 3'f + g -> f'' + W+/- ', 'f + g -> f + h0 ', - 3'f + gamma -> f + g ', 'f + gamma -> f + gamma ', - 3'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', - 3'f + gamma -> f + h0 ', 'f + Z0 -> f + g ', - 3'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ - DATA (PROC(I),I=41,60)/ - 4'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + h0 ', - 4'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', - 4'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', - 4'f + W+/- -> f'' + h0 ', 'f + h0 -> f + g ', - 4'f + h0 -> f + gamma ', 'f + h0 -> f + Z0 ', - 5'f + h0 -> f'' + W+/- ', 'f + h0 -> f + h0 ', - 5'g + g -> f + fbar ', 'g + gamma -> f + fbar ', - 5'g + Z0 -> f + fbar ', 'g + W+/- -> f + fbar'' ', - 5'g + h0 -> f + fbar ', 'gamma + gamma -> f + fbar ', - 5'gamma + Z0 -> f + fbar ', 'gamma + W+/- -> f + fbar'' '/ - DATA (PROC(I),I=61,80)/ - 6'gamma + h0 -> f + fbar ', 'Z0 + Z0 -> f + fbar ', - 6'Z0 + W+/- -> f + fbar'' ', 'Z0 + h0 -> f + fbar ', - 6'W+ + W- -> f + fbar ', 'W+/- + h0 -> f + fbar'' ', - 6'h0 + h0 -> f + fbar ', 'g + g -> g + g ', - 6'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> Z0 + W+/- ', - 7'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', - 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + h0 ', - 7'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', - 7'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + h0 -> W+/- + h0 ', - 7'h0 + h0 -> h0 + h0 ', 'q + gamma -> q'' + pi+/- '/ - DATA (PROC(I),I=81,100)/ - 8'q + qbar -> Q + Qbar, mass ', 'g + g -> Q + Qbar, massive ', - 8'f + q -> f'' + Q, massive ', 'g + gamma -> Q + Qbar, mass ', - 8'gamma + gamma -> F + Fbar, m', 'g + g -> J/Psi + g ', - 8'g + g -> chi_0c + g ', 'g + g -> chi_1c + g ', - 8'g + g -> chi_2c + g ', ' ', - 9'Elastic scattering ', 'Single diffractive (XB) ', - 9'Single diffractive (AX) ', 'Double diffractive ', - 9'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', - 9' ', ' ', - 9'q + gamma* -> q ', ' '/ - DATA (PROC(I),I=101,120)/ - &'g + g -> gamma*/Z0 ', 'g + g -> h0 ', - &'gamma + gamma -> h0 ', 'g + g -> chi_0c ', - &'g + g -> chi_2c ', 'g + g -> J/Psi + gamma ', - &'gamma + g -> J/Psi + g ', 'gamma+gamma -> J/Psi + gamma', - &' ', 'f + fbar -> gamma + h0 ', - 1'q + qbar -> g + h0 ', 'q + g -> q + h0 ', - 1'g + g -> g + h0 ', 'g + g -> gamma + gamma ', - 1'g + g -> g + gamma ', 'g + g -> gamma + Z0 ', - 1'g + g -> Z0 + Z0 ', 'g + g -> W+ + W- ', - 1' ', ' '/ - DATA (PROC(I),I=121,140)/ - 2'g + g -> Q + Qbar + h0 ', 'q + qbar -> Q + Qbar + h0 ', - 2'f + f'' -> f + f'' + h0 ', - 2'f + f'' -> f" + f"'' + h0 ', - 2' ', ' ', - 2' ', ' ', - 2' ', ' ', - 3'f + gamma*_T -> f + g ', 'f + gamma*_L -> f + g ', - 3'f + gamma*_T -> f + gamma ', 'f + gamma*_L -> f + gamma ', - 3'g + gamma*_T -> f + fbar ', 'g + gamma*_L -> f + fbar ', - 3'gamma*_T+gamma*_T -> f+fbar ', 'gamma*_T+gamma*_L -> f+fbar ', - 3'gamma*_L+gamma*_T -> f+fbar ', 'gamma*_L+gamma*_L -> f+fbar '/ - DATA (PROC(I),I=141,160)/ - 4'f + fbar -> gamma*/Z0/Z''0 ', 'f + fbar'' -> W''+/- ', - 4'f + fbar'' -> H+/- ', 'f + fbar'' -> R ', - 4'q + l -> LQ ', 'e + gamma -> e* ', - 4'd + g -> d* ', 'u + g -> u* ', - 4'g + g -> eta_tc ', ' ', - 5'f + fbar -> H0 ', 'g + g -> H0 ', - 5'gamma + gamma -> H0 ', ' ', - 5' ', 'f + fbar -> A0 ', - 5'g + g -> A0 ', 'gamma + gamma -> A0 ', - 5' ', ' '/ - DATA (PROC(I),I=161,180)/ - 6'f + g -> f'' + H+/- ', 'q + g -> LQ + lbar ', - 6'g + g -> LQ + LQbar ', 'q + qbar -> LQ + LQbar ', - 6'f + fbar -> f'' + fbar'' (g/Z)', - 6'f +fbar'' -> f" + fbar"'' (W) ', - 6'q + q'' -> q" + d* ', 'q + q'' -> q" + u* ', - 6'q + qbar -> e + e* ', ' ', - 7'f + fbar -> Z0 + H0 ', 'f + fbar'' -> W+/- + H0 ', - 7'f + f'' -> f + f'' + H0 ', - 7'f + f'' -> f" + f"'' + H0 ', - 7' ', 'f + fbar -> Z0 + A0 ', - 7'f + fbar'' -> W+/- + A0 ', - 7'f + f'' -> f + f'' + A0 ', - 7'f + f'' -> f" + f"'' + A0 ', - 7' '/ - DATA (PROC(I),I=181,200)/ - 8'g + g -> Q + Qbar + H0 ', 'q + qbar -> Q + Qbar + H0 ', - 8'q + qbar -> g + H0 ', 'q + g -> q + H0 ', - 8'g + g -> g + H0 ', 'g + g -> Q + Qbar + A0 ', - 8'q + qbar -> Q + Qbar + A0 ', 'q + qbar -> g + A0 ', - 8'q + g -> q + A0 ', 'g + g -> g + A0 ', - 9'f + fbar -> rho_tc0 ', 'f + f'' -> rho_tc+/- ', - 9'f + fbar -> omega_tc0 ', 'f+fbar -> f''+fbar'' (ETC) ', - 9'f+fbar'' -> f"+fbar"'' (ETC)',' ', - 9' ', ' ', - 9' ', ' '/ - DATA (PROC(I),I=201,220)/ - &'f + fbar -> ~e_L + ~e_Lbar ', 'f + fbar -> ~e_R + ~e_Rbar ', - &'f + fbar -> ~e_R + ~e_Lbar ', 'f + fbar -> ~mu_L + ~mu_Lbar', - &'f + fbar -> ~mu_R + ~mu_Rbar', 'f + fbar -> ~mu_L + ~mu_Rbar', - &'f+fbar -> ~tau_1 + ~tau_1bar', 'f+fbar -> ~tau_2 + ~tau_2bar', - &'f+fbar -> ~tau_1 + ~tau_2bar', 'q + qbar'' -> ~l_L + ~nulbar ', - 1'q+qbar''-> ~tau_1 + ~nutaubar', 'q+qbar''-> ~tau_2 + ~nutaubar', - 1'f + fbar -> ~nul + ~nulbar ', 'f+fbar -> ~nutau + ~nutaubar', - 1' ', 'f + fbar -> ~chi1 + ~chi1 ', - 1'f + fbar -> ~chi2 + ~chi2 ', 'f + fbar -> ~chi3 + ~chi3 ', - 1'f + fbar -> ~chi4 + ~chi4 ', 'f + fbar -> ~chi1 + ~chi2 '/ - DATA (PROC(I),I=221,240)/ - 2'f + fbar -> ~chi1 + ~chi3 ', 'f + fbar -> ~chi1 + ~chi4 ', - 2'f + fbar -> ~chi2 + ~chi3 ', 'f + fbar -> ~chi2 + ~chi4 ', - 2'f + fbar -> ~chi3 + ~chi4 ', 'f+fbar -> ~chi+-1 + ~chi-+1 ', - 2'f+fbar -> ~chi+-2 + ~chi-+2 ', 'f+fbar -> ~chi+-1 + ~chi-+2 ', - 2'q + qbar'' -> ~chi1 + ~chi+-1', 'q + qbar'' -> ~chi2 + ~chi+-1', - 3'q + qbar'' -> ~chi3 + ~chi+-1', 'q + qbar'' -> ~chi4 + ~chi+-1', - 3'q + qbar'' -> ~chi1 + ~chi+-2', 'q + qbar'' -> ~chi2 + ~chi+-2', - 3'q + qbar'' -> ~chi3 + ~chi+-2', 'q + qbar'' -> ~chi4 + ~chi+-2', - 3'q + qbar -> ~chi1 + ~g ', 'q + qbar -> ~chi2 + ~g ', - 3'q + qbar -> ~chi3 + ~g ', 'q + qbar -> ~chi4 + ~g '/ - DATA (PROC(I),I=241,260)/ - 4'q + qbar'' -> ~chi+-1 + ~g ', 'q + qbar'' -> ~chi+-2 + ~g ', - 4'q + qbar -> ~g + ~g ', 'g + g -> ~g + ~g ', - 4' ', 'qj + g -> ~qj_L + ~chi1 ', - 4'qj + g -> ~qj_R + ~chi1 ', 'qj + g -> ~qj_L + ~chi2 ', - 4'qj + g -> ~qj_R + ~chi2 ', 'qj + g -> ~qj_L + ~chi3 ', - 5'qj + g -> ~qj_R + ~chi3 ', 'qj + g -> ~qj_L + ~chi4 ', - 5'qj + g -> ~qj_R + ~chi4 ', 'qj + g -> ~qk_L + ~chi+-1 ', - 5'qj + g -> ~qk_R + ~chi+-1 ', 'qj + g -> ~qk_L + ~chi+-2 ', - 5'qj + g -> ~qk_R + ~chi+-2 ', 'qj + g -> ~qj_L + ~g ', - 5'qj + g -> ~qj_R + ~g ', ' '/ - DATA (PROC(I),I=261,300)/ - 6'f + fbar -> ~t_1 + ~t_1bar ', 'f + fbar -> ~t_2 + ~t_2bar ', - 6'f + fbar -> ~t_1 + ~t_2bar ', 'g + g -> ~t_1 + ~t_1bar ', - 6'g + g -> ~t_2 + ~t_2bar ', ' ', - 6' ', ' ', - 6' ', ' ', - 7'qi + qj -> ~qi_L + ~qj_L ', 'qi + qj -> ~qi_R + ~qj_R ', - 7'qi + qj -> ~qi_L + ~qj_R ', 'qi+qjbar -> ~qi_L + ~qj_Lbar', - 7'qi+qjbar -> ~qi_R + ~qj_Rbar', 'qi+qjbar -> ~qi_L + ~qj_Rbar', - 7'f + fbar -> ~qi_L + ~qi_Lbar', 'f + fbar -> ~qi_R + ~qi_Rbar', - 7'g + g -> ~qi_L + ~qi_Lbar ', 'g + g -> ~qi_R + ~qi_Rbar ', - 8'b + qj -> ~b_1 + ~qj_L ', 'b + qj -> ~b_2 + ~qj_R ', - 8'b + qj -> ~b_1 + ~qj_R ', 'b + qjbar -> ~b_1 + ~qj_Lbar', - 8'b + qjbar -> ~b_2 + ~qj_Rbar', 'b + qjbar -> ~b_1 + ~qj_Rbar', - 8'f + fbar -> ~b_1 + ~b_1bar ', 'f + fbar -> ~b_2 + ~b_2bar ', - 8'g + g -> ~b_1 + ~b_1bar ', 'g + g -> ~b_2 + ~b_2bar ', - 9'b + b -> ~b_1 + ~b_1 ', 'b + b -> ~b_2 + ~b_2 ', - 9'b + b -> ~b_1 + ~b_2 ', 'b + g -> ~b_1 + ~g ', - 9'b + g -> ~b_2 + ~g ', 'b + bbar -> ~b_1 + ~b_2bar ', - 9'f + fbar'' -> H+/- + h0 ', 'f + fbar -> H+/- + H0 ', - 9'f + fbar -> A0 + h0 ', 'f + fbar -> A0 + H0 '/ - DATA (PROC(I),I=301,340)/ - &'f + fbar -> H+ + H- ', 39*' '/ - DATA (PROC(I),I=341,380)/ - 4'l + l -> H_L++/-- ', 'l + l -> H_R++/-- ', - 4'l + gamma -> H_L++/-- e-/+ ', 'l + gamma -> H_R++/-- e-/+ ', - 4'l + gamma -> H_L++/-- mu-/+ ', 'l + gamma -> H_R++/-- mu-/+ ', - 4'l + gamma -> H_L++/-- tau-/+', 'l + gamma -> H_R++/-- tau-/+', - 4'f + fbar -> H_L++ + H_L-- ', 'f + fbar -> H_R++ + H_R-- ', - 5'f + f -> f'' + f'' + H_L++/-- ', - 5'f + f -> f'' + f'' + H_R++/-- ','f + fbar -> Z_R0 ', - 5'f + fbar'' -> W_R+/- ',5*' ', - 6' ', 'f + fbar -> W_L+ W_L- ', - 6'f + fbar -> W_L+/- pi_T-/+ ', 'f + fbar -> pi_T+ pi_T- ', - 6'f + fbar -> gamma pi_T0 ', 'f + fbar -> gamma pi_T0'' ', - 6'f + fbar -> Z0 pi_T0 ', 'f + fbar -> Z0 pi_T0'' ', - 6'f + fbar -> W+/- pi_T-/+ ', ' ', - 7'f + fbar'' -> W_L+/- Z_L0 ', 'f + fbar'' -> W_L+/- pi_T0 ', - 7'f + fbar'' -> pi_T+/- Z_L0 ', 'f + fbar'' -> pi_T+/- pi_T0 ', - 7'f + fbar'' -> gamma pi_T+/- ', 'f + fbar'' -> Z0 pi_T+/- ', - 7'f + fbar'' -> W+/- pi_T0 ', - 7'f + fbar'' -> W+/- pi_T0'' ', - 7' ', ' ', - 7' '/ - DATA (PROC(I),I=381,500)/ - 8'f + f'' -> f + f'' (ETC) ','f + fbar -> f'' + fbar'' (ETC)', - 8'f + fbar -> g + g (ETC) ', 'f + g -> f + g (ETC) ', - 8'g + g -> f + fbar (ETC) ', 'g + g -> g + g (ETC) ', - 8'q + qbar -> Q + Qbar (ETC) ', 'g + g -> Q + Qbar (ETC) ', - 8' ', ' ', - 9'f + fbar -> G* ', 'g + g -> G* ', - 9'q + qbar -> g + G* ', 'q + g -> q + G* ', - 9'g + g -> g + G* ', ' ', - 9 4*' ', - &'g + g -> t + b + H+/- ', 'q + qbar -> t + b + H+/- ', - & 98*' '/ - -C...Cross sections and slope offsets. - DATA SIGT/294*0D0/ - -C...Supersymmetry switches and parameters. - DATA IMSS/0, - & 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, - 1 89*0/ - DATA RMSS/0D0, - & 80D0,160D0,500D0,800D0,2D0,250D0,200D0,800D0,700D0,800D0, - 1 700D0,500D0,250D0,200D0,800D0,400D0,0D0,0.1D0,850D0,0.041D0, - 2 1D0,800D0,1D4,1D4,1D4,0D0,0D0,0D0,24D17,0D0, - 3 69*0D0/ -C...Initial values for R-violating SUSY couplings. -C...Should not be changed here. See PYMSIN. - DATA RVLAM/27*0D0/ - DATA RVLAMP/27*0D0/ - DATA RVLAMB/27*0D0/ - -C...Technicolor switches and parameters - DATA ITCM/0, - & 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 89*0/ - DATA RTCM/0D0, - & 82D0,1.333D0,.333D0,0.408D0,1D0,1D0,.0182D0,1D0,0D0,1.333D0, - 1 .05D0,200D0,200D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, - 2 .283D0,.707D0,0D0,0D0,0D0,1.667D0,250D0,250D0,.707D0,0D0, - 3 .707D0,0D0,1D0,0D0,0D0,0D0,0D0,0D0,0D0,0D0, - 4 1000D0, 1D0, 1D0, 1D0, 1D0, 0D0, 4*0D0, - 4 49*0D0/ - -C...Data for histogramming routines. - DATA IHIST/1000,20000,55,1/ - DATA INDX/1000*0/ - - END - - -C********************************************************************* - -C...PYDCYK -C...Handles flavour production in the decay of unstable particles -C...and small string clusters. - - SUBROUTINE PYDCYK(KFL1,KFL2,KFL3,KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - -C.. Call PYKFDI directly if no popcorn option is on - IF(MSTJ(12).LT.2) THEN - CALL PYKFDI(KFL1,KFL2,KFL3,KF) - MSTU(124)=KFL3 - RETURN - ENDIF - - KFL3=0 - KF=0 - IF(KFL1.EQ.0) RETURN - KF1A=IABS(KFL1) - KF2A=IABS(KFL2) - - NSTO=130 - NMAX=MIN(MSTU(125),10) - -C.. Identify rank 0 cluster qq - IRANK=1 - IF(KF1A.GT.10.AND.KF1A.LT.10000) IRANK=0 - - IF(KF2A.GT.0)THEN -C.. Join jets: Fails if store not empty - IF(MSTU(121).GT.0) THEN - MSTU(121)=0 - RETURN - ENDIF - CALL PYKFDI(KFL1,KFL2,KFL3,KF) - ELSEIF(KF1A.GT.10.AND.MSTU(121).GT.0)THEN -C.. Pick popcorn meson from store, return same qq, decrease store - KF=MSTU(NSTO+MSTU(121)) - KFL3=-KFL1 - MSTU(121)=MSTU(121)-1 - ELSE -C.. Generate new flavour. Then done if no diquark is generated - 100 CALL PYKFDI(KFL1,0,KFL3,KF) - IF(MSTU(121).EQ.-1) GOTO 100 - MSTU(124)=KFL3 - IF(KF.EQ.0.OR.IABS(KFL3).LE.10) RETURN - -C.. Simple case if no dynamical popcorn suppressions are considered - IF(MSTJ(12).LT.4) THEN - IF(MSTU(121).EQ.0) RETURN - NMES=1 - KFPREV=-KFL3 - CALL PYKFDI(KFPREV,0,KFL3,KFM) -C.. Due to eta+eta' suppr., a qq->M+qq attempt might end as qq->B+q - IF(IABS(KFL3).LE.10)THEN - KFL3=-KFPREV - RETURN - ENDIF - GOTO 120 - ENDIF - -C test output qq against fake Gamma, then return if no popcorn. - GB=2D0 - IF(IRANK.NE.0)THEN - CALL PYZDIS(1,2103,5D0,Z) - GB=5D0*(1D0-Z)/Z - IF(1D0-PARF(192)**GB.LT.PYR(0)) THEN - MSTU(121)=0 - GOTO 100 - ENDIF - ENDIF - IF(MSTU(121).EQ.0) RETURN - -C..Set store size memory. Pick fake dynamical variables of qq. - NMES=MSTU(121) - CALL PYPTDI(1,PX3,PY3) - X=1D0 - POPM=0D0 - G=GB - POPG=GB - -C.. Pick next popcorn meson, test with fake dynamical variables - 110 KFPREV=-KFL3 - PX1=-PX3 - PY1=-PY3 - CALL PYKFDI(KFPREV,0,KFL3,KFM) - IF(MSTU(121).EQ.-1) GOTO 100 - CALL PYPTDI(KFL3,PX3,PY3) - PM=PYMASS(KFM)**2+(PX1+PX3)**2+(PY1+PY3)**2 - CALL PYZDIS(KFPREV,KFL3,PM,Z) - G=(1D0-Z)*(G+PM/Z) - X=(1D0-Z)*X - - PTST=1D0 - GTST=1D0 - RTST=PYR(0) - IF(MSTJ(12).GT.4)THEN - POPMN=SQRT((1D0-X)*(G/X-GB)) - POPM=POPM+PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PTST=EXP((POPM-POPMN)*PARF(193)) - POPM=POPMN - ENDIF - IF(IRANK.NE.0)THEN - POPGN=X*GB - GTST=(1D0-PARF(192)**POPGN)/(1D0-PARF(192)**POPG) - POPG=POPGN - ENDIF - IF(RTST.GT.PTST*GTST)THEN - MSTU(121)=0 - IF(RTST.GT.PTST) MSTU(121)=-1 - GOTO 100 - ENDIF - -C.. Store meson - 120 IF(NMES.LE.NMAX) MSTU(NSTO+MSTU(121)+1)=KFM - IF(MSTU(121).GT.0) GOTO 110 - -C.. Test accepted system size. If OK set global popcorn size variable. - IF(NMES.GT.NMAX)THEN - KF=0 - KFL3=0 - RETURN - ENDIF - MSTU(121)=NMES - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDECY -C...Handles the decay of unstable particles. - - SUBROUTINE PYDECY(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays. - DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), - &WTCOR(10),PTAU(4),PCMTAU(4),DBETAU(3) - CHARACTER CIDC*4 - DATA WTCOR/2D0,5D0,15D0,60D0,250D0,1500D0,1.2D4,1.2D5,150D0,16D0/ - -C...Functions: momentum in two-particle decays and four-product. - PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2D0*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) - -C...Initial values. - NTRY=0 - NSAV=N - KFA=IABS(K(IP,2)) - KFS=ISIGN(1,K(IP,2)) - KC=PYCOMP(KFA) - MSTJ(92)=0 - -C...Choose lifetime and determine decay vertex. - IF(K(IP,1).EQ.5) THEN - V(IP,5)=0D0 - ELSEIF(K(IP,1).NE.4) THEN - V(IP,5)=-PMAS(KC,4)*LOG(PYR(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.1D-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 PYROBO(ITAU,ITAU,0D0,0D0,-DBETAU(1), - & -DBETAU(2),-DBETAU(3)) - PHITAU=PYANGL(P(ITAU,1),P(ITAU,2)) - CALL PYROBO(ITAU,ITAU,0D0,-PHITAU,0D0,0D0,0D0) - THETAU=PYANGL(P(ITAU,3),P(ITAU,1)) - CALL PYROBO(ITAU,ITAU,-THETAU,0D0,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 PYTAUD(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 PYROBO(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) - IF(KFORIG.NE.0) CALL PYROBO(NSAV+1,N,0D0,0D0,DBETAU(1), - & DBETAU(2),DBETAU(3)) - -C...Skip past ordinary tau decay treatment. - MMAT=0 - MBST=0 - ND=0 - GOTO 630 - ENDIF - ENDIF - -C...B-Bbar 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.5D0*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.PYR(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 PYERRM(9,'(PYDECY:) no decay channel defined') - RETURN - ENDIF - IF(MOD(KFA/1000,10).EQ.0.AND.KCA.EQ.85) KFS=-KFS - IF(KCHG(KC,3).EQ.0) THEN - KFSP=1 - KFSN=0 - IF(PYR(0).GT.0.5D0) 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=0D0 - 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 PYERRM(2,'(PYDECY:) all decay channels closed by user') - RETURN - ENDIF - -C...Select decay channel among allowed ones. - 240 RBR=BRSU*PYR(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.0D0) GOTO 250 - ENDIF - -C...Start readout of decay channel: matrix element, reset counters. - MMAT=MDME(IDC,2) - 260 NTRY=NTRY+1 - IF(MOD(NTRY,200).EQ.0) THEN - WRITE(CIDC,'(I4)') IDC -C...Do not print warning for some well-known special cases. - IF(KFA.NE.113.AND.KFA.NE.115.AND.KFA.NE.215) - & CALL PYERRM(4,'(PYDECY:) caught in loop for decay channel'// - & CIDC) - GOTO 240 - ENDIF - IF(NTRY.GT.1000) THEN - CALL PYERRM(14,'(PYDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=N - NP=0 - NQ=0 - MBST=0 - IF(MMAT.GE.11.AND.P(IP,4).GT.20D0*P(IP,5)) MBST=1 - DO 270 J=1,4 - PV(1,J)=0D0 - 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=0D0 - PSQ=0D0 - MREM=0 - MHADDY=0 - IF(KFA.GT.80) MHADDY=1 -C.. Random flavour and popcorn system memory. - IRNDMO=0 - JTMO=0 - MSTU(121)=0 - MSTU(125)=10 - -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=PYCOMP(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 PYDCYK(-KFS*INT(1D0+(2D0+PARJ(2))*PYR(0)),0,KFP,KDUMP) - IF(KFP.EQ.0) GOTO 260 - KFP=-KFP - IRNDMO=1 - MSTJ(93)=1 - IF(PV(1,5).LT.PARJ(32)+2D0*PYMASS(KFP)) GOTO 260 - ELSEIF(KP.EQ.-82) THEN - KFP=MSTU(124) - ENDIF - IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=PYCOMP(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 -C...set rndmflav popcorn system pointer - IF(KP.EQ.82.AND.MSTU(121).GT.0) JTMO=NQ - MSTJ(93)=2 - PSQ=PSQ+PYMASS(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 PYKFDI(KFP,KFI,KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 260 - MSTJ(93)=1 - P(I,5)=PYMASS(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)=PYMASS(KFP) - 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.1D0)) - IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) - 300 NTRY=NTRY+1 -C...Reset popcorn flags if new attempt. Re-select rndmflav if failed. - IF(IRNDMO.EQ.0) THEN - MSTU(121)=0 - JTMO=0 - ELSEIF(IRNDMO.EQ.1) THEN - IRNDMO=2 - ELSE - GOTO 260 - ENDIF - IF(NTRY.GT.1000) THEN - CALL PYERRM(14,'(PYDECY:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MMAT.LE.20) THEN - GAUSS=SQRT(-2D0*CNDE*LOG(MAX(1D-10,PYR(0))))* - & SIN(PARU(2)*PYR(0)) - ND=0.5D0+0.5D0*NP+0.25D0*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.. Set maximum popcorn meson number. Test rndmflav popcorn size. - MSTU(125)=ND-NQ/2 - IF(MSTU(121).GT.MSTU(125)) GOTO 300 - -C...Form hadrons from flavour content. - DO 310 JT=1,NQ - KFL1(JT)=KFLO(JT) - 310 CONTINUE - IF(ND.EQ.NP+NQ/2) GOTO 330 - DO 320 I=N+NP+1,N+ND-NQ/2 -C.. Stick to started popcorn system, else pick side at random - JT=JTMO - IF(JT.EQ.0) JT=1+INT((NQ-1)*PYR(0)) - CALL PYDCYK(KFL1(JT),0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 300 - MSTU(125)=MSTU(125)-1 - JTMO=0 - IF(MSTU(121).GT.0) JTMO=JT - KFL1(JT)=-KFL2 - 320 CONTINUE - 330 JT=2 - JT2=3 - JT3=4 - IF(NQ.EQ.4.AND.PYR(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 PYDCYK(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 PYDCYK(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)=PYMASS(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) - & .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)=(1D0-PQT)*PV(1,J) - 350 CONTINUE - IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 - ND=NP-1 - MREM=1 - -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...Determine position of grandmother, number of sisters. - NM=0 - KFAS=0 - MSGN=0 - IF(MMAT.EQ.3) THEN - IM=K(IP,3) - IF(IM.LT.0.OR.IM.GE.IP) IM=0 - IF(IM.NE.0) KFAM=IABS(K(IM,2)) - IF(IM.NE.0) THEN - DO 360 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 - 360 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 - ENDIF - ENDIF - -C...Kinematics of one-particle decays. - IF(ND.EQ.1) THEN - DO 370 J=1,4 - P(N+1,J)=P(IP,J) - 370 CONTINUE - GOTO 630 - ENDIF - -C...Calculate maximum weight ND-particle decay. - PV(ND,5)=P(N+ND,5) - IF(ND.GE.3) THEN - WTMAX=1D0/WTCOR(ND-2) - PMAX=PV(1,5)-PS+P(N+ND,5) - PMIN=0D0 - DO 380 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)) - 380 CONTINUE - ENDIF - -C...Find virtual gamma mass in Dalitz decay. - 390 IF(ND.EQ.2) THEN - ELSEIF(MMAT.EQ.2) THEN - PMES=4D0*PMAS(11,1)**2 - PMRHO2=PMAS(131,1)**2 - PGRHO2=PMAS(131,2)**2 - 400 PMST=PMES*(P(IP,5)**2/PMES)**PYR(0) - WT=(1+0.5D0*PMES/PMST)*SQRT(MAX(0D0,1D0-PMES/PMST))* - & (1D0-PMST/P(IP,5)**2)**3*(1D0+PGRHO2/PMRHO2)/ - & ((1D0-PMST/PMRHO2)**2+PGRHO2/PMRHO2) - IF(WT.LT.PYR(0)) GOTO 400 - PV(2,5)=MAX(2.00001D0*PMAS(11,1),SQRT(PMST)) - -C...M-generator gives weight. If rejected, try again. - ELSE - 410 RORD(1)=1D0 - DO 440 IL1=2,ND-1 - RSAV=PYR(0) - DO 420 IL2=IL1-1,1,-1 - IF(RSAV.LE.RORD(IL2)) GOTO 430 - RORD(IL2+1)=RORD(IL2) - 420 CONTINUE - 430 RORD(IL2+1)=RSAV - 440 CONTINUE - RORD(ND)=0D0 - WT=1D0 - DO 450 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)) - 450 CONTINUE - IF(WT.LT.PYR(0)*WTMAX) GOTO 410 - ENDIF - -C...Perform two-particle decays in respective CM frame. - 460 DO 480 IL=1,ND-1 - PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) - UE(3)=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) - DO 470 J=1,3 - P(N+IL,J)=PA*UE(J) - PV(IL+1,J)=-PA*UE(J) - 470 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) - 480 CONTINUE - -C...Lorentz transform decay products to lab frame. - DO 490 J=1,4 - P(N+ND,J)=PV(ND,J) - 490 CONTINUE - DO 530 IL=ND-1,1,-1 - DO 500 J=1,3 - BE(J)=PV(IL,J)/PV(IL,4) - 500 CONTINUE - GA=PV(IL,4)/PV(IL,5) - DO 520 I=N+IL,N+ND - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 510 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) - 510 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 520 CONTINUE - 530 CONTINUE - -C...Check that no infinite loop in matrix element weight. - NTRY=NTRY+1 - IF(NTRY.GT.800) GOTO 560 - -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 - & +2D0*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.001D0).LT.PYR(0)) GOTO 390 - -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.5D0*PMES)*(FOUR12**2+FOUR13**2)+ - & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) - IF(WT.LT.PYR(0)*0.25D0*PMST*(P(IP,5)**2-PMST)**2) GOTO 460 - -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*(2D0*FOUR10*FOUR12*FOUR02- - & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) - HNUM=MAX(1D-6*PMS1**2*PMS0*PMS2,HNUM) - HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) - IF(HNUM.LT.PYR(0)*HDEN) GOTO 460 - -C...Matrix element for "onium" -> g + g + g or gamma + g + g. - ELSEIF(MMAT.EQ.4) THEN - HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 - HX2=2D0*FOUR(IP,N+2)/P(IP,5)**2 - HX3=2D0*FOUR(IP,N+3)/P(IP,5)**2 - WT=((1D0-HX1)/(HX2*HX3))**2+((1D0-HX2)/(HX1*HX3))**2+ - & ((1D0-HX3)/(HX1*HX2))**2 - IF(WT.LT.2D0*PYR(0)) GOTO 390 - IF(K(IP+1,2).EQ.22.AND.(1D0-HX1)*P(IP,5)**2.LT.4D0*PARJ(32)**2) - & GOTO 390 - -C...Effective matrix element for nu spectrum in tau -> nu + hadrons. - ELSEIF(MMAT.EQ.41) THEN - IF(MBST.EQ.0) HX1=2D0*FOUR(IP,N+1)/P(IP,5)**2 - IF(MBST.EQ.1) HX1=2D0*P(N+1,4)/P(IP,5) - HXM=MIN(0.75D0,2D0*(1D0-PS/P(IP,5))) - IF(HX1*(3D0-2D0*HX1).LT.PYR(0)*HXM*(3D0-2D0*HXM)) GOTO 390 - -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.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 - ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN - DO 550 J=1,4 - P(N+NP+1,J)=0D0 - DO 540 IS=N+3,N+NP - P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) - 540 CONTINUE - 550 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.PYR(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 390 - ENDIF - -C...Scale back energy and reattach spectator. - 560 IF(MREM.EQ.1) THEN - DO 570 J=1,5 - PV(1,J)=PV(1,J)/(1D0-PQT) - 570 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.AND.ND.EQ.3) THEN - MSTJ(93)=1 - PM2=PYMASS(K(N+2,2)) - MSTJ(93)=1 - PM3=PYMASS(K(N+3,2)) - IF(P(N+2,5)**2+P(N+3,5)**2+2D0*FOUR(N+2,N+3).GE. - & (PARJ(32)+PM2+PM3)**2) GOTO 630 - K(N+2,1)=1 - KFTEMP=K(N+2,2) - CALL PYKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) - IF(K(N+2,2).EQ.0) GOTO 260 - P(N+2,5)=PYMASS(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 460 - ELSEIF(MMAT.EQ.44) THEN - MSTJ(93)=1 - PM3=PYMASS(K(N+3,2)) - MSTJ(93)=1 - PM4=PYMASS(K(N+4,2)) - IF(P(N+3,5)**2+P(N+4,5)**2+2D0*FOUR(N+3,N+4).GE. - & (PARJ(32)+PM3+PM4)**2) GOTO 600 - K(N+3,1)=1 - KFTEMP=K(N+3,2) - CALL PYKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) - IF(K(N+3,2).EQ.0) GOTO 260 - P(N+3,5)=PYMASS(K(N+3,2)) - DO 580 J=1,3 - P(N+3,J)=P(N+3,J)+P(N+4,J) - 580 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-2D0*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)/(2D0*HF) - DO 590 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 - 590 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. - 600 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(0D0,P(N+1,5)**2+P(N+2,5)**2+2D0*FOUR(N+1,N+2))) - MSTJ(93)=1 - PM1=PYMASS(K(N+1,2)) - MSTJ(93)=1 - PM2=PYMASS(K(N+2,2)) - IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 610 - KFLDUM=INT(1.5D0+PYR(0)) - CALL PYKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) - CALL PYKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) - IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 - PSM=PYMASS(KF1)+PYMASS(KF2) - IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 610 - IF(MMAT.GE.43.AND.PMR.GT.0.2D0*PARJ(32)+PSM) GOTO 610 - IF(MMAT.EQ.48) GOTO 390 - IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260 - K(N+1,1)=1 - KFTEMP=K(N+1,2) - CALL PYKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) - IF(K(N+1,2).EQ.0) GOTO 260 - P(N+1,5)=PYMASS(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 460 - ENDIF - -C...Phase space decay of partons from W decay. - 610 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 620 J=1,5 - PV(1,J)=P(N+1,J)+P(N+2,J) - P(N+1,J)=P(N+3,J) - 620 CONTINUE - PV(1,5)=PMR - N=N+1 - NP=0 - NQ=2 - PS=0D0 - MSTJ(93)=2 - PSQ=PYMASS(KFLO(1)) - MSTJ(93)=2 - PSQ=PSQ+PYMASS(KFLO(2)) - MMAT=11 - GOTO 290 - ENDIF - -C...Boost back for rapidly moving particle. - 630 N=N+ND - IF(MBST.EQ.1) THEN - DO 640 J=1,3 - BE(J)=P(IP,J)/P(IP,4) - 640 CONTINUE - GA=P(IP,4)/P(IP,5) - DO 660 I=NSAV+1,N - BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) - DO 650 J=1,3 - P(I,J)=P(I,J)+GA*(GA*BEP/(1D0+GA)+P(I,4))*BE(J) - 650 CONTINUE - P(I,4)=GA*(P(I,4)+BEP) - 660 CONTINUE - ENDIF - -C...Fill in position of decay vertex. - DO 680 I=NSAV+1,N - DO 670 J=1,4 - V(I,J)=VDCY(J) - 670 CONTINUE - V(I,5)=0D0 - 680 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).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).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=PYCOMP(K(NSAV+1,2)) - KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) - JCON=4 - IF(KQP.LT.0) JCON=5 - K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) - K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) - K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) - K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) - MSTJ(92)=NSAV+1 - ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN - K(NSAV+1,1)=3 - K(NSAV+3,1)=3 - K(NSAV+1,4)=MSTU(5)*(NSAV+3) - K(NSAV+1,5)=MSTU(5)*(NSAV+3) - K(NSAV+3,4)=MSTU(5)*(NSAV+1) - K(NSAV+3,5)=MSTU(5)*(NSAV+1) - MSTJ(92)=NSAV+1 - ENDIF - -C...Mark decayed particle; special option for B-Bbar 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********************************************************************* - -C...PYDIFF -C...Handles diffractive and elastic scattering. - - SUBROUTINE PYDIFF - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/ - -C...Reset K, P and V vectors. Store incoming particles. - DO 110 JT=1,MSTP(126)+10 - I=MINT(83)+JT - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - N=MINT(84) - MINT(3)=0 - MINT(21)=0 - MINT(22)=0 - MINT(23)=0 - MINT(24)=0 - MINT(4)=4 - DO 130 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 120 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 120 CONTINUE - 130 CONTINUE - MINT(6)=2 - -C...Subprocess; kinematics. - SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4D0*VINT(63)*VINT(64) - PZ=SQRT(SQLAM)/(2D0*VINT(1)) - DO 200 JT=1,2 - I=MINT(83)+JT - PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2D0*VINT(1)) - KFH=MINT(102+JT) - -C...Elastically scattered particle. (Except elastic GVMD states.) - IF(MINT(16+JT).LE.0.AND.(MINT(10+JT).NE.22.OR. - & MINT(106+JT).NE.3)) THEN - N=N+1 - K(N,1)=1 - K(N,2)=KFH - K(N,3)=I+2 - P(N,3)=PZ*(-1)**(JT+1) - P(N,4)=PE - P(N,5)=SQRT(VINT(62+JT)) - -C...Decay rho from elastic scattering of gamma with sin**2(theta) -C...distribution of decay products (in rho rest frame). - IF(KFH.EQ.113.AND.MINT(10+JT).EQ.22.AND.MSTP(102).EQ.1) THEN - NSAV=N - DBETAZ=P(N,3)/SQRT(P(N,3)**2+P(N,5)**2) - P(N,3)=0D0 - P(N,4)=P(N,5) - CALL PYDECY(NSAV) - IF(N.EQ.NSAV+2.AND.IABS(K(NSAV+1,2)).EQ.211) THEN - PHI=PYANGL(P(NSAV+1,1),P(NSAV+1,2)) - CALL PYROBO(NSAV+1,NSAV+2,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(NSAV+1,3),P(NSAV+1,1)) - CALL PYROBO(NSAV+1,NSAV+2,-THE,0D0,0D0,0D0,0D0) - 140 CTHE=2D0*PYR(0)-1D0 -C... Changing parameters for R_rho with values corresponding to W<7 (measured by -C... HERMES -C R_rho=1/eps * r0400/(1. - r0400) - PMVIRT=0.76849997 - R_rho=PARP(165)*(VINT(307)/(PMVIRT**2))**PARP(166) -C eps = (1. - VINT(309)) / (1.-VINT(309)+ -C $ (0.5*(VINT(309))**2.)) - BEAMAS=PYMASS(11) -C new epsilon (f_L/f_T) as used in pysigh.F with proton mass - eps=1D0/(1D0+(VINT(309)**2*(1D0-2D0*BEAMAS**2/ - & VINT(307)))/(2D0/(1D0+VINT(307)/VINT(309)**2/ - & VINT(290)**2)*(1D0-VINT(309)- - & (VINT(307)/4D0/VINT(290)**2)))) - r0400=eps*R_rho / ( 1. + eps * R_rho) - w_ang=0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0)*cthe**2.) - if( r0400 .le. 1.d0/3.d0 ) then - w_ang_max_x = 0.d0 - else - w_ang_max_x = 1.d0 - endif - w_ang_max= 0.75d0*(1.d0-r0400+(3.d0*r0400-1.d0) - $ *w_ang_max_x**2.) - -C IF(1D0-CTHE**2.LT.PYR(0)) GOTO 140 - IF(PYR(0).gt.w_ang/w_ang_max) GOTO 140 - CALL PYROBO(NSAV+1,NSAV+2,ACOS(CTHE),PHI,0D0,0D0,0D0) - ENDIF - CALL PYROBO(NSAV,NSAV+2,0D0,0D0,0D0,0D0,DBETAZ) - ENDIF - -C...Diffracted particle: low-mass system to two particles. - ELSEIF(VINT(62+JT).LT.(VINT(66+JT)+PARP(103))**2) THEN - N=N+2 - K(N-1,1)=1 - K(N,1)=1 - K(N-1,3)=I+2 - K(N,3)=I+2 - PMMAS=SQRT(VINT(62+JT)) - NTRY=0 - 150 NTRY=NTRY+1 - IF(NTRY.LT.20) THEN - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,KFL1,KFL2) - CALL PYKFDI(KFL1,0,KFL3,KF1) - IF(KF1.EQ.0) GOTO 150 - CALL PYKFDI(KFL2,-KFL3,KFLDUM,KF2) - IF(KF2.EQ.0) GOTO 150 - ELSE - KF1=KFH - KF2=111 - ENDIF - PM1=PYMASS(KF1) - PM2=PYMASS(KF2) - IF(PM1+PM2+PARJ(64).GT.PMMAS) GOTO 150 - K(N-1,2)=KF1 - K(N,2)=KF2 - P(N-1,5)=PM1 - P(N,5)=PM2 - PZP=SQRT(MAX(0D0,(PMMAS**2-PM1**2-PM2**2)**2- - & 4D0*PM1**2*PM2**2))/(2D0*PMMAS) - P(N-1,3)=PZP - P(N,3)=-PZP - P(N-1,4)=SQRT(PM1**2+PZP**2) - P(N,4)=SQRT(PM2**2+PZP**2) - CALL PYROBO(N-1,N,ACOS(2D0*PYR(0)-1D0),PARU(2)*PYR(0), - & 0D0,0D0,0D0) - DBETAZ=PZ*(-1)**(JT+1)/SQRT(PZ**2+PMMAS**2) - CALL PYROBO(N-1,N,0D0,0D0,0D0,0D0,DBETAZ) - -C...Diffracted particle: valence quark kicked out. - ELSEIF(MSTP(101).EQ.1.OR.(MSTP(101).EQ.3.AND.PYR(0).LT. - & PARP(101))) THEN - N=N+2 - K(N-1,1)=2 - K(N,1)=1 - K(N-1,3)=I+2 - K(N,3)=I+2 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,K(N,2),K(N-1,2)) - P(N-1,5)=PYMASS(K(N-1,2)) - P(N,5)=PYMASS(K(N,2)) - SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- - & 4D0*P(N-1,5)**2*P(N,5)**2 - P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- - & P(N,5)**2))/(2D0*VINT(62+JT))*(-1)**(JT+1) - P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) - P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) - P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) - -C...Diffracted particle: gluon kicked out. - ELSE - N=N+3 - K(N-2,1)=2 - K(N-1,1)=2 - K(N,1)=1 - K(N-2,3)=I+2 - K(N-1,3)=I+2 - K(N,3)=I+2 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(KFH,21,K(N,2),K(N-2,2)) - K(N-1,2)=21 - P(N-2,5)=PYMASS(K(N-2,2)) - P(N-1,5)=0D0 - P(N,5)=PYMASS(K(N,2)) -C...Energy distribution for particle into two jets. - 160 IMB=1 - IF(MOD(KFH/1000,10).NE.0) IMB=2 - CHIK=PARP(92+2*IMB) - IF(MSTP(92).LE.1) THEN - IF(IMB.EQ.1) CHI=PYR(0) - IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) - ELSEIF(MSTP(92).EQ.2) THEN - CHI=1D0-PYR(0)**(1D0/(1D0+CHIK)) - ELSEIF(MSTP(92).EQ.3) THEN - CUT=2D0*0.3D0/VINT(1) - 170 CHI=PYR(0)**2 - IF((CHI**2/(CHI**2+CUT**2))**0.25D0*(1D0-CHI)**CHIK.LT. - & PYR(0)) GOTO 170 - ELSEIF(MSTP(92).EQ.4) THEN - CUT=2D0*0.3D0/VINT(1) - CUTR=(1D0+SQRT(1D0+CUT**2))/CUT - 180 CHIR=CUT*CUTR**PYR(0) - CHI=(CHIR**2-CUT**2)/(2D0*CHIR) - IF((1D0-CHI)**CHIK.LT.PYR(0)) GOTO 180 - ELSE - CUT=2D0*0.3D0/VINT(1) - CUTA=CUT**(1D0-PARP(98)) - CUTB=(1D0+CUT)**(1D0-PARP(98)) - 190 CHI=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) - IF(((CHI+CUT)**2/(2D0*(CHI**2+CUT**2)))** - & (0.5D0*PARP(98))*(1D0-CHI)**CHIK.LT.PYR(0)) GOTO 190 - ENDIF - IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1D0-P(N-2,5)**2/ - & VINT(62+JT)) GOTO 160 - SQM=P(N-2,5)**2/(1D0-CHI)+P(N,5)**2/CHI - PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ - & (2D0*VINT(62+JT)) - PEI=SQRT(PZI**2+SQM) - PQQP=(1D0-CHI)*(PEI+PZI) - P(N-2,3)=0.5D0*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) - P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) - P(N-1,4)=0.5D0*(VINT(62+JT)-SQM)/(PEI+PZI) - P(N-1,3)=P(N-1,4)*(-1)**JT - P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) - P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) - ENDIF - -C...Documentation lines. - K(I+2,1)=21 - IF(MINT(16+JT).EQ.0) K(I+2,2)=KFH - IF(MINT(16+JT).NE.0.OR.(MINT(10+JT).EQ.22.AND. - & MINT(106+JT).EQ.3)) K(I+2,2)=ISIGN(9900000,KFH)+10*(KFH/10) - K(I+2,3)=I - P(I+2,3)=PZ*(-1)**(JT+1) - P(I+2,4)=PE - P(I+2,5)=SQRT(VINT(62+JT)) - 200 CONTINUE - -C...Rotate outgoing partons/particles using cos(theta). - IF(VINT(23).LT.0.9D0) THEN - CALL PYROBO(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) - ELSE - CALL PYROBO(MINT(83)+3,N,ASIN(VINT(59)),VINT(24),0D0,0D0,0D0) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDISG -C...Set up a DIS process as gamma* + f -> f, with beam remnant -C...and showering added consecutively. Photon flux by the PYGAGA -C...routine (if at all). - - SUBROUTINE PYDISG - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION PMS(4) - -C...Choice of subprocess, number of documentation lines - IDOC=7 - MINT(3)=IDOC-6 - MINT(4)=IDOC - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IPU3=MINT(84)+3 - ISIDE=1 - IF(MINT(107).EQ.4) ISIDE=2 - -C...Reset K, P and V vectors. Store incoming particles - DO 110 JT=1,MSTP(126)+20 - I=MINT(83)+JT - DO 100 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - DO 130 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 120 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 120 CONTINUE - 130 CONTINUE - MINT(6)=2 - -C...Store incoming partons in hadronic CM-frame - DO 140 JT=1,2 - I=MINT(84)+JT - K(I,1)=14 - K(I,2)=MINT(14+JT) - K(I,3)=MINT(83)+2+JT - 140 CONTINUE - IF(MINT(15).EQ.22) THEN - P(MINT(84)+1,3)=0.5D0*(VINT(1)+VINT(307)/VINT(1)) - P(MINT(84)+1,4)=0.5D0*(VINT(1)-VINT(307)/VINT(1)) - P(MINT(84)+1,5)=-SQRT(VINT(307)) - P(MINT(84)+2,3)=-0.5D0*VINT(307)/VINT(1) - P(MINT(84)+2,4)=0.5D0*VINT(307)/VINT(1) - KFRES=MINT(16) - ISIDE=2 - ELSE - P(MINT(84)+1,3)=0.5D0*VINT(308)/VINT(1) - P(MINT(84)+1,4)=0.5D0*VINT(308)/VINT(1) - P(MINT(84)+2,3)=-0.5D0*(VINT(1)+VINT(308)/VINT(1)) - P(MINT(84)+2,4)=0.5D0*(VINT(1)-VINT(308)/VINT(1)) - P(MINT(84)+1,5)=-SQRT(VINT(308)) - KFRES=MINT(15) - ISIDE=1 - ENDIF - SIDESG=(-1D0)**(ISIDE-1) - -C...Copy incoming partons to documentation lines. - DO 170 JT=1,2 - I1=MINT(83)+4+JT - I2=MINT(84)+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 150 J=1,5 - P(I1,J)=P(I2,J) - 150 CONTINUE - -C...Second copy for partons before ISR shower, since no such. - I1=MINT(83)+2+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 160 J=1,5 - P(I1,J)=P(I2,J) - 160 CONTINUE - 170 CONTINUE - -C...Define initial partons. - NTRY=0 - 180 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Scattered quark in hadronic CM frame. - I=MINT(83)+7 - K(IPU3,1)=3 - K(IPU3,2)=KFRES - K(IPU3,3)=I - P(IPU3,5)=PYMASS(KFRES) - P(IPU3,3)=P(IPU1,3)+P(IPU2,3) - P(IPU3,4)=P(IPU1,4)+P(IPU2,4) - P(IPU3,5)=0D0 - K(I,1)=21 - K(I,2)=KFRES - K(I,3)=MINT(83)+4+ISIDE - P(I,3)=P(IPU3,3) - P(I,4)=P(IPU3,4) - P(I,5)=P(IPU3,5) - N=IPU3 - MINT(21)=KFRES - MINT(22)=0 - -C...No primordial kT, or chosen according to truncated Gaussian or -C...exponential, or (for photon) predetermined or power law. - 190 IF(MINT(40+ISIDE).EQ.2.AND.MINT(10+ISIDE).NE.22) THEN - IF(MSTP(91).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(91).EQ.1) THEN - PT=PARP(91)*SQRT(-LOG(PYR(0))) - ELSE - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(92)*LOG(RPT1*RPT2) - ENDIF - IF(PT.GT.PARP(93)) GOTO 190 - ELSEIF(MINT(106+ISIDE).EQ.3) THEN - PTA=SQRT(VINT(282+ISIDE)) - PTB=0D0 - IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN - PTB=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PTB=-PARP(99)*LOG(RPT1*RPT2) - ENDIF - IF(PTB.GT.PARP(100)) GOTO 190 - PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) - IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) - ELSEIF(IABS(MINT(14+ISIDE)).LE.8.OR.MINT(14+ISIDE).EQ.21) THEN - IF(MSTP(93).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(93).EQ.1) THEN - PT=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(99)*LOG(RPT1*RPT2) - ELSEIF(MSTP(93).EQ.3) THEN - HA=PARP(99)**2 - HB=PARP(100)**2 - PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) - ELSE - HA=PARP(99)**2 - HB=PARP(100)**2 - IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) - PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) - ENDIF - IF(PT.GT.PARP(100)) GOTO 190 - ELSE - PT=0D0 - ENDIF - VINT(156+ISIDE)=PT - PHI=PARU(2)*PYR(0) - P(IPU3,1)=PT*COS(PHI) - P(IPU3,2)=PT*SIN(PHI) - P(IPU3,4)=SQRT(P(IPU3,5)**2+PT**2+P(IPU3,3)**2) - PMS(3-ISIDE)=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 - PCP=P(IPU3,4)+ABS(P(IPU3,3)) - -C...Find one or two beam remnants. - MINT(105)=MINT(102+ISIDE) - MINT(109)=MINT(106+ISIDE) - CALL PYSPLI(MINT(10+ISIDE),MINT(12+ISIDE),KFLCH,KFLSP) - IF(MINT(51).NE.0) THEN - MINT(51)=0 - GOTO 180 - ENDIF - -C...Store first remnant parton, with colour info and kinematics. - I=N+1 - K(I,1)=1 - K(I,2)=KFLSP - K(I,3)=MINT(83)+ISIDE - P(I,5)=PYMASS(K(I,2)) - KCOL=KCHG(PYCOMP(KFLSP),2) - IF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLSP))/2 - K(I,KFLS+3)=MSTU(5)*IPU3 - K(IPU3,6-KFLS)=MSTU(5)*I - ICOLR=I - ENDIF - IF(KFLCH.EQ.0) THEN - P(I,1)=-P(IPU3,1) - P(I,2)=-P(IPU3,2) - PMS(ISIDE)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - P(I,3)=-P(IPU3,3) - P(I,4)=SQRT(PMS(ISIDE)+P(I,3)**2) - PRP=P(I,4)+ABS(P(I,3)) - -C...When extra remnant parton or hadron: store extra remnant. - ELSE - I=I+1 - K(I,1)=1 - K(I,2)=KFLCH - K(I,3)=MINT(83)+ISIDE - P(I,5)=PYMASS(K(I,2)) - KCOL=KCHG(PYCOMP(KFLCH),2) - IF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLCH))/2 - K(I,KFLS+3)=MSTU(5)*IPU3 - K(IPU3,6-KFLS)=MSTU(5)*I - ICOLR=I - ENDIF - -C...Relative transverse momentum when two remnants. - LOOP=0 - 200 LOOP=LOOP+1 - CALL PYPTDI(1,P(I-1,1),P(I-1,2)) - P(I-1,1)=P(I-1,1)-0.5D0*P(IPU3,1) - P(I-1,2)=P(I-1,2)-0.5D0*P(IPU3,2) - PMS(3)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 - P(I,1)=-P(IPU3,1)-P(I-1,1) - P(I,2)=-P(IPU3,2)-P(I-1,2) - PMS(4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - -C...Relative distribution of energy for particle into jet plus particle. - IMB=1 - IF(MOD(MINT(10+ISIDE)/1000,10).NE.0) IMB=2 - IF(MSTP(94).LE.1) THEN - IF(IMB.EQ.1) CHI=PYR(0) - IF(IMB.EQ.2) CHI=1D0-SQRT(PYR(0)) - IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI - ELSEIF(MSTP(94).EQ.2) THEN - CHI=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) - IF(MOD(KFLCH/1000,10).NE.0) CHI=1D0-CHI - ELSEIF(MSTP(94).EQ.3) THEN - CALL PYZDIS(1,0,PMS(4),ZZ) - CHI=ZZ - ELSE - CALL PYZDIS(1000,0,PMS(4),ZZ) - CHI=ZZ - ENDIF - -C...Construct total transverse mass; reject if too large. - CHI=MAX(1D-8,MIN(1D0-1D-8,CHI)) - PMS(ISIDE)=PMS(4)/CHI+PMS(3)/(1D0-CHI) - IF(PMS(ISIDE).GT.P(IPU3,4)**2) THEN - IF(LOOP.LT.10) GOTO 200 - GOTO 180 - ENDIF - VINT(158+ISIDE)=CHI - -C...Subdivide longitudinal momentum according to value selected above. - PRP=SQRT(PMS(ISIDE)+P(IPU3,3)**2)+ABS(P(IPU3,3)) - PW1=(1D0-CHI)*PRP - P(I-1,4)=0.5D0*(PW1+PMS(3)/PW1) - P(I-1,3)=0.5D0*(PW1-PMS(3)/PW1)*SIDESG - PW2=CHI*PRP - P(I,4)=0.5D0*(PW2+PMS(4)/PW2) - P(I,3)=0.5D0*(PW2-PMS(4)/PW2)*SIDESG - ENDIF - N=I - -C...Boost current and remnant systems to correct frame. - IF(SQRT(PMS(1))+SQRT(PMS(2)).GT.0.99D0*VINT(1)) GOTO 180 - DSQLAM=SQRT(MAX(0D0,(VINT(2)-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2))) - DRKC=(VINT(2)+PMS(3-ISIDE)-PMS(ISIDE)+DSQLAM)/ - &(2D0*VINT(1)*PCP) - DRKR=(VINT(2)+PMS(ISIDE)-PMS(3-ISIDE)+DSQLAM)/ - &(2D0*VINT(1)*PRP) - DBEC=-SIDESG*(DRKC**2-1D0)/(DRKC**2+1D0) - DBER=SIDESG*(DRKR**2-1D0)/(DRKR**2+1D0) - CALL PYROBO(IPU3,IPU3,0D0,0D0,0D0,0D0,DBEC) - CALL PYROBO(IPU3+1,N,0D0,0D0,0D0,0D0,DBER) - -C...Let current quark shower; recoil but no showering by colour partner. - QMAX=2D0*SQRT(VINT(309-ISIDE)) - MSTJ48=MSTJ(48) - MSTJ(48)=1 - PARJ86=PARJ(86) - PARJ(86)=0D0 - IF(MSTP(71).EQ.1) CALL PYSHOW(IPU3,ICOLR,QMAX) - MSTJ(48)=MSTJ48 - PARJ(86)=PARJ86 - - RETURN - END - -C********************************************************************* - -C...PYDOCU -C...Handles the documentation of the process in MSTI and PARI, -C...and also computes cross-sections based on accumulated statistics. - - SUBROUTINE PYDOCU - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYJETS/,/PYDAT1/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT5/ - -C...Calculate Monte Carlo estimates of cross-sections. - ISUB=MINT(1) - IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 - NGEN(0,3)=NGEN(0,3)+1 - XSEC(0,3)=0D0 - DO 100 I=1,500 - IF(I.EQ.96.OR.I.EQ.97) THEN - XSEC(I,3)=0D0 - ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. - & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN - XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* - & DBLE(NGEN(96,2))) - ELSEIF(MSUB(95).EQ.1.AND.I.GE.381.AND.I.LE.386) THEN - XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1D0,DBLE(NGEN(96,1))* - & DBLE(NGEN(96,2))) - ELSEIF(MSUB(I).EQ.0.OR.NGEN(I,1).EQ.0) THEN - XSEC(I,3)=0D0 - ELSEIF(NGEN(I,2).EQ.0) THEN - XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(DBLE(NGEN(I,1))* - & DBLE(NGEN(0,2))) - ELSE - XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(DBLE(NGEN(I,1))* - & DBLE(NGEN(I,2))) - ENDIF - XSEC(0,3)=XSEC(0,3)+XSEC(I,3) - 100 CONTINUE - -C...Rescale to known low-pT cross-section for standard QCD processes. - IF(MSUB(95).EQ.1) THEN - XSECH=XSEC(11,3)+XSEC(12,3)+XSEC(13,3)+XSEC(28,3)+XSEC(53,3)+ - & XSEC(68,3)+XSEC(95,3) - XSECW=XSEC(97,2)/MAX(1D0,DBLE(NGEN(97,1))) - IF(XSECH.GT.1D-20.AND.XSECW.GT.1D-20) THEN - FAC=XSECW/XSECH - XSEC(11,3)=FAC*XSEC(11,3) - XSEC(12,3)=FAC*XSEC(12,3) - XSEC(13,3)=FAC*XSEC(13,3) - XSEC(28,3)=FAC*XSEC(28,3) - XSEC(53,3)=FAC*XSEC(53,3) - XSEC(68,3)=FAC*XSEC(68,3) - XSEC(95,3)=FAC*XSEC(95,3) - XSEC(0,3)=XSEC(0,3)-XSECH+XSECW - ENDIF - ENDIF - -C...Save information for gamma-p and gamma-gamma. - IF(MINT(121).GT.1) THEN - IGA=MINT(122) - CALL PYSAVE(2,IGA) - CALL PYSAVE(5,0) - ENDIF - -C...Reset information on hard interaction. - DO 110 J=1,200 - MSTI(J)=0 - PARI(J)=0D0 - 110 CONTINUE - -C...Copy integer valued information from MINT into MSTI. - DO 120 J=1,32 - MSTI(J)=MINT(J) - 120 CONTINUE - IF(MINT(121).GT.1) MSTI(9)=MINT(122) - -C...Store cross-section variables in PARI. - PARI(1)=XSEC(0,3) - PARI(2)=XSEC(0,3)/MINT(5) - PARI(7)=VINT(97) - PARI(9)=VINT(99) - PARI(10)=VINT(100) - VINT(98)=VINT(98)+VINT(100) - IF(MSTP(142).EQ.1) PARI(2)=XSEC(0,3)/VINT(98) - -C...Store kinematics variables in PARI. - PARI(11)=VINT(1) - PARI(12)=VINT(2) - IF(ISUB.NE.95) THEN - DO 130 J=13,26 - PARI(J)=VINT(30+J) - 130 CONTINUE - PARI(31)=VINT(141) - PARI(32)=VINT(142) - PARI(33)=VINT(41) - PARI(34)=VINT(42) - PARI(35)=PARI(33)-PARI(34) - PARI(36)=VINT(21) - PARI(37)=VINT(22) - PARI(38)=VINT(26) - PARI(39)=VINT(157) - PARI(40)=VINT(158) - PARI(41)=VINT(23) - PARI(42)=2D0*VINT(47)/VINT(1) - ENDIF - -C...Store information on scattered partons in PARI. - IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN - DO 140 IS=7,8 - I=MINT(IS) - PARI(36+IS)=P(I,3)/VINT(1) - PARI(38+IS)=P(I,4)/VINT(1) - PR=MAX(1D-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) - PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ - & SQRT(PR),1D20)),P(I,3)) - PR=MAX(1D-20,P(I,1)**2+P(I,2)**2) - PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ - & SQRT(PR),1D20)),P(I,3)) - PARI(44+IS)=P(I,3)/SQRT(1D-20+P(I,1)**2+P(I,2)**2+P(I,3)**2) - PARI(46+IS)=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) - PARI(48+IS)=PYANGL(P(I,1),P(I,2)) - 140 CONTINUE - ENDIF - -C...Store sum up transverse and longitudinal momenta. - PARI(65)=2D0*PARI(17) - IF(ISUB.LE.90.OR.ISUB.GE.95) THEN - DO 150 I=MSTP(126)+1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 - PT=SQRT(P(I,1)**2+P(I,2)**2) - PARI(69)=PARI(69)+PT - IF(I.LE.MINT(52)) PARI(66)=PARI(66)+PT - IF(I.GT.MINT(52).AND.I.LE.MINT(53)) PARI(68)=PARI(68)+PT - 150 CONTINUE - PARI(67)=PARI(68) - PARI(71)=VINT(151) - PARI(72)=VINT(152) - PARI(73)=VINT(151) - PARI(74)=VINT(152) - ELSE - PARI(66)=PARI(65) - PARI(69)=PARI(65) - ENDIF - -C...Store various other pieces of information into PARI. - PARI(61)=VINT(148) - PARI(75)=VINT(155) - PARI(76)=VINT(156) - PARI(77)=VINT(159) - PARI(78)=VINT(160) - PARI(81)=VINT(138) - -C...Store information on lepton -> lepton + gamma in PYGAGA. - MSTI(71)=MINT(141) - MSTI(72)=MINT(142) - PARI(101)=VINT(301) - PARI(102)=VINT(302) - DO 160 I=103,114 - PARI(I)=VINT(I+202) - 160 CONTINUE - -C...Set information for PYTABU. - IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN - MSTU(161)=MINT(21) - MSTU(162)=0 - ELSEIF(ISET(ISUB).EQ.5) THEN - MSTU(161)=MINT(23) - MSTU(162)=0 - ELSE - MSTU(161)=MINT(21) - MSTU(162)=MINT(22) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYDUMP -C...Dumps histogram contents on file for reading by other program. -C...Can also read back own dump. - - SUBROUTINE PYDUMP(MDUMP,LFN,NHI,IHI) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Local arrays and character variables. - DIMENSION IHI(*),ISS(100),VAL(5) - CHARACTER TITLE*60,FORMAT*13 - -C...Dump all histograms that have been booked, -C...including titles and ranges, one after the other. - IF(MDUMP.EQ.1) THEN - -C...Loop over histograms and find which are wanted and booked. - IF(NHI.LE.0) THEN - NW=IHIST(1) - ELSE - NW=NHI - ENDIF - DO 130 IW=1,NW - IF(NHI.EQ.0) THEN - ID=IW - ELSE - ID=IHI(IW) - ENDIF - IS=INDX(ID) - IF(IS.NE.0) THEN - -C...Write title, histogram size, filling statistics. - NX=NINT(BIN(IS+1)) - DO 100 IT=1,20 - IEQ=NINT(BIN(IS+8+NX+IT)) - TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)// - & CHAR(MOD(IEQ,256**2)/256)//CHAR(MOD(IEQ,256)) - 100 CONTINUE - WRITE(LFN,5100) ID,TITLE - WRITE(LFN,5200) NX,BIN(IS+2),BIN(IS+3) - WRITE(LFN,5300) NINT(BIN(IS+5)),BIN(IS+6),BIN(IS+7), - & BIN(IS+8) - - -C...Write histogram contents, in groups of five. - DO 120 IXG=1,(NX+4)/5 - DO 110 IXV=1,5 - IX=5*IXG+IXV-5 - IF(IX.LE.NX) THEN - VAL(IXV)=BIN(IS+8+IX) - ELSE - VAL(IXV)=0D0 - ENDIF - 110 CONTINUE - WRITE(LFN,5400) (VAL(IXV),IXV=1,5) - 120 CONTINUE - -C...Go to next histogram; finish. - ELSEIF(NHI.GT.0) THEN - CALL PYERRM(8,'(PYDUMP:) unknown histogram number') - ENDIF - 130 CONTINUE - -C...Read back in histograms dumped MDUMP=1. - ELSEIF(MDUMP.EQ.2) THEN - -C...Read histogram number, title and range, and book. - 140 READ(LFN,5100,END=170) ID,TITLE - READ(LFN,5200) NX,XL,XU - CALL PYBOOK(ID,TITLE,NX,XL,XU) - IS=INDX(ID) - -C...Read filling statistics. - READ(LFN,5300) NENTRY,BIN(IS+6),BIN(IS+7),BIN(IS+8) - BIN(IS+5)=DBLE(NENTRY) - -C...Read histogram contents, in groups of five. - DO 160 IXG=1,(NX+4)/5 - READ(LFN,5400) (VAL(IXV),IXV=1,5) - DO 150 IXV=1,5 - IX=5*IXG+IXV-5 - IF(IX.LE.NX) BIN(IS+8+IX)=VAL(IXV) - 150 CONTINUE - 160 CONTINUE - -C...Go to next histogram; finish. - GOTO 140 - 170 CONTINUE - -C...Write histogram contents in column format, -C...convenient e.g. for GNUPLOT input. - ELSEIF(MDUMP.EQ.3) THEN - -C...Find addresses to wanted histograms. - NSS=0 - IF(NHI.LE.0) THEN - NW=IHIST(1) - ELSE - NW=NHI - ENDIF - DO 180 IW=1,NW - IF(NHI.EQ.0) THEN - ID=IW - ELSE - ID=IHI(IW) - ENDIF - IS=INDX(ID) - IF(IS.NE.0.AND.NSS.LT.100) THEN - NSS=NSS+1 - ISS(NSS)=IS - ELSEIF(NSS.GE.100) THEN - CALL PYERRM(8,'(PYDUMP:) too many histograms requested') - ELSEIF(NHI.GT.0) THEN - CALL PYERRM(8,'(PYDUMP:) unknown histogram number') - ENDIF - 180 CONTINUE - -C...Check that they have common number of x bins. Fix format. - NX=NINT(BIN(ISS(1)+1)) - DO 190 IW=2,NSS - IF(NINT(BIN(ISS(IW)+1)).NE.NX) THEN - CALL PYERRM(8,'(PYDUMP:) different number of bins') - RETURN - ENDIF - 190 CONTINUE - FORMAT='(1P,000E12.4)' - WRITE(FORMAT(5:7),'(I3)') NSS+1 - -C...Write histogram contents; first column x values. - DO 200 IX=1,NX - X=BIN(ISS(1)+2)+(IX-0.5D0)*BIN(ISS(1)+4) - WRITE(LFN,FORMAT) X, (BIN(ISS(IW)+8+IX),IW=1,NSS) - 200 CONTINUE - - ENDIF - -C...Formats for output. - 5100 FORMAT(I5,5X,A60) - 5200 FORMAT(I5,1P,2D12.4) - 5300 FORMAT(I12,1P,3D12.4) - 5400 FORMAT(1P,5D12.4) - - RETURN - END - -C********************************************************************* - -C...PYEDIT -C...Performs global manipulations on the event record, in particular -C...to exclude unstable or undetectable partons/particles. - - SUBROUTINE PYEDIT(MEDIT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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).GE.21.AND.K(I,1).LE.40)) GOTO 110 - IF(MEDIT.EQ.1) THEN - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - ELSEIF(MEDIT.EQ.2) THEN - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - KC=PYCOMP(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.AND.K(I,1).NE.41.AND.K(I,1).NE.42) GOTO 110 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)).EQ.0) GOTO 110 - ELSEIF(MEDIT.EQ.5) THEN - IF(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.K(I,1).EQ.52) GOTO 110 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - IF(K(I,1).GT.10.AND.K(I,1).NE.41.AND.K(I,1).NE.42.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.OR.K(I,1).EQ.51).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,1).EQ.52.OR.K(I,2).EQ.94)) GOTO 120 - IF(MEDIT.EQ.15.AND.K(I,1).GE.21.AND.K(I,1).LE.40) 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).GE.21.AND.K(I,1).LE.40).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.OR. - & K(IM,1).EQ.51).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,1).EQ.52.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.AND. - & K(I,1).NE.42.AND.K(I,1).NE.52) 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).AND.K(I,1).NE.42.AND. - & K(I,1).NE.52) 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 220 I=1,N - IF(K(I,1).LE.10.OR.(K(I,1).GE.21.AND.K(I,1).LE.50)) GOTO 220 - IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 220 -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 220 -C...Find daughters who point to documentation version of mother. - IM=K(I,3) - IF(IM.LE.0.OR.IM.GE.I) GOTO 220 - IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 220 - IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1D-2) GOTO 220 - DO 190 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 - 190 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - IF(K(I,4).NE.0) GOTO 220 -C...Find daughters who point to documentation daughters who, -C...in their turn, point to documentation mother. - ID1=IM - ID2=IM - DO 200 I1=IM+1,I-1 - IF(K(I1,3).EQ.IM.AND.K(I1,1).GE.21.AND.K(I1,1).LE.30) THEN - ID2=I1 - IF(ID1.EQ.IM) ID1=I1 - ENDIF - 200 CONTINUE - DO 210 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 - 210 CONTINUE - IF(K(I,5).EQ.0) K(I,5)=K(I,4) - 220 CONTINUE - -C...Save top entries at bottom of PYJETS commonblock. - ELSEIF(MEDIT.EQ.21) THEN - IF(2*N.GE.MSTU(4)) THEN - CALL PYERRM(11,'(PYEDIT:) no more memory left in PYJETS') - RETURN - ENDIF - DO 240 I=1,N - DO 230 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) - 230 CONTINUE - 240 CONTINUE - MSTU(32)=N - -C...Restore bottom entries of commonblock PYJETS to top. - ELSEIF(MEDIT.EQ.22) THEN - DO 260 I=1,MSTU(32) - DO 250 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) - 250 CONTINUE - 260 CONTINUE - N=MSTU(32) - -C...Mark primary entries at top of commonblock PYJETS as untreated. - ELSEIF(MEDIT.EQ.23) THEN - I1=0 - DO 270 I=1,N - KH=K(I,3) - IF(KH.GE.1) THEN - IF(K(KH,1).GE.21.AND.K(KH,1).LE.30) KH=0 - ENDIF - IF(KH.NE.0) GOTO 280 - I1=I1+1 - IF(K(I,1).GE.11.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 - IF(K(I,1).GE.51.AND.K(I,1).LE.60) K(I,1)=K(I,1)-10 - 270 CONTINUE - 280 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 PYROBO(1,N+MSTU(3),0D0,-PYANGL(P(MSTU(61),1), - & P(MSTU(61),2)),0D0,0D0,0D0) - CALL PYROBO(1,N+MSTU(3),-PYANGL(P(MSTU(61),3), - & P(MSTU(61),1)),0D0,0D0,0D0,0D0) - CALL PYROBO(1,N+MSTU(3),0D0,-PYANGL(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 290 IS=1,2 - NS(IS)=0 - PTS(IS)=0D0 - PLS(IS)=0D0 - 290 CONTINUE - DO 300 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 300 - IF(MSTU(41).GE.2) THEN - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 300 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) - & .EQ.0) GOTO 300 - ENDIF - IS=2D0-SIGN(0.5D0,P(I,3)) - NS(IS)=NS(IS)+1 - PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) - 300 CONTINUE - IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) - & CALL PYROBO(1,N+MSTU(3),PARU(1),0D0,0D0,0D0,0D0) - -C...Rotate to put second largest jet into -z,+x quadrant. - DO 310 I=1,N - IF(P(I,3).GE.0D0) GOTO 310 - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 310 - IF(MSTU(41).GE.2) THEN - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. - & KC.EQ.18) GOTO 310 - IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.PYCHGE(K(I,2)) - & .EQ.0) GOTO 310 - ENDIF - IS=2D0-SIGN(0.5D0,P(I,1)) - PLS(IS)=PLS(IS)-P(I,3) - 310 CONTINUE - IF(PLS(2).GT.PLS(1)) CALL PYROBO(1,N+MSTU(3),0D0,PARU(1), - & 0D0,0D0,0D0) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYEEVT -C...Handles the generation of an e+e- annihilation jet event. - - SUBROUTINE PYEEVT(KFL,ECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Check input parameters. - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL PYERRM(16,'(PYEEVT:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02D0*PARF(100+MAX(1,KFL)) - IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02D0*PMAS(KFL,1) - IF(ECM.LT.ECMMIN) THEN - CALL PYERRM(16,'(PYEEVT:) 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 PYERRM(6, - & '(PYEEVT:) MSTJ(109) value requires MSTJ(110) = 1') - MSTJ(110)=1 - ENDIF - IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN - CALL PYERRM(6, - & '(PYEEVT:) 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 PYXTEE(KFL,ECM, - &XTOT) - IF(MSTJ(116).GE.3) MSTJ(116)=1 - PARJ(171)=0D0 - -C...Add initial e+e- to event record (documentation only). - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYEEVT:) caught in an infinite loop') - RETURN - ENDIF - MSTU(24)=0 - NC=0 - IF(MSTJ(115).GE.2) THEN - NC=NC+2 - CALL PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) - K(NC-1,1)=21 - CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) - 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 PYRADK(ECM,MK,PAK, - &THEK,PHIK,ALPK) - IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2D0*PAK)) - IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN - NC=NC+1 - CALL PY1ENT(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 PY1ENT(NC,KF,ECMC,0D0,0D0) - K(NC,1)=21 - K(NC,3)=1 - MSTU(10)=MSTU10 - ENDIF - -C...Choice of flavour and jet configuration. - CALL PYXKFL(KFL,ECM,ECMC,KFLC) - IF(KFLC.EQ.0) GOTO 100 - CALL PYXJET(ECMC,NJET,CUT) - KFLN=21 - IF(NJET.EQ.4) CALL PYX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, - &X12,X14) - IF(NJET.EQ.3) CALL PYX3JT(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 PY2ENT(NC+1,KFLC,-KFLC,ECMC) - IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL PY2ENT(-(NC+1),KFLC,-KFLC, - &ECMC) - IF(NJET.EQ.3) CALL PY3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) - IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL PY4ENT(NC+1,KFLC,KFLN,KFLN, - &-KFLC,ECMC,X1,X2,X4,X12,X14) - IF(NJET.EQ.4.AND.KFLN.NE.21) CALL PY4ENT(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 PYXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) - CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) - CALL PYROBO(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 PYROBO(NMIN,N,0D0,-PHIK,0D0,0D0,0D0) - CALL PYROBO(NMIN,N,ALPK,0D0,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) - CALL PYROBO(NMIN,N,0D0,PHIK,0D0,0D0,0D0) - ENDIF - -C...Generate parton shower. Rearrange along strings and check. - IF(MSTJ(101).EQ.5) THEN - CALL PYSHOW(N-1,N,ECMC) - MSTJ14=MSTJ(14) - IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 - IF(MSTJ(105).GE.0) MSTU(28)=0 - CALL PYPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Fragmentation/decay generation. Information for PYTABU. - IF(MSTJ(105).EQ.1) CALL PYEXEC - MSTU(161)=KFLC - MSTU(162)=-KFLC - - RETURN - END - -C********************************************************************* - -C...PYEIGC -C...Finds eigenvalues of a general complex matrix -C -C THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF -C SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) -C TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) -C OF A COMPLEX GENERAL MATRIX. -C -C ON INPUT -C -C NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL -C ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM -C DIMENSION STATEMENT. -C -C N IS THE ORDER OF THE MATRIX A=(AR,AI). -C -C AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE COMPLEX GENERAL MATRIX. -C -C MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF -C ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO -C ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. -C -C ON OUTPUT -C -C WR AND WI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVALUES. -C -C ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, -C RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. -C -C IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR -C COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR COMQR -C AND COMQR2. THE NORMAL COMPLETION CODE IS ZERO. -C -C FV1, FV2, AND FV3 ARE TEMPORARY STORAGE ARRAYS. -C -C QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, -C MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY -C -C THIS VERSION DATED AUGUST 1983. -C - - SUBROUTINE PYEICG(NM,N,AR,AI,WR,WI,MATZ,ZR,ZI,FV1,FV2,FV3,IERR) - - INTEGER N,NM,IS1,IS2,IERR,MATZ - DOUBLE PRECISION AR(4,4),AI(4,4),WR(4),WI(4),ZR(4,4),ZI(4,4), - X FV1(4),FV2(4),FV3(4) - IF (N .LE. NM) GOTO 100 - IERR = 10 * N - GOTO 120 -C - 100 CALL PYCBAL(NM,N,AR,AI,IS1,IS2,FV1) - CALL PYCRTH(NM,N,IS1,IS2,AR,AI,FV2,FV3) - IF (MATZ .NE. 0) GOTO 110 -C .......... FIND EIGENVALUES ONLY .......... - CALL PYCMQR(NM,N,IS1,IS2,AR,AI,WR,WI,IERR) - GOTO 120 -C .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... - 110 CALL PYCMQ2(NM,N,IS1,IS2,FV2,FV3,AR,AI,WR,WI,ZR,ZI,IERR) - IF (IERR .NE. 0) GOTO 120 - CALL PYCBA2(NM,N,IS1,IS2,FV1,N,ZR,ZI) - 120 RETURN - END - -C********************************************************************* - -C...PYEIG4 -C...Finds eigenvalues and eigenvectors to a 4 * 4 matrix. -C...Specific application: mixing in neutralino sector. - - SUBROUTINE PYEIG4(A,W,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Arrays: in call and local. - DIMENSION A(4,4),W(4),Z(4,4),X(4),D(4,4),E(4) - -C...Coefficients of fourth-degree equation from matrix. -C...x**4 + b3 * x**3 + b2 * x**2 + b1 * x + b0 = 0. - B3=-(A(1,1)+A(2,2)+A(3,3)+A(4,4)) - B2=0D0 - DO 110 I=1,3 - DO 100 J=I+1,4 - B2=B2+A(I,I)*A(J,J)-A(I,J)*A(J,I) - 100 CONTINUE - 110 CONTINUE - B1=0D0 - B0=0D0 - DO 120 I=1,4 - I1=MOD(I,4)+1 - I2=MOD(I+1,4)+1 - I3=MOD(I+2,4)+1 - B1=B1+A(I,I)*(-A(I1,I1)*A(I2,I2)+A(I1,I2)*A(I2,I1)+ - & A(I1,I3)*A(I3,I1)+A(I2,I3)*A(I3,I2))- - & A(I,I1)*A(I1,I2)*A(I2,I)-A(I,I2)*A(I2,I1)*A(I1,I) - B0=B0+(-1D0)**(I+1)*A(1,I)*( - & A(2,I1)*(A(3,I2)*A(4,I3)-A(3,I3)*A(4,I2))+ - & A(2,I2)*(A(3,I3)*A(4,I1)-A(3,I1)*A(4,I3))+ - & A(2,I3)*(A(3,I1)*A(4,I2)-A(3,I2)*A(4,I1))) - 120 CONTINUE - -C...Coefficients of third-degree equation needed for -C...separation into two second-degree equations. -C...u**3 + c2 * u**2 + c1 * u + c0 = 0. - C2=-B2 - C1=B1*B3-4D0*B0 - C0=-B1**2-B0*B3**2+4D0*B0*B2 - CQ=C1/3D0-C2**2/9D0 - CR=C1*C2/6D0-C0/2D0-C2**3/27D0 - CQR=CQ**3+CR**2 - -C...Cases with one or three real roots. - IF(CQR.GE.0D0) THEN - S1=(CR+SQRT(CQR))**(1D0/3D0) - S2=(CR-SQRT(CQR))**(1D0/3D0) - U=S1+S2-C2/3D0 - ELSE - SABS=SQRT(-CQ) - THE=ACOS(CR/SABS**3)/3D0 - SRE=SABS*COS(THE) - U=2D0*SRE-C2/3D0 - ENDIF - -C...Find and solve two second-degree equations. - P1=B3/2D0-SQRT(B3**2/4D0+U-B2) - P2=B3/2D0+SQRT(B3**2/4D0+U-B2) - Q1=U/2D0+SQRT(U**2/4D0-B0) - Q2=U/2D0-SQRT(U**2/4D0-B0) - IF(ABS(P1*Q1+P2*Q2-B1).LT.ABS(P1*Q2+P2*Q1-B1)) THEN - QSAV=Q1 - Q1=Q2 - Q2=QSAV - ENDIF - X(1)=-P1/2D0+SQRT(P1**2/4D0-Q1) - X(2)=-P1/2D0-SQRT(P1**2/4D0-Q1) - X(3)=-P2/2D0+SQRT(P2**2/4D0-Q2) - X(4)=-P2/2D0-SQRT(P2**2/4D0-Q2) - -C...Order eigenvalues in asceding mass. - W(1)=X(1) - DO 150 I1=2,4 - DO 130 I2=I1-1,1,-1 - IF(ABS(X(I1)).GE.ABS(W(I2))) GOTO 140 - W(I2+1)=W(I2) - 130 CONTINUE - 140 W(I2+1)=X(I1) - 150 CONTINUE - -C...Find equation system for eigenvectors. - DO 250 I=1,4 - DO 170 J1=1,4 - D(J1,J1)=A(J1,J1)-W(I) - DO 160 J2=J1+1,4 - D(J1,J2)=A(J1,J2) - D(J2,J1)=A(J2,J1) - 160 CONTINUE - 170 CONTINUE - -C...Find largest element in matrix. - DAMAX=0D0 - DO 190 J1=1,4 - DO 180 J2=1,4 - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 180 - JA=J1 - JB=J2 - DAMAX=ABS(D(J1,J2)) - 180 CONTINUE - 190 CONTINUE - -C...Subtract others by multiple of row selected above. - DAMAX=0D0 - DO 210 J3=JA+1,JA+3 - J1=J3-4*((J3-1)/4) - RL=D(J1,JB)/D(JA,JB) - DO 200 J2=1,4 - D(J1,J2)=D(J1,J2)-RL*D(JA,J2) - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 200 - JC=J1 - JD=J2 - DAMAX=ABS(D(J1,J2)) - 200 CONTINUE - 210 CONTINUE - -C...Do one more subtraction of a row. - DAMAX=0D0 - DO 230 J3=JC+1,JC+3 - J1=J3-4*((J3-1)/4) - IF(J1.EQ.JA) GOTO 230 - RL=D(J1,JD)/D(JC,JD) - DO 220 J2=1,4 - IF(J2.EQ.JB) GOTO 220 - D(J1,J2)=D(J1,J2)-RL*D(JC,J2) - IF(ABS(D(J1,J2)).LE.DAMAX) GOTO 220 - JE=J1 - DAMAX=ABS(D(J1,J2)) - 220 CONTINUE - 230 CONTINUE - -C...Construct unnormalized eigenvector. - JF1=JD+1-4*(JD/4) - JF2=JD+2-4*((JD+1)/4) - IF(JF1.EQ.JB) JF1=JD+3-4*((JD+2)/4) - IF(JF2.EQ.JB) JF2=JD+3-4*((JD+2)/4) - E(JF1)=-D(JE,JF2) - E(JF2)=D(JE,JF1) - E(JD)=-(D(JC,JF1)*E(JF1)+D(JC,JF2)*E(JF2))/D(JC,JD) - E(JB)=-(D(JA,JF1)*E(JF1)+D(JA,JF2)*E(JF2)+D(JA,JD)*E(JD))/ - & D(JA,JB) - -C...Normalize and fill in final array. - EA=SQRT(E(1)**2+E(2)**2+E(3)**2+E(4)**2) - SGN=(-1D0)**INT(PYR(0)+0.5D0) - DO 240 J=1,4 - Z(I,J)=SGN*E(J)/EA - 240 CONTINUE - 250 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYERRM -C...Informs user of errors in program execution. - - SUBROUTINE PYERRM(MERR,CHMESS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local character variable. - 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 - IF(MSTU(29).EQ.0) 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 PYLIST(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',I9, - &' PYEXEC calls:'/5X,A) - 5100 FORMAT(/5X,'Error type',I2,' has occured after',I9, - &' PYEXEC 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',I9, - &' PYEXEC calls:'/5X,A/5X,'Execution will now be stopped!') - - RETURN - END - -C********************************************************************* - -C...PYEVNT -C...Administers the generation of a high-pT event via calls to -C...a number of subroutines. - - SUBROUTINE PYEVNT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT4/,/PYINT5/ -C...Local array. - DIMENSION VTX(4) - -C...Stop if no subprocesses on. - IF(MINT(121).EQ.1.AND.MSTI(53).EQ.1) THEN - WRITE(MSTU(11),5100) - STOP - ENDIF - -C...Initial values for some counters. - N=0 - MINT(5)=MINT(5)+1 - MINT(7)=0 - MINT(8)=0 - MINT(83)=0 - MINT(84)=MSTP(126) - MSTU(24)=0 - MSTU70=0 - MSTJ14=MSTJ(14) - -C...If variable energies: redo incoming kinematics and cross-section. - MSTI(61)=0 - IF(MSTP(171).EQ.1) THEN - CALL PYINKI(1) - IF(MSTI(61).EQ.1) THEN - MINT(5)=MINT(5)-1 - RETURN - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(3,1) - CALL PYXTOT - ENDIF - -C...Loop over number of pileup events; check space left. - IF(MSTP(131).LE.0) THEN - NPILE=1 - ELSE - CALL PYPILE(2) - NPILE=MINT(81) - ENDIF - DO 250 IPILE=1,NPILE - IF(MINT(84)+100.GE.MSTU(4)) THEN - CALL PYERRM(11, - & '(PYEVNT:) no more space in PYJETS for pileup events') - IF(MSTU(21).GE.1) GOTO 260 - ENDIF - MINT(82)=IPILE - -C...Generate variables of hard scattering. - MINT(51)=0 - MSTI(52)=0 - 100 CONTINUE - IF(MINT(51).NE.0.OR.MSTU(24).NE.0) MSTI(52)=MSTI(52)+1 - MINT(31)=0 - MINT(51)=0 - MINT(57)=0 - CALL PYRAND - IF(MSTI(61).EQ.1) THEN - MINT(5)=MINT(5)-1 - RETURN - ENDIF - IF(MINT(51).EQ.2) RETURN - ISUB=MINT(1) - IF(MSTP(111).EQ.-1) GOTO 240 - - IF((ISUB.LE.90.OR.ISUB.GE.95).AND.ISUB.NE.99) THEN -C...Hard scattering (including low-pT): -C...reconstruct kinematics and colour flow of hard scattering. - MINT31=MINT(31) - 110 MINT(31)=MINT31 - MINT(51)=0 - CALL PYSCAT - IF(MINT(51).EQ.1) GOTO 100 - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IF(ISUB.EQ.95) GOTO 120 - -C...Showering of initial state partons (optional). - NFIN=N - ALAMSV=PARJ(81) - PARJ(81)=PARP(72) - IF(MSTP(61).GE.1.AND.MINT(47).GE.2) CALL PYSSPA(IPU1,IPU2) - PARJ(81)=ALAMSV - IF(MINT(51).EQ.1) GOTO 100 - -C...Showering of final state partons (optional). - ALAMSV=PARJ(81) - PARJ(81)=PARP(72) - IF(MSTP(71).GE.1.AND.ISET(ISUB).GE.2.AND.ISET(ISUB).LE.10) - & THEN - IPU3=MINT(84)+3 - IPU4=MINT(84)+4 - IF(ISET(ISUB).EQ.5) IPU4=-3 - QMAX=VINT(55) - IF(ISET(ISUB).EQ.2) QMAX=SQRT(PARP(71))*VINT(55) - CALL PYSHOW(IPU3,IPU4,QMAX) - ELSEIF(ISET(ISUB).EQ.11) THEN - CALL PYADSH(NFIN) - ENDIF - PARJ(81)=ALAMSV - -C...Decay of final state resonances. - MINT(32)=0 - IF(MSTP(41).GE.1.AND.ISET(ISUB).LE.10) CALL PYRESD(0) - IF(MINT(51).EQ.1) GOTO 100 - MINT(52)=N - -C...Multiple interactions. - IF(MSTP(81).GE.1.AND.MINT(50).EQ.1) CALL PYMULT(6) - MINT(53)=N - -C...Hadron remnants and primordial kT. - 120 CALL PYREMN(IPU1,IPU2) - IF(MINT(51).EQ.1.AND.MINT(57).GE.1.AND.MINT(57).LE.5) GOTO 110 - IF(MINT(51).EQ.1) GOTO 100 - - ELSEIF(ISUB.NE.99) THEN -C...Diffractive and elastic scattering. - CALL PYDIFF - - ELSE -C...DIS scattering (photon flux external). - CALL PYDISG - IF(MINT(51).EQ.1) GOTO 100 - ENDIF - -C...Check that no odd resonance left undecayed. - IF(MSTP(111).GE.1) THEN - NFIX=N - DO 130 I=MINT(84)+1,NFIX - IF(K(I,1).GE.1.AND.K(I,1).LE.10.AND.K(I,2).NE.21.AND. - & K(I,2).NE.22) THEN - KCA=PYCOMP(K(I,2)) - IF(MWID(KCA).NE.0.AND.MDCY(KCA,1).GE.1) THEN - CALL PYRESD(I) - IF(MINT(51).EQ.1) GOTO 100 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - -C...Boost hadronic subsystem to overall rest frame. -C..(Only relevant when photon inside lepton beam.) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(4,WTGAGA) - -C...Recalculate energies from momenta and masses (if desired). - IF(MSTP(113).GE.1) THEN - DO 140 I=MINT(83)+1,N - IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ - & P(I,2)**2+P(I,3)**2+P(I,5)**2) - 140 CONTINUE - NRECAL=N - ENDIF - -C...Rearrange partons along strings, check invariant mass cuts. - MSTU(28)=0 - IF(MSTP(111).LE.0) MSTJ(14)=-1 - CALL PYPREP(MINT(84)+1) - MSTJ(14)=MSTJ14 - IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 - IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN - DO 170 I=MINT(84)+1,N - IF(K(I,2).EQ.94) THEN - DO 160 I1=I+1,MIN(N,I+10) - IF(K(I1,3).EQ.I) THEN - K(I1,3)=MOD(K(I1,4)/MSTU(5),MSTU(5)) - IF(K(I1,3).EQ.0) THEN - DO 150 II=MINT(84)+1,I-1 - IF(K(II,2).EQ.K(I1,2)) THEN - IF(MOD(K(II,4),MSTU(5)).EQ.I1.OR. - & MOD(K(II,5),MSTU(5)).EQ.I1) K(I1,3)=II - ENDIF - 150 CONTINUE - IF(K(I+1,3).EQ.0) K(I+1,3)=K(I,3) - ENDIF - ENDIF - 160 CONTINUE - ENDIF - 170 CONTINUE - CALL PYEDIT(12) - CALL PYEDIT(14) - IF(MSTP(125).EQ.0) CALL PYEDIT(15) - IF(MSTP(125).EQ.0) MINT(4)=0 - DO 190 I=MINT(83)+1,N - IF(K(I,1).EQ.11.AND.K(I,4).EQ.0.AND.K(I,5).EQ.0) THEN - DO 180 I1=I+1,N - IF(K(I1,3).EQ.I.AND.K(I,4).EQ.0) K(I,4)=I1 - IF(K(I1,3).EQ.I) K(I,5)=I1 - 180 CONTINUE - ENDIF - 190 CONTINUE - ENDIF - -C...Introduce separators between sections in PYLIST event listing. - IF(IPILE.EQ.1.AND.MSTP(125).LE.0) THEN - MSTU70=1 - MSTU(71)=N - ELSEIF(IPILE.EQ.1) THEN - MSTU70=3 - MSTU(71)=2 - MSTU(72)=MINT(4) - MSTU(73)=N - ENDIF - -C...Go back to lab frame (needed for vertices, also in fragmentation). - CALL PYFRAM(1) - -C...Set nonvanishing production vertex (optional). - IF(MSTP(151).EQ.1) THEN - DO 200 J=1,4 - VTX(J)=PARP(150+J)*SQRT(-2D0*LOG(MAX(1D-10,PYR(0))))* - & SIN(PARU(2)*PYR(0)) - 200 CONTINUE - DO 220 I=MINT(83)+1,N - DO 210 J=1,4 - V(I,J)=V(I,J)+VTX(J) - 210 CONTINUE - 220 CONTINUE - ENDIF - -C...Perform hadronization (if desired). - IF(MSTP(111).GE.1) THEN - CALL PYEXEC - IF(MSTU(24).NE.0) GOTO 100 - ENDIF - IF(MSTP(113).GE.1) THEN - DO 230 I=NRECAL,N - IF(P(I,5).GT.0D0) P(I,4)=SQRT(P(I,1)**2+ - & P(I,2)**2+P(I,3)**2+P(I,5)**2) - 230 CONTINUE - ENDIF - IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL PYEDIT(14) - -C...Store event information and calculate Monte Carlo estimates of -C...subprocess cross-sections. - 240 IF(IPILE.EQ.1) CALL PYDOCU - -C...Set counters for current pileup event and loop to next one. - MSTI(41)=IPILE - IF(IPILE.GE.2.AND.IPILE.LE.10) MSTI(40+IPILE)=ISUB - IF(MSTU70.LT.10) THEN - MSTU70=MSTU70+1 - MSTU(70+MSTU70)=N - ENDIF - MINT(83)=N - MINT(84)=N+MSTP(126) - IF(IPILE.LT.NPILE) CALL PYFRAM(2) - 250 CONTINUE - -C...Generic information on pileup events. Reconstruct missing history. - IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN - PARI(91)=VINT(132) - PARI(92)=VINT(133) - PARI(93)=VINT(134) - IF(MSTP(133).GE.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) - ENDIF - CALL PYEDIT(16) - -C...Transform to the desired coordinate frame. - 260 CALL PYFRAM(MSTP(124)) - MSTU(70)=MSTU70 - PARU(21)=VINT(1) - -C...Error messages - 5100 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution stopped.') - - RETURN - END - -C********************************************************************* - -C...PYEVWT -C...Dummy routine, which the user can replace in order to multiply the -C...standard PYTHIA differential cross-section by a process- and -C...kinematics-dependent factor WTXS. For MSTP(142)=1 this corresponds -C...to generation of weighted events, with weight 1/WTXS, while for -C...MSTP(142)=2 it corresponds to a modification of the underlying -C...physics. - - SUBROUTINE PYEVWT(WTXS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYINT1/,/PYINT2/ - -C...Set default weight for WTXS. - WTXS=1D0 - -C...Read out subprocess number. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - -C...Read out tau, y*, cos(theta), tau' (where defined, else =0). - TAU=VINT(21) - YST=VINT(22) - CTH=0D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) - TAUP=0D0 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) - -C...Read out x_1, x_2, x_F, shat, that, uhat, p_T^2. - X1=VINT(41) - X2=VINT(42) - XF=X1-X2 - SHAT=VINT(44) - THAT=VINT(45) - UHAT=VINT(46) - PT2=VINT(48) - -C...Modifications by user to be put here. - -C...Stop program if this routine is ever called. -C...You should not copy these lines to your own routine. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYEVWT routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYEXEC -C...Administrates the fragmentation and decay chain. - - SUBROUTINE PYEXEC - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYINT4/ -C...Local array. - DIMENSION PS(2,6),IJOIN(100) - -C...Initialize and reset. - MSTU(24)=0 - IF(MSTU(12).GE.1) CALL PYLIST(0) - MSTU(29)=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)=0D0 - 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)+PYCHGE(K(I,2)) - 130 CONTINUE - PARU(21)=PS(1,4) - -C...Start by all decays of coloured resonances involved in shower. - NORIG=N - DO 140 I=1,NORIG - IF(K(I,1).EQ.3) THEN - KC=PYCOMP(K(I,2)) - IF(MWID(KC).NE.0.AND.KCHG(KC,2).NE.0) CALL PYRESD(I) - ENDIF - 140 CONTINUE - -C...Prepare system for subsequent fragmentation/decay. - CALL PYPREP(0) - -C...Loop through jet fragmentation and particle decays. - MBE=0 - 150 MBE=MBE+1 - IP=0 - 160 IP=IP+1 - KC=0 - IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=PYCOMP(K(IP,2)) - IF(KC.EQ.0) THEN - -C...Deal with any remaining undecayed resonance -C...(normally the task of PYEVNT, so seldom used). - ELSEIF(MWID(KC).NE.0) THEN - IBEG=IP - IF(KCHG(KC,2).NE.0.AND.K(I,1).NE.3) THEN - IBEG=IP+1 - 170 IBEG=IBEG-1 - IF(IBEG.GE.2.AND.K(IBEG,1).EQ.2) GOTO 170 - IF(K(IBEG,1).NE.2) IBEG=IBEG+1 - IEND=IP-1 - 180 IEND=IEND+1 - IF(IEND.LT.N.AND.K(IEND,1).EQ.2) GOTO 180 - IF(IEND.LT.N.AND.KCHG(PYCOMP(K(IEND,2)),2).EQ.0) GOTO 180 - NJOIN=0 - DO 190 I=IBEG,IEND - IF(KCHG(PYCOMP(K(IEND,2)),2).NE.0) THEN - NJOIN=NJOIN+1 - IJOIN(NJOIN)=I - ENDIF - 190 CONTINUE - ENDIF - CALL PYRESD(IP) - CALL PYPREP(IBEG) - -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 PYDECY(IP) - -C...Decay products may develop a shower. - IF(MSTJ(92).GT.0) THEN - IP1=MSTJ(92) - QMAX=SQRT(MAX(0D0,(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 PYSHOW(IP1,IP1+1,QMAX) - CALL PYPREP(IP1) - MSTJ(92)=0 - ELSEIF(MSTJ(92).LT.0) THEN - IP1=-MSTJ(92) - CALL PYSHOW(IP1,-3,P(IP,5)) - CALL PYPREP(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(PYCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) - ENDIF - ENDIF - IF(MFRAG.EQ.1) CALL PYSTRF(IP) - IF(MFRAG.EQ.2) CALL PYINDF(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 PYJETS 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 160 - ELSEIF(IP.LT.N) THEN - CALL PYERRM(11,'(PYEXEC:) no more memory left in PYJETS') - ENDIF - -C...Include simple Bose-Einstein effect parametrization if desired. - IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN - CALL PYBOEI(NSAV) - GOTO 150 - ENDIF - -C...Check that momentum, energy and charge were conserved. - DO 210 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 210 - DO 200 J=1,4 - PS(2,J)=PS(2,J)+P(I,J) - 200 CONTINUE - PS(2,6)=PS(2,6)+PYCHGE(K(I,2)) - 210 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)))/(1D0+ABS(PS(2,4))+ABS(PS(1,4))) - IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL PYERRM(15, - &'(PYEXEC:) four-momentum was not conserved') - IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1D0) CALL PYERRM(15, - &'(PYEXEC:) charge was not conserved') - - RETURN - END - -C********************************************************************* - -C...PYFACT -C...Multiplies histogram contents by factor. - - SUBROUTINE PYFACT(ID,F) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Find initial address in memory. Multiply all contents bins. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFACT:) not allowed histogram number') - IS=INDX(ID) - IF(IS.EQ.0) CALL PYERRM(28, - &'(PYFACT:) scaling unbooked histogram') - DO 100 IX=IS+6,IS+8+NINT(BIN(IS+1)) - BIN(IX)=F*BIN(IX) - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYFILL -C...Fills entry in histogram. - - SUBROUTINE PYFILL(ID,X,W) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Find initial address in memory. Increase number of entries. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFILL:) not allowed histogram number') - IS=INDX(ID) - IF(IS.EQ.0) CALL PYERRM(28, - &'(PYFILL:) filling unbooked histogram') - BIN(IS+5)=BIN(IS+5)+1D0 - -C...Find bin in x, including under/overflow, and fill. - IF(X.LT.BIN(IS+2)) THEN - BIN(IS+6)=BIN(IS+6)+W - ELSEIF(X.GE.BIN(IS+3)) THEN - BIN(IS+8)=BIN(IS+8)+W - ELSE - BIN(IS+7)=BIN(IS+7)+W - IX=(X-BIN(IS+2))/BIN(IS+4) - IX=MAX(0,MIN(NINT(BIN(IS+1))-1,IX)) - BIN(IS+9+IX)=BIN(IS+9+IX)+W - ENDIF - - RETURN - END - - - - - -C********************************************************************* - -C...PYFINT -C...Auxiliary routine to PYPOLE for SUSY Higgs calculations. - - FUNCTION PYFINT(A,B,C) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYINTS/XXM(20) - SAVE/PYINTS/ - -C...Local variables. - EXTERNAL PYFISB - DOUBLE PRECISION PYFISB - - XXM(1)=A - XXM(2)=B - XXM(3)=C - XLO=0D0 - XHI=1D0 - PYFINT = PYGAUS(PYFISB,XLO,XHI,1D-3) - - RETURN - END - -C********************************************************************* - -C...PYFISB -C...Auxiliary routine to PYFINT for SUSY Higgs calculations. - - FUNCTION PYFISB(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYINTS/XXM(20) - SAVE/PYINTS/ - - PYFISB = LOG(ABS(X*XXM(2)+(1-X)*XXM(3)-X*(1-X)*XXM(1))/ - &(X*(XXM(2)-XXM(3))+XXM(3))) - - RETURN - END - -C********************************************************************* - -C...PYFOWO -C...Calculates the first few Fox-Wolfram moments. - - SUBROUTINE PYFOWO(H10,H20,H30,H40) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Copy momenta for particles and calculate H0. - NP=0 - H0=0D0 - HD=0D0 - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 110 - ENDIF - IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYFOWO:) no more memory left in PYJETS') - H10=-1D0 - H20=-1D0 - H30=-1D0 - H40=-1D0 - 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 PYERRM(8,'(PYFOWO:) too few particles for analysis') - H10=-1D0 - H20=-1D0 - H30=-1D0 - H40=-1D0 - RETURN - ENDIF - -C...Calculate H1 - H4. - H10=0D0 - H20=0D0 - H30=0D0 - H40=0D0 - 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.5D0*CTHE**2-0.5D0) - H30=H30+P(I1,4)*P(I2,4)*(2.5D0*CTHE**3-1.5D0*CTHE) - H40=H40+P(I1,4)*P(I2,4)*(4.375D0*CTHE**4-3.75D0*CTHE**2+ - & 0.375D0) - 120 CONTINUE - 130 CONTINUE - -C...Calculate H1/H0 - H4/H0. Output. - MSTU(61)=N+1 - MSTU(62)=NP - H10=(HD+2D0*H10)/H0 - H20=(HD+2D0*H20)/H0 - H30=(HD+2D0*H30)/H0 - H40=(HD+2D0*H40)/H0 - - RETURN - END - -C********************************************************************* - -C...PYFRAM -C...Performs transformations between different coordinate frames. - - SUBROUTINE PYFRAM(IFRAME) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ - -C...Check that transformation can and should be done. - IF(IFRAME.EQ.1.OR.IFRAME.EQ.2.OR.(IFRAME.EQ.3.AND. - &MINT(91).EQ.1)) THEN - IF(IFRAME.EQ.MINT(6)) RETURN - ELSE - WRITE(MSTU(11),5000) IFRAME,MINT(6) - RETURN - ENDIF - - IF(MINT(6).EQ.1) THEN -C...Transform from fixed target or user specified frame to -C...overall CM frame. - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - ELSEIF(MINT(6).EQ.3) THEN -C...Transform from hadronic CM frame in DIS to overall CM frame. - CALL PYROBO(0,0,-VINT(221),-VINT(222),-VINT(223),-VINT(224), - & -VINT(225)) - ENDIF - - IF(IFRAME.EQ.1) THEN -C...Transform from overall CM frame to fixed target or user specified -C...frame. - CALL PYROBO(0,0,VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) - ELSEIF(IFRAME.EQ.3) THEN -C...Transform from overall CM frame to hadronic CM frame in DIS. - CALL PYROBO(0,0,0D0,0D0,VINT(223),VINT(224),VINT(225)) - CALL PYROBO(0,0,0D0,VINT(222),0D0,0D0,0D0) - CALL PYROBO(0,0,VINT(221),0D0,0D0,0D0,0D0) - ENDIF - -C...Set information about new frame. - MINT(6)=IFRAME - MSTI(6)=IFRAME - - 5000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X, - &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', - &1X,I5) - - RETURN - END -C********************************************************************* - -C...PYGAGA -C...For lepton beams it gives photon-hadron or photon-photon systems -C...to be treated with the ordinary machinery and combines this with a -C...description of the lepton -> lepton + photon branching. - - SUBROUTINE PYGAGA(IGAGA,WTGAGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - DOUBLE PRECISION minq2 - DOUBLE PRECISION rccorr,sigobs,sigtrue - DOUBLE PRECISION pyth_xsec - include "mcRadCor.inc" - include "mc_set.inc" - include "radgen.inc" - include "phiout.inc" - - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT5/ -C...Local variables and data statement. - DIMENSION PMS(2),XMIN(2),XMAX(2),Q2MIN(2),Q2MAX(2),PMC(3), - &X(2),Q2(2),Y(2),THETA(2),PHI(2),PT(2),BETA(3) - SAVE PMS,XMIN,XMAX,Q2MIN,Q2MAX,PMC,X,Q2,THETA,PHI,PT,W2MIN, - & YMIN,YMAX - DATA EPS/1D-4/ - -C...Initialize generation of photons inside leptons. - IF(IGAGA.EQ.1) THEN - -C...Save quantities on incoming lepton system. - VINT(301)=VINT(1) - VINT(302)=VINT(2) - PMS(1)=VINT(303)**2 - IF(MINT(141).EQ.0) PMS(1)=SIGN(VINT(3)**2,VINT(3)) - PMS(2)=VINT(304)**2 - IF(MINT(142).EQ.0) PMS(2)=SIGN(VINT(4)**2,VINT(4)) - PMC(3)=VINT(302)-PMS(1)-PMS(2) - W2MIN=MAX(CKIN(77),2D0*CKIN(3),2D0*CKIN(5))**2 - -C...Calculate range of x and Q2 values allowed in generation. - DO 100 I=1,2 - PMC(I)=VINT(302)+PMS(I)-PMS(3-I) - IF(MINT(140+I).NE.0) THEN - XMIN(I)=MAX(CKIN(59+2*I),EPS) - XMAX(I)=MIN(CKIN(60+2*I),1D0-2D0*VINT(301)*SQRT(PMS(I))/ - & PMC(I),1D0-EPS) - YMIN=MAX(CKIN(71+2*I),EPS) - YMAX=MIN(CKIN(72+2*I),1D0-EPS) - IF(CKIN(64+2*I).GT.0D0) XMIN(I)=MAX(XMIN(I), - & (YMIN*PMC(3)-CKIN(64+2*I))/PMC(I)) - XMAX(I)=MIN(XMAX(I),(YMAX*PMC(3)-CKIN(63+2*I))/PMC(I)) - THEMIN=MAX(CKIN(67+2*I),0D0) - THEMAX=MIN(CKIN(68+2*I),PARU(1)) - IF(CKIN(68+2*I).LT.0D0) THEMAX=PARU(1) - Q2MIN(I)=MAX(CKIN(63+2*I),XMIN(I)**2*PMS(I)/(1D0-XMIN(I))+ - & ((1D0-XMAX(I))*(VINT(302)-2D0*PMS(3-I))- - & 2D0*PMS(I)/(1D0-XMAX(I)))*SIN(THEMIN/2D0)**2,0D0) - Q2MAX(I)=XMAX(I)**2*PMS(I)/(1D0-XMAX(I))+ - & ((1D0-XMIN(I))*(VINT(302)-2D0*PMS(3-I))- - & 2D0*PMS(I)/(1D0-XMIN(I)))*SIN(THEMAX/2D0)**2 - IF(CKIN(64+2*I).GT.0D0) Q2MAX(I)=MIN(CKIN(64+2*I),Q2MAX(I)) -C...W limits when lepton on one side only. - IF(MINT(143-I).EQ.0) THEN - XMIN(I)=MAX(XMIN(I),(W2MIN-PMS(3-I))/PMC(I)) - IF(CKIN(78).GT.0D0) XMAX(I)=MIN(XMAX(I), - & (CKIN(78)**2-PMS(3-I))/PMC(I)) - ENDIF - ENDIF - 100 CONTINUE - -C...W limits when lepton on both sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - IF(CKIN(78).GT.0D0) XMAX(1)=MIN(XMAX(1), - & (CKIN(78)**2+PMC(3)-PMC(2)*XMIN(2))/PMC(1)) - IF(CKIN(78).GT.0D0) XMAX(2)=MIN(XMAX(2), - & (CKIN(78)**2+PMC(3)-PMC(1)*XMIN(1))/PMC(2)) - IF(IABS(MINT(141)).NE.IABS(MINT(142))) THEN - XMIN(1)=MAX(XMIN(1),(PMS(1)-PMS(2)+VINT(302)*(W2MIN- - & PMS(1)-PMS(2))/(PMC(2)*XMAX(2)+PMS(1)-PMS(2)))/PMC(1)) - XMIN(2)=MAX(XMIN(2),(PMS(2)-PMS(1)+VINT(302)*(W2MIN- - & PMS(1)-PMS(2))/(PMC(1)*XMAX(1)+PMS(2)-PMS(1)))/PMC(2)) - ELSE - XMIN(1)=MAX(XMIN(1),W2MIN/(VINT(302)*XMAX(2))) - XMIN(2)=MAX(XMIN(2),W2MIN/(VINT(302)*XMAX(1))) - ENDIF - ENDIF - -C...Q2 and W values and photon flux weight factors for initialization. - ELSEIF(IGAGA.EQ.2) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...W value for photon on one or both sides, and for processes -C...with gamma-gamma cross section peaked at small shat. - IF(MINT(141).NE.0.AND.MINT(142).EQ.0) THEN - VINT(2)=VINT(302)+PMS(1)-PMC(1)*(1D0-XMAX(1)) - ELSEIF(MINT(141).EQ.0.AND.MINT(142).NE.0) THEN - VINT(2)=VINT(302)+PMS(2)-PMC(2)*(1D0-XMAX(2)) - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN - VINT(2)=MAX(CKIN(77)**2,12D0*MAX(CKIN(3),CKIN(5))**2) - IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) - ELSE - VINT(2)=XMAX(1)*XMAX(2)*VINT(302) - IF(CKIN(78).GT.0D0) VINT(2)=MIN(VINT(2),CKIN(78)**2) - ENDIF - VINT(1)=SQRT(MAX(0D0,VINT(2))) - -C...Upper estimate of photon flux weight factor. -C...Initialization Q2 scale. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 110 I=1,2 - IF(MINT(140+I).NE.0) THEN - IF(MSTP(199).EQ.1) then - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & (LOG(mcSet_YMax/mcSet_YMin))*(LOG(mcSet_Q2Max/mcSet_Q2Min)) - ELSE - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) - ENDIF - IF(ISUB.EQ.99.AND.MINT(106+I).EQ.4.AND.MINT(109-I).EQ.3) - & THEN - Q2INIT=5D0+Q2MIN(3-I) - ELSEIF(ISUB.EQ.99.AND.MINT(106+I).EQ.4) THEN - Q2INIT=PMAS(PYCOMP(113),1)**2+Q2MIN(3-I) - ELSEIF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - Q2INIT=MAX(CKIN(1),2D0*CKIN(3),2D0*CKIN(5))**2/3D0 - ELSEIF((ISUB.EQ.138.AND.I.EQ.2).OR. - & (ISUB.EQ.139.AND.I.EQ.1)) THEN - Q2INIT=VINT(2)/3D0 - ELSEIF(ISUB.EQ.140) THEN - Q2INIT=VINT(2)/2D0 - ELSE - Q2INIT=Q2MIN(I) - ENDIF - VINT(2+I)=-SQRT(MAX(Q2MIN(I),MIN(Q2MAX(I),Q2INIT))) - IF(MSTP(14).EQ.0.OR.(ISUB.GE.131.AND.ISUB.LE.140)) - & MINT(14+I)=22 - VINT(306+I)=VINT(2+I)**2 - ENDIF - 110 CONTINUE - VINT(320)=WTGAGA - -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - VINT(318)=VINT(317) - -C...Generate photons inside leptons and -C...calculate photon flux weight factors. - ELSEIF(IGAGA.EQ.3) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...Generate phase space point and check against cuts. - LOOP=0 - 120 LOOP=LOOP+1 - DO 130 I=1,2 - IF(MINT(140+I).NE.0) THEN -C...Pick x and Q2 - X(I)=XMIN(I)*(XMAX(I)/XMIN(I))**PYR(0) - Q2(I)=Q2MIN(I)*(Q2MAX(I)/Q2MIN(I))**PYR(0) -C...Cuts on internal consistency in x and Q2. - IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) GOTO 120 - IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- - & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) GOTO 120 -C...Cuts on y and theta. - Y(I)=(PMC(I)*X(I)+Q2(I))/PMC(3) - IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) GOTO 120 - RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ - & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) - THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) - IF(THETA(I).LT.CKIN(67+2*I)) GOTO 120 - IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) - & GOTO 120 - -C...Phi angle isotropic. Reconstruct pT. - PHI(I)=PARU(2)*PYR(0) - PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- - & PMS(I))*SIN(THETA(I)) - -C...Store info on variables selected, for documentation purposes. - VINT(2+I)=-SQRT(Q2(I)) - VINT(304+I)=X(I) - VINT(306+I)=Q2(I) - VINT(308+I)=Y(I) - VINT(310+I)=THETA(I) - VINT(312+I)=PHI(I) - ELSE - VINT(304+I)=1D0 - VINT(306+I)=0D0 - VINT(308+I)=1D0 - VINT(310+I)=0D0 - VINT(312+I)=0D0 - ENDIF - 130 CONTINUE - -C...Cut on W combines info from two sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- - & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* - & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* - & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) - IF(W2.LT.W2MIN) GOTO 120 - IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 120 - PMS1=-Q2(1) - PMS2=-Q2(2) - ELSEIF(MINT(141).NE.0) THEN - W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) - PMS1=-Q2(1) - PMS2=PMS(2) - ELSEIF(MINT(142).NE.0) THEN - W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) - PMS1=PMS(1) - PMS2=-Q2(2) - ENDIF - -C...Store kinematics info for photon(s) in subsystem cm frame. - VINT(2)=W2 - VINT(1)=SQRT(W2) - VINT(291)=0D0 - VINT(292)=0D0 - VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) - VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) - VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) - VINT(296)=0D0 - VINT(297)=0D0 - VINT(298)=-VINT(293) - VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) - VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) - -C...Assign weight for photon flux; different for transverse and -C...longitudinal photons. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 140 I=1,2 - IF(MINT(140+I).NE.0) THEN - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & LOG(XMAX(I)/XMIN(I))*LOG(Q2MAX(I)/Q2MIN(I)) - IF(MSTP(16).EQ.0) THEN - XY=X(I) - ELSE - WTGAGA=WTGAGA*X(I)/Y(I) - XY=Y(I) - ENDIF - WTGAGA1=WTGAGA - IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - pmass=PYMASS(2212) - WTGAGA=WTGAGA*(1D0/(1D0+(Q2(I)/XY**2/ - & VINT(290)**2))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2)))/ - & Q2(I)/XY**2/VINT(290)* - & (VINT(290)*XY-Q2(I)/2D0/pmass)*XY*Q2(I) - ELSE - WTGAGA=WTGAGA*(1D0-XY) - ENDIF - ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - emass=PYMASS(11) - pmass=PYMASS(2212) - tmp=0.5D0*((VINT(290)*XY-Q2(I)/2D0/ - & pmass)/Q2(I)/XY**2/VINT(290)* - & (XY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XY**2/VINT(290)**2)))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2))))* - & XY*Q2(I) - WTGAGA=WTGAGA*(0.5D0*((VINT(290)*XY-Q2(I)/2D0/ - & pmass)/Q2(I)/XY**2/VINT(290)* - & (XY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XY**2/VINT(290)**2)))* - & (1D0-XY-(Q2(I)/4D0/VINT(290)**2))))* - & XY*Q2(I)) - WTGAGA1=WTGAGA1*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ELSE - WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ENDIF - IF(MINT(106+I).EQ.0) MINT(14+I)=22 - ENDIF - 140 CONTINUE - VINT(319)=WTGAGA - MINT(143)=LOOP - -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - -C...Generate photons inside leptons and -C...calculate photon flux weight factors. - ELSEIF(IGAGA.EQ.5) THEN - ISUB=MINT(1) - MINT(15)=0 - MINT(16)=0 - -C...Generate phase space point and check against cuts. - LOOP=0 - 121 LOOP=LOOP+1 - DO 131 I=1,2 - IF(MINT(140+I).NE.0) THEN -C...Pick x and Q2 - MINT(199)=0 - geny=mcSet_YMin*(mcSet_YMax/mcSet_YMin)**PYR(0) - genQ2=mcSet_Q2Min*(mcSet_Q2Max/mcSet_Q2Min)**PYR(0) - gennu=geny*VINT(290) - genx = genQ2 / (2D0*gennu*PYMASS(2212)) - genW2 = PYMASS(2212)**2D0+(2D0*PYMASS(2212)*gennu)-genQ2 -C....Check to have sensible ranges for variables - geneprim = VINT(290) - gennu - genpprim = sngl(sqrt(dble(geneprim)**2-pymass(11)**2)) - minq2 = PMS(1) * geny**2 / (1.- geny) - if (genQ2.lt.minq2) then - GOTO 121 - endif - if (genQ2.gt.(2D0*gennu*PYMASS(2212))) then - GOTO 121 - endif - temp = (genQ2-minq2)/(4.*VINT(290)*geneprim) - if (temp.lt.0.or.temp.gt.1.) then - GOTO 121 - endif - if ((genW2.lt.CKIN(77)**2).or. - & (CKIN(78).gt.0.and.genW2.gt.CKIN(78)**2)) then - GOTO 121 - endif - genthe = 2.*asin(sqrt(temp)) - genphi=PARU(2)*PYR(0) - PHI(I)=dble(genphi) - - ppt=tan(dble(genthe)) - ppx=ppt*cos(PHI(I)) - ppy=ppt*sin(PHI(I)) - - ntries=0 - 122 if (qedrad.eq.1) then - call radgen_event - endif - if (qedrad.eq.0) then - Y(I)=dble(geny) - Q2(I)=dble(genq2) - elseif ((mcRadCor_EBrems.eq.mcRadCor_EBrems).and. - & (mcRadCor_ThetaBrems.eq.mcRadCor_ThetaBrems)) then - Y(I)=dble(mcRadCor_NuTrue)/VINT(290) - Q2(I)=dble(mcRadCor_Q2True) - else - write(*,*)"I go to 122 again" - write(*,*) mcRadCor_ThetaBrems,mcRadCor_EBrems,mcEvent_iEvent - GOTO 122 - endif - X(I)=((PMC(3)*Y(I))-Q2(I))/PMC(I) -C P.L. ...An event with W^2_T<4will be generated new by RADGEN at the -C ...same kinematic point, the number of tries needed by RADGEN is -C ...counted and saved in the variable rcweight! - IF (qedrad.ne.0) then - IF((mcradcor_cType.eq.'qela').or.(mcradcor_cType.eq.'elas')) then - GOTO 122 - ENDIF - IF(dble(mcRadCor_W2True).LT. - & (CKIN(77)**2-1.D-4*abs(CKIN(77)**2))) THEN - MINT(199)=MINT(199)+1 -C write(*,*) "W2true: ",mcRadCor_W2True,MINT(199) - GOTO 122 - ENDIF - ENDIF - ntries=ntries+1 - IF(ntries.ge.20) GOTO 121 - -C ...... New try to implement weights directly into Pythia - sigobs=0.0D0 - sigtrue=0.0D0 - rccorr=1.0D0 - if (qedrad.eq.1) then - call MKF2(dble(genq2),dble(genx), - + mcSet_TarA,mcSet_TarZ,py6f2,py6f1) - sigobs=pyth_xsec(dble(genx), dble(genq2),py6f1, py6f2) - IF(mcRadCor_EBrems.eq.0) THEN - IF (sig1g.gt.0.D0) then - rccorr=(tbor+tine)/sig1g/(DBLE(MINT(199))+1.0D0) - ELSE - rccorr=0.D0 - ENDIF - ELSEIF(mcRadCor_EBrems.gt.0) THEN - call MKF2(Q2(I),dble(mcRadCor_XTrue), - + mcSet_TarA,mcSet_TarZ,py6f2,py6f1) - sigtrue=pyth_xsec(dble(mcRadCor_XTrue),Q2(I),py6f1, py6f2) - IF ((sig1g.gt.0.D0).and.(sigtrue.gt.0.D0)) then - rccorr=(tbor+tine)/sig1g*sigobs/sigtrue/(DBLE(MINT(199))+1.0D0) - ELSE - rccorr=0.D0 - ENDIF - ENDIF - ENDIF - IF(X(I).GT.(XMAX(I)+1.D-4*abs(XMAX(I)))) THEN - GOTO 121 - ENDIF -C...Cuts on internal consistency in x and Q2. - IF(Q2(I).LT.X(I)**2*PMS(I)/(1D0-X(I))) then - GOTO 121 - endif - IF(Q2(I).GT.(1D0-X(I))*(VINT(302)-2D0*PMS(3-I))- - & (2D0-X(I)**2)*PMS(I)/(1D0-X(I))) THEN - GOTO 121 - ENDIF -C...Cuts on y and theta. - IF(Y(I).LT.CKIN(71+2*I).OR.Y(I).GT.CKIN(72+2*I)) THEN - GOTO 121 - ENDIF - RAT=((1D0-X(I))*Q2(I)-X(I)**2*PMS(I))/ - & ((1D0-X(I))**2*(VINT(302)-2D0*PMS(3-I)-2D0*PMS(I))) - THETA(I)=2D0*ASIN(SQRT(MAX(0D0,MIN(1D0,RAT)))) - IF(THETA(I).LT.CKIN(67+2*I)) THEN - GOTO 121 - ENDIF - IF(CKIN(68+2*I).GT.0D0.AND.THETA(I).GT.CKIN(68+2*I)) - & GOTO 121 - -C...Phi angle isotropic. Reconstruct pT. - PT(I)=SQRT(((1D0-X(I))*PMC(I))**2/(4D0*VINT(302))- - & PMS(I))*SIN(THETA(I)) -C ... try 'new' phi - IF ((qedrad.ne.0).and.(mcRadCor_EBrems.gt.0)) then - emom=sqrt(dble(geneprim)**2-pymass(11)**2) - PHI(I)=atan2((emom*ppy+dplabg(2)),(emom*ppx+dplabg(1))) - IF (PHI(I).lt.0) THEN - PHI(I)=PHI(I)+PARU(2) - ENDIF - ENDIF -C...Store info on variables selected, for documentation purposes. - VINT(2+I)=-SQRT(Q2(I)) - VINT(304+I)=X(I) - VINT(306+I)=Q2(I) - VINT(308+I)=Y(I) - VINT(310+I)=THETA(I) - VINT(312+I)=PHI(I) - ELSE - VINT(304+I)=1D0 - VINT(306+I)=0D0 - VINT(308+I)=1D0 - VINT(310+I)=0D0 - VINT(312+I)=0D0 - ENDIF - 131 CONTINUE - -C...Cut on W combines info from two sides. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - W2=-Q2(1)-Q2(2)+0.5D0*X(1)*PMC(1)*X(2)*PMC(2)/VINT(302)- - & 2D0*PT(1)*PT(2)*COS(PHI(1)-PHI(2))+2D0* - & SQRT((0.5D0*X(1)*PMC(1)/VINT(301))**2+Q2(1)-PT(1)**2)* - & SQRT((0.5D0*X(2)*PMC(2)/VINT(301))**2+Q2(2)-PT(2)**2) - IF(W2.LT.W2MIN) THEN - GOTO 121 - ENDIF - IF(CKIN(78).GT.0D0.AND.W2.GT.CKIN(78)**2) GOTO 121 - PMS1=-Q2(1) - PMS2=-Q2(2) - ELSEIF(MINT(141).NE.0) THEN - W2=(VINT(302)+PMS(1))*X(1)+PMS(2)*(1D0-X(1)) - PMS1=-Q2(1) - PMS2=PMS(2) - ELSEIF(MINT(142).NE.0) THEN - W2=(VINT(302)+PMS(2))*X(2)+PMS(1)*(1D0-X(2)) - PMS1=PMS(1) - PMS2=-Q2(2) - ENDIF - -C...Store kinematics info for photon(s) in subsystem cm frame. - VINT(2)=W2 - VINT(1)=SQRT(W2) - VINT(291)=0D0 - VINT(292)=0D0 - VINT(293)=0.5D0*SQRT((W2-PMS1-PMS2)**2-4D0*PMS1*PMS2)/VINT(1) - VINT(294)=0.5D0*(W2+PMS1-PMS2)/VINT(1) - VINT(295)=SIGN(SQRT(ABS(PMS1)),PMS1) - VINT(296)=0D0 - VINT(297)=0D0 - VINT(298)=-VINT(293) - VINT(299)=0.5D0*(W2+PMS2-PMS1)/VINT(1) - VINT(300)=SIGN(SQRT(ABS(PMS2)),PMS2) - -C...Assign weight for photon flux; different for transverse and -C...longitudinal photons. Flag incoming unresolved photon. - WTGAGA=1D0 - DO 141 I=1,2 - IF(MINT(140+I).NE.0) THEN - WTGAGA=WTGAGA*2D0*(PARU(101)/PARU(2))* - & (LOG(mcSet_YMax)-LOG(mcSet_YMin))* - & (LOG(mcSet_Q2Max)-LOG(mcSet_Q2Min)) - XY=Y(I) - IF(ISUB.EQ.132.OR.ISUB.EQ.134.OR.ISUB.EQ.136) THEN - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - pmass=PYMASS(2212) - beam=VINT(290) - XXY=XY*VINT(290)/beam - WTGAGA=WTGAGA*(1D0/(1D0+(Q2(I)/XXY**2/beam**2))* - & (1D0-XXY-(Q2(I)/4D0/beam**2)))/ - & Q2(I)/XXY**2/beam* - & (beam*XXY-Q2(I)/2D0/pmass)*XXY*Q2(I) - ELSE - WTGAGA=WTGAGA*(1D0-XY) - ENDIF - ELSEIF(I.EQ.1.AND.(ISUB.EQ.139.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF(I.EQ.2.AND.(ISUB.EQ.138.OR.ISUB.EQ.140)) THEN - WTGAGA=WTGAGA*(1D0-XY) - ELSEIF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - emass=PYMASS(11) - pmass=PYMASS(2212) - beam=VINT(290) - XXY=XY*VINT(290)/beam - WTGAGA=WTGAGA*(0.5D0*((beam*XXY-Q2(I)/2D0/ - & pmass)/Q2(I)/XXY**2/beam* - & (XXY**2*(1D0-(2D0*emass**2/Q2(I)))+ - & (2D0/(1D0+(Q2(I)/XXY**2/beam**2)))* - & (1D0-XXY-(Q2(I)/4D0/beam**2))))*XXY*Q2(I)) - ELSE - WTGAGA=WTGAGA*(0.5D0*(1D0+(1D0-XY)**2)- - & PMS(I)*XY**2/Q2(I)) - ENDIF - IF(MINT(106+I).EQ.0) MINT(14+I)=22 - ENDIF - 141 CONTINUE - WTGAGA=WTGAGA*rccorr - VINT(319)=WTGAGA - MINT(143)=LOOP -C...Update pTmin and cross section information. - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/VINT(2) - VINT(154)=PTMN - CALL PYXTOT - -C...Reconstruct kinematics of photons inside leptons. - ELSEIF(IGAGA.EQ.4) THEN - -C...Make place for incoming particles and scattered leptons. - MOVE=3 - IF(MINT(141).NE.0.AND.MINT(142).NE.0) MOVE=4 - MINT(4)=MINT(4)+MOVE - DO 160 I=MINT(84)-MOVE,MINT(83)+1,-1 - IF(K(I,1).EQ.21) THEN - DO 150 J=1,5 - K(I+MOVE,J)=K(I,J) - P(I+MOVE,J)=P(I,J) - V(I+MOVE,J)=V(I,J) - 150 CONTINUE - IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) - & K(I+MOVE,3)=K(I,3)+MOVE - IF(K(I,4).GT.MINT(83).AND.K(I,4).LE.MINT(84)) - & K(I+MOVE,4)=K(I,4)+MOVE - IF(K(I,5).GT.MINT(83).AND.K(I,5).LE.MINT(84)) - & K(I+MOVE,5)=K(I,5)+MOVE - ENDIF - 160 CONTINUE - DO 170 I=MINT(84)+1,N - IF(K(I,3).GT.MINT(83).AND.K(I,3).LE.MINT(84)) - & K(I,3)=K(I,3)+MOVE - 170 CONTINUE - -C...Fill in incoming particles. - DO 190 I=MINT(83)+1,MINT(83)+MOVE - DO 180 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 180 CONTINUE - 190 CONTINUE - DO 200 I=1,2 - K(MINT(83)+I,1)=21 - IF(MINT(140+I).NE.0) THEN - K(MINT(83)+I,2)=MINT(140+I) - P(MINT(83)+I,5)=VINT(302+I) - ELSE - K(MINT(83)+I,2)=MINT(10+I) - P(MINT(83)+I,5)=VINT(2+I) - ENDIF - P(MINT(83)+I,3)=0.5D0*SQRT((PMC(3)**2-4D0*PMS(1)*PMS(2))/ - & VINT(302))*(-1D0)**(I+1) - P(MINT(83)+I,4)=0.5D0*PMC(I)/VINT(301) - 200 CONTINUE - -C...New mother-daughter relations in documentation section. - IF(MINT(141).NE.0.AND.MINT(142).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+3 - K(MINT(83)+1,5)=MINT(83)+5 - K(MINT(83)+2,4)=MINT(83)+4 - K(MINT(83)+2,5)=MINT(83)+6 - K(MINT(83)+3,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+1 - K(MINT(83)+4,3)=MINT(83)+2 - K(MINT(83)+6,3)=MINT(83)+2 - ELSEIF(MINT(141).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+3 - K(MINT(83)+1,5)=MINT(83)+4 - K(MINT(83)+2,4)=MINT(83)+5 - K(MINT(83)+3,3)=MINT(83)+1 - K(MINT(83)+4,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+2 - ELSEIF(MINT(142).NE.0) THEN - K(MINT(83)+1,4)=MINT(83)+4 - K(MINT(83)+2,4)=MINT(83)+3 - K(MINT(83)+2,5)=MINT(83)+5 - K(MINT(83)+3,3)=MINT(83)+2 - K(MINT(83)+4,3)=MINT(83)+1 - K(MINT(83)+5,3)=MINT(83)+2 - ENDIF - -C...Fill scattered lepton(s). - DO 210 I=1,2 - IF(MINT(140+I).NE.0) THEN - LSC=MINT(83)+MIN(I+2,MOVE) - K(LSC,1)=21 - K(LSC,2)=MINT(140+I) - P(LSC,1)=PT(I)*COS(PHI(I)) - P(LSC,2)=PT(I)*SIN(PHI(I)) - P(LSC,4)=(1D0-X(I))*P(MINT(83)+I,4) - P(LSC,3)=SQRT(P(LSC,4)**2-PMS(I))*COS(THETA(I))* - & (-1D0)**(I-1) - P(LSC,5)=VINT(302+I) - ENDIF - 210 CONTINUE - -C...Find incoming four-vectors to subprocess. - K(N+1,1)=21 - IF(MINT(141).NE.0) THEN - DO 220 J=1,4 - P(N+1,J)=P(MINT(83)+1,J)-P(MINT(83)+3,J) - 220 CONTINUE - ELSE - DO 230 J=1,4 - P(N+1,J)=P(MINT(83)+1,J) - 230 CONTINUE - ENDIF - K(N+2,1)=21 - IF(MINT(142).NE.0) THEN - DO 240 J=1,4 - P(N+2,J)=P(MINT(83)+2,J)-P(MINT(83)+MOVE,J) - 240 CONTINUE - ELSE - DO 250 J=1,4 - P(N+2,J)=P(MINT(83)+2,J) - 250 CONTINUE - ENDIF - -C...Define boost and rotation between hadronic subsystem and -C...collision rest frame; boost hadronic subsystem to this frame. - DO 260 J=1,3 - BETA(J)=(P(N+1,J)+P(N+2,J))/(P(N+1,4)+P(N+2,4)) - 260 CONTINUE - CALL PYROBO(N+1,N+2,0D0,0D0,-BETA(1),-BETA(2),-BETA(3)) - BPHI=PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+2,0D0,-BPHI,0D0,0D0,0D0) - BTHETA=PYANGL(P(N+1,3),P(N+1,1)) - CALL PYROBO(MINT(83)+MOVE+1,N,BTHETA,BPHI,BETA(1),BETA(2), - & BETA(3)) - -C...Add on scattered leptons to final state. - DO 280 I=1,2 - IF(MINT(140+I).NE.0) THEN - LSC=MINT(83)+MIN(I+2,MOVE) - N=N+1 - DO 270 J=1,5 - K(N,J)=K(LSC,J) - P(N,J)=P(LSC,J) - V(N,J)=V(LSC,J) - 270 CONTINUE - K(N,1)=1 - K(N,3)=LSC - ENDIF - 280 CONTINUE - ENDIF - - 290 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYGAMM -C...Gives ordinary Gamma function Gamma(x) for positive, real arguments; -C...see M. Abramowitz, I. A. Stegun: Handbook of Mathematical Functions -C...(Dover, 1965) 6.1.36. - - FUNCTION PYGAMM(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local array and data. - DIMENSION B(8) - DATA B/-0.577191652D0,0.988205891D0,-0.897056937D0,0.918206857D0, - &-0.756704078D0,0.482199394D0,-0.193527818D0,0.035868343D0/ - - NX=INT(X) - DX=X-NX - - PYGAMM=1D0 - DXP=1D0 - DO 100 I=1,8 - DXP=DXP*DX - PYGAMM=PYGAMM+B(I)*DXP - 100 CONTINUE - IF(X.LT.1D0) THEN - PYGAMM=PYGAMM/X - ELSE - DO 110 IX=1,NX-1 - PYGAMM=(X-IX)*PYGAMM - 110 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYGANO -C...Evaluates the parton distributions of the anomalous photon, -C...inhomogeneously evolved from a scale P2 (where it vanishes) to Q2. -C...KF=0 gives the sum over (up to) 5 flavours, -C...KF<0 limits to flavours up to abs(KF), -C...KF>0 is for flavour KF only. -C...ALAM is the 4-flavour Lambda, which is automatically converted -C...to 3- and 5-flavour equivalents as needed. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local arrays and data. - DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - VXPGA(KFL)=0D0 - 100 CONTINUE - IF(Q2.LE.P2) RETURN - KFA=IABS(KF) - -C...Calculate Lambda; protect against unphysical Q2 and P2 input. - ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2D0/27D0))**2 - ALAMSQ(4)=ALAM**2 - ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2D0/23D0))**2 - P2EFF=MAX(P2,1.2D0*ALAMSQ(3)) - IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2) - IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - XL=-LOG(X) - -C...Find number of flavours at lower and upper scale. - NFP=4 - IF(P2EFF.LT.PMC**2) NFP=3 - IF(P2EFF.GT.PMB**2) NFP=5 - NFQ=4 - IF(Q2EFF.LT.PMC**2) NFQ=3 - IF(Q2EFF.GT.PMB**2) NFQ=5 - -C...Define range of flavour loop. - IF(KF.EQ.0) THEN - KFLMN=1 - KFLMX=5 - ELSEIF(KF.LT.0) THEN - KFLMN=1 - KFLMX=KFA - ELSE - KFLMN=KFA - KFLMX=KFA - ENDIF - -C...Loop over flavours the photon can branch into. - DO 110 KFL=KFLMN,KFLMX - -C...Light flavours: calculate t range and (approximate) s range. - IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - IF(NFQ.GT.NFP) THEN - Q2DIV=PMB**2 - IF(NFQ.EQ.4) Q2DIV=PMC**2 - SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ - & LOG(P2EFF/ALAMSQ(NFQ-1))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) - ENDIF - IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN - Q2DIV=PMC**2 - SNF4=(6D0/(33D0-2D0*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/ - & LOG(P2EFF/ALAMSQ(4))) - SNF3=(6D0/(33D0-2D0*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/ - & LOG(P2EFF/ALAMSQ(3))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4) - ENDIF - -C...u and s quark do not need a separate treatment when d has been done. - ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN - -C...Charm: as above, but only include range above c threshold. - ELSEIF(KFL.EQ.4) THEN - IF(Q2.LE.PMC**2) GOTO 110 - P2EFF=MAX(P2EFF,PMC**2) - Q2EFF=MAX(Q2EFF,P2EFF) - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN - Q2DIV=PMB**2 - SNFQ=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - SNFP=(6D0/(33D0-2D0*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/ - & LOG(P2EFF/ALAMSQ(NFQ-1))) - S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ) - ENDIF - -C...Bottom: as above, but only include range above b threshold. - ELSEIF(KFL.EQ.5) THEN - IF(Q2.LE.PMB**2) GOTO 110 - P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - TDIFF=LOG(Q2EFF/P2EFF) - S=(6D0/(33D0-2D0*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/ - & LOG(P2EFF/ALAMSQ(NFQ))) - ENDIF - -C...Evaluate flavour-dependent prefactor (charge^2 etc.). - CHSQ=1D0/9D0 - IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4D0/9D0 - FAC=AEM2PI*2D0*CHSQ*TDIFF - -C...Evaluate parton distributions (normalized to unit momentum sum). - IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN - XVAL= ((1.5D0+2.49D0*S+26.9D0*S**2)/(1D0+32.3D0*S**2)*X**2 + - & (1.5D0-0.49D0*S+7.83D0*S**2)/(1D0+7.68D0*S**2)*(1D0-X)**2 + - & 1.5D0*S/(1D0-3.2D0*S+7D0*S**2)*X*(1D0-X)) * - & X**(1D0/(1D0+0.58D0*S)) * (1D0-X**2)**(2.5D0*S/(1D0+10D0*S)) - XGLU= 2D0*S/(1D0+4D0*S+7D0*S**2) * - & X**(-1.67D0*S/(1D0+2D0*S)) * (1D0-X**2)**(1.2D0*S) * - & ((4D0*X**2+7D0*X+4D0)*(1D0-X)/3D0 - 2D0*X*(1D0+X)*XL) - XSEA= 0.333D0*S**2/(1D0+4.90D0*S+4.69D0*S**2+21.4D0*S**3) * - & X**(-1.18D0*S/(1D0+1.22D0*S)) * (1D0-X)**(1.2D0*S) * - & ((8D0-73D0*X+62D0*X**2)*(1D0-X)/9D0 + - & (3D0-8D0*X**2/3D0)*X*XL + (2D0*X-1D0)*X*XL**2) - -C...Threshold factors for c and b sea. - SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) - XCHM=0D0 - IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - XCHM=XSEA*(1D0-(SCH/SLL)**3) - ENDIF - XBOT=0D0 - IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - XBOT=XSEA*(1D0-(SBT/SLL)**3) - ENDIF - ENDIF - -C...Add contribution of each valence flavour. - XPGA(0)=XPGA(0)+FAC*XGLU - XPGA(1)=XPGA(1)+FAC*XSEA - XPGA(2)=XPGA(2)+FAC*XSEA - XPGA(3)=XPGA(3)+FAC*XSEA - XPGA(4)=XPGA(4)+FAC*XCHM - XPGA(5)=XPGA(5)+FAC*XBOT - XPGA(KFL)=XPGA(KFL)+FAC*XVAL - VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL - 110 CONTINUE - DO 120 KFL=1,5 - XPGA(-KFL)=XPGA(KFL) - VXPGA(-KFL)=VXPGA(KFL) - 120 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGAU2 -C...Integration by adaptive Gaussian quadrature. -C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. -C...Carbon copy of PYGAUS, but avoids having to use it recursively. - - FUNCTION PYGAU2(F, A, B, EPS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local declarations. - EXTERNAL F - DOUBLE PRECISION F,W(12), X(12) - DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ - DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ - DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ - DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ - DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ - DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ - DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ - DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ - DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ - DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ - DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ - DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ - -C...The Gaussian quadrature algorithm. - H = 0D0 - IF(B .EQ. A) GOTO 140 - CONST = 5D-3 / ABS(B-A) - BB = A - 100 CONTINUE - AA = BB - BB = B - 110 CONTINUE - C1 = 0.5D0*(BB+AA) - C2 = 0.5D0*(BB-AA) - S8 = 0D0 - DO 120 I = 1, 4 - U = C2*X(I) - S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) - 120 CONTINUE - S16 = 0D0 - DO 130 I = 5, 12 - U = C2*X(I) - S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) - 130 CONTINUE - S16 = C2*S16 - IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN - H = H + S16 - IF(BB .NE. B) GOTO 100 - ELSE - BB = C1 - IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 - H = 0D0 - CALL PYERRM(18,'(PYGAU2:) too high accuracy required') - GOTO 140 - ENDIF - 140 CONTINUE - PYGAU2 = H - - RETURN - END - -C********************************************************************* - -C...PYGAUS -C...Integration by adaptive Gaussian quadrature. -C...Adapted from the CERNLIB DGAUSS routine by K.S. Kolbig. - - FUNCTION PYGAUS(F, A, B, EPS) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local declarations. - EXTERNAL F - DOUBLE PRECISION F,W(12), X(12) - DATA X( 1) /9.6028985649753623D-1/, W( 1) /1.0122853629037626D-1/ - DATA X( 2) /7.9666647741362674D-1/, W( 2) /2.2238103445337447D-1/ - DATA X( 3) /5.2553240991632899D-1/, W( 3) /3.1370664587788729D-1/ - DATA X( 4) /1.8343464249564980D-1/, W( 4) /3.6268378337836198D-1/ - DATA X( 5) /9.8940093499164993D-1/, W( 5) /2.7152459411754095D-2/ - DATA X( 6) /9.4457502307323258D-1/, W( 6) /6.2253523938647893D-2/ - DATA X( 7) /8.6563120238783174D-1/, W( 7) /9.5158511682492785D-2/ - DATA X( 8) /7.5540440835500303D-1/, W( 8) /1.2462897125553387D-1/ - DATA X( 9) /6.1787624440264375D-1/, W( 9) /1.4959598881657673D-1/ - DATA X(10) /4.5801677765722739D-1/, W(10) /1.6915651939500254D-1/ - DATA X(11) /2.8160355077925891D-1/, W(11) /1.8260341504492359D-1/ - DATA X(12) /9.5012509837637440D-2/, W(12) /1.8945061045506850D-1/ - -C...The Gaussian quadrature algorithm. - H = 0D0 - IF(B .EQ. A) GOTO 140 - CONST = 5D-3 / ABS(B-A) - BB = A - 100 CONTINUE - AA = BB - BB = B - 110 CONTINUE - C1 = 0.5D0*(BB+AA) - C2 = 0.5D0*(BB-AA) - S8 = 0D0 - DO 120 I = 1, 4 - U = C2*X(I) - S8 = S8 + W(I) * (F(C1+U) + F(C1-U)) - 120 CONTINUE - S16 = 0D0 - DO 130 I = 5, 12 - U = C2*X(I) - S16 = S16 + W(I) * (F(C1+U) + F(C1-U)) - 130 CONTINUE - S16 = C2*S16 - IF(DABS(S16-C2*S8) .LE. EPS*(1D0+DABS(S16))) THEN - H = H + S16 - IF(BB .NE. B) GOTO 100 - ELSE - BB = C1 - IF(1D0 + CONST*ABS(C2) .NE. 1D0) GOTO 110 - H = 0D0 - CALL PYERRM(18,'(PYGAUS:) too high accuracy required') - GOTO 140 - ENDIF - 140 CONTINUE - PYGAUS = H - - RETURN - END - -C********************************************************************* - -C...PYGBEH -C...Evaluates the Bethe-Heitler cross section for heavy flavour -C...production. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGBEH(KF,X,Q2,P2,PM2,XPBH) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local data. - DATA AEM2PI/0.0011614D0/ - -C...Reset output. - XPBH=0D0 - SIGBH=0D0 - -C...Check kinematics limits. - IF(X.GE.Q2/(4D0*PM2+Q2+P2)) RETURN - W2=Q2*(1D0-X)/X-P2 - BETA2=1D0-4D0*PM2/W2 - IF(BETA2.LT.1D-10) RETURN - BETA=SQRT(BETA2) - RMQ=4D0*PM2/Q2 - -C...Simple case: P2 = 0. - IF(P2.LT.1D-4) THEN - IF(BETA.LT.0.99D0) THEN - XBL=LOG((1D0+BETA)/(1D0-BETA)) - ELSE - XBL=LOG((1D0+BETA)**2*W2/(4D0*PM2)) - ENDIF - SIGBH=BETA*(8D0*X*(1D0-X)-1D0-RMQ*X*(1D0-X))+ - & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2) - -C...Complicated case: P2 > 0, based on approximation of -C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373 - ELSE - RPQ=1D0-4D0*X**2*P2/Q2 - IF(RPQ.GT.1D-10) THEN - RPBE=SQRT(RPQ*BETA2) - IF(RPBE.LT.0.99D0) THEN - XBL=LOG((1D0+RPBE)/(1D0-RPBE)) - XBI=2D0*RPBE/(1D0-RPBE**2) - ELSE - RPBESN=4D0*PM2/W2+(4D0*X**2*P2/Q2)*BETA2 - XBL=LOG((1D0+RPBE)**2/RPBESN) - XBI=2D0*RPBE/RPBESN - ENDIF - SIGBH=BETA*(6D0*X*(1D0-X)-1D0)+ - & XBL*(X**2+(1D0-X)**2+RMQ*X*(1D0-3D0*X)-0.5D0*RMQ**2*X**2)+ - & XBI*(2D0*X/Q2)*(PM2*X*(2D0-RMQ)-P2*X) - ENDIF - ENDIF - -C...Multiply by charge-squared etc. to get parton distribution. - CHSQ=1D0/9D0 - IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4D0/9D0 - XPBH=3D0*CHSQ*AEM2PI*X*SIGBH - - RETURN - END - -C********************************************************************* - -C...PYGDIR -C...Evaluates the direct contribution, i.e. the C^gamma term, -C...as needed in MSbar parametrizations. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGDIR(X,Q2,P2,Q02,XPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local array and data. - DIMENSION XPGA(-6:6) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - 100 CONTINUE - -C...Evaluate common x-dependent expression. - XTMP = (X**2+(1D0-X)**2) * (-LOG(X)) - 1D0 - CGAM = 3D0*AEM2PI*X * (XTMP*(1D0+P2/(P2+Q02)) + 6D0*X*(1D0-X)) - -C...d, u, s part by simple charge factor. - XPGA(1)=(1D0/9D0)*CGAM - XPGA(2)=(4D0/9D0)*CGAM - XPGA(3)=(1D0/9D0)*CGAM - -C...Also fill for antiquarks. - DO 110 KF=1,5 - XPGA(-KF)=XPGA(KF) - 110 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGFXX -C...Auxiliary to PYRGHM. - - SUBROUTINE PYGFXX(MA,TANB,MQ,MUR,MD,MTOP,AT,AB,XMU,XMGL,VH, - * STOP1,STOP2,SBOT1,SBOT2,DELTAMT,DELTAMB) - IMPLICIT DOUBLE PRECISION(A-H,M,O-Z) - DIMENSION VH(2,2),VH3T(2,2),VH3B(2,2),AL(2,2) -C...Commonblocks. - INTEGER MSTU,MSTJ,KCHG - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - G(X,Y) = 2.D0 - (X+Y)/(X-Y)*DLOG(X/Y) - - T(X,Y,Z) = (X**2*Y**2*LOG(X**2/Y**2) + X**2*Z**2*LOG(Z**2/X**2) - * + Y**2*Z**2*LOG(Y**2/Z**2))/((X**2-Y**2)*(Y**2-Z**2)*(X**2-Z**2)) - - IF(DABS(XMU).LT.0.000001D0) XMU = 0.000001D0 - MQ2 = MQ**2 - MUR2 = MUR**2 - MD2 = MD**2 - TANBA = TANB - SINBA = TANBA/DSQRT(TANBA**2+1D0) - COSBA = SINBA/TANBA - - SINB = TANB/DSQRT(TANB**2+1D0) - COSB = SINB/TANB - - PI = PARU(1) - MZ = PMAS(23,1) - MW = PMAS(24,1) - SW = 1D0-MW**2/MZ**2 - V = 174.1D0 - - ALPHA3 = 0.12D0/(1D0+23/12D0/PI*0.12D0*LOG(MTOP**2/MZ**2)) - G2 = DSQRT(0.0336D0*4D0*PI) - G1 = DSQRT(0.0101D0*4D0*PI) - - IF(MQ.GT.MUR) MST = MQ - IF(MUR.GT.MQ.OR.MUR.EQ.MQ) MST = MUR - - MSUSYT = DSQRT(MST**2 + MTOP**2) - - IF(MQ.GT.MD) MSB = MQ - IF(MD.GT.MQ.OR.MD.EQ.MQ) MSB = MD - - MB = PYMRUN(5,MSB**2) - MSUSYB = DSQRT(MSB**2 + MB**2) - TT = LOG(MSUSYT**2/MTOP**2) - TB = LOG(MSUSYB**2/MTOP**2) - - RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) - HT = RMTOP/(V*SINB) - HTST = RMTOP/V - HB = MB/V/COSB - G32 = ALPHA3*4D0*PI - BT2 = -(8D0*G32 - 9D0*HT**2/2D0 - HB**2/2D0)/(4D0*PI)**2 - BB2 = -(8D0*G32 - 9D0*HB**2/2D0 - HT**2/2D0)/(4D0*PI)**2 - AL2 = 3D0/8D0/PI**2*HT**2 -C BT2ST = -(8.*G32 - 9.*HTST**2/2.)/(4.*PI)**2 -C ALST = 3./8./PI**2*HTST**2 - AL1 = 3D0/8D0/PI**2*HB**2 - - AL(1,1) = AL1 - AL(1,2) = (AL2+AL1)/2D0 - AL(2,1) = (AL2+AL1)/2D0 - AL(2,2) = AL2 - - IF(MA.GT.MTOP) THEN - VI = V*(1D0 + 3D0/32D0/PI**2*HTST**2* - * LOG(MTOP**2/MA**2)) - H1I = VI* COSBA - H2I = VI*SINBA - H1T = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYT**2))**.25D0 - H2T = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYT**2))**.25D0 - H1B = H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MA**2/MSUSYB**2))**.25D0 - H2B = H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MA**2/MSUSYB**2))**.25D0 - ELSE - VI = V - H1I = VI*COSB - H2I = VI*SINB - H1T=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYT**2))**.25D0 - H2T=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYT**2))**.25D0 - H1B=H1I*(1D0+3D0/8D0/PI**2*HB**2*LOG(MTOP**2/MSUSYB**2))**.25D0 - H2B=H2I*(1D0+3D0/8D0/PI**2*HT**2*LOG(MTOP**2/MSUSYB**2))**.25D0 - ENDIF - - TANBST = H2T/H1T - SINBT = TANBST/DSQRT(1D0+TANBST**2) - - TANBSB = H2B/H1B - SINBB = TANBSB/DSQRT(1D0+TANBSB**2) - COSBB = SINBB/TANBSB - - DELTAMT = 0D0 - DELTAMB = 0D0 - - MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) - MTOP2 = DSQRT(MTOP4) - MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) - * /(1D0+DELTAMB)**4 - MBOT2 = DSQRT(MBOT4) - - STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) - STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 - * + MTOP2*(AT-XMU/TANBST)**2) - IF(STOP22.LT.0.) GOTO 120 - SBOT12 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - SBOT22 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - IF(SBOT22.LT.0.) SBOT22 = 10000D0 - - STOP1 = DSQRT(STOP12) - STOP2 = DSQRT(STOP22) - SBOT1 = DSQRT(SBOT12) - SBOT2 = DSQRT(SBOT22) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE IS THE DEFINITION OF DELTAMB AND DELTAMT, WHICH -C ARE THE VERTEX CORRECTIONS TO THE BOTTOM AND TOP QUARK -C MASS, KEEPING THE DOMINANT QCD AND TOP YUKAWA COUPLING -C INDUCED CORRECTIONS. -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - X=SBOT1 - Y=SBOT2 - Z=XMGL - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - - T1=T(X,Y,Z) - X=STOP1 - Y=STOP2 - Z=XMU - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - T2=T(X,Y,Z) - DELTAMB = -2*ALPHA3/3D0/PI*XMGL*(AB-XMU*TANB)*T1 - * + HT**2/(4D0*PI)**2*(AT-XMU/TANB)*XMU*TANB*T2 - X=STOP1 - Y=STOP2 - Z=XMGL - IF(X.EQ.Y) X = X - 0.00001D0 - IF(X.EQ.Z) X = X - 0.00002D0 - IF(Y.EQ.Z) Y = Y - 0.00003D0 - T3=T(X,Y,Z) - DELTAMT = -2D0*ALPHA3/3D0/PI*(AT-XMU/TANB)*XMGL*T3 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE THE NEW VALUES OF THE TOP AND BOTTOM QUARK MASSES AT -C THE SCALE MS ARE DEFINED, TO BE USED IN THE EFFECTIVE -C POTENTIAL APPROXIMATION. THEY ARE JUST THE OLD ONES, BUT -C INCLUDING THE FINITE CORRECTIONS DELTAMT AND DELTAMB. -C THE DELTAMB CORRECTIONS CAN BECOME LARGE AND ARE RESUMMED -C TO ALL ORDERS, AS SUGGESTED IN THE TWO RECENT WORKS BY M. CARENA, -C S. MRENNA AND C.E.M. WAGNER, AS WELL AS IN THE WORK BY M. CARENA, -C D. GARCIA, U. NIERSTE AND C.E.M. WAGNER, TO APPEAR. THE TOP -C QUARK MASS CORRECTIONS ARE SMALL AND ARE KEPT IN THE PERTURBATIVE -C FORMULATION. THE FUNCTION T(X,Y,Z) IS NECESSARY FOR THE -C CALCULATION. THE ENTRIES ARE MASSES AND NOT THEIR SQUARES ! -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - MTOP4 = RMTOP**4*(1D0+2D0*BT2*TT- AL2*TT - 4D0*DELTAMT) - MTOP2 = DSQRT(MTOP4) - MBOT4 = MB**4*(1D0+2D0*BB2*TB - AL1*TB) - * /(1D0+DELTAMB)**4 - MBOT2 = DSQRT(MBOT4) - - STOP12 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * +SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 + MTOP2*(AT-XMU/TANBST)**2) - STOP22 = (MQ2 + MUR2)*.5D0 + MTOP2 - * +1D0/8D0*(G2**2+G1**2)*(H1T**2-H2T**2) - * - SQRT(((G2**2-5D0*G1**2/3D0)/4D0*(H1T**2-H2T**2) + - * MQ2 - MUR2)**2*0.25D0 - * + MTOP2*(AT-XMU/TANBST)**2) - - IF(STOP22.LT.0.) GOTO 120 - SBOT12 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * + SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - SBOT22 = (MQ2 + MD2)*.5D0 - * - 1D0/8D0*(G2**2+G1**2)*(H1B**2-H2B**2) - * - SQRT(((G1**2/3D0-G2**2)/4D0*(H1B**2-H2B**2) + - * MQ2 - MD2)**2*0.25D0 + MBOT2*(AB-XMU*TANBSB)**2) - IF(SBOT22.LT.0.) GOTO 120 - - - STOP1 = DSQRT(STOP12) - STOP2 = DSQRT(STOP22) - SBOT1 = DSQRT(SBOT12) - SBOT2 = DSQRT(SBOT22) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC D-TERMS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - STW=SW - - F1T=(MQ2-MUR2)/(STOP12-STOP22)*(.5D0-4D0/3D0*STW)* - * LOG(STOP1/STOP2) - * +(.5D0-2D0/3D0*STW)*LOG(STOP1*STOP2/(MQ2+MTOP2)) - * + 2D0/3D0*STW*LOG(STOP1*STOP2/(MUR2+MTOP2)) - - F1B=(MQ2-MD2)/(SBOT12-SBOT22)*(-.5D0+2D0/3D0*STW)* - * LOG(SBOT1/SBOT2) - * +(-.5D0+1D0/3D0*STW)*LOG(SBOT1*SBOT2/(MQ2+MBOT2)) - * - 1D0/3D0*STW*LOG(SBOT1*SBOT2/(MD2+MBOT2)) - - F2T=DSQRT(MTOP2)*(AT-XMU/TANBST)/(STOP12-STOP22)* - * (-.5D0*LOG(STOP12/STOP22) - * +(4D0/3D0*STW-.5D0)*(MQ2-MUR2)/(STOP12-STOP22)* - * G(STOP12,STOP22)) - - F2B=DSQRT(MBOT2)*(AB-XMU*TANBSB)/(SBOT12-SBOT22)* - * (.5D0*LOG(SBOT12/SBOT22) - * +(-2D0/3D0*STW+.5D0)*(MQ2-MD2)/(SBOT12-SBOT22)* - * G(SBOT12,SBOT22)) - - VH3B(1,1) = MBOT4/(COSBB**2)*(LOG(SBOT1**2*SBOT2**2/ - * (MQ2+MBOT2)/(MD2+MBOT2)) - * + 2D0*(AB*(AB-XMU*TANBSB)/(SBOT1**2-SBOT2**2))* - * LOG(SBOT1**2/SBOT2**2)) + - * MBOT4/(COSBB**2)*(AB*(AB-XMU*TANBSB)/ - * (SBOT1**2-SBOT2**2))**2*G(SBOT12,SBOT22) - - VH3T(1,1) = - * MTOP4/(SINBT**2)*(XMU*(-AT+XMU/TANBST)/(STOP1**2 - * -STOP2**2))**2*G(STOP12,STOP22) - - VH3B(1,1)=VH3B(1,1)+ - * MZ**2*(2*MBOT2*F1B-DSQRT(MBOT2)*AB*F2B) - - VH3T(1,1) = VH3T(1,1) + - * MZ**2*(DSQRT(MTOP2)*XMU/TANBST*F2T) - - VH3T(2,2) = MTOP4/(SINBT**2)*(LOG(STOP1**2*STOP2**2/ - * (MQ2+MTOP2)/(MUR2+MTOP2)) - * + 2D0*(AT*(AT-XMU/TANBST)/(STOP1**2-STOP2**2))* - * LOG(STOP1**2/STOP2**2)) + - * MTOP4/(SINBT**2)*(AT*(AT-XMU/TANBST)/ - * (STOP1**2-STOP2**2))**2*G(STOP12,STOP22) - - VH3B(2,2) = - * MBOT4/(COSBB**2)*(XMU*(-AB+XMU*TANBSB)/(SBOT1**2 - * -SBOT2**2))**2*G(SBOT12,SBOT22) - - VH3T(2,2)=VH3T(2,2)+ - * MZ**2*(-2*MTOP2*F1T+DSQRT(MTOP2)*AT*F2T) - VH3B(2,2) = VH3B(2,2) -MZ**2*DSQRT(MBOT2)*XMU*TANBSB*F2B - VH3T(1,2) = - - * MTOP4/(SINBT**2)*XMU*(AT-XMU/TANBST)/ - * (STOP1**2-STOP2**2)*(LOG(STOP1**2/STOP2**2) + AT* - * (AT - XMU/TANBST)/(STOP1**2-STOP2**2)*G(STOP12,STOP22)) - - VH3B(1,2) = - * - MBOT4/(COSBB**2)*XMU*(AB-XMU*TANBSB)/ - * (SBOT1**2-SBOT2**2)*(LOG(SBOT1**2/SBOT2**2) + AB* - * (AB - XMU*TANBSB)/(SBOT1**2-SBOT2**2)*G(SBOT12,SBOT22)) - - - VH3T(1,2)=VH3T(1,2) + - *MZ**2*(MTOP2/TANBST*F1T-DSQRT(MTOP2)*(AT/TANBST+XMU)/2D0*F2T) - - VH3B(1,2)=VH3B(1,2) + - *MZ**2*(-MBOT2*TANBSB*F1B+DSQRT(MBOT2)*(AB*TANBSB+XMU)/2D0*F2B) - - VH3T(2,1) = VH3T(1,2) - VH3B(2,1) = VH3B(1,2) - -C TQ = LOG((MQ2 + MTOP2)/MTOP2) -C TU = LOG((MUR2+MTOP2)/MTOP2) -C TQD = LOG((MQ2 + MB**2)/MB**2) -C TD = LOG((MD2+MB**2)/MB**2) - - DO 110 I = 1,2 - DO 100 J = 1,2 - VH(I,J) = - * 6D0/(8D0*PI**2*(H1T**2+H2T**2)) - * *VH3T(I,J)*0.5D0*(1D0-AL(I,J)*TT/2D0) + - * 6D0/(8D0*PI**2*(H1B**2+H2B**2)) - * *VH3B(I,J)*0.5D0*(1D0-AL(I,J)*TB/2D0) - 100 CONTINUE - 110 CONTINUE - - GOTO 150 - 120 DO 140 I =1,2 - DO 130 J = 1,2 - VH(I,J) = -1D15 - 130 CONTINUE - 140 CONTINUE - - - 150 RETURN - END - -C********************************************************************* - -C...PYGGAM -C...Constructs the F2 and parton distributions of the photon -C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms. -C...For F2, c and b are included by the Bethe-Heitler formula; -C...in the 'MSbar' scheme additionally a Cgamma term is added. -C...Contains the SaS sets 1D, 1M, 2D and 2M. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - COMMON/PYINT9/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6) - SAVE /PYINT8/,/PYINT9/ -C...Local arrays. - DIMENSION XPDFGM(-6:6),XPGA(-6:6), VXPGA(-6:6) -C...Charm and bottom masses (low to compensate for J/psi etc.). - DATA PMC/1.3D0/, PMB/4.6D0/ -C...alpha_em and alpha_em/(2*pi). - DATA AEM/0.007297D0/, AEM2PI/0.0011614D0/ -C...Lambda value for 4 flavours. - DATA ALAM/0.20D0/ -C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum. - DATA FRACU/0.8D0/ -C...VMD couplings f_V**2/(4*pi). - DATA FRHO/2.20D0/, FOMEGA/23.6D0/, FPHI/18.4D0/ -C...Masses for rho (=omega) and phi. - DATA PMRHO/0.770D0/, PMPHI/1.020D0/ -C...Number of points in integration for IP2=1. - DATA NSTEP/100/ - -C...Reset output. - F2GM=0D0 - DO 100 KFL=-6,6 - XPDFGM(KFL)=0D0 - XPVMD(KFL)=0D0 - XPANL(KFL)=0D0 - XPANH(KFL)=0D0 - XPBEH(KFL)=0D0 - XPDIR(KFL)=0D0 - VXPVMD(KFL)=0D0 - VXPANL(KFL)=0D0 - VXPANH(KFL)=0D0 - VXPDGM(KFL)=0D0 - 100 CONTINUE - -C...Set Q0 cut-off parameter as function of set used. - IF(ISET.LE.2) THEN - Q0=0.6D0 - ELSE - Q0=2D0 - ENDIF - Q02=Q0**2 - -C...Scale choice for off-shell photon; common factors. - Q2A=Q2 - FACNOR=1D0 - IF(IP2.EQ.1) THEN - P2MX=P2+Q02 - Q2A=Q2+P2*Q02/MAX(Q02,Q2) - FACNOR=LOG(Q2/Q02)/NSTEP - ELSEIF(IP2.EQ.2) THEN - P2MX=MAX(P2,Q02) - ELSEIF(IP2.EQ.3) THEN - P2MX=P2+Q02 - Q2A=Q2+P2*Q02/MAX(Q02,Q2) - ELSEIF(IP2.EQ.4) THEN - P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - ELSEIF(IP2.EQ.5) THEN - P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=Q0*SQRT(P2MXA) - FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX) - ELSEIF(IP2.EQ.6) THEN - P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) - ELSE - P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/ - & ((Q2+P2)*(Q02+P2))) - P2MX=Q0*SQRT(P2MXA) - P2MXB=P2MX - P2MX=MAX(0D0,1D0-P2/Q2)*P2MX+MIN(1D0,P2/Q2)*MAX(P2,Q02) - P2MXB=MAX(0D0,1D0-P2/Q2)*P2MXB+MIN(1D0,P2/Q2)*P2MXA - IF(ABS(Q2-Q02).GT.1D-6) THEN - FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB) - ELSEIF(P2.LT.Q02) THEN - FACNOR=Q02**3/(Q02+P2)/(Q02**2-P2**2/2D0) - ELSE - FACNOR=1D0 - ENDIF - ENDIF - -C...Call VMD parametrization for d quark and use to give rho, omega, -C...phi. Note dipole dampening for off-shell photon. - CALL PYGVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - XFVAL=VXPGA(1) - XPGA(1)=XPGA(2) - XPGA(-1)=XPGA(-2) - FACUD=AEM*(1D0/FRHO+1D0/FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2 - FACS=AEM*(1D0/FPHI)*(PMPHI**2/(PMPHI**2+P2))**2 - DO 110 KFL=-5,5 - XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL) - 110 CONTINUE - XPVMD(1)=XPVMD(1)+(1D0-FRACU)*FACUD*XFVAL - XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL - XPVMD(3)=XPVMD(3)+FACS*XFVAL - XPVMD(-1)=XPVMD(-1)+(1D0-FRACU)*FACUD*XFVAL - XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL - XPVMD(-3)=XPVMD(-3)+FACS*XFVAL - VXPVMD(1)=(1D0-FRACU)*FACUD*XFVAL - VXPVMD(2)=FRACU*FACUD*XFVAL - VXPVMD(3)=FACS*XFVAL - VXPVMD(-1)=(1D0-FRACU)*FACUD*XFVAL - VXPVMD(-2)=FRACU*FACUD*XFVAL - VXPVMD(-3)=FACS*XFVAL - - IF(IP2.NE.1) THEN -C...Anomalous parametrizations for different strategies -C...for off-shell photons; except full integration. - -C...Call anomalous parametrization for d + u + s. - CALL PYGANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 120 KFL=-5,5 - XPANL(KFL)=FACNOR*XPGA(KFL) - VXPANL(KFL)=FACNOR*VXPGA(KFL) - 120 CONTINUE - -C...Call anomalous parametrization for c and b. - CALL PYGANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 130 KFL=-5,5 - XPANH(KFL)=FACNOR*XPGA(KFL) - VXPANH(KFL)=FACNOR*VXPGA(KFL) - 130 CONTINUE - CALL PYGANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA) - DO 140 KFL=-5,5 - XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL) - VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL) - 140 CONTINUE - - ELSE -C...Special option: loop over flavours and integrate over k2. - DO 170 KF=1,5 - DO 160 ISTEP=1,NSTEP - Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5D0)/NSTEP) - IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR. - & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160 - CALL PYGVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA) - FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR - IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8D0/9D0) - IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2D0/9D0) - DO 150 KFL=-5,5 - IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL) - IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL) - IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL) - IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL) - 150 CONTINUE - 160 CONTINUE - 170 CONTINUE - ENDIF - -C...Call Bethe-Heitler term expression for charm and bottom. - CALL PYGBEH(4,X,Q2,P2,PMC**2,XPBH) - XPBEH(4)=XPBH - XPBEH(-4)=XPBH - CALL PYGBEH(5,X,Q2,P2,PMB**2,XPBH) - XPBEH(5)=XPBH - XPBEH(-5)=XPBH - -C...For MSbar subtraction call C^gamma term expression for d, u, s. - IF(ISET.EQ.2.OR.ISET.EQ.4) THEN - CALL PYGDIR(X,Q2,P2,Q02,XPGA) - DO 180 KFL=-5,5 - XPDIR(KFL)=XPGA(KFL) - 180 CONTINUE - ENDIF - -C...Store result in output array. - DO 190 KFL=-5,5 - CHSQ=1D0/9D0 - IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4D0/9D0 - XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) - IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2 - XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL) - VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL) - 190 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYGIVE -C...Sets values of commonblock variables. - - SUBROUTINE PYGIVE(CHIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYDATR/MRPY(6),RRPY(100) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYDATR/, - &/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, - &/PYINT5/,/PYINT6/,/PYINT7/,/PYINT8/,/PYMSSM/,/PYMSRV/,/PYTCSM/ -C...Local arrays and character variables. - CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, - &CHNEW2*28,CHNAM*6,CHVAR(54)*6,CHALP(2)*26,CHIND*8,CHINI*10, - &CHINR*16 - DIMENSION MSVAR(54,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','MRPY', - &'RRPY','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', - &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', - &'MWID','WIDS','NGEN','XSEC','PROC','SIGT','XPVMD','XPANL', - &'XPANH','XPBEH','XPDIR','IMSS','RMSS','RVLAM','RVLAMP','RVLAMB', - &'ITCM','RTCM'/ - DATA ((MSVAR(I,J),J=1,8),I=1,54)/ 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,4,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,8000,1,2,2*0, - &2,1,1,8000,4*0, 1,2,1,8000,1,5,2*0, 3,2,1,500,1,2,2*0, - &1,1,1,6,4*0, 2,1,1,100,4*0, - &1,7*0, 1,1,1,500,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,500,4*0, - &1,2,1,500,1,2,2*0, 2,2,1,500,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, - &1,1,1,500,4*0, 2,2,1,500,1,5,2*0, 1,2,0,500,1,3,2*0, - &2,2,0,500,1,3,2*0, 4,1,0,500,4*0, 2,3,0,6,0,6,0,5, - &2,1,-6,6,4*0, 2,1,-6,6,4*0, 2,1,-6,6,4*0, - &2,1,-6,6,4*0, 2,1,-6,6,4*0, 1,1,0,99,4*0, 2,1,0,99,4*0, - &2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, 2,3,1,3,1,3,1,3, - &1,1,0,99,4*0, 2,1,0,99,4*0/ - DATA CHALP/'abcdefghijklmnopqrstuvwxyz', - &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - -C...Length of character variable. Subdivide it into instructions. - IF(MSTU(12).GE.1) CALL PYLIST(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...Peel off any text following exclamation mark. - LHIG2=LBIT - DO 140 LLOW2=LHIG2,1,-1 - IF(CHBIT(LLOW2:LLOW2).EQ.'!') LBIT=LLOW2-1 - 140 CONTINUE - IF(LBIT.EQ.0) RETURN - -C...Identify commonblock variable. - LNAM=1 - 150 LNAM=LNAM+1 - IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. - &LNAM.LE.6) GOTO 150 - CHNAM=CHBIT(1:LNAM-1)//' ' - DO 170 LCOM=1,LNAM-1 - DO 160 LALP=1,26 - IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= - & CHALP(2)(LALP:LALP) - 160 CONTINUE - 170 CONTINUE - IVAR=0 - DO 180 IV=1,54 - IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV - 180 CONTINUE - IF(IVAR.EQ.0) THEN - CALL PYERRM(18,'(PYGIVE:) 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 - 190 LIND=LIND+1 - IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 - 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.OR. - & IVAR.EQ.37)) THEN - CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) - READ(CHIND,'(I8)') KF - I1=PYCOMP(KF) - ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. - & 'c') THEN - CALL PYERRM(18,'(PYGIVE:) 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 - 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)') I2 - LNAM=LIND - IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 - NINDX=2 - ENDIF - IF(CHBIT(LNAM:LNAM).EQ.',') THEN - LIND=LNAM - 210 LIND=LIND+1 - IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 210 - 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 PYERRM(18,'(PYGIVE:) 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,I2)(1:8) - ELSEIF(IVAR.EQ.18) THEN - IOLD=MRPY(I1) - ELSEIF(IVAR.EQ.19) THEN - ROLD=RRPY(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 - IOLD=MWID(I1) - ELSEIF(IVAR.EQ.38) THEN - ROLD=WIDS(I1,I2) - ELSEIF(IVAR.EQ.39) THEN - IOLD=NGEN(I1,I2) - ELSEIF(IVAR.EQ.40) THEN - ROLD=XSEC(I1,I2) - ELSEIF(IVAR.EQ.41) THEN - CHOLD2=PROC(I1) - ELSEIF(IVAR.EQ.42) THEN - ROLD=SIGT(I1,I2,I3) - ELSEIF(IVAR.EQ.43) THEN - ROLD=XPVMD(I1) - ELSEIF(IVAR.EQ.44) THEN - ROLD=XPANL(I1) - ELSEIF(IVAR.EQ.45) THEN - ROLD=XPANH(I1) - ELSEIF(IVAR.EQ.46) THEN - ROLD=XPBEH(I1) - ELSEIF(IVAR.EQ.47) THEN - ROLD=XPDIR(I1) - ELSEIF(IVAR.EQ.48) THEN - IOLD=IMSS(I1) - ELSEIF(IVAR.EQ.49) THEN - ROLD=RMSS(I1) - ELSEIF(IVAR.EQ.50) THEN - ROLD=RVLAM(I1,I2,I3) - ELSEIF(IVAR.EQ.51) THEN - ROLD=RVLAMP(I1,I2,I3) - ELSEIF(IVAR.EQ.52) THEN - ROLD=RVLAMB(I1,I2,I3) - ELSEIF(IVAR.EQ.53) THEN - IOLD=ITCM(I1) - ELSEIF(IVAR.EQ.54) THEN - ROLD=RTCM(I1) - ENDIF - -C...Print current value of variable. Loop back. - IF(LNAM.GE.LBIT) THEN - CHBIT(LNAM:14)=' ' - CHBIT(15:60)=' has the value ' - IF(MSVAR(IVAR,1).EQ.1) THEN - WRITE(CHBIT(51:60),'(I10)') IOLD - ELSEIF(MSVAR(IVAR,1).EQ.2) THEN - WRITE(CHBIT(47:60),'(F14.5)') ROLD - ELSEIF(MSVAR(IVAR,1).EQ.3) THEN - CHBIT(53:60)=CHOLD - ELSE - CHBIT(33:60)=CHOLD - ENDIF - IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) - LLOW=LHIG - IF(LLOW.LT.LTOT) GOTO 120 - RETURN - ENDIF - -C...Read in new variable value. - IF(MSVAR(IVAR,1).EQ.1) THEN - CHINI=' ' - CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) - READ(CHINI,'(I10)') INEW - ELSEIF(MSVAR(IVAR,1).EQ.2) THEN - CHINR=' ' - CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) - READ(CHINR,*) 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,I2)=CHNEW - ELSEIF(IVAR.EQ.18) THEN - MRPY(I1)=INEW - ELSEIF(IVAR.EQ.19) THEN - RRPY(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 - MWID(I1)=INEW - ELSEIF(IVAR.EQ.38) THEN - WIDS(I1,I2)=RNEW - ELSEIF(IVAR.EQ.39) THEN - NGEN(I1,I2)=INEW - ELSEIF(IVAR.EQ.40) THEN - XSEC(I1,I2)=RNEW - ELSEIF(IVAR.EQ.41) THEN - PROC(I1)=CHNEW2 - ELSEIF(IVAR.EQ.42) THEN - SIGT(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.43) THEN - XPVMD(I1)=RNEW - ELSEIF(IVAR.EQ.44) THEN - XPANL(I1)=RNEW - ELSEIF(IVAR.EQ.45) THEN - XPANH(I1)=RNEW - ELSEIF(IVAR.EQ.46) THEN - XPBEH(I1)=RNEW - ELSEIF(IVAR.EQ.47) THEN - XPDIR(I1)=RNEW - ELSEIF(IVAR.EQ.48) THEN - IMSS(I1)=INEW - ELSEIF(IVAR.EQ.49) THEN - RMSS(I1)=RNEW - ELSEIF(IVAR.EQ.50) THEN - RVLAM(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.51) THEN - RVLAMP(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.52) THEN - RVLAMB(I1,I2,I3)=RNEW - ELSEIF(IVAR.EQ.53) THEN - ITCM(I1)=INEW - ELSEIF(IVAR.EQ.54) THEN - RTCM(I1)=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********************************************************************* - -C...PYGLUI -C...Calculates gluino decay modes. - - SUBROUTINE PYGLUI(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -CC &SFMIX(16,4), -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ - DOUBLE PRECISION XMI,XMJ,XMF,AXMJ,AXMI - DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,S12MAX,S12MIN - DOUBLE PRECISION CA,CB,AL,AR,BL,BR - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,ILR,I,IKNT,IFL - DOUBLE PRECISION SR2 - DOUBLE PRECISION GAM - DOUBLE PRECISION PYALEM,PI,PYALPS,EI,T3I - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - INTEGER KFNCHI(4),KFCCHI(2) - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA PREC/1D-2/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - IF(KFIN.NE.KSUSY1+21) RETURN - KCIN=PYCOMP(KFIN) - - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - - XMI=PMAS(KCIN,1) - AXMI=ABS(XMI) - XMI2=XMI**2 - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=AXMI**3 - - XMI=SIGN(XMI,RMSS(3)) - -C...2-BODY DECAYS OF GLUINO -> GRAVITINO GLUON - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=21 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC - ENDIF - ENDIF - -C...2-BODY DECAYS OF GLUINO -> QUARK SQUARK - - DO 110 IFL=1,6 - DO 100 ILR=1,2 - XMJ=PMAS(PYCOMP(ILR*KSUSY1+IFL),1) - AXMJ=ABS(XMJ) - XMF=PMAS(IFL,1) - IF(AXMI.GE.AXMJ+XMF) THEN -C...Minus sign difference from gluino-quark-squark feynman rules - AL=SFMIX(IFL,1) - BL=-SFMIX(IFL,3) - AR=SFMIX(IFL,2) - BR=-SFMIX(IFL,4) -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - CA=AL - CB=BL -C...F2 -> F CHI - ELSE - CA=AR - CB=BR - ENDIF - LKNT=LKNT+1 - XMA2=XMJ**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=4D0/8D0*AS/4D0/XMI3*SQRT(XL)*((XMI2+XMB2-XMA2)* - & (CA**2+CB**2)-4D0*CA*CB*XMI*XMF) - IDLAM(LKNT,1)=ILR*KSUSY1+IFL - IDLAM(LKNT,2)=-IFL - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - 100 CONTINUE - 110 CONTINUE - -C...3-BODY DECAYS TO GAUGINO FERMION-FERMION -C...GLUINO -> NI Q QBAR - DO 170 IX=1,4 - XMJ=SMZ(IX) - AXMJ=ABS(XMJ) - IF(AXMI.GE.AXMJ) THEN - DO 120 I=1,4 - ZMIXC(IX,I)=DCMPLX(ZMIX(IX,I),ZMIXI(IX,I)) - 120 CONTINUE - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))/SR2 - ORPP=DCONJG(OLPP) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - IA=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) - XXC(7)=XXC(5) - XXC(8)=XXC(6) - XXC(9)=1D6 - XXC(10)=0D0 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(1)=0D0 - CXC(2)=-GLIJ - CXC(3)=0D0 - CXC(4)=DCONJG(GLIJ) - CXC(5)=0D0 - CXC(6)=GRIJ - CXC(7)=0D0 - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 130 - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - 130 CONTINUE - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - PMOLD=PMAS(PYCOMP(KSUSY1+5),1) - IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+5),1)+PMAS(5,1)) THEN - GOTO 140 - ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+5),1)+PMAS(5,1)) THEN - PMAS(PYCOMP(KSUSY1+5),1)=100D0*XMI - ENDIF - CALL PYTBBN(IX,100,-1D0/3D0,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - PMAS(PYCOMP(KSUSY1+5),1)=PMOLD - ENDIF -C...U-TYPE QUARKS - 140 CONTINUE - IA=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+IA),1) -C IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 290 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(2)=-GLIJ - CXC(4)=DCONJG(GLIJ) - CXC(6)=GRIJ - CXC(8)=-DCONJG(GRIJ) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 150 - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-2) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - ENDIF - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - 150 CONTINUE -C...INCLUDE THE DECAY GLUINO -> NJ + T + T~ -C...IF THE DECAY GLUINO -> ST + T CANNOT OCCUR - XMF=PMAS(6,1) - IF(AXMI.GE.AXMJ+2D0*XMF) THEN - PMOLD=PMAS(PYCOMP(KSUSY1+6),1) - IF(AXMI.GT.PMAS(PYCOMP(KSUSY2+6),1)+XMF) THEN - GOTO 160 - ELSEIF(AXMI.GT.PMAS(PYCOMP(KSUSY1+6),1)+XMF) THEN - PMAS(PYCOMP(KSUSY1+6),1)=100D0*XMI - ENDIF - CALL PYTBBN(IX,100,2D0/3D0,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=6 - IDLAM(LKNT,3)=-6 - PMAS(PYCOMP(KSUSY1+6),1)=PMOLD - ENDIF - 160 CONTINUE - ENDIF - 170 CONTINUE - -C...GLUINO -> CI Q QBAR' - DO 210 IX=1,2 - XMJ=SMW(IX) - AXMJ=ABS(XMJ) - IF(AXMI.GE.AXMJ) THEN - DO 180 I=1,2 - VMIXC(IX,I)=DCMPLX(VMIX(IX,I),VMIXI(IX,I)) - UMIXC(IX,I)=DCMPLX(UMIX(IX,I),UMIXI(IX,I)) - 180 CONTINUE - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+1),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+2),1) - XXC(9)=1D6 - XXC(10)=0D0 - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32))) - ORPP=DCONJG(OLPP) - CXC(1)=DCMPLX(0D0,0D0) - CXC(3)=DCMPLX(0D0,0D0) - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - CXC(2)=UMIXC(IX,1)*OLPP/SR2 - CXC(4)=-DCONJG(VMIXC(IX,1))*ORPP/SR2 - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 190 - IF(AXMI.GE.AXMJ+PMAS(1,1)+PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-2 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-4 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - 190 CONTINUE - - XMF=PMAS(6,1) - XMFP=PMAS(5,1) - IF(AXMI.GE.AXMJ+XMF+XMFP) THEN - IF(XMI.GT.MIN(PMAS(PYCOMP(KSUSY1+5),1)+XMFP, - $ PMAS(PYCOMP(KSUSY2+6),1)+XMF)) GOTO 200 - PMOLT2=PMAS(PYCOMP(KSUSY2+6),1) - PMOLB2=PMAS(PYCOMP(KSUSY2+5),1) - PMOLT1=PMAS(PYCOMP(KSUSY1+6),1) - PMOLB1=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GT.PMOLT2+XMF) PMAS(PYCOMP(KSUSY2+6),1)=100D0*AXMI - IF(XMI.GT.PMOLT1+XMF) PMAS(PYCOMP(KSUSY1+6),1)=100D0*AXMI - IF(XMI.GT.PMOLB2+XMFP) PMAS(PYCOMP(KSUSY2+5),1)=100D0*AXMI - IF(XMI.GT.PMOLB1+XMFP) PMAS(PYCOMP(KSUSY1+5),1)=100D0*AXMI - CALL PYTBBC(IX,100,XMI,GAM) - LKNT=LKNT+1 - XLAM(LKNT)=GAM - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-6 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - PMAS(PYCOMP(KSUSY2+6),1)=PMOLT2 - PMAS(PYCOMP(KSUSY2+5),1)=PMOLB2 - PMAS(PYCOMP(KSUSY1+6),1)=PMOLT1 - PMAS(PYCOMP(KSUSY1+5),1)=PMOLB1 - ENDIF - 200 CONTINUE - ENDIF - 210 CONTINUE - -C...R-parity violating (3-body) decays. - CALL PYRVGL(KFIN,XLAM,IDLAM,LKNT) - - IKNT=LKNT - XLAM(0)=0D0 - DO 220 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 220 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYGRVD -C...Gives the GRV 94 D (DIS) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVD (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.34D0 - LAM2 = 0.248D0 * 0.248D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 2.484D0 + 0.116D0 * S + 0.093D0 * S2 - AKU = 0.563D0 - 0.025D0 * S - BKU = 0.054D0 + 0.154D0 * S - AU = -0.326D0 - 0.058D0 * S - 0.135D0 * S2 - BU = -3.322D0 + 8.259D0 * S - 3.119D0 * S2 + 0.291D0 * S3 - CU = 11.52D0 - 12.99D0 * S + 3.161D0 * S2 - DU = 2.808D0 + 1.400D0 * S - 0.557D0 * S2 + 0.119D0 * S3 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.156D0 - 0.017D0 * S - AKD = 0.299D0 - 0.022D0 * S - BKD = 0.259D0 - 0.015D0 * S - AD = 3.445D0 + 1.278D0 * S + 0.326D0 * S2 - BD = -6.934D0 + 37.45D0 * S - 18.95D0 * S2 + 1.463D0 * S3 - CD = 55.45D0 - 69.92D0 * S + 20.78D0 * S2 - DD = 3.577D0 + 1.441D0 * S - 0.683D0 * S2 + 0.179D0 * S3 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.099D0 + 0.019D0 * S + 0.002D0 * S2 - AKE = 0.419D0 - 0.013D0 * S - BKE = 1.064D0 - 0.038D0 * S - AE = -44.00D0 + 98.70D0 * S - 14.79D0 * S2 - BE = 28.59D0 - 40.94D0 * S - 13.66D0 * S2 + 2.523D0 * S3 - CE = 84.57D0 - 108.8D0 * S + 31.52D0 * S2 - DE = 7.469D0 + 2.480D0 * S - 0.866D0 * S2 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 1.215D0 - BEX = 0.466D0 - AKX = 0.326D0 + 0.150D0 * S - BKX = 0.956D0 + 0.405D0 * S - AGX = 0.272D0 - BGX = 3.794D0 - 2.359D0 * DS - CX = 2.014D0 - DX = 7.941D0 + 0.534D0 * DS - 0.940D0 * S + 0.410D0 * S2 - EX = 3.049D0 + 1.597D0 * S - ESX = 4.396D0 - 4.594D0 * DS + 3.268D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.175D0 - BES = 0.344D0 - AKS = 1.415D0 - 0.641D0 * DS - AS = 0.580D0 - 9.763D0 * DS + 6.795D0 * S - 0.558D0 * S2 - BS = 5.617D0 + 5.709D0 * DS - 3.972D0 * S - DST = 13.78D0 - 9.581D0 * S + 5.370D0 * S2 - 0.996D0 * S3 - EST = 4.546D0 + 0.372D0 * S2 - ESS = 5.053D0 - 1.070D0 * S + 0.805D0 * S2 - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.820D0 - ALC = 0.98D0 - BEC = 0D0 - AKC = -0.625D0 - 0.523D0 * S - AC = 0D0 - BC = 1.896D0 + 1.616D0 * S - DCT = 4.12D0 + 0.683D0 * S - ECT = 4.36D0 + 1.328D0 * S - ESC = 0.677D0 + 0.679D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.297D0 - ALB = 0.99D0 - BEB = 0D0 - AKB = - 0.193D0 * S - AB = 0D0 - BB = 0D0 - DBT = 3.447D0 + 0.927D0 * S - EBT = 4.68D0 + 1.259D0 * S - ESB = 1.892D0 + 2.199D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 1.258D0 - BEG = 1.846D0 - AKG = 2.423D0 - BKG = 2.427D0 + 1.311D0 * S - 0.153D0 * S2 - AG = 25.09D0 - 7.935D0 * S - BG = -14.84D0 - 124.3D0 * DS + 72.18D0 * S - CG = 590.3D0 - 173.8D0 * S - DG = 5.196D0 + 1.857D0 * S - EG = -1.648D0 + 3.988D0 * S - 0.432D0 * S2 - ESG = 3.232D0 - 0.542D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVL -C...Gives the GRV 94 L (leading order) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVL (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.23D0 - LAM2 = 0.2322D0 * 0.2322D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 2.284D0 + 0.802D0 * S + 0.055D0 * S2 - AKU = 0.590D0 - 0.024D0 * S - BKU = 0.131D0 + 0.063D0 * S - AU = -0.449D0 - 0.138D0 * S - 0.076D0 * S2 - BU = 0.213D0 + 2.669D0 * S - 0.728D0 * S2 - CU = 8.854D0 - 9.135D0 * S + 1.979D0 * S2 - DU = 2.997D0 + 0.753D0 * S - 0.076D0 * S2 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.371D0 + 0.083D0 * S + 0.039D0 * S2 - AKD = 0.376D0 - BKD = 0.486D0 + 0.062D0 * S - AD = -0.509D0 + 3.310D0 * S - 1.248D0 * S2 - BD = 12.41D0 - 10.52D0 * S + 2.267D0 * S2 - CD = 6.373D0 - 6.208D0 * S + 1.418D0 * S2 - DD = 3.691D0 + 0.799D0 * S - 0.071D0 * S2 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.082D0 + 0.014D0 * S + 0.008D0 * S2 - AKE = 0.409D0 - 0.005D0 * S - BKE = 0.799D0 + 0.071D0 * S - AE = -38.07D0 + 36.13D0 * S - 0.656D0 * S2 - BE = 90.31D0 - 74.15D0 * S + 7.645D0 * S2 - CE = 0.0D0 - DE = 7.486D0 + 1.217D0 * S - 0.159D0 * S2 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 1.451D0 - BEX = 0.271D0 - AKX = 0.410D0 - 0.232D0 * S - BKX = 0.534D0 - 0.457D0 * S - AGX = 0.890D0 - 0.140D0 * S - BGX = -0.981D0 - CX = 0.320D0 + 0.683D0 * S - DX = 4.752D0 + 1.164D0 * S + 0.286D0 * S2 - EX = 4.119D0 + 1.713D0 * S - ESX = 0.682D0 + 2.978D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.914D0 - BES = 0.577D0 - AKS = 1.798D0 - 0.596D0 * S - AS = -5.548D0 + 3.669D0 * DS - 0.616D0 * S - BS = 18.92D0 - 16.73D0 * DS + 5.168D0 * S - DST = 6.379D0 - 0.350D0 * S + 0.142D0 * S2 - EST = 3.981D0 + 1.638D0 * S - ESS = 6.402D0 - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.888D0 - ALC = 1.01D0 - BEC = 0.37D0 - AKC = 0D0 - AC = 0D0 - BC = 4.24D0 - 0.804D0 * S - DCT = 3.46D0 - 1.076D0 * S - ECT = 4.61D0 + 1.49D0 * S - ESC = 2.555D0 + 1.961D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.351D0 - ALB = 1.00D0 - BEB = 0.51D0 - AKB = 0D0 - AB = 0D0 - BB = 1.848D0 - DBT = 2.929D0 + 1.396D0 * S - EBT = 4.71D0 + 1.514D0 * S - ESB = 4.02D0 + 1.239D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 0.524D0 - BEG = 1.088D0 - AKG = 1.742D0 - 0.930D0 * S - BKG = - 0.399D0 * S2 - AG = 7.486D0 - 2.185D0 * S - BG = 16.69D0 - 22.74D0 * S + 5.779D0 * S2 - CG = -25.59D0 + 29.71D0 * S - 7.296D0 * S2 - DG = 2.792D0 + 2.215D0 * S + 0.422D0 * S2 - 0.104D0 * S3 - EG = 0.807D0 + 2.005D0 * S - ESG = 3.841D0 + 0.316D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, - & DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVM -C...Gives the GRV 94 M (MSbar) parton distribution function set -C...in parametrized form. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - SUBROUTINE PYGRVM (X, Q2, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Common expressions. - MU2 = 0.34D0 - LAM2 = 0.248D0 * 0.248D0 - S = LOG (LOG(Q2/LAM2) / LOG(MU2/LAM2)) - DS = SQRT (S) - S2 = S * S - S3 = S2 * S - -C...uv : - NU = 1.304D0 + 0.863D0 * S - AKU = 0.558D0 - 0.020D0 * S - BKU = 0.183D0 * S - AU = -0.113D0 + 0.283D0 * S - 0.321D0 * S2 - BU = 6.843D0 - 5.089D0 * S + 2.647D0 * S2 - 0.527D0 * S3 - CU = 7.771D0 - 10.09D0 * S + 2.630D0 * S2 - DU = 3.315D0 + 1.145D0 * S - 0.583D0 * S2 + 0.154D0 * S3 - UV = PYGRVV (X, NU, AKU, BKU, AU, BU, CU, DU) - -C...dv : - ND = 0.102D0 - 0.017D0 * S + 0.005D0 * S2 - AKD = 0.270D0 - 0.019D0 * S - BKD = 0.260D0 - AD = 2.393D0 + 6.228D0 * S - 0.881D0 * S2 - BD = 46.06D0 + 4.673D0 * S - 14.98D0 * S2 + 1.331D0 * S3 - CD = 17.83D0 - 53.47D0 * S + 21.24D0 * S2 - DD = 4.081D0 + 0.976D0 * S - 0.485D0 * S2 + 0.152D0 * S3 - DV = PYGRVV (X, ND, AKD, BKD, AD, BD, CD, DD) - -C...del : - NE = 0.070D0 + 0.042D0 * S - 0.011D0 * S2 + 0.004D0 * S3 - AKE = 0.409D0 - 0.007D0 * S - BKE = 0.782D0 + 0.082D0 * S - AE = -29.65D0 + 26.49D0 * S + 5.429D0 * S2 - BE = 90.20D0 - 74.97D0 * S + 4.526D0 * S2 - CE = 0.0D0 - DE = 8.122D0 + 2.120D0 * S - 1.088D0 * S2 + 0.231D0 * S3 - DEL = PYGRVV (X, NE, AKE, BKE, AE, BE, CE, DE) - -C...udb : - ALX = 0.877D0 - BEX = 0.561D0 - AKX = 0.275D0 - BKX = 0.0D0 - AGX = 0.997D0 - BGX = 3.210D0 - 1.866D0 * S - CX = 7.300D0 - DX = 9.010D0 + 0.896D0 * DS + 0.222D0 * S2 - EX = 3.077D0 + 1.446D0 * S - ESX = 3.173D0 - 2.445D0 * DS + 2.207D0 * S - UDB = PYGRVW (X, S, ALX, BEX, AKX, BKX, AGX, BGX, CX, - & DX, EX, ESX) - -C...sb : - STS = 0D0 - ALS = 0.756D0 - BES = 0.216D0 - AKS = 1.690D0 + 0.650D0 * DS - 0.922D0 * S - AS = -4.329D0 + 1.131D0 * S - BS = 9.568D0 - 1.744D0 * S - DST = 9.377D0 + 1.088D0 * DS - 1.320D0 * S + 0.130D0 * S2 - EST = 3.031D0 + 1.639D0 * S - ESS = 5.837D0 + 0.815D0 * S - SB = PYGRVS (X, S, STS, ALS, BES, AKS, AS, BS, DST, EST, ESS) - -C...cb : - STC = 0.820D0 - ALC = 0.98D0 - BEC = 0D0 - AKC = -0.625D0 - 0.523D0 * S - AC = 0D0 - BC = 1.896D0 + 1.616D0 * S - DCT = 4.12D0 + 0.683D0 * S - ECT = 4.36D0 + 1.328D0 * S - ESC = 0.677D0 + 0.679D0 * S - CHM = PYGRVS (X, S, STC, ALC, BEC, AKC, AC, BC, DCT, ECT, ESC) - -C...bb : - STB = 1.297D0 - ALB = 0.99D0 - BEB = 0D0 - AKB = - 0.193D0 * S - AB = 0D0 - BB = 0D0 - DBT = 3.447D0 + 0.927D0 * S - EBT = 4.68D0 + 1.259D0 * S - ESB = 1.892D0 + 2.199D0 * S - BOT = PYGRVS (X, S, STB, ALB, BEB, AKB, AB, BB, DBT, EBT, ESB) - -C...gl : - ALG = 1.014D0 - BEG = 1.738D0 - AKG = 1.724D0 + 0.157D0 * S - BKG = 0.800D0 + 1.016D0 * S - AG = 7.517D0 - 2.547D0 * S - BG = 34.09D0 - 52.21D0 * DS + 17.47D0 * S - CG = 4.039D0 + 1.491D0 * S - DG = 3.404D0 + 0.830D0 * S - EG = -1.112D0 + 3.438D0 * S - 0.302D0 * S2 - ESG = 3.256D0 - 0.436D0 * S - GL = PYGRVW (X, S, ALG, BEG, AKG, BKG, AG, BG, CG, DG, EG, ESG) - - RETURN - END - -C********************************************************************* - -C...PYGRVS -C...Auxiliary for the GRV 94 parton distribution functions -C...for s, c and b sea. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVS (X, S, STH, AL, BE, AK, AG, B, D, E, ES) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - IF(S.LE.STH) THEN - PYGRVS = 0D0 - ELSE - DX = SQRT (X) - LX = LOG (1D0/X) - PYGRVS = (S - STH)**AL / LX**AK * (1D0+ AG*DX + B*X) * - & (1D0- X)**D * EXP (-E + SQRT (ES * S**BE * LX)) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYGRVV -C...Auxiliary for the GRV 94 parton distribution functions -C...for u and d valence and d-u sea. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVV (X, N, AK, BK, A, B, C, D) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - DX = SQRT (X) - PYGRVV = N * X**AK * (1D0+ A*X**BK + X * (B + C*DX)) * - & (1D0- X)**D - - RETURN - END - -C********************************************************************* - -C...PYGRVW -C...Auxiliary for the GRV 94 parton distribution functions -C...for d+u sea and gluon. -C...Authors: M. Glueck, E. Reya and A. Vogt. - - FUNCTION PYGRVW (X, S, AL, BE, AK, BK, A, B, C, D, E, ES) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION (A - Z) - -C...Evaluation. - LX = LOG (1D0/X) - PYGRVW = (X**AK * (A + X * (B + X*C)) * LX**BK + S**AL - & * EXP (-E + SQRT (ES * S**BE * LX))) * (1D0- X)**D - - RETURN - END - -C********************************************************************* - -C...PYGVMD -C...Evaluates the VMD parton distributions of a photon, -C...evolved homogeneously from an initial scale P2 to Q2. -C...Does not include dipole suppression factor. -C...ISET is parton distribution set, see above; -C...additionally ISET=0 is used for the evolution of an anomalous photon -C...which branched at a scale P2 and then evolved homogeneously to Q2. -C...ALAM is the 4-flavour Lambda, which is automatically converted -C...to 3- and 5-flavour equivalents as needed. -C...Adapted from SaSgam library, authors G.A. Schuler and T. Sjostrand. - - SUBROUTINE PYGVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Local arrays and data. - DIMENSION XPGA(-6:6), VXPGA(-6:6) - DATA PMC/1.3D0/, PMB/4.6D0/, AEM/0.007297D0/, AEM2PI/0.0011614D0/ - -C...Reset output. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - VXPGA(KFL)=0D0 - 100 CONTINUE - KFA=IABS(KF) - -C...Calculate Lambda; protect against unphysical Q2 and P2 input. - ALAM3=ALAM*(PMC/ALAM)**(2D0/27D0) - ALAM5=ALAM*(ALAM/PMB)**(2D0/23D0) - P2EFF=MAX(P2,1.2D0*ALAM3**2) - IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2) - IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2) - Q2EFF=MAX(Q2,P2EFF) - -C...Find number of flavours at lower and upper scale. - NFP=4 - IF(P2EFF.LT.PMC**2) NFP=3 - IF(P2EFF.GT.PMB**2) NFP=5 - NFQ=4 - IF(Q2EFF.LT.PMC**2) NFQ=3 - IF(Q2EFF.GT.PMB**2) NFQ=5 - -C...Find s as sum of 3-, 4- and 5-flavour parts. - S=0D0 - IF(NFP.EQ.3) THEN - Q2DIV=PMC**2 - IF(NFQ.EQ.3) Q2DIV=Q2EFF - S=S+(6D0/27D0)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2)) - ENDIF - IF(NFP.LE.4.AND.NFQ.GE.4) THEN - P2DIV=P2EFF - IF(NFP.EQ.3) P2DIV=PMC**2 - Q2DIV=Q2EFF - IF(NFQ.EQ.5) Q2DIV=PMB**2 - S=S+(6D0/25D0)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2)) - ENDIF - IF(NFQ.EQ.5) THEN - P2DIV=PMB**2 - IF(NFP.EQ.5) P2DIV=P2EFF - S=S+(6D0/23D0)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2)) - ENDIF - -C...Calculate frequent combinations of x and s. - X1=1D0-X - XL=-LOG(X) - S2=S**2 - S3=S**3 - S4=S**4 - -C...Evaluate homogeneous anomalous parton distributions below or -C...above threshold. - IF(ISET.EQ.0) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = X * 1.5D0 * (X**2+X1**2) - XGLU = 0D0 - XSEA = 0D0 - ELSE - XVAL = (1.5D0/(1D0-0.197D0*S+4.33D0*S2)*X**2 + - & (1.5D0+2.10D0*S)/(1D0+3.29D0*S)*X1**2 + - & 5.23D0*S/(1D0+1.17D0*S+19.9D0*S3)*X*X1) * - & X**(1D0/(1D0+1.5D0*S)) * (1D0-X**2)**(2.667D0*S) - XGLU = 4D0*S/(1D0+4.76D0*S+15.2D0*S2+29.3D0*S4) * - & X**(-2.03D0*S/(1D0+2.44D0*S)) * (X1*XL)**(1.333D0*S) * - & ((4D0*X**2+7D0*X+4D0)*X1/3D0 - 2D0*X*(1D0+X)*XL) - XSEA = S2/(1D0+4.54D0*S+8.19D0*S2+8.05D0*S3) * - & X**(-1.54D0*S/(1D0+1.29D0*S)) * X1**(2.667D0*S) * - & ((8D0-73D0*X+62D0*X**2)*X1/9D0 + (3D0-8D0*X**2/3D0)*X*XL + - & (2D0*X-1D0)*X*XL**2) - ENDIF - -C...Evaluate set 1D parton distributions below or above threshold. - ELSEIF(ISET.EQ.1) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 1.294D0 * X**0.80D0 * X1**0.76D0 - XGLU = 1.273D0 * X**0.40D0 * X1**1.76D0 - XSEA = 0.100D0 * X1**3.76D0 - ELSE - XVAL = 1.294D0/(1D0+0.252D0*S+3.079D0*S2) * - & X**(0.80D0-0.13D0*S) * X1**(0.76D0+0.667D0*S) * XL**(2D0*S) - XGLU = 7.90D0*S/(1D0+5.50D0*S) * EXP(-5.16D0*S) * - & X**(-1.90D0*S/(1D0+3.60D0*S)) * X1**1.30D0 * - & XL**(0.50D0+3D0*S) + 1.273D0 * EXP(-10D0*S) * - & X**0.40D0 * X1**(1.76D0+3D0*S) - XSEA = (0.1D0-0.397D0*S2+1.121D0*S3)/ - & (1D0+5.61D0*S2+5.26D0*S3) * X**(-7.32D0*S2/(1D0+10.3D0*S2)) * - & X1**((3.76D0+15D0*S+12D0*S2)/(1D0+4D0*S)) - XSEA0 = 0.100D0 * X1**3.76D0 - ENDIF - -C...Evaluate set 1M parton distributions below or above threshold. - ELSEIF(ISET.EQ.2) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 0.8477D0 * X**0.51D0 * X1**1.37D0 - XGLU = 3.42D0 * X**0.255D0 * X1**2.37D0 - XSEA = 0D0 - ELSE - XVAL = 0.8477D0/(1D0+1.37D0*S+2.18D0*S2+3.73D0*S3) * - & X**(0.51D0+0.21D0*S) * X1**1.37D0 * XL**(2.667D0*S) - XGLU = 24D0*S/(1D0+9.6D0*S+0.92D0*S2+14.34D0*S3) * - & EXP(-5.94D0*S) * X**((-0.013D0-1.80D0*S)/(1D0+3.14D0*S)) * - & X1**(2.37D0+0.4D0*S) * XL**(0.32D0+3.6D0*S) + 3.42D0 * - & EXP(-12D0*S) * X**0.255D0 * X1**(2.37D0+3D0*S) - XSEA = 0.842D0*S/(1D0+21.3D0*S-33.2D0*S2+229D0*S3) * - & X**((0.13D0-2.90D0*S)/(1D0+5.44D0*S)) * X1**(3.45D0+0.5D0*S) * - & XL**(2.8D0*S) - XSEA0 = 0D0 - ENDIF - -C...Evaluate set 2D parton distributions below or above threshold. - ELSEIF(ISET.EQ.3) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = X**0.46D0 * X1**0.64D0 + 0.76D0 * X - XGLU = 1.925D0 * X1**2 - XSEA = 0.242D0 * X1**4 - ELSE - XVAL = (1D0+0.186D0*S)/(1D0-0.209D0*S+1.495D0*S2) * - & X**(0.46D0+0.25D0*S) * - & X1**((0.64D0+0.14D0*S+5D0*S2)/(1D0+S)) * XL**(1.9D0*S) + - & (0.76D0+0.4D0*S) * X * X1**(2.667D0*S) - XGLU = (1.925D0+5.55D0*S+147D0*S2)/(1D0-3.59D0*S+3.32D0*S2) * - & EXP(-18.67D0*S) * - & X**((-5.81D0*S-5.34D0*S2)/(1D0+29D0*S-4.26D0*S2)) - & * X1**((2D0-5.9D0*S)/(1D0+1.7D0*S)) * - & XL**(9.3D0*S/(1D0+1.7D0*S)) - XSEA = (0.242D0-0.252D0*S+1.19D0*S2)/ - & (1D0-0.607D0*S+21.95D0*S2) * - & X**(-12.1D0*S2/(1D0+2.62D0*S+16.7D0*S2)) * X1**4 * XL**S - XSEA0 = 0.242D0 * X1**4 - ENDIF - -C...Evaluate set 2M parton distributions below or above threshold. - ELSEIF(ISET.EQ.4) THEN - IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR. - & (KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN - XVAL = 1.168D0 * X**0.50D0 * X1**2.60D0 + 0.965D0 * X - XGLU = 1.808D0 * X1**2 - XSEA = 0.209D0 * X1**4 - ELSE - XVAL = (1.168D0+1.771D0*S+29.35D0*S2) * EXP(-5.776D0*S) * - & X**((0.5D0+0.208D0*S)/(1D0-0.794D0*S+1.516D0*S2)) * - & X1**((2.6D0+7.6D0*S)/(1D0+5D0*S)) * - & XL**(5.15D0*S/(1D0+2D0*S)) + - & (0.965D0+22.35D0*S)/(1D0+18.4D0*S) * X * X1**(2.667D0*S) - XGLU = (1.808D0+29.9D0*S)/(1D0+26.4D0*S) * EXP(-5.28D0*S) * - & X**((-5.35D0*S-10.11D0*S2)/(1D0+31.71D0*S)) * - & X1**((2D0-7.3D0*S+4D0*S2)/(1D0+2.5D0*S)) * - & XL**(10.9D0*S/(1D0+2.5D0*S)) - XSEA = (0.209D0+0.644D0*S2)/(1D0+0.319D0*S+17.6D0*S2) * - & X**((-0.373D0*S-7.71D0*S2)/(1D0+0.815D0*S+11.0D0*S2)) * - & X1**(4D0+S) * XL**(0.45D0*S) - XSEA0 = 0.209D0 * X1**4 - ENDIF - ENDIF - -C...Threshold factors for c and b sea. - SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2)) - XCHM=0D0 - IF(Q2.GT.PMC**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SCH=MAX(0D0,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - IF(ISET.EQ.0) THEN - XCHM=XSEA*(1D0-(SCH/SLL)**2) - ELSE - XCHM=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SCH/SLL) - ENDIF - ENDIF - XBOT=0D0 - IF(Q2.GT.PMB**2.AND.Q2.GT.1.001D0*P2EFF) THEN - SBT=MAX(0D0,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2))) - IF(ISET.EQ.0) THEN - XBOT=XSEA*(1D0-(SBT/SLL)**2) - ELSE - XBOT=MAX(0D0,XSEA-XSEA0*X1**(2.667D0*S))*(1D0-SBT/SLL) - ENDIF - ENDIF - -C...Fill parton distributions. - XPGA(0)=XGLU - XPGA(1)=XSEA - XPGA(2)=XSEA - XPGA(3)=XSEA - XPGA(4)=XCHM - XPGA(5)=XBOT - XPGA(KFA)=XPGA(KFA)+XVAL - DO 110 KFL=1,5 - XPGA(-KFL)=XPGA(KFL) - 110 CONTINUE - VXPGA(KFA)=XVAL - VXPGA(-KFA)=XVAL - - RETURN - END - -C********************************************************************* - -C...PYH2XX -C...Calculates the decay rate for a Higgs to an ino pair. - - FUNCTION PYH2XX(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Local variables. - DOUBLE PRECISION PYH2XX,XM1,XM2,XM3,GL,GR - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMK2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMK2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMK2) - PYH2XX=C1/4D0/XMI3*SQRT(XL) - &*(GX2*(XMI2-XMJ2-XMK2)- - &4D0*GLR*XM3*XM2) - IF(PYH2XX.LT.0D0) THEN - WRITE(MSTU(11),*) ' NEGATIVE WIDTH IN PYH2XX ' - WRITE(MSTU(11),*) XMI2,XMJ2,XMK2,GX2,GLR,XM1,XM2,XM3 - STOP - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYHEPC -C...Converts PYTHIA event record contents to or from -C...the standard event record commonblock. - - SUBROUTINE PYHEPC(MCONV) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...HEPEVT commonblock. - PARAMETER (NMXHEP=4000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) - DOUBLE PRECISION PHEP,VHEP - SAVE /HEPEVT/ - -C...Conversion from PYTHIA to standard, the easy part. - IF(MCONV.EQ.1) THEN - NEVHEP=0 - IF(N.GT.NMXHEP) CALL PYERRM(8, - & '(PYHEPC:) no more space in /HEPEVT/') - NHEP=MIN(N,NMXHEP) - DO 150 I=1,NHEP - ISTHEP(I)=0 - IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 - IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 - IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 - IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) - IDHEP(I)=K(I,2) - JMOHEP(1,I)=K(I,3) - JMOHEP(2,I)=0 - IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN - JDAHEP(1,I)=K(I,4) - JDAHEP(2,I)=K(I,5) - ELSE - JDAHEP(1,I)=0 - JDAHEP(2,I)=0 - ENDIF - DO 100 J=1,5 - PHEP(J,I)=P(I,J) - 100 CONTINUE - DO 110 J=1,4 - VHEP(J,I)=V(I,J) - 110 CONTINUE - -C...Check if new event (from pileup). - IF(I.EQ.1) THEN - INEW=1 - ELSE - IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I - ENDIF - -C...Fill in missing mother information. - IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN - IMO1=I-2 - 120 IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0) - & THEN - IMO1=IMO1-1 - GOTO 120 - ENDIF - JMOHEP(1,I)=IMO1 - JMOHEP(2,I)=IMO1+1 - ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN - I1=K(I,3)-1 - 130 I1=I1+1 - IF(I1.GE.I) CALL PYERRM(8, - & '(PYHEPC:) translation of inconsistent event history') - IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130 - KC=PYCOMP(K(I1,2)) - IF(I1.LT.I.AND.KC.EQ.0) GOTO 130 - IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130 - JMOHEP(2,I)=I1 - ELSEIF(K(I,2).EQ.94) THEN - NJET=2 - IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 - IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 - JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) - IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= - & MOD(K(I+1,4)/MSTU(5),MSTU(5)) - ENDIF - -C...Fill in missing daughter information. - IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN - DO 140 I1=JDAHEP(1,I),JDAHEP(2,I) - I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) - JDAHEP(1,I2)=I - 140 CONTINUE - ENDIF - IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150 - I1=JMOHEP(1,I) - IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150 - IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150 - IF(JDAHEP(1,I1).EQ.0) THEN - JDAHEP(1,I1)=I - ELSE - JDAHEP(2,I1)=I - ENDIF - 150 CONTINUE - DO 160 I=1,NHEP - IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160 - IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) - 160 CONTINUE - -C...Conversion from standard to PYTHIA, the easy part. - ELSE - IF(NHEP.GT.MSTU(4)) CALL PYERRM(8, - & '(PYHEPC:) no more space in /PYJETS/') - N=MIN(NHEP,MSTU(4)) - NKQ=0 - KQSUM=0 - DO 190 I=1,N - K(I,1)=0 - IF(ISTHEP(I).EQ.1) K(I,1)=1 - IF(ISTHEP(I).EQ.2) K(I,1)=11 - IF(ISTHEP(I).EQ.3) K(I,1)=21 - K(I,2)=IDHEP(I) - K(I,3)=JMOHEP(1,I) - K(I,4)=JDAHEP(1,I) - K(I,5)=JDAHEP(2,I) - DO 170 J=1,5 - P(I,J)=PHEP(J,I) - 170 CONTINUE - DO 180 J=1,4 - V(I,J)=VHEP(J,I) - 180 CONTINUE - V(I,5)=0D0 - IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN - I1=JDAHEP(1,I) - IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* - & PHEP(5,I)/PHEP(4,I) - ENDIF - -C...Fill in missing information on colour connection in jet systems. - IF(ISTHEP(I).EQ.1) THEN - KC=PYCOMP(K(I,2)) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.NE.0) NKQ=NKQ+1 - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(KQ.NE.0.AND.KQSUM.NE.0) THEN - K(I,1)=2 - ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN - IF(K(I+1,2).EQ.21) K(I,1)=2 - ENDIF - ENDIF - 190 CONTINUE - IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8, - & '(PYHEPC:) input parton configuration not colour singlet') - ENDIF - - END - -C********************************************************************* - -C...PYHEXT -C...Calculates the non-standard decay modes of the Higgs boson. -C... -C...Author: Stephen Mrenna -C...Last Update: April 2001 -C......Allow complex values for Z,U, and V - - SUBROUTINE PYHEXT(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP - COMPLEX*16 QIJ,RIJ,F21K,F12K - INTEGER KFIN - DOUBLE PRECISION XMI,XMJ,XMF,XMW,XMW2,XMZ,AXMJ,AXMI - DOUBLE PRECISION XMI2,XMI3,XMJ2 - DOUBLE PRECISION PYLAMF,XL,CF,EI - INTEGER IDU,IFL - DOUBLE PRECISION TANW,XW,AEM,C1,AS - DOUBLE PRECISION PYH2XX,GHLL,GHRR,GHLR - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IH,J,IJ,I,IKNT,IK - INTEGER ITH(4) - INTEGER KFNCHI(4),KFCCHI(2) - DOUBLE PRECISION ETAH(3),CH(3),DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION BETA,ALFA - DOUBLE PRECISION CBETA,SBETA,GR,GL,TANB - DOUBLE PRECISION PYALEM - DOUBLE PRECISION AL,AR,ALR - DOUBLE PRECISION XMK,AXMK,COSA,SINA,CW,XML - DOUBLE PRECISION XMUZ,ATRIT,ATRIB,ATRIL - DOUBLE PRECISION XMJL,XMJR,XM1,XM2 - DATA ITH/25,35,36,37/ - DATA ETAH/1D0,1D0,-1D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=IKNT - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - CW=SQRT(1D0-XW) - -C...1 - 4 DEPENDING ON Higgs species. - IH=1 - IF(KFIN.EQ.ITH(2)) IH=2 - IF(KFIN.EQ.ITH(3)) IH=3 - IF(KFIN.EQ.ITH(4)) IH=4 - - XMI=PMAS(KFIN,1) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - - TANB=RMSS(5) - BETA=ATAN(TANB) - CBETA=COS(BETA) - SBETA=TANB*CBETA - ALFA=RMSS(18) - COSA=COS(ALFA) - SINA=SIN(ALFA) - ATRIT=RMSS(16) - ATRIB=RMSS(15) - ATRIL=RMSS(17) - XMUZ=-RMSS(4) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - - - IF(IH.EQ.4) GOTO 220 - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS -C...H0_K -> CHI0_I + CHI0_J - EH(2)=SINA - EH(1)=COSA - EH(3)=CBETA - DH(2)=COSA - DH(1)=-SINA - DH(3)=SBETA - DO 150 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - DO 140 IK=1,IJ - XMK=SMZ(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - QIJ=ZMIXC(IK,3)*ZMIXC(IJ,2)+ - & ZMIXC(IJ,3)*ZMIXC(IK,2)- - & TANW*(ZMIXC(IK,3)*ZMIXC(IJ,1)+ - & ZMIXC(IJ,3)*ZMIXC(IK,1)) - RIJ=ZMIXC(IK,4)*ZMIXC(IJ,2)+ - & ZMIXC(IJ,4)*ZMIXC(IK,2)- - & TANW*(ZMIXC(IK,4)*ZMIXC(IJ,1)+ - & ZMIXC(IJ,4)*ZMIXC(IK,1)) - F21K=0.5D0*DCONJG(QIJ*DH(IH)-RIJ*EH(IH)) - F12K=0.5D0*(QIJ*DH(IH)-RIJ*EH(IH)) -C...SIGN OF MASSES I,J - XML=XMK*ETAH(IH) - GX2=ABS(F12K)**2+ABS(F21K)**2 - GLR=DBLE(F12K*DCONJG(F21K)) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) - IF(IJ.EQ.IK) XLAM(LKNT)=XLAM(LKNT)*0.5D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=KFNCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 140 CONTINUE - 150 CONTINUE - -C...H0_K -> CHI+_I CHI-_J - DO 170 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - DO 160 IK=1,2 - XMK=SMW(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - OLPP=DCONJG(VMIXC(IJ,1)*UMIXC(IK,2)*DH(IH) + - & VMIXC(IJ,2)*UMIXC(IK,1)*EH(IH))/SR2 - ORPP=(VMIXC(IK,1)*UMIXC(IJ,2)*DH(IH) + - & VMIXC(IK,2)*UMIXC(IJ,1)*EH(IH))/SR2 - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XML=XMK*ETAH(IH) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,XML,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-KFCCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 160 CONTINUE - 170 CONTINUE - -C...HIGGS TO SFERMION SFERMION - DO 200 IFL=1,16 - IF(IFL.GE.7.AND.IFL.LE.10) GOTO 200 - IJ=KSUSY1+IFL - XMJL=PMAS(PYCOMP(IJ),1) - XMJR=PMAS(PYCOMP(IJ+KSUSY1),1) - IF(AXMI.GE.2D0*MIN(XMJL,XMJR)) THEN - XMJ=XMJL - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJ2) - XMF=PMAS(IFL,1) - EI=KCHG(IFL,1)/3D0 - IDU=2-MOD(IFL,2) - - IF(IH.EQ.1) THEN - IF(IDU.EQ.1) THEN - GHLL=-XMZ/CW*(0.5D0+EI*XW)*SIN(ALFA+BETA)+ - & XMF**2/XMW*SINA/CBETA - GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)+ - & XMF**2/XMW*SINA/CBETA - IF(IFL.EQ.5) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- - & ATRIB*SINA) - ELSEIF(IFL.EQ.15) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*COSA- - & ATRIL*SINA) - ELSE - GHLR=0D0 - ENDIF - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*SIN(ALFA+BETA)- - & XMF**2/XMW*COSA/SBETA - GHRR=XMZ/CW*(EI*XW)*SIN(ALFA+BETA)- - & XMF**2/XMW*COSA/SBETA - IF(IFL.EQ.6) THEN - GHLR=XMF/2D0/XMW/SBETA*(XMUZ*SINA- - & ATRIT*COSA) - ELSE - GHLR=0D0 - ENDIF - ENDIF - - ELSEIF(IH.EQ.2) THEN - IF(IDU.EQ.1) THEN - GHLL=XMZ/CW*(0.5D0+EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*COSA/CBETA - GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*COSA/CBETA - IF(IFL.EQ.5) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ - & ATRIB*COSA) - ELSEIF(IFL.EQ.15) THEN - GHLR=-XMF/2D0/XMW/CBETA*(XMUZ*SINA+ - & ATRIL*COSA) - ELSE - GHLR=0D0 - ENDIF - ELSE - GHLL=-XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*SINA/SBETA - GHRR=-XMZ/CW*(EI*XW)*COS(ALFA+BETA)- - & XMF**2/XMW*SINA/SBETA - IF(IFL.EQ.6) THEN - GHLR=-XMF/2D0/XMW/SBETA*(XMUZ*COSA+ - & ATRIT*SINA) - ELSE - GHLR=0D0 - ENDIF - ENDIF - - ELSEIF(IH.EQ.3) THEN - GHLL=0D0 - GHRR=0D0 - GHLR=0D0 - IF(IDU.EQ.1) THEN - IF(IFL.EQ.5) THEN - GHLR=XMF/2D0/XMW*(ATRIB*TANB-XMUZ) - ELSEIF(IFL.EQ.15) THEN - GHLR=XMF/2D0/XMW*(ATRIL*TANB-XMUZ) - ENDIF - ELSE - IF(IFL.EQ.6) THEN - GHLR=XMF/2D0/XMW*(ATRIT/TANB-XMUZ) - ENDIF - ENDIF - ENDIF - IF(IH.EQ.3) GOTO 180 - - AL=SFMIX(IFL,1)**2 - AR=SFMIX(IFL,2)**2 - ALR=SFMIX(IFL,1)*SFMIX(IFL,2) - IF(IFL.LE.6) THEN - CF=3D0 - ELSE - CF=1D0 - ENDIF - - IF(AXMI.GE.2D0*XMJ) THEN - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR - & +2D0*GHLR*ALR)**2 - IDLAM(LKNT,1)=IJ - IDLAM(LKNT,2)=-IJ - IDLAM(LKNT,3)=0 - ENDIF - - IF(AXMI.GE.2D0*XMJR) THEN - LKNT=LKNT+1 - AL=SFMIX(IFL,3)**2 - AR=SFMIX(IFL,4)**2 - ALR=SFMIX(IFL,3)*SFMIX(IFL,4) - XMJ=XMJR - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJ2) - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR - & +2D0*GHLR*ALR)**2 - IDLAM(LKNT,1)=IJ+KSUSY1 - IDLAM(LKNT,2)=-(IJ+KSUSY1) - IDLAM(LKNT,3)=0 - ENDIF - 180 CONTINUE - - IF(AXMI.GE.XMJL+XMJR) THEN - LKNT=LKNT+1 - AL=SFMIX(IFL,1)*SFMIX(IFL,3) - AR=SFMIX(IFL,2)*SFMIX(IFL,4) - ALR=SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,2)*SFMIX(IFL,3) - XMJ=XMJR - XMJ2=XMJ**2 - XL=PYLAMF(XMI2,XMJ2,XMJL**2) - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GHLL*AL+GHRR*AR)**2 - IDLAM(LKNT,1)=IJ - IDLAM(LKNT,2)=-(IJ+KSUSY1) - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IJ - IDLAM(LKNT,2)=IJ+KSUSY1 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XLAM(LKNT-1) - ENDIF - ENDIF - 190 CONTINUE - 200 CONTINUE - 210 CONTINUE - - GOTO 270 - 220 CONTINUE - -C...H+ -> CHI+_I + CHI0_J - DO 240 IJ=1,4 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - DO 230 IK=1,2 - XMK=SMW(IK) - AXMK=ABS(XMK) - IF(AXMI.GE.AXMJ+AXMK) THEN - LKNT=LKNT+1 - OLPP=CBETA*DCONJG(ZMIXC(IJ,4)*VMIXC(IK,1)+(ZMIXC(IJ,2)+ - & ZMIXC(IJ,1)*TANW)*VMIXC(IK,2)/SR2) - ORPP=SBETA*(ZMIXC(IJ,3)*UMIXC(IK,1)- - & (ZMIXC(IJ,2)+ZMIXC(IJ,1)*TANW)*UMIXC(IK,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYH2XX(C1,XMI,XMJ,-XMK,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=KFCCHI(IK) - IDLAM(LKNT,3)=0 - ENDIF - 230 CONTINUE - 240 CONTINUE - - GL=-XMW/SR2*(SIN(2D0*BETA)-PMAS(6,1)**2/TANB/XMW2) - GR=-PMAS(6,1)/SR2/XMW*(XMUZ-ATRIT/TANB) - AL=0D0 - AR=0D0 - CF=3D0 - -C...H+ -> T_1 B_1~ - XM1=PMAS(PYCOMP(KSUSY1+6),1) - XM2=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,1)*SFMIX(5,1)+GR*SFMIX(6,2)*SFMIX(5,1))**2 - IDLAM(LKNT,1)=KSUSY1+6 - IDLAM(LKNT,2)=-(KSUSY1+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_2 B_1~ - XM1=PMAS(PYCOMP(KSUSY2+6),1) - XM2=PMAS(PYCOMP(KSUSY1+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,3)*SFMIX(5,1)+GR*SFMIX(6,4)*SFMIX(5,1))**2 - IDLAM(LKNT,1)=KSUSY2+6 - IDLAM(LKNT,2)=-(KSUSY1+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_1 B_2~ - XM1=PMAS(PYCOMP(KSUSY1+6),1) - XM2=PMAS(PYCOMP(KSUSY2+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,1)*SFMIX(5,3)+GR*SFMIX(6,2)*SFMIX(5,3))**2 - IDLAM(LKNT,1)=KSUSY1+6 - IDLAM(LKNT,2)=-(KSUSY2+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> T_2 B_2~ - XM1=PMAS(PYCOMP(KSUSY2+6),1) - XM2=PMAS(PYCOMP(KSUSY2+5),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3* - & (GL*SFMIX(6,3)*SFMIX(5,3)+GR*SFMIX(6,4)*SFMIX(5,3))**2 - IDLAM(LKNT,1)=KSUSY2+6 - IDLAM(LKNT,2)=-(KSUSY2+5) - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> UL DL~ - GL=-XMW/SR2*SIN(2D0*BETA) - DO 250 IJ=1,3,2 - XM1=PMAS(PYCOMP(KSUSY1+IJ),1) - XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 - IDLAM(LKNT,1)=-(KSUSY1+IJ) - IDLAM(LKNT,2)=KSUSY1+IJ+1 - IDLAM(LKNT,3)=0 - ENDIF - 250 CONTINUE - -C...H+ -> EL~ NUL - CF=1D0 - DO 260 IJ=11,13,2 - XM1=PMAS(PYCOMP(KSUSY1+IJ),1) - XM2=PMAS(PYCOMP(KSUSY1+IJ+1),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2 - IDLAM(LKNT,1)=-(KSUSY1+IJ) - IDLAM(LKNT,2)=KSUSY1+IJ+1 - IDLAM(LKNT,3)=0 - ENDIF - 260 CONTINUE - -C...H+ -> TAU1 NUTAUL - XM1=PMAS(PYCOMP(KSUSY1+15),1) - XM2=PMAS(PYCOMP(KSUSY1+16),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,1)**2 - IDLAM(LKNT,1)=-(KSUSY1+15) - IDLAM(LKNT,2)= KSUSY1+16 - IDLAM(LKNT,3)=0 - ENDIF - -C...H+ -> TAU2 NUTAUL - XM1=PMAS(PYCOMP(KSUSY2+15),1) - XM2=PMAS(PYCOMP(KSUSY1+16),1) - IF(XMI.GE.XM1+XM2) THEN - XL=PYLAMF(XMI2,XM1**2,XM2**2) - LKNT=LKNT+1 - XLAM(LKNT)=CF*SQRT(XL)/4D0*C1/XMI3*GL**2*SFMIX(15,3)**2 - IDLAM(LKNT,1)=-(KSUSY2+15) - IDLAM(LKNT,2)= KSUSY1+16 - IDLAM(LKNT,3)=0 - ENDIF - - 270 CONTINUE - IKNT=LKNT - XLAM(0)=0D0 - DO 280 I=1,IKNT - IF(XLAM(I).LE.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 280 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYHFTH -C...Gives threshold attractive/repulsive factor for heavy flavour -C...production. - - FUNCTION PYHFTH(SH,SQM,FRATT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ - -C...Value for alpha_strong. - IF(MSTP(35).LE.1) THEN - ALSSG=PARP(35) - ELSE - MST115=MSTU(115) - MSTU(115)=MSTP(36) - Q2BN=SQRT(MAX(1D0,SQM*((SQRT(SH)-2D0*SQRT(SQM))**2+ - & PARP(36)**2))) - ALSSG=PYALPS(Q2BN) - MSTU(115)=MST115 - ENDIF - -C...Evaluate attractive and repulsive factors. - XATTR=4D0*PARU(1)*ALSSG/(3D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) - FATTR=XATTR/(1D0-EXP(-MIN(50D0,XATTR))) - XREPU=PARU(1)*ALSSG/(6D0*SQRT(MAX(1D-20,1D0-4D0*SQM/SH))) - FREPU=XREPU/(EXP(MIN(50D0,XREPU))-1D0) - PYHFTH=FRATT*FATTR+(1D0-FRATT)*FREPU - VINT(138)=PYHFTH - - RETURN - END - -C********************************************************************* - -C...PYHGGM -C...Determines the Higgs boson mass spectrum using several inputs. - - SUBROUTINE PYHGGM(ALPHA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYMSSM/ - -C...Local variables. - DOUBLE PRECISION AT,AB,XMU,TANB - DOUBLE PRECISION ALPHA - INTEGER IHOPT - DOUBLE PRECISION DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD - DOUBLE PRECISION DMU,DMH,DHM,DMHCH,DSA,DCA,DTANBA - DOUBLE PRECISION DMC,DMDR,DMHP,DHMP,DAMP - DOUBLE PRECISION DSTOP1,DSTOP2,DSBOT1,DSBOT2 - - IHOPT=IMSS(4) - IF(IHOPT.EQ.2) THEN - ALPHA=RMSS(18) - RETURN - ENDIF - AT=RMSS(16) - AB=RMSS(15) - DMGL=RMSS(3) - XMU=RMSS(4) - TANB=RMSS(5) - - DMA=RMSS(19) - DTANB=TANB - DMQ=RMSS(10) - DMUR=RMSS(12) - DMDR=RMSS(11) - DMTOP=PMAS(6,1) - DMC=PMAS(PYCOMP(KSUSY1+37),1) - DAU=AT - DAD=AB - DMU=XMU - RMSS(40)=0D0 - RMSS(41)=0D0 - - IF(IHOPT.EQ.0) THEN - CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, - & DMHCH,DSA,DCA,DTANBA) - ELSEIF(IHOPT.EQ.1) THEN - CALL PYSUBH (DMA,DTANB,DMQ,DMUR,DMTOP,DAU,DAD,DMU,DMH,DHM, - & DMHCH,DSA,DCA,DTANBA) - CALL PYPOLE(3,DMC,DMA,DTANB,DMQ,DMUR,DMDR,DMTOP,DAU,DAD,DMU, - & DMH,DMHP,DHM,DHMP,DAMP,DSA,DCA, - & DSTOP1,DSTOP2,DSBOT1,DSBOT2,DTANBA,DMGL,DDT,DDB) - RMSS(40)=DDT - RMSS(41)=DDB - DMH=DMHP - DHM=DHMP - DMA=DAMP - IF(ABS(PMAS(PYCOMP(1000006),1)-DSTOP2).GT.5D-1) THEN - WRITE(MSTU(11),*) ' STOP1 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' STOP1 MASSES = ', - & PMAS(PYCOMP(1000006),1),DSTOP2 - ENDIF - IF(ABS(PMAS(PYCOMP(2000006),1)-DSTOP1).GT.5D-1) THEN - WRITE(MSTU(11),*) ' STOP2 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' STOP2 MASSES = ', - & PMAS(PYCOMP(2000006),1),DSTOP1 - ENDIF - IF(ABS(PMAS(PYCOMP(1000005),1)-DSBOT2).GT.5D-1) THEN - WRITE(MSTU(11),*) ' SBOT1 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' SBOT1 MASSES = ', - & PMAS(PYCOMP(1000005),1),DSBOT2 - ENDIF - IF(ABS(PMAS(PYCOMP(2000005),1)-DSBOT1).GT.5D-1) THEN - WRITE(MSTU(11),*) ' SBOT2 MASS DOES NOT MATCH IN PYHGGM ' - WRITE(MSTU(11),*) ' SBOT2 MASSES = ', - & PMAS(PYCOMP(2000005),1),DSBOT1 - ENDIF - - ENDIF - - ALPHA=ACOS(DCA) - - PMAS(25,1)=DMH - PMAS(35,1)=DHM - PMAS(36,1)=DMA - PMAS(37,1)=DMHCH - - RETURN - END - -C********************************************************************* - -C...PYHIST -C...Prints and resets all histograms. - - SUBROUTINE PYHIST - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - -C...Loop over histograms, print and reset used ones. - DO 100 ID=1,IHIST(1) - IS=INDX(ID) - IF(IS.NE.0.AND.NINT(BIN(IS+5)).GT.0) THEN - CALL PYPLOT(ID) - CALL PYNULL(ID) - ENDIF - 100 CONTINUE - - RETURN - END - -C*********************************************************************** - -C...PYI3AU -C...Calculates real and imaginary parts of the auxiliary function I3; -C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, -C...Nucl. Phys. B297 (1988) 221. - - SUBROUTINE PYI3AU(EPS,RAT,Y3RE,Y3IM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - BE=0.5D0*(1D0+SQRT(1D0+RAT*EPS)) - IF(EPS.LT.1D0) GA=0.5D0*(1D0+SQRT(1D0-EPS)) - - IF(EPS.LT.0D0) THEN - IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ - & PYSPEN(0.25D0*(RAT+1D0)*EPS/(1D0+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((RAT+1D0)/RAT,0D0,1)+0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2- - & LOG(0.25D0*RAT*EPS)**2)+LOG(1D0-0.25D0*EPS)* - & LOG((1D0+0.25D0*(RAT-1D0)*EPS)/(1D0+0.25D0*RAT*EPS))+ - & LOG(-0.25D0*EPS)*LOG(0.25D0*RAT*EPS/(1D0+0.25D0*(RAT-1D0)* - & EPS)) - ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ - & PYSPEN((BE-1D0+0.25D0*EPS)/BE,0D0,1)- - & PYSPEN((BE-1D0+0.25D0*EPS)/(BE-1D0),0D0,1)+ - & 0.5D0*(LOG(BE)**2-LOG(BE-1D0)**2)+ - & LOG(1D0-0.25D0*EPS)*LOG((BE-0.25D0*EPS)/BE)+ - & LOG(-0.25D0*EPS)*LOG((BE-1D0)/(BE-0.25D0*EPS)) - ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ - & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(1D0+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((1D0+0.25D0*RAT*EPS-GA)/(0.25D0*RAT*EPS),0D0,1)+ - & 0.5D0*(LOG(1D0+0.25D0*RAT*EPS)**2-LOG(0.25D0*RAT*EPS)**2)+ - & LOG(GA)*LOG((GA+0.25D0*RAT*EPS)/(1D0+0.25D0*RAT*EPS))+ - & LOG(GA-1D0)*LOG(0.25D0*RAT*EPS/(GA+0.25D0*RAT*EPS)) - ELSE - F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- - & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN((BE-GA)/BE,0D0,1)- - & PYSPEN((BE-GA)/(BE-1D0),0D0,1)+0.5D0*(LOG(BE)**2- - & LOG(BE-1D0)**2)+LOG(GA)*LOG((GA+BE-1D0)/BE)+ - & LOG(GA-1D0)*LOG((BE-1D0)/(GA+BE-1D0)) - ENDIF - F3IM=0D0 - ELSEIF(EPS.LT.1D0) THEN - IF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(1D0+0.25D0*(RAT-1D0)*EPS),0D0,1)+ - & PYSPEN((1D0-0.25D0*EPS)/(-0.25D0*(RAT+1D0)*EPS),0D0,1)- - & PYSPEN(1D0/(RAT+1D0),0D0,1)+LOG((1D0-0.25D0*EPS)/ - & (0.25D0*EPS))*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ - & (0.25D0*(RAT+1D0)*EPS)) - F3IM=-PARU(1)*LOG((1D0+0.25D0*(RAT-1D0)*EPS)/ - & (0.25D0*(RAT+1D0)*EPS)) - ELSEIF(ABS(EPS).LT.1D-4.AND.ABS(RAT*EPS).GE.1D-4) THEN - F3RE=PYSPEN(-0.25D0*EPS/(BE-0.25D0*EPS),0D0,1)- - & PYSPEN((1D0-0.25D0*EPS)/(BE-0.25D0*EPS),0D0,1)+ - & PYSPEN((1D0-0.25D0*EPS)/(1D0-0.25D0*EPS-BE),0D0,1)- - & PYSPEN(-0.25D0*EPS/(1D0-0.25D0*EPS-BE),0D0,1)+ - & LOG((1D0-0.25D0*EPS)/(0.25D0*EPS))* - & LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) - F3IM=-PARU(1)*LOG((BE-0.25D0*EPS)/(BE-1D0+0.25D0*EPS)) - ELSEIF(ABS(EPS).GE.1D-4.AND.ABS(RAT*EPS).LT.1D-4) THEN - F3RE=PYSPEN((GA-1D0)/(GA+0.25D0*RAT*EPS),0D0,1)- - & PYSPEN(GA/(GA+0.25D0*RAT*EPS),0D0,1)+ - & PYSPEN(GA/(GA-1D0-0.25D0*RAT*EPS),0D0,1)- - & PYSPEN((GA-1D0)/(GA-1D0-0.25D0*RAT*EPS),0D0,1)+ - & LOG(GA/(1D0-GA))*LOG((GA+0.25D0*RAT*EPS)/ - & (1D0+0.25D0*RAT*EPS-GA)) - F3IM=-PARU(1)*LOG((GA+0.25D0*RAT*EPS)/ - & (1D0+0.25D0*RAT*EPS-GA)) - ELSE - F3RE=PYSPEN((GA-1D0)/(GA+BE-1D0),0D0,1)- - & PYSPEN(GA/(GA+BE-1D0),0D0,1)+PYSPEN(GA/(GA-BE),0D0,1)- - & PYSPEN((GA-1D0)/(GA-BE),0D0,1)+LOG(GA/(1D0-GA))* - & LOG((GA+BE-1D0)/(BE-GA)) - F3IM=-PARU(1)*LOG((GA+BE-1D0)/(BE-GA)) - ENDIF - ELSE - RSQ=EPS/(EPS-1D0+(2D0*BE-1D0)**2) - RCTHE=RSQ*(1D0-2D0*BE/EPS) - RSTHE=SQRT(MAX(0D0,RSQ-RCTHE**2)) - RCPHI=RSQ*(1D0+2D0*(BE-1D0)/EPS) - RSPHI=SQRT(MAX(0D0,RSQ-RCPHI**2)) - R=SQRT(RSQ) - THE=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCTHE/R))) - PHI=ACOS(MAX(-0.999999D0,MIN(0.999999D0,RCPHI/R))) - F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)- - & PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+ - & (PHI-THE)*(PHI+THE-PARU(1)) - F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)- - & PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2) - ENDIF - - Y3RE=2D0/(2D0*BE-1D0)*F3RE - Y3IM=2D0/(2D0*BE-1D0)*F3IM - - RETURN - END - -C********************************************************************* - -C...PYINBM -C...Identifies the two incoming particles and the choice of frame. - - SUBROUTINE PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ - -C...Local arrays, character variables and data. - CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHCOM(3)*12,CHALP(2)*26, - &CHIDNT(3)*12,CHTEMP*12,CHCDE(39)*12,CHINIT*76,CHNAME*16 - DIMENSION LEN(3),KCDE(39),PM(2) - DATA CHALP/'abcdefghijklmnopqrstuvwxyz', - &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ - DATA CHCDE/ 'e- ','e+ ','nu_e ', - &'nu_ebar ','mu- ','mu+ ','nu_mu ', - &'nu_mubar ','tau- ','tau+ ','nu_tau ', - &'nu_taubar ','pi+ ','pi- ','n0 ', - &'nbar0 ','p+ ','pbar- ','gamma ', - &'lambda0 ','sigma- ','sigma0 ','sigma+ ', - &'xi- ','xi0 ','omega- ','pi0 ', - &'reggeon ','pomeron ','gamma/e- ','gamma/e+ ', - &'gamma/mu- ','gamma/mu+ ','gamma/tau- ','gamma/tau+ ', - &'k+ ','k- ','ks0 ','kl0 '/ - DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, - &211,-211,2112,-2112,2212,-2212,22,3122,3112,3212,3222, - &3312,3322,3334,111,110,990,6*22,321,-321,310,130/ - -C...Store initial energy. Default frame. - VINT(290)=WIN - MINT(111)=0 - -C...Special user process initialization; convert to normal input. - IF(CHFRAM(1:1).EQ.'u'.OR.CHFRAM(1:1).EQ.'U') THEN - MINT(111)=11 - CALL PYNAME(IDBMUP(1),CHNAME) - CHBEAM=CHNAME(1:12) - CALL PYNAME(IDBMUP(2),CHNAME) - CHTARG=CHNAME(1:12) - ENDIF - -C...Convert character variables to lowercase and find their length. - CHCOM(1)=CHFRAM - CHCOM(2)=CHBEAM - CHCOM(3)=CHTARG - DO 130 I=1,3 - LEN(I)=12 - DO 110 LL=12,1,-1 - IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1 - DO 100 LA=1,26 - IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)= - & CHALP(1)(LA:LA) - 100 CONTINUE - 110 CONTINUE - CHIDNT(I)=CHCOM(I) - -C...Fix up bar, underscore and charge in particle name (if needed). - DO 120 LL=1,10 - IF(CHIDNT(I)(LL:LL).EQ.'~') THEN - CHTEMP=CHIDNT(I) - CHIDNT(I)=CHTEMP(1:LL-1)//'bar'//CHTEMP(LL+1:10)//' ' - ENDIF - 120 CONTINUE - IF(CHIDNT(I)(1:2).EQ.'nu'.AND.CHIDNT(I)(3:3).NE.'_') THEN - CHTEMP=CHIDNT(I) - CHIDNT(I)='nu_'//CHTEMP(3:7) - ELSEIF(CHIDNT(I)(1:2).EQ.'n ') THEN - CHIDNT(I)(1:3)='n0 ' - ELSEIF(CHIDNT(I)(1:4).EQ.'nbar') THEN - CHIDNT(I)(1:5)='nbar0' - ELSEIF(CHIDNT(I)(1:2).EQ.'p ') THEN - CHIDNT(I)(1:3)='p+ ' - ELSEIF(CHIDNT(I)(1:4).EQ.'pbar'.OR. - & CHIDNT(I)(1:2).EQ.'p-') THEN - CHIDNT(I)(1:5)='pbar-' - ELSEIF(CHIDNT(I)(1:6).EQ.'lambda') THEN - CHIDNT(I)(7:7)='0' - ELSEIF(CHIDNT(I)(1:3).EQ.'reg') THEN - CHIDNT(I)(1:7)='reggeon' - ELSEIF(CHIDNT(I)(1:3).EQ.'pom') THEN - CHIDNT(I)(1:7)='pomeron' - ENDIF - 130 CONTINUE - -C...Identify free initialization. - IF(CHCOM(1)(1:2).EQ.'no') THEN - MINT(65)=1 - RETURN - ENDIF - -C...Identify incoming beam and target particles. - DO 160 I=1,2 - DO 140 J=1,39 - IF(CHIDNT(I+1).EQ.CHCDE(J)) MINT(10+I)=KCDE(J) - 140 CONTINUE - PM(I)=PYMASS(MINT(10+I)) - VINT(2+I)=PM(I) - MINT(140+I)=0 - IF(MINT(10+I).EQ.22.AND.CHIDNT(I+1)(6:6).EQ.'/') THEN - CHTEMP=CHIDNT(I+1)(7:12)//' ' - DO 150 J=1,12 - IF(CHTEMP.EQ.CHCDE(J)) MINT(140+I)=KCDE(J) - 150 CONTINUE - PM(I)=PYMASS(MINT(140+I)) - VINT(302+I)=PM(I) - ENDIF - 160 CONTINUE - IF(MINT(11).EQ.0) WRITE(MSTU(11),5000) CHBEAM(1:LEN(2)) - IF(MINT(12).EQ.0) WRITE(MSTU(11),5100) CHTARG(1:LEN(3)) - IF(MINT(11).EQ.0.OR.MINT(12).EQ.0) STOP - -C...Identify choice of frame and input energies. - CHINIT=' ' - -C...Events defined in the CM frame. - IF(CHCOM(1)(1:2).EQ.'cm') THEN - MINT(111)=1 - S=WIN**2 - IF(MSTP(122).GE.1) THEN - IF(CHCOM(2)(1:1).NE.'e') THEN - LOFFS=(31-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' collider'//' ' - ELSE - LOFFS=(30-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' collider'//' ' - ENDIF - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5300) WIN - ENDIF - -C...Events defined in fixed target frame. - ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN - MINT(111)=2 - S=PM(1)**2+PM(2)**2+2D0*PM(2)*SQRT(PM(1)**2+WIN**2) - IF(MSTP(122).GE.1) THEN - LOFFS=(29-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' fixed target'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5400) WIN - WRITE(MSTU(11),5500) SQRT(S) - ENDIF - -C...Frame defined by user three-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'3') THEN - MINT(111)=3 - P(1,5)=PM(1) - P(2,5)=PM(2) - P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by user four-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'4') THEN - MINT(111)=4 - PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 - P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) - PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 - P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by user five-vectors. - ELSEIF(CHCOM(1)(1:1).EQ.'5') THEN - MINT(111)=5 - S=(P(1,4)+P(2,4))**2-(P(1,1)+P(2,1))**2-(P(1,2)+P(2,2))**2- - & (P(1,3)+P(2,3))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),5600) - WRITE(MSTU(11),5700) CHCOM(2),P(1,1),P(1,2),P(1,3),P(1,4) - WRITE(MSTU(11),5700) CHCOM(3),P(2,1),P(2,2),P(2,3),P(2,4) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Frame defined by HEPRUP common block. - ELSEIF(MINT(111).EQ.11) THEN - S=(EBMUP(1)+EBMUP(2))**2-(SQRT(MAX(0D0,EBMUP(1)**2-PM(1)**2))- - & SQRT(MAX(0D0,EBMUP(2)**2-PM(2)**2)))**2 - IF(MSTP(122).GE.1) THEN - LOFFS=(22-(LEN(2)+LEN(3)))/2 - CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// - & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// - & ' user configuration'//' ' - WRITE(MSTU(11),5200) CHINIT - WRITE(MSTU(11),6000) EBMUP(1),EBMUP(2) - WRITE(MSTU(11),5500) SQRT(MAX(0D0,S)) - ENDIF - -C...Unknown frame. Error for too low CM energy. - ELSE - WRITE(MSTU(11),5800) CHFRAM(1:LEN(1)) - STOP - ENDIF - IF(S.LT.PARP(2)**2) THEN - WRITE(MSTU(11),5900) SQRT(S) - STOP - ENDIF - -C...Formats for initialization and error information. - 5000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''D0'/ - &1X,'Execution stopped!') - 5100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''D0'/ - &1X,'Execution stopped!') - 5200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I') - 5300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy', - &19X,'I'/1X,'I',76X,'I'/1X,78('=')) - 5400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I') - 5500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X, - &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('=')) - 5600 FORMAT(1X,'I',76X,'I'/1X,'I',18X,'px (GeV/c)',3X,'py (GeV/c)',3X, - &'pz (GeV/c)',6X,'E (GeV)',9X,'I') - 5700 FORMAT(1X,'I',8X,A8,4(2X,F10.3,1X),8X,'I') - 5800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''D0'/ - &1X,'Execution stopped!') - 5900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ', - &'generation.'/1X,'Execution stopped!') - 6000 FORMAT(1X,'I',12X,'with',1X,F10.3,1X,'GeV on',1X,F10.3,1X, - &'GeV beam energies',13X,'I') - - RETURN - END - -C********************************************************************* - -C...PYINDF -C...Handles the fragmentation of a jet system (or a single -C...jet) according to independent fragmentation models. - - SUBROUTINE PYINDF(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), - &KFLO(2),PXO(2),PYO(2),WO(2) - -C.. MOPS error message - IF(MSTJ(12).GT.3) CALL PYERRM(9,'(PYINDF:) MSTJ(12)>3 options'// - &' are not treated as expected in independent fragmentation') - -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)=0D0 - 100 CONTINUE - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL PYERRM(12,'(PYINDF:) 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=PYCOMP(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 PYERRM(12,'(PYINDF:) 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 PYROBO(NSAV+1,NSAV+NJET,0D0,0D0,-DPS(1)/DPS(4), - & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) - ENDIF - PECM=0D0 - 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 PYERRM(14,'(PYINDF:) 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 PYPTDI(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(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - CALL PYPTDI(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(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - KFLO(2)=-KFLO(1) - CALL PYPTDI(0,PXO(1),PYO(1)) - PXO(2)=-PXO(1) - PYO(2)=-PYO(1) - WO(1)=WF*PYR(0)**(1D0/3D0) - 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 PYERRM(11,'(PYINDF:) no more memory left in PYJETS') - 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 PYKFDI(KFL1,0,KFL2,K(I,2)) - IF(K(I,2).EQ.0) GOTO 180 - IF(IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.IABS(KFL2).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 200 - ENDIF - -C...Find hadron mass. Generate four-momentum. - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(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 PYZDIS(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.5D0*(Z*W-PR/MAX(1D-4,Z*W)) - P(I,4)=0.5D0*(Z*W+PR/MAX(1D-4,Z*W)) - IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. - & P(I,3).LE.0.001D0) THEN - IF(W.GE.P(I,5)+0.5D0*PARJ(32)) GOTO 180 - P(I,3)=0.0001D0 - P(I,4)=SQRT(PR) - Z=P(I,4)/W - ENDIF - -C...Remaining flavour and momentum. - KFL1=-KFL2 - PX1=-PX2 - PY1=-PY2 - W=(1D0-Z)*W - DO 210 J=1,5 - V(I,J)=0D0 - 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.0D0) 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.1D0*PARJ(32) - IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 - -C...Rotate jet to new direction. - THE=PYANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) - PHI=PYANGL(P(IP1,1),P(IP1,2)) - MSTU(33)=1 - CALL PYROBO(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)))*PYR(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((2D0+PARJ(2))*PYR(0)) - IF(NFET.EQ.0) KFLF(2)=-KFLF(1) - IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2D0+PARJ(2))*PYR(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.(1D0+3D0*PARJ(4))*PYR(0).GT.1D0) - & KFLFC=KFLFC+ISIGN(2,KFLFC) - ELSE - KFLFC=KFLF(1) - ENDIF - CALL PYKFDI(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(PYR(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)=PYMASS(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)=0D0 - 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=0D0 - 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+1D0 - 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=1D0 - 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)=0D0 - 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=0D0 - DO 420 I=N+1,N+NJET - IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8D0*P(I,5)+0.2D0)) - 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)+(1D0/(P(IR2,5)*PSS)-1D0)* - & 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=0D0 - PES=0D0 - PQS=0D0 - 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=0D0 - PQS=0D0 - 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.2D-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)=0D0 - 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 PYROBO(NSAV+1,N,0D0,0D0,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********************************************************************* - -C...PYINIT -C...Initializes the generation procedure; finds maxima of the -C...differential cross-sections to be used for weighting. - - SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT5/ -C...Local arrays and character variables. - DIMENSION ALAMIN(20),NFIN(20) - CHARACTER*(*) FRAME,BEAM,TARGET - CHARACTER CHFRAM*12,CHBEAM*12,CHTARG*12,CHLH(2)*6 - -C...Interface to PDFLIB. - COMMON/W50512/QCDL4,QCDL5 - SAVE /W50512/ - DOUBLE PRECISION VALUE(20),QCDL4,QCDL5 - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Data:Lambda and n_f values for parton distributions.. - DATA ALAMIN/0.177D0,0.239D0,0.247D0,0.2322D0,0.248D0,0.248D0, - &0.192D0,0.326D0,2*0.2D0,0.2D0,0.2D0,0.29D0,0.2D0,0.4D0,5*0.2D0/, - &NFIN/20*4/ - DATA CHLH/'lepton','hadron'/ - -C...Reset MINT and VINT arrays. Write headers. - MSTI(53)=0 - DO 100 J=1,400 - MINT(J)=0 - VINT(J)=0D0 - 100 CONTINUE - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) - -C...Reset processes that should not be on. - MSUB(96)=0 - MSUB(97)=0 - -C...Call user process initialization routine. - IF(FRAME(1:1).EQ.'u'.OR.FRAME(1:1).EQ.'U') THEN - MSEL=0 - CALL UPINIT - MSEL=0 - ENDIF - -C...Maximum 4 generations; set maximum number of allowed flavours. - MSTP(1)=MIN(4,MSTP(1)) - MSTU(114)=MIN(MSTU(114),2*MSTP(1)) - MSTP(58)=MIN(MSTP(58),2*MSTP(1)) - -C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton. - DO 120 I=-20,20 - VINT(180+I)=0D0 - IA=IABS(I) - IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN - DO 110 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IF(IB.GE.6.AND.MSTP(9).EQ.0) GOTO 110 - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)= - & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2) - 110 CONTINUE - ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN - VINT(180+I)=1D0 - ENDIF - 120 CONTINUE - -C...Initialize parton distributions: PDFLIB. - IF(MSTP(52).EQ.2) THEN - PARM(1)='NPTYPE' - VALUE(1)=1 - PARM(2)='NGROUP' - VALUE(2)=MSTP(51)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(51),1000) - PARM(4)='TMAS' - VALUE(4)=PMAS(6,1) - CALL PDFSET(PARM,VALUE) - MINT(93)=1000000+MSTP(51) - ENDIF - -C...Choose Lambda value to use in alpha-strong. - MSTU(111)=MSTP(2) - IF(MSTP(3).GE.2) THEN - ALAM=0.2D0 - NF=4 - IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN - ALAM=ALAMIN(MSTP(51)) - NF=NFIN(MSTP(51)) - ELSEIF(MSTP(52).EQ.2) THEN - ALAM=QCDL4 - NF=4 - ENDIF - PARP(1)=ALAM - PARP(61)=ALAM - PARP(72)=ALAM - PARU(112)=ALAM - MSTU(112)=NF - IF(MSTP(3).EQ.3) PARJ(81)=ALAM - ENDIF - -C...Initialize the SUSY generation: couplings, masses, -C...decay modes, branching ratios, and so on. - CALL PYMSIN -C...Initialize widths and partial widths for resonances. - CALL PYINRE -C...Set Z0 mass and width for e+e- routines. - PARJ(123)=PMAS(23,1) - PARJ(124)=PMAS(23,2) - -C...Identify beam and target particles and frame of process. - CHFRAM=FRAME//' ' - CHBEAM=BEAM//' ' - CHTARG=TARGET//' ' - CALL PYINBM(CHFRAM,CHBEAM,CHTARG,WIN) - IF(MINT(65).EQ.1) GOTO 170 - -C...For gamma-p or gamma-gamma allow many (3 or 6) alternatives. -C...For e-gamma allow 2 alternatives. - MINT(121)=1 - IF(MSTP(14).EQ.10.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=6 - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).EQ.11.OR.IABS(MINT(12)).EQ.11)) MINT(121)=2 - ELSEIF(MSTP(14).EQ.20.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=3 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=9 - ELSEIF(MSTP(14).EQ.25.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=2 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=4 - ELSEIF(MSTP(14).EQ.30.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN - IF((MINT(11).EQ.22.OR.MINT(12).EQ.22).AND. - & (IABS(MINT(11)).GT.100.OR.IABS(MINT(12)).GT.100)) MINT(121)=4 - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) MINT(121)=13 - ENDIF - MINT(123)=MSTP(14) - IF((MSTP(14).EQ.10.OR.MSTP(14).EQ.20.OR.MSTP(14).EQ.25.OR. - &MSTP(14).EQ.30).AND.MSEL.NE.1.AND.MSEL.NE.2) MINT(123)=0 - IF(MSTP(14).GE.11.AND.MSTP(14).LE.19) THEN - IF(MSTP(14).EQ.11) MINT(123)=0 - IF(MSTP(14).EQ.12.OR.MSTP(14).EQ.14) MINT(123)=5 - IF(MSTP(14).EQ.13.OR.MSTP(14).EQ.17) MINT(123)=6 - IF(MSTP(14).EQ.15) MINT(123)=2 - IF(MSTP(14).EQ.16.OR.MSTP(14).EQ.18) MINT(123)=7 - IF(MSTP(14).EQ.19) MINT(123)=3 - ELSEIF(MSTP(14).GE.21.AND.MSTP(14).LE.24) THEN - IF(MSTP(14).EQ.21) MINT(123)=0 - IF(MSTP(14).EQ.22.OR.MSTP(14).EQ.23) MINT(123)=4 - IF(MSTP(14).EQ.24) MINT(123)=1 - ELSEIF(MSTP(14).GE.26.AND.MSTP(14).LE.29) THEN - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28) MINT(123)=8 - IF(MSTP(14).EQ.27.OR.MSTP(14).EQ.29) MINT(123)=9 - ENDIF - -C...Set up kinematics of process. - CALL PYINKI(0) - -C...Set up kinematics for photons inside leptons. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(1,WTGAGA) - -C...Precalculate flavour selection weights. - CALL PYKFIN - -C...Loop over gamma-p or gamma-gamma alternatives. - CKIN3=CKIN(3) - MSAV48=0 - DO 160 IGA=1,MINT(121) - CKIN(3)=CKIN3 - MINT(122)=IGA - -C...Select partonic subprocesses to be included in the simulation. - CALL PYINPR - MINT(101)=1 - MINT(102)=1 - MINT(103)=MINT(11) - MINT(104)=MINT(12) - -C...Count number of subprocesses on. - MINT(48)=0 - DO 130 ISUB=1,500 - IF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. - & MSUB(ISUB).EQ.1.AND.MINT(121).GT.1) THEN - MSUB(ISUB)=0 - ELSEIF(MINT(50).EQ.0.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. - & MSUB(ISUB).EQ.1) THEN - WRITE(MSTU(11),5200) ISUB,CHLH(MINT(41)),CHLH(MINT(42)) - STOP - ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN - WRITE(MSTU(11),5300) ISUB - STOP - ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN - WRITE(MSTU(11),5400) ISUB - STOP - ELSEIF(MSUB(ISUB).EQ.1) THEN - MINT(48)=MINT(48)+1 - ENDIF - 130 CONTINUE - -C...Stop or raise warning flag if no subprocesses on. - IF(MINT(121).EQ.1.AND.MINT(48).EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5500) - STOP - ELSE - WRITE(MSTU(11),5700) - MSTI(53)=1 - ENDIF - ENDIF - MINT(49)=MINT(48)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) - MSAV48=MSAV48+MINT(48) - -C...Reset variables for cross-section calculation. - DO 150 I=0,500 - DO 140 J=1,3 - NGEN(I,J)=0 - XSEC(I,J)=0D0 - 140 CONTINUE - 150 CONTINUE - -C...Find parametrized total cross-sections. - CALL PYXTOT - VINT(318)=VINT(317) - -C...Maxima of differential cross-sections. - IF(MSTP(121).LE.1) CALL PYMAXI - -C...Initialize possibility of pileup events. - IF(MINT(121).GT.1) MSTP(131)=0 - IF(MSTP(131).NE.0) CALL PYPILE(1) - -C...Initialize multiple interactions with variable impact parameter. - IF(MINT(50).EQ.1) THEN - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - IF(MSTP(81).EQ.0.AND.CKIN(3).GT.PTMN) MSTP(82)=MIN(1,MSTP(82)) - IF((MINT(49).NE.0.OR.MSTP(131).NE.0).AND.MSTP(82).GE.2) - & CALL PYMULT(1) - ENDIF - -C...Save results for gamma-p and gamma-gamma alternatives. - IF(MINT(121).GT.1) CALL PYSAVE(1,IGA) - 160 CONTINUE - -C...Initialization finished. - IF(MSAV48.EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5500) - STOP - ELSE - WRITE(MSTU(11),5700) - MSTI(53)=1 - ENDIF - ENDIF - 170 IF(MSTP(122).GE.1) WRITE(MSTU(11),5600) - -C...Formats for initialization information. - 5100 FORMAT('1',18('*'),1X,'PYINIT: initialization of PYTHIA ', - &'routines',1X,17('*')) - 5200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6, - &'-',A6,' interactions.'/1X,'Execution stopped!') - 5300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/ - &1X,'Execution stopped!') - 5400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/ - &1X,'Execution stopped!') - 5500 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution stopped.') - 5600 FORMAT(/1X,22('*'),1X,'PYINIT: initialization completed',1X, - &22('*')) - 5700 FORMAT(1X,'Error: no subprocess switched on.'/ - &1X,'Execution will stop if you try to generate events.') - - RETURN - END - -C********************************************************************* - -C...PYINKI -C...Sets up kinematics, including rotations and boosts to/from CM frame. - - SUBROUTINE PYINKI(MODKI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/ - -C...Set initial flavour state. - N=2 - DO 100 I=1,2 - K(I,1)=1 - K(I,2)=MINT(10+I) - IF(MINT(140+I).NE.0) K(I,2)=MINT(140+I) - 100 CONTINUE - -C...Reset boost. Do kinematics for various cases. - DO 110 J=6,10 - VINT(J)=0D0 - 110 CONTINUE - -C...Set up kinematics for events defined in CM frame. - IF(MINT(111).EQ.1) THEN - WIN=VINT(290) - IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) - S=WIN**2 - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2D0*P(1,5)*P(2,5))**2)/ - & (4D0*S)) - P(2,3)=-P(1,3) - P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,3)**2+P(2,5)**2) - -C...Set up kinematics for fixed target events. - ELSEIF(MINT(111).EQ.2) THEN - WIN=VINT(290) - IF(MODKI.EQ.1) WIN=PARP(171)*VINT(290) - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=WIN - P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) - P(2,3)=0D0 - P(2,4)=P(2,5) - S=P(1,5)**2+P(2,5)**2+2D0*P(2,4)*P(1,4) - VINT(10)=P(1,3)/(P(1,4)+P(2,4)) - CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) - -C...Set up kinematics for events in user-defined frame. - ELSEIF(MINT(111).EQ.3) THEN - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) - P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) - DO 120 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 120 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=P(1,5)**2+P(2,5)**2+2D0*(P(1,4)*P(2,4)-P(1,3)*P(2,3)) - -C...Set up kinematics for events with user-defined four-vectors. - ELSEIF(MINT(111).EQ.4) THEN - PMS1=P(1,4)**2-P(1,1)**2-P(1,2)**2-P(1,3)**2 - P(1,5)=SIGN(SQRT(ABS(PMS1)),PMS1) - PMS2=P(2,4)**2-P(2,1)**2-P(2,2)**2-P(2,3)**2 - P(2,5)=SIGN(SQRT(ABS(PMS2)),PMS2) - DO 130 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 130 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=(P(1,4)+P(2,4))**2 - -C...Set up kinematics for events with user-defined five-vectors. - ELSEIF(MINT(111).EQ.5) THEN - DO 140 J=1,3 - VINT(7+J)=(P(1,J)+P(2,J))/(P(1,4)+P(2,4)) - 140 CONTINUE - CALL PYROBO(0,0,0D0,0D0,-VINT(8),-VINT(9),-VINT(10)) - VINT(7)=PYANGL(P(1,1),P(1,2)) - CALL PYROBO(0,0,0D0,-VINT(7),0D0,0D0,0D0) - VINT(6)=PYANGL(P(1,3),P(1,1)) - CALL PYROBO(0,0,-VINT(6),0D0,0D0,0D0,0D0) - S=(P(1,4)+P(2,4))**2 - -C...Set up kinematics for events with external user processes. - ELSEIF(MINT(111).EQ.11) THEN - P(1,5)=VINT(3) - P(2,5)=VINT(4) - IF(MINT(141).NE.0) P(1,5)=VINT(303) - IF(MINT(142).NE.0) P(2,5)=VINT(304) - P(1,1)=0D0 - P(1,2)=0D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(1,3)=SQRT(MAX(0D0,EBMUP(1)**2-P(1,5)**2)) - P(2,3)=-SQRT(MAX(0D0,EBMUP(2)**2-P(2,5)**2)) - P(1,4)=EBMUP(1) - P(2,4)=EBMUP(2) - VINT(10)=(P(1,3)+P(2,3))/(P(1,4)+P(2,4)) - CALL PYROBO(0,0,0D0,0D0,0D0,0D0,-VINT(10)) - S=(P(1,4)+P(2,4))**2 - ENDIF - -C...Return or error for too low CM energy. - IF(MODKI.EQ.1.AND.S.LT.PARP(2)**2) THEN - IF(MSTP(172).LE.1) THEN - CALL PYERRM(23, - & '(PYINKI:) too low invariant mass in this event') - ELSE - MSTI(61)=1 - RETURN - ENDIF - ENDIF - -C...Save information on incoming particles. - VINT(1)=SQRT(S) - VINT(2)=S - IF(MINT(111).GE.4) THEN - IF(MINT(141).EQ.0) THEN - VINT(3)=P(1,5) - IF(MINT(11).EQ.22.AND.P(1,5).LT.0) VINT(307)=P(1,5)**2 - ELSE - VINT(303)=P(1,5) - ENDIF - IF(MINT(142).EQ.0) THEN - VINT(4)=P(2,5) - IF(MINT(12).EQ.22.AND.P(2,5).LT.0) VINT(308)=P(2,5)**2 - ELSE - VINT(304)=P(2,5) - ENDIF - ENDIF - VINT(5)=P(1,3) - IF(MODKI.EQ.0) VINT(289)=S - DO 150 J=1,5 - V(1,J)=0D0 - V(2,J)=0D0 - VINT(290+J)=P(1,J) - VINT(295+J)=P(2,J) - 150 CONTINUE - -C...Store pT cut-off and related constants to be used in generation. - IF(MODKI.EQ.0) VINT(285)=CKIN(3) - IF(MSTP(82).LE.1) THEN - PTMN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - VINT(149)=4D0*PTMN**2/S - VINT(154)=PTMN - - RETURN - END - -C********************************************************************* - -C...PYINOM -C...Finds the mass eigenstates and mixing matrices for neutralinos -C...and charginos. - - SUBROUTINE PYINOM - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION XMW,XMZ,XM(4) - DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),AI(4,4) - DOUBLE PRECISION WI(4),FV1(4),FV2(4),FV3(4) - DOUBLE PRECISION COSW,SINW - DOUBLE PRECISION XMU - DOUBLE PRECISION TANB,COSB,SINB - DOUBLE PRECISION XM1,XM2,XM3,BETA - DOUBLE PRECISION Q2,AEM,A1,A2,AQ,RM1,RM2 - DOUBLE PRECISION ARG,X0,X1,AX0,AX1,AT,BT - DOUBLE PRECISION Y0,Y1,AMGX0,AM1X0,AMGX1,AM1X1 - DOUBLE PRECISION ARGX0,AR1X0,ARGX1,AR1X1 - DOUBLE PRECISION PYALPS,PYALEM - DOUBLE PRECISION PYRNM3 - COMPLEX*16 CAR(4,4),CAI(4,4),CA1,CA2 - INTEGER IERR,INDEX(4),I,J,K,IOPT,ILR,KFNCHI(4) - DATA KFNCHI/1000022,1000023,1000025,1000035/ - - IOPT=IMSS(2) - IF(IMSS(1).EQ.2) THEN - IOPT=1 - ENDIF -C...M1, M2, AND M3 ARE INDEPENDENT - IF(IOPT.EQ.0) THEN - XM1=RMSS(1) - XM2=RMSS(2) - XM3=RMSS(3) - ELSEIF(IOPT.GE.1) THEN - Q2=PMAS(23,1)**2 - AEM=PYALEM(Q2) - A2=AEM/PARU(102) - A1=AEM/(1D0-PARU(102)) - XM1=RMSS(1) - XM2=RMSS(2) - IF(IMSS(1).EQ.2) XM1=RMSS(1)/RMSS(20)*A1*5D0/3D0 - IF(IOPT.EQ.1) THEN - XM2=XM1*A2/A1*3D0/5D0 - RMSS(2)=XM2 - ELSEIF(IOPT.EQ.3) THEN - XM1=XM2*5D0/3D0*A1/A2 - RMSS(1)=XM1 - ENDIF - XM3=PYRNM3(XM2/A2) - RMSS(3)=XM3 - IF(XM3.LE.0D0) THEN - WRITE(MSTU(11),*) ' ERROR WITH M3 = ',XM3 - STOP - ENDIF - ENDIF - -C...GLUINO MASS - IF(IMSS(3).EQ.1) THEN - PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3) - ELSE - AQ=0D0 - DO 110 I=1,4 - DO 100 ILR=1,2 - RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 - AQ=AQ+0.5D0*((2D0-RM1)*(RM1*LOG(RM1)-1D0) - & +(1D0-RM1)**2*LOG(ABS(1D0-RM1))) - 100 CONTINUE - 110 CONTINUE - - DO 130 I=5,6 - DO 120 ILR=1,2 - RM1=PMAS(PYCOMP(ILR*KSUSY1+I),1)**2/XM3**2 - RM2=PMAS(I,1)**2/XM3**2 - ARG=(RM1-RM2-1D0)**2-4D0*RM2**2 - IF(ARG.GE.0D0) THEN - X0=0.5D0*(1D0+RM2-RM1-SQRT(ARG)) - AX0=ABS(X0) - X1=0.5D0*(1D0+RM2-RM1+SQRT(ARG)) - AX1=ABS(X1) - IF(X0.EQ.1D0) THEN - AT=-1D0 - BT=0.25D0 - ELSEIF(X0.EQ.0D0) THEN - AT=0D0 - BT=-0.25D0 - ELSE - AT=0.5D0*LOG(ABS(1D0-X0))*(1D0-X0**2)+ - & 0.5D0*X0**2*LOG(AX0) - BT=(-1D0-2D0*X0)/4D0 - ENDIF - IF(X1.EQ.1D0) THEN - AT=-1D0+AT - BT=0.25D0+BT - ELSEIF(X1.EQ.0D0) THEN - AT=0D0+AT - BT=-0.25D0+BT - ELSE - AT=0.5D0*LOG(ABS(1D0-X1))*(1D0-X1**2)+0.5D0* - & X1**2*LOG(AX1)+AT - BT=(-1D0-2D0*X1)/4D0+BT - ENDIF - AQ=AQ+AT+BT - ELSE - X0=0.5D0*(1D0+RM2-RM1) - Y0=-0.5D0*SQRT(-ARG) - AMGX0=SQRT(X0**2+Y0**2) - AM1X0=SQRT((1D0-X0)**2+Y0**2) - ARGX0=ATAN2(-X0,-Y0) - AR1X0=ATAN2(1D0-X0,Y0) - X1=X0 - Y1=-Y0 - AMGX1=AMGX0 - AM1X1=AM1X0 - ARGX1=ATAN2(-X1,-Y1) - AR1X1=ATAN2(1D0-X1,Y1) - AT=0.5D0*LOG(AM1X0)*(1D0-X0**2+3D0*Y0**2) - & +0.5D0*(X0**2-Y0**2)*LOG(AMGX0) - BT=(-1D0-2D0*X0)/4D0+X0*Y0*( AR1X0-ARGX0 ) - AT=AT+0.5D0*LOG(AM1X1)*(1D0-X1**2+3D0*Y1**2) - & +0.5D0*(X1**2-Y1**2)*LOG(AMGX1) - BT=BT+(-1D0-2D0*X1)/4D0+X1*Y1*( AR1X1-ARGX1 ) - AQ=AQ+AT+BT - ENDIF - 120 CONTINUE - 130 CONTINUE - PMAS(PYCOMP(KSUSY1+21),1)=ABS(XM3)*(1D0+PYALPS(XM3**2) - & /(2D0*PARU(2))*(15D0+AQ)) - ENDIF - -C...NEUTRALINO MASSES - DO 150 I=1,4 - DO 140 J=1,4 - AI(I,J)=0D0 - 140 CONTINUE - 150 CONTINUE - XMZ=PMAS(23,1) - XMW=PMAS(24,1) - XMU=RMSS(4) - SINW=SQRT(PARU(102)) - COSW=SQRT(1D0-PARU(102)) - TANB=RMSS(5) - BETA=ATAN(TANB) - COSB=COS(BETA) - SINB=TANB*COSB - -C... Definitions: -C... psi^0 =(-i bino^0, -i wino^0, h_d^0(=H_1^0), h_u^0(=H_2^0)) -C... => L_neutralino = -1/2*(psi^0)^T * [AR] * psi^0 + h.c. - AR(1,1) = XM1*COS(RMSS(30)) - AI(1,1) = XM1*SIN(RMSS(30)) - AR(2,2) = XM2*COS(RMSS(31)) - AI(2,2) = XM2*SIN(RMSS(31)) - AR(3,3) = 0D0 - AR(4,4) = 0D0 - AR(1,2) = 0D0 - AR(2,1) = 0D0 - AR(1,3) = -XMZ*SINW*COSB - AR(3,1) = AR(1,3) - AR(1,4) = XMZ*SINW*SINB - AR(4,1) = AR(1,4) - AR(2,3) = XMZ*COSW*COSB - AR(3,2) = AR(2,3) - AR(2,4) = -XMZ*COSW*SINB - AR(4,2) = AR(2,4) - AR(3,4) = -XMU*COS(RMSS(33)) - AI(3,4) = -XMU*SIN(RMSS(33)) - AR(4,3) = -XMU*COS(RMSS(33)) - AI(4,3) = -XMU*SIN(RMSS(33)) -C CALL PYEIG4(AR,WR,ZR) - CALL PYEICG(4,4,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - DO 160 I=1,4 - INDEX(I)=I - XM(I)=ABS(WR(I)) - 160 CONTINUE - DO 180 I=2,4 - K=I - DO 170 J=I-1,1,-1 - IF(XM(K).LT.XM(J)) THEN - ITMP=INDEX(J) - XTMP=XM(J) - INDEX(J)=INDEX(K) - XM(J)=XM(K) - INDEX(K)=ITMP - XM(K)=XTMP - K=K-1 - ELSE - GOTO 180 - ENDIF - 170 CONTINUE - 180 CONTINUE - - - DO 210 I=1,4 - K=INDEX(I) - SMZ(I)=WR(K) - PMAS(PYCOMP(KFNCHI(I)),1)=ABS(SMZ(I)) - S=0D0 - DO 190 J=1,4 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 190 CONTINUE - DO 200 J=1,4 - ZMIX(I,J)=ZR(J,K)/SQRT(S) - ZMIXI(I,J)=ZI(J,K)/SQRT(S) - IF(ABS(ZMIX(I,J)).LT.1D-6) ZMIX(I,J)=0D0 - IF(ABS(ZMIXI(I,J)).LT.1D-6) ZMIXI(I,J)=0D0 - 200 CONTINUE - 210 CONTINUE - -C...CHARGINO MASSES -C.....Find eigenvectors of X X^* - AI(1,1) = 0D0 - AI(2,2) = 0D0 - AR(1,1) = XM2**2+2D0*XMW**2*SINB**2 - AR(2,2) = XMU**2+2D0*XMW**2*COSB**2 - AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ - &XMU*COS(RMSS(33))*SINB) - AI(1,2) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*COSB- - &XMU*SIN(RMSS(33))*SINB) - AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*COSB+ - &XMU*COS(RMSS(33))*SINB) - AI(2,1) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*COSB+ - &XMU*SIN(RMSS(33))*SINB) - CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - INDEX(1)=1 - INDEX(2)=2 - IF(WR(2).LT.WR(1)) THEN - INDEX(1)=2 - INDEX(2)=1 - ENDIF - - DO 240 I=1,2 - K=INDEX(I) - SMW(I)=SQRT(WR(K)) - S=0D0 - DO 220 J=1,2 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 220 CONTINUE - DO 230 J=1,2 - UMIX(I,J)=ZR(J,K)/SQRT(S) - UMIXI(I,J)=-ZI(J,K)/SQRT(S) - IF(ABS(UMIX(I,J)).LT.1D-6) UMIX(I,J)=0D0 - IF(ABS(UMIXI(I,J)).LT.1D-6) UMIXI(I,J)=0D0 - 230 CONTINUE - 240 CONTINUE - IF(ABS(SMW(1)).LT.ABS(SMZ(1))) THEN - SMW(1)=SIGN(ABS(SMZ(1))+2D0*PMAS(PYCOMP(111),1),SMW(1)) - ENDIF - PMAS(PYCOMP(KSUSY1+24),1)=SMW(1) - PMAS(PYCOMP(KSUSY1+37),1)=SMW(2) - -C.....Find eigenvectors of X^* X - AI(1,1) = 0D0 - AI(2,2) = 0D0 - AR(1,1) = XM2**2+2D0*XMW**2*COSB**2 - AR(2,2) = XMU**2+2D0*XMW**2*SINB**2 - AR(1,2) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ - &XMU*COS(RMSS(33))*COSB) - AI(1,2) = SQRT(2D0)*XMW*(-XM2*SIN(RMSS(31))*SINB+ - &XMU*SIN(RMSS(33))*COSB) - AR(2,1) = SQRT(2D0)*XMW*(XM2*COS(RMSS(31))*SINB+ - &XMU*COS(RMSS(33))*COSB) - AI(2,1) = SQRT(2D0)*XMW*(XM2*SIN(RMSS(31))*SINB- - &XMU*SIN(RMSS(33))*COSB) - CALL PYEICG(4,2,AR,AI,WR,WI,1,ZR,ZI,FV1,FV2,FV3,IERR) - IF(IERR.NE.0) THEN - WRITE(MSTU(11),*) ' PROBLEM WITH PYEICG IN PYINOM ' - ENDIF - INDEX(1)=1 - INDEX(2)=2 - IF(WR(2).LT.WR(1)) THEN - INDEX(1)=2 - INDEX(2)=1 - ENDIF - - DO 270 I=1,2 - K=INDEX(I) - S=0D0 - DO 250 J=1,2 - S=S+ZR(J,K)**2+ZI(J,K)**2 - 250 CONTINUE - DO 260 J=1,2 - VMIX(I,J)=ZR(J,K)/SQRT(S) - VMIXI(I,J)=-ZI(J,K)/SQRT(S) - IF(ABS(VMIX(I,J)).LT.1D-6) VMIX(I,J)=0D0 - IF(ABS(VMIXI(I,J)).LT.1D-6) VMIXI(I,J)=0D0 - 260 CONTINUE - 270 CONTINUE - - - RETURN - END - -C********************************************************************* - -C...PYINPR -C...Selects partonic subprocesses to be included in the simulation. - - SUBROUTINE PYINPR - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks and character variables. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - SAVE /PYDAT1/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT6/ - CHARACTER CHIPR*10 - -C...Reset processes to be included. - IF(MSEL.NE.0) THEN - DO 100 I=1,500 - MSUB(I)=0 - 100 CONTINUE - ENDIF - -C...Set running pTmin scale. - IF(MSTP(82).LE.1) THEN - PTMRUN=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSE - PTMRUN=PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - -C...Begin by assuming incoming photon to enter subprocess. - IF(MINT(11).EQ.22) MINT(15)=22 - IF(MINT(12).EQ.22) MINT(16)=22 - -C...For e-gamma with MSTP(14)=10 allow mixture of VMD and anomalous. - IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN - MSUB(10)=1 - MINT(123)=MINT(122)+1 - -C...For gamma-p or gamma-gamma with MSTP(14) = 10, 20, 25 or 30 -C...allow mixture. -C...Here also set a few parameters otherwise normally not touched. - ELSEIF(MINT(121).GT.1) THEN - -C...Parton distributions dampened at small Q2; go to low energies, -C...alpha_s <1; no minimum pT cut-off a priori. - IF(MSTP(18).EQ.2) THEN - MSTP(57)=3 - PARP(2)=2D0 - PARU(115)=1D0 - CKIN(5)=0.2D0 - CKIN(6)=0.2D0 - ENDIF - -C...Define pT cut-off parameters and whether run involves low-pT. - PTMVMD=PTMRUN - VINT(154)=PTMVMD - PTMDIR=PTMVMD - IF(MSTP(18).EQ.2) PTMDIR=PARP(15) - PTMANO=PTMVMD - IF(MSTP(15).EQ.5) PTMANO=0.60D0+ - & 0.125D0*LOG(1D0+0.10D0*VINT(1))**2 - IPTL=1 - IF(VINT(285).GT.MAX(PTMVMD,PTMDIR,PTMANO)) IPTL=0 - IF(MSEL.EQ.2) IPTL=1 - -C...Set up for p/gamma * gamma; real or virtual photons. - IF(MINT(121).EQ.3.OR.MINT(121).EQ.6.OR.(MINT(121).EQ.4.AND. - & MSTP(14).EQ.30)) THEN - -C...Set up for p/VMD * VMD. - IF(MINT(122).EQ.1) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for p/VMD * direct gamma. - ELSEIF(MINT(122).EQ.2) THEN - MINT(123)=0 - IF(MINT(121).EQ.6) MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for p/VMD * anomalous gamma. - ELSEIF(MINT(122).EQ.3) THEN - MINT(123)=3 - IF(MINT(121).EQ.6) MINT(123)=7 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for DIS * p. - ELSEIF(MINT(122).EQ.4.AND.(IABS(MINT(11)).GT.100.OR. - & IABS(MINT(12)).GT.100)) THEN - MINT(123)=8 - IF(IPTL.EQ.1) MSUB(99)=1 - -C...Set up for direct * direct gamma (switch off leptons). - ELSEIF(MINT(122).EQ.4) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 110 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 110 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * anomalous gamma. - ELSEIF(MINT(122).EQ.5) THEN - MINT(123)=6 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMANO - -C...Set up for anomalous * anomalous gamma. - ELSEIF(MINT(122).EQ.6) THEN - MINT(123)=3 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...Set up for gamma* * gamma*; virtual photons = dir, VMD, anom. - ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - -C...Set up for direct * direct gamma (switch off leptons). - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 120 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 120 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * VMD and VMD * direct gamma. - ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.4) THEN - MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * anomalous and anomalous * direct gamma. - ELSEIF(MINT(122).EQ.3.OR.MINT(122).EQ.7) THEN - MINT(123)=6 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMANO - -C...Set up for VMD*VMD. - ELSEIF(MINT(122).EQ.5) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for VMD * anomalous and anomalous * VMD gamma. - ELSEIF(MINT(122).EQ.6.OR.MINT(122).EQ.8) THEN - MINT(123)=7 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for anomalous * anomalous gamma. - ELSEIF(MINT(122).EQ.9) THEN - MINT(123)=3 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - -C...Set up for DIS * VMD and VMD * DIS gamma. - ELSEIF(MINT(122).EQ.10.OR.MINT(122).EQ.12) THEN - MINT(123)=8 - IF(IPTL.EQ.1) MSUB(99)=1 - -C...Set up for DIS * anomalous and anomalous * DIS gamma. - ELSEIF(MINT(122).EQ.11.OR.MINT(122).EQ.13) THEN - MINT(123)=9 - IF(IPTL.EQ.1) MSUB(99)=1 - ENDIF - -C...Set up for gamma* * p; virtual photons = dir, res. - ELSEIF(MINT(121).EQ.2) THEN - -C...Set up for direct * p. - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for resolved * p. - ELSEIF(MINT(122).EQ.2) THEN - MINT(123)=1 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...Set up for gamma* * gamma*; virtual photons = dir, res. - ELSEIF(MINT(121).EQ.4) THEN - -C...Set up for direct * direct gamma (switch off leptons). - IF(MINT(122).EQ.1) THEN - MINT(123)=0 - MSUB(137)=1 - MSUB(138)=1 - MSUB(139)=1 - MSUB(140)=1 - DO 130 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 130 CONTINUE - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for direct * resolved and resolved * direct gamma. - ELSEIF(MINT(122).EQ.2.OR.MINT(122).EQ.3) THEN - MINT(123)=5 - MSUB(131)=1 - MSUB(132)=1 - MSUB(135)=1 - MSUB(136)=1 - IF(IPTL.EQ.1) CKIN(3)=PTMDIR - -C...Set up for resolved * resolved gamma. - ELSEIF(MINT(122).EQ.4) THEN - MINT(123)=2 - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - IF(IPTL.EQ.1) MSUB(95)=1 - IF(MSEL.EQ.2) THEN - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - ENDIF - IF(IPTL.EQ.1) CKIN(3)=0D0 - ENDIF - -C...End of special set up for gamma-p and gamma-gamma. - ENDIF - CKIN(1)=2D0*CKIN(3) - ENDIF - -C...Flavour information for individual beams. - DO 140 I=1,2 - MINT(40+I)=1 - IF(MINT(123).GE.1.AND.MINT(10+I).EQ.22) MINT(40+I)=2 - IF(IABS(MINT(10+I)).GT.100) MINT(40+I)=2 - MINT(44+I)=MINT(40+I) - IF(MSTP(11).GE.1.AND.(IABS(MINT(10+I)).EQ.11.OR. - & IABS(MINT(10+I)).EQ.13.OR.IABS(MINT(10+I)).EQ.15)) MINT(44+I)=3 - 140 CONTINUE - -C...If two real gammas, whereof one direct, pick the first. -C...For two virtual photons, keep requested order. - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - IF(MSTP(14).LE.10.AND.MINT(123).GE.4.AND.MINT(123).LE.6) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.12.OR.MSTP(14).EQ.13.OR.MSTP(14).EQ.22.OR. - & MSTP(14).EQ.26.OR.MSTP(14).EQ.27) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.14.OR.MSTP(14).EQ.17.OR.MSTP(14).EQ.23.OR. - & MSTP(14).EQ.28.OR.MSTP(14).EQ.29) THEN - MINT(42)=1 - MINT(46)=1 - ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.2 - & .OR.MINT(122).EQ.3.OR.MINT(122).EQ.10.OR.MINT(122).EQ.11)) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF((MSTP(14).EQ.20.OR.MSTP(14).EQ.30).AND.(MINT(122).EQ.4 - & .OR.MINT(122).EQ.7.OR.MINT(122).EQ.12.OR.MINT(122).EQ.13)) THEN - MINT(42)=1 - MINT(46)=1 - ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.2) THEN - MINT(41)=1 - MINT(45)=1 - ELSEIF(MSTP(14).EQ.25.AND.MINT(122).EQ.3) THEN - MINT(42)=1 - MINT(46)=1 - ENDIF - ELSEIF(MINT(11).EQ.22.OR.MINT(12).EQ.22) THEN - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.28.OR.MINT(122).EQ.4) THEN - IF(MINT(11).EQ.22) THEN - MINT(41)=1 - MINT(45)=1 - ELSE - MINT(42)=1 - MINT(46)=1 - ENDIF - ENDIF - IF(MINT(123).GE.4.AND.MINT(123).LE.7) CALL PYERRM(26, - & '(PYINPR:) unallowed MSTP(14) code for single photon') - ENDIF - -C...Flavour information on combination of incoming particles. - MINT(43)=2*MINT(41)+MINT(42)-2 - MINT(44)=MINT(43) - IF(MINT(123).LE.0) THEN - IF(MINT(11).EQ.22) MINT(43)=MINT(43)+2 - IF(MINT(12).EQ.22) MINT(43)=MINT(43)+1 - ELSEIF(MINT(123).LE.3) THEN - IF(MINT(11).EQ.22) MINT(44)=MINT(44)-2 - IF(MINT(12).EQ.22) MINT(44)=MINT(44)-1 - ELSEIF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - MINT(43)=4 - MINT(44)=1 - ENDIF - MINT(47)=2*MIN(2,MINT(45))+MIN(2,MINT(46))-2 - IF(MIN(MINT(45),MINT(46)).EQ.3) MINT(47)=5 - IF(MINT(45).EQ.1.AND.MINT(46).EQ.3) MINT(47)=6 - IF(MINT(45).EQ.3.AND.MINT(46).EQ.1) MINT(47)=7 - MINT(50)=0 - IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) MINT(50)=1 - MINT(107)=0 - MINT(108)=0 - IF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - IF((MINT(122).GE.4.AND.MINT(122).LE.6).OR.MINT(122).EQ.12) - & MINT(107)=2 - IF((MINT(122).GE.7.AND.MINT(122).LE.9).OR.MINT(122).EQ.13) - & MINT(107)=3 - IF(MINT(122).EQ.10.OR.MINT(122).EQ.11) MINT(107)=4 - IF(MINT(122).EQ.2.OR.MINT(122).EQ.5.OR.MINT(122).EQ.8.OR. - & MINT(122).EQ.10) MINT(108)=2 - IF(MINT(122).EQ.3.OR.MINT(122).EQ.6.OR.MINT(122).EQ.9.OR. - & MINT(122).EQ.11) MINT(108)=3 - IF(MINT(122).EQ.12.OR.MINT(122).EQ.13) MINT(108)=4 - ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.25) THEN - IF(MINT(122).GE.3) MINT(107)=1 - IF(MINT(122).EQ.2.OR.MINT(122).EQ.4) MINT(108)=1 - ELSEIF(MINT(121).EQ.2) THEN - IF(MINT(122).EQ.2.AND.MINT(11).EQ.22) MINT(107)=1 - IF(MINT(122).EQ.2.AND.MINT(12).EQ.22) MINT(108)=1 - ELSE - IF(MINT(11).EQ.22) THEN - MINT(107)=MINT(123) - IF(MINT(123).GE.4) MINT(107)=0 - IF(MINT(123).EQ.7) MINT(107)=2 - IF(MSTP(14).EQ.26.OR.MSTP(14).EQ.27) MINT(107)=4 - IF(MSTP(14).EQ.28) MINT(107)=2 - IF(MSTP(14).EQ.29) MINT(107)=3 - IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) - & MINT(107)=4 - ENDIF - IF(MINT(12).EQ.22) THEN - MINT(108)=MINT(123) - IF(MINT(123).GE.4) MINT(108)=MINT(123)-3 - IF(MINT(123).EQ.7) MINT(108)=3 - IF(MSTP(14).EQ.26) MINT(108)=2 - IF(MSTP(14).EQ.27) MINT(108)=3 - IF(MSTP(14).EQ.28.OR.MSTP(14).EQ.29) MINT(108)=4 - IF(MSTP(14).EQ.30.AND.MINT(121).EQ.4.AND.MINT(122).EQ.4) - & MINT(108)=4 - ENDIF - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.(MSTP(14).EQ.14.OR. - & MSTP(14).EQ.17.OR.MSTP(14).EQ.18.OR.MSTP(14).EQ.23)) THEN - MINTTP=MINT(107) - MINT(107)=MINT(108) - MINT(108)=MINTTP - ENDIF - ENDIF - IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 - IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 - -C...Select default processes according to incoming beams -C...(already done for gamma-p and gamma-gamma with -C...MSTP(14) = 10, 20, 25 or 30). - IF(MINT(121).GT.1) THEN - ELSEIF(MSEL.EQ.1.OR.MSEL.EQ.2) THEN - - IF(MINT(43).EQ.1) THEN -C...Lepton + lepton -> gamma/Z0 or W. - IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1 - IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1 - - ELSEIF(MINT(43).LE.3.AND.MINT(123).EQ.0.AND. - & (MINT(11).EQ.22.OR.MINT(12).EQ.22)) THEN -C...Unresolved photon + lepton: Compton scattering. - MSUB(133)=1 - MSUB(134)=1 - - ELSEIF((MINT(123).EQ.8.OR.MINT(123).EQ.9).AND.(MINT(11).EQ.22 - & .OR.MINT(12).EQ.22)) THEN -C...DIS as pure gamma* + f -> f process. - MSUB(99)=1 - - ELSEIF(MINT(43).LE.3) THEN -C...Lepton + hadron: deep inelastic scattering. - MSUB(10)=1 - - ELSEIF(MINT(123).EQ.0.AND.MINT(11).EQ.22.AND. - & MINT(12).EQ.22) THEN -C...Two unresolved photons: fermion pair production, -C...exclude lepton pairs. - DO 150 ISUB=137,140 - MSUB(ISUB)=1 - 150 CONTINUE - DO 160 II=MDCY(22,2),MDCY(22,2)+MDCY(22,3)-1 - IF(IABS(KFDP(II,1)).GE.10) MDME(II,1)=MIN(0,MDME(II,1)) - 160 CONTINUE - PTMDIR=PTMRUN - IF(MSTP(18).EQ.2) PTMDIR=PARP(15) - IF(CKIN(3).LT.PTMRUN.OR.MSEL.EQ.2) CKIN(3)=PTMDIR - CKIN(1)=MAX(CKIN(1),2D0*CKIN(3)) - - ELSEIF((MINT(123).EQ.0.AND.(MINT(11).EQ.22.OR.MINT(12).EQ.22)) - & .OR.(MINT(123).GE.4.AND.MINT(123).LE.6.AND.MINT(11).EQ.22.AND. - & MINT(12).EQ.22)) THEN -C...Unresolved photon + hadron: photon-parton scattering. - DO 170 ISUB=131,136 - MSUB(ISUB)=1 - 170 CONTINUE - - ELSEIF(MSEL.EQ.1) THEN -C...High-pT QCD processes: - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - PTMN=PTMRUN - VINT(154)=PTMN - IF(CKIN(3).LT.PTMN) MSUB(95)=1 - IF(MSUB(95).EQ.1.AND.MINT(50).EQ.0) MSUB(95)=0 - - ELSE -C...All QCD processes: - MSUB(11)=1 - MSUB(12)=1 - MSUB(13)=1 - MSUB(28)=1 - MSUB(53)=1 - MSUB(68)=1 - MSUB(91)=1 - MSUB(92)=1 - MSUB(93)=1 - MSUB(94)=1 - MSUB(95)=1 - ENDIF - - ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN -C...Heavy quark production. - MSUB(81)=1 - MSUB(82)=1 - MSUB(84)=1 - DO 180 J=1,MIN(8,MDCY(21,3)) - MDME(MDCY(21,2)+J-1,1)=0 - 180 CONTINUE - MDME(MDCY(21,2)+MSEL-1,1)=1 - MSUB(85)=1 - DO 190 J=1,MIN(12,MDCY(22,3)) - MDME(MDCY(22,2)+J-1,1)=0 - 190 CONTINUE - MDME(MDCY(22,2)+MSEL-1,1)=1 - - ELSEIF(MSEL.EQ.10) THEN -C...Prompt photon production: - MSUB(14)=1 - MSUB(18)=1 - MSUB(29)=1 - - ELSEIF(MSEL.EQ.11) THEN -C...Z0/gamma* production: - MSUB(1)=1 - - ELSEIF(MSEL.EQ.12) THEN -C...W+/- production: - MSUB(2)=1 - - ELSEIF(MSEL.EQ.13) THEN -C...Z0 + jet: - MSUB(15)=1 - MSUB(30)=1 - - ELSEIF(MSEL.EQ.14) THEN -C...W+/- + jet: - MSUB(16)=1 - MSUB(31)=1 - - ELSEIF(MSEL.EQ.15) THEN -C...Z0 & W+/- pair production: - MSUB(19)=1 - MSUB(20)=1 - MSUB(22)=1 - MSUB(23)=1 - MSUB(25)=1 - - ELSEIF(MSEL.EQ.16) THEN -C...h0 production: - MSUB(3)=1 - MSUB(102)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - - ELSEIF(MSEL.EQ.17) THEN -C...h0 & Z0 or W+/- pair production: - MSUB(24)=1 - MSUB(26)=1 - - ELSEIF(MSEL.EQ.18) THEN -C...h0 production; interesting processes in e+e-. - MSUB(24)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - - ELSEIF(MSEL.EQ.19) THEN -C...h0, H0 and A0 production; interesting processes in e+e-. - MSUB(24)=1 - MSUB(103)=1 - MSUB(123)=1 - MSUB(124)=1 - MSUB(153)=1 - MSUB(171)=1 - MSUB(173)=1 - MSUB(174)=1 - MSUB(158)=1 - MSUB(176)=1 - MSUB(178)=1 - MSUB(179)=1 - - ELSEIF(MSEL.EQ.21) THEN -C...Z'0 production: - MSUB(141)=1 - - ELSEIF(MSEL.EQ.22) THEN -C...W'+/- production: - MSUB(142)=1 - - ELSEIF(MSEL.EQ.23) THEN -C...H+/- production: - MSUB(143)=1 - - ELSEIF(MSEL.EQ.24) THEN -C...R production: - MSUB(144)=1 - - ELSEIF(MSEL.EQ.25) THEN -C...LQ (leptoquark) production. - MSUB(145)=1 - MSUB(162)=1 - MSUB(163)=1 - MSUB(164)=1 - - ELSEIF(MSEL.GE.35.AND.MSEL.LE.38) THEN -C...Production of one heavy quark (W exchange): - MSUB(83)=1 - DO 200 J=1,MIN(8,MDCY(21,3)) - MDME(MDCY(21,2)+J-1,1)=0 - 200 CONTINUE - MDME(MDCY(21,2)+MSEL-31,1)=1 - -CMRENNA++Define SUSY alternatives. - ELSEIF(MSEL.EQ.39) THEN -C...Turn on all SUSY processes. - IF(MINT(43).EQ.4) THEN -C...Hadron-hadron processes. - DO 210 I=201,301 - IF(ISET(I).GE.0) MSUB(I)=1 - 210 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN -C...Lepton-lepton processes: QED production of squarks. - DO 220 I=201,214 - MSUB(I)=1 - 220 CONTINUE - MSUB(210)=0 - MSUB(211)=0 - MSUB(212)=0 - DO 230 I=216,228 - MSUB(I)=1 - 230 CONTINUE - DO 240 I=261,263 - MSUB(I)=1 - 240 CONTINUE - MSUB(277)=1 - MSUB(278)=1 - ENDIF - - ELSEIF(MSEL.EQ.40) THEN -C...Gluinos and squarks. - IF(MINT(43).EQ.4) THEN - MSUB(243)=1 - MSUB(244)=1 - MSUB(258)=1 - MSUB(259)=1 - MSUB(261)=1 - MSUB(262)=1 - MSUB(264)=1 - MSUB(265)=1 - DO 250 I=271,296 - MSUB(I)=1 - 250 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN - MSUB(277)=1 - MSUB(278)=1 - ENDIF - - ELSEIF(MSEL.EQ.41) THEN -C...Stop production. - MSUB(261)=1 - MSUB(262)=1 - MSUB(263)=1 - IF(MINT(43).EQ.4) THEN - MSUB(264)=1 - MSUB(265)=1 - ENDIF - - ELSEIF(MSEL.EQ.42) THEN -C...Slepton production. - DO 260 I=201,214 - MSUB(I)=1 - 260 CONTINUE - IF(MINT(43).NE.4) THEN - MSUB(210)=0 - MSUB(211)=0 - MSUB(212)=0 - ENDIF - - ELSEIF(MSEL.EQ.43) THEN -C...Neutralino/Chargino + Gluino/Squark. - IF(MINT(43).EQ.4) THEN - DO 270 I=237,242 - MSUB(I)=1 - 270 CONTINUE - DO 280 I=246,254 - MSUB(I)=1 - 280 CONTINUE - MSUB(256)=1 - ENDIF - - ELSEIF(MSEL.EQ.44) THEN -C...Neutralino/Chargino pair production. - IF(MINT(43).EQ.4) THEN - DO 290 I=216,236 - MSUB(I)=1 - 290 CONTINUE - ELSEIF(MINT(43).EQ.1) THEN - DO 300 I=216,228 - MSUB(I)=1 - 300 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.45) THEN -C...Sbottom production. - MSUB(287)=1 - MSUB(288)=1 - IF(MINT(43).EQ.4) THEN - DO 310 I=281,296 - MSUB(I)=1 - 310 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.50) THEN -C...Pair production of technipions and gauge bosons. - DO 320 I=361,368 - MSUB(I)=1 - 320 CONTINUE - IF(MINT(43).EQ.4) THEN - DO 330 I=370,377 - MSUB(I)=1 - 330 CONTINUE - ENDIF - - ELSEIF(MSEL.EQ.51) THEN -C...QCD 2 -> 2 processes with compositeness/technicolor modifications. - DO 340 I=381,386 - MSUB(I)=1 - 340 CONTINUE - ENDIF - -C...Find heaviest new quark flavour allowed in processes 81-84. - KFLQM=1 - DO 350 I=1,MIN(8,MDCY(21,3)) - IDC=I+MDCY(21,2)-1 - IF(MDME(IDC,1).LE.0) GOTO 350 - KFLQM=I - 350 CONTINUE - IF(MSTP(7).GE.1.AND.MSTP(7).LE.8.AND.(MSEL.LE.3.OR.MSEL.GE.9)) - &KFLQM=MSTP(7) - MINT(55)=KFLQM - KFPR(81,1)=KFLQM - KFPR(81,2)=KFLQM - KFPR(82,1)=KFLQM - KFPR(82,2)=KFLQM - KFPR(83,1)=KFLQM - KFPR(84,1)=KFLQM - KFPR(84,2)=KFLQM - -C...Find heaviest new fermion flavour allowed in process 85. - KFLFM=1 - DO 360 I=1,MIN(12,MDCY(22,3)) - IDC=I+MDCY(22,2)-1 - IF(MDME(IDC,1).LE.0) GOTO 360 - KFLFM=KFDP(IDC,1) - 360 CONTINUE - IF(((MSTP(7).GE.1.AND.MSTP(7).LE.8).OR.(MSTP(7).GE.11.AND. - &MSTP(7).LE.18)).AND.(MSEL.LE.3.OR.MSEL.GE.9)) KFLFM=MSTP(7) - MINT(56)=KFLFM - KFPR(85,1)=KFLFM - KFPR(85,2)=KFLFM - -C...Import relevant information on external user processes. - IF(MINT(111).EQ.11) THEN - IPYPR=0 - DO 390 IUP=1,NPRUP -C...Find next empty PYTHIA process number slot and enable it. - 370 IPYPR=IPYPR+1 - IF(IPYPR.GT.500) CALL PYERRM(26, - & '(PYINPR.) no more empty slots for user processes') - IF(ISET(IPYPR).GE.0.AND.ISET(IPYPR).LE.9) GOTO 370 - IF(IPYPR.GE.91.AND.IPYPR.LE.100) GOTO 370 - ISET(IPYPR)=11 -C...Overwrite KFPR with references back to process number and ID. - KFPR(IPYPR,1)=IUP - KFPR(IPYPR,2)=LPRUP(IUP) -C...Process title. - WRITE(CHIPR,'(I10)') LPRUP(IUP) - ICHIN=1 - DO 380 ICH=1,9 - IF(CHIPR(ICH:ICH).EQ.' ') ICHIN=ICH+1 - 380 CONTINUE - PROC(IPYPR)='User process '//CHIPR(ICHIN:10)//' ' -C...Switch on process. - MSUB(IPYPR)=1 - 390 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYINRE -C...Calculates full and effective widths of gauge bosons, stores -C...masses and widths, rescales coefficients to be used for -C...resonance production generation. - - SUBROUTINE PYINRE - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT4/,/PYINT6/,/PYMSSM/ -C...Local arrays and data. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),WDTPM(0:400), - &WDTEM(0:400,0:5),KCORD(500),PMORD(500) - -C...Born level couplings in MSSM Higgs doublet sector. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - IF(MSTP(4).EQ.2) THEN - TANBE=PARU(141) - RATBE=((1D0-TANBE**2)/(1D0+TANBE**2))**2 - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SQMH=PMAS(25,1)**2 - SQMA=SQMH*(SQMZ-SQMH)/(SQMZ*RATBE-SQMH) - SQMHP=0.5D0*(SQMA+SQMZ+SQRT((SQMA+SQMZ)**2-4D0*SQMA*SQMZ*RATBE)) - SQMHC=SQMA+SQMW - IF(SQMH.GE.SQMZ.OR.MIN(SQMA,SQMHP,SQMHC).LE.0D0) THEN - WRITE(MSTU(11),5000) - STOP - ENDIF - PMAS(35,1)=SQRT(SQMHP) - PMAS(36,1)=SQRT(SQMA) - PMAS(37,1)=SQRT(SQMHC) - ALSU=0.5D0*ATAN(2D0*TANBE*(SQMA+SQMZ)/((1D0-TANBE**2)* - & (SQMA-SQMZ))) - BESU=ATAN(TANBE) - PARU(142)=1D0 - PARU(143)=1D0 - PARU(161)=-SIN(ALSU)/COS(BESU) - PARU(162)=COS(ALSU)/SIN(BESU) - PARU(163)=PARU(161) - PARU(164)=SIN(BESU-ALSU) - PARU(165)=PARU(164) - PARU(168)=SIN(BESU-ALSU)+0.5D0*COS(2D0*BESU)*SIN(BESU+ALSU)/XW - PARU(171)=COS(ALSU)/COS(BESU) - PARU(172)=SIN(ALSU)/SIN(BESU) - PARU(173)=PARU(171) - PARU(174)=COS(BESU-ALSU) - PARU(175)=PARU(174) - PARU(176)=COS(2D0*ALSU)*COS(BESU+ALSU)-2D0*SIN(2D0*ALSU)* - & SIN(BESU+ALSU) - PARU(177)=COS(2D0*BESU)*COS(BESU+ALSU) - PARU(178)=COS(BESU-ALSU)-0.5D0*COS(2D0*BESU)*COS(BESU+ALSU)/XW - PARU(181)=TANBE - PARU(182)=1D0/TANBE - PARU(183)=PARU(181) - PARU(184)=0D0 - PARU(185)=PARU(184) - PARU(186)=COS(BESU-ALSU) - PARU(187)=SIN(BESU-ALSU) - PARU(188)=PARU(186) - PARU(189)=PARU(187) - PARU(190)=0D0 - PARU(195)=COS(BESU-ALSU) - ENDIF - -C...Reset effective widths of gauge bosons. - DO 110 I=1,500 - DO 100 J=1,5 - WIDS(I,J)=1D0 - 100 CONTINUE - 110 CONTINUE - -C...Order resonances by increasing mass (except Z0 and W+/-). - NRES=0 - DO 140 KC=1,500 - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 140 - IF(MWID(KC).EQ.0) GOTO 140 - IF(KC.EQ.7.OR.KC.EQ.8.OR.KC.EQ.17.OR.KC.EQ.18) THEN - IF(MSTP(1).LE.3) GOTO 140 - ENDIF - IF(KF/KSUSY1.EQ.1.OR.KF/KSUSY1.EQ.2) THEN - IF(IMSS(1).LE.0) GOTO 140 - ENDIF - NRES=NRES+1 - PMRES=PMAS(KC,1) - IF(KC.EQ.23.OR.KC.EQ.24) PMRES=0D0 - DO 120 I1=NRES-1,1,-1 - IF(PMRES.GE.PMORD(I1)) GOTO 130 - KCORD(I1+1)=KCORD(I1) - PMORD(I1+1)=PMORD(I1) - 120 CONTINUE - 130 KCORD(I1+1)=KC - PMORD(I1+1)=PMRES - 140 CONTINUE - -C...Loop over possible resonances. - DO 180 I=1,NRES - KC=KCORD(I) - KF=KCHG(KC,4) - -C...Check that no fourth generation channels on by mistake. - IF(MSTP(1).LE.3) THEN - DO 150 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - KFA1=IABS(KFDP(IDC,1)) - KFA2=IABS(KFDP(IDC,2)) - IF(KFA1.EQ.7.OR.KFA1.EQ.8.OR.KFA1.EQ.17.OR.KFA1.EQ.18.OR. - & KFA2.EQ.7.OR.KFA2.EQ.8.OR.KFA2.EQ.17.OR.KFA2.EQ.18) - & MDME(IDC,1)=-1 - 150 CONTINUE - ENDIF - -C...Check that no supersymmetric channels on by mistake. - IF(IMSS(1).LE.0) THEN - DO 160 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - KFA1S=IABS(KFDP(IDC,1))/KSUSY1 - KFA2S=IABS(KFDP(IDC,2))/KSUSY1 - IF(KFA1S.EQ.1.OR.KFA1S.EQ.2.OR.KFA2S.EQ.1.OR.KFA2S.EQ.2) - & MDME(IDC,1)=-1 - 160 CONTINUE - ENDIF - -C...Find mass and evaluate width. - PMR=PMAS(KC,1) - IF(KF.EQ.25.OR.KF.EQ.35.OR.KF.EQ.36) MINT(62)=1 - IF(MWID(KC).EQ.3) MINT(63)=1 - CALL PYWIDT(KF,PMR**2,WDTP,WDTE) - MINT(51)=0 - -C...Evaluate suppression factors due to non-simulated channels. - IF(KCHG(KC,3).EQ.0) THEN - WDTP0I=0D0 - IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) - WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))**2+ - & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ - & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 - WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I - WIDS(KC,3)=0D0 - WIDS(KC,4)=0D0 - WIDS(KC,5)=0D0 - ELSE - IF(MWID(KC).EQ.3) MINT(63)=1 - CALL PYWIDT(-KF,PMR**2,WDTPM,WDTEM) - MINT(51)=0 - WDTP0I=0D0 - IF(WDTP(0).GT.0D0) WDTP0I=1D0/WDTP(0) - WIDS(KC,1)=((WDTE(0,1)+WDTE(0,2))*(WDTEM(0,1)+WDTEM(0,3))+ - & (WDTE(0,1)+WDTE(0,2))*(WDTEM(0,4)+WDTEM(0,5))+ - & (WDTE(0,4)+WDTE(0,5))*(WDTEM(0,1)+WDTEM(0,3))+ - & WDTE(0,4)*WDTEM(0,5)+WDTE(0,5)*WDTEM(0,4))*WDTP0I**2 - WIDS(KC,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*WDTP0I - WIDS(KC,3)=(WDTEM(0,1)+WDTEM(0,3)+WDTEM(0,4))*WDTP0I - WIDS(KC,4)=((WDTE(0,1)+WDTE(0,2))**2+ - & 2D0*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ - & 2D0*WDTE(0,4)*WDTE(0,5))*WDTP0I**2 - WIDS(KC,5)=((WDTEM(0,1)+WDTEM(0,3))**2+ - & 2D0*(WDTEM(0,1)+WDTEM(0,3))*(WDTEM(0,4)+WDTEM(0,5))+ - & 2D0*WDTEM(0,4)*WDTEM(0,5))*WDTP0I**2 - ENDIF - -C...Set resonance widths and branching ratios; -C...also on/off switch for decays. - IF(MWID(KC).EQ.1.OR.MWID(KC).EQ.3) THEN - PMAS(KC,2)=WDTP(0) - PMAS(KC,3)=MIN(0.9D0*PMAS(KC,1),10D0*PMAS(KC,2)) - IF(MSTP(41).EQ.0.OR.MSTP(41).EQ.1) MDCY(KC,1)=MSTP(41) - DO 170 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - BRAT(IDC)=0D0 - IF(WDTP(0).GT.0D0) BRAT(IDC)=WDTP(J)/WDTP(0) - 170 CONTINUE - ENDIF - 180 CONTINUE - -C...Flavours of leptoquark: redefine charge and name. - KFLQQ=KFDP(MDCY(42,2),1) - KFLQL=KFDP(MDCY(42,2),2) - KCHG(42,1)=KCHG(PYCOMP(KFLQQ),1)*ISIGN(1,KFLQQ)+ - &KCHG(PYCOMP(KFLQL),1)*ISIGN(1,KFLQL) - LL=1 - IF(IABS(KFLQL).EQ.13) LL=2 - IF(IABS(KFLQL).EQ.15) LL=3 - CHAF(42,1)='LQ_'//CHAF(IABS(KFLQQ),1)(1:1)// - &CHAF(IABS(KFLQL),1)(1:LL)//' ' - CHAF(42,2)=CHAF(42,2)(1:4+LL)//'bar ' - -C...Special cases in treatment of gamma*/Z0: redefine process name. - IF(MSTP(43).EQ.1) THEN - PROC(1)='f + fbar -> gamma*' - PROC(15)='f + fbar -> g + gamma*' - PROC(19)='f + fbar -> gamma + gamma*' - PROC(30)='f + g -> f + gamma*' - PROC(35)='f + gamma -> f + gamma*' - ELSEIF(MSTP(43).EQ.2) THEN - PROC(1)='f + fbar -> Z0' - PROC(15)='f + fbar -> g + Z0' - PROC(19)='f + fbar -> gamma + Z0' - PROC(30)='f + g -> f + Z0' - PROC(35)='f + gamma -> f + Z0' - ELSEIF(MSTP(43).EQ.3) THEN - PROC(1)='f + fbar -> gamma*/Z0' - PROC(15)='f + fbar -> g + gamma*/Z0' - PROC(19)='f+ fbar -> gamma + gamma*/Z0' - PROC(30)='f + g -> f + gamma*/Z0' - PROC(35)='f + gamma -> f + gamma*/Z0' - ENDIF - -C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name. - IF(MSTP(44).EQ.1) THEN - PROC(141)='f + fbar -> gamma*' - ELSEIF(MSTP(44).EQ.2) THEN - PROC(141)='f + fbar -> Z0' - ELSEIF(MSTP(44).EQ.3) THEN - PROC(141)='f + fbar -> Z''0' - ELSEIF(MSTP(44).EQ.4) THEN - PROC(141)='f + fbar -> gamma*/Z0' - ELSEIF(MSTP(44).EQ.5) THEN - PROC(141)='f + fbar -> gamma*/Z''0' - ELSEIF(MSTP(44).EQ.6) THEN - PROC(141)='f + fbar -> Z0/Z''0' - ELSEIF(MSTP(44).EQ.7) THEN - PROC(141)='f + fbar -> gamma*/Z0/Z''0' - ENDIF - -C...Special cases in treatment of WW -> WW: redefine process name. - IF(MSTP(45).EQ.1) THEN - PROC(77)='W+ + W+ -> W+ + W+' - ELSEIF(MSTP(45).EQ.2) THEN - PROC(77)='W+ + W- -> W+ + W-' - ELSEIF(MSTP(45).EQ.3) THEN - PROC(77)='W+/- + W+/- -> W+/- + W+/-' - ENDIF - -C...Format for error information. - 5000 FORMAT(1X,'Error: unphysical input tan^2(beta) and m_H ', - &'combination'/1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYJMAS -C...Determines, approximately, the two jet masses that minimize -C...the sum m_H^2 + m_L^2, a la Clavelli and Wyler. - - SUBROUTINE PYJMAS(PMH,PML) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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)=0D0 - 100 CONTINUE - DO 110 J2=1,4 - PS(J1,J2)=0D0 - 110 CONTINUE - 120 CONTINUE - PSS=0D0 - PIMASS=PMAS(PYCOMP(211),1) - -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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 170 - ENDIF - IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYJMAS:) no more memory left in PYJETS') - PMH=-2D0 - PML=-2D0 - 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)=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PIMASS - 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 PYERRM(8,'(PYJMAS:) too few particles for analysis') - PMH=-1D0 - PML=-1D0 - RETURN - ENDIF - PARU(61)=SQRT(MAX(0D0,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)/3D0-1D0/9D0 - SR=-0.5D0*(SQ+1D0/9D0+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)+1D0/27D0 - SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) - SMA=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-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=0D0 - 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=0D0 - 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.0D0) 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(1D-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ - &MAX(1D-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=0D0 - 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=2D0*(P(I,5)**2-PPS) - IF(K(I,3).EQ.2) PMDI=2D0*(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(0D0,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) - PS(2,5)=SQRT(MAX(0D0,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********************************************************************* - -C...PYJOIN -C...Connects a sequence of partons with colour flow indices, -C...as required for subsequent shower evolution (or other operations). - - SUBROUTINE PYJOIN(NJOIN,IJOIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local array. - 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=PYCOMP(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.5D0+PYR(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 PYERRM(12, - &'(PYJOIN:) given entries can not be joined by one string') - - RETURN - END - -C********************************************************************* - -C...PYJURF -C...From three given input vectors in PJU the boost VJU from -C...the "lab frame" to the junction rest frame is constructed. - - SUBROUTINE PYJURF(PJU,VJU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Input, output and local arrays. - DIMENSION PJU(3,5),VJU(5),PSUM(5),A(3,3),PENEW(3),PCM(5,5) - DATA TWOPI/6.283186D0/ - -C...Calculate masses and other invariants. - DO 100 J=1,4 - PSUM(J)=PJU(1,J)+PJU(2,J)+PJU(3,J) - 100 CONTINUE - PSUM2=PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2 - PSUM(5)=SQRT(PSUM2) - DO 120 I=1,3 - DO 110 J=1,3 - A(I,J)=PJU(I,4)*PJU(J,4)-PJU(I,1)*PJU(J,1)- - & PJU(I,2)*PJU(J,2)-PJU(I,3)*PJU(J,3) - 110 CONTINUE - 120 CONTINUE - -C...Pick I to be most massive parton and J to be the one closest to I. - ITRY=0 - I=1 - IF(A(2,2).GT.A(1,1)) I=2 - IF(A(3,3).GT.MAX(A(1,1),A(2,2))) I=3 - 130 ITRY=ITRY+1 - J=1+MOD(I,3) - K=1+MOD(J,3) - IF(A(I,K)**2*A(J,J).LT.A(I,J)**2*A(K,K)) THEN - K=1+MOD(I,3) - J=1+MOD(K,3) - ENDIF - PMI2=A(I,I) - PMJ2=A(J,J) - PMK2=A(K,K) - AIJ=A(I,J) - AIK=A(I,K) - AJK=A(J,K) - -C...Trivial find new parton energies if all three partons are massless. - IF(PMI2.LT.1D-4) THEN - PEI=SQRT(2D0*AIK*AIJ/(3D0*AJK)) - PEJ=SQRT(2D0*AJK*AIJ/(3D0*AIK)) - PEK=SQRT(2D0*AIK*AJK/(3D0*AIJ)) - -C...Else find momentum range for parton I and values at extremes. - ELSE - PAIMIN=0D0 - PEIMIN=SQRT(PMI2) - PEJMIN=AIJ/PEIMIN - PEKMIN=AIK/PEIMIN - PAJMIN=SQRT(MAX(0D0,PEJMIN**2-PMJ2)) - PAKMIN=SQRT(MAX(0D0,PEKMIN**2-PMK2)) - FMIN=PEJMIN*PEKMIN+0.5D0*PAJMIN*PAKMIN-AJK - PEIMAX=(AIJ+AIK)/SQRT(PMJ2+PMK2+2D0*AJK) - IF(PMJ2.GT.1D-4) PEIMAX=AIJ/SQRT(PMJ2) - PAIMAX=SQRT(MAX(0D0,PEIMAX**2-PMI2)) - HI=PEIMAX**2-0.25D0*PAIMAX**2 - PAJMAX=(PEIMAX*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))- - & 0.5D0*PAIMAX*AIJ)/HI - PAKMAX=(PEIMAX*SQRT(MAX(0D0,AIK**2-PMK2*HI))- - & 0.5D0*PAIMAX*AIK)/HI - PEJMAX=SQRT(PAJMAX**2+PMJ2) - PEKMAX=SQRT(PAKMAX**2+PMK2) - FMAX=PEJMAX*PEKMAX+0.5D0*PAJMAX*PAKMAX-AJK - -C...If unexpected values at upper endpoint then pick another parton. - IF(FMAX.GT.0D0.AND.ITRY.LE.2) THEN - I1=1+MOD(I,3) - IF(A(I1,I1).GE.1D-4) THEN - I=I1 - GOTO 130 - ENDIF - ITRY=ITRY+1 - I1=1+MOD(I,3) - IF(ITRY.LE.2.AND.A(I1,I1).GE.1D-4) THEN - I=I1 - GOTO 130 - ENDIF - ENDIF - -C..Start binary + linear search to find solution inside range. - ITER=0 - ITMIN=0 - ITMAX=0 - PAI=0.5D0*(PAIMIN+PAIMAX) - 140 ITER=ITER+1 - -C...Derive momentum of other two partons and distance to root. - PEI=SQRT(PAI**2+PMI2) - HI=PEI**2-0.25D0*PAI**2 - PAJ=(PEI*SQRT(MAX(0D0,AIJ**2-PMJ2*HI))-0.5D0*PAI*AIJ)/HI - PEJ=SQRT(PAJ**2+PMJ2) - PAK=(PEI*SQRT(MAX(0D0,AIK**2-PMK2*HI))-0.5D0*PAI*AIK)/HI - PEK=SQRT(PAK**2+PMK2) - FNOW=PEJ*PEK+0.5D0*PAJ*PAK-AJK - -C...Pick next I momentum to explore, hopefully closer to root. - IF(FNOW.GT.0D0) THEN - PAIMIN=PAI - FMIN=FNOW - ITMIN=ITMIN+1 - ELSE - PAIMAX=PAI - FMAX=FNOW - ITMAX=ITMAX+1 - ENDIF - IF((ITER.LT.10.OR.ITMIN.LE.1.OR.ITMAX.LE.1).AND.ITER.LT.20) - & THEN - PAI=0.5D0*(PAIMIN+PAIMAX) - GOTO 140 - ELSEIF(ITER.LT.40.AND.FMIN.GT.0D0.AND.FMAX.LT.0D0.AND. - & ABS(FNOW).GT.1D-12*PSUM2) THEN - PAI=PAIMIN+(PAIMAX-PAIMIN)*FMIN/(FMIN-FMAX) - GOTO 140 - ENDIF - ENDIF - -C...Now know energies in junction rest frame. - PENEW(I)=PEI - PENEW(J)=PEJ - PENEW(K)=PEK - -C...Boost (copy of) partons to their rest frame. - VXCM=-PSUM(1)/PSUM(5) - VYCM=-PSUM(2)/PSUM(5) - VZCM=-PSUM(3)/PSUM(5) - GAMCM=SQRT(1D0+VXCM**2+VYCM**2+VZCM**2) - DO 150 I=1,3 - FAC1=PJU(I,1)*VXCM+PJU(I,2)*VYCM+PJU(I,3)*VZCM - FAC2=FAC1/(1D0+GAMCM)+PJU(I,4) - PCM(I,1)=PJU(I,1)+FAC2*VXCM - PCM(I,2)=PJU(I,2)+FAC2*VYCM - PCM(I,3)=PJU(I,3)+FAC2*VZCM - PCM(I,4)=PJU(I,4)*GAMCM+FAC1 - PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) - 150 CONTINUE - -C...Construct difference vectors and boost to junction rest frame. - DO 160 J=1,3 - PCM(4,J)=PCM(1,J)/PCM(1,4)-PCM(2,J)/PCM(2,4) - PCM(5,J)=PCM(1,J)/PCM(1,4)-PCM(3,J)/PCM(3,4) - 160 CONTINUE - PCM(4,4)=PENEW(1)/PCM(1,4)-PENEW(2)/PCM(2,4) - PCM(5,4)=PENEW(1)/PCM(1,4)-PENEW(3)/PCM(3,4) - PCM4S=PCM(4,1)**2+PCM(4,2)**2+PCM(4,3)**2 - PCM5S=PCM(5,1)**2+PCM(5,2)**2+PCM(5,3)**2 - PCM45=PCM(4,1)*PCM(5,1)+PCM(4,2)*PCM(5,2)+PCM(4,3)*PCM(5,3) - C4=(PCM5S*PCM(4,4)-PCM45*PCM(5,4))/(PCM4S*PCM5S-PCM45**2) - C5=(PCM4S*PCM(5,4)-PCM45*PCM(4,4))/(PCM4S*PCM5S-PCM45**2) - VXJU=C4*PCM(4,1)+C5*PCM(5,1) - VYJU=C4*PCM(4,2)+C5*PCM(5,2) - VZJU=C4*PCM(4,3)+C5*PCM(5,3) - GAMJU=SQRT(1D0+VXJU**2+VYJU**2+VZJU**2) - -C...Add two boosts, giving final result. - FCM=(VXJU*VXCM+VYJU*VYCM+VZJU*VZCM)/(1+GAMCM)+GAMJU - VJU(1)=VXJU+FCM*VXCM - VJU(2)=VYJU+FCM*VYCM - VJU(3)=VZJU+FCM*VZCM - VJU(4)=SQRT(1D0+VJU(1)**2+VJU(2)**2+VJU(3)**2) - VJU(5)=1D0 - -C...In case of error in reconstruction: revert to CM frame of system. - CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ - &(PCM(1,5)*PCM(2,5)) - CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ - &(PCM(1,5)*PCM(3,5)) - CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ - &(PCM(2,5)*PCM(3,5)) - ERRCCM=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 - ERRTCM=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) - DO 170 I=1,3 - FAC1=PJU(I,1)*VJU(1)+PJU(I,2)*VJU(2)+PJU(I,3)*VJU(3) - FAC2=FAC1/(1D0+VJU(4))+PJU(I,4) - PCM(I,1)=PJU(I,1)+FAC2*VJU(1) - PCM(I,2)=PJU(I,2)+FAC2*VJU(2) - PCM(I,3)=PJU(I,3)+FAC2*VJU(3) - PCM(I,4)=PJU(I,4)*VJU(4)+FAC1 - PCM(I,5)=SQRT(PCM(I,1)**2+PCM(I,2)**2+PCM(I,3)**2) - 170 CONTINUE - CTH12=(PCM(1,1)*PCM(2,1)+PCM(1,2)*PCM(2,2)+PCM(1,3)*PCM(2,3))/ - &(PCM(1,5)*PCM(2,5)) - CTH13=(PCM(1,1)*PCM(3,1)+PCM(1,2)*PCM(3,2)+PCM(1,3)*PCM(3,3))/ - &(PCM(1,5)*PCM(3,5)) - CTH23=(PCM(2,1)*PCM(3,1)+PCM(2,2)*PCM(3,2)+PCM(2,3)*PCM(3,3))/ - &(PCM(2,5)*PCM(3,5)) - ERRCJU=(CTH12+0.5D0)**2+(CTH13+0.5D0)**2+(CTH23+0.5D0)**2 - ERRTJU=TWOPI-ACOS(CTH12)-ACOS(CTH13)-ACOS(CTH23) - IF(ERRCJU+ERRTJU.GT.ERRCCM+ERRTCM) THEN - VJU(1)=VXCM - VJU(2)=VYCM - VJU(3)=VZCM - VJU(4)=GAMCM - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYKCUT -C...Dummy routine, which the user can replace in order to make cuts on -C...the kinematics on the parton level before the matrix elements are -C...evaluated and the event is generated. The cross-section estimates -C...will automatically take these cuts into account, so the given -C...values are for the allowed phase space region only. MCUT=0 means -C...that the event has passed the cuts, MCUT=1 that it has failed. - - SUBROUTINE PYKCUT(MCUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYINT1/,/PYINT2/ - -C...Set default value (accepting event) for MCUT. - MCUT=0 - -C...Read out subprocess number. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - -C...Read out tau, y*, cos(theta), tau' (where defined, else =0). - TAU=VINT(21) - YST=VINT(22) - CTH=0D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) CTH=VINT(23) - TAUP=0D0 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUP=VINT(26) - -C...Calculate x_1, x_2, x_F. - IF(ISTSB.LE.2.OR.ISTSB.GE.5) THEN - X1=SQRT(TAU)*EXP(YST) - X2=SQRT(TAU)*EXP(-YST) - ELSE - X1=SQRT(TAUP)*EXP(YST) - X2=SQRT(TAUP)*EXP(-YST) - ENDIF - XF=X1-X2 - -C...Calculate shat, that, uhat, p_T^2. - SHAT=TAU*VINT(2) - SQM3=VINT(63) - SQM4=VINT(64) - RM3=SQM3/SHAT - RM4=SQM4/SHAT - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - RPTS=4D0*VINT(71)**2/SHAT - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=2D0*RM3*RM4 - RSQM=1D0+RM34 - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - THAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) - UHAT=-0.5D0*SHAT*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - PT2=MAX(VINT(71)**2,0.25D0*SHAT*BE34**2*(1D0-CTH**2)) - -C...Decisions by user to be put here. - -C...Stop program if this routine is ever called. -C...You should not copy these lines to your own routine. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYKCUT routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYK -C...Provides various integer-valued event related data. - - FUNCTION PYK(I,J) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Default value. For I=0 number of entries, number of stable entries -C...or 3 times total charge. - PYK=0 - IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN - ELSEIF(I.EQ.0.AND.J.EQ.1) THEN - PYK=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) PYK=PYK+1 - IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+ - & PYCHGE(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 - PYK=K(I,J) - ELSEIF(J.EQ.6) THEN - PYK=PYCHGE(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) PYK=1 - IF(J.EQ.8) PYK=PYK*K(I,2) - ELSEIF(J.LE.12) THEN - KFA=IABS(K(I,2)) - KC=PYCOMP(KFA) - KQ=0 - IF(KC.NE.0) KQ=KCHG(KC,2) - IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) PYK=K(I,2) - IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) PYK=K(I,2) - IF(J.EQ.11) PYK=KC - IF(J.EQ.12) PYK=KQ*ISIGN(1,K(I,2)) - -C...Heaviest flavour in hadron/diquark. - ELSEIF(J.EQ.13) THEN - KFA=IABS(K(I,2)) - PYK=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) - IF(KFA.LT.10) PYK=KFA - IF(MOD(KFA/1000,10).NE.0) PYK=MOD(KFA/1000,10) - PYK=PYK*ISIGN(1,K(I,2)) - -C...Particle history: generation, ancestor, rank. - ELSEIF(J.LE.15) THEN - I2=I - I1=I - 110 PYK=PYK+1 - I2=I1 - I1=K(I1,3) - IF(I1.GT.0) THEN - IF(K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 - ENDIF - IF(J.EQ.15) PYK=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) PYK=PYK+1 - 130 CONTINUE - ELSE - I3=I2 - 140 PYK=PYK+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 PYK=PYK+1 - I3=I1 - I1=K(I1,3) - I0=MAX(1,I1) - KC=PYCOMP(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(PYK.EQ.1) PYK=-1 - IF(PYK.GT.1) PYK=0 - RETURN - ENDIF - IF(KCHG(KC,2).EQ.0) GOTO 150 - IF(K(I1,1).NE.12) PYK=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) PYK=0 - K3P=K(I3+1,3) - IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) PYK=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) PYK=MAX(0,K(I,5)-K(I,4)+1) - IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) PYK=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) PYK=MOD(K(I,4)/MSTU(5),MSTU(5)) - IF(J.EQ.20) PYK=MOD(K(I,5)/MSTU(5),MSTU(5)) - IF(J.EQ.21) PYK=MOD(K(I,4),MSTU(5)) - IF(J.EQ.22) PYK=MOD(K(I,5),MSTU(5)) - ELSE - ENDIF - - RETURN - END - -C******************************************************************** - -C...PYKFDI -C...Generates a new flavour pair and combines off a hadron - - SUBROUTINE PYKFDI(KFL1,KFL2,KFL3,KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION PD(7) - - IF(MSTU(123).EQ.0.AND.MSTJ(12).GE.0) CALL PYKFIN - -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 - IF(MSTJ(12).GE.5) CALL PYERRM(29, - & '(PYKFDI:) Sorry, option MSTJ(15)=1 not available' // - & ' together with MSTJ(12)>=5 modification') - KTAB1=-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - KFL1S=MOD(KF1A,10) - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) - & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 - IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 - IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A - KTAB2=0 - IF(KF2A.NE.0) THEN - KTAB2=-1 - IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A - KFL2A=MOD(KF2A/1000,10) - KFL2B=MOD(KF2A/100,10) - KFL2S=MOD(KF2A,10) - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) - & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 - IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 - ENDIF - IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140 - ENDIF - -C.. Recognize rank 0 diquark case - 100 IRANK=1 - KFDIQ=MAX(KF1A,KF2A) - IF(KFDIQ.GT.10.AND.KFDIQ.LT.10000) IRANK=0 - -C.. Join two flavours to meson or baryon. Test for popcorn. - IF(KF2A.GT.0)THEN - MBARY=0 - IF(KFDIQ.GT.10) THEN - IF(IRANK.EQ.0.AND.MSTJ(12).LT.5) - & CALL PYNMES(KFDIQ) - IF(MSTU(121).NE.0) THEN - MSTU(121)=0 - RETURN - ENDIF - MBARY=2 - ENDIF - KFQOLD=KF1A - KFQVER=KF2A - GOTO 130 - ENDIF - -C.. Separate incoming flavours, curtain flavour consistency check - KFIN=KFL1 - KFQOLD=KF1A - KFQPOP=KF1A/10000 - IF(KF1A.GT.10)THEN - KFIN=-KFL1 - KFL1A=MOD(KF1A/1000,10) - KFL1B=MOD(KF1A/100,10) - IF(IRANK.EQ.0)THEN - QAWT=1D0 - IF(KFL1A.GE.3) QAWT=PARF(136+KFL1A/4) - IF(KFL1B.GE.3) QAWT=QAWT/PARF(136+KFL1B/4) - KFQPOP=KFL1A+(KFL1B-KFL1A)*INT(1D0/(QAWT+1D0)+PYR(0)) - ENDIF - IF(KFQPOP.NE.KFL1B.AND.KFQPOP.NE.KFL1A) THEN - MSTU(121)=0 - RETURN - ENDIF - KFQOLD=KFL1A+KFL1B-KFQPOP - ENDIF - -C...Meson/baryon choice. Set number of mesons if starting a popcorn -C...system. - 110 MBARY=0 - IF(KF1A.LE.10.AND.MSTJ(12).GT.0)THEN - IF(MSTU(121).EQ.-1.OR.(1D0+PARJ(1))*PYR(0).GT.1D0)THEN - MBARY=1 - CALL PYNMES(0) - ENDIF - ELSEIF(KF1A.GT.10)THEN - MBARY=2 - IF(IRANK.EQ.0) CALL PYNMES(KF1A) - IF(MSTU(121).GT.0) MBARY=-1 - ENDIF - -C..x->H+q: Choose single vertex quark. Jump to form hadron. - IF(MBARY.EQ.0.OR.MBARY.EQ.2)THEN - KFQVER=1+INT((2D0+PARJ(2))*PYR(0)) - KFL3=ISIGN(KFQVER,-KFIN) - GOTO 130 - ENDIF - -C..x->H+qq: (IDW=proper PARF position for diquark weights) - IDW=160 - IF(MBARY.EQ.1)THEN - IF(MSTU(121).EQ.0) IDW=150 - SQWT=PARF(IDW+1) - IF(MSTU(121).GT.0) SQWT=SQWT*PARF(135)*PARF(138)**MSTU(121) - KFQPOP=1+INT((2D0+SQWT)*PYR(0)) -C.. Shift to s-curtain parameters if needed - IF(KFQPOP.GE.3.AND.MSTJ(12).GE.5)THEN - PARF(194)=PARF(138)*PARF(139) - PARF(193)=PARJ(8)+PARJ(9) - ENDIF - ENDIF - -C.. x->H+qq: Get vertex quark - IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN - IDW=MSTU(122) - MSTU(121)=MSTU(121)-1 - IF(IDW.EQ.170) THEN - IF(MSTU(121).EQ.0)THEN - IPOS=3*MIN(KFQPOP-1,2)+MIN(KFQOLD-1,2) - ELSE - IPOS=3*3+3*MAX(0,MIN(KFQPOP-2,1))+MIN(KFQOLD-1,2) - ENDIF - ELSE - IF(MSTU(121).EQ.0)THEN - IPOS=3*5+5*MIN(KFQPOP-1,3)+MIN(KFQOLD-1,4) - ELSE - IPOS=3*5+5*4+MIN(KFQOLD-1,4) - ENDIF - ENDIF - IPOS=200+30*IPOS+1 - - IMES=-1 - RMES=PYR(0)*PARF(194) - 120 IMES=IMES+1 - RMES=RMES-PARF(IPOS+IMES) - IF(IMES.EQ.30) THEN - MSTU(121)=-1 - KF=-111 - RETURN - ENDIF - IF(RMES.GT.0D0) GOTO 120 - KMUL=IMES/5 - KFJ=2*KMUL+1 - IF(KMUL.EQ.2) KFJ=10003 - IF(KMUL.EQ.3) KFJ=10001 - IF(KMUL.EQ.4) KFJ=20003 - IF(KMUL.EQ.5) KFJ=5 - IDIAG=0 - KFQVER=MOD(IMES,5)+1 - IF(KFQVER.GE.KFQOLD) KFQVER=KFQVER+1 - IF(KFQVER.GT.3)THEN - IDIAG=KFQVER-3 - KFQVER=KFQOLD - ENDIF - ELSE - IF(MBARY.EQ.-1) IDW=170 - SQWT=PARF(IDW+2) - IF(KFQPOP.EQ.3) SQWT=PARF(IDW+3) - IF(KFQPOP.GT.3) SQWT=PARF(IDW+3)*(1D0/PARF(IDW+5)+1D0)/2D0 - KFQVER=MIN(3,1+INT((2D0+SQWT)*PYR(0))) - IF(KFQPOP.LT.3.AND.KFQVER.LT.3)THEN - KFQVER=KFQPOP - IF(PYR(0).GT.PARF(IDW+4)) KFQVER=3-KFQPOP - ENDIF - ENDIF - -C..x->H+qq: form outgoing diquark with KFQPOP flag at 10000-pos - KFLDS=3 - IF(KFQPOP.NE.KFQVER)THEN - SWT=PARF(IDW+7) - IF(KFQVER.EQ.3) SWT=PARF(IDW+6) - IF(KFQPOP.GE.3) SWT=PARF(IDW+5) - IF((1D0+SWT)*PYR(0).LT.1D0) KFLDS=1 - ENDIF - KFDIQ=900*MAX(KFQVER,KFQPOP)+100*(KFQVER+KFQPOP)+KFLDS - & +10000*KFQPOP - KFL3=ISIGN(KFDIQ,KFIN) - -C..x->M+y: flavour for meson. - 130 IF(MBARY.LE.0)THEN - KFLA=MAX(KFQOLD,KFQVER) - KFLB=MIN(KFQOLD,KFQVER) - KFS=ISIGN(1,KFL1) - IF(KFLA.NE.KFQOLD) KFS=-KFS -C... Form meson, with spin and flavour mixing for diagonal states. - IF(MBARY.EQ.-1.AND.MSTJ(12).GE.5)THEN - IF(IDIAG.GT.0) KF=110*IDIAG+KFJ - IF(IDIAG.EQ.0) KF=(100*KFLA+10*KFLB+KFJ)*KFS*(-1)**KFLA - RETURN - ENDIF - IF(KFLA.LE.2) KMUL=INT(PARJ(11)+PYR(0)) - IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+PYR(0)) - IF(KFLA.GE.4) KMUL=INT(PARJ(13)+PYR(0)) - IF(KMUL.EQ.0.AND.PARJ(14).GT.0D0)THEN - IF(PYR(0).LT.PARJ(14)) KMUL=2 - ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0D0)THEN - RMUL=PYR(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=PYR(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'. -C..Allow shift to qq->B+q in old version (set IRANK to 0) - IF(KF.EQ.221.OR.KF.EQ.331)THEN - IF(PYR(0).GT.PARJ(25+KF/300))THEN - IF(KF2A.GT.0) GOTO 130 - IF(MSTJ(12).LT.4) IRANK=0 - GOTO 110 - ENDIF - ENDIF - MSTU(121)=0 - -C.. x->B+y: Flavour for baryon - ELSE - KFLA=KFQVER - IF(KF1A.LE.10) KFLA=KFQOLD - KFLB=MOD(KFDIQ/1000,10) - KFLC=MOD(KFDIQ/100,10) - KFLDS=MOD(KFDIQ,10) - KFLD=MAX(KFLA,KFLB,KFLC) - KFLF=MIN(KFLA,KFLB,KFLC) - KFLE=KFLA+KFLB+KFLC-KFLD-KFLF - -C... SU(6) factors for formation of baryon. - KBARY=3 - KDMAX=5 - KFLG=KFLB - IF(KFLB.NE.KFLC)THEN - KBARY=2*KFLDS-1 - KDMAX=1+KFLDS/2 - IF(KFLB.GT.2) KDMAX=KDMAX+2 - ENDIF - IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC)THEN - KBARY=KBARY+1 - KFLG=KFLA - ENDIF - - SU6MAX=PARF(140+KDMAX) - SU6DEC=PARJ(18) - SU6S =PARF(146) - IF(MSTJ(12).GE.5.AND.IRANK.EQ.0) THEN - SU6MAX=1D0 - SU6DEC=1D0 - SU6S =1D0 - ENDIF - SU6OCT=PARF(60+KBARY) - IF(KFLG.GT.MAX(KFLA+KFLB-KFLG,2))THEN - SU6OCT=SU6OCT*4*SU6S/(3*SU6S+1) - IF(KBARY.EQ.2) SU6OCT=PARF(60+KBARY)*4/(3*SU6S+1) - ELSE - IF(KBARY.EQ.6) SU6OCT=SU6OCT*(3+SU6S)/(3*SU6S+1) - ENDIF - SU6WT=SU6OCT+SU6DEC*PARF(70+KBARY) - -C.. SU(6) test. Old options enforce new baryon if q->B+qq is rejected. - IF(SU6WT.LT.PYR(0)*SU6MAX.AND.KF2A.EQ.0)THEN - MSTU(121)=0 - IF(MSTJ(12).LE.2.AND.MBARY.EQ.1) MSTU(121)=-1 - GOTO 110 - ENDIF - -C.. Form baryon. Distinguish Lambda- and Sigmalike baryons. - KSIG=1 - KFLS=2 - IF(SU6WT*PYR(0).GT.SU6OCT) KFLS=4 - IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF)THEN - KSIG=KFLDS/3 - IF(KFLA.NE.KFLD) KSIG=INT(3*SU6S/(3*SU6S+KFLDS**2)+PYR(0)) - ENDIF - KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) - IF(KSIG.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) - ENDIF - RETURN - -C...Use tabulated probabilities to select new flavour and hadron. - 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN - KT3L=1 - KT3U=6 - ELSEIF(KTAB2.EQ.0) THEN - KT3L=1 - KT3U=22 - ELSE - KT3L=KTAB2 - KT3U=KTAB2 - ENDIF - RFL=0D0 - DO 160 KTS=0,2 - DO 150 KT3=KT3L,KT3U - RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) - 150 CONTINUE - 160 CONTINUE - RFL=PYR(0)*RFL - DO 180 KTS=0,2 - KTABS=KTS - DO 170 KT3=KT3L,KT3U - KTAB3=KT3 - RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) - IF(RFL.LE.0D0) GOTO 190 - 170 CONTINUE - 180 CONTINUE - 190 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=PYR(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 PYERRM(2,'(PYKFDI:) 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=PYCOMP(KF) - IF(KC.EQ.0) THEN - CALL PYERRM(2,'(PYKFDI:) user-defined flavour probabilities '// - & 'failed') - GOTO 100 - ENDIF - - RETURN - END - -C*************************************************************** - -C...PYKFIN -C...Precalculates a set of diquark and popcorn weights. - - SUBROUTINE PYKFIN - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - DIMENSION SU6(12),SU6M(7),QBB(7),QBM(7),DMB(14) - - - MSTU(123)=1 -C..Diquark indices for dimensional variables - IUD1=1 - IUU1=2 - IUS0=3 - ISU0=4 - IUS1=5 - ISU1=6 - ISS1=7 - -C.. *** SU(6) factors ** -C..Modify with decuplet- (and Sigma/Lambda-) suppression. - PARF(146)=1D0 - IF(MSTJ(12).GE.5) PARF(146)=3D0*PARJ(18)/(2D0*PARJ(18)+1D0) - IF(PARJ(18).LT.1D0-1D-5.AND.MSTJ(12).LT.5) CALL PYERRM(9, - & '(PYKFIN:) PARJ(18)<1 combined with 0 B+B+.. - DO 120 I=1,7 - QBB(I)=QBB(I)*QBM(I) - 120 CONTINUE - - IF(MSTJ(12).GE.5)THEN -C..New version: tau for rank 0 diquark. - DMB(7+ISU0)=EXP(-PARJ(10)*PMUS0) - DMB(7+IUS0)=PARJ(2)*DMB(7+ISU0) - DMB(7+ISS1)=6D0*PARJ(2)*EXP(-PARJ(10)*PMSS1)*DMB(7+ISU0) - DMB(7+IUU1)=6D0*EXP(-PARJ(10)*PMUD1) - DMB(7+ISU1)=3D0*EXP(-PARJ(10)*PMUS1)*DMB(7+ISU0) - DMB(7+IUS1)=PARJ(2)*DMB(7+ISU1) - DMB(7+IUD1)=DMB(7+IUU1)/2D0 - -C..New version: curtain flavour ratios. -C.. s/u for q->B+M+... -C.. s/u for rank 0 diquark: su -> ...M+B+... -C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... - WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) - PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU - WU=1D0+DMB(7+IUD1)+DMB(7+IUS0)+DMB(7+IUS1)+DMB(7+IUU1) - PARF(136)=(2D0*(DMB(7+ISU0)+DMB(7+ISU1))+DMB(7+ISS1))/WU - PARF(137)=(DMB(7+ISU0)+DMB(7+ISU1))* - & (2D0+DMB(7+ISS1)/(2D0*DMB(7+ISU1)))/WU - ELSE -C..Old version: reset unused rank 0 diquark weights and -C.. unused diquark SU(6) survival weights - DO 130 I=1,7 - IF(MSTJ(12).LT.3) DMB(I)=1D0 - DMB(7+I)=1D0 - 130 CONTINUE - -C..Old version: Shuffle PARJ(7) into tau - QBM(IUS0)=QBM(IUS0)*PARJ(7) - QBM(ISS1)=QBM(ISS1)*PARJ(7) - QBM(IUS1)=QBM(IUS1)*PARJ(7) - -C..Old version: curtain flavour ratios. -C.. s/u for q->B+M+... -C.. s/u for rank 0 diquark: su -> ...M+B+... -C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+... - WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1) - PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU - PARF(136)=PARF(135)*PARJ(6)*QBM(ISU0)/QBM(IUS0) - PARF(137)=(1D0+QBM(IUD1))*(2D0+QBM(IUS0))/WU - ENDIF - -C..Combine diquark SU(6) survival, SU(6)max, tau and T into factors for: -C.. rank0 D->M+B+..; D->M+B+..; q->B+M+..; q->B+B.. - DO 140 I=1,7 - DMB(7+I)=DMB(7+I)*DMB(I) - DMB(I)=DMB(I)*QBM(I) - QBM(I)=QBM(I)*SU6M(I)/SU6MUD - QBB(I)=QBB(I)*SU6M(I)/SU6MUD - 140 CONTINUE - -C.. *** Popcorn factors *** - - IF(MSTJ(12).LT.5)THEN -C.. Old version: Resulting popcorn weights. - PARF(138)=PARJ(6) - WS=PARF(135)*PARF(138) - WQ=WU*PARJ(5)/3D0 - PARF(132)=WQ*QBM(IUD1)/QBB(IUD1) - PARF(133)=WQ* - & (QBM(IUS1)/QBB(IUS1)+WS*QBM(ISU1)/QBB(ISU1))/2D0 - PARF(134)=WQ*WS*QBM(ISS1)/QBB(ISS1) - PARF(131)=WQ*(1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)+ - & WS*(QBM(ISU0)+QBM(ISU1)+QBM(ISS1)/2D0))/ - & (1D0+QBB(IUD1)+QBB(IUU1)+ - & 2D0*(QBB(IUS0)+QBB(IUS1))+QBB(ISS1)/2D0) - ELSE -C..New version: Store weights for popcorn mesons, -C..get prel. popcorn weights. - DO 150 IPOS=201,1400 - PARF(IPOS)=0D0 - 150 CONTINUE - DO 160 I=138,140 - PARF(I)=0D0 - 160 CONTINUE - IPOS=200 - PARF(193)=PARJ(8) - DO 240 MR=0,7,7 - IF(MR.EQ.7) PARF(193)=PARJ(10) - SQWT=2D0*(DMB(MR+IUS0)+DMB(MR+IUS1))/ - & (1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) - QQWT=DMB(MR+IUU1)/(1D0+DMB(MR+IUD1)+DMB(MR+IUU1)) - DO 230 NMES=0,1 - IF(NMES.EQ.1) SQWT=PARJ(2) - DO 220 KFQPOP=1,4 - IF(MR.EQ.0.AND.KFQPOP.GT.3) GOTO 220 - IF(NMES.EQ.0.AND.KFQPOP.GE.3)THEN - SQWT=DMB(MR+ISS1)/(DMB(MR+ISU0)+DMB(MR+ISU1)) - QQWT=0.5D0 - IF(MR.EQ.0) PARF(193)=PARJ(8)+PARJ(9) - IF(KFQPOP.EQ.4) SQWT=SQWT*(1D0/DMB(7+ISU1)+1D0)/2D0 - ENDIF - DO 210 KFQOLD =1,5 - IF(MR.EQ.0.AND.KFQOLD.GT.3) GOTO 210 - IF(NMES.EQ.1) THEN - IF(MR.EQ.0.AND.KFQPOP.EQ.1) GOTO 210 - IF(MR.EQ.7.AND.KFQPOP.NE.1) GOTO 210 - ENDIF - WTTOT=0D0 - WTFAIL=0D0 - DO 190 KMUL=0,5 - PJWT=PARJ(12+KMUL) - IF(KMUL.EQ.0) PJWT=1D0-PARJ(14) - IF(KMUL.EQ.1) PJWT=1D0-PARJ(15)-PARJ(16)-PARJ(17) - IF(PJWT.LE.0D0) GOTO 190 - IF(PJWT.GT.1D0) PJWT=1D0 - IMES=5*KMUL - IMIX=2*KFQOLD+10*KMUL - KFJ=2*KMUL+1 - IF(KMUL.EQ.2) KFJ=10003 - IF(KMUL.EQ.3) KFJ=10001 - IF(KMUL.EQ.4) KFJ=20003 - IF(KMUL.EQ.5) KFJ=5 - DO 180 KFQVER =1,3 - KFLA=MAX(KFQOLD,KFQVER) - KFLB=MIN(KFQOLD,KFQVER) - SWT=PARJ(11+KFLA/3+KFLA/4) - IF(KMUL.EQ.0.OR.KMUL.EQ.2) SWT=1D0-SWT - SWT=SWT*PJWT - QWT=SQWT/(2D0+SQWT) - IF(KFQVER.LT.3)THEN - IF(KFQVER.EQ.KFQPOP) QWT=(1D0-QWT)*QQWT - IF(KFQVER.NE.KFQPOP) QWT=(1D0-QWT)*(1D0-QQWT) - ENDIF - IF(KFQVER.NE.KFQOLD)THEN - IMES=IMES+1 - KFM=100*KFLA+10*KFLB+KFJ - PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PARF(IPOS+IMES)=QWT*SWT*EXP(-PARF(193)*PMM) - WTTOT=WTTOT+PARF(IPOS+IMES) - ELSE - DO 170 ID=3,5 - IF(ID.EQ.3) DWT=1D0-PARF(IMIX-1) - IF(ID.EQ.4) DWT=PARF(IMIX-1)-PARF(IMIX) - IF(ID.EQ.5) DWT=PARF(IMIX) - KFM=110*(ID-2)+KFJ - PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3) - PARF(IPOS+5*KMUL+ID)=QWT*SWT*DWT*EXP(-PARF(193)*PMM) - IF(KMUL.EQ.0.AND.ID.GT.3) THEN - WTFAIL=WTFAIL+QWT*SWT*DWT*(1D0-PARJ(21+ID)) - PARF(IPOS+5*KMUL+ID)= - & PARF(IPOS+5*KMUL+ID)*PARJ(21+ID) - ENDIF - WTTOT=WTTOT+PARF(IPOS+5*KMUL+ID) - 170 CONTINUE - ENDIF - 180 CONTINUE - 190 CONTINUE - DO 200 IMES=1,30 - PARF(IPOS+IMES)=PARF(IPOS+IMES)/(1D0-WTFAIL) - 200 CONTINUE - IF(MR.EQ.7) PARF(140)= - & MAX(PARF(140),WTTOT/(1D0-WTFAIL)) - IF(MR.EQ.0) PARF(139-KFQPOP/3)= - & MAX(PARF(139-KFQPOP/3),WTTOT/(1D0-WTFAIL)) - IPOS=IPOS+30 - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - 240 CONTINUE - IF(PARF(139).GT.1D-10) PARF(138)=PARF(138)/PARF(139) - MSTU(121)=0 - - ENDIF - -C..Recombine diquark weights to flavour and spin ratios - PARF(151)=(2D0*(QBB(ISU0)+QBB(ISU1))+QBB(ISS1))/ - & (1D0+QBB(IUD1)+QBB(IUU1)+QBB(IUS0)+QBB(IUS1)) - PARF(152)=2D0*(QBB(IUS0)+QBB(IUS1))/(1D0+QBB(IUD1)+QBB(IUU1)) - PARF(153)=QBB(ISS1)/(QBB(ISU0)+QBB(ISU1)) - PARF(154)=QBB(IUU1)/(1D0+QBB(IUD1)+QBB(IUU1)) - PARF(155)=QBB(ISU1)/QBB(ISU0) - PARF(156)=QBB(IUS1)/QBB(IUS0) - PARF(157)=QBB(IUD1) - - PARF(161)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/ - & (1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)) - PARF(162)=2D0*(QBM(IUS0)+QBM(IUS1))/(1D0+QBM(IUD1)+QBM(IUU1)) - PARF(163)=QBM(ISS1)/(QBM(ISU0)+QBM(ISU1)) - PARF(164)=QBM(IUU1)/(1D0+QBM(IUD1)+QBM(IUU1)) - PARF(165)=QBM(ISU1)/QBM(ISU0) - PARF(166)=QBM(IUS1)/QBM(IUS0) - PARF(167)=QBM(IUD1) - - PARF(171)=(2D0*(DMB(ISU0)+DMB(ISU1))+DMB(ISS1))/ - & (1D0+DMB(IUD1)+DMB(IUU1)+DMB(IUS0)+DMB(IUS1)) - PARF(172)=2D0*(DMB(IUS0)+DMB(IUS1))/(1D0+DMB(IUD1)+DMB(IUU1)) - PARF(173)=DMB(ISS1)/(DMB(ISU0)+DMB(ISU1)) - PARF(174)=DMB(IUU1)/(1D0+DMB(IUD1)+DMB(IUU1)) - PARF(175)=DMB(ISU1)/DMB(ISU0) - PARF(176)=DMB(IUS1)/DMB(IUS0) - PARF(177)=DMB(IUD1) - - PARF(185)=DMB(7+ISU1)/DMB(7+ISU0) - PARF(186)=DMB(7+IUS1)/DMB(7+IUS0) - PARF(187)=DMB(7+IUD1) - - RETURN - END - -C*********************************************************************** - -C...PYKLIM -C...Checks generated variables against pre-set kinematical limits; -C...also calculates limits on variables used in generation. - - SUBROUTINE PYKLIM(ILIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/ - -C...Common kinematical expressions. - MINT(51)=0 - ISUB=MINT(1) - ISTSB=ISET(ISUB) - IF(ISUB.EQ.96) GOTO 100 - SQM3=VINT(63) - SQM4=VINT(64) - IF(ILIM.NE.0) THEN - IF(ABS(SQM3).LT.1D-4.AND.ABS(SQM4).LT.1D-4) THEN - CKIN09=MAX(CKIN(9),CKIN(13)) - CKIN10=MIN(CKIN(10),CKIN(14)) - CKIN11=MAX(CKIN(11),CKIN(15)) - CKIN12=MIN(CKIN(12),CKIN(16)) - ELSE - CKIN09=MAX(CKIN(9),MIN(0D0,CKIN(13))) - CKIN10=MIN(CKIN(10),MAX(0D0,CKIN(14))) - CKIN11=MAX(CKIN(11),MIN(0D0,CKIN(15))) - CKIN12=MIN(CKIN(12),MAX(0D0,CKIN(16))) - ENDIF - ENDIF - IF(ILIM.NE.1) THEN - TAU=VINT(21) - RM3=SQM3/(TAU*VINT(2)) - RM4=SQM4/(TAU*VINT(2)) - BE34=SQRT(MAX(1D-20,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - ENDIF - PTHMIN=CKIN(3) - IF(MIN(SQM3,SQM4).LT.CKIN(6)**2.AND.ISTSB.NE.1.AND.ISTSB.NE.3) - &PTHMIN=MAX(CKIN(3),CKIN(5)) - - IF(ILIM.EQ.0) THEN -C...Check generated values of tau, y*, cos(theta-hat), and tau' against -C...pre-set kinematical limits. - YST=VINT(22) - CTH=VINT(23) - TAUP=VINT(26) - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP - X1=SQRT(TAUE)*EXP(YST) - X2=SQRT(TAUE)*EXP(-YST) - XF=X1-X2 - IF(MINT(47).NE.1) THEN - IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1 - IF(CKIN(2).GE.0D0.AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1 - IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1 - IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1 - ENDIF - IF(MINT(45).NE.1) THEN - IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1 - ENDIF - IF(MINT(46).NE.1) THEN - IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1 - ENDIF - IF(MINT(45).EQ.2) THEN - IF(X1.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 - ENDIF - IF(MINT(46).EQ.2) THEN - IF(X2.GT.1D0-2D0*PARP(111)/VINT(1)) MINT(51)=1 - ENDIF - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - PTH=0.5D0*BE34*SQRT(TAU*VINT(2)*MAX(0D0,1D0-CTH**2)) - EXPY3=MAX(1D-20,(1D0+RM3-RM4+BE34*CTH)/ - & MAX(1D-20,(1D0+RM3-RM4-BE34*CTH))) - EXPY4=MAX(1D-20,(1D0-RM3+RM4-BE34*CTH)/ - & MAX(1D-20,(1D0-RM3+RM4+BE34*CTH))) - Y3=YST+0.5D0*LOG(EXPY3) - Y4=YST+0.5D0*LOG(EXPY4) - YLARGE=MAX(Y3,Y4) - YSMALL=MIN(Y3,Y4) - ETALAR=20D0 - ETASMA=-20D0 - STH=SQRT(MAX(0D0,1D0-CTH**2)) - EXSQ3=SQRT(MAX(1D-20,((1D0+RM3-RM4)*COSH(YST)+BE34*SINH(YST)* - & CTH)**2-4D0*RM3)) - EXSQ4=SQRT(MAX(1D-20,((1D0-RM3+RM4)*COSH(YST)-BE34*SINH(YST)* - & CTH)**2-4D0*RM4)) - IF(STH.GE.1D-10) THEN - EXPET3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+EXSQ3)/ - & (BE34*STH) - EXPET4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+EXSQ4)/ - & (BE34*STH) - ETA3=LOG(MIN(1D10,MAX(1D-10,EXPET3))) - ETA4=LOG(MIN(1D10,MAX(1D-10,EXPET4))) - ETALAR=MAX(ETA3,ETA4) - ETASMA=MIN(ETA3,ETA4) - ENDIF - CTS3=((1D0+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/EXSQ3 - CTS4=((1D0-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/EXSQ4 - CTSLAR=MIN(1D0,MAX(-1D0,CTS3,CTS4)) - CTSSMA=MAX(-1D0,MIN(1D0,CTS3,CTS4)) - SH=TAU*VINT(2) - RPTS=4D0*VINT(71)**2/SH - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=MAX(1D-20,2D0*RM3*RM4) - IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) - & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - THA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4-BE34*CTH) - UHA=0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - IF(PTH.LT.PTHMIN) MINT(51)=1 - IF(CKIN(4).GE.0D0.AND.PTH.GT.CKIN(4)) MINT(51)=1 - IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1 - IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1 - IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1 - IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1 - IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1 - IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1 - IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1 - IF(THA.LT.CKIN(35)) MINT(51)=1 - IF(CKIN(36).GE.0D0.AND.THA.GT.CKIN(36)) MINT(51)=1 - IF(UHA.LT.CKIN(37)) MINT(51)=1 - IF(CKIN(38).GE.0D0.AND.UHA.GT.CKIN(38)) MINT(51)=1 - ENDIF - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1 - IF(CKIN(32).GE.0D0.AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1 - ENDIF - -C...Additional cuts on W2 (approximately) in DIS. - IF(ISUB.EQ.10.AND.MINT(43).GE.2) THEN - XBJ=X2 - IF(IABS(MINT(12)).LT.20) XBJ=X1 - Q2BJ=THA - W2BJ=Q2BJ*(1D0-XBJ)/XBJ - IF(W2BJ.LT.CKIN(39)) MINT(51)=1 - IF(CKIN(40).GT.0D0.AND.W2BJ.GT.CKIN(40)) MINT(51)=1 - ENDIF - - ELSEIF(ILIM.EQ.1) THEN -C...Calculate limits on tau -C...0) due to definition - TAUMN0=0D0 - TAUMX0=1D0 -C...1) due to limits on subsystem mass - TAUMN1=CKIN(1)**2/VINT(2) - TAUMX1=1D0 - IF(CKIN(2).GE.0D0) TAUMX1=CKIN(2)**2/VINT(2) -C...2) due to limits on pT-hat (and non-overlapping rapidity intervals) - TM3=SQRT(SQM3+PTHMIN**2) - TM4=SQRT(SQM4+PTHMIN**2) - YDCOSH=1D0 - IF(CKIN09.GT.CKIN12) YDCOSH=COSH(CKIN09-CKIN12) - TAUMN2=(TM3**2+2D0*TM3*TM4*YDCOSH+TM4**2)/VINT(2) - TAUMX2=1D0 -C...3) due to limits on pT-hat and cos(theta-hat) - CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2) - CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2) - TAUMN3=0D0 - IF(CKIN(27)*CKIN(28).GT.0D0) TAUMN3= - & (SQRT(SQM3+PTHMIN**2/(1D0-CTH2MN))+ - & SQRT(SQM4+PTHMIN**2/(1D0-CTH2MN)))**2/VINT(2) - TAUMX3=1D0 - IF(CKIN(4).GE.0D0.AND.CTH2MX.LT.1D0) TAUMX3= - & (SQRT(SQM3+CKIN(4)**2/(1D0-CTH2MX))+ - & SQRT(SQM4+CKIN(4)**2/(1D0-CTH2MX)))**2/VINT(2) -C...4) due to limits on x1 and x2 - TAUMN4=CKIN(21)*CKIN(23) - TAUMX4=CKIN(22)*CKIN(24) -C...5) due to limits on xF - TAUMN5=0D0 - TAUMX5=MAX(1D0-CKIN(25),1D0+CKIN(26)) -C...6) due to limits on that and uhat - TAUMN6=(SQM3+SQM4+CKIN(35)+CKIN(37))/VINT(2) - TAUMX6=1D0 - IF(CKIN(36).GT.0D0.AND.CKIN(38).GT.0D0) TAUMX6= - & (SQM3+SQM4+CKIN(36)+CKIN(38))/VINT(2) - -C...Net effect of all separate limits. - VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5,TAUMN6) - VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5,TAUMX6) - IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN - VINT(11)=1D0-1D-9 - VINT(31)=1D0+1D-9 - ELSEIF(MINT(47).EQ.5) THEN - VINT(31)=MIN(VINT(31),1D0-2D-10) - ELSEIF(MINT(47).GE.6) THEN - VINT(31)=MIN(VINT(31),1D0-1D-10) - ENDIF - IF(VINT(31).LE.VINT(11)) MINT(51)=1 - - ELSEIF(ILIM.EQ.2) THEN -C...Calculate limits on y* - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) - TAURT=SQRT(TAUE) -C...0) due to kinematics - YSTMN0=LOG(TAURT) - YSTMX0=-YSTMN0 -C...1) due to explicit limits - YSTMN1=CKIN(7) - YSTMX1=CKIN(8) -C...2) due to limits on x1 - YSTMN2=LOG(MAX(TAUE,CKIN(21))/TAURT) - YSTMX2=LOG(MAX(TAUE,CKIN(22))/TAURT) -C...3) due to limits on x2 - YSTMN3=-LOG(MAX(TAUE,CKIN(24))/TAURT) - YSTMX3=-LOG(MAX(TAUE,CKIN(23))/TAURT) -C...4) due to limits on xF - YEPMN4=0.5D0*ABS(CKIN(25))/TAURT - YSTMN4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMN4**2)+YEPMN4)),CKIN(25)) - YEPMX4=0.5D0*ABS(CKIN(26))/TAURT - YSTMX4=SIGN(LOG(MAX(1D-20,SQRT(1D0+YEPMX4**2)+YEPMX4)),CKIN(26)) -C...5) due to simultaneous limits on y-large and y-small - YEPSMN=(RM3-RM4)*SINH(CKIN09-CKIN11) - YEPSMX=(RM3-RM4)*SINH(CKIN10-CKIN12) - YDIFMN=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMN**2)-YEPSMN))) - YDIFMX=ABS(LOG(MAX(1D-20,SQRT(1D0+YEPSMX**2)-YEPSMX))) - YSTMN5=0.5D0*(CKIN09+CKIN11-YDIFMN) - YSTMX5=0.5D0*(CKIN10+CKIN12+YDIFMX) -C...6) due to simultaneous limits on cos(theta-hat) and y-large or -C... y-small - CTHLIM=SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAUE*VINT(2)))) - RZMN=BE34*MAX(CKIN(27),-CTHLIM) - RZMX=BE34*MIN(CKIN(28),CTHLIM) - YEX3MX=(1D0+RM3-RM4+RZMX)/MAX(1D-10,1D0+RM3-RM4-RZMX) - YEX4MX=(1D0+RM4-RM3-RZMN)/MAX(1D-10,1D0+RM4-RM3+RZMN) - YEX3MN=MAX(1D-10,1D0+RM3-RM4+RZMN)/(1D0+RM3-RM4-RZMN) - YEX4MN=MAX(1D-10,1D0+RM4-RM3-RZMX)/(1D0+RM4-RM3+RZMX) - YSTMN6=CKIN09-0.5D0*LOG(MAX(YEX3MX,YEX4MX)) - YSTMX6=CKIN12-0.5D0*LOG(MIN(YEX3MN,YEX4MN)) - -C...Net effect of all separate limits. - VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6) - VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6) - IF(MINT(47).EQ.1) THEN - VINT(12)=-1D-9 - VINT(32)=1D-9 - ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN - VINT(12)=(1D0-1D-9)*YSTMX0 - VINT(32)=(1D0+1D-9)*YSTMX0 - ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN - VINT(12)=-(1D0+1D-9)*YSTMX0 - VINT(32)=-(1D0-1D-9)*YSTMX0 - ELSEIF(MINT(47).EQ.5) THEN - YSTEE=LOG((1D0-1D-10)/TAURT) - VINT(12)=MAX(VINT(12),-YSTEE) - VINT(32)=MIN(VINT(32),YSTEE) - ENDIF - IF(VINT(32).LE.VINT(12)) MINT(51)=1 - - ELSEIF(ILIM.EQ.3) THEN -C...Calculate limits on cos(theta-hat) - YST=VINT(22) -C...0) due to definition - CTNMN0=-1D0 - CTNMX0=0D0 - CTPMN0=0D0 - CTPMX0=1D0 -C...1) due to explicit limits - CTNMN1=MIN(0D0,CKIN(27)) - CTNMX1=MIN(0D0,CKIN(28)) - CTPMN1=MAX(0D0,CKIN(27)) - CTPMX1=MAX(0D0,CKIN(28)) -C...2) due to limits on pT-hat - CTNMN2=-SQRT(MAX(0D0,1D0-4D0*PTHMIN**2/(BE34**2*TAU*VINT(2)))) - CTPMX2=-CTNMN2 - CTNMX2=0D0 - CTPMN2=0D0 - IF(CKIN(4).GE.0D0) THEN - CTNMX2=-SQRT(MAX(0D0,1D0-4D0*CKIN(4)**2/ - & (BE34**2*TAU*VINT(2)))) - CTPMN2=-CTNMX2 - ENDIF -C...3) due to limits on y-large and y-small - CTNMN3=MIN(0D0,MAX((1D0+RM3-RM4)/BE34*TANH(CKIN11-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN10-YST))) - CTNMX3=MIN(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN12-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN09-YST)) - CTPMN3=MAX(0D0,(1D0+RM3-RM4)/BE34*TANH(CKIN09-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN12-YST)) - CTPMX3=MAX(0D0,MIN((1D0+RM3-RM4)/BE34*TANH(CKIN10-YST), - & -(1D0-RM3+RM4)/BE34*TANH(CKIN11-YST))) -C...4) due to limits on that - CTNMN4=-1D0 - CTNMX4=0D0 - CTPMN4=0D0 - CTPMX4=1D0 - SH=TAU*VINT(2) - IF(CKIN(35).GT.0D0) THEN - CTLIM=(1D0-RM3-RM4-2D0*CKIN(35)/SH)/BE34 - IF(CTLIM.GT.0D0) THEN - CTPMX4=CTLIM - ELSE - CTPMX4=0D0 - CTNMX4=CTLIM - ENDIF - ENDIF - IF(CKIN(36).GT.0D0) THEN - CTLIM=(1D0-RM3-RM4-2D0*CKIN(36)/SH)/BE34 - IF(CTLIM.LT.0D0) THEN - CTNMN4=CTLIM - ELSE - CTNMN4=0D0 - CTPMN4=CTLIM - ENDIF - ENDIF -C...5) due to limits on uhat - CTNMN5=-1D0 - CTNMX5=0D0 - CTPMN5=0D0 - CTPMX5=1D0 - IF(CKIN(37).GT.0D0) THEN - CTLIM=(2D0*CKIN(37)/SH-(1D0-RM3-RM4))/BE34 - IF(CTLIM.LT.0D0) THEN - CTNMN5=CTLIM - ELSE - CTNMN5=0D0 - CTPMN5=CTLIM - ENDIF - ENDIF - IF(CKIN(38).GT.0D0) THEN - CTLIM=(2D0*CKIN(38)/SH-(1D0-RM3-RM4))/BE34 - IF(CTLIM.GT.0D0) THEN - CTPMX5=CTLIM - ELSE - CTPMX5=0D0 - CTNMX5=CTLIM - ENDIF - ENDIF - -C...Net effect of all separate limits. - VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3,CTNMN4,CTNMN5) - VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3,CTNMX4,CTNMX5) - VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3,CTPMN4,CTPMN5) - VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3,CTPMX4,CTPMX5) - IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1 - - ELSEIF(ILIM.EQ.4) THEN -C...Calculate limits on tau' -C...0) due to kinematics - TAPMN0=TAU - IF(ISTSB.EQ.5.AND.VINT(201).GT.0D0) THEN - PQRAT=(VINT(201)+VINT(206))/VINT(1) - TAPMN0=(SQRT(TAU)+PQRAT)**2 - ENDIF - TAPMX0=1D0 -C...1) due to explicit limits - TAPMN1=CKIN(31)**2/VINT(2) - TAPMX1=1D0 - IF(CKIN(32).GE.0D0) TAPMX1=CKIN(32)**2/VINT(2) - -C...Net effect of all separate limits. - VINT(16)=MAX(TAPMN0,TAPMN1) - VINT(36)=MIN(TAPMX0,TAPMX1) - IF(MINT(47).EQ.1) THEN - VINT(16)=1D0-1D-9 - VINT(36)=1D0+1D-9 - ELSEIF(MINT(47).EQ.5) THEN - VINT(36)=MIN(VINT(36),1D0-2D-10) - ELSEIF(MINT(47).EQ.6.OR.MINT(47).EQ.7) THEN - VINT(36)=MIN(VINT(36),1D0-1D-10) - ENDIF - IF(VINT(36).LE.VINT(16)) MINT(51)=1 - - ENDIF - RETURN - -C...Special case for low-pT and multiple interactions: -C...effective kinematical limits for tau, y*, cos(theta-hat). - 100 IF(ILIM.EQ.0) THEN - ELSEIF(ILIM.EQ.1) THEN - IF(MSTP(82).LE.1) THEN - VINT(11)=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ - & VINT(2) - ELSE - VINT(11)=(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/VINT(2) - ENDIF - VINT(31)=1D0 - ELSEIF(ILIM.EQ.2) THEN - VINT(12)=0.5D0*LOG(VINT(21)) - VINT(32)=-VINT(12) - ELSEIF(ILIM.EQ.3) THEN - IF(MSTP(82).LE.1) THEN - ST2EFF=4D0*(PARP(81)*(VINT(1)/PARP(89))**PARP(90))**2/ - & (VINT(21)*VINT(2)) - ELSE - ST2EFF=0.01D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ - & (VINT(21)*VINT(2)) - ENDIF - VINT(13)=-SQRT(MAX(0D0,1D0-ST2EFF)) - VINT(33)=0D0 - VINT(14)=0D0 - VINT(34)=-VINT(13) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYKMAP -C...Maps a uniform distribution into a distribution of a kinematical -C...variable according to one of the possibilities allowed. It is -C...assumed that kinematical limits have been set by a PYKLIM call. - - SUBROUTINE PYKMAP(IVAR,MVAR,VVAR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Convert VVAR to tau variable. - ISUB=MINT(1) - ISTSB=ISET(ISUB) - IF(IVAR.EQ.1) THEN - TAUMIN=VINT(11) - TAUMAX=VINT(31) - IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN - TAURE=VINT(73) - GAMRE=VINT(74) - ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN - TAURE=VINT(75) - GAMRE=VINT(76) - ENDIF - IF(MINT(47).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) THEN - TAU=1D0 - ELSEIF(MVAR.EQ.1) THEN - TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR - ELSEIF(MVAR.EQ.2) THEN - TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR) - ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN - RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX - TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN) - ELSEIF(MVAR.EQ.4.OR.MVAR.EQ.6) THEN - AUPP=ATAN((TAUMAX-TAURE)/GAMRE) - ALOW=ATAN((TAUMIN-TAURE)/GAMRE) - TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR) - ELSEIF(MINT(47).EQ.5) THEN - AUPP=LOG(MAX(2D-10,1D0-TAUMAX)) - ALOW=LOG(MAX(2D-10,1D0-TAUMIN)) - TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ELSE - AUPP=LOG(MAX(1D-10,1D0-TAUMAX)) - ALOW=LOG(MAX(1D-10,1D0-TAUMIN)) - TAU=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ENDIF - VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU)) - -C...Convert VVAR to y* variable. - ELSEIF(IVAR.EQ.2) THEN - YSTMIN=VINT(12) - YSTMAX=VINT(32) - TAUE=VINT(21) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINT(26) - IF(MINT(47).EQ.1) THEN - YST=0D0 - ELSEIF(MINT(47).EQ.2.OR.MINT(47).EQ.6) THEN - YST=-0.5D0*LOG(TAUE) - ELSEIF(MINT(47).EQ.3.OR.MINT(47).EQ.7) THEN - YST=0.5D0*LOG(TAUE) - ELSEIF(MVAR.EQ.1) THEN - YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR) - ELSEIF(MVAR.EQ.2) THEN - YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1D0-VVAR) - ELSEIF(MVAR.EQ.3) THEN - AUPP=ATAN(EXP(YSTMAX)) - ALOW=ATAN(EXP(YSTMIN)) - YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR)) - ELSEIF(MVAR.EQ.4) THEN - YST0=-0.5D0*LOG(TAUE) - AUPP=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)) - ALOW=LOG(MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - YST=YST0-LOG(1D0+EXP(ALOW+VVAR*(AUPP-ALOW))) - ELSE - YST0=-0.5D0*LOG(TAUE) - AUPP=LOG(MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - ALOW=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)) - YST=LOG(1D0+EXP(AUPP+VVAR*(ALOW-AUPP)))-YST0 - ENDIF - VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST)) - -C...Convert VVAR to cos(theta-hat) variable. - ELSEIF(IVAR.EQ.3) THEN - RM34=MAX(1D-20,2D0*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2) - RSQM=1D0+RM34 - IF(2D0*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001D0) - & RM34=MAX(RM34,2D0*VINT(71)**2/(VINT(21)*VINT(2))) - CTNMIN=VINT(13) - CTNMAX=VINT(33) - CTPMIN=VINT(14) - CTPMAX=VINT(34) - IF(MVAR.EQ.1) THEN - ANEG=CTNMAX-CTNMIN - APOS=CTPMAX-CTPMIN - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP - ENDIF - ELSEIF(MVAR.EQ.2) THEN - RMNMIN=MAX(RM34,RSQM-CTNMIN) - RMNMAX=MAX(RM34,RSQM-CTNMAX) - RMPMIN=MAX(RM34,RSQM-CTPMIN) - RMPMAX=MAX(RM34,RSQM-CTPMAX) - ANEG=LOG(RMNMIN/RMNMAX) - APOS=LOG(RMPMIN/RMPMAX) - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP - ENDIF - ELSEIF(MVAR.EQ.3) THEN - RMNMIN=MAX(RM34,RSQM+CTNMIN) - RMNMAX=MAX(RM34,RSQM+CTNMAX) - RMPMIN=MAX(RM34,RSQM+CTPMIN) - RMPMAX=MAX(RM34,RSQM+CTPMAX) - ANEG=LOG(RMNMAX/RMNMIN) - APOS=LOG(RMPMAX/RMPMIN) - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM - ENDIF - ELSEIF(MVAR.EQ.4) THEN - RMNMIN=MAX(RM34,RSQM-CTNMIN) - RMNMAX=MAX(RM34,RSQM-CTNMAX) - RMPMIN=MAX(RM34,RSQM-CTPMIN) - RMPMAX=MAX(RM34,RSQM-CTPMAX) - ANEG=1D0/RMNMAX-1D0/RMNMIN - APOS=1D0/RMPMAX-1D0/RMPMIN - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=RSQM-1D0/(1D0/RMNMIN+ANEG*VCTN) - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=RSQM-1D0/(1D0/RMPMIN+APOS*VCTP) - ENDIF - ELSEIF(MVAR.EQ.5) THEN - RMNMIN=MAX(RM34,RSQM+CTNMIN) - RMNMAX=MAX(RM34,RSQM+CTNMAX) - RMPMIN=MAX(RM34,RSQM+CTPMIN) - RMPMAX=MAX(RM34,RSQM+CTPMAX) - ANEG=1D0/RMNMIN-1D0/RMNMAX - APOS=1D0/RMPMIN-1D0/RMPMAX - IF(ANEG.GT.0D0.AND.VVAR*(ANEG+APOS).LE.ANEG) THEN - VCTN=VVAR*(ANEG+APOS)/ANEG - CTH=1D0/(1D0/RMNMIN-ANEG*VCTN)-RSQM - ELSE - VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS - CTH=1D0/(1D0/RMPMIN-APOS*VCTP)-RSQM - ENDIF - ENDIF - IF(CTH.LT.0D0) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH)) - IF(CTH.GT.0D0) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH)) - VINT(23)=CTH - -C...Convert VVAR to tau' variable. - ELSEIF(IVAR.EQ.4) THEN - TAU=VINT(21) - TAUPMN=VINT(16) - TAUPMX=VINT(36) - IF(MINT(47).EQ.1) THEN - TAUP=1D0 - ELSEIF(MVAR.EQ.1) THEN - TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR - ELSEIF(MVAR.EQ.2) THEN - AUPP=(1D0-TAU/TAUPMX)**4 - ALOW=(1D0-TAU/TAUPMN)**4 - TAUP=TAU/MAX(1D-10,1D0-(ALOW+(AUPP-ALOW)*VVAR)**0.25D0) - ELSEIF(MINT(47).EQ.5) THEN - AUPP=LOG(MAX(2D-10,1D0-TAUPMX)) - ALOW=LOG(MAX(2D-10,1D0-TAUPMN)) - TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ELSE - AUPP=LOG(MAX(1D-10,1D0-TAUPMX)) - ALOW=LOG(MAX(1D-10,1D0-TAUPMN)) - TAUP=1D0-EXP(AUPP+VVAR*(ALOW-AUPP)) - ENDIF - VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP)) - -C...Selection of extra variables needed in 2 -> 3 process: -C...pT1, pT2, phi1, phi2, y3 for three outgoing particles. -C...Since no options are available, the functions of PYKLIM -C...and PYKMAP are joint for these choices. - ELSEIF(IVAR.EQ.5) THEN - -C...Read out total energy and particle masses. - MINT(51)=0 - MPTPK=1 - IF(ISUB.EQ.123.OR.ISUB.EQ.124.OR.ISUB.EQ.173.OR.ISUB.EQ.174 - & .OR.ISUB.EQ.178.OR.ISUB.EQ.179.OR.ISUB.EQ.351.OR.ISUB.EQ.352) - & MPTPK=2 - SHP=VINT(26)*VINT(2) - SHPR=SQRT(SHP) - PM1=VINT(201) - PM2=VINT(206) - PM3=SQRT(VINT(21))*VINT(1) - IF(PM1+PM2+PM3.GT.0.9999D0*SHPR) THEN - MINT(51)=1 - RETURN - ENDIF - PMRS1=VINT(204)**2 - PMRS2=VINT(209)**2 - -C...Specify coefficients of pT choice; upper and lower limits. - IF(MPTPK.EQ.1) THEN - HWT1=0.4D0 - HWT2=0.4D0 - ELSE - HWT1=0.05D0 - HWT2=0.05D0 - ENDIF - HWT3=1D0-HWT1-HWT2 - PTSMX1=((SHP-PM1**2-(PM2+PM3)**2)**2-(2D0*PM1*(PM2+PM3))**2)/ - & (4D0*SHP) - IF(CKIN(52).GT.0D0) PTSMX1=MIN(PTSMX1,CKIN(52)**2) - PTSMN1=CKIN(51)**2 - PTSMX2=((SHP-PM2**2-(PM1+PM3)**2)**2-(2D0*PM2*(PM1+PM3))**2)/ - & (4D0*SHP) - IF(CKIN(54).GT.0D0) PTSMX2=MIN(PTSMX2,CKIN(54)**2) - PTSMN2=CKIN(53)**2 - -C...Select transverse momenta according to -C...dp_T^2 * (a + b/(M^2 + p_T^2) + c/(M^2 + p_T^2)^2). - HMX=PMRS1+PTSMX1 - HMN=PMRS1+PTSMN1 - IF(HMX.LT.1.0001D0*HMN) THEN - MINT(51)=1 - RETURN - ENDIF - HDE=PTSMX1-PTSMN1 - RPT=PYR(0) - IF(RPT.LT.HWT1) THEN - PTS1=PTSMN1+PYR(0)*HDE - ELSEIF(RPT.LT.HWT1+HWT2) THEN - PTS1=MAX(PTSMN1,HMN*(HMX/HMN)**PYR(0)-PMRS1) - ELSE - PTS1=MAX(PTSMN1,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS1) - ENDIF - WTPTS1=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS1+PTS1))+ - & HWT3*HMN*HMX/(PMRS1+PTS1)**2) - HMX=PMRS2+PTSMX2 - HMN=PMRS2+PTSMN2 - IF(HMX.LT.1.0001D0*HMN) THEN - MINT(51)=1 - RETURN - ENDIF - HDE=PTSMX2-PTSMN2 - RPT=PYR(0) - IF(RPT.LT.HWT1) THEN - PTS2=PTSMN2+PYR(0)*HDE - ELSEIF(RPT.LT.HWT1+HWT2) THEN - PTS2=MAX(PTSMN2,HMN*(HMX/HMN)**PYR(0)-PMRS2) - ELSE - PTS2=MAX(PTSMN2,HMN*HMX/(HMN+PYR(0)*HDE)-PMRS2) - ENDIF - WTPTS2=HDE/(HWT1+HWT2*HDE/(LOG(HMX/HMN)*(PMRS2+PTS2))+ - & HWT3*HMN*HMX/(PMRS2+PTS2)**2) - -C...Select azimuthal angles and check pT choice. - PHI1=PARU(2)*PYR(0) - PHI2=PARU(2)*PYR(0) - PHIR=PHI2-PHI1 - PTS3=MAX(0D0,PTS1+PTS2+2D0*SQRT(PTS1*PTS2)*COS(PHIR)) - IF(PTS3.LT.CKIN(55)**2.OR.(CKIN(56).GT.0D0.AND.PTS3.GT. - & CKIN(56)**2)) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Calculate transverse masses and check phase space not closed. - PMS1=PM1**2+PTS1 - PMS2=PM2**2+PTS2 - PMS3=PM3**2+PTS3 - PMT1=SQRT(PMS1) - PMT2=SQRT(PMS2) - PMT3=SQRT(PMS3) - PM12=(PMT1+PMT2)**2 - IF(PMT1+PMT2+PMT3.GT.0.9999D0*SHPR) THEN - MINT(51)=1 - RETURN - ENDIF - -C...Select rapidity for particle 3 and check phase space not closed. - Y3MAX=LOG((SHP+PMS3-PM12+SQRT(MAX(0D0,(SHP-PMS3-PM12)**2- - & 4D0*PMS3*PM12)))/(2D0*SHPR*PMT3)) - IF(Y3MAX.LT.1D-6) THEN - MINT(51)=1 - RETURN - ENDIF - Y3=(2D0*PYR(0)-1D0)*0.999999D0*Y3MAX - PZ3=PMT3*SINH(Y3) - PE3=PMT3*COSH(Y3) - -C...Find momentum transfers in two mirror solutions (in 1-2 frame). - PZ12=-PZ3 - PE12=SHPR-PE3 - PMS12=PE12**2-PZ12**2 - SQL12=SQRT(MAX(0D0,(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2)) - IF(SQL12.LT.1D-6*SHP) THEN - MINT(51)=1 - RETURN - ENDIF - PMM1=PMS12+PMS1-PMS2 - PMM2=PMS12+PMS2-PMS1 - TFAC=-SHPR/(2D0*PMS12) - T1P=TFAC*(PE12-PZ12)*(PMM1-SQL12) - T1N=TFAC*(PE12-PZ12)*(PMM1+SQL12) - T2P=TFAC*(PE12+PZ12)*(PMM2-SQL12) - T2N=TFAC*(PE12+PZ12)*(PMM2+SQL12) - -C...Construct relative mirror weights and make choice. - IF(MPTPK.EQ.1.OR.ISUB.EQ.351.OR.ISUB.EQ.352) THEN - WTPU=1D0 - WTNU=1D0 - ELSE - WTPU=1D0/((T1P-PMRS1)*(T2P-PMRS2))**2 - WTNU=1D0/((T1N-PMRS1)*(T2N-PMRS2))**2 - ENDIF - WTP=WTPU/(WTPU+WTNU) - WTN=WTNU/(WTPU+WTNU) - EPS=1D0 - IF(WTN.GT.PYR(0)) EPS=-1D0 - -C...Store result of variable choice and associated weights. - VINT(202)=PTS1 - VINT(207)=PTS2 - VINT(203)=PHI1 - VINT(208)=PHI2 - VINT(205)=WTPTS1 - VINT(210)=WTPTS2 - VINT(211)=Y3 - VINT(212)=Y3MAX - VINT(213)=EPS - IF(EPS.GT.0D0) THEN - VINT(214)=1D0/WTP - VINT(215)=T1P - VINT(216)=T2P - ELSE - VINT(214)=1D0/WTN - VINT(215)=T1N - VINT(216)=T2N - ENDIF - VINT(217)=-0.5D0*TFAC*(PE12-PZ12)*(PMM2+EPS*SQL12) - VINT(218)=-0.5D0*TFAC*(PE12+PZ12)*(PMM1+EPS*SQL12) - VINT(219)=0.5D0*(PMS12-PTS3) - VINT(220)=SQL12 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYLAMF -C...The standard lambda function. - - FUNCTION PYLAMF(X,Y,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYLAMF,X,Y,Z - - PYLAMF=(X-(Y+Z))**2-4D0*Y*Z - IF(PYLAMF.LT.0D0) PYLAMF=0D0 - - RETURN - END - -C********************************************************************* - -C...PYLDCM -C...Auxiliary to PYSIGH, for technicolor corrections to QCD 2 -> 2 -C...processes. - - SUBROUTINE PYLDCM(A,N,NP,INDX,D) - IMPLICIT NONE - INTEGER N,NP,INDX(N) - REAL*8 D,TINY - COMPLEX*16 A(NP,NP) - PARAMETER (TINY=1.0D-20) - INTEGER I,IMAX,J,K - REAL*8 AAMAX,VV(6),DUM - COMPLEX*16 SUM,DUMC - - D=1D0 - DO 110 I=1,N - AAMAX=0D0 - DO 100 J=1,N - IF (ABS(A(I,J)).GT.AAMAX) AAMAX=ABS(A(I,J)) - 100 CONTINUE - IF (AAMAX.EQ.0D0) print*, 'SINGULAR MATRIX IN PYLDCM' - VV(I)=1D0/AAMAX - 110 CONTINUE - DO 180 J=1,N - DO 130 I=1,J-1 - SUM=A(I,J) - DO 120 K=1,I-1 - SUM=SUM-A(I,K)*A(K,J) - 120 CONTINUE - A(I,J)=SUM - 130 CONTINUE - AAMAX=0D0 - DO 150 I=J,N - SUM=A(I,J) - DO 140 K=1,J-1 - SUM=SUM-A(I,K)*A(K,J) - 140 CONTINUE - A(I,J)=SUM - DUM=VV(I)*ABS(SUM) - IF (DUM.GE.AAMAX) THEN - IMAX=I - AAMAX=DUM - ENDIF - 150 CONTINUE - IF (J.NE.IMAX)THEN - DO 160 K=1,N - DUMC=A(IMAX,K) - A(IMAX,K)=A(J,K) - A(J,K)=DUMC - 160 CONTINUE - D=-D - VV(IMAX)=VV(J) - ENDIF - INDX(J)=IMAX - IF(ABS(A(J,J)).EQ.0D0) A(J,J)=DCMPLX(TINY,0D0) - IF(J.NE.N)THEN - DO 170 I=J+1,N - A(I,J)=A(I,J)/A(J,J) - 170 CONTINUE - ENDIF - 180 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYLIST -C...Gives program heading, or lists an event, or particle -C...data, or current parameter values. - - SUBROUTINE PYLIST(MLIST) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...HEPEVT commonblock. - PARAMETER (NMXHEP=4000) - COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), - &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) - DOUBLE PRECISION PHEP,VHEP - SAVE /HEPEVT/ - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays, character variables and data. - 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 PYLOGO - 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) GOTO 120 - IF(MSTU(15).EQ.0.AND.K(I,1).LE.0) GOTO 120 - IF(MSTU(15).EQ.1.AND.K(I,1).LT.0) GOTO 120 - -C...Get particle name, pad it and check it is not too long. - CALL PYNAME(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=PYCOMP(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 - IF((K(I,1).EQ.41.OR.K(I,1).EQ.51).AND.LEN+2*LDL+3.LE.LMX) - & CHAC(LMX-1:LMX-1)='I' - -C...Write data for particle/jet. - IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999D0) 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.99999D0) 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.OR.K(I,1).EQ.42.OR.K(I,1).EQ.52)) 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)=PYP(0,J) - 130 CONTINUE - IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999D0) THEN - WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) - ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999D0) 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...Simple listing of HEPEVT entries (mainly for test purposes). - ELSEIF(MLIST.EQ.5) THEN - WRITE(MSTU(11),7500) - DO 140 I=1,NHEP - IF(ISTHEP(I).EQ.0) GOTO 140 - WRITE(MSTU(11),7600) I,ISTHEP(I),IDHEP(I),JMOHEP(1,I), - & JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),(PHEP(J,I),J=1,5) - 140 CONTINUE - - -C...Simple listing of user-process entries (mainly for test purposes). - ELSEIF(MLIST.EQ.7) THEN - WRITE(MSTU(11),7300) - DO 150 I=1,NUP - WRITE(MSTU(11),7400) I,ISTUP(I),IDUP(I),MOTHUP(1,I), - & MOTHUP(2,I),ICOLUP(1,I),ICOLUP(2,I),(PUP(J,I),J=1,5) - 150 CONTINUE - -C...Give simple list of KF codes defined in program. - ELSEIF(MLIST.EQ.11) THEN - WRITE(MSTU(11),6600) - DO 160 KF=1,80 - CALL PYNAME(KF,CHAP) - CALL PYNAME(-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 - 160 CONTINUE - DO 190 KFLS=1,3,2 - DO 180 KFLA=1,5 - DO 170 KFLB=1,KFLA-(3-KFLS)/2 - KF=1000*KFLA+100*KFLB+KFLS - CALL PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 170 CONTINUE - 180 CONTINUE - 190 CONTINUE - DO 220 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 210 KFLB=1,5 - DO 200 KFLC=1,KFLB-1 - KF=10000*KFLR+100*KFLB+10*KFLC+KFLS - CALL PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - IF(KF.EQ.311) THEN - KFK=130 - CALL PYNAME(KFK,CHAP) - WRITE(MSTU(11),6700) KFK,CHAP - KFK=310 - CALL PYNAME(KFK,CHAP) - WRITE(MSTU(11),6700) KFK,CHAP - ENDIF - 200 CONTINUE - KF=10000*KFLR+110*KFLB+KFLS - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - 210 CONTINUE - 220 CONTINUE - KF=100443 - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - KF=100553 - CALL PYNAME(KF,CHAP) - WRITE(MSTU(11),6700) KF,CHAP - DO 260 KFLSP=1,3 - KFLS=2+2*(KFLSP/3) - DO 250 KFLA=1,5 - DO 240 KFLB=1,KFLA - DO 230 KFLC=1,KFLB - IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) - & GOTO 230 - IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 230 - 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 PYNAME(KF,CHAP) - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN - 230 CONTINUE - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - DO 270 KC=1,500 - KF=KCHG(KC,4) - IF(KF.LT.1000000) GOTO 270 - CALL PYNAME(KF,CHAP) - CALL PYNAME(-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 - 270 CONTINUE - -C...List parton/particle data table. Check whether to be listed. - ELSEIF(MLIST.EQ.12) THEN - WRITE(MSTU(11),6800) - DO 300 KC=1,MSTU(6) - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 300 - IF(KF.LT.MSTU(1).OR.(MSTU(2).GT.0.AND.KF.GT.MSTU(2))) - & GOTO 300 - -C...Find particle name and mass. Print information. - CALL PYNAME(KF,CHAP) - IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 300 - CALL PYNAME(-KF,CHAN) - WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,(KCHG(KC,J1),J1=1,3), - & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) - -C...Particle decay: channel number, branching ratios, matrix element, -C...decay products. - DO 290 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - DO 280 J=1,5 - CALL PYNAME(KFDP(IDC,J),CHAD(J)) - 280 CONTINUE - WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), - & (CHAD(J),J=1,5) - 290 CONTINUE - 300 CONTINUE - -C...List parameter value table. - ELSEIF(MLIST.EQ.13) THEN - WRITE(MSTU(11),7100) - DO 310 I=1,200 - WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) - 310 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,1X,A12,1X,I2,I8,1X,I4,5F9.3) - 5500 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.2) - 5600 FORMAT(1X,I4,1X,A12,1X,I2,I8,1X,I4,5F9.1) - 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,I4,2(3X,I1,2I4),5F13.5) - 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I9,1X,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,I9,4X,A16,6X,I9,4X,A16) - 6800 FORMAT(///30X,'Particle/parton data table'//8X,'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,I9,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), - &1X,1P,E13.5,3X,I2) - 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F10.6,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) - 7300 FORMAT(/10X,'Event listing of user process at input (simplified)' - &//' I IST ID Mothers Colours p_x p_y p_z', - &' E m') - 7400 FORMAT(1X,I3,I3,I8,2I4,2I5,5F9.3) - 7500 FORMAT(/10X,'Event listing of HEPEVT common block (simplified)' - &//' I IST ID Mothers Daughters p_x p_y p_z', - &' E m') - 7600 FORMAT(1X,I4,I2,I8,4I5,5F9.3) - - RETURN - END - -C********************************************************************* - -C...PYLOGO -C...Writes a logo for the program. - - SUBROUTINE PYLOGO - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter for length of information block. - PARAMETER (IREFER=24) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYDAT1/,/PYPARS/ -C...Local arrays and character variables. - INTEGER IDATI(6) - CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(2*IREFER)*36, LINE*79, - &VERS*1, SUBV*3, DATE*2, YEAR*4, HOUR*2, MINU*2, SECO*2 - -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,19)/ - &' *......* ', - &' *:::!!:::::::::::* ', - &' *::::::!!::::::::::::::* ', - &' *::::::::!!::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *:::::::::!!:::::::::::::::::* ', - &' *::::::::!!::::::::::::::::*! ', - &' *::::::!!::::::::::::::* !! ', - &' !! *:::!!:::::::::::* !! ', - &' !! !* -><- * !! ', - &' !! !! !! ', - &' !! !! !! ', - &' !! !! ', - &' !! lh !! ', - &' !! !! ', - &' !! hh !! ', - &' !! ll !! ', - &' !! !! ', - &' !! '/ - DATA (LOGO(J),J=20,38)/ - &'Welcome to the Lund Monte Carlo!', - &' ', - &'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', - &' ', - &'This is PYTHIA version x.xxx ', - &'Last date of change: xx xxx 200x', - &' ', - &'Now is xx xxx 200x at xx:xx:xx ', - &' ', - &'Disclaimer: this program comes ', - &'without any guarantees. Beware ', - &'of errors and use common sense ', - &'when interpreting results. ', - &' ', - &'Copyright T. Sjostrand (2004) '/ - DATA (REFER(J),J=1,18)/ - &'An archive of program versions and d', - &'ocumentation is found on the web: ', - &'http://www.thep.lu.se/~torbjorn/Pyth', - &'ia.html ', - &' ', - &' ', - &'When you cite this program, currentl', - &'y the official reference is ', - &'T. Sjostrand, P. Eden, C. Friberg, L', - &'. Lonnblad, G. Miu, S. Mrenna and ', - &'E. Norrbin, Computer Physics Commun.', - &' 135 (2001) 238. ', - &'The large manual is ', - &' ', - &'T. Sjostrand, L. Lonnblad and S. Mre', - &'nna, LU TP 01-21 [hep-ph/0108264]. ', - &'Also remember that the program, to a', - &' large extent, represents original '/ - DATA (REFER(J),J=19,36)/ - &'physics research. Other publications', - &' of special relevance to your ', - &'studies may therefore deserve separa', - &'te mention. ', - &' ', - &' ', - &'Main author: Torbjorn Sjostrand; Dep', - &'artment of Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 48 16; e-ma', - &'il: torbjorn@thep.lu.se ', - &'Author: Leif Lonnblad; Department of', - &' Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 77 80; e-ma', - &'il: leif@thep.lu.se '/ - DATA (REFER(J),J=37,2*IREFER)/ - &'Author: Stephen Mrenna; Computing Di', - &'vision, Simulations Group, ', - &' Fermi National Accelerator Laborat', - &'ory, MS 234, Batavia, IL 60510, USA;', - &' phone: + 1 - 630 - 840 - 2556; e-m', - &'ail: mrenna@fnal.gov ', - &'Author: Peter Skands; Department of ', - &'Theoretical Physics 2, ', - &' Lund University, Solvegatan 14A, S', - &'-223 62 Lund, Sweden; ', - &' phone: + 46 - 46 - 222 31 92; e-ma', - &'il: zeiler@thep.lu.se '/ - -C...Check that PYDATA linked. - IF(MSTP(183)/10.NE.199.AND.MSTP(183)/10.NE.200) THEN - WRITE(*,'(1X,A)') - & 'Error: PYDATA has not been linked.' - WRITE(*,'(1X,A)') 'Execution stopped!' - STOP - -C...Write current version number and current date+time. - ELSE - WRITE(VERS,'(I1)') MSTP(181) - LOGO(28)(24:24)=VERS - WRITE(SUBV,'(I3)') MSTP(182) - LOGO(28)(26:28)=SUBV - IF(MSTP(182).LT.100) LOGO(28)(26:26)='0' - WRITE(DATE,'(I2)') MSTP(185) - LOGO(29)(22:23)=DATE - LOGO(29)(25:27)=MONTH(MSTP(184)) - WRITE(YEAR,'(I4)') MSTP(183) - LOGO(29)(29:32)=YEAR - CALL PYTIME(IDATI) - IF(IDATI(1).LE.0) THEN - LOGO(31)=' ' - ELSE - WRITE(DATE,'(I2)') IDATI(3) - LOGO(31)(8:9)=DATE - LOGO(31)(11:13)=MONTH(MAX(1,MIN(12,IDATI(2)))) - WRITE(YEAR,'(I4)') IDATI(1) - LOGO(31)(15:18)=YEAR - WRITE(HOUR,'(I2)') IDATI(4) - LOGO(31)(23:24)=HOUR - WRITE(MINU,'(I2)') IDATI(5) - LOGO(31)(26:27)=MINU - IF(IDATI(5).LT.10) LOGO(31)(26:26)='0' - WRITE(SECO,'(I2)') IDATI(6) - LOGO(31)(29:30)=SECO - IF(IDATI(6).LT.10) LOGO(31)(29:29)='0' - ENDIF - ENDIF - -C...Loop over lines in header. Define page feed and side borders. - DO 100 ILIN=1,29+IREFER - 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.GE.28+IREFER) THEN - LINE(4:77)='***********************************************'// - & '***************************' - ELSEIF(ILIN.GE.6.AND.ILIN.LE.24) THEN - LINE(6:37)=LOGO(ILIN-5) - LINE(44:75)=LOGO(ILIN+14) - ELSEIF(ILIN.GE.26.AND.ILIN.LE.25+IREFER) THEN - LINE(5:40)=REFER(2*ILIN-51) - LINE(41:76)=REFER(2*ILIN-50) - ENDIF - -C...Write lines to appropriate unit. - WRITE(MSTU(11),'(A79)') LINE - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYMAEL -C...Auxiliary to PYSHOW. -C...Matrix elements for gluon (or photon) emission from -C...a two-body state; to be used by the parton shower routine. -C...Here X_i = 2 E_i/E_cm, R_i = m_i/E_cm and -C...1/sigma_0 d(sigma)/d(x_1)d(x_2) = -C... = (alpha-strong/2 pi) * CF * PYMAEL, -C...i.e. normalization is such that one recovers the familiar -C...(X1**2+X2**2)/((1-X1)*(1-X2)) for the massless case. -C...Coupling structure: -C...NI = 6- 9 : eikonal soft-gluon expression (spin-independent) -C... = 11-14 : V -> q qbar (V = vector/axial vector colour singlet) -C... = 16-19 : q -> q V -C... = 21-24 : S -> q qbar (S = scalar/pseudoscalar colour singlet) -C... = 26-29 : q -> q S -C... = 31-34 : V -> ~q ~qbar (~q = squark) -C... = 36-39 : ~q -> ~q V -C... = 41-44 : S -> ~q ~qbar -C... = 46-49 : ~q -> ~q S -C... = 51-54 : chi -> q ~qbar (chi = neutralino/chargino) -C... = 56-59 : ~q -> q chi -C... = 61-64 : q -> ~q chi -C... = 66-69 : ~g -> q ~qbar -C... = 71-74 : ~q -> q ~g -C... = 76-79 : q -> ~q ~g -C... = 81-84 : (9/4)*(eikonal) for gg -> ~g ~g -C...Note that the order of the decay products is important. -C...In each set of four, the variants are ordered as: -C...ICOMBI = 1 : pure non-gamma5, i.e. vector/scalar/... -C... = 2 : pure gamma5, i.e. axial vector/pseudoscalar/.... -C... = 3 : mixture alpha*(ICOMBI=1) + (1-alpha)*(ICOMBI=2) -C... = 4 : mixture (ICOMBI=1) +- (ICOMBI=2) - - FUNCTION PYMAEL(NI,X1,X2,R1,R2,ALPHA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Check input values. Return zero outside allowed phase space. - PYMAEL=0D0 - IF(X1.LE.2D0*R1.OR.X1.GE.1D0+R1**2-R2**2) RETURN - IF(X2.LE.2D0*R2.OR.X2.GE.1D0+R2**2-R1**2) RETURN - IF(X1+X2.LE.1D0+(R1+R2)**2) RETURN - IF((2D0-2D0*X1-2D0*X2+X1*X2+2D0*R1**2+2D0*R2**2)**2.GE. - &(X1**2-4D0*R1**2)*(X2**2-4D0*R2**2)) RETURN - ALPCOR=MAX(0D0,MIN(1D0,ALPHA)) - -C...Initial values and flags. - ICLASS=NI/5 - ICOMBI=NI-5*ICLASS - ISSET1=0 - ISSET2=0 - ISSET4=0 - -C... Phase space. - PS=SQRT((1D0-(R1+R2)**2)*(1D0-(R1-R2)**2)) - -C...Eikonal expression; also acts as default. - IF(ICLASS.LE.1.OR.ICLASS.GE.17.OR.ICOMBI.EQ.0) THEN - RLO=PS - IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN - ANUM=0D0 - ELSEIF(ICOMBI.EQ.2) THEN - ANUM=(2D0-X1-X2)**2 - ELSEIF(ICOMBI.EQ.3) THEN - ANUM=ALPCOR*(2D0-X1-X2)**2 - ELSE - ANUM=0.5D0*(2D0-X1-X2)**2 - ENDIF - RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ - & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- - & R1**2/(1D0+R2**2-R1**2-X2)**2- - & R2**2/(1D0+R1**2-R2**2-X1)**2) - ICOMBI=0 - -C...V -> q qbar (V = gamma*/Z0/W+-/...). - ELSEIF(ICLASS.EQ.2) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(2-R1**2-R1**4+6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 - RFO1=-1.D0*(3+6*R1**2+R1**4-6*R1*R2+6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2+6*R1*R2**3+R2**4-3*X1+6*R1*R2*X1 - & +2*R2**2*X1+X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2) - & +6*R1*R2*(2-X1-X2)-R2**2*(2-X1-X2)-2*X1*(2-X1-X2) - & -5*R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) - & -3*(2-X1-X2)**2-3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2 - & +2*X1*(2-X1-X2)**2+(2-X1-X2)**3-X2)/ - & (-1+R1**2-R2**2+X2)**2 - RFO1=RFO1-2*(-3+R1**2-6*R1*R2+6*R1**3*R2+3*R2**2-4*R1**2*R2**2 - & +6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 - & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)+3*R1*R2*(2-X1 - & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) - & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2+R1*R2*(2 - & -X1-X2)**2+X1*(2-X1-X2)**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO1=RFO1-1.D0*(-1+2*R1**2+R1**4+6*R1*R2+6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2+6*R1*R2**3+R2**4-X1-2*R1**2*X1-6*R1*R2*X1 - & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2 - & -X1-X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2* - & (2-X1-X2)+X2)/(-1-R1**2+R2**2+X1)**2 - RFO1=RFO1/2.D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(2-R1**2-R1**4-6*R1*R2-R2**2+2*R1**2*R2**2-R2**4)/2.D0 - RFO2=-1*(3+6*R1**2+R1**4+6*R1*R2-6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2-6*R1*R2**3+R2**4-3*X1-6*R1*R2*X1+2*R2**2*X1 - & +X1**2-2*R1**2*X1**2+3*R1**2*(2-X1-X2)-6*R1*R2*(2-X1-X2) - & -R2**2*(2-X1-X2)-2*X1*(2-X1-X2)-5*R1**2*X1*(2-X1-X2) - & +R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2)-3*(2-X1-X2)**2 - & -3*R1**2*(2-X1-X2)**2+R2**2*(2-X1-X2)**2+2*X1*(2-X1-X2)**2 - & +(2-X1-X2)**3-X2)/(-1+R1**2-R2**2+X2)**2 - RFO2=RFO2-2*(-3+R1**2+6*R1*R2-6*R1**3*R2+3*R2**2-4*R1**2*R2**2 - & -6*R1*R2**3+2*X1+3*R1**2*X1+R2**2*X1-X1**2-R1**2*X1**2 - & -R2**2*X1**2+4*(2-X1-X2)+2*R1**2*(2-X1-X2)-3*R1*R2*(2-X1 - & -X2)-R2**2*(2-X1-X2)-3*X1*(2-X1-X2)-2*R1**2*X1*(2-X1-X2) - & +X1**2*(2-X1-X2)-(2-X1-X2)**2-R1**2*(2-X1-X2)**2-R1*R2*(2 - & -X1-X2)**2+X1*(2-X1-X2)**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO2=RFO2-1*(-1+2*R1**2+R1**4-6*R1*R2-6*R1**3*R2-2*R2**2 - & -6*R1**2*R2**2-6*R1*R2**3+R2**4-X1-2*R1**2*X1+6*R1*R2*X1 - & +8*R2**2*X1+X1**2-2*R2**2*X1**2-R1**2*(2-X1-X2)+R2**2*(2-X1 - & -X2)-R1**2*X1*(2-X1-X2)+R2**2*X1*(2-X1-X2)+X1**2*(2-X1-X2) - & +X2)/(-1-R1**2+R2**2+X1)**2 - RFO2=RFO2/2.D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(2D0-R1**2-R1**4-R2**2+2D0*R1**2*R2**2-R2**4)/2D0 - RFO4=(1-R1**4+6*R1**2*R2**2-R2**4+X1+3*R1**2*X1-9*R2**2*X1 - & -3*X1**2-R1**2*X1**2+3*R2**2*X1**2+X1**3-X2-R1**2*X2 - & +R2**2*X2-R1**2*X1*X2+R2**2*X1*X2+X1**2*X2)/ - & (-1-R1**2+R2**2+X1)**2 - RFO4=RFO4 - & -2*(1+R1**2+R2**2-4*R1**2*R2**2+R1**2*X1+2*R2**2*X1-X1**2 - & -R2**2*X1**2+2*R1**2*X2+R2**2*X2-3*X1*X2+X1**2*X2-X2**2 - & -R1**2*X2**2+X1*X2**2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - RFO4=RFO4+(1-R1**4+6*R1**2*R2**2-R2**4-X1+R1**2*X1-R2**2*X1+X2 - & -9*R1**2*X2+3*R2**2*X2+R1**2*X1*X2-R2**2*X1*X2-3*X2**2 - & +3*R1**2*X2**2-R2**2*X2**2+X1*X2**2+X2**3)/ - & (-1+R1**2-R2**2+X2)**2 - RFO4=RFO4/2.D0 - ISSET4=1 - ENDIF - -C...q -> q V. - ELSEIF(ICLASS.EQ.3) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4+R2**2-6D0*R1*R2**2 - & +R1**2*R2**2-2D0*R2**4) - RFO1=2*(-1+R1-2*R1**2+2*R1**3-R1**4+R1**5-R2**2+R1*R2**2 - & -5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4+2*X1-2*R1*X1 - & +2*R1**2*X1-2*R1**3*X1+2*R2**2*X1+5*R1*R2**2*X1 - & +R1**2*R2**2*X1+2*R2**4*X1-X1**2+R1*X1**2-R2**2*X1**2+3*X2 - & +4*R1**2*X2+R1**4*X2+2*R2**2*X2+2*R1**2*R2**2*X2-4*X1*X2 - & -2*R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-2*X2**2 - & -2*R1**2*X2**2+X1*X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) - RFO1=RFO1+(2*R2**2+6*R1*R2**2-6*R1**2*R2**2+6*R1**3*R2**2 - & +2*R2**4+6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 - & -R1**4*X2-3*R2**2*X2-6*R1*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO1=RFO1+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4 - & +9*X1+10*R1**2*X1+R1**4*X1-3*R2**2*X1+6*R1*R2**2*X1 - & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 - & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2+6*R1*R2**2*X2 - & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-2+X1+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-2D0*R1**2+R1**4+R2**2+6D0*R1*R2**2 - & +R1**2*R2**2-2D0*R2**4) - RFO2=2*(1+R1+2*R1**2+2*R1**3+R1**4+R1**5+R2**2+R1*R2**2 - & +5*R1**2*R2**2+R1**3*R2**2-2*R1*R2**4-2*X1-2*R1*X1 - & -2*R1**2*X1-2*R1**3*X1-2*R2**2*X1+5*R1*R2**2*X1 - & -R1**2*R2**2*X1-2*R2**4*X1+X1**2+R1*X1**2+R2**2*X1**2-3*X2 - & -4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2+4*X1*X2 - & +2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2+2*R1**2*X2**2 - & -X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - RFO2=RFO2+(2*R2**2-6*R1*R2**2-6*R1**2*R2**2-6*R1**3*R2**2 - & +2*R2**4-6*R1*R2**4-R2**2*X1+R1**2*R2**2*X1-R2**4*X1+X2 - & -R1**4*X2-3*R2**2*X2+6*R1*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO2=RFO2+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 - & +10*R1**2*X1+R1**4*X1-3*R2**2*X1-6*R1*R2**2*X1 - & +R1**2*R2**2*X1-2*R2**4*X1-6*X1**2-2*R1**2*X1**2+X1**3 - & +7*X2+8*R1**2*X2+R1**4*X2-7*R2**2*X2-6*R1*R2**2*X2 - & +R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 - & +X1*X2**2)/(-2+X1+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1.D0-2.D0*R1**2+R1**4+R2**2+R1**2*R2**2-2.D0*R2**4) - RFO4=2*(1+2*R1**2+R1**4+R2**2+5*R1**2*R2**2-2*X1-2*R1**2*X1 - & -2*R2**2*X1-R1**2*R2**2*X1-2*R2**4*X1+X1**2+R2**2*X1**2 - & -3*X2-4*R1**2*X2-R1**4*X2-2*R2**2*X2-2*R1**2*R2**2*X2 - & +4*X1*X2+2*R1**2*X1*X2+R2**2*X1*X2-X1**2*X2+2*X2**2 - & +2*R1**2*X2**2-X1*X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - RFO4=RFO4+(2*R2**2-6*R1**2*R2**2+2*R2**4-R2**2*X1+R1**2*R2**2*X1 - & -R2**4*X1+X2-R1**4*X2-3*R2**2*X2+9*R1**2*R2**2*X2 - & -2*R2**4*X2-X1*X2+R1**2*X1*X2-X2**2-3*R1**2*X2**2 - & +2*R2**2*X2**2+X1*X2**2)/(-1+R1**2-R2**2+X2)**2 - RFO4=RFO4+(-4-8*R1**2-4*R1**4+4*R2**2-4*R1**2*R2**2+8*R2**4+9*X1 - & +10*R1**2*X1+R1**4*X1-3*R2**2*X1+R1**2*R2**2*X1-2*R2**4*X1 - & -6*X1**2-2*R1**2*X1**2+X1**3+7*X2+8*R1**2*X2+R1**4*X2 - & -7*R2**2*X2+R1**2*R2**2*X2-2*R2**4*X2-9*X1*X2-3*R1**2*X1*X2 - & +2*R2**2*X1*X2+2*X1**2*X2-3*X2**2-R1**2*X2**2+2*R2**2*X2**2 - & +X1*X2**2)/(2-X1-X2)**2 - ISSET4=1 - ENDIF - -C...S -> q qbar (S = h0/H0/A0/H+-/...). - ELSEIF(ICLASS.EQ.4) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2-R2**2-2D0*R1*R2) - RFO1=-(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -2*(R1**2+R1**4-2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4-R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2-R2**2+2D0*R1*R2) - RFO2=-(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +2*(-R1**2-R1**4-2*R1**3*R2-R2**2+6*R1**2*R2**2 - & -2*R1*R2**3-R2**4+R1**2*X1+R1*R2*X1-2*R2**2*X1 - & -2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2-R2**2) - RFO4=-(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 - & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -2*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 - & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1 - & +X2+3*R1**2*X2-R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...q -> q S. - ELSEIF(ICLASS.EQ.5) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=(4-4*R1**2+4*R2**2-3*X1-2*R1*X1+R1**2*X1-R2**2*X1-5*X2 - & -2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3-R1-5*R1**2-R1**3+3*R2**2+R1*R2**2-2*X1-R1*X1 - & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) - RFO2=(4-4*R1**2+4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2 - & +2*R1*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3+R1-5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1 - & +R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0+R1**2-R2**2) - RFO4=(4-4*R1**2+4*R2**2-3*X1+R1**2*X1-R2**2*X1-5*X2+R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2 - & +2*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2+2*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(1-R1**2+R2**2-X2)/(-2+X1+X2) - & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...V -> ~q ~qbar (~q = squark). - ELSEIF(ICLASS.EQ.6) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) - RFO1=2D0*3D0+(1+R1**2+R2**2-X1)*(4*R1**2-X1**2)/ - & (-1-R1**2+R2**2+X1)**2 - & -2D0*(-1-3*R1**2-R2**2+X1+X1**2/2+X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1) - & +(1+R1**2+R2**2-X2)*(4*R2**2-X2**2) - & /(-1+R1**2-R2**2+X2)**2 - & -2D0*(-1-R1**2-3*R2**2+X1+X2-X1*X2/2+X2**2/2)/ - & (-1+R1**2-R2**2+X2) - & -(-4*R1**2-4*R1**4-4*R2**2-8*R1**2*R2**2-4*R2**4+2*X1 - & +6*R1**2*X1+6*R2**2*X1-2*X1**2+2*X2+6*R1**2*X2+6*R2**2*X2 - & -4*X1*X2-2*R1**2*X1*X2-2*R2**2*X1*X2+X1**2*X2-2*X2**2 - & +X1*X2**2)/(-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - ISSET1=1 - -C...~q -> ~q V. - ELSEIF(ICLASS.EQ.7) THEN - RLO1=PS*(1D0-2D0*R1**2+R1**4-2D0*R2**2-2D0*R1**2*R2**2+R2**4) - RFO1=16*R2**2+8*(4*R2**2+2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2 - & -2*X2**2)/(3*(-1+R1**2-R2**2+X2))+8*(1+R1**2+R2**2-X2)* - & (4*R2**2-X2**2)/(3*(-1+R1**2-R2**2+X2)**2)+8*(X1+X2)* - & (-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 - & +2*R1**2*X1+2*R2**2*X1-X1**2+2*X2+2*R1**2*X2+2*R2**2*X2 - & -2*X1*X2-X2**2)/(3*(-2+X1+X2)**2)+8*(-1-R1**2+R2**2-X1)* - & (2*R2**2*X1+X2+R1**2*X2+R2**2*X2-X1*X2-X2**2)/ - & (3*(-1+R1**2-R2**2+X2)*(-2+X1+X2))+8*(1+2*R1**2+R1**4 - & +2*R2**2-2*R1**2*R2**2+R2**4-2*X1-2*R1**2*X1-4*R2**2*X1 - & +X1**2-3*X2-3*R1**2*X2-3*R2**2*X2+3*X1*X2+2*X2**2)/ - & (3*(-2+X1+X2)) - RFO1=3D0*RFO1/8D0 - ISSET1=1 - -C...S -> ~q ~qbar. - ELSEIF(ICLASS.EQ.8) THEN - RLO1=PS - RFO1=(-1-2*R1**2-R1**4-2*R2**2+2*R1**2*R2**2-R2**4+2*X1 - & +2*R1**2*X1+2*R2**2*X1-X1**2-R2**2*X1**2+2*X2+2*R1**2*X2 - & +2*R2**2*X2-3*X1*X2-R1**2*X1*X2-R2**2*X1*X2+X1**2*X2-X2**2 - & -R1**2*X2**2+X1*X2**2)/ - & (1+R1**2-R2**2-X1)**2/(-1+R1**2-R2**2+X2)**2 - RFO1=2D0*RFO1 - ISSET1=1 - -C...~q -> ~q S. - ELSEIF(ICLASS.EQ.9) THEN - RLO1=PS - RFO1=(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(1+R1**2-R2**2+X1)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - & -(X1+X2)/(-2+X1+X2)**2 - ISSET1=1 - -C...chi -> q ~qbar (chi = neutralino/chargino). - ELSEIF(ICLASS.EQ.10) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=(2*R1+X1)*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 - & +2*(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1 - & -R1**2*X1/2-R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2-2*R1-6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-2D0*R1+R1**2-R2**2) - RFO2=(2*R1-X1)*(1+R1**2+R2**2-X1)/(-1-R1**2+R2**2+X1)**2 - & +2*(-1-R1**2+2*R1**3-R2**2+2*R1*R2**2+3*X1/2-R1*X1 - & -R1**2*X1/2-R2**2*X1/2+X2-R1*X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2+2*R1-6*R1**2+2*R1**3+2*R2**2+2*R1*R2**2-X1+R1**2*X1 - & -R2**2*X1-3*X2-2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-1+R1**2-R2**2+X2)**2 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1+R1**2-R2**2) - RFO4=X1*(-1-R1**2-R2**2+X1)/(-1-R1**2+R2**2+X1)**2 - & +2D0*(-1-R1**2-R2**2+3*X1/2-R1**2*X1/2-R2**2*X1/2 - & +X2+R1**2*X2-X1*X2/2)/ - & (-1-R1**2+R2**2+X1)/(-1+R1**2-R2**2+X2) - & +(2-6*R1**2+2*R2**2-X1+R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2 - & -R2**2*X2+X1*X2+X2**2)/(-1+R1**2-R2**2+X2)**2 - ISSET4=1 - ENDIF - -C...~q -> q chi. - ELSEIF(ICLASS.EQ.11) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-(R1+R2)**2) - RFO1=(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 - & -(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 - & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-(R1-R2)**2) - RFO2=(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/ - & (-2+X1+X2)**2 - & -(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(-1+R1**2-R2**2+X2)**2 - & +(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3+R2**4 - & +X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(-1+R1**2-R2**2+X2)/(-2+X1+X2) - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2-R2**2) - RFO4=(1+R1**2+R2**2-X1-X2)*(X1+X2)/(-2+X1+X2)**2 - & -(-1+R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2 - & +3*R1**2*X2-R2**2*X2-X1*X2)/ - & (-1+R1**2-R2**2+X2)**2 - & -(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 - & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET4=1 - ENDIF - -C...q -> ~q chi. - ELSEIF(ICLASS.EQ.12) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) - RFO1=(2*R2+X2)*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1-2*R2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2-2*R2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2+R2+R1**2*R2-R2**2-R2**3+X1 - & +R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET1=1 - END IF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) - RFO2=(2*R2-X2)*(1+R1**2+R2**2-X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 - & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET2=1 - END IF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2+R2**2) - RFO4=X2*(-1-R1**2-R2**2+X2)/(-1+R1**2-R2**2+X2)**2 - & +(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2 - & -3*X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-2+X1+X2)**2-2*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2 - & +R1**2*X2-X1*X2/2-X2**2/2)/ - & (2-X1-X2)/(-1+R1**2-R2**2+X2) - ISSET4=1 - END IF - -C...~g -> q ~qbar. - ELSEIF(ICLASS.EQ.13) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0+R1**2-R2**2+2D0*R1) - RFO1=4*(2*R1+X1)*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2) - & -(-1-R1**2-2*R1**3-R2**2-2*R1*R2**2+3*X1/2+R1*X1-R1**2*X1/2 - & -R2**2*X1/2+X2+R1*X2+R1**2*X2-X1*X2/2)/(3*(-1-R1**2+R2**2 - & +X1)*(-1+R1**2-R2**2+X2))-3*(-1+R1-R1**2-R1**3-R2**2 - & +R1*R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1*X2+R1**2*X2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+3*(4-4*R1**2+4*R2**2-3*X1 - & -2*R1*X1+R1**2*X1-R2**2*X1-5*X2-2*R1*X2+R1**2*X2-R2**2*X2 - & +X1*X2+X2**2)/(-2+X1+X2)**2+3*(3-R1-5*R1**2-R1**3+3*R2**2 - & +R1*R2**2-2*X1-R1*X1+R1**2*X1-4*X2+2*R1**2*X2-R2**2*X2 - & +X1*X2+X2**2)/((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2-2*R1 - & -6*R1**2-2*R1**3+2*R2**2-2*R1*R2**2-X1+R1**2*X1-R2**2*X1 - & -3*X2+2*R1*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO1=3D0*RFO1/4D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0+R1**2-R2**2-2D0*R1) - RFO2=4*(2*R1-X1)*(1+R1**2+R2**2-X1)/(3*(-1-R1**2+R2**2+X1)**2) - & -3*(-1-R1-R1**2+R1**3-R2**2-R1*R2**2+2*X1+R2**2*X1-X1**2/2 - & +X2-R1*X2+R1**2*X2-X1*X2/2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - & +(2+2*R1**2-4*R1**3+2*R2**2-4*R1*R2**2-3*X1+2*R1*X1 - & +R1**2*X1+R2**2*X1-2*X2+2*R1*X2-2*R1**2*X2+X1*X2)/ - & (6*(-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+3*(4-4*R1**2 - & +4*R2**2-3*X1+2*R1*X1+R1**2*X1-R2**2*X1-5*X2+2*R1*X2 - & +R1**2*X2-R2**2*X2+X1*X2+X2**2)/(-2+X1+X2)**2+3*(3+R1 - & -5*R1**2+R1**3+3*R2**2-R1*R2**2-2*X1+R1*X1+R1**2*X1-4*X2 - & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+4*(2+2*R1-6*R1**2+2*R1**3 - & +2*R2**2+2*R1*R2**2-X1+R1**2*X1-R2**2*X1-3*X2-2*R1*X2 - & +3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO2=3D0*RFO2/4D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0+R1**2-R2**2) - RFO4=8*X1*(-1-R1**2-R2**2+X1)/(3*(-1-R1**2+R2**2+X1)**2)-6*(-1 - & -R1**2-R2**2+2*X1+R2**2*X1-X1**2/2+X2+R1**2*X2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+(2+2*R1**2+2*R2**2-3*X1 - & +R1**2*X1+R2**2*X1-2*X2-2*R1**2*X2+X1*X2)/(3*(-1-R1**2 - & +R2**2+X1)*(-1+R1**2-R2**2+X2))+6*(4-4*R1**2+4*R2**2-3*X1 - & +R1**2*X1-R2**2*X1-5*X2+R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (-2+X1+X2)**2+6*(3-5*R1**2+3*R2**2-2*X1+R1**2*X1-4*X2 - & +2*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & ((1-R1**2+R2**2-X2)*(-2+X1+X2))+8*(2-6*R1**2+2*R2**2-X1 - & +R1**2*X1-R2**2*X1-3*X2+3*R1**2*X2-R2**2*X2+X1*X2+X2**2)/ - & (3*(-1+R1**2-R2**2+X2)**2) - RFO4=3D0*RFO4/8D0 - ISSET4=1 - ENDIF - -C...~q -> q ~g. - ELSEIF(ICLASS.EQ.14) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1-R1**2-R2**2-2D0*R1*R2) - RFO1=64*(1+R1**2+2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) - & -16*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-16*(R1**2+R1**4 - & -2*R1**3*R2+R2**2-6*R1**2*R2**2-2*R1*R2**3+R2**4 - & -R1**2*X1+R1*R2*X1+2*R2**2*X1+2*R1**2*X2+R1*R2*X2-R2**2*X2 - & -X1*X2)/((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) - & -64*(-1+R1**4-2*R1*R2-2*R1**3*R2-6*R1**2*R2**2-2*R1*R2**3 - & +R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2+2*R1*R2*X2 - & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1+R1**4-2*R1*R2+2*R1**3*R2-2*R2**2-2*R1*R2**3-R2**4 - & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2-2*R1*R2*X2 - & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) - RFO1=RFO1 - & +8*(-1-2*R1**2-R1**4-2*R1*R2-2*R1**3*R2+2*R1*R2**3+R2**4 - & +X1+R1**2*X1-2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2-2*R2**2*X2 - & +X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO1=9D0*RFO1/64D0 - ISSET1=1 - ENDIF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1-R1**2-R2**2+2D0*R1*R2) - RFO2=64*(1+R1**2-2*R1*R2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2) - & -16*(-1+R1**4+2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3 - & +R2**4+X1-R1**2*X1-2*R1*R2*X1+3*R2**2*X1+X2+R1**2*X2 - & -R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2-64*(-1+R1**4 - & +2*R1*R2+2*R1**3*R2-6*R1**2*R2**2+2*R1*R2**3+R2**4+X1 - & -R1**2*X1+R2**2*X1+X2+3*R1**2*X2-2*R1*R2*X2-R2**2*X2 - & -X1*X2)/(9*(-1+R1**2-R2**2+X2)**2)+16*(-R1**2-R1**4 - & -2*R1**3*R2-R2**2+6*R1**2*R2**2-2*R1*R2**3-R2**4+R1**2*X1 - & +R1*R2*X1-2*R2**2*X1-2*R1**2*X2+R1*R2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2)) - RFO2=RFO2 - & +8*(-1+R1**4+2*R1*R2-2*R1**3*R2-2*R2**2+2*R1*R2**3-R2**4 - & -2*R1**2*X1+2*R2**2*X1+X1**2+X2-3*R1**2*X2+2*R1*R2*X2 - & +R2**2*X2+X1*X2)/((-1-R1**2+R2**2+X1)*(-2+X1+X2)) - & +8*(-1-2*R1**2-R1**4+2*R1*R2+2*R1**3*R2-2*R1*R2**3 - & +R2**4+X1+R1**2*X1+2*R1*R2*X1-3*R2**2*X1+2*R1**2*X2 - & -2*R2**2*X2+X1*X2+X2**2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO2=9D0*RFO2/64D0 - ISSET2=1 - ENDIF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1-R1**2-R2**2) - RFO4=128*(1+R1**2+R2**2-X1-X2)*(X1+X2)/(9*(-2+X1+X2)**2)-32*(-1 - & +R1**4-6*R1**2*R2**2+R2**4+X1-R1**2*X1+3*R2**2*X1+X2 - & +R1**2*X2-R2**2*X2-X1*X2)/(-1-R1**2+R2**2+X1)**2 - & -32*(R1**2+R1**4+R2**2-6*R1**2*R2**2+R2**4-R1**2*X1 - & +2*R2**2*X1+2*R1**2*X2-R2**2*X2-X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))-128*(-1+R1**4 - & -6*R1**2*R2**2+R2**4+X1-R1**2*X1+R2**2*X1+X2+3*R1**2*X2 - & -R2**2*X2-X1*X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +16*(-1+R1**4-2*R2**2-R2**4-2*R1**2*X1+2*R2**2*X1+X1**2 - & +X2-3*R1**2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(-2+X1+ X2)) - RFO4=RFO4+16*(-1-2*R1**2-R1**4+R2**4+X1+R1**2*X1-3*R2**2*X1 - & +2*R1**2*X2-2*R2**2*X2+X1*X2+X2**2)/ - & (9*(1-R1**2+R2**2-X2)*(-2+X1+X2)) - RFO4=9D0*RFO4/128D0 - ISSET4=1 - ENDIF - -C...q -> ~q ~g. - ELSEIF(ICLASS.EQ.15) THEN - IF(ICOMBI.EQ.1.OR.ICOMBI.EQ.3) THEN - RLO1=PS*(1D0-R1**2+R2**2+2D0*R2) - RFO1=32*(2*R2+X2)*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1-R1**2-2*R1**2*R2-R2**2-2*R2**3+X1+R2*X1+R2**2*X1 - & +3*X2/2-R1**2*X2/2+R2*X2-R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2-2*R2 - & -2*R1**2*R2-6*R2**2-2*R2**3-3*X1-R1**2*X1+2*R2*X1 - & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)**2+32*(4+4*R1**2-4*R2**2-5*X1 - & -R1**2*X1-2*R2*X1+R2**2*X1+X1**2-3*X2-R1**2*X2-2*R2*X2 - & +R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) - RFO1=RFO1+8*(3+3*R1**2-R2+R1**2*R2-5*R2**2-R2**3-4*X1-R1**2*X1 - & +2*R2**2*X1+X1**2-2*X2-R2*X2+R2**2*X2+X1*X2)/ - & ((-1-R1**2+R2**2+X1)*(2-X1-X2))+8*(-1-R1**2+R2+R1**2*R2 - & -R2**2-R2**3+X1+R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 - & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO1=9D0*RFO1/32D0 - ISSET1=1 - END IF - IF(ICOMBI.EQ.2.OR.ICOMBI.EQ.3) THEN - RLO2=PS*(1D0-R1**2+R2**2-2D0*R2) - RFO2=32*(2*R2-X2)*(1+R1**2+R2**2-X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +8*(-1-R1**2+2*R1**2*R2-R2**2+2*R2**3+X1-R2*X1+R2**2*X1 - & +3*X2/2-R1**2*X2/2-R2*X2-R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+8*(2+2*R1**2+2*R2 - & +2*R1**2*R2-6*R2**2+2*R2**3-3*X1-R1**2*X1-2*R2*X1 - & +3*R2**2*X1+X1**2-X2-R1**2*X2+R2**2*X2+X1*X2)/ - & (-1-R1**2+R2**2+X1)**2+8*(3+3*R1**2+R2-R1**2*R2-5*R2**2 - & +R2**3-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2*X2+R2**2*X2 - & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - RFO2=RFO2+32*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+2*R2*X1+R2**2*X1 - & +X1**2-3*X2-R1**2*X2+2*R2*X2+R2**2*X2+X1*X2)/ - & (9*(-2+X1+X2)**2)+8*(-1-R1**2-R2-R1**2*R2-R2**2+R2**3+X1 - & -R2*X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2-X2**2/2)/ - & (9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO2=9D0*RFO2/32D0 - ISSET2=1 - END IF - IF(ICOMBI.EQ.4) THEN - RLO4=PS*(1D0-R1**2+R2**2) - RFO4=64*X2*(-1-R1**2-R2**2+X2)/(9*(-1+R1**2-R2**2+X2)**2) - & +16*(-1-R1**2-R2**2+X1+R2**2*X1+3*X2/2-R1**2*X2/2 - & -R2**2*X2/2-X1*X2/2)/ - & ((-1-R1**2+R2**2+X1)*(-1+R1**2-R2**2+X2))+16*(3+3*R1**2 - & -5*R2**2-4*X1-R1**2*X1+2*R2**2*X1+X1**2-2*X2+R2**2*X2 - & +X1*X2)/((-1-R1**2+R2**2+X1)*(2-X1-X2)) - & +64*(4+4*R1**2-4*R2**2-5*X1-R1**2*X1+R2**2*X1+X1**2-3*X2 - & -R1**2*X2+R2**2*X2+X1*X2)/(9*(-2+X1+X2)**2) - RFO4=RFO4+16*(2+2*R1**2-6*R2**2-3*X1-R1**2*X1+3*R2**2*X1+X1**2 - & -X2-R1**2*X2+R2**2*X2+X1*X2)/(-1-R1**2+R2**2+X1)**2 - & +16*(-1-R1**2-R2**2+X1+R2**2*X1+2*X2+R1**2*X2-X1*X2/2 - & -X2**2/2)/(9*(2-X1-X2)*(-1+R1**2-R2**2+X2)) - RFO4=9D0*RFO4/64D0 - ISSET4=1 - END IF - -C...g -> ~g ~g. Use (9/4)*eikonal. May be changed in the future. - ELSEIF(ICLASS.EQ.16) THEN - RLO=PS - IF(ICOMBI.EQ.0.OR.ICOMBI.EQ.1) THEN - ANUM=0D0 - ELSEIF(ICOMBI.EQ.2) THEN - ANUM=(2D0-X1-X2)**2 - ELSEIF(ICOMBI.EQ.3) THEN - ANUM=ALPCOR*(2D0-X1-X2)**2 - ELSE - ANUM=0.5D0*(2D0-X1-X2)**2 - ENDIF - RFO=PS*2D0*((X1+X2-1D0+ANUM-R1**2-R2**2)/ - & ((1D0+R1**2-R2**2-X1)*(1D0+R2**2-R1**2-X2))- - & R1**2/(1D0+R2**2-R1**2-X2)**2- - & R2**2/(1D0+R1**2-R2**2-X1)**2) - RFO=9D0*RFO/4D0 - ICOMBI=0 - ENDIF - -C...Find relevant LO and FO expression. - IF(ICOMBI.EQ.0) THEN - ELSEIF(ICOMBI.EQ.1.AND.ISSET1.EQ.1) THEN - RLO=RLO1 - RFO=RFO1 - ELSEIF(ICOMBI.EQ.2.AND.ISSET2.EQ.1) THEN - RLO=RLO2 - RFO=RFO2 - ELSEIF(ICOMBI.EQ.3.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN - RLO=ALPCOR*RLO1+(1D0-ALPCOR)*RLO2 - RFO=ALPCOR*RFO1+(1D0-ALPCOR)*RFO2 - ELSEIF(ISSET4.EQ.1) THEN - RLO=RLO4 - RFO=RFO4 - ELSEIF(ICOMBI.EQ.4.AND.ISSET1.EQ.1.AND.ISSET2.EQ.1) THEN - RLO=0.5D0*(RLO1+RLO2) - RFO=0.5D0*(RFO1+RFO2) - ELSEIF(ISSET1.EQ.1) THEN - RLO=RLO1 - RFO=RFO1 - ELSE - CALL PYERRM(16,'(PYMAEL:) not implemented ME code') - RLO=1D0 - RFO=0D0 - ENDIF - -C...Output. - PYMAEL=RFO/RLO - - RETURN - END - -C********************************************************************* - -C...PYMASS -C...Gives the mass of a particle/parton. - - FUNCTION PYMASS(KF) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Reset variables. Compressed code. Special case for popcorn diquarks. - PYMASS=0D0 - KFA=IABS(KF) - KC=PYCOMP(KF) - IF(KC.EQ.0) THEN - MSTJ(93)=0 - RETURN - ENDIF - -C...Guarantee use of constituent masses for internal checks. - IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND. - &(KFA.LE.10.OR.MOD(KFA/10,10).EQ.0)) THEN - IF(KFA.LE.5) THEN - PYMASS=PARF(100+KFA) - IF(MSTJ(93).EQ.2) PYMASS=MAX(0D0,PYMASS-PARF(121)) - ELSEIF(KFA.LE.10) THEN - PYMASS=PMAS(KFA,1) - ELSEIF(MSTJ(93).EQ.1) THEN - PYMASS=PARF(100+MOD(KFA/1000,10))+PARF(100+MOD(KFA/100,10)) - ELSE - PYMASS=MAX(0D0,PMAS(KC,1)-PARF(122)-2D0*PARF(112)/3D0) - ENDIF - -C...Other masses can be read directly off table. - ELSE - PYMASS=PMAS(KC,1) - 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.1D-4) THEN - IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN - PYMASS=PYMASS+0.5D0*PMAS(KC,2)*TAN((2D0*PYR(0)-1D0)* - & ATAN(2D0*PMAS(KC,3)/PMAS(KC,2))) - ELSE - PM0=PYMASS - PMLOW=ATAN((MAX(0D0,PM0-PMAS(KC,3))**2-PM0**2)/ - & (PM0*PMAS(KC,2))) - PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) - PYMASS=SQRT(MAX(0D0,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ - & (PMUPP-PMLOW)*PYR(0)))) - ENDIF - ENDIF - MSTJ(93)=0 - - RETURN - END - -C********************************************************************* - -C...PYMAXI -C...Finds optimal set of coefficients for kinematical variable selection -C...and the maximum of the part of the differential cross-section used -C...in the event weighting. - - SUBROUTINE PYMAXI - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28 - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT6/,/PYINT7/ -C...Local arrays, character variables and data. - CHARACTER CVAR(4)*4 - DIMENSION NPTS(4),MVARPT(500,4),VINTPT(500,30),SIGSPT(500), - &NAREL(7),WTREL(7),WTMAT(7,7),WTRELN(7),COEFU(7),COEFO(7), - &IACCMX(4),SIGSMX(4),SIGSSM(3),PMMN(2) - DATA CVAR/'tau ','tau''','y* ','cth '/ - DATA SIGSSM/3*0D0/ - -C...Initial values and loop over subprocesses. - NPOSI=0 - VINT(143)=1D0 - VINT(144)=1D0 - XSEC(0,1)=0D0 - DO 460 ISUB=1,500 - MINT(1)=ISUB - MINT(51)=0 - -C...Find maximum weight factors for photon flux. - IF(MSUB(ISUB).EQ.1.OR.(ISUB.GE.91.AND.ISUB.LE.100)) THEN - IF(MINT(141).NE.0.OR.MINT(142).NE.0) CALL PYGAGA(2,WTGAGA) - ENDIF - -C...Select subprocess to study: skip cases not applicable. - IF(ISET(ISUB).EQ.11) THEN - IF(MSUB(ISUB).NE.1) GOTO 460 -C...User process intialization: cross section model dependent. - IF(IABS(IDWTUP).EQ.1) THEN - IF(IDWTUP.GT.0.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') - XSEC(ISUB,1)=1.00000001D-9*ABS(XMAXUP(KFPR(ISUB,1))) - ELSE - IF((IDWTUP.EQ.2.OR.IDWTUP.EQ.3).AND. - & XSECUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XSECUP for user process') - IF(IDWTUP.EQ.2.AND.XMAXUP(KFPR(ISUB,1)).LT.0D0) CALL - & PYERRM(26,'(PYMAXI:) Negative XMAXUP for user process') - XSEC(ISUB,1)=1.00000001D-9*ABS(XSECUP(KFPR(ISUB,1))) - ENDIF - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - NPOSI=NPOSI+1 - GOTO 450 - ELSEIF(ISUB.GE.91.AND.ISUB.LE.95) THEN - CALL PYSIGH(NCHN,SIGS) - XSEC(ISUB,1)=SIGS - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - IF(MSUB(ISUB).NE.1) GOTO 460 - NPOSI=NPOSI+1 - GOTO 450 - ELSEIF(ISUB.EQ.99.AND.MSUB(ISUB).EQ.1) THEN - CALL PYSIGH(NCHN,SIGS) - XSEC(ISUB,1)=SIGS - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - IF(XSEC(ISUB,1).EQ.0D0) THEN - MSUB(ISUB)=0 - ELSE - NPOSI=NPOSI+1 - ENDIF - GOTO 450 - ELSEIF(ISUB.EQ.96) THEN - IF(MINT(50).EQ.0) GOTO 460 - IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) - & GOTO 460 - IF(MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 460 - ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR. - & ISUB.EQ.53.OR.ISUB.EQ.68) THEN - IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 - ELSEIF(ISUB.GE.381.AND.ISUB.LE.386) THEN - IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 460 - ELSE - IF(MSUB(ISUB).NE.1) GOTO 460 - ENDIF - ISTSB=ISET(ISUB) - IF(ISUB.EQ.96) ISTSB=2 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5000) ISUB - MWTXS=0 - IF(MSTP(142).GE.1.AND.ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+ - & MSUB(94)+MSUB(95).EQ.0) MWTXS=1 - -C...Find resonances (explicit or implicit in cross-section). - MINT(72)=0 - KFR1=0 - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - KFR1=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165 - & .OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN - KFR1=23 - ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172 - & .OR.ISUB.EQ.177) THEN - KFR1=24 - ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN - KFR1=25 - IF(MSTP(46).EQ.5) THEN - KFR1=89 - PMAS(89,1)=PARP(45) - PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) - ENDIF - ELSEIF(ISUB.EQ.194) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.EQ.195) THEN - KFR1=KTECHN+213 - ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN - KFR1=KTECHN+213 - ENDIF - CKMX=CKIN(2) - IF(CKMX.LE.0D0) CKMX=VINT(1) - KCR1=PYCOMP(KFR1) - IF(KFR1.NE.0) THEN - IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. - & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 - ENDIF - IF(KFR1.NE.0) THEN - TAUR1=PMAS(KCR1,1)**2/VINT(2) - IF(KFR1.EQ.KTECHN+113) THEN - CALL PYTECM(S1,S2) - TAUR1=S1/VINT(2) - ENDIF - GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - KFR2=0 - IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) - $ THEN - KFR2=23 - IF(ISUB.EQ.194) THEN - KFR2=KTECHN+223 - ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN - KFR2=KTECHN+223 - ENDIF - KCR2=PYCOMP(KFR2) - TAUR2=PMAS(KCR2,1)**2/VINT(2) - IF(KFR2.EQ.KTECHN+223) THEN - CALL PYTECM(S1,S2) - TAUR2=S2/VINT(2) - ENDIF - GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) - IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. - & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 - IF(KFR2.NE.0.AND.KFR1.NE.0) THEN - MINT(72)=2 - MINT(74)=KFR2 - VINT(75)=TAUR2 - VINT(76)=GAMR2 - ELSEIF(KFR2.NE.0) THEN - KFR1=KFR2 - TAUR1=TAUR2 - GAMR1=GAMR2 - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - KFR2=0 - ENDIF - ENDIF - -C...Find product masses and minimum pT of process. - SQM3=0D0 - SQM4=0D0 - MINT(71)=0 - VINT(71)=CKIN(3) - VINT(80)=1D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - NBW=0 - DO 110 I=1,2 - PMMN(I)=0D0 - IF(KFPR(ISUB,I).EQ.0) THEN - ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. - & PARP(41)) THEN - IF(I.EQ.1) SQM3=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - IF(I.EQ.2) SQM4=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - ELSE - NBW=NBW+1 -C...This prevents SUSY/t particles from becoming too light. - KFLW=KFPR(ISUB,I) - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - KCW=PYCOMP(KFLW) - PMMN(I)=PMAS(KCW,1) - DO 100 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 100 CONTINUE - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - ENDIF - 110 CONTINUE - IF(NBW.GE.1) THEN - CKIN41=CKIN(41) - CKIN43=CKIN(43) - CKIN(41)=MAX(PMMN(1),CKIN(41)) - CKIN(43)=MAX(PMMN(2),CKIN(43)) - CALL PYOFSH(3,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) - CKIN(41)=CKIN41 - CKIN(43)=CKIN43 - IF(MINT(51).EQ.1) THEN - WRITE(MSTU(11),5100) ISUB - MSUB(ISUB)=0 - GOTO 460 - ENDIF - SQM3=PQM3**2 - SQM4=PQM4**2 - ENDIF - IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1 - IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) - IF(ISUB.EQ.96.AND.MSTP(82).LE.1) THEN - VINT(71)=PARP(81)*(VINT(1)/PARP(89))**PARP(90) - ELSEIF(ISUB.EQ.96) THEN - VINT(71)=0.08D0*PARP(82)*(VINT(1)/PARP(89))**PARP(90) - ENDIF - ENDIF - VINT(63)=SQM3 - VINT(64)=SQM4 - -C...Prepare for additional variable choices in 2 -> 3. - IF(ISTSB.EQ.5) THEN - VINT(201)=0D0 - IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) - VINT(206)=VINT(201) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) - VINT(204)=PMAS(23,1) - IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) - IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182 - & .OR.ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) - & VINT(204)=VINT(201) - VINT(209)=VINT(204) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) - ENDIF - -C...Number of points for each variable: tau, tau', y*, cos(theta-hat). - NPTS(1)=2+2*MINT(72) - IF(MINT(47).EQ.1) THEN - IF(ISTSB.EQ.1.OR.ISTSB.EQ.2) NPTS(1)=1 - ELSEIF(MINT(47).GE.5) THEN - IF(ISTSB.LE.2.OR.ISTSB.GT.5) NPTS(1)=NPTS(1)+1 - ENDIF - NPTS(2)=1 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - IF(MINT(47).GE.2) NPTS(2)=2 - IF(MINT(47).GE.5) NPTS(2)=3 - ENDIF - NPTS(3)=1 - IF(MINT(47).EQ.4.OR.MINT(47).EQ.5) THEN - NPTS(3)=3 - IF(MINT(45).EQ.3) NPTS(3)=NPTS(3)+1 - IF(MINT(46).EQ.3) NPTS(3)=NPTS(3)+1 - ENDIF - NPTS(4)=1 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5 - NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) - -C...Reset coefficients of cross-section weighting. - DO 120 J=1,20 - COEF(ISUB,J)=0D0 - 120 CONTINUE - COEF(ISUB,1)=1D0 - COEF(ISUB,8)=0.5D0 - COEF(ISUB,9)=0.5D0 - COEF(ISUB,13)=1D0 - COEF(ISUB,18)=1D0 - MCTH=0 - MTAUP=0 - METAUP=0 - VINT(23)=0D0 - VINT(26)=0D0 - SIGSAM=0D0 - -C...Find limits and select tau, y*, cos(theta-hat) and tau' values, -C...in grid of phase space points. - CALL PYKLIM(1) - METAU=MINT(51) - NACC=0 - DO 150 ITRY=1,NTRY - MINT(51)=0 - IF(METAU.EQ.1) GOTO 150 - IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN - MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4)) - IF(MTAU.GT.2+2*MINT(72)) MTAU=7 - RTAU=0.5D0 -C...Special case when both resonances have same mass, -C...as is often the case in process 194. - IF(MINT(72).EQ.2) THEN - IF(ABS(PMAS(KCR2,1)-PMAS(KCR1,1)).LT. - & 0.01D0*(PMAS(KCR2,1)+PMAS(KCR1,1))) THEN - IF(MTAU.EQ.3.OR.MTAU.EQ.4) THEN - RTAU=0.4D0 - ELSEIF(MTAU.EQ.5.OR.MTAU.EQ.6) THEN - RTAU=0.6D0 - ENDIF - ENDIF - ENDIF - CALL PYKMAP(1,MTAU,RTAU) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) CALL PYKLIM(4) - METAUP=MINT(51) - ENDIF - IF(METAUP.EQ.1) GOTO 150 - IF(ISTSB.GE.3.AND.ISTSB.LE.5.AND.MOD(ITRY-1,NPTS(3)*NPTS(4)) - & .EQ.0) THEN - MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2)) - CALL PYKMAP(4,MTAUP,0.5D0) - ENDIF - IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) THEN - CALL PYKLIM(2) - MEYST=MINT(51) - ENDIF - IF(MEYST.EQ.1) GOTO 150 - IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN - MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3)) - IF(MYST.EQ.4.AND.MINT(45).NE.3) MYST=5 - CALL PYKMAP(2,MYST,0.5D0) - CALL PYKLIM(3) - MECTH=MINT(51) - ENDIF - IF(MECTH.EQ.1) GOTO 150 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - MCTH=1+MOD(ITRY-1,NPTS(4)) - CALL PYKMAP(3,MCTH,0.5D0) - ENDIF - IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1D0-VINT(23)**2) - -C...Store position and limits. - MINT(51)=0 - CALL PYKLIM(0) - IF(MINT(51).EQ.1) GOTO 150 - NACC=NACC+1 - MVARPT(NACC,1)=MTAU - MVARPT(NACC,2)=MTAUP - MVARPT(NACC,3)=MYST - MVARPT(NACC,4)=MCTH - DO 130 J=1,30 - VINTPT(NACC,J)=VINT(10+J) - 130 CONTINUE - -C...Normal case: calculate cross-section. - IF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - -C..2 -> 3: find highest value out of a number of tries. - ELSE - SIGS=0D0 - DO 140 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 140 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 140 CONTINUE - ENDIF - -C...Store cross-section. - SIGSPT(NACC)=SIGS - IF(SIGS.GT.SIGSAM) SIGSAM=SIGS - IF(MSTP(122).GE.2) WRITE(MSTU(11),5200) MTAU,MYST,MCTH,MTAUP, - & VINT(21),VINT(22),VINT(23),VINT(26),SIGS - 150 CONTINUE - IF(NACC.EQ.0) THEN - WRITE(MSTU(11),5100) ISUB - MSUB(ISUB)=0 - GOTO 460 - ELSEIF(SIGSAM.EQ.0D0) THEN - WRITE(MSTU(11),5300) ISUB - MSUB(ISUB)=0 - GOTO 460 - ENDIF - IF(ISUB.NE.96) NPOSI=NPOSI+1 - -C...Calculate integrals in tau over maximal phase space limits. - TAUMIN=VINT(11) - TAUMAX=VINT(31) - ATAU1=LOG(TAUMAX/TAUMIN) - IF(NPTS(1).GE.2) THEN - ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) - ENDIF - IF(NPTS(1).GE.4) THEN - ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 - ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ - & GAMR1 - ENDIF - IF(NPTS(1).GE.6) THEN - ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 - ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ - & GAMR2 - ENDIF - IF(NPTS(1).GT.2+2*MINT(72)) THEN - ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) - ENDIF - -C...Reset. Sum up cross-sections in points calculated. - DO 320 IVAR=1,4 - IF(NPTS(IVAR).EQ.1) GOTO 320 - IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 320 - NBIN=NPTS(IVAR) - DO 170 J1=1,NBIN - NAREL(J1)=0 - WTREL(J1)=0D0 - COEFU(J1)=0D0 - DO 160 J2=1,NBIN - WTMAT(J1,J2)=0D0 - 160 CONTINUE - 170 CONTINUE - DO 180 IACC=1,NACC - IBIN=MVARPT(IACC,IVAR) - IF(IVAR.EQ.1.AND.IBIN.EQ.7) IBIN=3+2*MINT(72) - IF(IVAR.EQ.3.AND.IBIN.EQ.5.AND.MINT(45).NE.3) IBIN=4 - NAREL(IBIN)=NAREL(IBIN)+1 - WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC) - -C...Sum up tau cross-section pieces in points used. - IF(IVAR.EQ.1) THEN - TAU=VINTPT(IACC,11) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU - IF(NBIN.GE.4) THEN - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/ - & ((TAU-TAUR1)**2+GAMR1**2) - ENDIF - IF(NBIN.GE.6) THEN - WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2) - WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/ - & ((TAU-TAUR2)**2+GAMR2**2) - ENDIF - IF(NBIN.GT.2+2*MINT(72)) THEN - WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(ATAU1/ATAU7)* - & TAU/MAX(2D-10,1D0-TAU) - ENDIF - -C...Sum up tau' cross-section pieces in points used. - ELSEIF(IVAR.EQ.2) THEN - TAU=VINTPT(IACC,11) - TAUP=VINTPT(IACC,16) - TAUPMN=VINTPT(IACC,6) - TAUPMX=VINTPT(IACC,26) - ATAUP1=LOG(TAUPMX/TAUPMN) - ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)* - & (1D0-TAU/TAUP)**3/TAUP - IF(NBIN.GE.3) THEN - ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAUP1/ATAUP3)* - & TAUP/MAX(2D-10,1D0-TAUP) - ENDIF - -C...Sum up y* cross-section pieces in points used. - ELSEIF(IVAR.EQ.3) THEN - YST=VINTPT(IACC,12) - YSTMIN=VINTPT(IACC,2) - YSTMAX=VINTPT(IACC,22) - AYST0=YSTMAX-YSTMIN - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST2=AYST1 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN) - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST2)*(YSTMAX-YST) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST) - IF(MINT(45).EQ.3) THEN - TAUE=VINTPT(IACC,11) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) - YST0=-0.5D0*LOG(TAUE) - AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ - & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(AYST0/AYST4)/ - & MAX(1D-10,1D0-EXP(YST-YST0)) - ENDIF - IF(MINT(46).EQ.3) THEN - TAUE=VINTPT(IACC,11) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=VINTPT(IACC,16) - YST0=-0.5D0*LOG(TAUE) - AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ - & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - WTMAT(IBIN,NBIN)=WTMAT(IBIN,NBIN)+(AYST0/AYST5)/ - & MAX(1D-10,1D0-EXP(-YST-YST0)) - ENDIF - -C...Sum up cos(theta-hat) cross-section pieces in points used. - ELSE - RM34=MAX(1D-20,2D0*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2) - RSQM=1D0+RM34 - CTHMAX=SQRT(1D0-4D0*VINT(71)**2/(TAUMAX*VINT(2))) - CTHMIN=-CTHMAX - IF(CTHMAX.GT.0.9999D0) RM34=MAX(RM34,2D0*VINT(71)**2/ - & (TAUMAX*VINT(2))) - ACTH1=CTHMAX-CTHMIN - ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX)) - ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN)) - ACTH4=1D0/MAX(RM34,RSQM-CTHMAX)-1D0/MAX(RM34,RSQM-CTHMIN) - ACTH5=1D0/MAX(RM34,RSQM+CTHMIN)-1D0/MAX(RM34,RSQM+CTHMAX) - CTH=VINTPT(IACC,13) - WTMAT(IBIN,1)=WTMAT(IBIN,1)+1D0 - WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/ - & MAX(RM34,RSQM-CTH) - WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/ - & MAX(RM34,RSQM+CTH) - WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/ - & MAX(RM34,RSQM-CTH)**2 - WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/ - & MAX(RM34,RSQM+CTH)**2 - ENDIF - 180 CONTINUE - -C...Check that equation system solvable. - IF(MSTP(122).GE.2) WRITE(MSTU(11),5400) CVAR(IVAR) - MSOLV=1 - WTRELS=0D0 - DO 190 IBIN=1,NBIN - IF(MSTP(122).GE.2) WRITE(MSTU(11),5500) (WTMAT(IBIN,IRED), - & IRED=1,NBIN),WTREL(IBIN) - IF(NAREL(IBIN).EQ.0) MSOLV=0 - WTRELS=WTRELS+WTREL(IBIN) - 190 CONTINUE - IF(ABS(WTRELS).LT.1D-20) MSOLV=0 - -C...Solve to find relative importance of cross-section pieces. - IF(MSOLV.EQ.1) THEN - DO 200 IBIN=1,NBIN - WTRELN(IBIN)=MAX(0.1D0,WTREL(IBIN)/WTRELS) - 200 CONTINUE - DO 230 IRED=1,NBIN-1 - DO 220 IBIN=IRED+1,NBIN - IF(ABS(WTMAT(IRED,IRED)).LT.1D-20) THEN - MSOLV=0 - GOTO 260 - ENDIF - RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) - WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED) - DO 210 ICOE=IRED,NBIN - WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE) - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - DO 250 IRED=NBIN,1,-1 - DO 240 ICOE=IRED+1,NBIN - WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE) - 240 CONTINUE - COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) - 250 CONTINUE - ENDIF - -C...Share evenly if failure. - 260 IF(MSOLV.EQ.0) THEN - DO 270 IBIN=1,NBIN - COEFU(IBIN)=1D0 - WTRELN(IBIN)=0.1D0 - IF(WTRELS.GT.0D0) WTRELN(IBIN)=MAX(0.1D0, - & WTREL(IBIN)/WTRELS) - 270 CONTINUE - ENDIF - -C...Normalize coefficients, with piece shared democratically. - COEFSU=0D0 - WTRELS=0D0 - DO 280 IBIN=1,NBIN - COEFU(IBIN)=MAX(0D0,COEFU(IBIN)) - COEFSU=COEFSU+COEFU(IBIN) - WTRELS=WTRELS+WTRELN(IBIN) - 280 CONTINUE - IF(COEFSU.GT.0D0) THEN - DO 290 IBIN=1,NBIN - COEFO(IBIN)=PARP(122)/NBIN+(1D0-PARP(122))*0.5D0* - & (COEFU(IBIN)/COEFSU+WTRELN(IBIN)/WTRELS) - 290 CONTINUE - ELSE - DO 300 IBIN=1,NBIN - COEFO(IBIN)=1D0/NBIN - 300 CONTINUE - ENDIF - IF(IVAR.EQ.1) IOFF=0 - IF(IVAR.EQ.2) IOFF=17 - IF(IVAR.EQ.3) IOFF=7 - IF(IVAR.EQ.4) IOFF=12 - DO 310 IBIN=1,NBIN - ICOF=IOFF+IBIN - IF(IVAR.EQ.1.AND.IBIN.GT.2+2*MINT(72)) ICOF=7 - IF(IVAR.EQ.3.AND.IBIN.EQ.4.AND.MINT(45).NE.3) ICOF=ICOF+1 - COEF(ISUB,ICOF)=COEFO(IBIN) - 310 CONTINUE - IF(MSTP(122).GE.2) WRITE(MSTU(11),5600) CVAR(IVAR), - & (COEFO(IBIN),IBIN=1,NBIN) - 320 CONTINUE - -C...Find two most promising maxima among points previously determined. - DO 330 J=1,4 - IACCMX(J)=0 - SIGSMX(J)=0D0 - 330 CONTINUE - NMAX=0 - DO 390 IACC=1,NACC - DO 340 J=1,30 - VINT(10+J)=VINTPT(IACC,J) - 340 CONTINUE - IF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - ELSE - SIGS=0D0 - DO 350 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 350 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 350 CONTINUE - ENDIF - IEQ=0 - DO 360 IMV=1,NMAX - IF(ABS(SIGS-SIGSMX(IMV)).LT.1D-4*(SIGS+SIGSMX(IMV))) IEQ=IMV - 360 CONTINUE - IF(IEQ.EQ.0) THEN - DO 370 IMV=NMAX,1,-1 - IIN=IMV+1 - IF(SIGS.LE.SIGSMX(IMV)) GOTO 380 - IACCMX(IMV+1)=IACCMX(IMV) - SIGSMX(IMV+1)=SIGSMX(IMV) - 370 CONTINUE - IIN=1 - 380 IACCMX(IIN)=IACC - SIGSMX(IIN)=SIGS - IF(NMAX.LE.1) NMAX=NMAX+1 - ENDIF - 390 CONTINUE - -C...Read out starting position for search. - IF(MSTP(122).GE.2) WRITE(MSTU(11),5700) - SIGSAM=SIGSMX(1) - DO 440 IMAX=1,NMAX - IACC=IACCMX(IMAX) - MTAU=MVARPT(IACC,1) - MTAUP=MVARPT(IACC,2) - MYST=MVARPT(IACC,3) - MCTH=MVARPT(IACC,4) - VTAU=0.5D0 - VYST=0.5D0 - VCTH=0.5D0 - VTAUP=0.5D0 - -C...Starting point and step size in parameter space. - DO 430 IRPT=1,2 - DO 420 IVAR=1,4 - IF(NPTS(IVAR).EQ.1) GOTO 420 - IF(IVAR.EQ.1) VVAR=VTAU - IF(IVAR.EQ.2) VVAR=VTAUP - IF(IVAR.EQ.3) VVAR=VYST - IF(IVAR.EQ.4) VVAR=VCTH - IF(IVAR.EQ.1) MVAR=MTAU - IF(IVAR.EQ.2) MVAR=MTAUP - IF(IVAR.EQ.3) MVAR=MYST - IF(IVAR.EQ.4) MVAR=MCTH - IF(IRPT.EQ.1) VDEL=0.1D0 - IF(IRPT.EQ.2) VDEL=MAX(0.01D0,MIN(0.05D0,VVAR-0.02D0, - & 0.98D0-VVAR)) - IF(IRPT.EQ.1) VMAR=0.02D0 - IF(IRPT.EQ.2) VMAR=0.002D0 - IMOV0=1 - IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0 - DO 410 IMOV=IMOV0,8 - -C...Define new point in parameter space. - IF(IMOV.EQ.0) THEN - INEW=2 - VNEW=VVAR - ELSEIF(IMOV.EQ.1) THEN - INEW=3 - VNEW=VVAR+VDEL - ELSEIF(IMOV.EQ.2) THEN - INEW=1 - VNEW=VVAR-VDEL - ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND. - & VVAR+2D0*VDEL.LT.1D0-VMAR) THEN - VVAR=VVAR+VDEL - SIGSSM(1)=SIGSSM(2) - SIGSSM(2)=SIGSSM(3) - INEW=3 - VNEW=VVAR+VDEL - ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND. - & VVAR-2D0*VDEL.GT.VMAR) THEN - VVAR=VVAR-VDEL - SIGSSM(3)=SIGSSM(2) - SIGSSM(2)=SIGSSM(1) - INEW=1 - VNEW=VVAR-VDEL - ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN - VDEL=0.5D0*VDEL - VVAR=VVAR+VDEL - SIGSSM(1)=SIGSSM(2) - INEW=2 - VNEW=VVAR - ELSE - VDEL=0.5D0*VDEL - VVAR=VVAR-VDEL - SIGSSM(3)=SIGSSM(2) - INEW=2 - VNEW=VVAR - ENDIF - -C...Convert to relevant variables and find derived new limits. - ILERR=0 - IF(IVAR.EQ.1) THEN - VTAU=VNEW - CALL PYKMAP(1,MTAU,VTAU) - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - CALL PYKLIM(4) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - ENDIF - IF(IVAR.LE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5.AND. - & ILERR.EQ.0) THEN - IF(IVAR.EQ.2) VTAUP=VNEW - CALL PYKMAP(4,MTAUP,VTAUP) - ENDIF - IF(IVAR.LE.2.AND.ILERR.EQ.0) THEN - CALL PYKLIM(2) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - IF(IVAR.LE.3.AND.ILERR.EQ.0) THEN - IF(IVAR.EQ.3) VYST=VNEW - CALL PYKMAP(2,MYST,VYST) - CALL PYKLIM(3) - IF(MINT(51).EQ.1) ILERR=1 - ENDIF - IF((ISTSB.EQ.2.OR.ISTSB.EQ.4.OR.ISTSB.EQ.6).AND. - & ILERR.EQ.0) THEN - IF(IVAR.EQ.4) VCTH=VNEW - CALL PYKMAP(3,MCTH,VCTH) - ENDIF - IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) - -C...Evaluate cross-section. Save new maximum. Final maximum. - IF(ILERR.NE.0) THEN - SIGS=0. - ELSEIF(ISTSB.NE.5) THEN - CALL PYSIGH(NCHN,SIGS) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGS=WTXS*SIGS - ENDIF - ELSE - SIGS=0D0 - DO 400 IKIN3=1,MSTP(129) - CALL PYKMAP(5,0,0D0) - IF(MINT(51).EQ.1) GOTO 400 - CALL PYSIGH(NCHN,SIGTMP) - IF(MWTXS.EQ.1) THEN - CALL PYEVWT(WTXS) - SIGTMP=WTXS*SIGTMP - ENDIF - IF(SIGTMP.GT.SIGS) SIGS=SIGTMP - 400 CONTINUE - ENDIF - SIGSSM(INEW)=SIGS - IF(SIGS.GT.SIGSAM) SIGSAM=SIGS - IF(MSTP(122).GE.2) WRITE(MSTU(11),5800) IMAX,IVAR,MVAR, - & IMOV,VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS - 410 CONTINUE - 420 CONTINUE - 430 CONTINUE - 440 CONTINUE - IF(MSTP(121).EQ.1) SIGSAM=PARP(121)*SIGSAM - XSEC(ISUB,1)=1.05D0*SIGSAM - IF(MINT(141).NE.0.OR.MINT(142).NE.0) XSEC(ISUB,1)= - & WTGAGA*XSEC(ISUB,1) - 450 CONTINUE - IF(MSTP(173).EQ.1.AND.ISUB.NE.96) XSEC(ISUB,1)= - & PARP(174)*XSEC(ISUB,1) - IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1) - 460 CONTINUE - MINT(51)=0 - -C...Print summary table. - IF(MINT(121).EQ.1.AND.NPOSI.EQ.0) THEN - IF(MSTP(127).NE.1) THEN - WRITE(MSTU(11),5900) - STOP - ELSE - WRITE(MSTU(11),6400) - MSTI(53)=1 - ENDIF - ENDIF - IF(MSTP(122).GE.1) THEN - WRITE(MSTU(11),6000) - WRITE(MSTU(11),6100) - DO 470 ISUB=1,500 - IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 470 - IF(ISUB.EQ.96.AND.MINT(50).EQ.0) GOTO 470 - IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 470 - IF(ISUB.EQ.96.AND.MINT(49).EQ.0.AND.MSTP(131).EQ.0) GOTO 470 - IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13 - & .OR.ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 470 - IF(MSUB(95).EQ.1.AND.ISUB.GE.381.AND.ISUB.LE.386) GOTO 470 - WRITE(MSTU(11),6200) ISUB,PROC(ISUB),XSEC(ISUB,1) - 470 CONTINUE - WRITE(MSTU(11),6300) - ENDIF - -C...Format statements for maximization results. - 5000 FORMAT(/1X,'Coefficient optimization and maximum search for ', - &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X, - &'cth',9X,'tau''',7X,'sigma') - 5100 FORMAT(1X,'Warning: requested subprocess ',I3,' has no allowed ', - &'phase space.'/1X,'Process switched off!') - 5200 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,D12.4) - 5300 FORMAT(1X,'Warning: requested subprocess ',I3,' has vanishing ', - &'cross-section.'/1X,'Process switched off!') - 5400 FORMAT(1X,'Coefficients of equation system to be solved for ',A4) - 5500 FORMAT(1X,1P,8D11.3) - 5600 FORMAT(1X,'Result for ',A4,':',7F9.4) - 5700 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ', - &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma') - 5800 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,D12.4) - 5900 FORMAT(1X,'Error: no requested process has non-vanishing ', - &'cross-section.'/1X,'Execution stopped!') - 6000 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ', - &'cross-section maximum search',1X,8('*')) - 6100 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ', - &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I', - &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I') - 6200 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,D12.4,3X,'I') - 6300 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('=')) - 6400 FORMAT(1X,'Error: no requested process has non-vanishing ', - &'cross-section.'/ - &1X,'Execution will stop if you try to generate events.') - - RETURN - END - -C********************************************************************* - -C...PYMEMX -C...Generates maximum ME weight in some initial-state showers. -C...Inparameter MECOR: kind of hard scattering process -C...Outparameter WTFF: maximum weight for fermion -> fermion -C... WTGF: maximum weight for gluon/photon -> fermion -C... WTFG: maximum weight for fermion -> gluon/photon -C... WTGG: maximum weight for gluon -> gluon - - SUBROUTINE PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Default maximum weight. - WTFF=1D0 - WTGF=1D0 - WTFG=1D0 - WTGG=1D0 - -C...Select maximum weight by process. - IF(MECOR.EQ.1) THEN - WTFF=1D0 - WTGF=3D0 - ELSEIF(MECOR.EQ.2) THEN - WTFG=1D0 - WTGG=1D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMEWT -C...Calculates actual ME weight in some initial-state showers. -C...Inparameter MECOR: kind of hard scattering process -C... IFLCB: flavour combination of branching, -C... 1 for fermion -> fermion, -C... 2 for gluon/photon -> fermion -C... 3 for fermion -> gluon/photon, -C... 4 for gluon -> gluon -C... Q2: Q2 value of shower branching -C... Z: Z value of branching -C...In+outparameter PHIBR: azimuthal angle of branching -C...Outparameter WTME: actual ME weight - - SUBROUTINE PYMEWT(MECOR,IFLCB,Q2,Z,PHIBR,WTME) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYJETS/,/PYDAT1/,/PYPARS/,/PYINT1/,/PYINT2/ - -C...Default output. - WTME=1D0 - -C...Define kinematics of shower branching in Mandelstam variables. - SQM=VINT(44) - SH=SQM/Z - TH=-Q2 - UH=Q2-SQM*(1D0-Z)/Z - -C...Matrix-element corrections for f + fbar -> s-channel vector boson. - IF(MECOR.EQ.1) THEN - IF(IFLCB.EQ.1) THEN - WTME=(TH**2+UH**2+2D0*SQM*SH)/(SH**2+SQM**2) - ELSEIF(IFLCB.EQ.2) THEN - WTME=(SH**2+UH**2+2D0*SQM*TH)/((SH-SQM)**2+SQM**2) - ENDIF - -C...Matrix-element corrections for g + g -> Higgs (h0, H0, A0). - ELSEIF(MECOR.EQ.2) THEN - IF(IFLCB.EQ.3) THEN - WTME=(SH**2+UH**2)/(SH**2+(SH-SQM)**2) - ELSEIF(IFLCB.EQ.4) THEN - WTME=0.5D0*(SH**4+UH**4+TH**4+SQM**4)/(SH**2-SQM*(SH-SQM))**2 - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMRUN -C...Gives the running, current-algebra mass of a d, u, s, c or b quark, -C...for Higgs couplings. Everything else sent on to PYMASS. - - FUNCTION PYMRUN(KF,Q2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/ - -C...Most masses not handled here. - KFA=IABS(KF) - IF(KFA.EQ.0.OR.KFA.GT.6) THEN - PYMRUN=PYMASS(KF) - -C...Current-algebra masses, but no Q2 dependence. - ELSEIF(MSTP(37).NE.1.OR.MSTP(2).LE.0) THEN - PYMRUN=PARF(90+KFA) - -C...Running current-algebra masses. - ELSE - AS=PYALPS(Q2) - PYMRUN=PARF(90+KFA)* - & (LOG(MAX(4D0,PARP(37)**2*PARF(90+KFA)**2/PARU(117)**2))/ - & LOG(MAX(4D0,Q2/PARU(117)**2)))**(12D0/(33D0-2D0*MSTU(118))) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYMSIN -C...Initializes supersymmetry: finds sparticle masses and -C...branching ratios and stores this information. -C...AUTHOR: STEPHEN MRENNA -C...Baryon- and lepton-number violating parameters by P. Z. Skands. - - SUBROUTINE PYMSIN - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYHTRI/HHH(7) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT4/,/PYMSSM/, - &/PYMSRV/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION ALFA,BETA - DOUBLE PRECISION TANB,AL,BE,COSA,COSB,SINA,SINB,XW - INTEGER I,J,J1,I1,K1 - INTEGER KC,LKNT,IDLAM(400,3) - DOUBLE PRECISION XLAM(0:400) - DOUBLE PRECISION WDTP(0:400),WDTE(0:400,0:5) - DOUBLE PRECISION XARG,COS2B,XMW2,XMZ2 - DOUBLE PRECISION DELM,XMDIF - DOUBLE PRECISION DX,DY,DS,DMU2,DMA2,DQ2,DU2,DD2,DL2,DE2,DHU2,DHD2 - DOUBLE PRECISION ARG,SGNMU,R - INTEGER IMSSM - INTEGER IRPRTY - INTEGER KFSUSY(36),MWIDSU(36),MDCYSU(36) - SAVE MWIDSU,MDCYSU - DATA KFSUSY/ - &1000001,2000001,1000002,2000002,1000003,2000003, - &1000004,2000004,1000005,2000005,1000006,2000006, - &1000011,2000011,1000012,2000012,1000013,2000013, - &1000014,2000014,1000015,2000015,1000016,2000016, - &1000021,1000022,1000023,1000025,1000035,1000024, - &1000037,1000039, 25, 35, 36, 37/ - DATA INIT/0/ - -C...Do nothing if SUSY not requested. - IMSSM=IMSS(1) - IF(IMSSM.EQ.0) RETURN - -C...Save copy of MWID(KC) and MDCY(KC,1) values before -C...they are set to zero for the LSP. - IF(INIT.EQ.0) THEN - INIT=1 - DO 100 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - MWIDSU(I)=MWID(KC) - MDCYSU(I)=MDCY(KC,1) - 100 CONTINUE - ENDIF - -C...Restore MWID(KC) and MDCY(KC,1) values previously zeroed for LSP. - DO 110 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - IF(MDCY(KC,1).EQ.0.AND.MDCYSU(I).NE.0) THEN - MWID(KC)=MWIDSU(I) - MDCY(KC,1)=MDCYSU(I) - ENDIF - 110 CONTINUE - -C...First part of routine: set masses and couplings. - -C...Reset mixing values in sfermion sector to pure left/right. - DO 120 I=1,16 - SFMIX(I,1)=1D0 - SFMIX(I,4)=1D0 - SFMIX(I,2)=0D0 - SFMIX(I,3)=0D0 - 120 CONTINUE - -C...Common couplings. - TANB=RMSS(5) - BETA=ATAN(TANB) - COSB=COS(BETA) - SINB=TANB*COSB - COS2B=COS(2D0*BETA) - ALFA=RMSS(18) - XMW2=PMAS(24,1)**2 - XMZ2=PMAS(23,1)**2 - XW=PARU(102) - -C...Define sparticle masses for a general MSSM simulation. - IF(IMSSM.EQ.1) THEN - IF(IMSS(9).EQ.0) RMSS(22)=RMSS(9) - DO 130 I=1,5,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(RMSS(8)**2-(2D0*XMW2+XMZ2)*COS2B/6D0) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(RMSS(9)**2+(XMW2-XMZ2)*COS2B/3D0) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(RMSS(8)**2+(4D0*XMW2-XMZ2)*COS2B/6D0) - KC=PYCOMP(KSUSY2+I+1) - PMAS(KC,1)=SQRT(RMSS(22)**2-(XMW2-XMZ2)*COS2B*2D0/3D0) - 130 CONTINUE - XARG=RMSS(6)**2-PMAS(24,1)**2*ABS(COS(2D0*BETA)) - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - XARG=SQRT(XARG) - ENDIF - DO 140 I=11,15,2 - PMAS(PYCOMP(KSUSY1+I),1)=RMSS(6) - PMAS(PYCOMP(KSUSY2+I),1)=RMSS(7) - PMAS(PYCOMP(KSUSY1+I+1),1)=XARG - PMAS(PYCOMP(KSUSY2+I+1),1)=9999D0 - 140 CONTINUE - IF(IMSS(8).EQ.1) THEN - RMSS(13)=RMSS(6) - RMSS(14)=RMSS(7) - ENDIF - -C...Alternatively derive masses from SUGRA relations. - ELSEIF(IMSSM.EQ.2) THEN - CALL PYAPPS -C...Or use ISASUSY - ELSEIF(IMSSM.EQ.12) THEN - CALL PYSUGI - ALFA=RMSS(18) - GOTO 170 - ENDIF - -C...Add in extra D-term contributions. - IF(IMSS(7).EQ.1) THEN - R=0.43D0 - DX=RMSS(23) - DY=RMSS(24) - DS=RMSS(25) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) 'C NEW DTERMS ADDED TO SCALAR MASSES ' - WRITE(MSTU(11),*) 'C IN A U(B-L) THEORY ' - WRITE(MSTU(11),*) 'C DX = ',DX - WRITE(MSTU(11),*) 'C DY = ',DY - WRITE(MSTU(11),*) 'C DS = ',DS - WRITE(MSTU(11),*) 'C ' - DY=R*DY-4D0/33D0*(1D0-R)*DX+(1D0-R)/33D0*DS - WRITE(MSTU(11),*) 'C DY AT THE WEAK SCALE = ',DY - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - DQ2=DY/6D0-DX/3D0-DS/3D0 - DU2=-2D0*DY/3D0-DX/3D0-DS/3D0 - DD2=DY/3D0+DX-2D0*DS/3D0 - DL2=-DY/2D0+DX-2D0*DS/3D0 - DE2=DY-DX/3D0-DS/3D0 - DHU2=DY/2D0+2D0*DX/3D0+2D0*DS/3D0 - DHD2=-DY/2D0-2D0*DX/3D0+DS - DMU2=(-DY/2D0-2D0/3D0*DX+(COSB**2-2D0*SINB**2/3D0)*DS) - & /ABS(COS2B) - DMA2 = 2D0*DMU2+DHU2+DHD2 - DO 150 I=1,5,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DD2) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DQ2) - KC=PYCOMP(KSUSY2+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DU2) - 150 CONTINUE - DO 160 I=11,15,2 - KC=PYCOMP(KSUSY1+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) - KC=PYCOMP(KSUSY2+I) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DE2) - KC=PYCOMP(KSUSY1+I+1) - PMAS(KC,1)=SQRT(PMAS(KC,1)**2+DL2) - 160 CONTINUE - IF(RMSS(4)**2+DMU2.LT.0D0) THEN - WRITE(MSTU(11),*) ' MU2 DRIVEN NEGATIVE ' - STOP - ENDIF - SGNMU=SIGN(1D0,RMSS(4)) - RMSS(4)=SGNMU*SQRT(RMSS(4)**2+DMU2) - ARG=RMSS(10)**2*SIGN(1D0,RMSS(10))+DQ2 - RMSS(10)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(11)**2*SIGN(1D0,RMSS(11))+DD2 - RMSS(11)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(12)**2*SIGN(1D0,RMSS(12))+DU2 - RMSS(12)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(13)**2*SIGN(1D0,RMSS(13))+DL2 - RMSS(13)=SIGN(SQRT(ABS(ARG)),ARG) - ARG=RMSS(14)**2*SIGN(1D0,RMSS(14))+DE2 - RMSS(14)=SIGN(SQRT(ABS(ARG)),ARG) - IF( RMSS(19)**2 + DMA2 .LE. 50D0 ) THEN - WRITE(MSTU(11),*) ' MA DRIVEN TOO LOW ' - STOP - ENDIF - RMSS(19)=SQRT(RMSS(19)**2+DMA2) - RMSS(6)=SQRT(RMSS(6)**2+DL2) - RMSS(7)=SQRT(RMSS(7)**2+DE2) - WRITE(MSTU(11),*) ' MTL = ',RMSS(10) - WRITE(MSTU(11),*) ' MBR = ',RMSS(11) - WRITE(MSTU(11),*) ' MTR = ',RMSS(12) - WRITE(MSTU(11),*) ' SEL = ',RMSS(6),RMSS(13) - WRITE(MSTU(11),*) ' SER = ',RMSS(7),RMSS(14) - ENDIF - -C...Fix the third generation sfermions. - CALL PYTHRG - -C...Fix the neutralino--chargino--gluino sector. - CALL PYINOM - -C...Fix the Higgs sector. - CALL PYHGGM(ALFA) - -C...Choose the Gunion-Haber convention. - ALFA=-ALFA - RMSS(18)=ALFA - -C...Print information on mass parameters. - IF(IMSSM.EQ.2.AND.MSTP(122).GT.0) THEN - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) ' USING APPROXIMATE SUGRA RELATIONS ' - WRITE(MSTU(11),*) ' M0 = ',RMSS(8) - WRITE(MSTU(11),*) ' M1/2=',RMSS(1) - WRITE(MSTU(11),*) ' TANB=',RMSS(5) - WRITE(MSTU(11),*) ' MU = ',RMSS(4) - WRITE(MSTU(11),*) ' AT = ',RMSS(16) - WRITE(MSTU(11),*) ' MA = ',RMSS(19) - WRITE(MSTU(11),*) ' MTOP=',PMAS(6,1) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - ENDIF - IF(IMSS(20).EQ.1) THEN - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - WRITE(MSTU(11),*) ' DEBUG MODE ' - WRITE(MSTU(11),*) ' UMIX = ',UMIX(1,1),UMIX(1,2), - & UMIX(2,1),UMIX(2,2) - WRITE(MSTU(11),*) ' UMIXI = ',UMIXI(1,1),UMIXI(1,2), - & UMIXI(2,1),UMIXI(2,2) - WRITE(MSTU(11),*) ' VMIX = ',VMIX(1,1),VMIX(1,2), - & VMIX(2,1),VMIX(2,2) - WRITE(MSTU(11),*) ' VMIXI = ',VMIXI(1,1),VMIXI(1,2), - & VMIXI(2,1),VMIXI(2,2) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(1,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(1,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(2,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(2,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(3,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(3,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIX = ',(ZMIX(4,I),I=1,4) - WRITE(MSTU(11),*) ' ZMIXI = ',(ZMIXI(4,I),I=1,4) - WRITE(MSTU(11),*) ' ALFA = ',ALFA - WRITE(MSTU(11),*) ' BETA = ',BETA - WRITE(MSTU(11),*) ' STOP = ',(SFMIX(6,I),I=1,4) - WRITE(MSTU(11),*) ' SBOT = ',(SFMIX(5,I),I=1,4) - WRITE(MSTU(11),*) 'CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC' - ENDIF - -C...Set up the Higgs couplings - needed here since initialization -C...in PYINRE did not yet occur when PYWIDT is called below. - 170 AL=ALFA - BE=BETA - SINA=SIN(AL) - COSA=COS(AL) - COSB=COS(BE) - SINB=TANB*COSB - SBMA=SIN(BE-AL) - SAPB=SIN(AL+BE) - CAPB=COS(AL+BE) - CBMA=COS(BE-AL) - C2A=COS(2D0*AL) - C2B=COSB**2-SINB**2 -C...tanb (used for H+) - PARU(141)=TANB - -C...Firstly: h -C...Coupling to d-type quarks - PARU(161)=SINA/COSB -C...Coupling to u-type quarks - PARU(162)=-COSA/SINB -C...Coupling to leptons - PARU(163)=PARU(161) -C...Coupling to Z - PARU(164)=SBMA -C...Coupling to W - PARU(165)=PARU(164) - -C...Secondly: H -C...Coupling to d-type quarks - PARU(171)=-COSA/COSB -C...Coupling to u-type quarks - PARU(172)=-SINA/SINB -C...Coupling to leptons - PARU(173)=PARU(171) -C...Coupling to Z - PARU(174)=CBMA -C...Coupling to W - PARU(175)=PARU(174) -C...Coupling to h - IF(IMSS(4).EQ.2) THEN - PARU(176)=COS(2D0*AL)*COS(BE+AL)-2D0*SIN(2D0*AL)*SIN(BE+AL) - ELSE - HHH(3)=HHH(3)+HHH(4)+HHH(5) - PARU(176)=-3D0/HHH(1)*(HHH(1)*SINA**2*COSB*COSA+ - 1 HHH(2)*COSA**2*SINB*SINA+HHH(3)*(SINA**3*SINB+COSA**3*COSB- - 2 2D0/3D0*CBMA)-HHH(6)*SINA*(COSB*C2A+COSA*CAPB)+ - 3 HHH(7)*COSA*(SINB*C2A+SINA*CAPB)) - ENDIF -C...Coupling to H+ -C...Define later - IF(IMSS(4).EQ.2) THEN - PARU(168)=-SBMA-COS(2D0*BE)*SAPB/2D0/(1D0-XW) - ELSE - PARU(168)=1D0/HHH(1)*(HHH(1)*SINB**2*COSB*SINA- - 1 HHH(2)*COSB**2*SINB*COSA-HHH(3)*(SINB**3*COSA-COSB**3*SINA)+ - 2 2D0*HHH(5)*SBMA-HHH(6)*SINB*(COSB*SAPB+SINA*C2B)- - 3 HHH(7)*COSB*(COSA*C2B-SINB*SAPB)-(HHH(5)-HHH(4))*SBMA) - ENDIF -C...Coupling to A - IF(IMSS(4).EQ.2) THEN - PARU(177)=COS(2D0*BE)*COS(BE+AL) - ELSE - PARU(177)=-1D0/HHH(1)*(HHH(1)*SINB**2*COSB*COSA+ - 1 HHH(2)*COSB**2*SINB*SINA+HHH(3)*(SINB**3*SINA+COSB**3*COSA)- - 2 2D0*HHH(5)*CBMA-HHH(6)*SINB*(COSB*CAPB+COSA*C2B)+ - 3 HHH(7)*COSB*(SINB*CAPB+SINA*C2B)) - ENDIF -C...Coupling to H+ - IF(IMSS(4).EQ.2) THEN - PARU(178)=PARU(177) - ELSE - PARU(178)=PARU(177)-(HHH(5)-HHH(4))/HHH(1)*CBMA - ENDIF -C...Thirdly, A -C...Coupling to d-type quarks - PARU(181)=TANB -C...Coupling to u-type quarks - PARU(182)=1D0/PARU(181) -C...Coupling to leptons - PARU(183)=PARU(181) - PARU(184)=0D0 - PARU(185)=0D0 -C...Coupling to Z h - PARU(186)=COS(BE-AL) -C...Coupling to Z H - PARU(187)=SIN(BE-AL) - PARU(188)=0D0 - PARU(189)=0D0 - PARU(190)=0D0 - -C...Finally: H+ -C...Coupling to W h - PARU(195)=COS(BE-AL) - -C...Tell that all Higgs couplings have been set. - MSTP(4)=1 - -C...Set R-Violating couplings. -C...Set lambda couplings to common value or "natural values". - IF ((IMSS(51).NE.3).AND.(IMSS(51).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 200 IRK=1,3 - DO 190 IRI=1,3 - DO 180 IRJ=1,3 - IF (IRI.NE.IRJ) THEN - IF (IRI.LT.IRJ) THEN - RVLAM(IRI,IRJ,IRK)=RMSS(51) - IF (IMSS(51).EQ.2) RVLAM(IRI,IRJ,IRK)=RMSS(51)* - & SQRT(PMAS(9+2*IRI,1)*PMAS(9+2*IRJ,1)* - & PMAS(9+2*IRK,1)*VIR3) - ELSE - RVLAM(IRI,IRJ,IRK)=-RVLAM(IRJ,IRI,IRK) - ENDIF - ELSE - RVLAM(IRI,IRJ,IRK)=0D0 - ENDIF - 180 CONTINUE - 190 CONTINUE - 200 CONTINUE - ENDIF -C...Set lambda' couplings to common value or "natural values". - IF ((IMSS(52).NE.3).AND.(IMSS(52).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 230 IRI=1,3 - DO 220 IRJ=1,3 - DO 210 IRK=1,3 - RVLAMP(IRI,IRJ,IRK)=RMSS(52) - IF (IMSS(52).EQ.2) RVLAMP(IRI,IRJ,IRK)=RMSS(52)* - & SQRT(PMAS(9+2*IRI,1)*0.5D0*(PMAS(2*IRJ,1)+ - & PMAS(2*IRJ-1,1))*PMAS(2*IRK-1,1)*VIR3) - 210 CONTINUE - 220 CONTINUE - 230 CONTINUE - ENDIF -C...Set lambda'' couplings to common value or "natural values". - IF ((IMSS(53).NE.3).AND.(IMSS(53).NE.0)) THEN - VIR3=1D0/(126D0)**3 - DO 260 IRI=1,3 - DO 250 IRJ=1,3 - DO 240 IRK=1,3 - IF (IRJ.NE.IRK) THEN - IF (IRJ.LT.IRK) THEN - RVLAMB(IRI,IRJ,IRK)=RMSS(53) - IF (IMSS(53).EQ.2) RVLAMB(IRI,IRJ,IRK)= - & RMSS(53)*SQRT(PMAS(2*IRI,1)*PMAS(2*IRJ-1,1)* - & PMAS(2*IRK-1,1)*VIR3) - ELSE - RVLAMB(IRI,IRJ,IRK)=-RVLAMB(IRI,IRK,IRJ) - ENDIF - ELSE - RVLAMB(IRI,IRJ,IRK) = 0D0 - ENDIF - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - ENDIF - -C...Antisymmetrize couplings set by user - IF (IMSS(51).EQ.3.OR.IMSS(53).EQ.3) THEN - DO 290 IRI=1,3 - DO 280 IRJ=1,3 - DO 270 IRK=1,3 - IF (RVLAM(IRI,IRJ,IRK).NE.-RVLAM(IRJ,IRI,IRK)) THEN - RVLAM(IRJ,IRI,IRK)=-RVLAM(IRI,IRJ,IRK) - IF (IRI.EQ.IRJ) RVLAM(IRI,IRJ,IRK)=0D0 - ENDIF - IF (RVLAMB(IRI,IRJ,IRK).NE.-RVLAMB(IRI,IRK,IRJ)) THEN - RVLAMB(IRI,IRK,IRJ)=-RVLAMB(IRI,IRJ,IRK) - IF (IRJ.EQ.IRK) RVLAMB(IRI,IRJ,IRK)=0D0 - ENDIF - 270 CONTINUE - 280 CONTINUE - 290 CONTINUE - ENDIF - -C...Second part of routine: set decay modes and branching ratios. - -C...Allow chi10 -> gravitino + gamma or not. - KC=PYCOMP(KSUSY1+39) - IF( IMSS(11) .NE. 0 ) THEN - PMAS(KC,1)=RMSS(21)/1000000000D0 - PMAS(KC,2)=0.0001D0 - IRPRTY=0 - WRITE(MSTU(11),*) ' ALLOWING DECAYS TO GRAVITINOS ' - ELSE IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - IRPRTY=0 - IF (IMSS(51).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY LLE DECAYS' - IF (IMSS(52).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY LQD DECAYS' - IF (IMSS(53).GE.1) WRITE(MSTU(11),*) - & ' ALLOWING SUSY UDD DECAYS' - IF (IMSS(53).GE.1.AND.IMSS(52).GE.1) WRITE(MSTU(11),*) - & ' --- Warning: R-Violating couplings possibly', - & ' incompatible with proton decay' - ELSE - PMAS(KC,1)=9999D0 - IRPRTY=1 - ENDIF - -C...Loop over sparticle and Higgs species. - PMCHI1=PMAS(PYCOMP(KSUSY1+22),1) -C...Find the LSP or NLSP for a gravitino LSP - ILSP=0 - PMLSP=1D20 - DO 300 I=1,36 - KF=KFSUSY(I) - IF(KF.EQ.1000039) GOTO 300 - KC=PYCOMP(KF) - IF(PMAS(KC,1).LT.PMLSP) THEN - ILSP=I - PMLSP=PMAS(KC,1) - ENDIF - 300 CONTINUE - DO 370 I=1,36 - KF=KFSUSY(I) - KC=PYCOMP(KF) - LKNT=0 - -C...Sfermion decays. - IF(I.LE.24) THEN -C...First check to see if sneutrino is lighter than chi10. - IF((I.EQ.15.OR.I.EQ.19.OR.I.EQ.23).AND. - & PMAS(KC,1).LT.PMCHI1) THEN - ELSE - CALL PYSFDC(KF,XLAM,IDLAM,LKNT) - ENDIF - -C...Gluino decays. - ELSEIF(I.EQ.25) THEN - CALL PYGLUI(KF,XLAM,IDLAM,LKNT) - IF(I.EQ.ILSP.AND.IRPRTY.EQ.1) LKNT=0 - -C...Neutralino decays. - ELSEIF(I.GE.26.AND.I.LE.29) THEN - CALL PYNJDC(KF,XLAM,IDLAM,LKNT) -C...chi10 stable or chi10 -> gravitino + gamma. - IF(I.EQ.26.AND.IRPRTY.EQ.1) THEN - PMAS(KC,2)=1D-6 - MDCY(KC,1)=0 - MWID(KC)=0 - ENDIF - -C...Chargino decays. - ELSEIF(I.GE.30.AND.I.LE.31) THEN - CALL PYCJDC(KF,XLAM,IDLAM,LKNT) - -C...Gravitino is stable. - ELSEIF(I.EQ.32) THEN - MDCY(KC,1)=0 - MWID(KC)=0 - -C...Higgs decays. - ELSEIF(I.GE.33.AND.I.LE.36) THEN -C...Calculate decays to non-SUSY particles. - CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) - LKNT=0 - DO 310 I1=0,100 - XLAM(I1)=0D0 - 310 CONTINUE - DO 330 I1=1,MDCY(KC,3) - K1=MDCY(KC,2)+I1-1 - IF(IABS(KFDP(K1,1)).GT.KSUSY1.OR. - & IABS(KFDP(K1,2)).GT.KSUSY1) GOTO 330 - XLAM(I1)=WDTP(I1) - XLAM(0)=XLAM(0)+XLAM(I1) - DO 320 J1=1,3 - IDLAM(I1,J1)=KFDP(K1,J1) - 320 CONTINUE - LKNT=LKNT+1 - 330 CONTINUE -C...Add the decays to SUSY particles. - CALL PYHEXT(KF,XLAM,IDLAM,LKNT) - ENDIF -C...Zero the branching ratios for use in loop mode -C...thanks to K. Matchev (FNAL) - DO 340 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - BRAT(IDC)=0D0 - 340 CONTINUE - -C...Set stable particles. - IF(LKNT.EQ.0) THEN - MDCY(KC,1)=0 - MWID(KC)=0 - PMAS(KC,2)=1D-6 - PMAS(KC,3)=1D-5 - PMAS(KC,4)=0D0 - -C...Store branching ratios in the standard tables. - ELSE - IDC=MDCY(KC,2)+MDCY(KC,3)-1 - DELM=1D6 - DO 360 IL=1,LKNT - IDCSV=IDC - 350 IDC=IDC+1 - BRAT(IDC)=0D0 - IF(IDC.EQ.MDCY(KC,2)+MDCY(KC,3)) IDC=MDCY(KC,2) - IF(IDLAM(IL,1).EQ.KFDP(IDC,1).AND.IDLAM(IL,2).EQ. - & KFDP(IDC,2).AND.IDLAM(IL,3).EQ.KFDP(IDC,3)) THEN - BRAT(IDC)=XLAM(IL)/XLAM(0) - XMDIF=PMAS(KC,1) - IF(MDME(IDC,1).GE.1) THEN - XMDIF=XMDIF-PMAS(PYCOMP(KFDP(IDC,1)),1)- - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) XMDIF=XMDIF- - & PMAS(PYCOMP(KFDP(IDC,3)),1) - ENDIF - IF(I.LE.32) THEN - IF(XMDIF.GE.0D0) THEN - DELM=MIN(DELM,XMDIF) - ELSE - WRITE(MSTU(11),*) ' ERROR WITH DELM ',DELM,XMDIF - WRITE(MSTU(11),*) ' KF = ',KF - WRITE(MSTU(11),*) ' KF(decay) = ',(KFDP(IDC,J),J=1,3) - ENDIF - ENDIF - GOTO 360 - ELSEIF(IDC.EQ.IDCSV) THEN - WRITE(MSTU(11),*) ' Error in PYMSIN: SUSY decay ', - & 'channel not recognized:' - WRITE(MSTU(11),*) KF,' -> ',(IDLAM(I,J),J=1,3) - GOTO 360 - ELSE - GOTO 350 - ENDIF - 360 CONTINUE - -C...Store width, cutoff and lifetime. - PMAS(KC,2)=XLAM(0) - IF(PMAS(KC,2).LT.0.1D0*DELM) THEN - PMAS(KC,3)=PMAS(KC,2)*10D0 - ELSE - PMAS(KC,3)=0.95D0*DELM - ENDIF - IF(PMAS(KC,2).NE.0D0) THEN - PMAS(KC,4)=PARU(3)/PMAS(KC,2)*1D-12 - ENDIF - ENDIF - 370 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYMULT -C...Initializes treatment of multiple interactions, selects kinematics -C...of hardest interaction if low-pT physics included in run, and -C...generates all non-hardest interactions. - - SUBROUTINE PYMULT(MMUL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT5/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION NMUL(20),SIGM(20),KSTR(500,2),VINTSV(80) - SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM - -C...Initialization of multiple interaction treatment. - IF(MMUL.EQ.1) THEN - IF(MSTP(122).GE.1) WRITE(MSTU(11),5000) MSTP(82) - ISUB=96 - MINT(1)=96 - VINT(63)=0D0 - VINT(64)=0D0 - VINT(143)=1D0 - VINT(144)=1D0 - -C...Loop over phase space points: xT2 choice in 20 bins. - 100 SIGSUM=0D0 - DO 120 IXT2=1,20 - NMUL(IXT2)=MSTP(83) - SIGM(IXT2)=0D0 - DO 110 ITRY=1,MSTP(83) - RSCA=0.05D0*((21-IXT2)-PYR(0)) - XT2=VINT(149)*(1D0+VINT(149))/(VINT(149)+RSCA)-VINT(149) - XT2=MAX(0.01D0*VINT(149),XT2) - VINT(25)=XT2 - -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - -C...Calculate differential cross-section. - VINT(71)=0.5D0*VINT(1)*SQRT(XT2) - CALL PYSIGH(NCHN,SIGS) - SIGM(IXT2)=SIGM(IXT2)+SIGS - 110 CONTINUE - SIGSUM=SIGSUM+SIGM(IXT2) - 120 CONTINUE - SIGSUM=SIGSUM/(20D0*MSTP(83)) - -C...Reject result if sigma(parton-parton) is smaller than hadronic one. - IF(SIGSUM.LT.1.1D0*SIGT(0,0,5)) THEN - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) - & PARP(82)*(VINT(1)/PARP(89))**PARP(90),SIGSUM - PARP(82)=0.9D0*PARP(82) - VINT(149)=4D0*(PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2/ - & VINT(2) - GOTO 100 - ENDIF - IF(MSTP(122).GE.1) WRITE(MSTU(11),5200) - & PARP(82)*(VINT(1)/PARP(89))**PARP(90), SIGSUM - -C...Start iteration to find k factor. - YKE=SIGSUM/MAX(1D-10,SIGT(0,0,5)) - SO=0.5D0 - XI=0D0 - YI=0D0 - XF=0D0 - YF=0D0 - XK=0.5D0 - IIT=0 - 130 IF(IIT.EQ.0) THEN - XK=2D0*XK - ELSEIF(IIT.EQ.1) THEN - XK=0.5D0*XK - ELSE - XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) - ENDIF - -C...Evaluate overlap integrals. - IF(MSTP(82).EQ.2) THEN - SP=0.5D0*PARU(1)*(1D0-EXP(-XK)) - SOP=SP/PARU(1) - ELSE - IF(MSTP(82).EQ.3) DELTAB=0.02D0 - IF(MSTP(82).EQ.4) DELTAB=MIN(0.01D0,0.05D0*PARP(84)) - SP=0D0 - SOP=0D0 - B=-0.5D0*DELTAB - 140 B=B+DELTAB - IF(MSTP(82).EQ.3) THEN - OV=EXP(-B**2)/PARU(2) - ELSE - CQ2=PARP(84)**2 - OV=((1D0-PARP(83))**2*EXP(-MIN(50D0,B**2))+ - & 2D0*PARP(83)*(1D0-PARP(83))*2D0/(1D0+CQ2)* - & EXP(-MIN(50D0,B**2*2D0/(1D0+CQ2)))+ - & PARP(83)**2/CQ2*EXP(-MIN(50D0,B**2/CQ2)))/PARU(2) - ENDIF - PACC=1D0-EXP(-MIN(50D0,PARU(1)*XK*OV)) - SP=SP+PARU(2)*B*DELTAB*PACC - SOP=SOP+PARU(2)*B*DELTAB*OV*PACC - IF(B.LT.1D0.OR.B*PACC.GT.1D-6) GOTO 140 - ENDIF - YK=PARU(1)*XK*SO/SP - -C...Continue iteration until convergence. - IF(YK.LT.YKE) THEN - XI=XK - YI=YK - IF(IIT.EQ.1) IIT=2 - ELSE - XF=XK - YF=YK - IF(IIT.EQ.0) IIT=1 - ENDIF - IF(ABS(YK-YKE).GE.1D-5*YKE) GOTO 130 - -C...Store some results for subsequent use. - VINT(145)=SIGSUM - VINT(146)=SOP/SO - VINT(147)=SOP/SP - -C...Initialize iteration in xT2 for hardest interaction. - ELSEIF(MMUL.EQ.2) THEN - IF(MSTP(82).LE.0) THEN - ELSEIF(MSTP(82).EQ.1) THEN - XT2=1D0 - SIGRAT=XSEC(96,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* - & VINT(317)/(VINT(318)*VINT(320)) - XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) - ELSEIF(MSTP(82).EQ.2) THEN - XT2=1D0 - XT2FAC=VINT(146)*XSEC(96,1)/MAX(1D-10,SIGT(0,0,5))* - & VINT(149)*(1D0+VINT(149)) - ELSE - XC2=4D0*CKIN(3)**2/VINT(2) - IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0D0 - ENDIF - - ELSEIF(MMUL.EQ.3) THEN -C...Low-pT or multiple interactions (first semihard interaction): -C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) -C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). - ISUB=MINT(1) - IF(MSTP(82).LE.0) THEN - XT2=0D0 - ELSEIF(MSTP(82).EQ.1) THEN - XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) - ELSEIF(MSTP(82).EQ.2) THEN - IF(XT2.LT.1D0.AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ - & VINT(149)))).GT.PYR(0)) XT2=1D0 - IF(XT2.GE.1D0) THEN - XT2=(1D0+VINT(149))*XT2FAC/(XT2FAC-(1D0+VINT(149))*LOG(1D0- - & PYR(0)*(1D0-EXP(-XT2FAC/(VINT(149)*(1D0+VINT(149)))))))- - & VINT(149) - ELSE - XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+PYR(0)* - & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- - & VINT(149) - ENDIF - XT2=MAX(0.01D0*VINT(149),XT2) - ELSE - XT2=(XC2+VINT(149))*(1D0+VINT(149))/(1D0+VINT(149)- - & PYR(0)*(1D0-XC2))-VINT(149) - XT2=MAX(0.01D0*VINT(149),XT2) - ENDIF - VINT(25)=XT2 - -C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. - IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN - IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-MINT(143) - IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-MINT(143) - ISUB=95 - MINT(1)=ISUB - VINT(21)=0.01D0*VINT(149) - VINT(22)=0D0 - VINT(23)=0D0 - VINT(25)=0.01D0*VINT(149) - - ELSE -C...Multiple interactions (first semihard interaction). -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - ENDIF - VINT(71)=0.5D0*VINT(1)*SQRT(VINT(25)) - -C...Store results of cross-section calculation. - ELSEIF(MMUL.EQ.4) THEN - ISUB=MINT(1) - XTS=VINT(25) - IF(ISET(ISUB).EQ.1) XTS=VINT(21) - IF(ISET(ISUB).EQ.2) - & XTS=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) XTS=VINT(26) - RBIN=MAX(0.000001D0,MIN(0.999999D0,XTS*(1D0+VINT(149))/ - & (XTS+VINT(149)))) - IRBIN=INT(1D0+20D0*RBIN) - IF(ISUB.EQ.96.AND.MSTP(171).EQ.0) THEN - NMUL(IRBIN)=NMUL(IRBIN)+1 - SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) - ENDIF - -C...Choose impact parameter. - ELSEIF(MMUL.EQ.5) THEN - ISUB=MINT(1) - 150 IF(MSTP(82).EQ.3) THEN - VINT(148)=PYR(0)/(PARU(2)*VINT(147)) - ELSE - RTYPE=PYR(0) - CQ2=PARP(84)**2 - IF(RTYPE.LT.(1D0-PARP(83))**2) THEN - B2=-LOG(PYR(0)) - ELSEIF(RTYPE.LT.1D0-PARP(83)**2) THEN - B2=-0.5D0*(1D0+CQ2)*LOG(PYR(0)) - ELSE - B2=-CQ2*LOG(PYR(0)) - ENDIF - VINT(148)=((1D0-PARP(83))**2*EXP(-MIN(50D0,B2))+2D0*PARP(83)* - & (1D0-PARP(83))*2D0/(1D0+CQ2)*EXP(-MIN(50D0,B2*2D0/(1D0+CQ2)))+ - & PARP(83)**2/CQ2*EXP(-MIN(50D0,B2/CQ2)))/(PARU(2)*VINT(147)) - ENDIF - -C...Multiple interactions (variable impact parameter) : reject with -C...probability exp(-overlap*cross-section above pT/normalization). - RNCOR=(IRBIN-20D0*RBIN)*NMUL(IRBIN) - SIGCOR=(IRBIN-20D0*RBIN)*SIGM(IRBIN) - DO 160 IBIN=IRBIN+1,20 - RNCOR=RNCOR+NMUL(IBIN) - SIGCOR=SIGCOR+SIGM(IBIN) - 160 CONTINUE - SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1D0-XTS)/(XTS+VINT(149)) - IF(MSTP(171).EQ.1) SIGABV=SIGABV*VINT(2)/VINT(289) - VINT(150)=EXP(-MIN(50D0,VINT(146)*VINT(148)* - & SIGABV/MAX(1D-10,SIGT(0,0,5)))) - IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUB.NE.11.AND. - & ISUB.NE.12.AND.ISUB.NE.13.AND.ISUB.NE.28.AND.ISUB.NE.53 - & .AND.ISUB.NE.68.AND.ISUB.NE.95.AND.ISUB.NE.96)) THEN - IF(VINT(150).LT.PYR(0)) GOTO 150 - VINT(150)=1D0 - ENDIF - -C...Generate additional multiple semihard interactions. - ELSEIF(MMUL.EQ.6) THEN - ISUBSV=MINT(1) - DO 170 J=11,80 - VINTSV(J)=VINT(J) - 170 CONTINUE - ISUB=96 - MINT(1)=96 - VINT(151)=0D0 - VINT(152)=0D0 - -C...Reconstruct strings in hard scattering. - NMAX=MINT(84)+4 - IF(ISET(ISUBSV).EQ.1) NMAX=MINT(84)+2 - IF(ISET(ISUBSV).EQ.11) NMAX=MINT(84)+2+MINT(3) - NSTR=0 - DO 190 I=MINT(84)+1,NMAX - KCS=KCHG(PYCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) - IF(KCS.EQ.0) GOTO 190 - DO 180 J=1,4 - IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 180 - IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 180 - IF(J.LE.2) THEN - IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) - ELSE - IST=MOD(K(I,J+1),MSTU(5)) - ENDIF - IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 180 - IF(KCHG(PYCOMP(K(IST,2)),2).EQ.0) GOTO 180 - NSTR=NSTR+1 - IF(J.EQ.1.OR.J.EQ.4) THEN - KSTR(NSTR,1)=I - KSTR(NSTR,2)=IST - ELSE - KSTR(NSTR,1)=IST - KSTR(NSTR,2)=I - ENDIF - 180 CONTINUE - 190 CONTINUE - -C...Set up starting values for iteration in xT2. - IF(MSTP(86).EQ.3.OR.(MSTP(86).EQ.2.AND.ISUBSV.NE.11.AND. - & ISUBSV.NE.12.AND.ISUBSV.NE.13.AND.ISUBSV.NE.28.AND. - & ISUBSV.NE.53.AND.ISUBSV.NE.68.AND.ISUBSV.NE.95.AND. - & ISUBSV.NE.96)) THEN - XT2=(1D0-VINT(141))*(1D0-VINT(142)) - ELSE - XT2=VINT(25) - IF(ISET(ISUBSV).EQ.1) XT2=VINT(21) - IF(ISET(ISUBSV).EQ.2) - & XT2=(4D0*VINT(48)+2D0*VINT(63)+2D0*VINT(64))/VINT(2) - IF(ISET(ISUBSV).GE.3.AND.ISET(ISUBSV).LE.5) XT2=VINT(26) - ENDIF - IF(MSTP(82).LE.1) THEN - SIGRAT=XSEC(ISUB,1)/MAX(1D-10,VINT(315)*VINT(316)*SIGT(0,0,5)) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGRAT=SIGRAT* - & VINT(317)/(VINT(318)*VINT(320)) - XT2FAC=SIGRAT*VINT(149)/(1D0-VINT(149)) - ELSE - XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/ - & MAX(1D-10,SIGT(0,0,5))*VINT(149)*(1D0+VINT(149)) - ENDIF - VINT(63)=0D0 - VINT(64)=0D0 - VINT(143)=1D0-VINT(141) - VINT(144)=1D0-VINT(142) - -C...Iterate downwards in xT2. - 200 IF(MSTP(82).LE.1) THEN - XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(PYR(0))) - IF(XT2.LT.VINT(149)) GOTO 250 - ELSE - IF(XT2.LE.0.01001D0*VINT(149)) GOTO 250 - XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* - & LOG(PYR(0)))-VINT(149) - IF(XT2.LE.0D0) GOTO 250 - XT2=MAX(0.01D0*VINT(149),XT2) - ENDIF - VINT(25)=XT2 - -C...Choose tau and y*. Calculate cos(theta-hat). - IF(PYR(0).LE.COEF(ISUB,1)) THEN - TAUT=(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0)**PYR(0) - TAU=XT2*(1D0+TAUT)**2/(4D0*TAUT) - ELSE - TAU=XT2*(1D0+TAN(PYR(0)*ATAN(SQRT(1D0/XT2-1D0)))**2) - ENDIF - VINT(21)=TAU - CALL PYKLIM(2) - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - CALL PYKMAP(2,MYST,PYR(0)) - VINT(23)=SQRT(MAX(0D0,1D0-XT2/TAU))*(-1)**INT(1.5D0+PYR(0)) - -C...Check that x not used up. Accept or reject kinematical variables. - X1M=SQRT(TAU)*EXP(VINT(22)) - X2M=SQRT(TAU)*EXP(-VINT(22)) - IF(VINT(143)-X1M.LT.0.01D0.OR.VINT(144)-X2M.LT.0.01D0) GOTO 200 - VINT(71)=0.5D0*VINT(1)*SQRT(XT2) - CALL PYSIGH(NCHN,SIGS) - IF(MINT(141).NE.0.OR.MINT(142).NE.0) SIGS=SIGS*VINT(320) - IF(SIGS.LT.XSEC(ISUB,1)*PYR(0)) GOTO 200 - -C...Reset K, P and V vectors. Select some variables. - DO 220 I=N+1,N+2 - DO 210 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 210 CONTINUE - 220 CONTINUE - RFLAV=PYR(0) - PT=0.5D0*VINT(1)*SQRT(XT2) - PHI=PARU(2)*PYR(0) - CTH=VINT(23) - -C...Add first parton to event record. - K(N+1,1)=3 - K(N+1,2)=21 - IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= - & 1+INT((2D0+PARJ(2))*PYR(0)) - P(N+1,1)=PT*COS(PHI) - P(N+1,2)=PT*SIN(PHI) - P(N+1,3)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)-VINT(42)*(1D0-CTH)) - P(N+1,4)=0.25D0*VINT(1)*(VINT(41)*(1D0+CTH)+VINT(42)*(1D0-CTH)) - P(N+1,5)=0D0 - -C...Add second parton to event record. - K(N+2,1)=3 - K(N+2,2)=21 - IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) - P(N+2,1)=-P(N+1,1) - P(N+2,2)=-P(N+1,2) - P(N+2,3)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)-VINT(42)*(1D0+CTH)) - P(N+2,4)=0.25D0*VINT(1)*(VINT(41)*(1D0-CTH)+VINT(42)*(1D0+CTH)) - P(N+2,5)=0D0 - - IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN -C....Choose relevant string pieces to place gluons on. - DO 240 I=N+1,N+2 - DMIN=1D8 - DO 230 ISTR=1,NSTR - I1=KSTR(ISTR,1) - I2=KSTR(ISTR,2) - DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- - & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- - & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1D0,P(I1,4)*P(I2,4)- - & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) - IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN - DMIN=DIST - IST1=I1 - IST2=I2 - ISTM=ISTR - ENDIF - 230 CONTINUE - -C....Colour flow adjustments, new string pieces. - IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ - & MOD(K(IST1,4),MSTU(5)) - IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= - & MSTU(5)*(K(IST1,5)/MSTU(5))+I - K(I,5)=MSTU(5)*IST1 - K(I,4)=MSTU(5)*IST2 - IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ - & MOD(K(IST2,5),MSTU(5)) - IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= - & MSTU(5)*(K(IST2,4)/MSTU(5))+I - KSTR(ISTM,2)=I - KSTR(NSTR+1,1)=I - KSTR(NSTR+1,2)=IST2 - NSTR=NSTR+1 - 240 CONTINUE - -C...String drawing and colour flow for gluon loop. - ELSEIF(K(N+1,2).EQ.21) THEN - K(N+1,4)=MSTU(5)*(N+2) - K(N+1,5)=MSTU(5)*(N+2) - K(N+2,4)=MSTU(5)*(N+1) - K(N+2,5)=MSTU(5)*(N+1) - KSTR(NSTR+1,1)=N+1 - KSTR(NSTR+1,2)=N+2 - KSTR(NSTR+2,1)=N+2 - KSTR(NSTR+2,2)=N+1 - NSTR=NSTR+2 - -C...String drawing and colour flow for qqbar pair. - ELSE - K(N+1,4)=MSTU(5)*(N+2) - K(N+2,5)=MSTU(5)*(N+1) - KSTR(NSTR+1,1)=N+1 - KSTR(NSTR+1,2)=N+2 - NSTR=NSTR+1 - ENDIF - -C...Update remaining energy; iterate. - N=N+2 - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYMULT:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - MINT(31)=MINT(31)+1 - VINT(151)=VINT(151)+VINT(41) - VINT(152)=VINT(152)+VINT(42) - VINT(143)=VINT(143)-VINT(41) - VINT(144)=VINT(144)-VINT(42) - IF(MINT(31).LT.240) GOTO 200 - 250 CONTINUE - MINT(1)=ISUBSV - DO 260 J=11,80 - VINT(J)=VINTSV(J) - 260 CONTINUE - ENDIF - -C...Format statements for printout. - 5000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter', - &'actions for MSTP(82) =',I2,' ******') - 5100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, - &D9.2,' mb: rejected') - 5200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, - &D9.2,' mb: accepted') - - RETURN - END - -C********************************************************************* - -C...PYNAME -C...Gives the particle/parton name as a character string. - - SUBROUTINE PYNAME(KF,CHAU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - SAVE /PYDAT1/,/PYDAT2/,/PYDAT4/ -C...Local character variable. - CHARACTER CHAU*16 - -C...Read out code with distinction particle/antiparticle. - CHAU=' ' - KC=PYCOMP(KF) - IF(KC.NE.0) CHAU=CHAF(KC,(3-ISIGN(1,KF))/2) - - - RETURN - END - -C********************************************************************* - -C...PYNJDC -C...Calculates decay widths for the neutralinos (admixtures of -C...Bino, W3-ino, Higgs1-ino, Higgs2-ino) - -C...Input: KCIN = KF code for particle -C...Output: XLAM = widths -C... IDLAM = KF codes for decay particles -C... IKNT = number of decay channels defined -C...AUTHOR: STEPHEN MRENNA -C...Last change: -C...10-15-95: force decay chi^0_2 -> chi^0_1 + gamma -C...when CHIGAMMA .NE. 0 -C...10 FEB 96: Calculate this decay for small tan(beta) - - SUBROUTINE PYNJDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) -c COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), -c &SFMIX(16,4) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYINTC/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2),OLPP,ORPP,GLIJ,GRIJ - COMPLEX*16 QIJ,RIJ,F21K,F12K,CAL,CAR,CBL,CBR,CA,CB - INTEGER KFIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2, - &XMZ,XMZ2,AXMJ,AXMI - DOUBLE PRECISION S12MIN,S12MAX - DOUBLE PRECISION XMI2,XMI3,XMJ2,XMH,XMH2,XMHP,XMA2,XMB2 - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS,EI,T3I - DOUBLE PRECISION PYX2XH,PYX2XG - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,IH,J,IJ,I,IKNT,FID - INTEGER ITH(3),KF1,KF2 - INTEGER ITHC - DOUBLE PRECISION DH(3),EH(3) - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA - DOUBLE PRECISION GAMCON,XMT1,XMT2 - DOUBLE PRECISION PYALEM,PI,PYALPS - DOUBLE PRECISION RAT1,RAT2 - DOUBLE PRECISION T3T,FCOL - DOUBLE PRECISION ALFA,BETA,TANB - DOUBLE PRECISION PYXXGA - EXTERNAL PYGAUS,PYXXZ6 - DOUBLE PRECISION PYGAUS,PYXXZ6 - DOUBLE PRECISION PREC - INTEGER KFNCHI(4),KFCCHI(2) - DATA ITH/25,35,36/ - DATA ITHC/37/ - DATA PREC/1D-2/ - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XMZ2=XMZ**2 - XW=1D0-XMW2/XMZ2 - XW1=1D0-XW - TANW = SQRT(XW/XW1) - -C...IX IS 1 - 4 DEPENDING ON SEQUENCE NUMBER - IX=1 - IF(KFIN.EQ.KFNCHI(2)) IX=2 - IF(KFIN.EQ.KFNCHI(3)) IX=3 - IF(KFIN.EQ.KFNCHI(4)) IX=4 - - XMI=SMZ(IX) - XMI2=XMI**2 - AXMI=ABS(XMI) - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=ABS(XMI**3) - - TANB=RMSS(5) - BETA=ATAN(TANB) - ALFA=RMSS(18) - CBETA=COS(BETA) - SBETA=TANB*CBETA - CALFA=COS(ALFA) - SALFA=SIN(ALFA) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - -C...CHECK ALL 2-BODY DECAYS TO GAUGE AND HIGGS BOSONS - IF(IX.EQ.1.AND.IMSS(11).EQ.0) GOTO 300 - -C...FORCE CHI0_2 -> CHI0_1 + GAMMA - IF(IX.EQ.2 .AND. IMSS(10).NE.0 ) THEN - XMJ=SMZ(1) - AXMJ=ABS(XMJ) - LKNT=LKNT+1 - GAMCON=AEM**3/8D0/PI/XMW2/XW - XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 - XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 - XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) - IDLAM(LKNT,1)=KSUSY1+22 - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - WRITE(MSTU(11),*) 'FORCED N2 -> N1 + GAMMA ',XLAM(LKNT) - GOTO 340 - ENDIF - -C...GRAVITINO DECAY MODES - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - SINW=SQRT(XW) - COSW=SQRT(1D0-XW) - XFAC=(XMI2/(XMP*XMGR))**2*AXMI/48D0/PI - IF(AXMI.GT.XMGR+PMAS(22,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*ABS(ZMIXC(IX,1)*COSW+ZMIXC(IX,2)*SINW)**2 - ENDIF - IF(AXMI.GT.XMGR+XMZ) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,1)*SINW-ZMIXC(IX,2)*COSW)**2 + - $ .5D0*ABS(ZMIXC(IX,3)*CBETA-ZMIXC(IX,4)*SBETA)**2)* - & (1D0-XMZ2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(25,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=25 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SALFA-ZMIXC(IX,4)*CALFA)**2)* - $ .5D0*(1D0-PMAS(25,1)**2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(35,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=35 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*CALFA+ZMIXC(IX,4)*SALFA)**2)* - $ .5D0*(1D0-PMAS(35,1)**2/XMI2)**4 - ENDIF - IF(AXMI.GT.XMGR+PMAS(36,1)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=36 - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(ABS(ZMIXC(IX,3)*SBETA+ZMIXC(IX,4)*CBETA)**2)* - $ .5D0*(1D0-PMAS(36,1)**2/XMI2)**4 - ENDIF - IF(IX.EQ.1) GOTO 300 - ENDIF - - DO 220 IJ=1,IX-1 - XMJ=SMZ(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - -C...CHI0_I -> CHI0_J + GAMMA - IF(AXMI.GE.AXMJ.AND.SBETA/CBETA.LE.2D0) THEN - RAT1=ABS(ZMIXC(IJ,1))**2+ABS(ZMIXC(IJ,2))**2 - RAT1=RAT1/( 1D-6+ABS(ZMIXC(IX,3))**2+ABS(ZMIXC(IX,4))**2 ) - RAT2=ABS(ZMIXC(IX,1))**2+ABS(ZMIXC(IX,2))**2 - RAT2=RAT2/( 1D-6+ABS(ZMIXC(IJ,3))**2+ABS(ZMIXC(IJ,4))**2 ) - IF((RAT1.GT. 0.90D0 .AND. RAT1.LT. 1.10D0) .OR. - & (RAT2.GT. 0.90D0 .AND. RAT2.LT. 1.10D0)) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=22 - IDLAM(LKNT,3)=0 - GAMCON=AEM**3/8D0/PI/XMW2/XW - XMT1=(PMAS(PYCOMP(KSUSY1+6),1)/PMAS(6,1))**2 - XMT2=(PMAS(PYCOMP(KSUSY2+6),1)/PMAS(6,1))**2 - XLAM(LKNT)=PYXXGA(GAMCON,AXMI,AXMJ,XMT1,XMT2) - ENDIF - ENDIF - -C...CHI0_I -> CHI0_J + Z0 - IF(AXMI.GE.AXMJ+XMZ) THEN - LKNT=LKNT+1 - OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- - & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 - ORPP=-DCONJG(OLPP) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMZ,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=23 - IDLAM(LKNT,3)=0 - ELSEIF(AXMI.GE.AXMJ) THEN - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(9)=XMZ - XXC(10)=PMAS(23,2) - OLPP=(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,3))- - & ZMIXC(IX,4)*DCONJG(ZMIXC(IJ,4)))/2D0 - ORPP=DCONJG(OLPP) -C...CHARGED LEPTONS - FID=11 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(11,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=FID - IDLAM(LKNT,3)=-FID - IF(AXMI.GE.AXMJ+2D0*PMAS(13,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-13 - ENDIF - ENDIF - 140 CONTINUE - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+15),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - ENDIF - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(15,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-15 - ENDIF - -C...NEUTRINOS - 150 CONTINUE - FID=12 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF( XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=12 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=14 - IDLAM(LKNT,3)=-14 - 160 CONTINUE - - IF(PMAS(PYCOMP(KSUSY1+16),1).NE.PMAS(PYCOMP(KSUSY1+12),1)) - & THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+16),1) - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - XXC(7)=XXC(5) - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - ELSE - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - ENDIF - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=16 - IDLAM(LKNT,3)=-16 -C...D-TYPE QUARKS - 170 CONTINUE - FID=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - IF( XXC(5).LT.AXMI ) THEN - XXC(5)=1D6 - ENDIF - IF( XXC(6).LT.AXMI ) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - 180 CONTINUE - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 190 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF - -C...U-TYPE QUARKS - 190 CONTINUE - FID=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))* - & DCONJG(T3I*ZMIXC(IJ,2)-TANW*(T3I-EI)*ZMIXC(IJ,1)) - GRIJ=ZMIXC(IX,1)*DCONJG(ZMIXC(IJ,1))*(EI*TANW)**2 - CXC(1)=DCMPLX((T3I-EI*XW)/XW1)*OLPP - CXC(2)=-GLIJ - CXC(3)=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - CXC(4)=DCONJG(GLIJ) - CXC(5)=-DCMPLX((EI*XW)/XW1)*OLPP - CXC(6)=GRIJ - CXC(7)=DCMPLX((EI*XW)/XW1)*ORPP - CXC(8)=-DCONJG(GRIJ) - - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 200 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(5) - XXC(8)=XXC(6) - - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3)*3D0 - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 200 CONTINUE - ENDIF - -C...CHI0_I -> CHI0_J + H0_K - EH(1)=SIN(ALFA) - EH(2)=COS(ALFA) - EH(3)=-SIN(BETA) - DH(1)=COS(ALFA) - DH(2)=-SIN(ALFA) - DH(3)=COS(BETA) - QIJ=ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,2))+ - & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,2)- - & TANW*(ZMIXC(IX,3)*DCONJG(ZMIXC(IJ,1))+ - & DCONJG(ZMIXC(IJ,3))*ZMIXC(IX,1)) - RIJ=DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,2)+ - & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,2))- - & TANW*(DCONJG(ZMIXC(IX,4))*ZMIXC(IJ,1)+ - & ZMIXC(IJ,4)*DCONJG(ZMIXC(IX,1))) - DO 210 IH=1,3 - XMH=PMAS(ITH(IH),1) - XMH2=XMH**2 - IF(AXMI.GE.AXMJ+XMH) THEN - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMJ2,XMH2) - F21K=0.5D0*(QIJ*EH(IH)+RIJ*DH(IH)) - F12K=F21K -C...SIGN OF MASSES I,J - XMK=XMJ - IF(IH.EQ.3) XMK=-XMK - GX2=ABS(F21K)**2+ABS(F12K)**2 - GLR=DBLE(F21K*DCONJG(F12K)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMK,XMH,GX2,GLR) - IDLAM(LKNT,1)=KFNCHI(IJ) - IDLAM(LKNT,2)=ITH(IH) - IDLAM(LKNT,3)=0 - ENDIF - 210 CONTINUE - 220 CONTINUE - -C...CHI0_I -> CHI+_J + W- - DO 260 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - IF(AXMI.GE.AXMJ+XMW) THEN - LKNT=LKNT+1 - CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- - & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)/SR2) - CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ - & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))/SR2) - GX2=ABS(CXC(1))**2+ABS(CXC(3))**2 - GLR=DBLE(CXC(1)*DCONJG(CXC(3))) - XLAM(LKNT)=PYX2XG(C1/XMW2,XMI,XMJ,XMW,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-24 - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-KFCCHI(IJ) - IDLAM(LKNT,2)=24 - IDLAM(LKNT,3)=0 - ELSEIF(AXMI.GE.AXMJ) THEN - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 - RT2I = 1D0/SQRT(2D0) - CXC(1)=(DCONJG(ZMIXC(IX,2))*VMIXC(IJ,1)- - & DCONJG(ZMIXC(IX,4))*VMIXC(IJ,2)*RT2I)*RT2I - CXC(3)=(ZMIXC(IX,2)*DCONJG(UMIXC(IJ,1))+ - & ZMIXC(IX,3)*DCONJG(UMIXC(IJ,2))*RT2I)*RT2I - CXC(5)=DCMPLX(0D0,0D0) - CXC(7)=DCMPLX(0D0,0D0) - IA=11 - JA=12 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* - & TANW+ZMIXC(IX,2)*T3J)*RT2I - CXC(4)=-DCONJG(UMIXC(IJ,1))*( - & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I)*RT2I - CXC(6)=DCMPLX(0D0,0D0) - CXC(8)=DCMPLX(0D0,0D0) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - XXC(5)=PMAS(PYCOMP(KSUSY1+JA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(9)=PMAS(24,1) - XXC(10)=PMAS(24,2) - IF( XXC(5).LT.AXMI .AND. XXC(6).LT.AXMI ) GOTO 230 - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ELSEIF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(11,1)+PMAS(12,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=11 - IDLAM(LKNT,3)=-12 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - IF(AXMI.GE.AXMJ+PMAS(13,1)+PMAS(14,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=13 - IDLAM(LKNT,3)=-14 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - ENDIF - 230 CONTINUE - IF(ABS(SFMIX(15,1)).GT.ABS(SFMIX(15,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) - ELSE - XXC(5)=PMAS(PYCOMP(KSUSY2+15),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+16),1) - ENDIF - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(15,1)+PMAS(16,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=15 - IDLAM(LKNT,3)=-16 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - -C...NOW, DO THE QUARKS - 240 CONTINUE - IA=1 - JA=2 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - CXC(2)=VMIXC(IJ,1)*DCONJG(ZMIXC(IX,1)*(EJ-T3J)* - & TANW+ZMIXC(IX,2)*T3J) - CXC(4)=-DCONJG(UMIXC(IJ,1))*( - & ZMIXC(IX,1)*(EI-T3I)*TANW+ZMIXC(IX,2)*T3I) - XXC(5)=PMAS(PYCOMP(KSUSY1+IA),1) - XXC(6)=PMAS(PYCOMP(KSUSY1+JA),1) - IF(XXC(5).LT.AXMI) THEN - XXC(5)=1D6 - ENDIF - IF(XXC(6).LT.AXMI) THEN - XXC(6)=1D6 - ENDIF - XXC(7)=XXC(6) - XXC(8)=XXC(5) - IF(AXMI.GE.AXMJ+PMAS(2,1)+PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=3D0*C1**2/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,PREC) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-2 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - IF(AXMI.GE.AXMJ+PMAS(3,1)+PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-4 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ENDIF - ENDIF - 250 CONTINUE - ENDIF - 260 CONTINUE - 270 CONTINUE - -C...CHI0_I -> CHI+_I + H- - DO 280 IJ=1,2 - XMJ=SMW(IJ) - AXMJ=ABS(XMJ) - XMJ2=XMJ**2 - XMHP=PMAS(ITHC,1) - IF(AXMI.GE.AXMJ+XMHP) THEN - LKNT=LKNT+1 - OLPP=CBETA*(ZMIXC(IX,4)*DCONJG(VMIXC(IJ,1))+(ZMIXC(IX,2)+ - & ZMIXC(IX,1)*TANW)*DCONJG(VMIXC(IJ,2))/SR2) - ORPP=SBETA*(DCONJG(ZMIXC(IX,3))*UMIXC(IJ,1)- - & (DCONJG(ZMIXC(IX,2))+DCONJG(ZMIXC(IX,1))*TANW)* - & UMIXC(IJ,2)/SR2) - GX2=ABS(OLPP)**2+ABS(ORPP)**2 - GLR=DBLE(OLPP*DCONJG(ORPP)) - XLAM(LKNT)=PYX2XH(C1,XMI,XMJ,XMHP,GX2,GLR) - IDLAM(LKNT,1)=KFCCHI(IJ) - IDLAM(LKNT,2)=-ITHC - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - ELSE - - ENDIF - 280 CONTINUE - -C...2-BODY DECAYS TO FERMION SFERMION - DO 290 J=1,16 - IF(J.GE.7.AND.J.LE.10) GOTO 290 - KF1=KSUSY1+J - KF2=KSUSY2+J - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - XMF=PMAS(J,1) - IF(J.LE.6) THEN - FCOL=3D0 - ELSE - FCOL=1D0 - ENDIF - - EI=KCHG(J,1)/3D0 - T3T=SIGN(1D0,EI) - IF(J.EQ.12.OR.J.EQ.14.OR.J.EQ.16) T3T=1D0 - IF(MOD(J,2).EQ.0) THEN - CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) - CAL=XMF*ZMIXC(IX,4)/XMW/SBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ELSE - CBL=T3T*ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-T3T) - CAL=XMF*ZMIXC(IX,3)/XMW/CBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ENDIF - -C...D~ D_L - IF(AXMI.GE.XMF+XMSF1) THEN - LKNT=LKNT+1 - XMA2=XMSF1**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - CA=CAL*SFMIX(J,1)+CAR*SFMIX(J,2) - CB=CBL*SFMIX(J,1)+CBR*SFMIX(J,2) - XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=-J - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - -C...D~ D_R - IF(AXMI.GE.XMF+XMSF2) THEN - LKNT=LKNT+1 - XMA2=XMSF2**2 - XMB2=XMF**2 - CA=CAL*SFMIX(J,3)+CAR*SFMIX(J,4) - CB=CBL*SFMIX(J,3)+CBR*SFMIX(J,4) - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=0.5D0*FCOL*C1/8D0/XMI3*SQRT(XL)*( (XMI2+XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)+4D0*DBLE(CA*DCONJG(CB))*XMF*XMI) - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=-J - IDLAM(LKNT,3)=0 - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=0 - ENDIF - 290 CONTINUE - 300 CONTINUE -C...3-BODY DECAY TO Q Q~ GLUINO - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - IF(AXMI.GE.XMJ) THEN - RT2I = 1D0/SQRT(2D0) - OLPP=DCMPLX(COS(RMSS(32)),SIN(RMSS(32)))*RT2I - ORPP=DCONJG(OLPP) - AXMJ=ABS(XMJ) - XXC(1)=0D0 - XXC(2)=XMJ - XXC(3)=0D0 - XXC(4)=XMI - FID=1 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 310 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - XXC(9)=1D6 - XXC(10)=0D0 - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(1)=0D0 - CXC(2)=-GLIJ - CXC(3)=0D0 - CXC(4)=DCONJG(GLIJ) - CXC(5)=0D0 - CXC(6)=GRIJ - CXC(7)=0D0 - CXC(8)=-DCONJG(GRIJ) - S12MIN=0D0 - S12MAX=(AXMI-AXMJ)**2 -C...ALL QUARKS BUT T - IF(AXMI.GE.AXMJ+2D0*PMAS(1,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=4D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=1 - IDLAM(LKNT,3)=-1 - IF(AXMI.GE.AXMJ+2D0*PMAS(3,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=3 - IDLAM(LKNT,3)=-3 - ENDIF - ENDIF - 310 CONTINUE - IF(ABS(SFMIX(5,1)).GT.ABS(SFMIX(5,2))) THEN - XXC(5)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+5),1) - ELSE - XXC(6)=PMAS(PYCOMP(KSUSY1+5),1) - XXC(5)=PMAS(PYCOMP(KSUSY2+5),1) - ENDIF - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 320 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - IF(AXMI.GE.AXMJ+2D0*PMAS(5,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=5 - IDLAM(LKNT,3)=-5 - ENDIF -C...U-TYPE QUARKS - 320 CONTINUE - FID=2 - XXC(5)=PMAS(PYCOMP(KSUSY1+FID),1) - XXC(6)=PMAS(PYCOMP(KSUSY2+FID),1) - IF( XXC(5).LT.AXMI .OR. XXC(6).LT.AXMI ) GOTO 330 - XXC(7)=XXC(5) - XXC(8)=XXC(6) - EI=KCHG(FID,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - GLIJ=(T3I*ZMIXC(IX,2)-TANW*(T3I-EI)*ZMIXC(IX,1))*OLPP - GRIJ=ZMIXC(IX,1)*(EI*TANW)*ORPP - CXC(2)=-GLIJ - CXC(4)=DCONJG(GLIJ) - CXC(6)=GRIJ - CXC(8)=-DCONJG(GRIJ) - IF(AXMI.GE.AXMJ+2D0*PMAS(2,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=0.5D0*C1*AS/XMI3/(16D0*PI)* - & PYGAUS(PYXXZ6,S12MIN,S12MAX,1D-3) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=2 - IDLAM(LKNT,3)=-2 - IF(AXMI.GE.AXMJ+2D0*PMAS(4,1)) THEN - LKNT=LKNT+1 - XLAM(LKNT)=XLAM(LKNT-1) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=-4 - ENDIF - ENDIF - 330 CONTINUE - ENDIF - -C...R-violating decay modes (SKANDS). - CALL PYRVNE(KFIN,XLAM,IDLAM,LKNT) - - 340 IKNT=LKNT - XLAM(0)=0D0 - DO 350 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 350 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-6 - - RETURN - END - -C********************************************************************* - -C...PYNMES -C...Generates number of popcorn mesons and stores some relevant -C...parameters. - - SUBROUTINE PYNMES(KFDIQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - - MSTU(121)=0 - IF(MSTJ(12).LT.2) RETURN - -C..Old version: Get 1 or 0 popcorn mesons - IF(MSTJ(12).LT.5)THEN - POPWT=PARF(131) - IF(KFDIQ.NE.0) THEN - KFDIQA=IABS(KFDIQ) - KFA=MOD(KFDIQA/1000,10) - KFB=MOD(KFDIQA/100,10) - KFS=MOD(KFDIQA,10) - POPWT=PARF(132) - IF(KFA.EQ.3) POPWT=PARF(133) - IF(KFB.EQ.3) POPWT=PARF(134) - IF(KFS.EQ.1) POPWT=POPWT*SQRT(PARJ(4)) - ENDIF - MSTU(121)=INT(POPWT/(1D0+POPWT)+PYR(0)) - RETURN - ENDIF - -C..New version: Store popcorn- or rank 0 diquark parameters - MSTU(122)=170 - PARF(193)=PARJ(8) - PARF(194)=PARF(139) - IF(KFDIQ.NE.0) THEN - MSTU(122)=180 - PARF(193)=PARJ(10) - PARF(194)=PARF(140) - ENDIF - IF(PARF(194).LT.1D-5.OR.PARF(194).GT.1D0-1D-5) THEN - IF(PARF(194).GT.1D0-1D-5) CALL PYERRM(9, - & '(PYNMES:) Neglecting too large popcorn possibility') - RETURN - ENDIF - -C..New version: Get number of popcorn mesons - 100 RTST=PYR(0) - MSTU(121)=-1 - 110 MSTU(121)=MSTU(121)+1 - RTST=RTST/PARF(194) - IF(RTST.LT.1D0) GOTO 110 - IF(KFDIQ.EQ.0.AND.PYR(0)*(2D0+PARF(135)*PARF(161)).GT. - & (2D0+PARF(135)*PARF(161)*PARF(138)**MSTU(121))) GOTO 100 - RETURN - END - -C********************************************************************* - -C...PYNULL -C...Resets bin contents of a histogram. - - SUBROUTINE PYNULL(ID) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ - - IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN - IS=INDX(ID) - IF(IS.EQ.0) RETURN - DO 100 IX=IS+5,IS+8+NINT(BIN(IS+1)) - BIN(IX)=0D0 - 100 CONTINUE - - RETURN - END - -C*********************************************************************** - -C...PYOFSH -C...Calculates partial width and differential cross-section maxima -C...of channels/processes not allowed on mass-shell, and selects -C...masses in such channels/processes. - - SUBROUTINE PYOFSH(MOFSH,KFMO,KFD1,KFD2,PMMO,RET1,RET2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT5/ -C...Local arrays. - DIMENSION KFD(2),MBW(2),PMD(2),PGD(2),PMG(2),PML(2),PMU(2), - &PMH(2),ATL(2),ATU(2),ATH(2),RMG(2),INX1(100),XPT1(100), - &FPT1(100),INX2(100),XPT2(100),FPT2(100),WDTP(0:400), - &WDTE(0:400,0:5) - -C...Find if particles equal, maximum mass, matrix elements, etc. - MINT(51)=0 - ISUB=MINT(1) - KFD(1)=IABS(KFD1) - KFD(2)=IABS(KFD2) - MEQL=0 - IF(KFD(1).EQ.KFD(2)) MEQL=1 - MLM=0 - IF(MOFSH.GE.2.AND.MEQL.EQ.1) MLM=INT(1.5D0+PYR(0)) - IF(MOFSH.LE.2.OR.MOFSH.EQ.5) THEN - NOFF=44 - PMMX=PMMO - ELSE - NOFF=40 - PMMX=VINT(1) - IF(CKIN(2).GT.CKIN(1)) PMMX=MIN(CKIN(2),VINT(1)) - ENDIF - MMED=0 - IF((KFMO.EQ.25.OR.KFMO.EQ.35.OR.KFMO.EQ.36).AND.MEQL.EQ.1.AND. - &(KFD(1).EQ.23.OR.KFD(1).EQ.24)) MMED=1 - IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(1).EQ.23.OR. - &KFD(1).EQ.24).AND.(KFD(2).EQ.23.OR.KFD(2).EQ.24)) MMED=2 - IF((KFMO.EQ.32.OR.IABS(KFMO).EQ.34).AND.(KFD(2).EQ.25.OR. - &KFD(2).EQ.35.OR.KFD(2).EQ.36)) MMED=3 - LOOP=1 - -C...Find where Breit-Wigners are required, else select discrete masses. - 100 DO 110 I=1,2 - KFCA=PYCOMP(KFD(I)) - IF(KFCA.GT.0) THEN - PMD(I)=PMAS(KFCA,1) - PGD(I)=PMAS(KFCA,2) - ELSE - PMD(I)=0D0 - PGD(I)=0D0 - ENDIF - IF(MSTP(42).LE.0.OR.PGD(I).LT.PARP(41)) THEN - MBW(I)=0 - PMG(I)=PMD(I) - RMG(I)=(PMG(I)/PMMX)**2 - ELSE - MBW(I)=1 - ENDIF - 110 CONTINUE - -C...Find allowed mass range and Breit-Wigner parameters. - DO 120 I=1,2 - IF(MOFSH.EQ.1.AND.LOOP.EQ.1.AND.MBW(I).EQ.1) THEN - PML(I)=PARP(42) - PMU(I)=PMMX-PARP(42) - IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - ELSEIF(MBW(I).EQ.1.AND.MOFSH.NE.5) THEN - ILM=I - IF(MLM.EQ.2) ILM=3-I - PML(I)=MAX(CKIN(NOFF+2*ILM-1),PARP(42)) - IF(MBW(3-I).EQ.0) THEN - PMU(I)=PMMX-PMD(3-I) - ELSE - PMU(I)=PMMX-MAX(CKIN(NOFF+5-2*ILM),PARP(42)) - ENDIF - IF(CKIN(NOFF+2*ILM).GT.CKIN(NOFF+2*ILM-1)) PMU(I)= - & MIN(PMU(I),CKIN(NOFF+2*ILM)) - IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) - IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - IF(MBW(I).EQ.1) THEN - ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* - & PGD(I))) - ENDIF - ELSEIF(MBW(I).EQ.1.AND.MOFSH.EQ.5) THEN - ILM=I - IF(MLM.EQ.2) ILM=3-I - PML(I)=MAX(CKIN(48+I),PARP(42)) - PMU(I)=PMMX-MAX(CKIN(51-I),PARP(42)) - IF(MBW(3-I).EQ.0) PMU(I)=MIN(PMU(I),PMMX-PMD(3-I)) - IF(I.EQ.MLM) PMU(I)=MIN(PMU(I),0.5D0*PMMX) - IF(MEQL.EQ.0) PMH(I)=MIN(PMU(I),0.5D0*PMMX) - IF(PMU(I).LT.PML(I)+PARJ(64)) MBW(I)=-1 - IF(MBW(I).EQ.1) THEN - ATL(I)=ATAN((PML(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - ATU(I)=ATAN((PMU(I)**2-PMD(I)**2)/(PMD(I)*PGD(I))) - IF(MEQL.EQ.0) ATH(I)=ATAN((PMH(I)**2-PMD(I)**2)/(PMD(I)* - & PGD(I))) - ENDIF - ENDIF - 120 CONTINUE - IF(MBW(1).LT.0.OR.MBW(2).LT.0.OR.(MBW(1).EQ.0.AND.MBW(2).EQ.0)) - &THEN - CALL PYERRM(3,'(PYOFSH:) no allowed decay product masses') - MINT(51)=1 - RETURN - ENDIF - -C...Calculation of partial width of resonance. - IF(MOFSH.EQ.1) THEN - -C..If only one integration, pick that to be the inner. - IF(MBW(1).EQ.0) THEN - PM2=PMD(1) - PMD(1)=PMD(2) - PGD(1)=PGD(2) - PML(1)=PML(2) - PMU(1)=PMU(2) - ELSEIF(MBW(2).EQ.0) THEN - PM2=PMD(2) - ENDIF - -C...Start outer loop of integration. - IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - ATL2=ATAN((PML(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) - ATU2=ATAN((PMU(2)**2-PMD(2)**2)/(PMD(2)*PGD(2))) - NPT2=1 - XPT2(1)=1D0 - INX2(1)=0 - FMAX2=0D0 - ENDIF - 130 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - PM2S=PMD(2)**2+PMD(2)*PGD(2)*TAN(ATL2+XPT2(NPT2)*(ATU2-ATL2)) - PM2=MIN(PMU(2),MAX(PML(2),SQRT(MAX(0D0,PM2S)))) - ENDIF - RM2=(PM2/PMMX)**2 - -C...Start inner loop of integration. - PML1=PML(1) - PMU1=MIN(PMU(1),PMMX-PM2) - IF(MEQL.EQ.1) PMU1=MIN(PMU1,PM2) - ATL1=ATAN((PML1**2-PMD(1)**2)/(PMD(1)*PGD(1))) - ATU1=ATAN((PMU1**2-PMD(1)**2)/(PMD(1)*PGD(1))) - IF(PML1+PARJ(64).GE.PMU1.OR.ATL1+1D-7.GE.ATU1) THEN - FUNC2=0D0 - GOTO 180 - ENDIF - NPT1=1 - XPT1(1)=1D0 - INX1(1)=0 - FMAX1=0D0 - 140 PM1S=PMD(1)**2+PMD(1)*PGD(1)*TAN(ATL1+XPT1(NPT1)*(ATU1-ATL1)) - PM1=MIN(PMU1,MAX(PML1,SQRT(MAX(0D0,PM1S)))) - RM1=(PM1/PMMX)**2 - -C...Evaluate function value - inner loop. - FUNC1=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - IF(MMED.EQ.1) FUNC1=FUNC1*((1D0-RM1-RM2)**2+8D0*RM1*RM2) - IF(MMED.EQ.2) FUNC1=FUNC1**3*(1D0+10D0*RM1+10D0*RM2+RM1**2+ - & RM2**2+10D0*RM1*RM2) - IF(FUNC1.GT.FMAX1) FMAX1=FUNC1 - FPT1(NPT1)=FUNC1 - -C...Go to next position in inner loop. - IF(NPT1.EQ.1) THEN - NPT1=NPT1+1 - XPT1(NPT1)=0D0 - INX1(NPT1)=1 - GOTO 140 - ELSEIF(NPT1.LE.8) THEN - NPT1=NPT1+1 - IF(NPT1.LE.4.OR.NPT1.EQ.6) ISH1=1 - ISH1=ISH1+1 - XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) - INX1(NPT1)=INX1(ISH1) - INX1(ISH1)=NPT1 - GOTO 140 - ELSEIF(NPT1.LT.100) THEN - ISN1=ISH1 - 150 ISH1=ISH1+1 - IF(ISH1.GT.NPT1) ISH1=2 - IF(ISH1.EQ.ISN1) GOTO 160 - DFPT1=ABS(FPT1(ISH1)-FPT1(INX1(ISH1))) - IF(DFPT1.LT.PARP(43)*FMAX1) GOTO 150 - NPT1=NPT1+1 - XPT1(NPT1)=0.5D0*(XPT1(ISH1)+XPT1(INX1(ISH1))) - INX1(NPT1)=INX1(ISH1) - INX1(ISH1)=NPT1 - GOTO 140 - ENDIF - -C...Calculate integral over inner loop. - 160 FSUM1=0D0 - DO 170 IPT1=2,NPT1 - FSUM1=FSUM1+0.5D0*(FPT1(IPT1)+FPT1(INX1(IPT1)))* - & (XPT1(INX1(IPT1))-XPT1(IPT1)) - 170 CONTINUE - FUNC2=FSUM1*(ATU1-ATL1)/PARU(1) - 180 IF(MBW(1).EQ.1.AND.MBW(2).EQ.1) THEN - IF(FUNC2.GT.FMAX2) FMAX2=FUNC2 - FPT2(NPT2)=FUNC2 - -C...Go to next position in outer loop. - IF(NPT2.EQ.1) THEN - NPT2=NPT2+1 - XPT2(NPT2)=0D0 - INX2(NPT2)=1 - GOTO 130 - ELSEIF(NPT2.LE.8) THEN - NPT2=NPT2+1 - IF(NPT2.LE.4.OR.NPT2.EQ.6) ISH2=1 - ISH2=ISH2+1 - XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) - INX2(NPT2)=INX2(ISH2) - INX2(ISH2)=NPT2 - GOTO 130 - ELSEIF(NPT2.LT.100) THEN - ISN2=ISH2 - 190 ISH2=ISH2+1 - IF(ISH2.GT.NPT2) ISH2=2 - IF(ISH2.EQ.ISN2) GOTO 200 - DFPT2=ABS(FPT2(ISH2)-FPT2(INX2(ISH2))) - IF(DFPT2.LT.PARP(43)*FMAX2) GOTO 190 - NPT2=NPT2+1 - XPT2(NPT2)=0.5D0*(XPT2(ISH2)+XPT2(INX2(ISH2))) - INX2(NPT2)=INX2(ISH2) - INX2(ISH2)=NPT2 - GOTO 130 - ENDIF - -C...Calculate integral over outer loop. - 200 FSUM2=0D0 - DO 210 IPT2=2,NPT2 - FSUM2=FSUM2+0.5D0*(FPT2(IPT2)+FPT2(INX2(IPT2)))* - & (XPT2(INX2(IPT2))-XPT2(IPT2)) - 210 CONTINUE - FSUM2=FSUM2*(ATU2-ATL2)/PARU(1) - IF(MEQL.EQ.1) FSUM2=2D0*FSUM2 - ELSE - FSUM2=FUNC2 - ENDIF - -C...Save result; second integration for user-selected mass range. - IF(LOOP.EQ.1) WIDW=FSUM2 - WID2=FSUM2 - IF(LOOP.EQ.1.AND.(CKIN(46).GE.CKIN(45).OR.CKIN(48).GE.CKIN(47) - & .OR.MAX(CKIN(45),CKIN(47)).GE.1.01D0*PARP(42))) THEN - LOOP=2 - GOTO 100 - ENDIF - RET1=WIDW - RET2=WID2/WIDW - -C...Select two decay product masses of a resonance. - ELSEIF(MOFSH.EQ.2.OR.MOFSH.EQ.5) THEN - 220 DO 230 I=1,2 - IF(MBW(I).EQ.0) GOTO 230 - PMBW=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)* - & (ATU(I)-ATL(I))) - PMG(I)=MIN(PMU(I),MAX(PML(I),SQRT(MAX(0D0,PMBW)))) - RMG(I)=(PMG(I)/PMMX)**2 - 230 CONTINUE - IF((MEQL.EQ.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. - & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) GOTO 220 - -C...Weight with matrix element (if none known, use beta factor). - FLAM=SQRT(MAX(0D0,(1D0-RMG(1)-RMG(2))**2-4D0*RMG(1)*RMG(2))) - IF(MMED.EQ.1) THEN - WTBE=FLAM*((1D0-RMG(1)-RMG(2))**2+8D0*RMG(1)*RMG(2)) - ELSEIF(MMED.EQ.2) THEN - WTBE=FLAM**3*(1D0+10D0*RMG(1)+10D0*RMG(2)+RMG(1)**2+ - & RMG(2)**2+10D0*RMG(1)*RMG(2)) - ELSEIF(MMED.EQ.3) THEN - WTBE=FLAM*(RMG(1)+FLAM**2/12D0) - ELSE - WTBE=FLAM - ENDIF - IF(WTBE.LT.PYR(0)) GOTO 220 - RET1=PMG(1) - RET2=PMG(2) - -C...Find suitable set of masses for initialization of 2 -> 2 processes. - ELSEIF(MOFSH.EQ.3) THEN - IF(MBW(1).NE.0.AND.MBW(2).EQ.0) THEN - PMG(1)=MIN(PMD(1),0.5D0*(PML(1)+PMU(1))) - PMG(2)=PMD(2) - ELSEIF(MBW(2).NE.0.AND.MBW(1).EQ.0) THEN - PMG(1)=PMD(1) - PMG(2)=MIN(PMD(2),0.5D0*(PML(2)+PMU(2))) - ELSE - IDIV=-1 - 240 IDIV=IDIV+1 - PMG(1)=MIN(PMD(1),0.1D0*(IDIV*PML(1)+(10-IDIV)*PMU(1))) - PMG(2)=MIN(PMD(2),0.1D0*(IDIV*PML(2)+(10-IDIV)*PMU(2))) - IF(IDIV.LE.9.AND.PMG(1)+PMG(2).GT.0.9D0*PMMX) GOTO 240 - ENDIF - RET1=PMG(1) - RET2=PMG(2) - -C...Evaluate importance of excluded tails of Breit-Wigners. - IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) - & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 - IF(MEQL.LE.1) THEN - VINT(80)=1D0 - DO 250 I=1,2 - IF(MBW(I).NE.0) VINT(80)=VINT(80)*1.25D0*(ATU(I)-ATL(I))/ - & PARU(1) - 250 CONTINUE - ELSE - VINT(80)=(1.25D0/PARU(1))**2*MAX((ATU(1)-ATL(1))* - & (ATH(2)-ATL(2)),(ATH(1)-ATL(1))*(ATU(2)-ATL(2))) - ENDIF - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.30.OR.ISUB.EQ.35).AND. - & MSTP(43).NE.2) VINT(80)=2D0*VINT(80) - IF(ISUB.EQ.22.AND.MSTP(43).NE.2) VINT(80)=4D0*VINT(80) - IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) - -C...Pick one particle to be the lighter (if improves efficiency). - ELSEIF(MOFSH.EQ.4) THEN - IF(MEQL.EQ.0.AND.MBW(1).EQ.1.AND.MBW(2).EQ.1.AND.PMD(1)+PMD(2) - & .GT.PMMX.AND.PMH(1).GT.PML(1).AND.PMH(2).GT.PML(2)) MEQL=2 - 260 IF(MEQL.EQ.2) MLM=INT(1.5D0+PYR(0)) - -C...Select two masses according to Breit-Wigner + flat in s + 1/s. - DO 270 I=1,2 - IF(MBW(I).EQ.0) GOTO 270 - PMV=PMU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) - ATV=ATU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) - RBR=PYR(0) - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. - & ISUB.EQ.35).AND.MSTP(43).NE.2) RBR=2D0*RBR - IF(RBR.LT.0.8D0) THEN - PMSR=PMD(I)**2+PMD(I)*PGD(I)*TAN(ATL(I)+PYR(0)*(ATV-ATL(I))) - PMG(I)=MIN(PMV,MAX(PML(I),SQRT(MAX(0D0,PMSR)))) - ELSEIF(RBR.LT.0.9D0) THEN - PMG(I)=SQRT(MAX(0D0,PML(I)**2+PYR(0)*(PMV**2-PML(I)**2))) - ELSEIF(RBR.LT.1.5D0) THEN - PMG(I)=PML(I)*(PMV/PML(I))**PYR(0) - ELSE - PMG(I)=SQRT(MAX(0D0,PML(I)**2*PMV**2/(PML(I)**2+PYR(0)* - & (PMV**2-PML(I)**2)))) - ENDIF - 270 CONTINUE - IF((MEQL.GE.1.AND.PMG(MAX(1,MLM)).GT.PMG(MIN(2,3-MLM))).OR. - & PMG(1)+PMG(2)+PARJ(64).GT.PMMX) THEN - IF(MINT(48).EQ.1.AND.MSTP(171).EQ.0) THEN - NGEN(0,1)=NGEN(0,1)+1 - NGEN(MINT(1),1)=NGEN(MINT(1),1)+1 - GOTO 260 - ELSE - MINT(51)=1 - RETURN - ENDIF - ENDIF - RET1=PMG(1) - RET2=PMG(2) - -C...Give weight for selected mass distribution. - VINT(80)=1D0 - DO 280 I=1,2 - IF(MBW(I).EQ.0) GOTO 280 - PMV=PMU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) PMV=PMH(I) - ATV=ATU(I) - IF(MEQL.EQ.2.AND.I.EQ.MLM) ATV=ATH(I) - F0=PMD(I)*PGD(I)/((PMG(I)**2-PMD(I)**2)**2+ - & (PMD(I)*PGD(I))**2)/PARU(1) - F1=1D0 - F2=1D0/PMG(I)**2 - F3=1D0/PMG(I)**4 - FI0=(ATV-ATL(I))/PARU(1) - FI1=PMV**2-PML(I)**2 - FI2=2D0*LOG(PMV/PML(I)) - FI3=1D0/PML(I)**2-1D0/PMV**2 - IF((ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR.ISUB.EQ.30.OR. - & ISUB.EQ.35).AND.MSTP(43).NE.2) THEN - VINT(80)=VINT(80)*20D0/(8D0+(FI0/F0)*(F1/FI1+6D0*F2/FI2+ - & 5D0*F3/FI3)) - ELSE - VINT(80)=VINT(80)*10D0/(8D0+(FI0/F0)*(F1/FI1+F2/FI2)) - ENDIF - VINT(80)=VINT(80)*FI0 - 280 CONTINUE - IF(MEQL.GE.1) VINT(80)=2D0*VINT(80) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYONIA -C...Generates Upsilon and toponium decays into three gluons -C...or two gluons and a photon. - - SUBROUTINE PYONIA(KFL,ECM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Printout. Check input parameters. - IF(MSTU(12).GE.1) CALL PYLIST(0) - IF(KFL.LT.0.OR.KFL.GT.8) THEN - CALL PYERRM(16,'(PYONIA:) called with unknown flavour code') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(ECM.LT.PARJ(127)+2.02D0*PARF(101)) THEN - CALL PYERRM(16,'(PYONIA:) 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 PY1ENT(NC-1,11,0.5D0*ECM,0D0,0D0) - K(NC-1,1)=21 - CALL PY1ENT(NC,-11,0.5D0*ECM,PARU(1),0D0) - 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 PY1ENT(NC,KF,ECM,0D0,0D0) - 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=PYR(0) - X2=PYR(0) - X3=2D0-X1-X2 - IF(X3.GE.1D0.OR.((1D0-X1)/(X2*X3))**2+((1D0-X2)/(X1*X3))**2+ - &((1D0-X3)/(X1*X2))**2.LE.2D0*PYR(0)) GOTO 100 - NTRY=NTRY+1 - NJET=3 - IF(MSTJ(101).LE.4) CALL PY3ENT(NC+1,21,21,21,ECM,X1,X3) - IF(MSTJ(101).GE.5) CALL PY3ENT(-(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=0D0 - IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3D0 - RGAM=7.2D0*QF**2*PARU(101)/PYALPS(ECM**2) - MK=0 - ECMC=ECM - IF(PYR(0).GT.RGAM/(1D0+RGAM)) THEN - IF(1D0-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) - & NJET=2 - IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL PY2ENT(NC+1,21,21,ECM) - IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL PY2ENT(-(NC+1),21,21,ECM) - ELSE - MK=1 - ECMC=SQRT(1D0-X1)*ECM - IF(ECMC.LT.2D0*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.4D0*PARJ(127)) THEN - MSTU10=MSTU(10) - MSTU(10)=1 - P(NC+2,5)=ECMC - CALL PY1ENT(NC+2,83,0.5D0*(X2+X3)*ECM,PARU(1),0D0) - 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(2D0) - HF1=1D0-PARJ(131)*PARJ(132) - HF3=PARJ(133)**2 - CT13=(X1*X3-2D0*X1-2D0*X3+2D0)/(X1*X3) - ST13=SQRT(1D0-CT13**2) - SIGL=0.5D0*X3**2*((1D0-X2)**2+(1D0-X3)**2)*ST13**2 - SIGU=(X1*(1D0-X1))**2+(X2*(1D0-X2))**2+(X3*(1D0-X3))**2-SIGL - SIGT=0.5D0*SIGL - SIGI=(SIGL*CT13/ST13+0.5D0*X1*X3*(1D0-X2)**2*ST13)/SQ2 - SIGMAX=(2D0*HF1+HF3)*ABS(SIGU)+2D0*(HF1+HF3)*ABS(SIGL)+2D0*(HF1+ - & 2D0*HF3)*ABS(SIGT)+2D0*SQ2*(HF1+2D0*HF3)*ABS(SIGI) - -C...Angular orientation of event. - 120 CHI=PARU(2)*PYR(0) - CTHE=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2D0*CHI) - S2CHI=SIN(2D0*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2D0*(PHI-PARJ(134))) - S2PHI=SIN(2D0*(PHI-PARJ(134))) - SIG=((1D0+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2D0*(STHE**2*HF1- - & STHE**2*C2PHI*HF3)*SIGL+2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)* - & C2CHI*C2PHI-2D0*CTHE*S2CHI*S2PHI)*HF3)*SIGT- - & 2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE* - & (CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI - IF(SIG.LT.SIGMAX*PYR(0)) GOTO 120 - CALL PYROBO(NC+1,N,0D0,CHI,0D0,0D0,0D0) - CALL PYROBO(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 PYSHOW(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 PYPREP(0) - MSTJ(14)=MSTJ14 - IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 - ENDIF - -C...Generate fragmentation. Information for PYTABU: - IF(MSTJ(105).EQ.1) CALL PYEXEC - MSTU(161)=110*KFLC+3 - MSTU(162)=0 - - RETURN - END - -C********************************************************************* - -C...PYOPER -C...Performs operations between histograms. - - SUBROUTINE PYOPER(ID1,OPER,ID2,ID3,F1,F2) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblock. - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYBINS/ -C...Character variable. - CHARACTER OPER*(*) - -C...Find initial addresses in memory, and histogram size. - IF(ID1.LE.0.OR.ID1.GT.IHIST(1)) CALL PYERRM(28, - &'(PYFACT:) not allowed histogram number') - IS1=INDX(ID1) - IS2=INDX(MIN(IHIST(1),MAX(1,ID2))) - IS3=INDX(MIN(IHIST(1),MAX(1,ID3))) - NX=NINT(BIN(IS3+1)) - IF(OPER.EQ.'M'.AND.ID3.EQ.0) NX=NINT(BIN(IS2+1)) - -C...Update info on number of histogram entries. - IF(OPER.EQ.'+'.OR.OPER.EQ.'-'.OR.OPER.EQ.'*'.OR.OPER.EQ.'/') THEN - BIN(IS3+5)=BIN(IS1+5)+BIN(IS2+5) - ELSEIF(OPER.EQ.'A'.OR.OPER.EQ.'S'.OR.OPER.EQ.'L') THEN - BIN(IS3+5)=BIN(IS1+5) - ENDIF - -C...Operations on pair of histograms: addition, subtraction, -C...multiplication, division. - IF(OPER.EQ.'+') THEN - DO 100 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)+F2*BIN(IS2+IX) - 100 CONTINUE - ELSEIF(OPER.EQ.'-') THEN - DO 110 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)-F2*BIN(IS2+IX) - 110 CONTINUE - ELSEIF(OPER.EQ.'*') THEN - DO 120 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)*F2*BIN(IS2+IX) - 120 CONTINUE - ELSEIF(OPER.EQ.'/') THEN - DO 130 IX=6,8+NX - FA2=F2*BIN(IS2+IX) - IF(ABS(FA2).LE.1D-20) THEN - BIN(IS3+IX)=0D0 - ELSE - BIN(IS3+IX)=F1*BIN(IS1+IX)/FA2 - ENDIF - 130 CONTINUE - -C...Operations on single histogram: multiplication+addition, -C...square root+addition, logarithm+addition. - ELSEIF(OPER.EQ.'A') THEN - DO 140 IX=6,8+NX - BIN(IS3+IX)=F1*BIN(IS1+IX)+F2 - 140 CONTINUE - ELSEIF(OPER.EQ.'S') THEN - DO 150 IX=6,8+NX - BIN(IS3+IX)=F1*SQRT(MAX(0D0,BIN(IS1+IX)))+F2 - 150 CONTINUE - ELSEIF(OPER.EQ.'L') THEN - ZMIN=1D20 - DO 160 IX=9,8+NX - IF(BIN(IS1+IX).LT.ZMIN.AND.BIN(IS1+IX).GT.1D-20) - & ZMIN=0.8D0*BIN(IS1+IX) - 160 CONTINUE - DO 170 IX=6,8+NX - BIN(IS3+IX)=F1*LOG10(MAX(ZMIN,BIN(IS1+IX)))+F2 - 170 CONTINUE - -C...Operation on two or three histograms: average and -C...standard deviation. - ELSEIF(OPER.EQ.'M') THEN - DO 180 IX=6,8+NX - IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN - BIN(IS2+IX)=0D0 - ELSE - BIN(IS2+IX)=BIN(IS2+IX)/BIN(IS1+IX) - ENDIF - IF(ID3.NE.0) THEN - IF(ABS(BIN(IS1+IX)).LE.1D-20) THEN - BIN(IS3+IX)=0D0 - ELSE - BIN(IS3+IX)=SQRT(MAX(0D0,BIN(IS3+IX)/BIN(IS1+IX)- - & BIN(IS2+IX)**2)) - ENDIF - ENDIF - BIN(IS1+IX)=F1*BIN(IS1+IX) - 180 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDEL -C...Gives electron (or muon, or tau) parton distribution. - - SUBROUTINE PYPDEL(KFA,X,Q2,XPEL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPEL(-25:25),XPGA(-6:6),SXP(0:6) - -C...Interface to PDFLIB. - COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX - SAVE /W50513/ - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, - &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Some common constants. - DO 100 KFL=-25,25 - XPEL(KFL)=0D0 - 100 CONTINUE - AEM=PARU(101) - PME=PMAS(11,1) - IF(KFA.EQ.13) PME=PMAS(13,1) - IF(KFA.EQ.15) PME=PMAS(15,1) - XL=LOG(MAX(1D-10,X)) - X1L=LOG(MAX(1D-10,1D0-X)) - HLE=LOG(MAX(3D0,Q2/PME**2)) - HBE2=(AEM/PARU(1))*(HLE-1D0) - -C...Electron inside electron, see R. Kleiss et al., in Z physics at -C...LEP 1, CERN 89-08, p. 34 - IF(MSTP(59).LE.1) THEN - HDE=1D0+(AEM/PARU(1))*(1.5D0*HLE+1.289868D0)+(AEM/PARU(1))**2* - & (-2.164868D0*HLE**2+9.840808D0*HLE-10.130464D0) - HEE=HBE2*(1D0-X)**(HBE2-1D0)*SQRT(MAX(0D0,HDE))- - & 0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)*(-4D0*X1L+3D0*XL)- - & 4D0*XL/(1D0-X)-5D0-X) - ELSE - HEE=HBE2*(1D0-X)**(HBE2-1D0)*EXP(0.172784D0*HBE2)/ - & PYGAMM(1D0+HBE2)-0.5D0*HBE2*(1D0+X)+HBE2**2/8D0*((1D0+X)* - & (-4D0*X1L+3D0*XL)-4D0*XL/(1D0-X)-5D0-X) - ENDIF -C...Zero distribution for very large x and rescale it for intermediate. - IF(X.GT.1D0-1D-10) THEN - HEE=0D0 - ELSEIF(X.GT.1D0-1D-7) THEN - HEE=HEE*1000D0**HBE2/(1000D0**HBE2-1D0) - ENDIF - XPEL(KFA)=X*HEE - -C...Photon and (transverse) W- inside electron. - AEMP=PYALEM(PME*SQRT(MAX(0D0,Q2)))/PARU(2) - IF(MSTP(13).LE.1) THEN - HLG=HLE - ELSE - HLG=LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-X)/X**2)) - ENDIF - XPEL(22)=AEMP*HLG*(1D0+(1D0-X)**2) - HLW=LOG(1D0+Q2/PMAS(24,1)**2)/(4D0*PARU(102)) - XPEL(-24)=AEMP*HLW*(1D0+(1D0-X)**2) - -C...Electron or positron inside photon inside electron. - IF(KFA.EQ.11.AND.MSTP(12).EQ.1) THEN - XFSEA=0.5D0*(AEMP*(HLE-1D0))**2*(4D0/3D0+X-X**2-4D0*X**3/3D0+ - & 2D0*X*(1D0+X)*XL) - XPEL(11)=XPEL(11)+XFSEA - XPEL(-11)=XFSEA - -C...Initialize PDFLIB photon parton distributions. - IF(MSTP(56).EQ.2) THEN - PARM(1)='NPTYPE' - VALUE(1)=3 - PARM(2)='NGROUP' - VALUE(2)=MSTP(55)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(55),1000) - IF(MINT(93).NE.3000000+MSTP(55)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=3000000+MSTP(55) - ENDIF - ENDIF - -C...Quarks and gluons inside photon inside electron: -C...numerical convolution required. - DO 110 KFL=0,6 - SXP(KFL)=0D0 - 110 CONTINUE - SUMXPP=0D0 - ITER=-1 - 120 ITER=ITER+1 - SUMXP=SUMXPP - NSTP=2**(ITER-1) - IF(ITER.EQ.0) NSTP=2 - DO 130 KFL=0,6 - SXP(KFL)=0.5D0*SXP(KFL) - 130 CONTINUE - WTSTP=0.5D0/NSTP - IF(ITER.EQ.0) WTSTP=0.5D0 -C...Pick grid of x_{gamma} values logarithmically even. - DO 150 ISTP=1,NSTP - IF(ITER.EQ.0) THEN - XLE=XL*(ISTP-1) - ELSE - XLE=XL*(ISTP-0.5D0)/NSTP - ENDIF - XE=MIN(1D0-1D-10,EXP(XLE)) - XG=MIN(1D0-1D-10,X/XE) -C...Evaluate photon inside electron parton distribution for convolution. - XPGP=1D0+(1D0-XE)**2 - IF(MSTP(13).LE.1) THEN - XPGP=XPGP*HLE - ELSE - XPGP=XPGP*LOG(MAX(1D0,(PARP(13)/PME**2)*(1D0-XE)/XE**2)) - ENDIF -C...Evaluate photon parton distributions for convolution. - IF(MSTP(56).EQ.1) THEN - IF(MSTP(55).EQ.1) THEN - CALL PYPDGA(XG,Q2,XPGA) - ELSEIF(MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.7) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) - VINT(231)=P2MX - ELSEIF(MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.11) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,XG,Q2MX,P2,MSTP(60),F2GAM,XPGA) - VINT(231)=P2MX - ENDIF - DO 140 KFL=0,5 - SXP(KFL)=SXP(KFL)+WTSTP*XPGP*XPGA(KFL) - 140 CONTINUE - ELSEIF(MSTP(56).EQ.2) THEN -C...Call PDFLIB parton distributions. - XX=XG - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - SXP(0)=SXP(0)+WTSTP*XPGP*GLU - SXP(1)=SXP(1)+WTSTP*XPGP*DNV - SXP(2)=SXP(2)+WTSTP*XPGP*UPV - SXP(3)=SXP(3)+WTSTP*XPGP*STR - SXP(4)=SXP(4)+WTSTP*XPGP*CHM - SXP(5)=SXP(5)+WTSTP*XPGP*BOT - SXP(6)=SXP(6)+WTSTP*XPGP*TOP - ENDIF - 150 CONTINUE - SUMXPP=SXP(0)+2D0*SXP(1)+2D0*SXP(2) - IF(ITER.LE.2.OR.(ITER.LE.7.AND.ABS(SUMXPP-SUMXP).GT. - & PARP(14)*(SUMXPP+SUMXP))) GOTO 120 - -C...Put convolution into output arrays. - FCONV=AEMP*(-XL) - XPEL(0)=FCONV*SXP(0) - DO 160 KFL=1,6 - XPEL(KFL)=FCONV*SXP(KFL) - XPEL(-KFL)=XPEL(KFL) - 160 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDFL -C...Gives proton parton distribution at small x and/or Q^2 according to -C...correct limiting behaviour. - - SUBROUTINE PYPDFL(KF,X,Q2,XPQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPQ(-25:25),XPA(-25:25),XPB(-25:25),WTSB(-3:3) - DATA RMR/0.92D0/,RMP/0.38D0/,WTSB/0.5D0,1D0,1D0,5D0,1D0,1D0,0.5D0/ - -C...Send everything but protons/neutrons/VMD pions directly to PYPDFU. - MINT(92)=0 - KFA=IABS(KF) - IACC=0 - IF((KFA.EQ.2212.OR.KFA.EQ.2112).AND.MSTP(57).GE.2) IACC=1 - IF(KFA.EQ.211.AND.MSTP(57).GE.3) IACC=1 - IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND.MSTP(57).GE.3) IACC=1 - IF(IACC.EQ.0) THEN - CALL PYPDFU(KF,X,Q2,XPQ) - RETURN - ENDIF - -C...Reset. Check x. - DO 100 KFL=-25,25 - XPQ(KFL)=0D0 - 100 CONTINUE - IF(X.LE.0D0.OR.X.GE.1D0) THEN - WRITE(MSTU(11),5000) X - RETURN - ENDIF - -C...Define valence content. - KFC=KF - NV1=2 - NV2=1 - IF(KF.EQ.2212) THEN - KFV1=2 - KFV2=1 - ELSEIF(KF.EQ.-2212) THEN - KFV1=-2 - KFV2=-1 - ELSEIF(KF.EQ.2112) THEN - KFV1=1 - KFV2=2 - ELSEIF(KF.EQ.-2112) THEN - KFV1=-1 - KFV2=-2 - ELSEIF(KF.EQ.211) THEN - NV1=1 - KFV1=2 - KFV2=-1 - ELSEIF(KF.EQ.-211) THEN - NV1=1 - KFV1=-2 - KFV2=1 - ELSEIF(MINT(105).LE.223) THEN - KFV1=1 - WTV1=0.2D0 - KFV2=2 - WTV2=0.8D0 - ELSEIF(MINT(105).EQ.333) THEN - KFV1=3 - WTV1=1.0D0 - KFV2=1 - WTV2=0.0D0 - ELSEIF(MINT(105).EQ.443) THEN - KFV1=4 - WTV1=1.0D0 - KFV2=1 - WTV2=0.0D0 - ENDIF - -C...Do naive evaluation and find min Q^2, boundary Q^2 and x_0. - CALL PYPDFU(KFC,X,Q2,XPA) - Q2MN=MAX(3D0,VINT(231)) - Q2B=2D0+0.052D0**2*EXP(3.56D0*SQRT(MAX(0D0,-LOG(3D0*X)))) - XMN=EXP(-(LOG((Q2MN-2D0)/0.052D0**2)/3.56D0)**2)/3D0 - -C...Large Q2 and large x: naive call is enough. - IF(Q2.GT.Q2MN.AND.Q2.GT.Q2B) THEN - DO 110 KFL=-25,25 - XPQ(KFL)=XPA(KFL) - 110 CONTINUE - MINT(92)=1 - -C...Small Q2 and large x: dampen boundary value. - ELSEIF(X.GT.XMN) THEN - -C...Evaluate at boundary and define dampening factors. - CALL PYPDFU(KFC,X,Q2MN,XPA) - FV=(Q2*(Q2MN+RMR)/(Q2MN*(Q2+RMR)))**(0.55D0*(1D0-X)/(1D0-XMN)) - FS=(Q2*(Q2MN+RMP)/(Q2MN*(Q2+RMP)))**1.08D0 - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFV1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFV2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) - XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) - XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) - XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) - ENDIF - -C...Dampen valence and sea separately. Put back together. - DO 120 KFL=-25,25 - XPQ(KFL)=FS*XPA(KFL) - 120 CONTINUE - IF(KFA.NE.22) THEN - XPQ(KFV1)=XPQ(KFV1)+FV*XFV1 - XPQ(KFV2)=XPQ(KFV2)+FV*XFV2 - ELSE - XPQ(KFV1)=XPQ(KFV1)+FV*WTV1*VINT(232) - XPQ(-KFV1)=XPQ(-KFV1)+FV*WTV1*VINT(232) - XPQ(KFV2)=XPQ(KFV2)+FV*WTV2*VINT(232) - XPQ(-KFV2)=XPQ(-KFV2)+FV*WTV2*VINT(232) - ENDIF - MINT(92)=2 - -C...Large Q2 and small x: interpolate behaviour. - ELSEIF(Q2.GT.Q2MN) THEN - -C...Evaluate at extremes and define coefficients for interpolation. - CALL PYPDFU(KFC,XMN,Q2MN,XPA) - VI232A=VINT(232) - CALL PYPDFU(KFC,X,Q2B,XPB) - VI232B=VINT(232) - FLA=LOG(Q2B/Q2)/LOG(Q2B/Q2MN) - FVA=(X/XMN)**0.45D0*FLA - FSA=(X/XMN)**(-0.08D0)*FLA - FB=1D0-FLA - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFVA1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFVA2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - XFVB1=XPB(KFV1)-XPB(-KFV1) - XPB(KFV1)=XPB(-KFV1) - XFVB2=XPB(KFV2)-XPB(-KFV2) - XPB(KFV2)=XPB(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VI232A - XPA(-KFV1)=XPA(-KFV1)-WTV1*VI232A - XPA(KFV2)=XPA(KFV2)-WTV2*VI232A - XPA(-KFV2)=XPA(-KFV2)-WTV2*VI232A - XPB(KFV1)=XPB(KFV1)-WTV1*VI232B - XPB(-KFV1)=XPB(-KFV1)-WTV1*VI232B - XPB(KFV2)=XPB(KFV2)-WTV2*VI232B - XPB(-KFV2)=XPB(-KFV2)-WTV2*VI232B - ENDIF - -C...Interpolate for valence and sea. Put back together. - DO 130 KFL=-25,25 - XPQ(KFL)=FSA*XPA(KFL)+FB*XPB(KFL) - 130 CONTINUE - IF(KFA.NE.22) THEN - XPQ(KFV1)=XPQ(KFV1)+(FVA*XFVA1+FB*XFVB1) - XPQ(KFV2)=XPQ(KFV2)+(FVA*XFVA2+FB*XFVB2) - ELSE - XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VI232A+FB*VI232B) - XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VI232A+FB*VI232B) - XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VI232A+FB*VI232B) - XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VI232A+FB*VI232B) - ENDIF - MINT(92)=3 - -C...Small Q2 and small x: dampen boundary value and add term. - ELSE - -C...Evaluate at boundary and define dampening factors. - CALL PYPDFU(KFC,XMN,Q2MN,XPA) - FB=(XMN-X)*(Q2MN-Q2)/(XMN*Q2MN) - FA=1D0-FB - FVC=(X/XMN)**0.45D0*(Q2/(Q2+RMR))**0.55D0 - FVA=FVC*FA*((Q2MN+RMR)/Q2MN)**0.55D0 - FVB=FVC*FB*1.10D0*XMN**0.45D0*0.11D0 - FSC=(X/XMN)**(-0.08D0)*(Q2/(Q2+RMP))**1.08D0 - FSA=FSC*FA*((Q2MN+RMP)/Q2MN)**1.08D0 - FSB=FSC*FB*0.21D0*XMN**(-0.08D0)*0.21D0 - -C...Separate valence and sea parts of parton distribution. - IF(KFA.NE.22) THEN - XFV1=XPA(KFV1)-XPA(-KFV1) - XPA(KFV1)=XPA(-KFV1) - XFV2=XPA(KFV2)-XPA(-KFV2) - XPA(KFV2)=XPA(-KFV2) - ELSE - XPA(KFV1)=XPA(KFV1)-WTV1*VINT(232) - XPA(-KFV1)=XPA(-KFV1)-WTV1*VINT(232) - XPA(KFV2)=XPA(KFV2)-WTV2*VINT(232) - XPA(-KFV2)=XPA(-KFV2)-WTV2*VINT(232) - ENDIF - -C...Dampen valence and sea separately. Add constant terms. -C...Put back together. - DO 140 KFL=-25,25 - XPQ(KFL)=FSA*XPA(KFL) - 140 CONTINUE - IF(KFA.NE.22) THEN - DO 150 KFL=-3,3 - XPQ(KFL)=XPQ(KFL)+FSB*WTSB(KFL) - 150 CONTINUE - XPQ(KFV1)=XPQ(KFV1)+(FVA*XFV1+FVB*NV1) - XPQ(KFV2)=XPQ(KFV2)+(FVA*XFV2+FVB*NV2) - ELSE - DO 160 KFL=-3,3 - XPQ(KFL)=XPQ(KFL)+VINT(281)*FSB*WTSB(KFL) - 160 CONTINUE - XPQ(KFV1)=XPQ(KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(-KFV1)=XPQ(-KFV1)+WTV1*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(KFV2)=XPQ(KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) - XPQ(-KFV2)=XPQ(-KFV2)+WTV2*(FVA*VINT(232)+FVB*VINT(281)) - ENDIF - XPQ(21)=XPQ(0) - MINT(92)=4 - ENDIF - -C...Format for error printout. - 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) - - RETURN - END - -C********************************************************************* - -C...PYPDFU -C...Gives electron, muon, tau, photon, pi+, neutron, proton and hyperon -C...parton distributions according to a few different parametrizations. -C...Note that what is coded is x times the probability distribution, -C...i.e. xq(x,Q2) etc. - - SUBROUTINE PYPDFU(KF,X,Q2,XPQ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT8/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6), - &XPDIR(-6:6) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT8/ -C...Local arrays. - DIMENSION XPQ(-25:25),XPEL(-25:25),XPGA(-6:6),VXPGA(-6:6), - &XPPI(-6:6),XPPR(-6:6) - -C...Interface to PDFLIB. - COMMON/W50513/XMIN,XMAX,Q2MIN,Q2MAX - SAVE /W50513/ - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU, - &VALUE(20),XMIN,XMAX,Q2MIN,Q2MAX - CHARACTER*20 PARM(20) - DATA VALUE/20*0D0/,PARM/20*' '/ - -C...Data related to Schuler-Sjostrand photon distributions. - DATA ALAMGA/0.2D0/, PMCGA/1.3D0/, PMBGA/4.6D0/ - -C...Reset parton distributions. - MINT(92)=0 - DO 100 KFL=-25,25 - XPQ(KFL)=0D0 - 100 CONTINUE - -C...Check x and particle species. - IF(X.LE.0D0.OR.X.GE.1D0) THEN - WRITE(MSTU(11),5000) X - RETURN - ENDIF - KFA=IABS(KF) - IF(KFA.NE.11.AND.KFA.NE.13.AND.KFA.NE.15.AND.KFA.NE.22.AND. - &KFA.NE.211.AND.KFA.NE.2112.AND.KFA.NE.2212.AND.KFA.NE.3122.AND. - &KFA.NE.3112.AND.KFA.NE.3212.AND.KFA.NE.3222.AND.KFA.NE.3312.AND. - &KFA.NE.3322.AND.KFA.NE.3334.AND.KFA.NE.111.AND.KFA.NE.321.AND. - &KFA.NE.310.AND.KFA.NE.130) THEN - WRITE(MSTU(11),5100) KF - RETURN - ENDIF - -C...Electron (or muon or tau) parton distribution call. - IF(KFA.EQ.11.OR.KFA.EQ.13.OR.KFA.EQ.15) THEN - CALL PYPDEL(KFA,X,Q2,XPEL) - DO 110 KFL=-25,25 - XPQ(KFL)=XPEL(KFL) - 110 CONTINUE - -C...Photon parton distribution call (VDM+anomalous). - ELSEIF(KFA.EQ.22.AND.MINT(109).LE.1) THEN - IF(MSTP(56).EQ.1.AND.MSTP(55).EQ.1) THEN - CALL PYPDGA(X,Q2,XPGA) - DO 120 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 120 CONTINUE - ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND.MSTP(55).LE.8) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.7) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 130 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 130 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.1.AND.MSTP(55).GE.9.AND.MSTP(55).LE.12) THEN - Q2MX=Q2 - P2MX=0.36D0 - IF(MSTP(55).GE.11) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 140 KFL=-6,6 - XPQ(KFL)=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL) - 140 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=3 - PARM(2)='NGROUP' - VALUE(2)=MSTP(55)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(55),1000) - IF(MINT(93).NE.3000000+MSTP(55)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=3000000+MSTP(55) - ENDIF - XX=X - QQ2=MAX(0D0,Q2MIN,Q2) - IF(MSTP(57).EQ.0) QQ2=Q2MIN - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - IP2=MSTP(60) - IF(MSTP(55).EQ.5004) THEN - IF(5D0*P2.LT.QQ2.AND. - & QQ2.GT.0.6D0.AND.QQ2.LT.5D4.AND. - & P2.GE.0D0.AND.P2.LT.10D0.AND. - & XX.GT.1D-4.AND.XX.LT.1D0) THEN - CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - & BOT,TOP,GLU) - ELSE - UPV=0D0 - DNV=0D0 - USEA=0D0 - DSEA=0D0 - STR=0D0 - CHM=0D0 - BOT=0D0 - TOP=0D0 - GLU=0D0 - ENDIF - ELSE - IF(P2.LT.QQ2) THEN - CALL STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - & BOT,TOP,GLU) - ELSE - UPV=0D0 - DNV=0D0 - USEA=0D0 - DSEA=0D0 - STR=0D0 - CHM=0D0 - BOT=0D0 - TOP=0D0 - GLU=0D0 - ENDIF - ENDIF - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DNV - XPQ(-1)=DNV - XPQ(2)=UPV - XPQ(-2)=UPV - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(56),MSTP(55) - ENDIF - -C...Pion/gammaVDM parton distribution call. - ELSEIF(KFA.EQ.211.OR.KFA.EQ.111.OR.KFA.EQ.321.OR.KFA.EQ.130.OR. - &KFA.EQ.310.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN - IF(KFA.EQ.22.AND.MSTP(56).EQ.1.AND.MSTP(55).GE.5.AND. - & MSTP(55).LE.12) THEN - ISET=1+MOD(MSTP(55)-1,4) - Q2MX=Q2 - P2MX=0.36D0 - IF(ISET.GE.3) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(ISET,X,Q2MX,P2,MSTP(60),F2GAM,XPGA) - DO 150 KFL=-6,6 - XPQ(KFL)=XPVMD(KFL) - 150 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(54).EQ.1.AND.MSTP(53).GE.1.AND.MSTP(53).LE.3) THEN - CALL PYPDPI(X,Q2,XPPI) - DO 160 KFL=-6,6 - XPQ(KFL)=XPPI(KFL) - 160 CONTINUE - ELSEIF(MSTP(54).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=2 - PARM(2)='NGROUP' - VALUE(2)=MSTP(53)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(53),1000) - IF(MINT(93).NE.2000000+MSTP(53)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=2000000+MSTP(53) - ENDIF - XX=X - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DSEA - XPQ(-1)=UPV+DSEA - XPQ(2)=UPV+USEA - XPQ(-2)=USEA - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(54),MSTP(53) - ENDIF - -C...Anomalous photon parton distribution call. - ELSEIF(KFA.EQ.22.AND.MINT(109).EQ.3) THEN - Q2MX=Q2 - P2MX=PARP(15)**2 - IF(MSTP(56).EQ.1.AND.MSTP(55).LE.8) THEN - IF(MSTP(55).EQ.5.OR.MSTP(55).EQ.6) P2MX=0.36D0 - IF(MSTP(55).EQ.7.OR.MSTP(55).EQ.8) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-4,X,Q2MX,P2,MSTP(60),F2GM,XPGA) - DO 170 KFL=-6,6 - XPQ(KFL)=XPANL(KFL)+XPANH(KFL) - 170 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.1) THEN - IF(MSTP(55).EQ.9.OR.MSTP(55).EQ.10) P2MX=0.36D0 - IF(MSTP(55).EQ.11.OR.MSTP(55).EQ.12) P2MX=4.0D0 - IF(MSTP(57).EQ.0) Q2MX=P2MX - P2=0D0 - IF(VINT(120).LT.0D0) P2=VINT(120)**2 - CALL PYGGAM(MSTP(55)-8,X,Q2MX,P2,MSTP(60),F2GM,XPGA) - DO 180 KFL=-6,6 - XPQ(KFL)=MAX(0D0,XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)) - 180 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(56).EQ.2) THEN - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGANO(0,X,Q2MX,P2MX,ALAMGA,XPGA,VXPGA) - DO 190 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 190 CONTINUE - VINT(231)=P2MX - ELSEIF(MSTP(55).GE.1.AND.MSTP(55).LE.5) THEN - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGVMD(0,MSTP(55),X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) - DO 200 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 200 CONTINUE - VINT(231)=P2MX - ELSE - 210 RKF=11D0*PYR(0) - KFR=1 - IF(RKF.GT.1D0) KFR=2 - IF(RKF.GT.5D0) KFR=3 - IF(RKF.GT.6D0) KFR=4 - IF(RKF.GT.10D0) KFR=5 - IF(KFR.EQ.4.AND.Q2.LT.PMCGA**2) GOTO 210 - IF(KFR.EQ.5.AND.Q2.LT.PMBGA**2) GOTO 210 - IF(MSTP(57).EQ.0) Q2MX=P2MX - CALL PYGVMD(0,KFR,X,Q2MX,P2MX,PARP(1),XPGA,VXPGA) - DO 220 KFL=-6,6 - XPQ(KFL)=XPGA(KFL) - 220 CONTINUE - VINT(231)=P2MX - ENDIF - -C...Proton parton distribution call. - ELSE - IF(MSTP(52).EQ.1.AND.MSTP(51).GE.1.AND.MSTP(51).LE.20) THEN - CALL PYPDPR(X,Q2,XPPR) - DO 230 KFL=-6,6 - XPQ(KFL)=XPPR(KFL) - 230 CONTINUE - ELSEIF(MSTP(52).EQ.2) THEN -C...Call PDFLIB parton distributions. - PARM(1)='NPTYPE' - VALUE(1)=1 - PARM(2)='NGROUP' - VALUE(2)=MSTP(51)/1000 - PARM(3)='NSET' - VALUE(3)=MOD(MSTP(51),1000) - IF(MINT(93).NE.1000000+MSTP(51)) THEN - CALL PDFSET(PARM,VALUE) - MINT(93)=1000000+MSTP(51) - ENDIF - XX=X - QQ=SQRT(MAX(0D0,Q2MIN,Q2)) - IF(MSTP(57).EQ.0) QQ=SQRT(Q2MIN) - CALL STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - VINT(231)=Q2MIN - XPQ(0)=GLU - XPQ(1)=DNV+DSEA - XPQ(-1)=DSEA - XPQ(2)=UPV+USEA - XPQ(-2)=USEA - XPQ(3)=STR - XPQ(-3)=STR - XPQ(4)=CHM - XPQ(-4)=CHM - XPQ(5)=BOT - XPQ(-5)=BOT - XPQ(6)=TOP - XPQ(-6)=TOP - ELSE - WRITE(MSTU(11),5200) KF,MSTP(52),MSTP(51) - ENDIF - ENDIF - -C...Isospin average for pi0/gammaVDM. - IF(KFA.EQ.111.OR.(KFA.EQ.22.AND.MINT(109).EQ.2)) THEN - IF(KFA.EQ.22.AND.MSTP(55).GE.5.AND.MSTP(55).LE.12) THEN - XPV=XPQ(2)-XPQ(1) - XPQ(2)=XPQ(1) - XPQ(-2)=XPQ(-1) - ELSE - XPS=0.5D0*(XPQ(1)+XPQ(-2)) - XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS - XPQ(2)=XPS - XPQ(-1)=XPS - ENDIF - IF(KFA.EQ.22.AND.MINT(105).LE.223) THEN - XPQ(1)=XPQ(1)+0.2D0*XPV - XPQ(-1)=XPQ(-1)+0.2D0*XPV - XPQ(2)=XPQ(2)+0.8D0*XPV - XPQ(-2)=XPQ(-2)+0.8D0*XPV - ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.333) THEN - XPQ(3)=XPQ(3)+XPV - XPQ(-3)=XPQ(-3)+XPV - ELSEIF(KFA.EQ.22.AND.MINT(105).EQ.443) THEN - XPQ(4)=XPQ(4)+XPV - XPQ(-4)=XPQ(-4)+XPV - IF(MSTP(55).GE.9) THEN - DO 240 KFL=-6,6 - XPQ(KFL)=0D0 - 240 CONTINUE - ENDIF - ELSE - XPQ(1)=XPQ(1)+0.5D0*XPV - XPQ(-1)=XPQ(-1)+0.5D0*XPV - XPQ(2)=XPQ(2)+0.5D0*XPV - XPQ(-2)=XPQ(-2)+0.5D0*XPV - ENDIF - -C...Rescale for gammaVDM by effective gamma -> rho coupling. -C+++Do not rescale? - IF(KFA.EQ.22.AND.MINT(109).EQ.2.AND..NOT.(MSTP(56).EQ.1 - & .AND.MSTP(55).GE.5.AND.MSTP(55).LE.12)) THEN - DO 250 KFL=-6,6 - XPQ(KFL)=VINT(281)*XPQ(KFL) - 250 CONTINUE - VINT(232)=VINT(281)*XPV - ENDIF - -C...Simple recipes for kaons. - ELSEIF(KFA.EQ.321) THEN - XPQ(-3)=XPQ(-3)+XPQ(-1)-XPQ(1) - XPQ(-1)=XPQ(1) - ELSEIF(KFA.EQ.130.OR.KFA.EQ.310) THEN - XPS=0.5D0*(XPQ(1)+XPQ(-2)) - XPV=0.5D0*(XPQ(2)+XPQ(-1))-XPS - XPQ(2)=XPS - XPQ(-1)=XPS - XPQ(1)=XPQ(1)+0.5D0*XPV - XPQ(-1)=XPQ(-1)+0.5D0*XPV - XPQ(3)=XPQ(3)+0.5D0*XPV - XPQ(-3)=XPQ(-3)+0.5D0*XPV - -C...Isospin conjugation for neutron. - ELSEIF(KFA.EQ.2112) THEN - XPS=XPQ(1) - XPQ(1)=XPQ(2) - XPQ(2)=XPS - XPS=XPQ(-1) - XPQ(-1)=XPQ(-2) - XPQ(-2)=XPS - -C...Simple recipes for hyperon (average valence parton distribution). - ELSEIF(KFA.EQ.3122.OR.KFA.EQ.3112.OR.KFA.EQ.3212.OR.KFA.EQ.3222 - & .OR.KFA.EQ.3312.OR.KFA.EQ.3322.OR.KFA.EQ.3334) THEN - XPVAL=(XPQ(1)+XPQ(2)-XPQ(-1)-XPQ(-2))/3D0 - XPSEA=0.5D0*(XPQ(-1)+XPQ(-2)) - XPQ(1)=XPSEA - XPQ(2)=XPSEA - XPQ(-1)=XPSEA - XPQ(-2)=XPSEA - XPQ(KFA/1000)=XPQ(KFA/1000)+XPVAL - XPQ(MOD(KFA/100,10))=XPQ(MOD(KFA/100,10))+XPVAL - XPQ(MOD(KFA/10,10))=XPQ(MOD(KFA/10,10))+XPVAL - ENDIF - -C...Charge conjugation for antiparticle. - IF(KF.LT.0) THEN - DO 260 KFL=1,25 - IF(KFL.EQ.21.OR.KFL.EQ.22.OR.KFL.EQ.23.OR.KFL.EQ.25) GOTO 260 - XPS=XPQ(KFL) - XPQ(KFL)=XPQ(-KFL) - XPQ(-KFL)=XPS - 260 CONTINUE - ENDIF - -C...Allow gluon also in position 21. - XPQ(21)=XPQ(0) - -C...Check positivity and reset above maximum allowed flavour. - DO 270 KFL=-25,25 - XPQ(KFL)=MAX(0D0,XPQ(KFL)) - IF(IABS(KFL).GT.MSTP(58).AND.IABS(KFL).LE.8) XPQ(KFL)=0D0 - 270 CONTINUE - -C...Formats for error printouts. - 5000 FORMAT(' Error: x value outside physical range; x =',1P,D12.3) - 5100 FORMAT(' Error: illegal particle code for parton distribution;', - &' KF =',I5) - 5200 FORMAT(' Error: unknown parton distribution; KF, library, set =', - &3I5) - - RETURN - END - -C********************************************************************* - -C...PYPDGA -C...Gives photon parton distribution. - - SUBROUTINE PYPDGA(X,Q2,XPGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPGA(-6:6),DGAG(4,3),DGBG(4,3),DGCG(4,3),DGAN(4,3), - &DGBN(4,3),DGCN(4,3),DGDN(4,3),DGEN(4,3),DGAS(4,3),DGBS(4,3), - &DGCS(4,3),DGDS(4,3),DGES(4,3) - -C...The following data lines are coefficients needed in the -C...Drees and Grassie photon parton distribution parametrization. - DATA DGAG/-.207D0,.6158D0,1.074D0,0.D0,.8926D-2,.6594D0, - &.4766D0,.1975D-1,.03197D0,1.018D0,.2461D0,.2707D-1/ - DATA DGBG/-.1987D0,.6257D0,8.352D0,5.024D0,.5085D-1,.2774D0, - &-.3906D0,-.3212D0,-.618D-2,.9476D0,-.6094D0,-.1067D-1/ - DATA DGCG/5.119D0,-.2752D0,-6.993D0,2.298D0,-.2313D0,.1382D0, - &6.542D0,.5162D0,-.1216D0,.9047D0,2.653D0,.2003D-2/ - DATA DGAN/2.285D0,-.1526D-1,1330.D0,4.219D0,-.3711D0,1.061D0, - &4.758D0,-.1503D-1,15.8D0,-.9464D0,-.5D0,-.2118D0/ - DATA DGBN/6.073D0,-.8132D0,-41.31D0,3.165D0,-.1717D0,.7815D0, - &1.535D0,.7067D-2,2.742D0,-.7332D0,.7148D0,3.287D0/ - DATA DGCN/-.4202D0,.1778D-1,.9216D0,.18D0,.8766D-1,.2197D-1, - &.1096D0,.204D0,.2917D-1,.4657D-1,.1785D0,.4811D-1/ - DATA DGDN/-.8083D-1,.6346D0,1.208D0,.203D0,-.8915D0,.2857D0, - &2.973D0,.1185D0,-.342D-1,.7196D0,.7338D0,.8139D-1/ - DATA DGEN/.5526D-1,1.136D0,.9512D0,.1163D-1,-.1816D0,.5866D0, - &2.421D0,.4059D0,-.2302D-1,.9229D0,.5873D0,-.79D-4/ - DATA DGAS/16.69D0,-.7916D0,1099.D0,4.428D0,-.1207D0,1.071D0, - &1.977D0,-.8625D-2,6.734D0,-1.008D0,-.8594D-1,.7625D-1/ - DATA DGBS/.176D0,.4794D-1,1.047D0,.25D-1,25.D0,-1.648D0, - &-.1563D-1,6.438D0,59.88D0,-2.983D0,4.48D0,.9686D0/ - DATA DGCS/-.208D-1,.3386D-2,4.853D0,.8404D0,-.123D-1,1.162D0, - &.4824D0,-.11D-1,-.3226D-2,.8432D0,.3616D0,.1383D-2/ - DATA DGDS/-.1685D-1,1.353D0,1.426D0,1.239D0,-.9194D-1,.7912D0, - &.6397D0,2.327D0,-.3321D-1,.9475D0,-.3198D0,.2132D-1/ - DATA DGES/-.1986D0,1.1D0,1.136D0,-.2779D0,.2015D-1,.9869D0, - &-.7036D-1,.1694D-1,.1059D0,.6954D0,-.6663D0,.3683D0/ - -C...Photon parton distribution from Drees and Grassie. -C...Allowed variable range: 1 GeV^2 < Q^2 < 10000 GeV^2. - DO 100 KFL=-6,6 - XPGA(KFL)=0D0 - 100 CONTINUE - VINT(231)=1D0 - IF(MSTP(57).LE.0) THEN - T=LOG(1D0/0.16D0) - ELSE - T=LOG(MIN(1D4,MAX(1D0,Q2))/0.16D0) - ENDIF - X1=1D0-X - NF=3 - IF(Q2.GT.25D0) NF=4 - IF(Q2.GT.300D0) NF=5 - NFE=NF-2 - AEM=PARU(101) - -C...Evaluate gluon content. - DGA=DGAG(1,NFE)*T**DGAG(2,NFE)+DGAG(3,NFE)*T**(-DGAG(4,NFE)) - DGB=DGBG(1,NFE)*T**DGBG(2,NFE)+DGBG(3,NFE)*T**(-DGBG(4,NFE)) - DGC=DGCG(1,NFE)*T**DGCG(2,NFE)+DGCG(3,NFE)*T**(-DGCG(4,NFE)) - XPGL=DGA*X**DGB*X1**DGC - -C...Evaluate up- and down-type quark content. - DGA=DGAN(1,NFE)*T**DGAN(2,NFE)+DGAN(3,NFE)*T**(-DGAN(4,NFE)) - DGB=DGBN(1,NFE)*T**DGBN(2,NFE)+DGBN(3,NFE)*T**(-DGBN(4,NFE)) - DGC=DGCN(1,NFE)*T**DGCN(2,NFE)+DGCN(3,NFE)*T**(-DGCN(4,NFE)) - DGD=DGDN(1,NFE)*T**DGDN(2,NFE)+DGDN(3,NFE)*T**(-DGDN(4,NFE)) - DGE=DGEN(1,NFE)*T**DGEN(2,NFE)+DGEN(3,NFE)*T**(-DGEN(4,NFE)) - XPQN=X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE - DGA=DGAS(1,NFE)*T**DGAS(2,NFE)+DGAS(3,NFE)*T**(-DGAS(4,NFE)) - DGB=DGBS(1,NFE)*T**DGBS(2,NFE)+DGBS(3,NFE)*T**(-DGBS(4,NFE)) - DGC=DGCS(1,NFE)*T**DGCS(2,NFE)+DGCS(3,NFE)*T**(-DGCS(4,NFE)) - DGD=DGDS(1,NFE)*T**DGDS(2,NFE)+DGDS(3,NFE)*T**(-DGDS(4,NFE)) - DGE=DGES(1,NFE)*T**DGES(2,NFE)+DGES(3,NFE)*T**(-DGES(4,NFE)) - DGF=9D0 - IF(NF.EQ.4) DGF=10D0 - IF(NF.EQ.5) DGF=55D0/6D0 - XPQS=DGF*X*(X**2+X1**2)/(DGA-DGB*LOG(X1))+DGC*X**DGD*X1**DGE - IF(NF.LE.3) THEN - XPQU=(XPQS+9D0*XPQN)/6D0 - XPQD=(XPQS-4.5D0*XPQN)/6D0 - ELSEIF(NF.EQ.4) THEN - XPQU=(XPQS+6D0*XPQN)/8D0 - XPQD=(XPQS-6D0*XPQN)/8D0 - ELSE - XPQU=(XPQS+7.5D0*XPQN)/10D0 - XPQD=(XPQS-5D0*XPQN)/10D0 - ENDIF - -C...Put into output arrays. - XPGA(0)=AEM*XPGL - XPGA(1)=AEM*XPQD - XPGA(2)=AEM*XPQU - XPGA(3)=AEM*XPQD - IF(NF.GE.4) XPGA(4)=AEM*XPQU - IF(NF.GE.5) XPGA(5)=AEM*XPQD - DO 110 KFL=1,6 - XPGA(-KFL)=XPGA(KFL) - 110 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYPDPI -C...Gives pi+ parton distribution according to two different -C...parametrizations. - - SUBROUTINE PYPDPI(X,Q2,XPPI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION XPPI(-6:6),COW(3,5,4,2),XQ(9),TS(6) - -C...The following data lines are coefficients needed in the -C...Owens pion parton distribution parametrizations, see below. -C...Expansion coefficients for up and down valence quark distributions. - DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/ - &4.0000D-01, 7.0000D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-6.2120D-02, 6.4780D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-7.1090D-03, 1.3350D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ - DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/ - &4.0000D-01, 6.2800D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-5.9090D-02, 6.4360D-01, 0.0000D+00, 0.0000D+00, 0.0000D+00, - &-6.5240D-03, 1.4510D-02, 0.0000D+00, 0.0000D+00, 0.0000D+00/ -C...Expansion coefficients for gluon distribution. - DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/ - &8.8800D-01, 0.0000D+00, 3.1100D+00, 6.0000D+00, 0.0000D+00, - &-1.8020D+00, -1.5760D+00, -1.3170D-01, 2.8010D+00, -1.7280D+01, - &1.8120D+00, 1.2000D+00, 5.0680D-01, -1.2160D+01, 2.0490D+01/ - DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/ - &7.9400D-01, 0.0000D+00, 2.8900D+00, 6.0000D+00, 0.0000D+00, - &-9.1440D-01, -1.2370D+00, 5.9660D-01, -3.6710D+00, -8.1910D+00, - &5.9660D-01, 6.5820D-01, -2.5500D-01, -2.3040D+00, 7.7580D+00/ -C...Expansion coefficients for (up+down+strange) quark sea distribution. - DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/ - &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, - &-2.4280D-01, -2.1200D-01, 8.6730D-01, 1.2660D+00, 2.3820D+00, - &1.3860D-01, 3.6710D-03, 4.7470D-02, -2.2150D+00, 3.4820D-01/ - DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/ - &9.0000D-01, 0.0000D+00, 5.0000D+00, 0.0000D+00, 0.0000D+00, - &-1.4170D-01, -1.6970D-01, -2.4740D+00, -2.5340D+00, 5.6210D-01, - &-1.7400D-01, -9.6230D-02, 1.5750D+00, 1.3780D+00, -2.7010D-01/ -C...Expansion coefficients for charm quark sea distribution. - DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/ - &0.0000D+00, -2.2120D-02, 2.8940D+00, 0.0000D+00, 0.0000D+00, - &7.9280D-02, -3.7850D-01, 9.4330D+00, 5.2480D+00, 8.3880D+00, - &-6.1340D-02, -1.0880D-01, -1.0852D+01, -7.1870D+00, -1.1610D+01/ - DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/ - &0.0000D+00, -8.8200D-02, 1.9240D+00, 0.0000D+00, 0.0000D+00, - &6.2290D-02, -2.8920D-01, 2.4240D-01, -4.4630D+00, -8.3670D-01, - &-4.0990D-02, -1.0820D-01, 2.0360D+00, 5.2090D+00, -4.8400D-02/ - -C...Euler's beta function, requires ordinary Gamma function - EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) - -C...Reset output array. - DO 100 KFL=-6,6 - XPPI(KFL)=0D0 - 100 CONTINUE - - IF(MSTP(53).LE.2) THEN -C...Pion parton distributions from Owens. -C...Allowed variable range: 4 GeV^2 < Q^2 < approx 2000 GeV^2. - -C...Determine set, Lambda and s expansion variable. - NSET=MSTP(53) - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.4D0 - VINT(231)=4D0 - IF(MSTP(57).LE.0) THEN - SD=0D0 - ELSE - Q2IN=MIN(2D3,MAX(4D0,Q2)) - SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) - ENDIF - -C...Calculate parton distributions. - DO 120 KFL=1,4 - DO 110 IS=1,5 - TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+ - & COW(3,IS,KFL,NSET)*SD**2 - 110 CONTINUE - IF(KFL.EQ.1) THEN - XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)/EULBET(TS(1),TS(2)+1D0) - ELSE - XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ - & TS(5)*X**2) - ENDIF - 120 CONTINUE - -C...Put into output array. - XPPI(0)=XQ(2) - XPPI(1)=XQ(3)/6D0 - XPPI(2)=XQ(1)+XQ(3)/6D0 - XPPI(3)=XQ(3)/6D0 - XPPI(4)=XQ(4) - XPPI(-1)=XQ(1)+XQ(3)/6D0 - XPPI(-2)=XQ(3)/6D0 - XPPI(-3)=XQ(3)/6D0 - XPPI(-4)=XQ(4) - -C...Leading order pion parton distributions from Glueck, Reya and Vogt. -C...Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and -C...10^-5 < x < 1. - ELSE - -C...Determine s expansion variable and some x expressions. - VINT(231)=0.25D0 - IF(MSTP(57).LE.0) THEN - SD=0D0 - ELSE - Q2IN=MIN(1D8,MAX(0.25D0,Q2)) - SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) - ENDIF - SD2=SD**2 - XL=-LOG(X) - XS=SQRT(X) - -C...Evaluate valence, gluon and sea distributions. - XFVAL=(0.519D0+0.180D0*SD-0.011D0*SD2)*X**(0.499D0-0.027D0*SD)* - & (1D0+(0.381D0-0.419D0*SD)*XS)*(1D0-X)**(0.367D0+0.563D0*SD) - XFGLU=(X**(0.482D0+0.341D0*SQRT(SD))*((0.678D0+0.877D0* - & SD-0.175D0*SD2)+ - & (0.338D0-1.597D0*SD)*XS+(-0.233D0*SD+0.406D0*SD2)*X)+ - & SD**0.599D0*EXP(-(0.618D0+2.070D0*SD)+SQRT(3.676D0*SD**1.263D0* - & XL)))* - & (1D0-X)**(0.390D0+1.053D0*SD) - XFSEA=SD**0.55D0*(1D0-0.748D0*XS+(0.313D0+0.935D0*SD)*X)*(1D0- - & X)**3.359D0* - & EXP(-(4.433D0+1.301D0*SD)+SQRT((9.30D0-0.887D0*SD)*SD**0.56D0* - & XL))/ - & XL**(2.538D0-0.763D0*SD) - IF(SD.LE.0.888D0) THEN - XFCHM=0D0 - ELSE - XFCHM=(SD-0.888D0)**1.02D0*(1D0+1.008D0*X)*(1D0-X)**(1.208D0+ - & 0.771D0*SD)* - & EXP(-(4.40D0+1.493D0*SD)+SQRT((2.032D0+1.901D0*SD)*SD**0.39D0* - & XL)) - ENDIF - IF(SD.LE.1.351D0) THEN - XFBOT=0D0 - ELSE - XFBOT=(SD-1.351D0)**1.03D0*(1D0-X)**(0.697D0+0.855D0*SD)* - & EXP(-(4.51D0+1.490D0*SD)+SQRT((3.056D0+1.694D0*SD)*SD**0.39D0* - & XL)) - ENDIF - -C...Put into output array. - XPPI(0)=XFGLU - XPPI(1)=XFSEA - XPPI(2)=XFSEA - XPPI(3)=XFSEA - XPPI(4)=XFCHM - XPPI(5)=XFBOT - DO 130 KFL=1,5 - XPPI(-KFL)=XPPI(KFL) - 130 CONTINUE - XPPI(2)=XPPI(2)+XFVAL - XPPI(-1)=XPPI(-1)+XFVAL - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDPO -C...Auxiliary to PYPDPR. Gives proton parton distributions according to -C...a few older parametrizations, now obsolete but convenient for -C...backwards checks. - - SUBROUTINE PYPDPO(X,Q2,XPPR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ - DIMENSION XPPR(-6:6),XQ(9),TX(6),TT(6),TS(6),NEHLQ(8,2), - &CEHLQ(6,6,2,8,2),CDO(3,6,5,2) - - -C...The following data lines are coefficients needed in the -C...Eichten, Hinchliffe, Lane, Quigg proton structure function -C...parametrizations, see below. -C...Powers of 1-x in different cases. - DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ -C...Expansion coefficients for up valence quark distribution. - DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 7.677D-01,-2.087D-01,-3.303D-01,-2.517D-02,-1.570D-02,-1.000D-04, - 2-5.326D-01,-2.661D-01, 3.201D-01, 1.192D-01, 2.434D-02, 7.620D-03, - 3 2.162D-01, 1.881D-01,-8.375D-02,-6.515D-02,-1.743D-02,-5.040D-03, - 4-9.211D-02,-9.952D-02, 1.373D-02, 2.506D-02, 8.770D-03, 2.550D-03, - 5 3.670D-02, 4.409D-02, 9.600D-04,-7.960D-03,-3.420D-03,-1.050D-03, - 6-1.549D-02,-2.026D-02,-3.060D-03, 2.220D-03, 1.240D-03, 4.100D-04, - 1 2.395D-01, 2.905D-01, 9.778D-02, 2.149D-02, 3.440D-03, 5.000D-04, - 2 1.751D-02,-6.090D-03,-2.687D-02,-1.916D-02,-7.970D-03,-2.750D-03, - 3-5.760D-03,-5.040D-03, 1.080D-03, 2.490D-03, 1.530D-03, 7.500D-04, - 4 1.740D-03, 1.960D-03, 3.000D-04,-3.400D-04,-2.900D-04,-1.800D-04, - 5-5.300D-04,-6.400D-04,-1.700D-04, 4.000D-05, 6.000D-05, 4.000D-05, - 6 1.700D-04, 2.200D-04, 8.000D-05, 1.000D-05,-1.000D-05,-1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 7.237D-01,-2.189D-01,-2.995D-01,-1.909D-02,-1.477D-02, 2.500D-04, - 2-5.314D-01,-2.425D-01, 3.283D-01, 1.119D-01, 2.223D-02, 7.070D-03, - 3 2.289D-01, 1.890D-01,-9.859D-02,-6.900D-02,-1.747D-02,-5.080D-03, - 4-1.041D-01,-1.084D-01, 2.108D-02, 2.975D-02, 9.830D-03, 2.830D-03, - 5 4.394D-02, 5.116D-02,-1.410D-03,-1.055D-02,-4.230D-03,-1.270D-03, - 6-1.991D-02,-2.539D-02,-2.780D-03, 3.430D-03, 1.720D-03, 5.500D-04, - 1 2.410D-01, 2.884D-01, 9.369D-02, 1.900D-02, 2.530D-03, 2.400D-04, - 2 1.765D-02,-9.220D-03,-3.037D-02,-2.085D-02,-8.440D-03,-2.810D-03, - 3-6.450D-03,-5.260D-03, 1.720D-03, 3.110D-03, 1.830D-03, 8.700D-04, - 4 2.120D-03, 2.320D-03, 2.600D-04,-4.900D-04,-3.900D-04,-2.300D-04, - 5-6.900D-04,-8.200D-04,-2.000D-04, 7.000D-05, 9.000D-05, 6.000D-05, - 6 2.400D-04, 3.100D-04, 1.100D-04, 0.000D+00,-2.000D-05,-2.000D-05/ -C...Expansion coefficients for down valence quark distribution. - DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 3.813D-01,-8.090D-02,-1.634D-01,-2.185D-02,-8.430D-03,-6.200D-04, - 2-2.948D-01,-1.435D-01, 1.665D-01, 6.638D-02, 1.473D-02, 4.080D-03, - 3 1.252D-01, 1.042D-01,-4.722D-02,-3.683D-02,-1.038D-02,-2.860D-03, - 4-5.478D-02,-5.678D-02, 8.900D-03, 1.484D-02, 5.340D-03, 1.520D-03, - 5 2.220D-02, 2.567D-02,-3.000D-05,-4.970D-03,-2.160D-03,-6.500D-04, - 6-9.530D-03,-1.204D-02,-1.510D-03, 1.510D-03, 8.300D-04, 2.700D-04, - 1 1.261D-01, 1.354D-01, 3.958D-02, 8.240D-03, 1.660D-03, 4.500D-04, - 2 3.890D-03,-1.159D-02,-1.625D-02,-9.610D-03,-3.710D-03,-1.260D-03, - 3-1.910D-03,-5.600D-04, 1.590D-03, 1.590D-03, 8.400D-04, 3.900D-04, - 4 6.400D-04, 4.900D-04,-1.500D-04,-2.900D-04,-1.800D-04,-1.000D-04, - 5-2.000D-04,-1.900D-04, 0.000D+00, 6.000D-05, 4.000D-05, 3.000D-05, - 6 7.000D-05, 8.000D-05, 2.000D-05,-1.000D-05,-1.000D-05,-1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 3.578D-01,-8.622D-02,-1.480D-01,-1.840D-02,-7.820D-03,-4.500D-04, - 2-2.925D-01,-1.304D-01, 1.696D-01, 6.243D-02, 1.353D-02, 3.750D-03, - 3 1.318D-01, 1.041D-01,-5.486D-02,-3.872D-02,-1.038D-02,-2.850D-03, - 4-6.162D-02,-6.143D-02, 1.303D-02, 1.740D-02, 5.940D-03, 1.670D-03, - 5 2.643D-02, 2.957D-02,-1.490D-03,-6.450D-03,-2.630D-03,-7.700D-04, - 6-1.218D-02,-1.497D-02,-1.260D-03, 2.240D-03, 1.120D-03, 3.500D-04, - 1 1.263D-01, 1.334D-01, 3.732D-02, 7.070D-03, 1.260D-03, 3.400D-04, - 2 3.660D-03,-1.357D-02,-1.795D-02,-1.031D-02,-3.880D-03,-1.280D-03, - 3-2.100D-03,-3.600D-04, 2.050D-03, 1.920D-03, 9.800D-04, 4.400D-04, - 4 7.700D-04, 5.400D-04,-2.400D-04,-3.900D-04,-2.400D-04,-1.300D-04, - 5-2.600D-04,-2.300D-04, 2.000D-05, 9.000D-05, 6.000D-05, 4.000D-05, - 6 9.000D-05, 1.000D-04, 2.000D-05,-2.000D-05,-2.000D-05,-1.000D-05/ -C...Expansion coefficients for up and down sea quark distributions. - DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 6.870D-02,-6.861D-02, 2.973D-02,-5.400D-03, 3.780D-03,-9.700D-04, - 2-1.802D-02, 1.400D-04, 6.490D-03,-8.540D-03, 1.220D-03,-1.750D-03, - 3-4.650D-03, 1.480D-03,-5.930D-03, 6.000D-04,-1.030D-03,-8.000D-05, - 4 6.440D-03, 2.570D-03, 2.830D-03, 1.150D-03, 7.100D-04, 3.300D-04, - 5-3.930D-03,-2.540D-03,-1.160D-03,-7.700D-04,-3.600D-04,-1.900D-04, - 6 2.340D-03, 1.930D-03, 5.300D-04, 3.700D-04, 1.600D-04, 9.000D-05, - 1 1.014D+00,-1.106D+00, 3.374D-01,-7.444D-02, 8.850D-03,-8.700D-04, - 2 9.233D-01,-1.285D+00, 4.475D-01,-9.786D-02, 1.419D-02,-1.120D-03, - 3 4.888D-02,-1.271D-01, 8.606D-02,-2.608D-02, 4.780D-03,-6.000D-04, - 4-2.691D-02, 4.887D-02,-1.771D-02, 1.620D-03, 2.500D-04,-6.000D-05, - 5 7.040D-03,-1.113D-02, 1.590D-03, 7.000D-04,-2.000D-04, 0.000D+00, - 6-1.710D-03, 2.290D-03, 3.800D-04,-3.500D-04, 4.000D-05, 1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 1.008D-01,-7.100D-02, 1.973D-02,-5.710D-03, 2.930D-03,-9.900D-04, - 2-5.271D-02,-1.823D-02, 1.792D-02,-6.580D-03, 1.750D-03,-1.550D-03, - 3 1.220D-02, 1.763D-02,-8.690D-03,-8.800D-04,-1.160D-03,-2.100D-04, - 4-1.190D-03,-7.180D-03, 2.360D-03, 1.890D-03, 7.700D-04, 4.100D-04, - 5-9.100D-04, 2.040D-03,-3.100D-04,-1.050D-03,-4.000D-04,-2.400D-04, - 6 1.190D-03,-1.700D-04,-2.000D-04, 4.200D-04, 1.700D-04, 1.000D-04, - 1 1.081D+00,-1.189D+00, 3.868D-01,-8.617D-02, 1.115D-02,-1.180D-03, - 2 9.917D-01,-1.396D+00, 4.998D-01,-1.159D-01, 1.674D-02,-1.720D-03, - 3 5.099D-02,-1.338D-01, 9.173D-02,-2.885D-02, 5.890D-03,-6.500D-04, - 4-3.178D-02, 5.703D-02,-2.070D-02, 2.440D-03, 1.100D-04,-9.000D-05, - 5 8.970D-03,-1.392D-02, 2.050D-03, 6.500D-04,-2.300D-04, 2.000D-05, - 6-2.340D-03, 3.010D-03, 5.000D-04,-3.900D-04, 6.000D-05, 1.000D-05/ -C...Expansion coefficients for gluon distribution. - DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.482D-01,-9.578D-01, 1.009D-01,-1.051D-01, 3.456D-02,-3.054D-02, - 2-9.627D-01, 5.379D-01, 3.368D-01,-9.525D-02, 1.488D-02,-2.051D-02, - 3 4.300D-01,-8.306D-02,-3.372D-01, 4.902D-02,-9.160D-03, 1.041D-02, - 4-1.925D-01,-1.790D-02, 2.183D-01, 7.490D-03, 4.140D-03,-1.860D-03, - 5 8.183D-02, 1.926D-02,-1.072D-01,-1.944D-02,-2.770D-03,-5.200D-04, - 6-3.884D-02,-1.234D-02, 5.410D-02, 1.879D-02, 3.350D-03, 1.040D-03, - 1 2.948D+01,-3.902D+01, 1.464D+01,-3.335D+00, 5.054D-01,-5.915D-02, - 2 2.559D+01,-3.955D+01, 1.661D+01,-4.299D+00, 6.904D-01,-8.243D-02, - 3-1.663D+00, 1.176D+00, 1.118D+00,-7.099D-01, 1.948D-01,-2.404D-02, - 4-2.168D-01, 8.170D-01,-7.169D-01, 1.851D-01,-1.924D-02,-3.250D-03, - 5 2.088D-01,-4.355D-01, 2.239D-01,-2.446D-02,-3.620D-03, 1.910D-03, - 6-9.097D-02, 1.601D-01,-5.681D-02,-2.500D-03, 2.580D-03,-4.700D-04/ - DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 2.367D+00, 4.453D-01, 3.660D-01, 9.467D-02, 1.341D-01, 1.661D-02, - 2-3.170D+00,-1.795D+00, 3.313D-02,-2.874D-01,-9.827D-02,-7.119D-02, - 3 1.823D+00, 1.457D+00,-2.465D-01, 3.739D-02, 6.090D-03, 1.814D-02, - 4-1.033D+00,-9.827D-01, 2.136D-01, 1.169D-01, 5.001D-02, 1.684D-02, - 5 5.133D-01, 5.259D-01,-1.173D-01,-1.139D-01,-4.988D-02,-2.021D-02, - 6-2.881D-01,-3.145D-01, 5.667D-02, 9.161D-02, 4.568D-02, 1.951D-02, - 1 3.036D+01,-4.062D+01, 1.578D+01,-3.699D+00, 6.020D-01,-7.031D-02, - 2 2.700D+01,-4.167D+01, 1.770D+01,-4.804D+00, 7.862D-01,-1.060D-01, - 3-1.909D+00, 1.357D+00, 1.127D+00,-7.181D-01, 2.232D-01,-2.481D-02, - 4-2.488D-01, 9.781D-01,-8.127D-01, 2.094D-01,-2.997D-02,-4.710D-03, - 5 2.506D-01,-5.427D-01, 2.672D-01,-3.103D-02,-1.800D-03, 2.870D-03, - 6-1.128D-01, 2.087D-01,-6.972D-02,-2.480D-03, 2.630D-03,-8.400D-04/ -C...Expansion coefficients for strange sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.968D-02,-4.173D-02, 2.102D-02,-3.270D-03, 3.240D-03,-6.700D-04, - 2-6.150D-03,-1.294D-02, 6.740D-03,-6.890D-03, 9.000D-04,-1.510D-03, - 3-8.580D-03, 5.050D-03,-4.900D-03,-1.600D-04,-9.400D-04,-1.500D-04, - 4 7.840D-03, 1.510D-03, 2.220D-03, 1.400D-03, 7.000D-04, 3.500D-04, - 5-4.410D-03,-2.220D-03,-8.900D-04,-8.500D-04,-3.600D-04,-2.000D-04, - 6 2.520D-03, 1.840D-03, 4.100D-04, 3.900D-04, 1.600D-04, 9.000D-05, - 1 9.235D-01,-1.085D+00, 3.464D-01,-7.210D-02, 9.140D-03,-9.100D-04, - 2 9.315D-01,-1.274D+00, 4.512D-01,-9.775D-02, 1.380D-02,-1.310D-03, - 3 4.739D-02,-1.296D-01, 8.482D-02,-2.642D-02, 4.760D-03,-5.700D-04, - 4-2.653D-02, 4.953D-02,-1.735D-02, 1.750D-03, 2.800D-04,-6.000D-05, - 5 6.940D-03,-1.132D-02, 1.480D-03, 6.500D-04,-2.100D-04, 0.000D+00, - 6-1.680D-03, 2.340D-03, 4.200D-04,-3.400D-04, 5.000D-05, 1.000D-05/ - DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 6.478D-02,-4.537D-02, 1.643D-02,-3.490D-03, 2.710D-03,-6.700D-04, - 2-2.223D-02,-2.126D-02, 1.247D-02,-6.290D-03, 1.120D-03,-1.440D-03, - 3-1.340D-03, 1.362D-02,-6.130D-03,-7.900D-04,-9.000D-04,-2.000D-04, - 4 5.080D-03,-3.610D-03, 1.700D-03, 1.830D-03, 6.800D-04, 4.000D-04, - 5-3.580D-03, 6.000D-05,-2.600D-04,-1.050D-03,-3.800D-04,-2.300D-04, - 6 2.420D-03, 9.300D-04,-1.000D-04, 4.500D-04, 1.700D-04, 1.100D-04, - 1 9.868D-01,-1.171D+00, 3.940D-01,-8.459D-02, 1.124D-02,-1.250D-03, - 2 1.001D+00,-1.383D+00, 5.044D-01,-1.152D-01, 1.658D-02,-1.830D-03, - 3 4.928D-02,-1.368D-01, 9.021D-02,-2.935D-02, 5.800D-03,-6.600D-04, - 4-3.133D-02, 5.785D-02,-2.023D-02, 2.630D-03, 1.600D-04,-8.000D-05, - 5 8.840D-03,-1.416D-02, 1.900D-03, 5.800D-04,-2.500D-04, 1.000D-05, - 6-2.300D-03, 3.080D-03, 5.500D-04,-3.700D-04, 7.000D-05, 1.000D-05/ -C...Expansion coefficients for charm sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.270D-03,-1.817D-02, 9.590D-03,-6.390D-03, 1.690D-03,-1.540D-03, - 2 5.710D-03,-1.188D-02, 6.090D-03,-4.650D-03, 1.240D-03,-1.310D-03, - 3-3.960D-03, 7.100D-03,-3.590D-03, 1.840D-03,-3.900D-04, 3.400D-04, - 4 1.120D-03,-1.960D-03, 1.120D-03,-4.800D-04, 1.000D-04,-4.000D-05, - 5 4.000D-05,-3.000D-05,-1.800D-04, 9.000D-05,-5.000D-05,-2.000D-05, - 6-4.200D-04, 7.300D-04,-1.600D-04, 5.000D-05, 5.000D-05, 5.000D-05, - 1 8.098D-01,-1.042D+00, 3.398D-01,-6.824D-02, 8.760D-03,-9.000D-04, - 2 8.961D-01,-1.217D+00, 4.339D-01,-9.287D-02, 1.304D-02,-1.290D-03, - 3 3.058D-02,-1.040D-01, 7.604D-02,-2.415D-02, 4.600D-03,-5.000D-04, - 4-2.451D-02, 4.432D-02,-1.651D-02, 1.430D-03, 1.200D-04,-1.000D-04, - 5 1.122D-02,-1.457D-02, 2.680D-03, 5.800D-04,-1.200D-04, 3.000D-05, - 6-7.730D-03, 7.330D-03,-7.600D-04,-2.400D-04, 1.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.980D-03,-1.945D-02, 1.055D-02,-6.870D-03, 1.860D-03,-1.560D-03, - 2 5.700D-03,-1.203D-02, 6.250D-03,-4.860D-03, 1.310D-03,-1.370D-03, - 3-4.490D-03, 7.990D-03,-4.170D-03, 2.050D-03,-4.400D-04, 3.300D-04, - 4 1.470D-03,-2.480D-03, 1.460D-03,-5.700D-04, 1.200D-04,-1.000D-05, - 5-9.000D-05, 1.500D-04,-3.200D-04, 1.200D-04,-6.000D-05,-4.000D-05, - 6-4.200D-04, 7.600D-04,-1.400D-04, 4.000D-05, 7.000D-05, 5.000D-05, - 1 8.698D-01,-1.131D+00, 3.836D-01,-8.111D-02, 1.048D-02,-1.300D-03, - 2 9.626D-01,-1.321D+00, 4.854D-01,-1.091D-01, 1.583D-02,-1.700D-03, - 3 3.057D-02,-1.088D-01, 8.022D-02,-2.676D-02, 5.590D-03,-5.600D-04, - 4-2.845D-02, 5.164D-02,-1.918D-02, 2.210D-03,-4.000D-05,-1.500D-04, - 5 1.311D-02,-1.751D-02, 3.310D-03, 5.100D-04,-1.200D-04, 5.000D-05, - 6-8.590D-03, 8.380D-03,-9.200D-04,-2.600D-04, 1.000D-05,-1.000D-05/ -C...Expansion coefficients for bottom sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 9.010D-03,-1.401D-02, 7.150D-03,-4.130D-03, 1.260D-03,-1.040D-03, - 2 6.280D-03,-9.320D-03, 4.780D-03,-2.890D-03, 9.100D-04,-8.200D-04, - 3-2.930D-03, 4.090D-03,-1.890D-03, 7.600D-04,-2.300D-04, 1.400D-04, - 4 3.900D-04,-1.200D-03, 4.400D-04,-2.500D-04, 2.000D-05,-2.000D-05, - 5 2.600D-04, 1.400D-04,-8.000D-05, 1.000D-04, 1.000D-05, 1.000D-05, - 6-2.600D-04, 3.200D-04, 1.000D-05,-1.000D-05, 1.000D-05,-1.000D-05, - 1 8.029D-01,-1.075D+00, 3.792D-01,-7.843D-02, 1.007D-02,-1.090D-03, - 2 7.903D-01,-1.099D+00, 4.153D-01,-9.301D-02, 1.317D-02,-1.410D-03, - 3-1.704D-02,-1.130D-02, 2.882D-02,-1.341D-02, 3.040D-03,-3.600D-04, - 4-7.200D-04, 7.230D-03,-5.160D-03, 1.080D-03,-5.000D-05,-4.000D-05, - 5 3.050D-03,-4.610D-03, 1.660D-03,-1.300D-04,-1.000D-05, 1.000D-05, - 6-4.360D-03, 5.230D-03,-1.610D-03, 2.000D-04,-2.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 8.980D-03,-1.459D-02, 7.510D-03,-4.410D-03, 1.310D-03,-1.070D-03, - 2 5.970D-03,-9.440D-03, 4.800D-03,-3.020D-03, 9.100D-04,-8.500D-04, - 3-3.050D-03, 4.440D-03,-2.100D-03, 8.500D-04,-2.400D-04, 1.400D-04, - 4 5.300D-04,-1.300D-03, 5.600D-04,-2.700D-04, 3.000D-05,-2.000D-05, - 5 2.000D-04, 1.400D-04,-1.100D-04, 1.000D-04, 0.000D+00, 0.000D+00, - 6-2.600D-04, 3.200D-04, 0.000D+00,-3.000D-05, 1.000D-05,-1.000D-05, - 1 8.672D-01,-1.174D+00, 4.265D-01,-9.252D-02, 1.244D-02,-1.460D-03, - 2 8.500D-01,-1.194D+00, 4.630D-01,-1.083D-01, 1.614D-02,-1.830D-03, - 3-2.241D-02,-5.630D-03, 2.815D-02,-1.425D-02, 3.520D-03,-4.300D-04, - 4-7.300D-04, 8.030D-03,-5.780D-03, 1.380D-03,-1.300D-04,-4.000D-05, - 5 3.460D-03,-5.380D-03, 1.960D-03,-2.100D-04, 1.000D-05, 1.000D-05, - 6-4.850D-03, 5.950D-03,-1.890D-03, 2.600D-04,-3.000D-05, 0.000D+00/ -C...Expansion coefficients for top sea quark distribution. - DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.410D-03,-7.480D-03, 3.770D-03,-2.580D-03, 7.300D-04,-7.100D-04, - 2 3.840D-03,-6.050D-03, 3.030D-03,-2.030D-03, 5.800D-04,-5.900D-04, - 3-8.800D-04, 1.660D-03,-7.500D-04, 4.700D-04,-1.000D-04, 1.000D-04, - 4-8.000D-05,-1.500D-04, 1.200D-04,-9.000D-05, 3.000D-05, 0.000D+00, - 5 1.300D-04,-2.200D-04,-2.000D-05,-2.000D-05,-2.000D-05,-2.000D-05, - 6-7.000D-05, 1.900D-04,-4.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, - 1 6.623D-01,-9.248D-01, 3.519D-01,-7.930D-02, 1.110D-02,-1.180D-03, - 2 6.380D-01,-9.062D-01, 3.582D-01,-8.479D-02, 1.265D-02,-1.390D-03, - 3-2.581D-02, 2.125D-02, 4.190D-03,-4.980D-03, 1.490D-03,-2.100D-04, - 4 7.100D-04, 5.300D-04,-1.270D-03, 3.900D-04,-5.000D-05,-1.000D-05, - 5 3.850D-03,-5.060D-03, 1.860D-03,-3.500D-04, 4.000D-05, 0.000D+00, - 6-3.530D-03, 4.460D-03,-1.500D-03, 2.700D-04,-3.000D-05, 0.000D+00/ - DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ - 1 4.260D-03,-7.530D-03, 3.830D-03,-2.680D-03, 7.600D-04,-7.300D-04, - 2 3.640D-03,-6.050D-03, 3.030D-03,-2.090D-03, 5.900D-04,-6.000D-04, - 3-9.200D-04, 1.710D-03,-8.200D-04, 5.000D-04,-1.200D-04, 1.000D-04, - 4-5.000D-05,-1.600D-04, 1.300D-04,-9.000D-05, 3.000D-05, 0.000D+00, - 5 1.300D-04,-2.100D-04,-1.000D-05,-2.000D-05,-2.000D-05,-1.000D-05, - 6-8.000D-05, 1.800D-04,-5.000D-05, 2.000D-05, 0.000D+00, 0.000D+00, - 1 7.146D-01,-1.007D+00, 3.932D-01,-9.246D-02, 1.366D-02,-1.540D-03, - 2 6.856D-01,-9.828D-01, 3.977D-01,-9.795D-02, 1.540D-02,-1.790D-03, - 3-3.053D-02, 2.758D-02, 2.150D-03,-4.880D-03, 1.640D-03,-2.500D-04, - 4 9.200D-04, 4.200D-04,-1.340D-03, 4.600D-04,-8.000D-05,-1.000D-05, - 5 4.230D-03,-5.660D-03, 2.140D-03,-4.300D-04, 6.000D-05, 0.000D+00, - 6-3.890D-03, 5.000D-03,-1.740D-03, 3.300D-04,-4.000D-05, 0.000D+00/ - -C...The following data lines are coefficients needed in the -C...Duke, Owens proton structure function parametrizations, see below. -C...Expansion coefficients for (up+down) valence quark distribution. - DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/ - 1 4.190D-01, 3.460D+00, 4.400D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 4.000D-03, 7.240D-01,-4.860D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 3-7.000D-03,-6.600D-02, 1.330D+00, 0.000D+00, 0.000D+00, 0.000D+00/ - DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/ - 1 3.740D-01, 3.330D+00, 6.030D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 1.400D-02, 7.530D-01,-6.220D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 3 0.000D+00,-7.600D-02, 1.560D+00, 0.000D+00, 0.000D+00, 0.000D+00/ -C...Expansion coefficients for down valence quark distribution. - DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/ - 1 7.630D-01, 4.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-2.370D-01, 6.270D-01,-4.210D-01, 0.000D+00, 0.000D+00, 0.000D+00, - 3 2.600D-02,-1.900D-02, 3.300D-02, 0.000D+00, 0.000D+00, 0.000D+00/ - DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/ - 1 7.610D-01, 3.830D+00, 0.000D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-2.320D-01, 6.270D-01,-4.180D-01, 0.000D+00, 0.000D+00, 0.000D+00, - 3 2.300D-02,-1.900D-02, 3.600D-02, 0.000D+00, 0.000D+00, 0.000D+00/ -C...Expansion coefficients for (up+down+strange) sea quark distribution. - DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/ - 1 1.265D+00, 0.000D+00, 8.050D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-1.132D+00,-3.720D-01, 1.590D+00, 6.310D+00,-1.050D+01, 1.470D+01, - 3 2.930D-01,-2.900D-02,-1.530D-01,-2.730D-01,-3.170D+00, 9.800D+00/ - DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/ - 1 1.670D+00, 0.000D+00, 9.150D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2-1.920D+00,-2.730D-01, 5.300D-01, 1.570D+01,-1.010D+02, 2.230D+02, - 3 5.820D-01,-1.640D-01,-7.630D-01,-2.830D+00, 4.470D+01,-1.170D+02/ -C...Expansion coefficients for charm sea quark distribution. - DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/ - 1 0.000D+00,-3.600D-02, 6.350D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 1.350D-01,-2.220D-01, 3.260D+00,-3.030D+00, 1.740D+01,-1.790D+01, - 3-7.500D-02,-5.800D-02,-9.090D-01, 1.500D+00,-1.130D+01, 1.560D+01/ - DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/ - 1 0.000D+00,-1.200D-01, 3.510D+00, 0.000D+00, 0.000D+00, 0.000D+00, - 2 6.700D-02,-2.330D-01, 3.660D+00,-4.740D-01, 9.500D+00,-1.660D+01, - 3-3.100D-02,-2.300D-02,-4.530D-01, 3.580D-01,-5.430D+00, 1.550D+01/ -C...Expansion coefficients for gluon distribution. - DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/ - 1 1.560D+00, 0.000D+00, 6.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, - 2-1.710D+00,-9.490D-01, 1.440D+00,-7.190D+00,-1.650D+01, 1.530D+01, - 3 6.380D-01, 3.250D-01,-1.050D+00, 2.550D-01, 1.090D+01,-1.010D+01/ - DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/ - 1 8.790D-01, 0.000D+00, 4.000D+00, 9.000D+00, 0.000D+00, 0.000D+00, - 2-9.710D-01,-1.160D+00, 1.230D+00,-5.640D+00,-7.540D+00,-5.960D-01, - 3 4.340D-01, 4.760D-01,-2.540D-01,-8.170D-01, 5.500D+00, 1.260D-01/ - -C...Euler's beta function, requires ordinary Gamma function - EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y) - -C...Leading order proton parton distributions from Glueck, Reya and -C...Vogt. Allowed variable range: 0.25 GeV^2 < Q^2 < 10^8 GeV^2 and -C...10^-5 < x < 1. - IF(MSTP(51).EQ.11) THEN - -C...Determine s expansion variable and some x expressions. - Q2IN=MIN(1D8,MAX(0.25D0,Q2)) - SD=LOG(LOG(Q2IN/0.232D0**2)/LOG(0.25D0/0.232D0**2)) - SD2=SD**2 - XL=-LOG(X) - XS=SQRT(X) - -C...Evaluate valence, gluon and sea distributions. - XFVUD=(0.663D0+0.191D0*SD-0.041D0*SD2+0.031D0*SD**3)* - & X**0.326D0*(1D0+(-1.97D0+6.74D0*SD-1.96D0*SD2)*XS+ - & (24.4D0-20.7D0*SD+4.08D0*SD2)*X)* - & (1D0-X)**(2.86D0+0.70D0*SD-0.02D0*SD2) - XFVDD=(0.579D0+0.283D0*SD+0.047D0*SD2)*X**(0.523D0-0.015D0*SD)* - & (1D0+(2.22D0-0.59D0*SD-0.27D0*SD2)*XS+(5.95D0-6.19D0*SD+ - & 1.55D0*SD2)*X)*(1D0-X)**(3.57D0+0.94D0*SD-0.16D0*SD2) - XFGLU=(X**(1.00D0-0.17D0*SD)*((4.879D0*SD-1.383D0*SD2)+ - & (25.92D0-28.97D0*SD+5.596D0*SD2)*X+(-25.69D0+23.68D0*SD- - & 1.975D0*SD2)*X**2)+SD**0.558D0*EXP(-(0.595D0+2.138D0*SD)+ - & SQRT(4.066D0*SD**1.218D0*XL)))* - & (1D0-X)**(2.537D0+1.718D0*SD+0.353D0*SD2) - XFSEA=(X**(0.412D0-0.171D0*SD)*(0.363D0-1.196D0*X+(1.029D0+ - & 1.785D0*SD-0.459D0*SD2)*X**2)*XL**(0.566D0-0.496D0*SD)+ - & SD**1.396D0*EXP(-(3.838D0+1.944D0*SD)+SQRT(2.845D0*SD**1.331D0* - & XL)))*(1D0-X)**(4.696D0+2.109D0*SD) - XFSTR=SD**0.803D0*(1D0+(-3.055D0+1.024D0*SD**0.67D0)*XS+ - & (27.4D0-20.0D0*SD**0.154D0)*X)*(1D0-X)**6.22D0* - & EXP(-(4.33D0+1.408D0*SD)+SQRT((8.27D0-0.437D0*SD)* - & SD**0.563D0*XL))/XL**(2.082D0-0.577D0*SD) - IF(SD.LE.0.888D0) THEN - XFCHM=0D0 - ELSE - XFCHM=(SD-0.888D0)**1.01D0*(1.+(4.24D0-0.804D0*SD)*X)* - & (1D0-X)**(3.46D0+1.076D0*SD)*EXP(-(4.61D0+1.49D0*SD)+ - & SQRT((2.555D0+1.961D0*SD)*SD**0.37D0*XL)) - ENDIF - IF(SD.LE.1.351D0) THEN - XFBOT=0D0 - ELSE - XFBOT=(SD-1.351D0)*(1D0+1.848D0*X)*(1D0-X)**(2.929D0+ - & 1.396D0*SD)*EXP(-(4.71D0+1.514D0*SD)+ - & SQRT((4.02D0+1.239D0*SD)*SD**0.51D0*XL)) - ENDIF - -C...Put into output array. - XPPR(0)=XFGLU - XPPR(1)=XFVDD+XFSEA - XPPR(2)=XFVUD-XFVDD+XFSEA - XPPR(3)=XFSTR - XPPR(4)=XFCHM - XPPR(5)=XFBOT - XPPR(-1)=XFSEA - XPPR(-2)=XFSEA - XPPR(-3)=XFSTR - XPPR(-4)=XFCHM - XPPR(-5)=XFBOT - -C...Proton parton distributions from Eichten, Hinchliffe, Lane, Quigg. -C...Allowed variable range: 5 GeV^2 < Q^2 < 1E8 GeV^2; 1E-4 < x < 1 - ELSEIF(MSTP(51).EQ.12.OR.MSTP(51).EQ.13) THEN - -C...Determine set, Lambda and x and t expansion variables. - NSET=MSTP(51)-11 - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.29D0 - TMIN=LOG(5D0/ALAM**2) - TMAX=LOG(1D8/ALAM**2) - T=LOG(MAX(1D0,Q2/ALAM**2)) - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - NX=1 - IF(X.LE.0.1D0) NX=2 - IF(NX.EQ.1) VX=(2D0*X-1.1D0)/0.9D0 - IF(NX.EQ.2) VX=MAX(-1D0,(2D0*LOG(X)+11.51293D0)/6.90776D0) - -C...Chebyshev polynomials for x and t expansion. - TX(1)=1D0 - TX(2)=VX - TX(3)=2D0*VX**2-1D0 - TX(4)=4D0*VX**3-3D0*VX - TX(5)=8D0*VX**4-8D0*VX**2+1D0 - TX(6)=16D0*VX**5-20D0*VX**3+5D0*VX - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - -C...Calculate structure functions. - DO 120 KFL=1,6 - XQSUM=0D0 - DO 110 IT=1,6 - DO 100 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT) - 100 CONTINUE - 110 CONTINUE - XQ(KFL)=XQSUM*(1D0-X)**NEHLQ(KFL,NSET) - 120 CONTINUE - -C...Put into output array. - XPPR(0)=XQ(4) - XPPR(1)=XQ(2)+XQ(3) - XPPR(2)=XQ(1)+XQ(3) - XPPR(3)=XQ(5) - XPPR(4)=XQ(6) - XPPR(-1)=XQ(3) - XPPR(-2)=XQ(3) - XPPR(-3)=XQ(5) - XPPR(-4)=XQ(6) - -C...Special expansion for bottom (threshold effects). - IF(MSTP(58).GE.5) THEN - IF(NSET.EQ.1) TMIN=8.1905D0 - IF(NSET.EQ.2) TMIN=7.4474D0 - IF(T.GT.TMIN) THEN - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - XQSUM=0D0 - DO 140 IT=1,6 - DO 130 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT) - 130 CONTINUE - 140 CONTINUE - XPPR(5)=XQSUM*(1D0-X)**NEHLQ(7,NSET) - XPPR(-5)=XPPR(5) - ENDIF - ENDIF - -C...Special expansion for top (threshold effects). - IF(MSTP(58).GE.6) THEN - IF(NSET.EQ.1) TMIN=11.5528D0 - IF(NSET.EQ.2) TMIN=10.8097D0 - TMIN=TMIN+2D0*LOG(PMAS(6,1)/30D0) - TMAX=TMAX+2D0*LOG(PMAS(6,1)/30D0) - IF(T.GT.TMIN) THEN - VT=MAX(-1D0,MIN(1D0,(2D0*T-TMAX-TMIN)/(TMAX-TMIN))) - TT(1)=1D0 - TT(2)=VT - TT(3)=2D0*VT**2-1D0 - TT(4)=4D0*VT**3-3D0*VT - TT(5)=8D0*VT**4-8D0*VT**2+1D0 - TT(6)=16D0*VT**5-20D0*VT**3+5D0*VT - XQSUM=0D0 - DO 160 IT=1,6 - DO 150 IX=1,6 - XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT) - 150 CONTINUE - 160 CONTINUE - XPPR(6)=XQSUM*(1D0-X)**NEHLQ(8,NSET) - XPPR(-6)=XPPR(6) - ENDIF - ENDIF - -C...Proton parton distributions from Duke, Owens. -C...Allowed variable range: 4 GeV^2 < Q^2 < approx 1E6 GeV^2. - ELSEIF(MSTP(51).EQ.14.OR.MSTP(51).EQ.15) THEN - -C...Determine set, Lambda and s expansion parameter. - NSET=MSTP(51)-13 - IF(NSET.EQ.1) ALAM=0.2D0 - IF(NSET.EQ.2) ALAM=0.4D0 - Q2IN=MIN(1D6,MAX(4D0,Q2)) - SD=LOG(LOG(Q2IN/ALAM**2)/LOG(4D0/ALAM**2)) - -C...Calculate structure functions. - DO 180 KFL=1,5 - DO 170 IS=1,6 - TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+ - & CDO(3,IS,KFL,NSET)*SD**2 - 170 CONTINUE - IF(KFL.LE.2) THEN - XQ(KFL)=X**TS(1)*(1D0-X)**TS(2)*(1D0+TS(3)*X)/(EULBET(TS(1), - & TS(2)+1D0)*(1D0+TS(3)*TS(1)/(TS(1)+TS(2)+1D0))) - ELSE - XQ(KFL)=TS(1)*X**TS(2)*(1D0-X)**TS(3)*(1D0+TS(4)*X+ - & TS(5)*X**2+TS(6)*X**3) - ENDIF - 180 CONTINUE - -C...Put into output arrays. - XPPR(0)=XQ(5) - XPPR(1)=XQ(2)+XQ(3)/6D0 - XPPR(2)=3D0*XQ(1)-XQ(2)+XQ(3)/6D0 - XPPR(3)=XQ(3)/6D0 - XPPR(4)=XQ(4) - XPPR(-1)=XQ(3)/6D0 - XPPR(-2)=XQ(3)/6D0 - XPPR(-3)=XQ(3)/6D0 - XPPR(-4)=XQ(4) - - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPDPR -C...Gives proton parton distributions according to a few different -C...parametrizations. - - SUBROUTINE PYPDPR(X,Q2,XPPR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Arrays and data. - DIMENSION XPPR(-6:6),Q2MIN(16) - DATA Q2MIN/ 2.56D0, 2.56D0, 2.56D0, 0.4D0, 0.4D0, 0.4D0, - &1.0D0, 1.0D0, 2*0D0, 0.25D0, 5D0, 5D0, 4D0, 4D0, 0D0/ - -C...Reset output array. - DO 100 KFL=-6,6 - XPPR(KFL)=0D0 - 100 CONTINUE - -C...Common preliminaries. - NSET=MAX(1,MIN(16,MSTP(51))) - IF(NSET.EQ.9.OR.NSET.EQ.10) NSET=6 - VINT(231)=Q2MIN(NSET) - IF(MSTP(57).EQ.0) THEN - Q2L=Q2MIN(NSET) - ELSE - Q2L=MAX(Q2MIN(NSET),Q2) - ENDIF - - IF(NSET.GE.1.AND.NSET.LE.3) THEN -C...Interface to the CTEQ 3 parton distributions. - QRT=SQRT(MAX(1D0,Q2L)) - -C...Loop over flavours. - DO 110 I=-6,6 - IF(I.LE.0) THEN - XPPR(I)=PYCTEQ(NSET,I,X,QRT) - ELSEIF(I.LE.2) THEN - XPPR(I)=PYCTEQ(NSET,I,X,QRT)+XPPR(-I) - ELSE - XPPR(I)=XPPR(-I) - ENDIF - 110 CONTINUE - - ELSEIF(NSET.GE.4.AND.NSET.LE.6) THEN -C...Interface to the GRV 94 distributions. - IF(NSET.EQ.4) THEN - CALL PYGRVL (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ELSEIF(NSET.EQ.5) THEN - CALL PYGRVM (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ELSE - CALL PYGRVD (X, Q2L, UV, DV, DEL, UDB, SB, CHM, BOT, GL) - ENDIF - -C...Put into output array. - XPPR(0)=GL - XPPR(-1)=0.5D0*(UDB+DEL) - XPPR(-2)=0.5D0*(UDB-DEL) - XPPR(-3)=SB - XPPR(-4)=CHM - XPPR(-5)=BOT - XPPR(1)=DV+XPPR(-1) - XPPR(2)=UV+XPPR(-2) - XPPR(3)=SB - XPPR(4)=CHM - XPPR(5)=BOT - - ELSEIF(NSET.EQ.7) THEN -C...Interface to the CTEQ 5L parton distributions. -C...Range of validity 10^-6 < x < 1, 1 < Q < 10^4 extended by -C...freezing x*f(x,Q2) at borders. - QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) - XIN=MAX(1D-6,MIN(1D0,X)) - -C...Loop over flavours (with u <-> d notation mismatch). - SUMUDB=PYCT5L(-1,XIN,QRT) - RATUDB=PYCT5L(-2,XIN,QRT) - DO 120 I=-5,2 - IF(I.EQ.1) THEN - XPPR(I)=XIN*PYCT5L(2,XIN,QRT) - ELSEIF(I.EQ.2) THEN - XPPR(I)=XIN*PYCT5L(1,XIN,QRT) - ELSEIF(I.EQ.-1) THEN - XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) - ELSEIF(I.EQ.-2) THEN - XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) - ELSE - XPPR(I)=XIN*PYCT5L(I,XIN,QRT) - IF(I.LT.0) XPPR(-I)=XPPR(I) - ENDIF - 120 CONTINUE - - ELSEIF(NSET.EQ.8) THEN -C...Interface to the CTEQ 5M1 parton distributions. - QRT=SQRT(MAX(1D0,MIN(1D8,Q2L))) - XIN=MAX(1D-6,MIN(1D0,X)) - -C...Loop over flavours (with u <-> d notation mismatch). - SUMUDB=PYCT5M(-1,XIN,QRT) - RATUDB=PYCT5M(-2,XIN,QRT) - DO 130 I=-5,2 - IF(I.EQ.1) THEN - XPPR(I)=XIN*PYCT5M(2,XIN,QRT) - ELSEIF(I.EQ.2) THEN - XPPR(I)=XIN*PYCT5M(1,XIN,QRT) - ELSEIF(I.EQ.-1) THEN - XPPR(I)=XIN*SUMUDB*RATUDB/(1D0+RATUDB) - ELSEIF(I.EQ.-2) THEN - XPPR(I)=XIN*SUMUDB/(1D0+RATUDB) - ELSE - XPPR(I)=XIN*PYCT5M(I,XIN,QRT) - IF(I.LT.0) XPPR(-I)=XPPR(I) - ENDIF - 130 CONTINUE - - ELSEIF(NSET.GE.11.AND.NSET.LE.15) THEN -C...GRV92LO, EHLQ1, EHLQ2, DO1 AND DO2 distributions: -C...obsolete but offers backwards compatibility. - CALL PYPDPO(X,Q2L,XPPR) - -C...Symmetric choice for debugging only - ELSEIF(NSET.EQ.16) THEN - XPPR(0)=.5D0/X - XPPR(1)=.05D0/X - XPPR(2)=.05D0/X - XPPR(3)=.05D0/X - XPPR(4)=.05D0/X - XPPR(5)=.05D0/X - XPPR(-1)=.05D0/X - XPPR(-2)=.05D0/X - XPPR(-3)=.05D0/X - XPPR(-4)=.05D0/X - XPPR(-5)=.05D0/X - - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYP -C...Provides various real-valued event related data. - - FUNCTION PYP(I,J) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local array. - DIMENSION PSUM(4) - -C...Set default value. For I = 0 sum of momenta or charges, -C...or invariant mass of system. - PYP=0D0 - 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) PYP=PYP+P(I1,J) - 100 CONTINUE - ELSEIF(I.EQ.0.AND.J.EQ.5) THEN - DO 120 J1=1,4 - PSUM(J1)=0D0 - 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 - PYP=SQRT(MAX(0D0,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) PYP=PYP+PYCHGE(K(I1,2))/3D0 - 130 CONTINUE - ELSEIF(I.EQ.0) THEN - -C...Direct readout of P matrix. - ELSEIF(J.LE.5) THEN - PYP=P(I,J) - -C...Charge, total momentum, transverse momentum, transverse mass. - ELSEIF(J.LE.12) THEN - IF(J.EQ.6) PYP=PYCHGE(K(I,2))/3D0 - IF(J.EQ.7.OR.J.EQ.8) PYP=P(I,1)**2+P(I,2)**2+P(I,3)**2 - IF(J.EQ.9.OR.J.EQ.10) PYP=P(I,1)**2+P(I,2)**2 - IF(J.EQ.11.OR.J.EQ.12) PYP=P(I,5)**2+P(I,1)**2+P(I,2)**2 - IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PYP=SQRT(PYP) - -C...Theta and phi angle in radians or degrees. - ELSEIF(J.LE.16) THEN - IF(J.LE.14) PYP=PYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) - IF(J.GE.15) PYP=PYANGL(P(I,1),P(I,2)) - IF(J.EQ.14.OR.J.EQ.16) PYP=PYP*180D0/PARU(1) - -C...True rapidity, rapidity with pion mass, pseudorapidity. - ELSEIF(J.LE.19) THEN - PMR=0D0 - IF(J.EQ.17) PMR=P(I,5) - IF(J.EQ.18) PMR=PYMASS(211) - PR=MAX(1D-20,PMR**2+P(I,1)**2+P(I,2)**2) - PYP=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), - & 1D20)),P(I,3)) - -C...Energy and momentum fractions (only to be used in CM frame). - ELSEIF(J.LE.25) THEN - IF(J.EQ.20) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) - IF(J.EQ.21) PYP=2D0*P(I,3)/PARU(21) - IF(J.EQ.22) PYP=2D0*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) - IF(J.EQ.23) PYP=2D0*P(I,4)/PARU(21) - IF(J.EQ.24) PYP=(P(I,4)+P(I,3))/PARU(21) - IF(J.EQ.25) PYP=(P(I,4)-P(I,3))/PARU(21) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYPILE -C...Initializes multiplicity distribution and selects mutliplicity -C...of pileup events, i.e. several events occuring at the same -C...beam crossing. - - SUBROUTINE PYPILE(MPILE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYPARS/,/PYINT1/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION WTI(0:200) - SAVE IMIN,IMAX,WTI,WTS - -C...Sum of allowed cross-sections for pileup events. - IF(MPILE.EQ.1) THEN - VINT(131)=SIGT(0,0,5) - IF(MSTP(132).GE.2) VINT(131)=VINT(131)+SIGT(0,0,4) - IF(MSTP(132).GE.3) VINT(131)=VINT(131)+SIGT(0,0,2)+SIGT(0,0,3) - IF(MSTP(132).GE.4) VINT(131)=VINT(131)+SIGT(0,0,1) - IF(MSTP(133).LE.0) RETURN - -C...Initialize multiplicity distribution at maximum. - XNAVE=VINT(131)*PARP(131) - IF(XNAVE.GT.120D0) WRITE(MSTU(11),5000) XNAVE - INAVE=MAX(1,MIN(200,NINT(XNAVE))) - WTI(INAVE)=1D0 - WTS=WTI(INAVE) - WTN=WTI(INAVE)*INAVE - -C...Find shape of multiplicity distribution below maximum. - IMIN=INAVE - DO 100 I=INAVE-1,1,-1 - IF(MSTP(133).EQ.1) WTI(I)=WTI(I+1)*(I+1)/XNAVE - IF(MSTP(133).GE.2) WTI(I)=WTI(I+1)*I/XNAVE - IF(WTI(I).LT.1D-6) GOTO 110 - WTS=WTS+WTI(I) - WTN=WTN+WTI(I)*I - IMIN=I - 100 CONTINUE - -C...Find shape of multiplicity distribution above maximum. - 110 IMAX=INAVE - DO 120 I=INAVE+1,200 - IF(MSTP(133).EQ.1) WTI(I)=WTI(I-1)*XNAVE/I - IF(MSTP(133).GE.2) WTI(I)=WTI(I-1)*XNAVE/(I-1) - IF(WTI(I).LT.1D-6) GOTO 130 - WTS=WTS+WTI(I) - WTN=WTN+WTI(I)*I - IMAX=I - 120 CONTINUE - 130 VINT(132)=XNAVE - VINT(133)=WTN/WTS - IF(MSTP(133).EQ.1.AND.IMIN.EQ.1) VINT(134)= - & WTS/(WTS+WTI(1)/XNAVE) - IF(MSTP(133).EQ.1.AND.IMIN.GT.1) VINT(134)=1D0 - IF(MSTP(133).GE.2) VINT(134)=XNAVE - -C...Pick multiplicity of pileup events. - ELSE - IF(MSTP(133).LE.0) THEN - MINT(81)=MAX(1,MSTP(134)) - ELSE - WTR=WTS*PYR(0) - DO 140 I=IMIN,IMAX - MINT(81)=I - WTR=WTR-WTI(I) - IF(WTR.LE.0D0) GOTO 150 - 140 CONTINUE - 150 CONTINUE - ENDIF - ENDIF - -C...Format statement for error message. - 5000 FORMAT(1X,'Warning: requested average number of events per bunch', - &'crossing too large, ',1P,D12.4) - - RETURN - END - -C********************************************************************* - -C...PYPLOT -C...Prints a histogram (but does not reset it). - - SUBROUTINE PYPLOT(ID) - -C...Double precision declaration. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYBINS/IHIST(4),INDX(1000),BIN(20000) - SAVE /PYDAT1/,/PYBINS/ -C...Local arrays and character variables. - DIMENSION IDATI(6), IROW(100), IFRA(100), DYAC(10) - CHARACTER TITLE*60, OUT*100, CHA(0:11)*1 - -C...Steps in histogram scale. Character sequence. - DATA DYAC/.04,.05,.06,.08,.10,.12,.15,.20,.25,.30/ - DATA CHA/'0','1','2','3','4','5','6','7','8','9','X','-'/ - -C...Find initial address in memory; skip if empty histogram. - IF(ID.LE.0.OR.ID.GT.IHIST(1)) RETURN - IS=INDX(ID) - IF(IS.EQ.0) RETURN - IF(NINT(BIN(IS+5)).LE.0) THEN - WRITE(MSTU(11),5000) ID - RETURN - ENDIF - -C...Number of histogram lines and x bins. - LIN=IHIST(3)-18 - NX=NINT(BIN(IS+1)) - -C...Extract title by conversion from double precision via integer. - DO 100 IT=1,20 - IEQ=NINT(BIN(IS+8+NX+IT)) - TITLE(3*IT-2:3*IT)=CHAR(IEQ/256**2)//CHAR(MOD(IEQ,256**2)/256) - & //CHAR(MOD(IEQ,256)) - 100 CONTINUE - -C...Find time; print title. - CALL PYTIME(IDATI) - IF(IDATI(1).GT.0) THEN - WRITE(MSTU(11),5100) ID, TITLE, (IDATI(J),J=1,5) - ELSE - WRITE(MSTU(11),5200) ID, TITLE - ENDIF - -C...Find minimum and maximum bin content. - YMIN=BIN(IS+9) - YMAX=BIN(IS+9) - DO 110 IX=IS+10,IS+8+NX - IF(BIN(IX).LT.YMIN) YMIN=BIN(IX) - IF(BIN(IX).GT.YMAX) YMAX=BIN(IX) - 110 CONTINUE - -C...Determine scale and step size for y axis. - IF(YMAX-YMIN.GT.LIN*DYAC(1)*1D-9) THEN - IF(YMIN.GT.0D0.AND.YMIN.LT.0.1D0*YMAX) YMIN=0D0 - IF(YMAX.LT.0D0.AND.YMAX.GT.0.1D0*YMIN) YMAX=0D0 - IPOT=INT(LOG10(YMAX-YMIN)+10D0)-10 - IF(YMAX-YMIN.LT.LIN*DYAC(1)*10D0**IPOT) IPOT=IPOT-1 - IF(YMAX-YMIN.GT.LIN*DYAC(10)*10D0**IPOT) IPOT=IPOT+1 - DELY=DYAC(1) - DO 120 IDEL=1,9 - IF(YMAX-YMIN.GE.LIN*DYAC(IDEL)*10D0**IPOT) DELY=DYAC(IDEL+1) - 120 CONTINUE - DY=DELY*10D0**IPOT - -C...Convert bin contents to integer form; fractional fill in top row. - DO 130 IX=1,NX - CTA=ABS(BIN(IS+8+IX))/DY - IROW(IX)=SIGN(CTA+0.95D0,BIN(IS+8+IX)) - IFRA(IX)=10D0*(CTA+1.05D0-DBLE(INT(CTA+0.95D0))) - 130 CONTINUE - IRMI=SIGN(ABS(YMIN)/DY+0.95D0,YMIN) - IRMA=SIGN(ABS(YMAX)/DY+0.95D0,YMAX) - -C...Print histogram row by row. - DO 150 IR=IRMA,IRMI,-1 - IF(IR.EQ.0) GOTO 150 - OUT=' ' - DO 140 IX=1,NX - IF(IR.EQ.IROW(IX)) OUT(IX:IX)=CHA(IFRA(IX)) - IF(IR*(IROW(IX)-IR).GT.0) OUT(IX:IX)=CHA(10) - 140 CONTINUE - WRITE(MSTU(11),5300) IR*DELY, IPOT, OUT - 150 CONTINUE - -C...Print sign and value of bin contents. - IPOT=INT(LOG10(MAX(YMAX,-YMIN))+10.0001D0)-10 - OUT=' ' - DO 160 IX=1,NX - IF(BIN(IS+8+IX).LT.-10D0**(IPOT-4)) OUT(IX:IX)=CHA(11) - IROW(IX)=NINT(10D0**(3-IPOT)*ABS(BIN(IS+8+IX))) - 160 CONTINUE - WRITE(MSTU(11),5400) OUT - DO 180 IR=4,1,-1 - DO 170 IX=1,NX - OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) - 170 CONTINUE - WRITE(MSTU(11),5500) IPOT+IR-4, OUT - 180 CONTINUE - -C...Print sign and value of lower bin edge. - IPOT=INT(LOG10(MAX(-BIN(IS+2),BIN(IS+3)-BIN(IS+4)))+ - & 10.0001D0)-10 - OUT=' ' - DO 190 IX=1,NX - IF(BIN(IS+2)+(IX-1)*BIN(IS+4).LT.-10D0**(IPOT-3)) - & OUT(IX:IX)=CHA(11) - IROW(IX)=NINT(10D0**(2-IPOT)*ABS(BIN(IS+2)+(IX-1)*BIN(IS+4))) - 190 CONTINUE - WRITE(MSTU(11),5600) OUT - DO 210 IR=3,1,-1 - DO 200 IX=1,NX - OUT(IX:IX)=CHA(MOD(IROW(IX),10**IR)/10**(IR-1)) - 200 CONTINUE - WRITE(MSTU(11),5500) IPOT+IR-3, OUT - 210 CONTINUE - ENDIF - -C...Calculate and print statistics. - CSUM=0D0 - CXSUM=0D0 - CXXSUM=0D0 - DO 220 IX=1,NX - CTA=ABS(BIN(IS+8+IX)) - X=BIN(IS+2)+(IX-0.5D0)*BIN(IS+4) - CSUM=CSUM+CTA - CXSUM=CXSUM+CTA*X - CXXSUM=CXXSUM+CTA*X**2 - 220 CONTINUE - XMEAN=CXSUM/MAX(CSUM,1D-20) - XRMS=SQRT(MAX(0D0,CXXSUM/MAX(CSUM,1D-20)-XMEAN**2)) - WRITE(MSTU(11),5700) NINT(BIN(IS+5)),XMEAN,BIN(IS+6), - &BIN(IS+2),BIN(IS+7),XRMS,BIN(IS+8),BIN(IS+3) - -C...Formats for output. - 5000 FORMAT(/5X,'Histogram no',I5,' : no entries') - 5100 FORMAT('1'/5X,'Histogram no',I5,6X,A60,5X,I4,'-',I2,'-',I2,1X, - &I2,':',I2/) - 5200 FORMAT('1'/5X,'Histogram no',I5,6X,A60/) - 5300 FORMAT(2X,F7.2,'*10**',I2,3X,A100) - 5400 FORMAT(/8X,'Contents',3X,A100) - 5500 FORMAT(9X,'*10**',I2,3X,A100) - 5600 FORMAT(/8X,'Low edge',3X,A100) - 5700 FORMAT(/5X,'Entries =',I12,1P,6X,'Mean =',D12.4,6X,'Underflow =' - &,D12.4,6X,'Low edge =',D12.4/5X,'All chan =',D12.4,6X, - &'Rms =',D12.4,6X,'Overflow =',D12.4,6X,'High edge =',D12.4) - - RETURN - END - -C********************************************************************* - -C...PYPOLE -C...This subroutine computes the CP-even higgs and CP-odd pole -c...Higgs masses and mixing angles. - -C...Program based on the work by M. Carena, M. Quiros -C...and C.E.M. Wagner, "Effective potential methods and -C...the Higgs mass spectrum in the MSSM", CERN-TH/95-157 - -C...Inputs: IHIGGS(explained below),MCHI,MA,TANB,MQ,MUR,MDR,MTOP, -C...AT,AB,MU -C...where MCHI is the largest chargino mass, MA is the running -C...CP-odd higgs mass, TANB is the value of the ratio of vacuum -C...expectaion values at the scale MTOP, MQ is the third generation -C...left handed squark mass parameter, MUR is the third generation -C...right handed stop mass parameter, MDR is the third generation -C...right handed sbottom mass parameter, MTOP is the pole top quark -C...mass; AT,AB are the soft supersymmetry breaking trilinear -C...couplings of the stop and sbottoms, respectively, and MU is the -C...supersymmetric mass parameter - -C...The parameter IHIGGS=0,1,2,3 corresponds to the number of -C...Higgses whose pole mass is computed. If IHIGGS=0 only running -C...masses are given, what makes the running of the program -c...much faster and it is quite generally a good approximation -c...(for a theoretical discussion see ref. above). If IHIGGS=1, -C...only the pole mass for H is computed. If IHIGGS=2, then h and H, -c...and if IHIGGS=3, then h,H,A polarizations are computed - -C...Output: MH and MHP which are the lightest CP-even Higgs running -C...and pole masses, respectively; HM and HMP are the heaviest CP-even -C...Higgs running and pole masses, repectively; SA and CA are the -C...SIN(ALPHA) and COS(ALPHA) where ALPHA is the Higgs mixing angle -C...AMP is the CP-odd Higgs pole mass. STOP1,STOP2,SBOT1 and SBOT2 -C...are the stop and sbottom mass eigenvalues. Finally, TANBA is -C...the value of TANB at the CP-odd Higgs mass scale - -C...This subroutine makes use of CERN library subroutine -C...integration package, which makes the computation of the -C...pole Higgs masses somewhat faster. We thank P. Janot for this -C...improvement. Those who are not able to call the CERN -C...libraries, please use the subroutine SUBHPOLE2.F, which -C...although somewhat slower, gives identical results - - SUBROUTINE PYPOLE(IHIGGS,XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB,XMU, - &XMH,XMHP,HM,HMP,AMP,SA,CA,STOP1,STOP2,SBOT1,SBOT2,TANBA,XMG,DT,DB) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...Parameters. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DIMENSION DELTA(2,2),COUPT(2,2),T(2,2),SSTOP2(2), - &SSBOT2(2),B(2,2),COUPB(2,2), - &HCOUPT(2,2),HCOUPB(2,2), - &ACOUPT(2,2),ACOUPB(2,2),PR(3), POLAR(3) - - DELTA(1,1) = 1D0 - DELTA(2,2) = 1D0 - DELTA(1,2) = 0D0 - DELTA(2,1) = 0D0 - V = 174.1D0 - XMZ=91.18D0 - PI=PARU(1) - RXMT=PYMRUN(6,XMT**2) - CALL PYRGHM(XMC,XMA,TANB,XMQ,XMUR,XMDR,XMT,AT,AB, - &XMU,XMH,HM,XMCH,SA,CA,SAB,CAB,TANBA,XMG,DT,DB) - - SINB = TANB/(TANB**2+1D0)**0.5D0 - COSB = 1D0/(TANB**2+1D0)**0.5D0 - COS2B = SINB**2 - COSB**2 - SINBPA = SINB*CA + COSB*SA - COSBPA = COSB*CA - SINB*SA - RMBOT = PYMRUN(5,XMT**2) - XMQ2 = XMQ**2 - XMUR2 = XMUR**2 - IF(XMUR.LT.0D0) XMUR2=-XMUR2 - XMDR2 = XMDR**2 - XMST11 = RXMT**2 + XMQ2 - 0.35D0*XMZ**2*COS2B - XMST22 = RXMT**2 + XMUR2 - 0.15D0*XMZ**2*COS2B - IF(XMST11.LT.0D0) GOTO 500 - IF(XMST22.LT.0D0) GOTO 500 - XMSB11 = RMBOT**2 + XMQ2 + 0.42D0*XMZ**2*COS2B - XMSB22 = RMBOT**2 + XMDR2 + 0.08D0*XMZ**2*COS2B - IF(XMSB11.LT.0D0) GOTO 500 - IF(XMSB22.LT.0D0) GOTO 500 -C WMST11 = RXMT**2 + XMQ2 -C WMST22 = RXMT**2 + XMUR2 - XMST12 = RXMT*(AT - XMU/TANB) - XMSB12 = RMBOT*(AB - XMU*TANB) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...STOP EIGENVALUES CALCULATION -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - STOP12 = 0.5D0*(XMST11+XMST22) + - &0.5D0*((XMST11+XMST22)**2 - - &4D0*(XMST11*XMST22 - XMST12**2))**0.5D0 - STOP22 = 0.5D0*(XMST11+XMST22) - - &0.5D0*((XMST11+XMST22)**2 - 4D0*(XMST11*XMST22 - - &XMST12**2))**0.5D0 - - IF(STOP22.LT.0D0) GOTO 500 - SSTOP2(1) = STOP12 - SSTOP2(2) = STOP22 - STOP1 = STOP12**0.5D0 - STOP2 = STOP22**0.5D0 -C STOP1W = STOP1 -C STOP2W = STOP2 - - IF(XMST12.EQ.0D0) XST11 = 1D0 - IF(XMST12.EQ.0D0) XST12 = 0D0 - IF(XMST12.EQ.0D0) XST21 = 0D0 - IF(XMST12.EQ.0D0) XST22 = 1D0 - - IF(XMST12.EQ.0D0) GOTO 110 - - 100 XST11 = XMST12/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 - XST12 = - (XMST11-STOP12)/(XMST12**2+(XMST11-STOP12)**2)**0.5D0 - XST21 = XMST12/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 - XST22 = - (XMST11-STOP22)/(XMST12**2+(XMST11-STOP22)**2)**0.5D0 - - 110 T(1,1) = XST11 - T(2,2) = XST22 - T(1,2) = XST12 - T(2,1) = XST21 - - SBOT12 = 0.5D0*(XMSB11+XMSB22) + - &0.5D0*((XMSB11+XMSB22)**2 - - &4D0*(XMSB11*XMSB22 - XMSB12**2))**0.5D0 - SBOT22 = 0.5D0*(XMSB11+XMSB22) - - &0.5D0*((XMSB11+XMSB22)**2 - 4D0*(XMSB11*XMSB22 - - &XMSB12**2))**0.5D0 - IF(SBOT22.LT.0D0) GOTO 500 - SBOT1 = SBOT12**0.5D0 - SBOT2 = SBOT22**0.5D0 - - SSBOT2(1) = SBOT12 - SSBOT2(2) = SBOT22 - - IF(XMSB12.EQ.0D0) XSB11 = 1D0 - IF(XMSB12.EQ.0D0) XSB12 = 0D0 - IF(XMSB12.EQ.0D0) XSB21 = 0D0 - IF(XMSB12.EQ.0D0) XSB22 = 1D0 - - IF(XMSB12.EQ.0D0) GOTO 130 - - 120 XSB11 = XMSB12/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 - XSB12 = - (XMSB11-SBOT12)/(XMSB12**2+(XMSB11-SBOT12)**2)**0.5D0 - XSB21 = XMSB12/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 - XSB22 = - (XMSB11-SBOT22)/(XMSB12**2+(XMSB11-SBOT22)**2)**0.5D0 - - 130 B(1,1) = XSB11 - B(2,2) = XSB22 - B(1,2) = XSB12 - B(2,1) = XSB21 - - - SINT = 0.2320D0 - SQR = DSQRT(2D0) - VP = 174.1D0*SQR - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...STARTING OF LIGHT HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.0) GOTO 490 - - DO 150 I = 1,2 - DO 140 J = 1,2 - COUPT(I,J) = - & SINT*XMZ**2*2D0*SQR/174.1D0/3D0*SINBPA*(DELTA(I,J) + - & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) - & -RXMT**2/174.1D0**2*VP/SINB*CA*DELTA(I,J) - & -RXMT/VP/SINB*(AT*CA + XMU*SA)*(T(1,I)*T(2,J) + - & T(1,J)*T(2,I)) - 140 CONTINUE - 150 CONTINUE - - - DO 170 I = 1,2 - DO 160 J = 1,2 - COUPB(I,J) = - & -SINT*XMZ**2*2D0*SQR/174.1D0/6D0*SINBPA*(DELTA(I,J) + - & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) - & +RMBOT**2/174.1D0**2*VP/COSB*SA*DELTA(I,J) - & +RMBOT/VP/COSB*(AB*SA + XMU*CA)*(B(1,I)*B(2,J) + - & B(1,J)*B(2,I)) - 160 CONTINUE - 170 CONTINUE - - PRUN = XMH - EPS = 1D-4*PRUN - ITER = 0 - 180 ITER = ITER + 1 - DO 230 I3 = 1,3 - - PR(I3)=PRUN+(I3-2)*EPS/2 - P2=PR(I3)**2 - POLT = 0D0 - DO 200 I = 1,2 - DO 190 J = 1,2 - POLT = POLT + COUPT(I,J)**2*3D0* - & PYFINT(P2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 190 CONTINUE - 200 CONTINUE - - POLB = 0D0 - DO 220 I = 1,2 - DO 210 J = 1,2 - POLB = POLB + COUPB(I,J)**2*3D0* - & PYFINT(P2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 210 CONTINUE - 220 CONTINUE -C RXMT2 = RXMT**2 - XMT2=XMT**2 - - POLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & CA**2/SINB**2 * - & (-2D0*XMT**2+0.5D0*P2)* - & PYFINT(P2,XMT2,XMT2) - - POL = POLT + POLB + POLTT - POLAR(I3) = P2 - XMH**2 - POL - 230 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - P2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 240 - GOTO 180 - 240 CONTINUE - - XMHP = DSQRT(P2) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...END OF LIGHT HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - 250 IF(IHIGGS.EQ.1) GOTO 490 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C... STARTING OF HEAVY HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 270 I = 1,2 - DO 260 J = 1,2 - HCOUPT(I,J) = - & -SINT*XMZ**2*2D0*SQR/174.1D0/3D0*COSBPA*(DELTA(I,J) + - & (3D0 - 8D0*SINT)/4D0/SINT*T(1,I)*T(1,J)) - & -RXMT**2/174.1D0**2*VP/SINB*SA*DELTA(I,J) - & -RXMT/VP/SINB*(AT*SA - XMU*CA)*(T(1,I)*T(2,J) + - & T(1,J)*T(2,I)) - 260 CONTINUE - 270 CONTINUE - - DO 290 I = 1,2 - DO 280 J = 1,2 - HCOUPB(I,J) = - & SINT*XMZ**2*2D0*SQR/174.1D0/6D0*COSBPA*(DELTA(I,J) + - & (3D0 - 4D0*SINT)/2D0/SINT*B(1,I)*B(1,J)) - & -RMBOT**2/174.1D0**2*VP/COSB*CA*DELTA(I,J) - & -RMBOT/VP/COSB*(AB*CA - XMU*SA)*(B(1,I)*B(2,J) + - & B(1,J)*B(2,I)) - HCOUPB(I,J)=0D0 - 280 CONTINUE - 290 CONTINUE - - PRUN = HM - EPS = 1D-4*PRUN - ITER = 0 - 300 ITER = ITER + 1 - DO 350 I3 = 1,3 - PR(I3)=PRUN+(I3-2)*EPS/2 - HP2=PR(I3)**2 - - HPOLT = 0D0 - DO 320 I = 1,2 - DO 310 J = 1,2 - HPOLT = HPOLT + HCOUPT(I,J)**2*3D0* - & PYFINT(HP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 310 CONTINUE - 320 CONTINUE - - HPOLB = 0D0 - DO 340 I = 1,2 - DO 330 J = 1,2 - HPOLB = HPOLB + HCOUPB(I,J)**2*3D0* - & PYFINT(HP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 330 CONTINUE - 340 CONTINUE - -C RXMT2 = RXMT**2 - XMT2 = XMT**2 - - HPOLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & SA**2/SINB**2 * - & (-2D0*XMT**2+0.5D0*HP2)* - & PYFINT(HP2,XMT2,XMT2) - - HPOL = HPOLT + HPOLB + HPOLTT - POLAR(I3) =HP2-HM**2-HPOL - 350 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - HP2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 360 - GOTO 300 - 360 CONTINUE - - - 370 CONTINUE - HMP = HP2**0.5D0 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C... END OF HEAVY HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.2) GOTO 490 - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...BEGINNING OF PSEUDOSCALAR HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 390 I = 1,2 - DO 380 J = 1,2 - ACOUPT(I,J) = - & -RXMT/VP/SINB*(AT*COSB + XMU*SINB)* - & (T(1,I)*T(2,J) -T(1,J)*T(2,I)) - 380 CONTINUE - 390 CONTINUE - DO 410 I = 1,2 - DO 400 J = 1,2 - ACOUPB(I,J) = - & RMBOT/VP/COSB*(AB*SINB + XMU*COSB)* - & (B(1,I)*B(2,J) -B(1,J)*B(2,I)) - 400 CONTINUE - 410 CONTINUE - - PRUN = XMA - EPS = 1D-4*PRUN - ITER = 0 - 420 ITER = ITER + 1 - DO 470 I3 = 1,3 - PR(I3)=PRUN+(I3-2)*EPS/2 - AP2=PR(I3)**2 - APOLT = 0D0 - DO 440 I = 1,2 - DO 430 J = 1,2 - APOLT = APOLT + ACOUPT(I,J)**2*3D0* - & PYFINT(AP2,SSTOP2(I),SSTOP2(J))/16D0/PI**2 - 430 CONTINUE - 440 CONTINUE - APOLB = 0D0 - DO 460 I = 1,2 - DO 450 J = 1,2 - APOLB = APOLB + ACOUPB(I,J)**2*3D0* - & PYFINT(AP2,SSBOT2(I),SSBOT2(J))/16D0/PI**2 - 450 CONTINUE - 460 CONTINUE -C RXMT2 = RXMT**2 - XMT2=XMT**2 - APOLTT = - & 3D0*RXMT**2/8D0/PI**2/ V **2* - & COSB**2/SINB**2 * - & (-0.5D0*AP2)* - & PYFINT(AP2,XMT2,XMT2) - APOL = APOLT + APOLB + APOLTT - POLAR(I3) = AP2 - XMA**2 -APOL - 470 CONTINUE - DERIV = (POLAR(3)-POLAR(1))/EPS - DRUN = - POLAR(2)/DERIV - PRUN = PRUN + DRUN - AP2 = PRUN**2 - IF( ABS(DRUN) .LT. 1D-4 .OR.ITER.GT.500) GOTO 480 - GOTO 420 - 480 CONTINUE - - AMP = DSQRT(AP2) - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C...END OF PSEUDOSCALAR HIGGS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - IF(IHIGGS.EQ.3) GOTO 490 - - 490 CONTINUE - RETURN - 500 CONTINUE - WRITE(MSTU(11),*) ' EXITING IN PYPOLE ' - WRITE(MSTU(11),*) ' XMST11,XMST22 = ',XMST11,XMST22 - WRITE(MSTU(11),*) ' XMSB11,XMSB22 = ',XMSB11,XMSB22 - WRITE(MSTU(11),*) ' STOP22,SBOT22 = ',STOP22,SBOT22 - STOP - END - -C********************************************************************* - -C...PYPREP -C...Rearranges partons along strings. -C...Special considerations for systems with junctions, with -C...possibility of junction-antijunction annihilation. -C...Allows small systems to collapse into one or two particles. -C...Checks flavours and colour singlet invariant masses. - - SUBROUTINE PYPREP(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays. - DIMENSION DPS(5),DPC(5),UE(3),PG(5),E1(3),E2(3),E3(3),E4(3), - &ECL(3),IJUNC(10,0:4),IPIECE(30,0:4),KFEND(4),KFQ(4), - &IJUR(4),PJU(4,6),IRNG(4,2),TJJ(2,5),T(5),PUL(3,5), - &IJCP(0:6),TJUOLD(5) - -C...Function to give four-product. - 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) - -C...Rearrange parton shower product listing along strings: begin loop. - NOLD=N - I1=N - NJUNC=0 - NPIECE=0 - NJJSTR=0 - MSTU32=MSTU(32)+1 - DO 170 MQGST=1,3 - DO 160 I=MAX(1,IP),N - -C...Special treatment for junctions - IF(K(I,1).EQ.42) THEN -C...First, just store positions - IF (MQGST.EQ.1) THEN - NJUNC=NJUNC+1 - IJUNC(NJUNC,0)=I - IJUNC(NJUNC,4)=0 -C...Then look for junction-junction strings (not detected in the -C...main search below). - ELSE IF (MQGST.EQ.2.AND.NPIECE.NE.3*NJUNC) THEN - IF (NJJSTR.EQ.0) THEN - NJJSTR = (3*NJUNC-NPIECE)/2 - ENDIF -C...Check how many already identified strings end on this junction - ILC=0 - DO 100 J=1,NPIECE - IF (IPIECE(J,4).EQ.I) ILC=ILC+1 - 100 CONTINUE -C...If only 2, third one must be to another junction - IF (ILC.EQ.2) THEN -C...The colour information in the junction is unreadable for the -C...colour space search further down in this routine, so we must -C...start on the colour mother of this junction and then "artificially" -C...prevent the colour mother from connecting here again. - IA=MOD(K(I,4),MSTU(5)) - KCS=4 - IF (MOD(MOD(K(I,4)/MSTU(5),MSTU(5)),2).EQ.1) KCS=5 - K(IA,KCS) = K(IA,KCS) + MSTU(5)**2 - K(I,KCS) = K(I,KCS) + 2*MSTU(5)**2 - I1BEG = I1 - NSTP = 0 - GOTO 150 - ELSE IF (ILC.NE.3) THEN -C...This could happen if 2 legs of a junction connect to other -C...junctions. - CALL PYERRM(12, - & '(PYPREP:) Too many junction-junction strings.') - ENDIF - ENDIF - ENDIF - -C...Look for coloured string endpoint, or (later) leftover gluon. - IF(K(I,1).NE.3) GOTO 160 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 160 - KQ=KCHG(KC,2) - IF(KQ.EQ.0.OR.(MQGST.LE.2.AND.KQ.EQ.2)) GOTO 160 - -C...Pick up loose string end. - KCS=4 - IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 - IA=I - IB=I - I1BEG=I1 - NSTP=0 - 110 NSTP=NSTP+1 - IF(NSTP.GT.4*N) THEN - CALL PYERRM(14,'(PYPREP:) caught in infinite loop') - RETURN - ENDIF - -C...Copy undecayed parton. Finished if reached string endpoint. - IF(K(IA,1).EQ.3) THEN - IF(I1.GE.MSTU(4)-MSTU32-5) THEN - CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') - RETURN - ENDIF - I1=I1+1 - K(I1,1)=2 - IF(NSTP.GE.2.AND.KCHG(PYCOMP(K(IA,2)),2).NE.2) K(I1,1)=1 - K(I1,2)=K(IA,2) - K(I1,3)=IA - K(I1,4)=0 - K(I1,5)=0 - DO 120 J=1,5 - P(I1,J)=P(IA,J) - V(I1,J)=V(IA,J) - 120 CONTINUE - K(IA,1)=K(IA,1)+10 - IF(K(I1,1).EQ.1) GOTO 160 - ENDIF - -C...Also finished (for now) if reached junction; then copy to end. - IF(K(IA,1).EQ.42) THEN - NCOPY=I1-I1BEG - IF(I1.GE.MSTU(4)-MSTU32-NCOPY-5) THEN - CALL PYERRM(11,'(PYPREP:) no more memory left in PYJETS') - RETURN - ENDIF - IF (MQGST.LE.2.AND.NCOPY.NE.0) THEN - DO 140 ICOPY=1,NCOPY - DO 130 J=1,5 - K(MSTU(4)-MSTU32-ICOPY,J)=K(I1BEG+ICOPY,J) - P(MSTU(4)-MSTU32-ICOPY,J)=P(I1BEG+ICOPY,J) - V(MSTU(4)-MSTU32-ICOPY,J)=V(I1BEG+ICOPY,J) - 130 CONTINUE - 140 CONTINUE - ENDIF - NPIECE=NPIECE+1 - IPIECE(NPIECE,0)=I - IPIECE(NPIECE,1)=MSTU32+1 - IPIECE(NPIECE,2)=MSTU32+NCOPY - IPIECE(NPIECE,3)=IB - IPIECE(NPIECE,4)=IA - MSTU32=MSTU32+NCOPY - I1=I1BEG - GOTO 160 - ENDIF - -C...GOTO next parton in colour space. - 150 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 PYERRM(12,'(PYPREP:) 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 110 - K(I1,1)=1 - 160 CONTINUE - 170 CONTINUE - -C...Junction systems remain. - IJU=0 - IJUS=0 - IJUCNT=0 - MREV=0 - IJJSTR=0 - 180 IJUCNT=IJUCNT+1 - IF (IJUCNT.LE.NJUNC) THEN -C...If we are not processing a j-j string, treat this junction as new. - IF (IJJSTR.EQ.0) THEN - IJU=IJUNC(IJUCNT,0) - MREV=0 -C...If junction has already been read, ignore it. - IF (IJUNC(IJUCNT,4).EQ.1) GOTO 180 -C...If we are on a j-j string, goto second j-j junction. - ELSE - IJUCNT=IJUCNT-1 - IJU=IJUS - ENDIF -C...Mark selected junction read. - DO 190 J=1,NJUNC - IF (IJUNC(J,0).EQ.IJU) IJUNC(J,4)=1 - 190 CONTINUE - -C...Determine junction type - ITJUNC = MOD(K(IJU,4)/MSTU(5),MSTU(5)) -C...Type 1 and 2 junctions: ~chi -> q q q, ~chi -> qbar,qbar,qbar -C...Type 3 and 4 junctions: ~qbar -> q q , ~q -> qbar qbar -C...Type 5 and 6 junctions: ~g -> q q q, ~g -> qbar qbar qbar - IF (ITJUNC.GE.1.AND.ITJUNC.LE.6) THEN - IHK=0 - 200 IHK=IHK+1 -C...Find which quarks belong to given junction. - IF(IHK.EQ.1) IEND=MOD(K(IJU,5),MSTU(5)) - IF(IHK.EQ.2) IEND=MOD(K(IJU,5)/MSTU(5),MSTU(5)) -C...IHK = 3 is special. Either normal string piece, or j-j string. - IF(IHK.EQ.3) THEN - IEND=MOD(K(IJU,4),MSTU(5)) - IF (MREV.NE.1) THEN - DO 210 IPC=1,NPIECE -C...If there is a j-j string starting on the present junction which has -C...zero length, insert next junction immediately. - IF (IPIECE(IPC,0).EQ.IJU.AND.K(IPIECE(IPC,4),1) - & .EQ.42.AND.IPIECE(IPC,1)-1-IPIECE(IPC,2).EQ.0) THEN - IJJSTR = 1 - GOTO 250 - ENDIF - 210 CONTINUE - MREV = 1 -C...If MREV is 1 and IHK is 3 we are finished with this system. - ELSE - MREV=0 - GOTO 180 - ENDIF - ENDIF - -C...If we've gotten this far, then either IHK < 3, or -C...an interjunction string exists, or just a third normal string. - IJUNC(IJUCNT,IHK)=0 - IJJSTR = 0 -C..Order pieces belonging to this junction. Also look for j-j. - DO 220 IPC=1,NPIECE - IF (IPIECE(IPC,3).EQ.IEND) IJUNC(IJUCNT,IHK)=IPC - IF (IHK.EQ.3.AND.IPIECE(IPC,0).EQ.IJUNC(IJUCNT,0) - & .AND.K(IPIECE(IPC,4),1).EQ.42) THEN - IJUNC(IJUCNT,IHK)=IPC - IJJSTR = 1 - MREV = 0 - ENDIF - 220 CONTINUE -C...Copy back chains in proper order. MREV=0/1 : descending/ascending - IPC=IJUNC(IJUCNT,IHK) - DO 240 ICP=IPIECE(IPC,1+MREV),IPIECE(IPC,2-MREV),1-2*MREV - I1=I1+1 - DO 230 J=1,5 - K(I1,J)=K(MSTU(4)-ICP,J) - P(I1,J)=P(MSTU(4)-ICP,J) - V(I1,J)=V(MSTU(4)-ICP,J) - 230 CONTINUE - 240 CONTINUE - K(I1,1)=2 -C...Mark last quark. - IF (MREV.EQ.1.AND.IHK.GE.2) K(I1,1)=1 -C...Do not insert junctions at wrong places. - IF(IHK.LT.2.OR.MREV.NE.0) GOTO 270 -C...Insert junction. - 250 IJUS = IJU - IF (IHK.EQ.3) THEN -C...Shift to end junction if a j-j string has been processed. - IF (IJJSTR.NE.0) IJUS = IPIECE(IPC,4) - MREV= 1 - ENDIF - I1=I1+1 - DO 260 J=1,5 - K(I1,J)=0 - P(I1,J)=0. - V(I1,J)=0. - 260 CONTINUE - K(I1,1)=41 - K(IJUS,1)=K(IJUS,1)+10 - K(I1,2)=K(IJUS,2) - K(I1,3)=K(IJUS,3) - 270 IF (IHK.LT.3) GOTO 200 - ELSE - CALL PYERRM(12,'(PYPREP:) Unknown junction type') - ENDIF - IF (IJUCNT.NE.NJUNC) GOTO 180 - ENDIF - N=I1 - -C...Rearrange three strings from junction, e.g. in case one has been -C...shortened by shower, so the last is the largest-energy one. - IF(NJUNC.GE.1) THEN -C...Find systems with exactly one junction. - MJUN1=0 - NBEG=NOLD+1 - DO 380 I=NOLD+1,N - IF(K(I,1).NE.1.AND.K(I,1).NE.41) THEN - ELSEIF(K(I,1).EQ.41) THEN - MJUN1=MJUN1+1 - ELSEIF(K(I,1).EQ.1.AND.MJUN1.NE.1) THEN - MJUN1=0 - NBEG=I+1 - ELSE - NEND=I -C...Sum up energy-momentum in each junction string. - DO 280 J=1,5 - PJU(1,J)=0D0 - PJU(2,J)=0D0 - PJU(3,J)=0D0 - 280 CONTINUE - NJU=0 - DO 300 I1=NBEG,NEND - IF(K(I1,2).NE.21) THEN - NJU=NJU+1 - IJUR(NJU)=I1 - ENDIF - DO 290 J=1,5 - PJU(MIN(NJU,3),J)=PJU(MIN(NJU,3),J)+P(I1,J) - 290 CONTINUE - 300 CONTINUE -C...Find which of them has highest energy (minus mass) in rest frame. - DO 310 J=1,5 - PJU(4,J)=PJU(1,J)+PJU(2,J)+PJU(3,J) - 310 CONTINUE - PMJU=SQRT(MAX(0D0,PJU(4,4)**2-PJU(4,1)**2-PJU(4,2)**2- - & PJU(4,3)**2)) - DO 320 I2=1,3 - PJU(I2,6)=(PJU(4,4)*PJU(I2,4)-PJU(4,1)*PJU(I2,1)- - & PJU(4,2)*PJU(I2,2)-PJU(4,3)*PJU(I2,3))/PMJU-PJU(I2,5) - 320 CONTINUE - IF(PJU(3,6).LT.MIN(PJU(1,6),PJU(2,6))) THEN -C...Decide how to rearrange so that new last has highest energy. - IF(PJU(1,6).LT.PJU(2,6)) THEN - IRNG(1,1)=IJUR(1) - IRNG(1,2)=IJUR(2)-1 - IRNG(2,1)=IJUR(4) - IRNG(2,2)=IJUR(3)+1 - IRNG(4,1)=IJUR(3)-1 - IRNG(4,2)=IJUR(2) - ELSE - IRNG(1,1)=IJUR(4) - IRNG(1,2)=IJUR(3)+1 - IRNG(2,1)=IJUR(2) - IRNG(2,2)=IJUR(3)-1 - IRNG(4,1)=IJUR(2)-1 - IRNG(4,2)=IJUR(1) - ENDIF - IRNG(3,1)=IJUR(3) - IRNG(3,2)=IJUR(3) -C...Copy in correct order below bottom of current event record. - I2=N - DO 350 II=1,4 - DO 340 I1=IRNG(II,1),IRNG(II,2), - & ISIGN(1,IRNG(II,2)-IRNG(II,1)) - I2=I2+1 - DO 330 J=1,5 - K(I2,J)=K(I1,J) - P(I2,J)=P(I1,J) - V(I2,J)=V(I1,J) - 330 CONTINUE - IF(K(I2,1).EQ.1) K(I2,1)=2 - 340 CONTINUE - 350 CONTINUE - K(I2,1)=1 -C...Copy back up, overwriting but now in correct order. - DO 370 I1=NBEG,NEND - I2=I1-NBEG+N+1 - DO 360 J=1,5 - K(I1,J)=K(I2,J) - P(I1,J)=P(I2,J) - V(I1,J)=V(I2,J) - 360 CONTINUE - 370 CONTINUE - ENDIF - MJUN1=0 - NBEG=I+1 - ENDIF - 380 CONTINUE -C++SKANDS -C...Check whether q-q-j-j-qbar-qbar systems should be collapsed -C...to two q-qbar systems. -C...(MSTJ(19)=1 forces q-q-j-j-qbar-qbar.) - IF (MSTJ(19).NE.1) THEN - MJUN1 = 0 - JJGLUE = 0 - NBEG = NOLD+1 -C...Force collapse when MSTJ(19)=2. - IF (MSTJ(19).EQ.2) THEN - DELMJJ = 1D9 - DELMQQ = 0D0 - ENDIF -C...Find systems with exactly two junctions. - DO 610 I=NOLD+1,N -C...Count junctions - IF (K(I,1).EQ.41) THEN - MJUN1 = MJUN1+1 -C...Check for interjunction gluons - IF (MJUN1.EQ.2.AND.K(I-1,1).NE.41) THEN - JJGLUE = 1 - ENDIF - ELSEIF(K(I,1).EQ.1.AND.(MJUN1.NE.2)) THEN -C...If end of system reached with either zero or one junction, restart -C...with next system. - MJUN1 = 0 - JJGLUE = 0 - NBEG = I+1 - ELSEIF(K(I,1).EQ.1) THEN -C...If end of system reached with exactly two junctions, compute string -C...length measure for the (q-q-j-j-qbar-qbar) topology and compare with -C...length measure for the (q-qbar)(q-qbar) topology. - NEND=I -C...Loop down through chain. - ISID=0 - DO 390 I1=NBEG,NEND -C...Store string piece division locations in event record - IF (K(I1,2).NE.21) THEN - ISID = ISID+1 - IJCP(ISID) = I1 - ENDIF - 390 CONTINUE -C...Randomly choose between (1,3)(2,4) and (1,4)(2,3) topologies. - ISW=0 - IF (PYR(0).LT.0.5D0) ISW=1 -C...Randomly choose which qqbar string gets the jj gluons. - IGS=1 - IF (PYR(0).GT.0.5D0) IGS=2 -C...Only compute string lengths when no topology forced. - IF (MSTJ(19).EQ.0) THEN -C...Repeat following for each junction - DO 480 IJU=1,2 -C...Initialize iterative procedure for finding JRF - IJRFIT=0 - DO 400 IX=1,3 - TJUOLD(IX)=0D0 - 400 CONTINUE - TJUOLD(4)=1D0 -C...Start iteration. Sum up momenta in string pieces - 410 DO 450 IJS=1,3 -C...JD=-1 for first junction, +1 for second junction. -C...Find out where piece starts and ends and which direction to go. - JD=2*IJU-3 - IF (IJS.LE.2) THEN - IA = IJCP((IJU-1)*7 - JD*(IJS+1)) + JD - IB = IJCP((IJU-1)*7 - JD*IJS) - ELSEIF (IJS.EQ.3) THEN - JD =-JD - IA = IJCP((IJU-1)*7 + JD*(IJS)) + JD - IB = IJCP((IJU-1)*7 + JD*(IJS+3)) - ENDIF -C...Initialize junction pull 4-vector. - DO 420 J=1,5 - PUL(IJS,J)=0D0 - 420 CONTINUE -C...Initialize weight - PWT = 0D0 - PWTOLD = 0D0 -C...Sum up (weighted) momenta along each string piece - DO 440 ISP=IA,IB,JD -C...If present parton not last in chain - IF (ISP.NE.IA.AND.ISP.NE.IB) THEN -C...If last parton was a junction, store present weight - IF (K(ISP-JD,2).EQ.88) THEN - PWTOLD = PWT -C...If last parton was a quark, reset to stored weight. - ELSEIF (K(ISP-JD,2).NE.21) THEN - PWT = PWTOLD - ENDIF - ENDIF -C...Skip next parton if weight already large - IF (PWT.GT.10D0) GOTO 440 -C...Compute momentum in TJUOLD frame: - TDP=TJUOLD(1)*P(ISP,1)+TJUOLD(2)*P(ISP,2)+TJUOLD(3 - & )*P(ISP,3) - BFC=TDP/(1D0+TJUOLD(4))+P(ISP,4) - DO 430 J=1,3 - TMP=P(ISP,J)+TJUOLD(J)*BFC - PUL(IJS,J)=PUL(IJS,J)+TMP*EXP(-PWT) - 430 CONTINUE -C...Boosted energy - TMP=TJUOLD(4)*P(ISP,4)+TDP - PUL(IJS,4)=PUL(IJS,J)+TMP*EXP(-PWT) -C...Update weight - PWT=PWT+TMP/PARJ(48) -C...Put |p| rather than m in 5th slot - PUL(IJS,5)=SQRT(PUL(IJS,1)**2+PUL(IJS,2)**2 - & +PUL(IJS,3)**2) - 440 CONTINUE - 450 CONTINUE -C...Compute boost - IJRFIT=IJRFIT+1 - CALL PYJURF(PUL,T) -C...Combine new boost (T) with old boost (TJUOLD) - TMP=T(1)*TJUOLD(1)+T(2)*TJUOLD(2)+T(3)*TJUOLD(3) - DO 460 IX=1,3 - TJUOLD(IX)=T(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+T(4 - & )) - 460 CONTINUE - TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3) - & **2) -C...If last boost small, accept JRF, else iterate. -C...Also prevent possibility of infinite loop. - IF (ABS((T(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. - & IJRFIT.LT.MSTJ(18))THEN - GOTO 410 - ELSEIF (IJRFIT.GE.MSTJ(18)) THEN - CALL PYERRM(1,'(PYPREP:) failed to converge on JRF') - ENDIF -C...Store final boost, with change of sign since TJJ motion vector. - DO 470 IX=1,3 - TJJ(IJU,IX)=-TJUOLD(IX) - 470 CONTINUE - TJJ(IJU,4)=SQRT(1D0+TJJ(IJU,1)**2+TJJ(IJU,2)**2 - & +TJJ(IJU,3)**2) - 480 CONTINUE -C...String length measure for (q-qbar)(q-qbar) topology. -C...Note only momenta of nearest partons used (since rest of system -C...identical). - IF (JJGLUE.EQ.0) THEN - DELMQQ=4D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1)*FOUR(IJCP(3) - & -1,IJCP(5-ISW)+1) - ELSE -C...Put jj gluons on selected string (IGS selected randomly above). - IF (IGS.EQ.1) THEN - DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 - & ,IJCP(4+ISW)+1)*FOUR(IJCP(3)-1,IJCP(5-ISW)+1) - ELSE - DELMQQ=8D0*FOUR(IJCP(2)-1,IJCP(4+ISW)+1) - & *FOUR(IJCP(3)-1,IJCP(4)-1)*FOUR(IJCP(3)+1 - & ,IJCP(5-ISW)+1) - ENDIF - ENDIF -C...String length measure for q-q-j-j-q-q topology. - T1G1=0D0 - T2G2=0D0 - T1T2=0D0 - T1P1=0D0 - T1P2=0D0 - T2P3=0D0 - T2P4=0D0 - ISGN=-1 -C...Note only momenta of nearest partons used (since rest of system -C...identical). - DO 490 IX=1,4 - IF (IX.EQ.4) ISGN=1 - T1P1=T1P1+ISGN*TJJ(1,IX)*P(IJCP(2)-1,IX) - T1P2=T1P2+ISGN*TJJ(1,IX)*P(IJCP(3)-1,IX) - T2P3=T2P3+ISGN*TJJ(2,IX)*P(IJCP(4)+1,IX) - T2P4=T2P4+ISGN*TJJ(2,IX)*P(IJCP(5)+1,IX) - IF (JJGLUE.EQ.0) THEN -C...Junction motion vector dot product gives length when inter-junction -C...gluons absent. - T1T2=T1T2+ISGN*TJJ(1,IX)*TJJ(2,IX) - ELSE -C...Junction motion vector dot products with gluon momenta give length -C...when inter-junction gluons present. - T1G1=T1G1+ISGN*TJJ(1,IX)*P(IJCP(3)+1,IX) - T2G2=T2G2+ISGN*TJJ(2,IX)*P(IJCP(4)-1,IX) - ENDIF - 490 CONTINUE - DELMJJ=16D0*T1P1*T1P2*T2P3*T2P4 - IF (JJGLUE.EQ.0) THEN - DELMJJ=DELMJJ*(T1T2+SQRT(T1T2**2-1)) - ELSE - DELMJJ=DELMJJ*4D0*T1G1*T2G2 - ENDIF - ENDIF -C...If delmjj > delmqq collapse string system to q-qbar q-qbar -C...(Always the case for MSTJ(19)=2 due to initialization above) - IF (DELMJJ.GT.DELMQQ) THEN -C...Put new system at end of event record - NCOP=N - DO 560 IST=1,2 - DO 510 ICOP=IJCP(IST),IJCP(IST+1)-1 - NCOP=NCOP+1 - DO 500 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 500 CONTINUE - 510 CONTINUE - IF (JJGLUE.NE.0.AND.IST.EQ.IGS) THEN -C...Insert inter-junction gluon string piece (reversed) - NJJGL=0 - DO 530 ICOP=IJCP(4)-1,IJCP(3)+1,-1 - NJJGL=NJJGL+1 - NCOP=NCOP+1 - DO 520 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 520 CONTINUE - 530 CONTINUE - ENDIF - IFC=-2*IST+3 - DO 550 ICOP=IJCP(IST+IFC*ISW+3)+1,IJCP(IST+IFC*ISW+4) - NCOP=NCOP+1 - DO 540 IX=1,5 - P(NCOP,IX)=P(ICOP,IX) - K(NCOP,IX)=K(ICOP,IX) - 540 CONTINUE - 550 CONTINUE - K(NCOP,1)=1 - 560 CONTINUE -C...Copy system back in right order - DO 580 ICOP=NBEG,NEND-2 - DO 570 IX=1,5 - P(ICOP,IX)=P(N+ICOP-NBEG+1,IX) - K(ICOP,IX)=K(N+ICOP-NBEG+1,IX) - 570 CONTINUE - 580 CONTINUE -C...Shift down rest of event record - DO 600 ICOP=NEND+1,N - DO 590 IX=1,5 - P(ICOP-2,IX)=P(ICOP,IX) - K(ICOP-2,IX)=K(ICOP,IX) - 590 CONTINUE - 600 CONTINUE -C...Update length of event record. - N=N-2 - ENDIF - MJUN1=0 - NBEG=I+1 - ENDIF - 610 CONTINUE - ENDIF - ENDIF - -C...Done if no checks on small-mass systems. - IF(MSTJ(14).LT.0) RETURN - IF(MSTJ(14).EQ.0) GOTO 1050 - -C...Find lowest-mass colour singlet jet system. - NS=N - 620 NSIN=N-NS - PDMIN=1D0+PARJ(32) - IC=0 - DO 680 I=MAX(1,IP),N - 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 630 J=1,4 - DPS(J)=P(I,J) - 630 CONTINUE - MSTJ(93)=1 - DPS(5)=PYMASS(K(I,2)) - ELSEIF(K(I,1).EQ.2.AND.K(I,2).NE.21) THEN - DO 640 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 640 CONTINUE - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - ELSEIF(K(I,1).EQ.2) THEN - DO 650 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 650 CONTINUE - ELSEIF(IC.NE.0.AND.KCHG(PYCOMP(K(I,2)),2).NE.0) THEN - DO 660 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 660 CONTINUE - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))- - & DPS(5) - IF(PD.LT.PDMIN) THEN - PDMIN=PD - DO 670 J=1,5 - DPC(J)=DPS(J) - 670 CONTINUE - IC1=IC - IC2=I - ENDIF - IC=0 - ELSE - NSIN=NSIN+1 - ENDIF - 680 CONTINUE - -C...Done if lowest-mass system above threshold for string frag. - IF(PDMIN.GE.PARJ(32)) GOTO 1050 - -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 - 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...Set up history, assuming cluster -> 2 hadrons. - NBODY=2 - K(N+1,4)=N+2 - K(N+1,5)=N+3 - 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 - V(N+1,5)=0D0 - V(N+2,5)=0D0 - V(N+3,5)=0D0 - -C...Find total flavour content - complicated by presence of junctions. - NQ=0 - NDIQ=0 - DO 690 I=IC1,IC2 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.K(I,2).NE.21) THEN - NQ=NQ+1 - KFQ(NQ)=K(I,2) - IF(IABS(K(I,2)).GT.1000) NDIQ=NDIQ+1 - ENDIF - 690 CONTINUE - -C...If several diquarks, split up one to give even number of flavours. - IF(NQ.EQ.3.AND.NDIQ.GE.2) THEN - I1=3 - IF(IABS(KFQ(3)).LT.1000) I1=1 - KFQ(4)=ISIGN(MOD(IABS(KFQ(I1))/100,10),KFQ(I1)) - KFQ(I1)=KFQ(I1)/1000 - NQ=4 - NDIQ=NDIQ-1 - ENDIF - -C...If four quark ends, join two to diquark. - IF(NQ.EQ.4.AND.NDIQ.EQ.0) THEN - I1=1 - I2=2 - IF(KFQ(I1)*KFQ(I2).LT.0) I2=3 - IF(I2.EQ.3.AND.KFQ(I1)*KFQ(I2).LT.0) I2=4 - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 - KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ - & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) - KFQ(I2)=KFQ(4) - NQ=3 - NDIQ=1 - ENDIF - -C...If two quark ends, plus quark or diquark, join quarks to diquark. - IF(NQ.EQ.3) THEN - I1=1 - I2=2 - IF(IABS(KFQ(I1)).GT.1000) I1=3 - IF(IABS(KFQ(I2)).GT.1000) I2=3 - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFQ(I1).EQ.KFQ(I2)) KFLS=3 - KFQ(I1)=ISIGN(1000*MAX(IABS(KFQ(I1)),IABS(KFQ(I2)))+ - & 100*MIN(IABS(KFQ(I1)),IABS(KFQ(I2)))+KFLS,KFQ(I1)) - KFQ(I2)=KFQ(3) - NQ=2 - NDIQ=NDIQ+1 - ENDIF - -C...Form two particles from flavours of lowest-mass system, if feasible. - NTRY = 0 - 700 NTRY = NTRY + 1 - -C...Open string with two specified endpoint flavours. - IF(NQ.EQ.2) THEN - KC1=PYCOMP(KFQ(1)) - KC2=PYCOMP(KFQ(2)) - IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 1050 - KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) - KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) - IF(KQ1+KQ2.NE.0) GOTO 1050 -C...Start with qq, if there is one. Only allow for rank 1 popcorn meson - 710 K1=KFQ(1) - IF(IABS(KFQ(2)).GT.1000) K1=KFQ(2) - MSTU(125)=0 - CALL PYDCYK(K1,0,KFLN,K(N+2,2)) - CALL PYDCYK(KFQ(1)+KFQ(2)-K1,-KFLN,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 710 - -C...Open string with four specified flavours. - ELSEIF(NQ.EQ.4) THEN - KC1=PYCOMP(KFQ(1)) - KC2=PYCOMP(KFQ(2)) - KC3=PYCOMP(KFQ(3)) - KC4=PYCOMP(KFQ(4)) - IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) GOTO 1050 - KQ1=KCHG(KC1,2)*ISIGN(1,KFQ(1)) - KQ2=KCHG(KC2,2)*ISIGN(1,KFQ(2)) - KQ3=KCHG(KC3,2)*ISIGN(1,KFQ(3)) - KQ4=KCHG(KC4,2)*ISIGN(1,KFQ(4)) - IF(KQ1+KQ2+KQ3+KQ4.NE.0) GOTO 1050 -C...Combine flavours pairwise to form two hadrons. - 720 I1=1 - I2=2 - IF(KQ1*KQ2.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. - & IABS(KFQ(2)).GT.1000)) I2=3 - IF(I2.EQ.3.AND.(KQ1*KQ3.GT.0.OR.(IABS(KFQ(1)).GT.1000.AND. - & IABS(KFQ(3)).GT.1000))) I2=4 - I3=3 - IF(I2.EQ.3) I3=2 - I4=10-I1-I2-I3 - CALL PYDCYK(KFQ(I1),KFQ(I2),KFLDMP,K(N+2,2)) - CALL PYDCYK(KFQ(I3),KFQ(I4),KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 720 - -C...Closed string. - ELSE - IF(IABS(K(IC2,2)).NE.21) GOTO 1050 -C...No room for popcorn mesons in closed string -> 2 hadrons. - MSTU(125)=0 - 730 CALL PYDCYK(1+INT((2D0+PARJ(2))*PYR(0)),0,KFLN,KFDMP) - CALL PYDCYK(KFLN,0,KFLM,K(N+2,2)) - CALL PYDCYK(-KFLN,-KFLM,KFLDMP,K(N+3,2)) - IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 730 - ENDIF - P(N+2,5)=PYMASS(K(N+2,2)) - P(N+3,5)=PYMASS(K(N+3,2)) - -C...If it does not work: try again (a number of times), give up (if no -C...place to shuffle momentum or too many flavours), or form one hadron. - IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) THEN - IF(NTRY.LT.MSTJ(17).OR.(NQ.EQ.4.AND.NTRY.LT.5*MSTJ(17))) THEN - GOTO 700 - ELSEIF(NSIN.EQ.1.OR.NQ.EQ.4) THEN - GOTO 1050 - ELSE - GOTO 800 - END IF - END IF - -C...Perform two-particle decay of jet system. -C...First step: find reference axis in decaying system rest frame. -C...(Borrow slot N+2 for temporary direction.) - DO 740 J=1,4 - P(N+2,J)=P(IC1,J) - 740 CONTINUE - DO 760 I=IC1+1,IC2-1 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. - & KCHG(PYCOMP(K(I,2)),2).NE.0) THEN - FRAC1=FOUR(IC2,I)/(FOUR(IC1,I)+FOUR(IC2,I)) - DO 750 J=1,4 - P(N+2,J)=P(N+2,J)+FRAC1*P(I,J) - 750 CONTINUE - ENDIF - 760 CONTINUE - CALL PYROBO(N+2,N+2,0D0,0D0,-DPC(1)/DPC(4),-DPC(2)/DPC(4), - &-DPC(3)/DPC(4)) - THE1=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) - PHI1=PYANGL(P(N+2,1),P(N+2,2)) - -C...Second step: generate isotropic/anisotropic decay. - PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- - &(P(N+2,5)-P(N+3,5))**2))/(2D0*PECM) - 770 UE(3)=PYR(0) - IF(PARJ(21).LE.0.01D0) UE(3)=1D0 - PT2=(1D0-UE(3)**2)*PA**2 - IF(MSTJ(16).LE.0) THEN - PREV=0.5D0 - ELSE - IF(EXP(-PT2/(2D0*MAX(0.01D0,PARJ(21))**2)).LT.PYR(0)) GOTO 770 - PR1=P(N+2,5)**2+PT2 - PR2=P(N+3,5)**2+PT2 - ALAMBD=SQRT(MAX(0D0,(PECM**2-PR1-PR2)**2-4D0*PR1*PR2)) - PREVCF=PARJ(42) - IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) - PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*ALAMBD*PARJ(40)))) - ENDIF - IF(PYR(0).LT.PREV) UE(3)=-UE(3) - PHI=PARU(2)*PYR(0) - UE(1)=SQRT(1D0-UE(3)**2)*COS(PHI) - UE(2)=SQRT(1D0-UE(3)**2)*SIN(PHI) - DO 780 J=1,3 - P(N+2,J)=PA*UE(J) - P(N+3,J)=-PA*UE(J) - 780 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) - -C...Third step: move back to event frame and set production vertex. - CALL PYROBO(N+2,N+3,THE1,PHI1,DPC(1)/DPC(4),DPC(2)/DPC(4), - &DPC(3)/DPC(4)) - DO 790 J=1,4 - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - V(N+3,J)=V(IC2,J) - 790 CONTINUE - N=N+3 - GOTO 1030 - -C...Else form one particle, if possible. - 800 NBODY=1 - K(N+1,5)=N+2 - DO 810 J=1,4 - V(N+1,J)=V(IC1,J) - V(N+2,J)=V(IC1,J) - 810 CONTINUE - -C...Select hadron flavour from available quark flavours. - 820 IF(NQ.EQ.2.AND.IABS(KFQ(1)).GT.100.AND.IABS(KFQ(2)).GT.100) THEN - GOTO 1050 - ELSEIF(NQ.EQ.2) THEN - CALL PYKFDI(KFQ(1),KFQ(2),KFLDMP,K(N+2,2)) - ELSE - KFLN=1+INT((2D0+PARJ(2))*PYR(0)) - CALL PYKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) - ENDIF - IF(K(N+2,2).EQ.0) GOTO 820 - P(N+2,5)=PYMASS(K(N+2,2)) - -C...Use old algorithm for E/p conservation? (EN) - IF (MSTJ(16).LE.0) GOTO 990 - -C...Find the string piece closest to the cluster by a loop -C...over the undecayed partons not in present cluster. (EN) - DGLOMI=1D30 - IBEG=0 - I0=0 - NJUNC=0 - DO 850 I1=MAX(1,IP),N-1 - IF(K(I,1).EQ.1) NJUNC=0 - IF(K(I,1).EQ.41) NJUNC=NJUNC+1 - IF(I1.GE.IC1-1.AND.I1.LE.IC2) THEN - I0=0 - ELSEIF(K(I1,1).EQ.2) THEN - IF(I0.EQ.0) I0=I1 - I2=I1 - 830 I2=I2+1 - IF(K(I2,1).EQ.41) GOTO 850 - IF(K(I2,1).GT.10) GOTO 830 - IF(KCHG(PYCOMP(K(I2,2)),2).EQ.0) GOTO 830 - IF(K(I1,2).EQ.21.AND.K(I2,2).NE.21.AND.K(I2,1).NE.1.AND. - & NJUNC.EQ.0) GOTO 850 - IF(K(I1,2).NE.21.AND.K(I2,2).EQ.21.AND.NJUNC.NE.0) GOTO 850 - -C...Define velocity vectors e1, e2, ecl and differences e3, e4. - DO 840 J=1,3 - E1(J)=P(I1,J)/P(I1,4) - E2(J)=P(I2,J)/P(I2,4) - ECL(J)=P(N+1,J)/P(N+1,4) - E3(J)=E2(J)-E1(J) - E4(J)=ECL(J)-E1(J) - 840 CONTINUE - -C...Calculate minimal D=(e4-alpha*e3)**2 for 0 0: emit a 'gluon' (EN) - IF (P(N+1,5).GE.P(N+2,5)) THEN - -C...Construct 'gluon' that is needed to put hadron on the mass shell. - FRAC=P(N+2,5)/P(N+1,5) - DO 860 J=1,5 - P(N+2,J)=FRAC*P(N+1,J) - PG(J)=(1D0-FRAC)*P(N+1,J) - 860 CONTINUE - -C... Copy string with new gluon put in. - N=N+2 - I=IBEG-1 - 870 I=I+1 - IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 870 - IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 870 - N=N+1 - DO 880 J=1,5 - K(N,J)=K(I,J) - P(N,J)=P(I,J) - V(N,J)=V(I,J) - 880 CONTINUE - K(I,1)=K(I,1)+10 - K(I,4)=N - K(I,5)=N - K(N,3)=I - IF(I.EQ.IPCS) THEN - N=N+1 - DO 890 J=1,5 - K(N,J)=K(N-1,J) - P(N,J)=PG(J) - V(N,J)=V(N-1,J) - 890 CONTINUE - K(N,2)=21 - K(N,3)=NSAV+1 - ENDIF - IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 870 - GOTO 1030 - -C...Delta_m = m_clus - m_had < 0: have to absorb a 'gluon' instead, -C...from string piece endpoints. - ELSE - -C...Begin by copying string that should give energy to cluster. - N=N+2 - I=IBEG-1 - 900 I=I+1 - IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 900 - IF(KCHG(PYCOMP(K(I,2)),2).EQ.0.AND.K(I,1).NE.41) GOTO 900 - N=N+1 - DO 910 J=1,5 - K(N,J)=K(I,J) - P(N,J)=P(I,J) - V(N,J)=V(I,J) - 910 CONTINUE - K(I,1)=K(I,1)+10 - K(I,4)=N - K(I,5)=N - K(N,3)=I - IF(I.EQ.IPCS) I1=N - IF(K(I,1).EQ.12.OR.K(I,1).EQ.51) GOTO 900 - I2=I1+1 - -C...Set initial Phad. - DO 920 J=1,4 - P(NSAV+2,J)=P(NSAV+1,J) - 920 CONTINUE - -C...Calculate Pg, a part of which will be added to Phad later. (EN) - 930 IF(MSTJ(16).EQ.1) THEN - ALPHA=1D0 - BETA=1D0 - ELSE - ALPHA=FOUR(NSAV+1,I2)/FOUR(I1,I2) - BETA=FOUR(NSAV+1,I1)/FOUR(I1,I2) - ENDIF - DO 940 J=1,4 - PG(J)=ALPHA*P(I1,J)+BETA*P(I2,J) - 940 CONTINUE - PG(5)=SQRT(MAX(1D-20,PG(4)**2-PG(1)**2-PG(2)**2-PG(3)**2)) - -C..Solve 2nd order equation, use the best (smallest) solution. (EN) - PMSCOL=P(NSAV+2,4)**2-P(NSAV+2,1)**2-P(NSAV+2,2)**2- - & P(NSAV+2,3)**2 - PCLPG=(P(NSAV+2,4)*PG(4)-P(NSAV+2,1)*PG(1)- - & P(NSAV+2,2)*PG(2)-P(NSAV+2,3)*PG(3))/PG(5)**2 - DELTA=SQRT(PCLPG**2+(P(NSAV+2,5)**2-PMSCOL)/PG(5)**2)-PCLPG - -C...If all gluon energy eaten, zero it and take a step back. - ITER=0 - IF(DELTA*ALPHA.GT.1D0.AND.I1.GT.NSAV+3) THEN - ITER=1 - DO 950 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+P(I1,J) - P(I1,J)=0D0 - 950 CONTINUE - P(I1,5)=0D0 - K(I1,1)=K(I1,1)+10 - I1=I1-1 - IF(K(I1,1).EQ.41) ITER=-1 - ENDIF - IF(DELTA*BETA.GT.1D0.AND.I2.LT.N) THEN - ITER=1 - DO 960 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+P(I2,J) - P(I2,J)=0D0 - 960 CONTINUE - P(I2,5)=0D0 - K(I2,1)=K(I2,1)+10 - I2=I2+1 - IF(K(I2,1).EQ.41) ITER=-1 - ENDIF - IF(ITER.EQ.1) GOTO 930 - -C...If also all endpoint energy eaten, revert to old procedure. - IF((1D0-DELTA*ALPHA)*P(I1,4).LT.P(I1,5).OR. - & (1D0-DELTA*BETA)*P(I2,4).LT.P(I2,5).OR.ITER.EQ.-1) THEN - DO 970 I=NSAV+3,N - IM=K(I,3) - K(IM,1)=K(IM,1)-10 - K(IM,4)=0 - K(IM,5)=0 - 970 CONTINUE - N=NSAV - GOTO 990 - ENDIF - -C... Construct the collapsed hadron and modified string partons. - DO 980 J=1,4 - P(NSAV+2,J)=P(NSAV+2,J)+DELTA*PG(J) - P(I1,J)=(1D0-DELTA*ALPHA)*P(I1,J) - P(I2,J)=(1D0-DELTA*BETA)*P(I2,J) - 980 CONTINUE - P(I1,5)=(1D0-DELTA*ALPHA)*P(I1,5) - P(I2,5)=(1D0-DELTA*BETA)*P(I2,5) - -C...Finished with string collapse in new scheme. - GOTO 1030 - ENDIF - -C... Use old algorithm; by choice or when in trouble. - 990 CONTINUE -C...Find parton/particle which combines to largest extra mass. - IR=0 - HA=0D0 - HSM=0D0 - DO 1010 MCOMB=1,3 - IF(IR.NE.0) GOTO 1010 - DO 1000 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 1000 - IF(MCOMB.EQ.1) KCI=PYCOMP(K(I,2)) - IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 1000 - IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 1000 - IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) - & GOTO 1000 - HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) - HSR=2D0*HCR+PECM**2-P(N+2,5)**2-2D0*P(N+2,5)*P(I,5) - IF(HSR.GT.HSM) THEN - IR=I - HA=HCR - HSM=HSR - ENDIF - 1000 CONTINUE - 1010 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.5D0*(HB*SQRT(MAX(0D0,((HB+HC)**2-4D0*(HB+HD)*P(N+2,5)**2)/ - & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) - HK1=(0.5D0*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB - DO 1020 J=1,4 - P(N+2,J)=(1D0+HK1)*DPC(J)-HK2*P(IR,J) - P(IR,J)=(1D0+HK2)*P(IR,J)-HK1*DPC(J) - 1020 CONTINUE - N=N+2 - ELSE - CALL PYERRM(3,'(PYPREP:) no match for collapsing cluster') - RETURN - ENDIF - -C...Mark collapsed system and store daughter pointers. Iterate. - 1030 DO 1040 I=IC1,IC2 - IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND. - & KCHG(PYCOMP(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)=NSAV+1+NBODY - ENDIF - ENDIF - IF(K(I,1).EQ.41) K(I,1)=K(I,1)+10 - 1040 CONTINUE - IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 620 - -C...Check flavours and invariant masses in parton systems. - 1050 NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 1060 J=1,5 - DPS(J)=0D0 - 1060 CONTINUE - DO 1090 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 1090 - KC=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 1090 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0) GOTO 1090 - NP=NP+1 - IF(KQ.NE.2) THEN - KFN=KFN+1 - KQS=KQS+KQ - MSTJ(93)=1 - DPS(5)=DPS(5)+PYMASS(K(I,2)) - ENDIF - DO 1070 J=1,4 - DPS(J)=DPS(J)+P(I,J) - 1070 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 - & PYERRM(2,'(PYPREP:) unphysical flavour combination') - IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. - & (0.9D0*PARJ(32)+DPS(5))**2) CALL PYERRM(3, - & '(PYPREP:) too small mass in jet system') - NP=0 - KFN=0 - KQS=0 - NJU=0 - DO 1080 J=1,5 - DPS(J)=0D0 - 1080 CONTINUE - ENDIF - 1090 CONTINUE - - RETURN - END - - -C********************************************************************* - -C...PYPTDI -C...Generates transverse momentum according to a Gaussian. - - SUBROUTINE PYPTDI(KFL,PX,PY) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Generate p_T and azimuthal angle, gives p_x and p_y. - KFLA=IABS(KFL) - PT=PARJ(21)*SQRT(-LOG(MAX(1D-10,PYR(0)))) - IF(PARJ(23).GT.PYR(0)) PT=PARJ(24)*PT - IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT - IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0D0 - PHI=PARU(2)*PYR(0) - PX=PT*COS(PHI) - PY=PT*SIN(PHI) - - RETURN - END - -C*********************************************************************** - -C...PYQQBH -C...Calculates the matrix element for the processes -C...g + g or q + qbar -> Q + Qbar + H (normally with Q = t). -C...REDUCE output and part of the rest courtesy Z. Kunszt, see -C...Z. Kunszt, Nucl. Phys. B247 (1984) 339. - - SUBROUTINE PYQQBH(WTQQBH) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/ -C...Local arrays and function. - DIMENSION PP(15,4),CLR(8,8),FM(10,10),RM(8,8),DX(8) - DOT(I,J)=PP(I,4)*PP(J,4)-PP(I,1)*PP(J,1)-PP(I,2)*PP(J,2)- - &PP(I,3)*PP(J,3) - -C...Mass parameters. - WTQQBH=0D0 - ISUB=MINT(1) - SHPR=SQRT(VINT(26))*VINT(1) - PQ=PMAS(PYCOMP(KFPR(ISUB,2)),1) - PH=SQRT(VINT(21))*VINT(1) - SPQ=PQ**2 - SPH=PH**2 - -C...Set up outgoing kinematics: 1=t, 2=tbar, 3=H. - DO 100 I=1,2 - PT=SQRT(MAX(0D0,VINT(197+5*I))) - PP(I,1)=PT*COS(VINT(198+5*I)) - PP(I,2)=PT*SIN(VINT(198+5*I)) - 100 CONTINUE - PP(3,1)=-PP(1,1)-PP(2,1) - PP(3,2)=-PP(1,2)-PP(2,2) - PMS1=SPQ+PP(1,1)**2+PP(1,2)**2 - PMS2=SPQ+PP(2,1)**2+PP(2,2)**2 - PMS3=SPH+PP(3,1)**2+PP(3,2)**2 - PMT3=SQRT(PMS3) - PP(3,3)=PMT3*SINH(VINT(211)) - PP(3,4)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-PP(3,4))**2-PP(3,3)**2 - PP(1,3)=(-PP(3,3)*(PMS12+PMS1-PMS2)+ - &VINT(213)*(SHPR-PP(3,4))*VINT(220))/(2D0*PMS12) - PP(2,3)=-PP(1,3)-PP(3,3) - PP(1,4)=SQRT(PMS1+PP(1,3)**2) - PP(2,4)=SQRT(PMS2+PP(2,3)**2) - -C...Set up incoming kinematics and derived momentum combinations. - DO 110 I=4,5 - PP(I,1)=0D0 - PP(I,2)=0D0 - PP(I,3)=-0.5D0*SHPR*(-1)**I - PP(I,4)=-0.5D0*SHPR - 110 CONTINUE - DO 120 J=1,4 - PP(6,J)=PP(1,J)+PP(2,J) - PP(7,J)=PP(1,J)+PP(3,J) - PP(8,J)=PP(1,J)+PP(4,J) - PP(9,J)=PP(1,J)+PP(5,J) - PP(10,J)=-PP(2,J)-PP(3,J) - PP(11,J)=-PP(2,J)-PP(4,J) - PP(12,J)=-PP(2,J)-PP(5,J) - PP(13,J)=-PP(4,J)-PP(5,J) - 120 CONTINUE - -C...Derived kinematics invariants. - X1=DOT(1,2) - X2=DOT(1,3) - X3=DOT(1,4) - X4=DOT(1,5) - X5=DOT(2,3) - X6=DOT(2,4) - X7=DOT(2,5) - X8=DOT(3,4) - X9=DOT(3,5) - X10=DOT(4,5) - -C...Propagators. - SS1=DOT(7,7)-SPQ - SS2=DOT(8,8)-SPQ - SS3=DOT(9,9)-SPQ - SS4=DOT(10,10)-SPQ - SS5=DOT(11,11)-SPQ - SS6=DOT(12,12)-SPQ - SS7=DOT(13,13) - DX(1)=SS1*SS6 - DX(2)=SS2*SS6 - DX(3)=SS2*SS4 - DX(4)=SS1*SS5 - DX(5)=SS3*SS5 - DX(6)=SS3*SS4 - DX(7)=SS7*SS1 - DX(8)=SS7*SS4 - -C...Define colour coefficients for g + g -> Q + Qbar + H. - IF(ISUB.EQ.121.OR.ISUB.EQ.181.OR.ISUB.EQ.186) THEN - DO 140 I=1,3 - DO 130 J=1,3 - CLR(I,J)=16D0/3D0 - CLR(I+3,J+3)=16D0/3D0 - CLR(I,J+3)=-2D0/3D0 - CLR(I+3,J)=-2D0/3D0 - 130 CONTINUE - 140 CONTINUE - DO 160 L=1,2 - DO 150 I=1,3 - CLR(I,6+L)=-6D0 - CLR(I+3,6+L)=6D0 - CLR(6+L,I)=-6D0 - CLR(6+L,I+3)=6D0 - 150 CONTINUE - 160 CONTINUE - DO 180 K1=1,2 - DO 170 K2=1,2 - CLR(6+K1,6+K2)=12D0 - 170 CONTINUE - 180 CONTINUE - -C...Evaluate matrix elements for g + g -> Q + Qbar + H. - FM(1,1)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X4+X9+2* - & X7+X5)+8*PQ**2*PH**2*(-X1-X4+2*X7)+16*PQ**2*(X2*X9+4*X2* - & X7+X2*X5-2*X4*X7-2*X9*X7)+8*PH**2*X4*X7-16*X2*X9*X7 - FM(1,2)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10+X9-X8+2 - & *X7-4*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X4-2*X2*X10+X2*X7-2* - & X2*X6-2*X3*X7+2*X4*X7+4*X10*X7-X9*X7-X8*X7)+16*X2*X7*(X4+ - & X10) - FM(1,3)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-2*X3-4* - & X4-8*X10+X9+X8-2*X7-4*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X4+X10 - & +X6)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 - & -4*X2*X4-5*X2*X10+X2*X8-X2*X7-3*X2*X6+X2*X5+X3*X9+2*X3*X7 - & -X3*X5+X4*X8+2*X4*X6-3*X4*X5-5*X10*X5+X9*X8+X9*X6+X9*X5+ - & X8*X7-4*X6*X5+X5**2)-(16*X2*X5)*(X1+X4+X10+X6) - FM(1,4)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1+X2-X3-X4+X10- - & X9-X8+2*X7+2*X6-X5)+4*PQ**2*PH**2*(X1+X3+X4+X10+2*X7+2*X6 - & )+8*PQ**2*(4*X1*X10+4*X1*X7+4*X1*X6+2*X2*X10-X2*X9-X2*X8+ - & 4*X2*X7+4*X2*X6-X2*X5+4*X10*X5+4*X7*X5+4*X6*X5)-(8*PH**2* - & X1)*(X10+X7+X6)+16*X2*X5*(X10+X7+X6) - FM(1,5)=8*PQ**4*(-2*X1-2*X4+X10-X9)+4*PQ**2*(4*X1**2-2*X1* - & X2+8*X1*X3+6*X1*X10-2*X1*X9+4*X1*X8+4*X1*X7+4*X1*X6+2*X1* - & X5+X2*X10+4*X3*X4-X3*X9+2*X3*X7+3*X4*X8-2*X4*X6+2*X4*X5-4 - & *X10*X7+3*X10*X5-3*X9*X6+3*X8*X7-4*X7**2+4*X7*X5)+8*(X1** - & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5-X1*X4* - & X8-X1*X4*X5+X1*X10*X9+X1*X9*X7+X1*X9*X6-X1*X8*X7-X2*X3*X7 - & +X2*X4*X6-X2*X10*X7-X2*X7**2+X3*X7*X5-X4*X10*X5-X4*X7*X5- - & X4*X6*X5) - FM(1,6)=16*PQ**4*(-4*X1-X4+X9-X7)+4*PQ**2*PH**2*(-2*X1-X4- - & X7)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X4-3*X1*X9-2*X1*X7-3* - & X1*X5-2*X2*X4-2*X7*X5)-8*PH**2*X4*X7+8*(-X1*X2*X9-2*X1*X2 - & *X5-X1*X9**2-X1*X9*X5+X2**2*X7-X2*X4*X5+X2*X9*X7-X2*X7*X5 - & +X4*X9*X5+X4*X5**2) - FM(1,7)=8*PQ**4*(2*X3+X4+3*X10+X9+2*X8+3*X7+6*X6)+2*PQ**2* - & PH**2*(-2*X3-X4+3*X10+3*X7+6*X6)+4*PQ**2*(4*X1*X10+4*X1* - & X7+8*X1*X6+6*X2*X10+X2*X9+2*X2*X8+6*X2*X7+12*X2*X6-8*X3* - & X7+4*X4*X7+4*X4*X6+4*X10*X5+4*X9*X7+4*X9*X6-8*X8*X7+4*X7* - & X5+8*X6*X5)+4*PH**2*(-X1*X10-X1*X7-2*X1*X6+2*X3*X7-X4*X7- - & X4*X6)+8*X2*(X10*X5+X9*X7+X9*X6-2*X8*X7+X7*X5+2*X6*X5) - FM(1,8)=8*PQ**4*(2*X3+X4+3*X10+2*X9+X8+3*X7+6*X6)+2*PQ**2* - & PH**2*(-2*X3-X4+2*X10+X7+2*X6)+4*PQ**2*(4*X1*X10-2*X1*X9+ - & 2*X1*X8+4*X1*X7+8*X1*X6+5*X2*X10+2*X2*X9+X2*X8+4*X2*X7+8* - & X2*X6-X3*X9-8*X3*X7+2*X3*X5+2*X4*X9-X4*X8+4*X4*X7+4*X4*X6 - & +4*X4*X5+5*X10*X5+X9**2-X9*X8+2*X9*X7+5*X9*X6+X9*X5-7*X8* - & X7+2*X8*X5+2*X7*X5+10*X6*X5)+2*PH**2*(-X1*X10+X3*X7-2*X4* - & X7+X4*X6)+4*(-X1*X9**2+X1*X9*X8-2*X1*X9*X5-X1*X8*X5+2*X2* - & X10*X5+X2*X9*X7+X2*X9*X6-2*X2*X8*X7+3*X2*X6*X5+X3*X9*X5+ - & X3*X5**2+X4*X9*X5-2*X4*X8*X5+2*X4*X5**2) - FM(2,2)=16*PQ**6+16*PQ**4*(-X1+X3-X4-X10+X7-X6)+16*PQ**2*( - & X3*X10+X3*X7+X3*X6+X4*X7+X10*X7)-16*X3*X10*X7 - FM(2,3)=16*PQ**6+8*PQ**4*(-2*X1+X2+2*X3-4*X4-4*X10-X9+X8-2 - & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5+4*X3*X10-X3*X9-X3*X8-2*X3* - & X7+2*X3*X6+X3*X5-2*X4*X5-2*X10*X5-2*X6*X5)+16*X3*X5*(X10+ - & X6) - FM(2,4)=8*PQ**4*(-2*X1-2*X3+X10-X8)+4*PQ**2*(4*X1**2-2*X1* - & X2+8*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+4*X1*X7+4*X1*X6+2*X1* - & X5+X2*X10+4*X3*X4+3*X3*X9-2*X3*X7+2*X3*X5-X4*X8+2*X4*X6-4 - & *X10*X6+3*X10*X5+3*X9*X6-3*X8*X7-4*X6**2+4*X6*X5)+8*(-X1 - & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9-X1*X3*X5+X1*X4 - & *X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X1*X8*X6+X2*X3* - & X7-X2*X4*X6-X2*X10*X6-X2*X6**2-X3*X10*X5-X3*X7*X5-X3*X6* - & X5+X4*X6*X5) - FM(2,5)=16*PQ**4*X10+8*PQ**2*(2*X1**2+2*X1*X3+2*X1*X4+2*X1 - & *X10+2*X1*X7+2*X1*X6+X3*X7+X4*X6)+8*(-2*X1**3-2*X1**2*X3- - & 2*X1**2*X4-2*X1**2*X10-2*X1**2*X7-2*X1**2*X6-2*X1*X3*X4- - & X1*X3*X10-2*X1*X3*X6-X1*X4*X10-2*X1*X4*X7-X1*X10**2-X1* - & X10*X7-X1*X10*X6-2*X1*X7*X6+X3**2*X7-X3*X4*X7-X3*X4*X6+X3 - & *X10*X7+X3*X7**2-X3*X7*X6+X4**2*X6+X4*X10*X6-X4*X7*X6+X4* - & X6**2) - FM(2,6)=8*PQ**4*(-2*X1+X10-X9-2*X7)+4*PQ**2*(4*X1**2+2*X1* - & X2+4*X1*X3+4*X1*X4+6*X1*X10-2*X1*X9+4*X1*X8+8*X1*X6-2*X1* - & X5+4*X2*X4+3*X2*X10+2*X2*X7-3*X3*X9-2*X3*X7-4*X4**2-4*X4* - & X10+3*X4*X8+2*X4*X6+X10*X5-X9*X6+3*X8*X7+4*X7*X6)+8*(X1** - & 2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9+X1*X3*X5+X1*X4* - & X9-X1*X4*X8-X1*X4*X5+X1*X10*X9+X1*X9*X6-X1*X8*X7-X2*X3*X7 - & -X2*X4*X7+X2*X4*X6-X2*X10*X7+X3*X7*X5-X4**2*X5-X4*X10*X5- - & X4*X6*X5) - FM(2,7)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- - & 2*X1*X4-2*X1*X10+X1*X9-X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* - & X4+3*X2*X10+X2*X7+2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9-2*X3* - & X7-4*X3*X6-X3*X5-6*X4**2-6*X4*X10-3*X4*X9-X4*X8-4*X4*X7-2 - & *X4*X6-2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+X10*X5 - & +X9*X7-2*X8*X7-2*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( - & -X1**2*X9+X1**2*X8-2*X1*X2*X10-3*X1*X2*X7-3*X1*X2*X6+X1* - & X3*X9-X1*X3*X5+X1*X4*X9+X1*X4*X8+X1*X4*X5+X1*X10*X9+X1* - & X10*X8-X1*X9*X6+X1*X8*X6+X2*X3*X7-3*X2*X4*X7-X2*X4*X6-3* - & X2*X10*X7-3*X2*X10*X6-3*X2*X7*X6-3*X2*X6**2-2*X3*X4*X5-X3 - & *X10*X5-X3*X6*X5-X4**2*X5-X4*X10*X5+X4*X6*X5) - FM(2,8)=8*PQ**4*(X3+2*X4+3*X10+X7+2*X6)+4*PQ**2*(-4*X1*X3- - & 2*X1*X4-2*X1*X10-X1*X9+X1*X8-4*X1*X7-2*X1*X6+X2*X3+2*X2* - & X4+X2*X10-X2*X7-2*X2*X6-6*X3*X4-6*X3*X10-2*X3*X9+X3*X8-2* - & X3*X7-4*X3*X6+X3*X5-6*X4**2-6*X4*X10-2*X4*X9-4*X4*X7-2*X4 - & *X6+2*X4*X5-3*X10*X9-3*X10*X8-6*X10*X7-6*X10*X6+3*X10*X5- - & X9*X6-2*X8*X7-3*X8*X6-6*X7*X6+X7*X5-6*X6**2+2*X6*X5)+4*( - & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6-3*X1*X3*X5+X1*X4*X9- - & X1*X4*X8-3*X1*X4*X5+X1*X10*X9+X1*X10*X8-2*X1*X10*X5+X1*X9 - & *X6+X1*X8*X7+X1*X8*X6-X2*X4*X7+X2*X4*X6-X2*X10*X7-X2*X10* - & X6-2*X2*X7*X6-X2*X6**2-3*X3*X4*X5-3*X3*X10*X5+X3*X7*X5-3* - & X3*X6*X5-3*X4**2*X5-3*X4*X10*X5-X4*X6*X5) - FM(3,3)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X3+X8+X6 - & +2*X5)+8*PQ**2*PH**2*(-X1+2*X3-X6)+16*PQ**2*(X2*X5-2*X3* - & X8-2*X3*X6+4*X3*X5+X8*X5)+8*PH**2*X3*X6-16*X3*X8*X5 - FM(3,4)=16*PQ**4*(-4*X1-X3+X8-X6)+4*PQ**2*PH**2*(-2*X1-X3- - & X6)+16*PQ**2*(-2*X1**2-3*X1*X2-2*X1*X3-3*X1*X8-2*X1*X6-3* - & X1*X5-2*X2*X3-2*X6*X5)-8*PH**2*X3*X6+8*(-X1*X2*X8-2*X1*X2 - & *X5-X1*X8**2-X1*X8*X5+X2**2*X6-X2*X3*X5+X2*X8*X6-X2*X6*X5 - & +X3*X8*X5+X3*X5**2) - FM(3,5)=8*PQ**4*(-2*X1+X10-X8-2*X6)+4*PQ**2*(4*X1**2+2*X1* - & X2+4*X1*X3+4*X1*X4+6*X1*X10+4*X1*X9-2*X1*X8+8*X1*X7-2*X1* - & X5+4*X2*X3+3*X2*X10+2*X2*X6-4*X3**2-4*X3*X10+3*X3*X9+2*X3 - & *X7-3*X4*X8-2*X4*X6+X10*X5+3*X9*X6-X8*X7+4*X7*X6)+8*(-X1 - & **2*X9+X1**2*X8+X1*X2*X7-X1*X2*X6-X1*X3*X9+X1*X3*X8-X1*X3 - & *X5+X1*X4*X8+X1*X4*X5+X1*X10*X8-X1*X9*X6+X1*X8*X7+X2*X3* - & X7-X2*X3*X6-X2*X4*X6-X2*X10*X6-X3**2*X5-X3*X10*X5-X3*X7* - & X5+X4*X6*X5) - FM(3,6)=16*PQ**6+4*PQ**4*PH**2+16*PQ**4*(-X1-X2+2*X3+2*X4+ - & X10-X9-X8-X7-X6+X5)+4*PQ**2*PH**2*(X1+2*X3+2*X4+X10+X7+X6 - & )+8*PQ**2*(4*X1*X3+4*X1*X4+4*X1*X10+4*X2*X3+4*X2*X4+4*X2* - & X10-X2*X5+4*X3*X5+4*X4*X5+2*X10*X5-X9*X5-X8*X5)-(8*PH**2* - & X1)*(X3+X4+X10)+16*X2*X5*(X3+X4+X10) - FM(3,7)=8*PQ**4*(3*X3+6*X4+3*X10+X9+2*X8+2*X7+X6)+2*PQ**2* - & PH**2*(X3+2*X4+2*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+4* - & X1*X10+2*X1*X9-2*X1*X8+2*X2*X3+10*X2*X4+5*X2*X10+2*X2*X9+ - & X2*X8+2*X2*X7+4*X2*X6-7*X3*X9+2*X3*X8-8*X3*X7+4*X3*X6+4* - & X3*X5+5*X4*X8+4*X4*X6+8*X4*X5+5*X10*X5-X9*X8-X9*X6+X9*X5+ - & X8**2-X8*X7+2*X8*X6+2*X8*X5)+2*PH**2*(-X1*X10+X3*X7-2*X3* - & X6+X4*X6)+4*(-X1*X2*X9-2*X1*X2*X8+X1*X9*X8-X1*X8**2+X2**2 - & *X7+2*X2**2*X6+3*X2*X4*X5+2*X2*X10*X5-2*X2*X9*X6+X2*X8*X7 - & +X2*X8*X6-2*X3*X9*X5+X3*X8*X5+X4*X8*X5) - FM(3,8)=8*PQ**4*(3*X3+6*X4+3*X10+2*X9+X8+2*X7+X6)+2*PQ**2* - & PH**2*(3*X3+6*X4+3*X10-2*X7-X6)+4*PQ**2*(4*X1*X3+8*X1*X4+ - & 4*X1*X10+4*X2*X3+8*X2*X4+4*X2*X10-8*X3*X9+4*X3*X8-8*X3*X7 - & +4*X3*X6+6*X3*X5+4*X4*X8+4*X4*X6+12*X4*X5+6*X10*X5+2*X9* - & X5+X8*X5)+4*PH**2*(-X1*X3-2*X1*X4-X1*X10+2*X3*X7-X3*X6-X4 - & *X6)+8*X5*(X2*X3+2*X2*X4+X2*X10-2*X3*X9+X3*X8+X4*X8) - FM(4,4)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+2*X2+X3+X8+2* - & X6+X5)+8*PQ**2*PH**2*(-X1-X3+2*X6)+16*PQ**2*(X2*X8+4*X2* - & X6+X2*X5-2*X3*X6-2*X8*X6)+8*PH**2*X3*X6-16*X2*X8*X6 - FM(4,5)=16*PQ**6+8*PQ**4*(-2*X1+X2-2*X3-2*X4-4*X10-X9+X8-4 - & *X7+2*X6+X5)+8*PQ**2*(-2*X1*X2-2*X2*X3-2*X2*X10-2*X2*X7+ - & X2*X6+2*X3*X6-2*X4*X6+4*X10*X6-X9*X6-X8*X6)+16*X2*X6*(X3+ - & X10) - FM(4,6)=16*PQ**6-4*PQ**4*PH**2+8*PQ**4*(-2*X1+2*X2-4*X3-2* - & X4-8*X10+X9+X8-4*X7-2*X6+2*X5)-(4*PQ**2*PH**2)*(X1+X3+X10 - & +X7)+8*PQ**2*(-2*X1*X2-2*X1*X10+X1*X9+X1*X8-2*X1*X5+X2**2 - & -4*X2*X3-5*X2*X10+X2*X9-3*X2*X7-X2*X6+X2*X5+X3*X9+2*X3*X7 - & -3*X3*X5+X4*X8+2*X4*X6-X4*X5-5*X10*X5+X9*X8+X9*X6+X8*X7+ - & X8*X5-4*X7*X5+X5**2)-(16*X2*X5)*(X1+X3+X10+X7) - FM(4,7)=8*PQ**4*(-X3-2*X4-3*X10-2*X9-X8-6*X7-3*X6)+2*PQ**2 - & *PH**2*(X3+2*X4-3*X10-6*X7-3*X6)+4*PQ**2*(-4*X1*X10-8*X1* - & X7-4*X1*X6-6*X2*X10-2*X2*X9-X2*X8-12*X2*X7-6*X2*X6-4*X3* - & X7-4*X3*X6+8*X4*X6-4*X10*X5+8*X9*X6-4*X8*X7-4*X8*X6-8*X7* - & X5-4*X6*X5)+4*PH**2*(X1*X10+2*X1*X7+X1*X6+X3*X7+X3*X6-2* - & X4*X6)+8*X2*(-X10*X5+2*X9*X6-X8*X7-X8*X6-2*X7*X5-X6*X5) - FM(4,8)=8*PQ**4*(-X3-2*X4-3*X10-X9-2*X8-6*X7-3*X6)+2*PQ**2 - & *PH**2*(X3+2*X4-2*X10-2*X7-X6)+4*PQ**2*(-4*X1*X10-2*X1*X9 - & +2*X1*X8-8*X1*X7-4*X1*X6-5*X2*X10-X2*X9-2*X2*X8-8*X2*X7-4 - & *X2*X6+X3*X9-2*X3*X8-4*X3*X7-4*X3*X6-4*X3*X5+X4*X8+8*X4* - & X6-2*X4*X5-5*X10*X5+X9*X8+7*X9*X6-2*X9*X5-X8**2-5*X8*X7-2 - & *X8*X6-X8*X5-10*X7*X5-2*X6*X5)+2*PH**2*(X1*X10-X3*X7+2*X3 - & *X6-X4*X6)+4*(-X1*X9*X8+X1*X9*X5+X1*X8**2+2*X1*X8*X5-2*X2 - & *X10*X5+2*X2*X9*X6-X2*X8*X7-X2*X8*X6-3*X2*X7*X5+2*X3*X9* - & X5-X3*X8*X5-2*X3*X5**2-X4*X8*X5-X4*X5**2) - FM(5,5)=16*PQ**6+16*PQ**4*(-X1-X3+X4-X10-X7+X6)+16*PQ**2*( - & X3*X6+X4*X10+X4*X7+X4*X6+X10*X6)-16*X4*X10*X6 - FM(5,6)=16*PQ**6+8*PQ**4*(-2*X1+X2-4*X3+2*X4-4*X10+X9-X8-2 - & *X7-2*X6+X5)+8*PQ**2*(-2*X1*X5-2*X3*X5+4*X4*X10-X4*X9-X4* - & X8+2*X4*X7-2*X4*X6+X4*X5-2*X10*X5-2*X7*X5)+16*X4*X5*(X10+ - & X7) - FM(5,7)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ - & 4*X1*X4+2*X1*X10+X1*X9-X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* - & X4-3*X2*X10-2*X2*X7-X2*X6+6*X3**2+6*X3*X4+6*X3*X10+X3*X9+ - & 3*X3*X8+2*X3*X7+4*X3*X6+2*X3*X5+6*X4*X10+2*X4*X8+4*X4*X7+ - & 2*X4*X6+X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-X10*X5+ - & 2*X9*X7+2*X9*X6-X8*X6+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*(- - & X1**2*X9+X1**2*X8+2*X1*X2*X10+3*X1*X2*X7+3*X1*X2*X6-X1*X3 - & *X9-X1*X3*X8-X1*X3*X5-X1*X4*X8+X1*X4*X5-X1*X10*X9-X1*X10* - & X8-X1*X9*X7+X1*X8*X7+X2*X3*X7+3*X2*X3*X6-X2*X4*X6+3*X2* - & X10*X7+3*X2*X10*X6+3*X2*X7**2+3*X2*X7*X6+X3**2*X5+2*X3*X4 - & *X5+X3*X10*X5-X3*X7*X5+X4*X10*X5+X4*X7*X5) - FM(5,8)=8*PQ**4*(-2*X3-X4-3*X10-2*X7-X6)+4*PQ**2*(2*X1*X3+ - & 4*X1*X4+2*X1*X10-X1*X9+X1*X8+2*X1*X7+4*X1*X6-2*X2*X3-X2* - & X4-X2*X10+2*X2*X7+X2*X6+6*X3**2+6*X3*X4+6*X3*X10+2*X3*X8+ - & 2*X3*X7+4*X3*X6-2*X3*X5+6*X4*X10-X4*X9+2*X4*X8+4*X4*X7+2* - & X4*X6-X4*X5+3*X10*X9+3*X10*X8+6*X10*X7+6*X10*X6-3*X10*X5+ - & 3*X9*X7+2*X9*X6+X8*X7+6*X7**2+6*X7*X6-2*X7*X5-X6*X5)+4*( - & X1**2*X9-X1**2*X8-X1*X2*X7+X1*X2*X6+X1*X3*X9-X1*X3*X8+3* - & X1*X3*X5+3*X1*X4*X5-X1*X10*X9-X1*X10*X8+2*X1*X10*X5-X1*X9 - & *X7-X1*X9*X6-X1*X8*X7-X2*X3*X7+X2*X3*X6+X2*X10*X7+X2*X10* - & X6+X2*X7**2+2*X2*X7*X6+3*X3**2*X5+3*X3*X4*X5+3*X3*X10*X5+ - & X3*X7*X5+3*X4*X10*X5+3*X4*X7*X5-X4*X6*X5) - FM(6,6)=64*PQ**6+16*PQ**4*PH**2+32*PQ**4*(X1+X2+2*X4+X9+X7 - & +2*X5)+8*PQ**2*PH**2*(-X1+2*X4-X7)+16*PQ**2*(X2*X5-2*X4* - & X9-2*X4*X7+4*X4*X5+X9*X5)+8*PH**2*X4*X7-16*X4*X9*X5 - FM(6,7)=8*PQ**4*(-6*X3-3*X4-3*X10-2*X9-X8-X7-2*X6)+2*PQ**2 - & *PH**2*(-2*X3-X4-2*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1*X4 - & -4*X1*X10+2*X1*X9-2*X1*X8-10*X2*X3-2*X2*X4-5*X2*X10-X2*X9 - & -2*X2*X8-4*X2*X7-2*X2*X6-5*X3*X9-4*X3*X7-8*X3*X5-2*X4*X9+ - & 7*X4*X8-4*X4*X7+8*X4*X6-4*X4*X5-5*X10*X5-X9**2+X9*X8-2*X9 - & *X7+X9*X6-2*X9*X5+X8*X7-X8*X5)+2*PH**2*(X1*X10-X3*X7+2*X4 - & *X7-X4*X6)+4*(2*X1*X2*X9+X1*X2*X8+X1*X9**2-X1*X9*X8-2*X2 - & **2*X7-X2**2*X6-3*X2*X3*X5-2*X2*X10*X5-X2*X9*X7-X2*X9*X6+ - & 2*X2*X8*X7-X3*X9*X5-X4*X9*X5+2*X4*X8*X5) - FM(6,8)=8*PQ**4*(-6*X3-3*X4-3*X10-X9-2*X8-X7-2*X6)+2*PQ**2 - & *PH**2*(-6*X3-3*X4-3*X10+X7+2*X6)+4*PQ**2*(-8*X1*X3-4*X1* - & X4-4*X1*X10-8*X2*X3-4*X2*X4-4*X2*X10-4*X3*X9-4*X3*X7-12* - & X3*X5-4*X4*X9+8*X4*X8-4*X4*X7+8*X4*X6-6*X4*X5-6*X10*X5-X9 - & *X5-2*X8*X5)+4*PH**2*(2*X1*X3+X1*X4+X1*X10+X3*X7+X4*X7-2* - & X4*X6)+8*X5*(-2*X2*X3-X2*X4-X2*X10-X3*X9-X4*X9+2*X4*X8) - FM(7,7)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+9* - & X2*X10+7*X3*X7+2*X3*X6+2*X4*X7+7*X4*X6+X10*X5+2*X9*X7+7* - & X9*X6+7*X8*X7+2*X8*X6)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2 - & *X4*X7-7*X4*X6)+4*X2*(X10*X5+2*X9*X7+7*X9*X6+7*X8*X7+2*X8 - & *X6) - FM(7,8)=72*PQ**4*X10+2*PQ**2*PH**2*X10+4*PQ**2*(2*X1*X10+ - & 10*X2*X10+7*X3*X9+2*X3*X8+14*X3*X7+4*X3*X6+2*X4*X9+7*X4* - & X8+4*X4*X7+14*X4*X6+10*X10*X5+X9**2+7*X9*X8+2*X9*X7+7*X9* - & X6+X8**2+7*X8*X7+2*X8*X6)+2*PH**2*(7*X1*X10-7*X3*X7-2*X3* - & X6-2*X4*X7-7*X4*X6)+2*(-2*X1*X9**2-14*X1*X9*X8-2*X1*X8**2 - & +2*X2*X10*X5+2*X2*X9*X7+7*X2*X9*X6+7*X2*X8*X7+2*X2*X8*X6+ - & 7*X3*X9*X5+2*X3*X8*X5+2*X4*X9*X5+7*X4*X8*X5) - FM(8,8)=72*PQ**4*X10+18*PQ**2*PH**2*X10+8*PQ**2*(X1*X10+X2 - & *X10+7*X3*X9+2*X3*X8+7*X3*X7+2*X3*X6+2*X4*X9+7*X4*X8+2*X4 - & *X7+7*X4*X6+9*X10*X5)+2*PH**2*(-X1*X10-7*X3*X7-2*X3*X6-2* - & X4*X7-7*X4*X6)+4*X5*(X2*X10+7*X3*X9+2*X3*X8+2*X4*X9+7*X4* - & X8) - FM(9,9)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ - & X3*X7+X4*X6-X10*X5+X9*X6+X8*X7)+PH**2*(X1*X10-X3*X7-X4*X6 - & )+2*X2*(-X10*X5+X9*X6+X8*X7) - FM(9,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* - & X10+2*X3*X9+2*X3*X7+2*X4*X6-2*X10*X5+X9*X8+2*X8*X7)+PH**2 - & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X8*X7+X3* - & X9*X5) - FMXX=-4*PQ**4*X10-PQ**2*PH**2*X10+2*PQ**2*(-2*X1*X10-2*X2* - & X10+2*X4*X8+2*X4*X6+2*X3*X7-2*X10*X5+X9*X8+2*X9*X6)+PH**2 - & *(X1*X10-X3*X7-X4*X6)+2*(-X1*X9*X8-X2*X10*X5+X2*X9*X6+X4* - & X8*X5) - FM(9,10)=0.5D0*(FMXX+FM(9,10)) - FM(10,10)=-4*PQ**4*X10-PQ**2*PH**2*X10+4*PQ**2*(-X1*X10-X2*X10+ - & X3*X7+X4*X6-X10*X5+X9*X3+X8*X4)+PH**2*(X1*X10-X3*X7-X4*X6 - & )+2*X5*(-X10*X2+X9*X3+X8*X4) - -C...Repackage matrix elements. - DO 200 I=1,8 - DO 190 J=I,8 - RM(I,J)=FM(I,J) - 190 CONTINUE - 200 CONTINUE - RM(7,7)=FM(7,7)-2D0*FM(9,9) - RM(7,8)=FM(7,8)-2D0*FM(9,10) - RM(8,8)=FM(8,8)-2D0*FM(10,10) - -C...Produce final result: matrix elements * colours * propagators. - DO 220 I=1,8 - DO 210 J=I,8 - FAC=8D0 - IF(I.EQ.J)FAC=4D0 - WTQQBH=WTQQBH+RM(I,J)*FAC*CLR(I,J)/(DX(I)*DX(J)) - 210 CONTINUE - 220 CONTINUE - WTQQBH=-WTQQBH/256D0 - - ELSE -C...Evaluate matrix elements for q + qbar -> Q + Qbar + H. - A11=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X2*X10+X3 - & *X7+X4*X6+X9*X6+X8*X7)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X2)*(X9 - & *X6+X8*X7) - A12=-8D0*PQ**4*X10+4D0*PQ**2*(-X2*X10-X3*X9-2D0*X3*X7-X4*X8- - & 2D0*X4*X6-X10*X5-X9*X8-X9*X6-X8*X7)+2D0*PH**2*(-X1*X10+X3*X7 - & +X4*X6)+2D0*(2D0*X1*X9*X8-X2*X9*X6-X2*X8*X7-X3*X9*X5-X4*X8* - & X5) - A22=-8D0*PQ**4*X10-2D0*PQ**2*PH**2*X10-(8D0*PQ**2)*(X3*X9+X3* - & X7+X4*X8+X4*X6+X10*X5)+2D0*PH**2*(X3*X7+X4*X6)-(4D0*X5)*(X3 - & *X9+X4*X8) - -C...Produce final result: matrix elements * propagators. - A11=A11/DX(7)**2 - A12=A12/(DX(7)*DX(8)) - A22=A22/DX(8)**2 - WTQQBH=-(A11+A22+2D0*A12)*8D0/9D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRADK -C...Generates initial state photon radiation. - - SUBROUTINE PYRADK(ECM,MK,PAK,THEK,PHIK,ALPK) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Function: cumulative hard photon spectrum in QFD case. - FXK(XX)=2D0*LOG(XX)+PARJ(161)*LOG(1D0-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=0D0 - IF(PARJ(160).LT.PYR(0)) RETURN - MK=1 - -C...Photon energy range. Find photon momentum in QED case. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) - IF(MSTJ(102).LE.1) THEN - 100 XK=1D0/(1D0+(1D0/XKL-1D0)*((1D0/XKU-1D0)/(1D0/XKL-1D0))**PYR(0)) - IF(1D0+(1D0-XK)**2.LT.2D0*PYR(0)) GOTO 100 - -C...Ditto in QFD case, by numerical inversion of integrated spectrum. - ELSE - SZM=1D0-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - FXKL=FXK(XKL) - FXKU=FXK(XKU) - FXKD=1D-4*(FXKU-FXKL) - FXKR=FXKL+PYR(0)*(FXKU-FXKL) - NXK=0 - 110 NXK=NXK+1 - XK=0.5D0*(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.5D0*ECM*XK - -C...Photon polar and azimuthal angle. - PME=2D0*(PYMASS(11)/ECM)**2 - 120 CTHM=PME*(2D0/PME)**PYR(0) - IF(1D0-(XK**2*CTHM*(1D0-0.5D0*CTHM)+2D0*(1D0-XK)*PME/MAX(PME, - &CTHM*(1D0-0.5D0*CTHM)))/(1D0+(1D0-XK)**2).LT.PYR(0)) GOTO 120 - CTHE=1D0-CTHM - IF(PYR(0).GT.0.5D0) CTHE=-CTHE - STHE=SQRT(MAX(0D0,(CTHM-PME)*(2D0-CTHM))) - THEK=PYANGL(CTHE,STHE) - PHIK=PARU(2)*PYR(0) - -C...Rotation angle for hadronic system. - SGN=1D0 - IF(0.5D0*(2D0-XK*(1D0-CTHE))**2/((2D0-XK)**2+(XK*CTHE)**2).GT. - &PYR(0)) SGN=-1D0 - ALPK=ASIN(SGN*STHE*(XK-SGN*(2D0*SQRT(1D0-XK)-2D0+XK)*CTHE)/ - &(2D0-XK*(1D0-SGN*CTHE))) - - RETURN - END - -C********************************************************************* - -C...PYRAND -C...Generates quantities characterizing the high-pT scattering at the -C...parton level according to the matrix elements. Chooses incoming, -C...reacting partons, their momentum fractions and one of the possible -C...subprocesses. - - SUBROUTINE PYRAND - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process initialization and event commonblocks. - 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) - 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 /HEPRUP/,/HEPEUP/ - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/,/PYMSSM/ -C...Local arrays. - DIMENSION XPQ(-25:25),PMM(2),PDIF(4),BHAD(4),PMMN(2) - -C...Parameters and data used in elastic/diffractive treatment. - DATA EPS/0.0808D0/, ALP/0.25D0/, CRES/2D0/, PMRC/1.062D0/, - &SMP/0.880D0/, BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ - -C...Initial values, specifically for (first) semihard interaction. - MINT(10)=0 - MINT(17)=0 - MINT(18)=0 - VINT(97)=1D0 - VINT(143)=1D0 - VINT(144)=1D0 - VINT(157)=0D0 - VINT(158)=0D0 - MFAIL=0 - IF(MSTP(171).EQ.1.AND.MSTP(172).EQ.2) MFAIL=1 - ISUB=0 - ISTSB=0 - LOOP=0 - 100 LOOP=LOOP+1 - MINT(51)=0 - MINT(143)=1 - -C...Start by assuming incoming photon is entering subprocess. - IF(MINT(11).EQ.22) THEN - MINT(15)=22 - VINT(307)=VINT(3)**2 - ENDIF - IF(MINT(12).EQ.22) THEN - MINT(16)=22 - VINT(308)=VINT(4)**2 - ENDIF - MINT(103)=MINT(11) - MINT(104)=MINT(12) - -C...Choice of process type - first event of pileup. - INMULT=0 - IF(MINT(82).EQ.1.AND.ISUB.GE.91.AND.ISUB.LE.96) THEN - ELSEIF(MINT(82).EQ.1) THEN - -C...For gamma-p or gamma-gamma first pick between alternatives. - IGA=0 - IF(MINT(121).GT.1) CALL PYSAVE(4,IGA) - MINT(122)=IGA - -C...For real gamma + gamma with different nature, flip at random. - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. - & MSTP(14).LE.10.AND.PYR(0).GT.0.5D0) THEN - MINTSV=MINT(41) - MINT(41)=MINT(42) - MINT(42)=MINTSV - MINTSV=MINT(45) - MINT(45)=MINT(46) - MINT(46)=MINTSV - MINTSV=MINT(107) - MINT(107)=MINT(108) - MINT(108)=MINTSV - IF(MINT(47).EQ.2.OR.MINT(47).EQ.3) MINT(47)=5-MINT(47) - ENDIF - -C...Pick process type, possibly by user process machinery. -C...(If the latter, also event will be picked here.) - IF(MINT(111).EQ.11.AND.IABS(IDWTUP).EQ.2.AND.LOOP.GE.2) THEN - CALL UPEVNT - CALL PYUPRE - ELSEIF(MINT(111).EQ.11.AND.IABS(IDWTUP).GE.3) THEN - CALL UPEVNT - CALL PYUPRE - ISUB=0 - 110 ISUB=ISUB+1 - IF((ISET(ISUB).NE.11.OR.KFPR(ISUB,2).NE.IDPRUP).AND. - & ISUB.LT.500) GOTO 110 - ELSE - RSUB=XSEC(0,1)*PYR(0) - DO 120 I=1,500 - IF(MSUB(I).NE.1) GOTO 120 - ISUB=I - RSUB=RSUB-XSEC(I,1) - IF(RSUB.LE.0D0) GOTO 130 - 120 CONTINUE - 130 IF(ISUB.EQ.95) ISUB=96 - IF(ISUB.EQ.96) INMULT=1 - IF(ISET(ISUB).EQ.11) THEN - IDPRUP=KFPR(ISUB,2) - CALL UPEVNT - CALL PYUPRE - ENDIF - ENDIF - -C...Choice of inclusive process type - pileup events. - ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN - RSUB=VINT(131)*PYR(0) - ISUB=96 - IF(RSUB.GT.SIGT(0,0,5)) ISUB=94 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)) ISUB=93 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)) ISUB=92 - IF(RSUB.GT.SIGT(0,0,5)+SIGT(0,0,4)+SIGT(0,0,3)+SIGT(0,0,2)) - & ISUB=91 - IF(ISUB.EQ.96) INMULT=1 - ENDIF - -C...Choice of photon energy and flux factor inside lepton. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN - IF (MSTP(199).EQ.1) THEN - CALL PYGAGA(5,WTGAGA) - ELSE - CALL PYGAGA(3,WTGAGA) - ENDIF - IF(ISUB.GE.131.AND.ISUB.LE.140) THEN - CKIN(3)=MAX(VINT(285),VINT(154)) - CKIN(1)=2D0*CKIN(3) - ENDIF -C...When necessary set direct/resolved photon by hand. - ELSEIF(MINT(15).EQ.22.OR.MINT(16).EQ.22) THEN - IF(MINT(15).EQ.22.AND.MINT(41).EQ.2) MINT(15)=0 - IF(MINT(16).EQ.22.AND.MINT(42).EQ.2) MINT(16)=0 - ENDIF - -C...Restrict direct*resolved processes to pTmin >= Q, -C...to avoid doublecounting with DIS. - IF(MSTP(18).EQ.3.AND.ISUB.GE.131.AND.ISUB.LE.136) THEN - IF(MINT(15).EQ.22) THEN - CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(3))) - ELSE - CKIN(3)=MAX(VINT(285),VINT(154),ABS(VINT(4))) - ENDIF - CKIN(1)=2D0*CKIN(3) - ENDIF - -C...Set up for multiple interactions. - IF(INMULT.EQ.1) CALL PYMULT(2) - -C...Loopback point for minimum bias in photon physics. - LOOP2=0 - 140 LOOP2=LOOP2+1 - IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+MINT(143) - IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+MINT(143) - IF(ISUB.EQ.96.AND.LOOP2.EQ.1.AND.MINT(82).EQ.1) - &NGEN(97,1)=NGEN(97,1)+MINT(143) - MINT(1)=ISUB - ISTSB=ISET(ISUB) - -C...Random choice of flavour for some SUSY processes. - IF(ISUB.GE.201.AND.ISUB.LE.301) THEN -C...~e_L ~nu_e or ~mu_L ~nu_mu. - IF(ISUB.EQ.210) THEN - KFPR(ISUB,1)=KSUSY1+11+2*INT(0.5D0+PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1)+1 -C...~nu_e ~nu_e(bar) or ~nu_mu ~nu_mu(bar). - ELSEIF(ISUB.EQ.213) THEN - KFPR(ISUB,1)=KSUSY1+12+2*INT(0.5D0+PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) -C...~q ~chi/~g; ~q = ~d, ~u, ~s, ~c or ~b. - ELSEIF(ISUB.GE.246.AND.ISUB.LE.259) THEN - IF(ISUB.GE.258) THEN - RKF=4D0 - ELSE - RKF=5D0 - ENDIF - IF(MOD(ISUB,2).EQ.0) THEN - KFPR(ISUB,1)=KSUSY1+1+INT(RKF*PYR(0)) - ELSE - KFPR(ISUB,1)=KSUSY2+1+INT(RKF*PYR(0)) - ENDIF -C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.GE.271.AND.ISUB.LE.276) THEN - IF(ISUB.EQ.271.OR.ISUB.EQ.274) THEN - KSU1=KSUSY1 - KSU2=KSUSY1 - ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.275) THEN - KSU1=KSUSY2 - KSU2=KSUSY2 - ELSEIF(PYR(0).LT.0.5D0) THEN - KSU1=KSUSY1 - KSU2=KSUSY2 - ELSE - KSU1=KSUSY2 - KSU2=KSUSY1 - ENDIF - KFPR(ISUB,1)=KSU1+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KSU2+1+INT(4D0*PYR(0)) -C...~q ~q(bar); ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.279) THEN - KFPR(ISUB,1)=KSUSY1+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.280) THEN - KFPR(ISUB,1)=KSUSY2+1+INT(4D0*PYR(0)) - KFPR(ISUB,2)=KFPR(ISUB,1) -C...~q1 ~q2; ~q = ~d, ~u, ~s, or ~c. - ELSEIF(ISUB.GE.281.AND.ISUB.LE.286) THEN - IF(ISUB.EQ.281.OR.ISUB.EQ.284) THEN - KSU1=KSUSY1 - KSU2=KSUSY1 - ELSEIF(ISUB.EQ.282.OR.ISUB.EQ.285) THEN - KSU1=KSUSY2 - KSU2=KSUSY2 - ELSEIF(PYR(0).LT.0.5D0) THEN - KSU1=KSUSY1 - KSU2=KSUSY2 - ELSE - KSU1=KSUSY2 - KSU2=KSUSY1 - ENDIF - IF(ISUB.EQ.281.OR.ISUB.LE.283) THEN - RKF=5D0 - ELSE - RKF=4D0 - ENDIF - KFPR(ISUB,2)=KSU2+1+INT(RKF*PYR(0)) - ENDIF - ENDIF - -C...Find resonances (explicit or implicit in cross-section). - MINT(72)=0 - KFR1=0 - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - KFR1=KFPR(ISUB,1) - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.25.OR.ISUB.EQ.110.OR.ISUB.EQ.165.OR. - & ISUB.EQ.171.OR.ISUB.EQ.176) THEN - KFR1=23 - ELSEIF(ISUB.EQ.23.OR.ISUB.EQ.26.OR.ISUB.EQ.166.OR.ISUB.EQ.172.OR. - & ISUB.EQ.177) THEN - KFR1=24 - ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN - KFR1=25 - IF(MSTP(46).EQ.5) THEN - KFR1=89 - PMAS(89,1)=PARP(45) - PMAS(89,2)=PARP(45)**3/(96D0*PARU(1)*PARP(47)**2) - ENDIF - ELSEIF(ISUB.EQ.194) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.EQ.195) THEN - KFR1=KTECHN+213 - ELSEIF(ISUB.GE.361.AND.ISUB.LE.368) THEN - KFR1=KTECHN+113 - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN - KFR1=KTECHN+213 - ENDIF - CKMX=CKIN(2) - IF(CKMX.LE.0D0) CKMX=VINT(1) - KCR1=PYCOMP(KFR1) - IF(KFR1.NE.0) THEN - IF(CKIN(1).GT.PMAS(KCR1,1)+20D0*PMAS(KCR1,2).OR. - & CKMX.LT.PMAS(KCR1,1)-20D0*PMAS(KCR1,2)) KFR1=0 - ENDIF - IF(KFR1.NE.0) THEN - TAUR1=PMAS(KCR1,1)**2/VINT(2) - IF(KFR1.EQ.KTECHN+113) THEN - CALL PYTECM(S1,S2) - TAUR1=S1/VINT(2) - ENDIF - GAMR1=PMAS(KCR1,1)*PMAS(KCR1,2)/VINT(2) - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - IF(ISUB.EQ.141.OR.ISUB.EQ.194.OR.(ISUB.GE.364.AND.ISUB.LE.368)) - $THEN - KFR2=23 - IF(ISUB.EQ.194) THEN - KFR2=KTECHN+223 - ELSEIF(ISUB.GE.364.AND.ISUB.LE.368) THEN - KFR2=KTECHN+223 - ENDIF - KCR2=PYCOMP(KFR2) - TAUR2=PMAS(KCR2,1)**2/VINT(2) - IF(KFR2.EQ.KTECHN+223) THEN - CALL PYTECM(S1,S2) - TAUR2=S2/VINT(2) - ENDIF - GAMR2=PMAS(KCR2,1)*PMAS(KCR2,2)/VINT(2) - IF(CKIN(1).GT.PMAS(KCR2,1)+20D0*PMAS(KCR2,2).OR. - & CKMX.LT.PMAS(KCR2,1)-20D0*PMAS(KCR2,2)) KFR2=0 - IF(KFR2.NE.0.AND.KFR1.NE.0) THEN - MINT(72)=2 - MINT(74)=KFR2 - VINT(75)=TAUR2 - VINT(76)=GAMR2 - ELSEIF(KFR2.NE.0) THEN - KFR1=KFR2 - TAUR1=TAUR2 - GAMR1=GAMR2 - MINT(72)=1 - MINT(73)=KFR1 - VINT(73)=TAUR1 - VINT(74)=GAMR1 - ENDIF - ENDIF - -C...Find product masses and minimum pT of process, -C...optionally with broadening according to a truncated Breit-Wigner. - VINT(63)=0D0 - VINT(64)=0D0 - MINT(71)=0 - VINT(71)=CKIN(3) - IF(MINT(82).GE.2) VINT(71)=0D0 - VINT(80)=1D0 - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - NBW=0 - DO 160 I=1,2 - PMMN(I)=0D0 - IF(KFPR(ISUB,I).EQ.0) THEN - ELSEIF(MSTP(42).LE.0.OR.PMAS(PYCOMP(KFPR(ISUB,I)),2).LT. - & PARP(41)) THEN - VINT(62+I)=PMAS(PYCOMP(KFPR(ISUB,I)),1)**2 - ELSE - NBW=NBW+1 -C...This prevents SUSY/t particles from becoming too light. - KFLW=KFPR(ISUB,I) - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - KCW=PYCOMP(KFLW) - PMMN(I)=PMAS(KCW,1) - DO 150 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 150 CONTINUE - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - ENDIF - 160 CONTINUE - IF(NBW.GE.1) THEN - CKIN41=CKIN(41) - CKIN43=CKIN(43) - CKIN(41)=MAX(PMMN(1),CKIN(41)) - CKIN(43)=MAX(PMMN(2),CKIN(43)) - CALL PYOFSH(4,0,KFPR(ISUB,1),KFPR(ISUB,2),0D0,PQM3,PQM4) - CKIN(41)=CKIN41 - CKIN(43)=CKIN43 - IF(MINT(51).EQ.1) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - VINT(63)=PQM3**2 - VINT(64)=PQM4**2 - ENDIF - IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1 - IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) - ENDIF - -C...Prepare for additional variable choices in 2 -> 3. - IF(ISTSB.EQ.5) THEN - VINT(201)=0D0 - IF(KFPR(ISUB,2).GT.0) VINT(201)=PMAS(PYCOMP(KFPR(ISUB,2)),1) - VINT(206)=VINT(201) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(206)=PMAS(5,1) - VINT(204)=PMAS(23,1) - IF(ISUB.EQ.124.OR.ISUB.EQ.351) VINT(204)=PMAS(24,1) - IF(ISUB.EQ.352) VINT(204)=PMAS(PYCOMP(9900024),1) - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. - & ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) - & VINT(204)=VINT(201) - VINT(209)=VINT(204) - IF(ISUB.EQ.401.OR.ISUB.EQ.402) VINT(209)=VINT(206) - ENDIF - -C...Select incoming VDM particle (rho/omega/phi/J/psi). - IF(ISTSB.NE.0.AND.(MINT(101).GE.2.OR.MINT(102).GE.2).AND. - &(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7)) THEN - VRN=PYR(0)*SIGT(0,0,5) - IF(MINT(101).LE.1) THEN - I1MN=0 - I1MX=0 - ELSE - I1MN=1 - I1MX=MINT(101) - ENDIF - IF(MINT(102).LE.1) THEN - I2MN=0 - I2MX=0 - ELSE - I2MN=1 - I2MX=MINT(102) - ENDIF - DO 180 I1=I1MN,I1MX - KFV1=110*I1+3 - DO 170 I2=I2MN,I2MX - KFV2=110*I2+3 - VRN=VRN-SIGT(I1,I2,5) - IF(VRN.LE.0D0) GOTO 190 - 170 CONTINUE - 180 CONTINUE - 190 IF(MINT(101).GE.2) MINT(103)=KFV1 - IF(MINT(102).GE.2) MINT(104)=KFV2 - ENDIF - - IF(ISTSB.EQ.0) THEN -C...Elastic scattering or single or double diffractive scattering. - -C...Select incoming particle (rho/omega/phi/J/psi for VDM) and mass. - MINT(103)=MINT(11) - MINT(104)=MINT(12) - PMM(1)=VINT(3) - PMM(2)=VINT(4) - IF(MINT(101).GE.2.OR.MINT(102).GE.2) THEN - JJ=ISUB-90 - VRN=PYR(0)*SIGT(0,0,JJ) - IF(MINT(101).LE.1) THEN - I1MN=0 - I1MX=0 - ELSE - I1MN=1 - I1MX=MINT(101) - ENDIF - IF(MINT(102).LE.1) THEN - I2MN=0 - I2MX=0 - ELSE - I2MN=1 - I2MX=MINT(102) - ENDIF - DO 210 I1=I1MN,I1MX - KFV1=110*I1+3 - DO 200 I2=I2MN,I2MX - KFV2=110*I2+3 - VRN=VRN-SIGT(I1,I2,JJ) - IF(VRN.LE.0D0) GOTO 220 - 200 CONTINUE - 210 CONTINUE - 220 IF(MINT(101).GE.2) THEN - MINT(103)=KFV1 - PMM(1)=PYMASS(KFV1) - ENDIF - IF(MINT(102).GE.2) THEN - MINT(104)=KFV2 - PMM(2)=PYMASS(KFV2) - ENDIF - ENDIF - VINT(67)=PMM(1) - VINT(68)=PMM(2) - -C...Select mass for GVMD states (rejecting previous assignment). - Q0S=4D0*PARP(15)**2 - Q1S=4D0*VINT(154)**2 - LOOP3=0 - 230 LOOP3=LOOP3+1 - DO 240 JT=1,2 - IF(MINT(106+JT).EQ.3) THEN - PS=VINT(2+JT)**2 - PMM(JT)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - IF(MINT(102+JT).GE.333) PMM(JT)=PMM(JT)- - & PMAS(PYCOMP(113),1)+PMAS(PYCOMP(MINT(102+JT)),1) - ENDIF - 240 CONTINUE - IF(PMM(1)+PMM(2)+PARP(104).GE.VINT(1)) THEN - IF(LOOP3.LT.100.AND.(MINT(107).EQ.3.OR.MINT(108).EQ.3)) - & GOTO 230 - GOTO 100 - ENDIF - -C...Side/sides of diffractive system. - MINT(17)=0 - MINT(18)=0 - IF(ISUB.EQ.92.OR.ISUB.EQ.94) MINT(17)=1 - IF(ISUB.EQ.93.OR.ISUB.EQ.94) MINT(18)=1 - -C...Find masses of particles and minimal masses of diffractive states. - DO 250 JT=1,2 - PDIF(JT)=PMM(JT) - VINT(68+JT)=PDIF(JT) - IF(MINT(16+JT).EQ.1) PDIF(JT)=PDIF(JT)+PARP(102) - 250 CONTINUE - SH=VINT(2) - SQM1=PMM(1)**2 - SQM2=PMM(2)**2 - SQM3=PDIF(1)**2 - SQM4=PDIF(2)**2 - SMRES1=(PMM(1)+PMRC)**2 - SMRES2=(PMM(2)+PMRC)**2 - -C...Find elastic slope and lower limit diffractive slope. - IHA=MAX(2,IABS(MINT(103))/110) - IF(IHA.GE.5) IHA=1 - IHB=MAX(2,IABS(MINT(104))/110) - IF(IHB.GE.5) IHB=1 - IF(ISUB.EQ.91) THEN - BMN=2D0*BHAD(IHA)+2D0*BHAD(IHB)+4D0*SH**EPS-4.2D0 - ELSEIF(ISUB.EQ.92) THEN - BMN=MAX(2D0,2D0*BHAD(IHB)) - ELSEIF(ISUB.EQ.93) THEN - BMN=MAX(2D0,2D0*BHAD(IHA)) - ELSEIF(ISUB.EQ.94) THEN - BMN=2D0*ALP*4D0 - ENDIF - -C...Determine maximum possible t range and coefficient of generation. - SQLA12=(SH-SQM1-SQM2)**2-4D0*SQM1*SQM2 - SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 - THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH - THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH - THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* - & (SQM1*SQM4-SQM2*SQM3)/SH - THL=-0.5D0*(THA+THB) - THU=THC/THL - THRND=EXP(MAX(-50D0,BMN*(THL-THU)))-1D0 - -C...Select diffractive mass/masses according to dm^2/m^2. - LOOP3=0 - 260 LOOP3=LOOP3+1 - DO 270 JT=1,2 - IF(MINT(16+JT).EQ.0) THEN - PDIF(2+JT)=PDIF(JT) - ELSE - PMMIN=PDIF(JT) - PMMAX=MAX(VINT(2+JT),VINT(1)-PDIF(3-JT)) - PDIF(2+JT)=PMMIN*(PMMAX/PMMIN)**PYR(0) - ENDIF - 270 CONTINUE - SQM3=PDIF(3)**2 - SQM4=PDIF(4)**2 - -C..Additional mass factors, including resonance enhancement. - IF(PDIF(3)+PDIF(4).GE.VINT(1)) THEN - IF(LOOP3.LT.100) GOTO 260 - GOTO 100 - ENDIF - IF(ISUB.EQ.92) THEN - FSD=(1D0-SQM3/SH)*(1D0+CRES*SMRES1/(SMRES1+SQM3)) - IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 - ELSEIF(ISUB.EQ.93) THEN - FSD=(1D0-SQM4/SH)*(1D0+CRES*SMRES2/(SMRES2+SQM4)) - IF(FSD.LT.PYR(0)*(1D0+CRES)) GOTO 260 - ELSEIF(ISUB.EQ.94) THEN - FDD=(1D0-(PDIF(3)+PDIF(4))**2/SH)*(SH*SMP/ - & (SH*SMP+SQM3*SQM4))*(1D0+CRES*SMRES1/(SMRES1+SQM3))* - & (1D0+CRES*SMRES2/(SMRES2+SQM4)) - IF(FDD.LT.PYR(0)*(1D0+CRES)**2) GOTO 260 - ENDIF - -C...Select t according to exp(Bmn*t) and correct to right slope. - TH=THU+LOG(1D0+THRND*PYR(0))/BMN - IF(ISUB.GE.92) THEN - IF(ISUB.EQ.92) THEN - BADD=2D0*ALP*LOG(SH/SQM3) - IF(BHAD(IHB).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHB)-2D0) - ELSEIF(ISUB.EQ.93) THEN - BADD=2D0*ALP*LOG(SH/SQM4) - IF(BHAD(IHA).LT.1D0) BADD=MAX(0D0,BADD+2D0*BHAD(IHA)-2D0) - ELSEIF(ISUB.EQ.94) THEN - BADD=2D0*ALP*(LOG(EXP(4D0)+SH/(ALP*SQM3*SQM4))-4D0) - ENDIF - IF(EXP(MAX(-50D0,BADD*(TH-THU))).LT.PYR(0)) GOTO 260 - ENDIF - -C...Check whether m^2 and t choices are consistent. - SQLA34=(SH-SQM3-SQM4)**2-4D0*SQM3*SQM4 - THA=SH-(SQM1+SQM2+SQM3+SQM4)+(SQM1-SQM2)*(SQM3-SQM4)/SH - THB=SQRT(MAX(0D0,SQLA12))*SQRT(MAX(0D0,SQLA34))/SH - IF(THB.LE.1D-8) GOTO 260 - THC=(SQM3-SQM1)*(SQM4-SQM2)+(SQM1+SQM4-SQM2-SQM3)* - & (SQM1*SQM4-SQM2*SQM3)/SH - THLM=-0.5D0*(THA+THB) - THUM=THC/THLM - IF(TH.LT.THLM.OR.TH.GT.THUM) GOTO 260 - -C...Information to output. - VINT(21)=1D0 - VINT(22)=0D0 - VINT(23)=MIN(1D0,MAX(-1D0,(THA+2D0*TH)/THB)) - VINT(45)=TH - VINT(59)=2D0*SQRT(MAX(0D0,-(THC+THA*TH+TH**2)))/THB - VINT(63)=PDIF(3)**2 - VINT(64)=PDIF(4)**2 - VINT(283)=PMM(1)**2/4D0 - VINT(284)=PMM(2)**2/4D0 - -C...Note: in the following, by In is meant the integral over the -C...quantity multiplying coefficient cn. -C...Choose tau according to h1(tau)/tau, where -C...h1(tau) = c1 + I1/I2*c2*1/tau + I1/I3*c3*1/(tau+tau_R) + -C...I1/I4*c4*tau/((s*tau-m^2)^2+(m*Gamma)^2) + -C...I1/I5*c5*1/(tau+tau_R') + -C...I1/I6*c6*tau/((s*tau-m'^2)^2+(m'*Gamma')^2) + -C...I1/I7*c7*tau/(1.-tau), and -C...c1 + c2 + c3 + c4 + c5 + c6 + c7 = 1. - ELSEIF(ISTSB.GE.1.AND.ISTSB.LE.5) THEN - CALL PYKLIM(1) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RTAU=PYR(0) - MTAU=1 - IF(RTAU.GT.COEF(ISUB,1)) MTAU=2 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)) - & MTAU=5 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ - & COEF(ISUB,5)) MTAU=6 - IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ - & COEF(ISUB,5)+COEF(ISUB,6)) MTAU=7 - CALL PYKMAP(1,MTAU,PYR(0)) - -C...2 -> 3, 4 processes: -C...Choose tau' according to h4(tau,tau')/tau', where -C...h4(tau,tau') = c1 + I1/I2*c2*(1 - tau/tau')^3/tau' + -C...I1/I3*c3*1/(1 - tau'), and c1 + c2 + c3 = 1. - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - CALL PYKLIM(4) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RTAUP=PYR(0) - MTAUP=1 - IF(RTAUP.GT.COEF(ISUB,18)) MTAUP=2 - IF(RTAUP.GT.COEF(ISUB,18)+COEF(ISUB,19)) MTAUP=3 - CALL PYKMAP(4,MTAUP,PYR(0)) - ENDIF - -C...Choose y* according to h2(y*), where -C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) + -C...I0/I3*c3*1/cosh(y*) + I0/I4*c4*1/(1-exp(y*-y*max)) + -C...I0/I5*c5*1/(1-exp(-y*-y*min)), I0 = y*max-y*min, -C...and c1 + c2 + c3 + c4 + c5 = 1. - CALL PYKLIM(2) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - RYST=PYR(0) - MYST=1 - IF(RYST.GT.COEF(ISUB,8)) MYST=2 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)) MYST=3 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)) MYST=4 - IF(RYST.GT.COEF(ISUB,8)+COEF(ISUB,9)+COEF(ISUB,10)+ - & COEF(ISUB,11)) MYST=5 - CALL PYKMAP(2,MYST,PYR(0)) - -C...2 -> 2 processes: -C...Choose cos(theta-hat) (cth) according to h3(cth), where -C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) + -C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2, -C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products), -C...and c0 + c1 + c2 + c3 + c4 = 1. - CALL PYKLIM(3) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - RCTH=PYR(0) - MCTH=1 - IF(RCTH.GT.COEF(ISUB,13)) MCTH=2 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)) MCTH=3 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)) MCTH=4 - IF(RCTH.GT.COEF(ISUB,13)+COEF(ISUB,14)+COEF(ISUB,15)+ - & COEF(ISUB,16)) MCTH=5 - CALL PYKMAP(3,MCTH,PYR(0)) - ENDIF - -C...2 -> 3 : select pT1, phi1, pT2, phi2, y3 for 3 outgoing. - IF(ISTSB.EQ.5) THEN - CALL PYKMAP(5,0,0D0) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - -C...DIS as f + gamma* -> f process: set dummy values. - ELSEIF(ISTSB.EQ.8) THEN - VINT(21)=0.9D0 - VINT(22)=0D0 - VINT(23)=0D0 - VINT(47)=0D0 - VINT(48)=0D0 - -C...Low-pT or multiple interactions (first semihard interaction). - ELSEIF(ISTSB.EQ.9) THEN - CALL PYMULT(3) - ISUB=MINT(1) - -C...Study user-defined process: kinematics plus weight. - ELSEIF(ISTSB.EQ.11) THEN - IF(IDWTUP.GT.0.AND.XWGTUP.LT.0D0) CALL - & PYERRM(26,'(PYRAND:) Negative XWGTUP for user process') - MSTI(51)=0 - IF(NUP.LE.0) THEN - MINT(51)=2 - MSTI(51)=1 - IF(MINT(82).EQ.1) THEN - NGEN(0,1)=NGEN(0,1)-1 - NGEN(ISUB,1)=NGEN(ISUB,1)-1 - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - -C...Extract cross section event weight. - IF(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.4) THEN - SIGS=1D-9*XWGTUP - ELSE - SIGS=1D-9*XSECUP(KFPR(ISUB,1)) - ENDIF - IF(IABS(IDWTUP).GE.1.AND.IABS(IDWTUP).LE.3) THEN - VINT(97)=SIGN(1D0,XWGTUP) - ELSE - VINT(97)=1D-9*XWGTUP - ENDIF - -C...Construct 'trivial' kinematical variables needed. - KFL1=IDUP(1) - KFL2=IDUP(2) - VINT(41)=PUP(4,1)/EBMUP(1) - VINT(42)=PUP(4,2)/EBMUP(2) - VINT(21)=VINT(41)*VINT(42) - VINT(22)=0.5D0*LOG(VINT(41)/VINT(42)) - VINT(44)=VINT(21)*VINT(2) - VINT(43)=SQRT(MAX(0D0,VINT(44))) - VINT(55)=SCALUP - IF(SCALUP.LE.0D0) VINT(55)=VINT(43) - VINT(56)=VINT(55)**2 - VINT(57)=AQEDUP - VINT(58)=AQCDUP - -C...Construct other kinematical variables needed (approximately). - VINT(23)=0D0 - VINT(26)=VINT(21) - VINT(45)=-0.5D0*VINT(44) - VINT(46)=-0.5D0*VINT(44) - VINT(49)=VINT(43) - VINT(50)=VINT(44) - VINT(51)=VINT(55) - VINT(52)=VINT(56) - VINT(53)=VINT(55) - VINT(54)=VINT(56) - VINT(25)=0D0 - VINT(48)=0D0 - IF(ISTUP(1).NE.-1.OR.ISTUP(2).NE.-1) CALL PYERRM(26, - & '(PYRAND:) unacceptable ISTUP code for incoming particles') - DO 280 IUP=3,NUP - IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) CALL PYERRM(26, - & '(PYRAND:) unacceptable ISTUP code for particles') - IF(ISTUP(IUP).EQ.1) VINT(25)=VINT(25)+2D0*(PUP(5,IUP)**2+ - & PUP(1,IUP)**2+PUP(2,IUP)**2)/VINT(2) - IF(ISTUP(IUP).EQ.1) VINT(48)=VINT(48)+0.5D0*(PUP(1,IUP)**2+ - & PUP(2,IUP)**2) - 280 CONTINUE - VINT(47)=SQRT(VINT(48)) - ENDIF - -C...Choose azimuthal angle. - VINT(24)=0D0 - IF(ISTSB.NE.11) VINT(24)=PARU(2)*PYR(0) - -C...Check against user cuts on kinematics at parton level. - MINT(51)=0 - IF((ISUB.LE.90.OR.ISUB.GT.100).AND.ISTSB.LE.10) CALL PYKLIM(0) - IF(MINT(51).NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - IF(MINT(82).EQ.1.AND.MSTP(141).GE.1.AND.ISTSB.LE.10) THEN - MCUT=0 - IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0) - & CALL PYKCUT(MCUT) - IF(MCUT.NE.0) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - -C...Calculate differential cross-section for different subprocesses. - IF(ISTSB.LE.10) CALL PYSIGH(NCHN,SIGS) - SIGSOR=SIGS - SIGLPT=SIGT(0,0,5)*VINT(315)*VINT(316) - -C...Multiply cross section by lepton -> photon flux factor. - IF(MINT(141).NE.0.OR.MINT(142).NE.0) THEN - SIGS=WTGAGA*SIGS - DO 290 ICHN=1,NCHN - SIGH(ICHN)=WTGAGA*SIGH(ICHN) - 290 CONTINUE - SIGLPT=WTGAGA*SIGLPT - ENDIF - -C...Multiply cross-section by user-defined weights. - IF(MSTP(173).EQ.1) THEN - SIGS=PARP(173)*SIGS - DO 300 ICHN=1,NCHN - SIGH(ICHN)=PARP(173)*SIGH(ICHN) - 300 CONTINUE - SIGLPT=PARP(173)*SIGLPT - ENDIF - WTXS=1D0 - SIGSWT=SIGS - VINT(99)=1D0 - VINT(100)=1D0 - IF(MINT(82).EQ.1.AND.MSTP(142).GE.1) THEN - IF(ISUB.NE.96.AND.MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+ - & MSUB(95).EQ.0) CALL PYEVWT(WTXS) - SIGSWT=WTXS*SIGS - VINT(99)=WTXS - IF(MSTP(142).EQ.1) VINT(100)=1D0/WTXS - ENDIF - -C...Calculations for Monte Carlo estimate of all cross-sections. - IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN - IF(MSTP(142).LE.1) THEN - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS - ELSE - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGSWT - ENDIF - ELSEIF(MINT(82).EQ.1) THEN - XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS - ENDIF - IF((ISUB.EQ.95.OR.ISUB.EQ.96).AND.LOOP2.EQ.1.AND. - &MINT(82).EQ.1) XSEC(97,2)=XSEC(97,2)+SIGLPT - -C...Multiple interactions: store results of cross-section calculation. - IF(MINT(50).EQ.1.AND.MSTP(82).GE.3) THEN - VINT(153)=SIGSOR - CALL PYMULT(4) - ENDIF - -C...Ratio of actual to maximum cross section. - IF(ISTSB.NE.11) THEN - VIOL=SIGSWT/XSEC(ISUB,1) - IF(ISUB.EQ.96.AND.MSTP(173).EQ.1) VIOL=VIOL/PARP(174) - ELSEIF(IDWTUP.EQ.1.OR.IDWTUP.EQ.2) THEN - VIOL=XWGTUP/XMAXUP(KFPR(ISUB,1)) - ELSEIF(IDWTUP.EQ.-1.OR.IDWTUP.EQ.-2) THEN - VIOL=ABS(XWGTUP)/ABS(XMAXUP(KFPR(ISUB,1))) - ELSE - VIOL=1D0 - ENDIF - -C...Check that weight not negative. - IF(MSTP(123).LE.0) THEN - IF(VIOL.LT.-1D-3) THEN - WRITE(MSTU(11),5000) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - STOP - ENDIF - ELSE - IF(VIOL.LT.MIN(-1D-3,VINT(109))) THEN - VINT(109)=VIOL - WRITE(MSTU(11),5200) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.1) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - ENDIF - ENDIF - -C...Weighting using estimate of maximum of differential cross-section. - IF(MFAIL.EQ.0.AND.ISUB.NE.95.AND.ISUB.NE.96) THEN - IF(VIOL.LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(ISUB.GE.91.AND.ISUB.LE.94) ISUB=0 - GOTO 100 - ENDIF - ELSEIF(MFAIL.EQ.0) THEN - RATND=SIGLPT/XSEC(95,1) - VIOL=VIOL/RATND - IF(LOOP2.EQ.1.AND.RATND.LT.PYR(0)) THEN - IF(VIOL.GT.PYR(0).AND.MINT(82).EQ.1.AND.MSUB(95).EQ.1.AND. - & (ISUB.LE.90.OR.ISUB.GE.95)) NGEN(95,1)=NGEN(95,1)+MINT(143) - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - ISUB=0 - GOTO 100 - ENDIF - IF(VIOL.LT.PYR(0)) THEN - GOTO 140 - ENDIF - ELSEIF(ISUB.NE.95.AND.ISUB.NE.96) THEN - IF(VIOL.LT.PYR(0)) THEN - MSTI(61)=1 - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - ELSE - RATND=SIGLPT/XSEC(95,1) - IF(LOOP.EQ.1.AND.RATND.LT.PYR(0)) THEN - MSTI(61)=1 - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - RETURN - ENDIF - VIOL=VIOL/RATND - IF(VIOL.LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - GOTO 100 - ENDIF - ENDIF - -C...Check for possible violation of estimated maximum of differential -C...cross-section used in weighting. - IF(MSTP(123).LE.0) THEN - IF(VIOL.GT.1D0) THEN - WRITE(MSTU(11),5300) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - STOP - ENDIF - ELSEIF(MSTP(123).EQ.1) THEN - IF(VIOL.GT.VINT(108)) THEN - VINT(108)=VIOL - IF(VIOL.GT.1.0001D0) THEN - MINT(10)=1 - WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - ENDIF - ENDIF - ELSEIF(VIOL.GT.VINT(108)) THEN - VINT(108)=VIOL - IF(VIOL.GT.1D0) THEN - MINT(10)=1 - WRITE(MSTU(11),5400) VIOL,NGEN(0,3)+1 - IF(ISTSB.EQ.11.AND.(IABS(IDWTUP).EQ.1.OR.IABS(IDWTUP).EQ.2)) - & THEN - XMAXUP(KFPR(ISUB,1))=VIOL*XMAXUP(KFPR(ISUB,1)) - IF(KFPR(ISUB,1).LE.9) THEN - WRITE(MSTU(11),5800) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ELSEIF(KFPR(ISUB,1).LE.99) THEN - WRITE(MSTU(11),5900) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ELSE - WRITE(MSTU(11),6000) KFPR(ISUB,1),XMAXUP(KFPR(ISUB,1)) - ENDIF - ENDIF - IF(ISTSB.NE.11.OR.IABS(IDWTUP).EQ.1) THEN - XDIF=XSEC(ISUB,1)*(VIOL-1D0) - XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF - IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) - & XSEC(0,1)=XSEC(0,1)+XDIF - IF(MSTP(122).GE.2) WRITE(MSTU(11),5100) ISUB,VINT(21), - & VINT(22),VINT(23),VINT(26) - IF(ISUB.LE.9) THEN - WRITE(MSTU(11),5500) ISUB,XSEC(ISUB,1) - ELSEIF(ISUB.LE.99) THEN - WRITE(MSTU(11),5600) ISUB,XSEC(ISUB,1) - ELSE - WRITE(MSTU(11),5700) ISUB,XSEC(ISUB,1) - ENDIF - ENDIF - VINT(108)=1D0 - ENDIF - ENDIF - -C...Multiple interactions: choose impact parameter. - VINT(148)=1D0 - IF(MINT(50).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND. - &MSTP(82).GE.3) THEN - CALL PYMULT(5) - IF(VINT(150).LT.PYR(0)) THEN - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - IF(MFAIL.EQ.1) THEN - MSTI(61)=1 - RETURN - ENDIF - GOTO 100 - ENDIF - ENDIF - IF(MINT(82).EQ.1) NGEN(0,2)=NGEN(0,2)+1 - IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN - IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+MINT(143) - IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1 - ENDIF - IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1 - -C...Choose flavour of reacting partons (and subprocess). - IF(ISTSB.GE.11) GOTO 320 - RSIGS=SIGS*PYR(0) - QT2=VINT(48) - RQQBAR=PARP(87)*(1D0-(QT2/(QT2+(PARP(88)*PARP(82)* - &(VINT(1)/PARP(89))**PARP(90))**2))**2) - IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. - &PYR(0).GT.RQQBAR)) THEN - DO 310 ICHN=1,NCHN - KFL1=ISIG(ICHN,1) - KFL2=ISIG(ICHN,2) - MINT(2)=ISIG(ICHN,3) - RSIGS=RSIGS-SIGH(ICHN) - IF(RSIGS.LE.0D0) GOTO 320 - 310 CONTINUE - -C...Multiple interactions: choose qqbar preferentially at small pT. - ELSEIF(ISUB.EQ.96) THEN - MINT(105)=MINT(103) - MINT(109)=MINT(107) - CALL PYSPLI(MINT(11),21,KFL1,KFLDUM) - MINT(105)=MINT(104) - MINT(109)=MINT(108) - CALL PYSPLI(MINT(12),21,KFL2,KFLDUM) - MINT(1)=11 - MINT(2)=1 - IF(KFL1.EQ.KFL2.AND.PYR(0).LT.0.5D0) MINT(2)=2 - -C...Low-pT: choose string drawing configuration. - ELSE - KFL1=21 - KFL2=21 - RSIGS=6D0*PYR(0) - MINT(2)=1 - IF(RSIGS.GT.1D0) MINT(2)=2 - IF(RSIGS.GT.2D0) MINT(2)=3 - ENDIF - -C...Reassign QCD process. Partons before initial state radiation. - 320 IF(MINT(2).GT.10) THEN - MINT(1)=MINT(2)/10 - MINT(2)=MOD(MINT(2),10) - ENDIF - IF(MINT(82).EQ.1.AND.MSTP(111).GE.0) NGEN(MINT(1),2)= - &NGEN(MINT(1),2)+1 - MINT(15)=KFL1 - MINT(16)=KFL2 - MINT(13)=MINT(15) - MINT(14)=MINT(16) - VINT(141)=VINT(41) - VINT(142)=VINT(42) - VINT(151)=0D0 - VINT(152)=0D0 - -C...Calculate x value of photon for parton inside photon inside e. - DO 350 JT=1,2 - MINT(18+JT)=0 - VINT(154+JT)=0D0 - MSPLI=0 - IF(JT.EQ.1.AND.MINT(43).LE.2) MSPLI=1 - IF(JT.EQ.2.AND.MOD(MINT(43),2).EQ.1) MSPLI=1 - IF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) MSPLI=MSPLI+1 - IF(MSPLI.EQ.2) THEN - KFLH=MINT(14+JT) - XHRD=VINT(140+JT) - Q2HRD=VINT(54) - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(22,XHRD,Q2HRD,XPQ) - ELSE - CALL PYPDFL(22,XHRD,Q2HRD,XPQ) - ENDIF - WTMX=4D0*XPQ(KFLH) - IF(MSTP(13).EQ.2) THEN - Q2PMS=Q2HRD/PMAS(11,1)**2 - WTMX=WTMX*LOG(MAX(2D0,Q2PMS*(1D0-XHRD)/XHRD**2)) - ENDIF - 330 XE=XHRD**PYR(0) - XG=MIN(1D0-1D-10,XHRD/XE) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(22,XG,Q2HRD,XPQ) - ELSE - CALL PYPDFL(22,XG,Q2HRD,XPQ) - ENDIF - WT=(1D0+(1D0-XE)**2)*XPQ(KFLH) - IF(MSTP(13).EQ.2) WT=WT*LOG(MAX(2D0,Q2PMS*(1D0-XE)/XE**2)) - IF(WT.LT.PYR(0)*WTMX) GOTO 330 - MINT(18+JT)=1 - VINT(154+JT)=XE - DO 340 KFLS=-25,25 - XSFX(JT,KFLS)=XPQ(KFLS) - 340 CONTINUE - ENDIF - 350 CONTINUE - -C...Pick scale where photon is resolved. - Q0S=PARP(15)**2 - Q1S=VINT(154)**2 - VINT(283)=0D0 - IF(MINT(107).EQ.3) THEN - IF(MSTP(66).EQ.1) THEN - VINT(283)=Q0S*(VINT(54)/Q0S)**PYR(0) - ELSEIF(MSTP(66).EQ.2) THEN - PS=VINT(3)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - VINT(283)=Q2INT*(VINT(54)/Q2INT)**PYR(0) - ELSEIF(MSTP(66).EQ.3) THEN - VINT(283)=Q0S*(Q1S/Q0S)**PYR(0) - ELSEIF(MSTP(66).GE.4) THEN - PS=0.25D0*VINT(3)**2 - VINT(283)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - ENDIF - ENDIF - VINT(284)=0D0 - IF(MINT(108).EQ.3) THEN - IF(MSTP(66).EQ.1) THEN - VINT(284)=Q0S*(VINT(54)/Q0S)**PYR(0) - ELSEIF(MSTP(66).EQ.2) THEN - PS=VINT(4)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - VINT(284)=Q2INT*(VINT(54)/Q2INT)**PYR(0) - ELSEIF(MSTP(66).EQ.3) THEN - VINT(284)=Q0S*(Q1S/Q0S)**PYR(0) - ELSEIF(MSTP(66).GE.4) THEN - PS=0.25D0*VINT(4)**2 - VINT(284)=(Q0S+PS)*(Q1S+PS)/ - & (Q0S+PYR(0)*(Q1S-Q0S)+PS)-PS - ENDIF - ENDIF - IF(MINT(121).GT.1) CALL PYSAVE(2,IGA) - -C...Format statements for differential cross-section maximum violations. - 5000 FORMAT(/1X,'Error: negative cross-section fraction',1P,D11.3,1X, - &'in event',1X,I7,'D0'/1X,'Execution stopped!') - 5100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau =',1P, - &D11.3,', y* =',D11.3,', cthe = ',0P,F11.7,', tau'' =',1P,D11.3) - 5200 FORMAT(/1X,'Warning: negative cross-section fraction',1P,D11.3,1X, - &'in event',1X,I7) - 5300 FORMAT(/1X,'Error: maximum violated by',1P,D11.3,1X, - &'in event',1X,I7,'D0'/1X,'Execution stopped!') - 5400 FORMAT(/1X,'Advisory warning: maximum violated by',1P,D11.3,1X, - &'in event',1X,I7) - 5500 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,D11.3) - 5600 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,D11.3) - 5700 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,D11.3) - 5800 FORMAT(1X,'XMAXUP(',I1,') increased to',1P,D11.3) - 5900 FORMAT(1X,'XMAXUP(',I2,') increased to',1P,D11.3) - 6000 FORMAT(1X,'XMAXUP(',I3,') increased to',1P,D11.3) - - RETURN - END - -C*********************************************************************** - -C...PYRECO -C...Handles the possibility of colour reconnection in W+W- events, -C...Based on the main scenarios of the Sjostrand and Khoze study: -C...I, II, II', intermediate and instantaneous; plus one model -C...along the lines of the Gustafson and Hakkinen: GH. -C...Note: also handles Z0 Z0 and W-W+ events, but notation below -C...is as if first resonance is W+ and second W-. - - SUBROUTINE PYRECO(IW1,IW2,NSD1,NAFT1) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter value; number of points in MC integration. - PARAMETER (NPT=100) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION NBEG(2),NEND(2),INP(50),INM(50),BEWW(3),XP(3),XM(3), - &V1(3),V2(3),BETP(50,4),DIRP(50,3),BETM(50,4),DIRM(50,3), - &XD(4),XB(4),IAP(NPT),IAM(NPT),WTA(NPT),V1P(3),V2P(3),V1M(3), - &V2M(3),Q(4,3),XPP(3),XMM(3),IPC(20),IMC(20),TC(0:20),TPC(20), - &TMC(20),IJOIN(100) - -C...Functions to give four-product and to do determinants. - 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) - DETER(I,J,L)=Q(I,1)*Q(J,2)*Q(L,3)-Q(I,1)*Q(L,2)*Q(J,3)+ - &Q(J,1)*Q(L,2)*Q(I,3)-Q(J,1)*Q(I,2)*Q(L,3)+ - &Q(L,1)*Q(I,2)*Q(J,3)-Q(L,1)*Q(J,2)*Q(I,3) - -C...Only allow fraction of recoupling for GH, intermediate and -C...instantaneous. - IF(MSTP(115).EQ.5.OR.MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN - IF(PYR(0).GT.PARP(120)) RETURN - ENDIF - ISUB=MINT(1) - -C...Common part for scenarios I, II, II', and GH. - IF(MSTP(115).EQ.1.OR.MSTP(115).EQ.2.OR.MSTP(115).EQ.3.OR. - &MSTP(115).EQ.5) THEN - -C...Read out frequently-used parameters. - PI=PARU(1) - HBAR=PARU(3) - PMW=PMAS(24,1) - IF(ISUB.EQ.22) PMW=PMAS(23,1) - PGW=PMAS(24,2) - IF(ISUB.EQ.22) PGW=PMAS(23,2) - TFRAG=PARP(115) - RHAD=PARP(116) - FACT=PARP(117) - BLOWR=PARP(118) - BLOWT=PARP(119) - -C...Find range of decay products of the W's. -C...Background: the W's are stored in IW1 and IW2. -C...Their direct decay products in NSD1+1 through NSD1+4. -C...Products after shower (if any) in NSD1+5 through NAFT1 -C...for first W and in NAFT1+1 through N for the second. - IF(NAFT1.GT.NSD1+4) THEN - NBEG(1)=NSD1+5 - NEND(1)=NAFT1 - ELSE - NBEG(1)=NSD1+1 - NEND(1)=NSD1+2 - ENDIF - IF(N.GT.NAFT1) THEN - NBEG(2)=NAFT1+1 - NEND(2)=N - ELSE - NBEG(2)=NSD1+3 - NEND(2)=NSD1+4 - ENDIF - -C...Rearrange parton shower products along strings. - NOLD=N - CALL PYPREP(NSD1+1) - -C...Find partons pointing back to W+ and W-; store them with quark -C...end of string first. - NNP=0 - NNM=0 - ISGP=0 - ISGM=0 - DO 120 I=NOLD+1,N - IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 120 - IF(IABS(K(I,2)).GE.22) GOTO 120 - IF(K(I,3).GE.NBEG(1).AND.K(I,3).LE.NEND(1)) THEN - IF(ISGP.EQ.0) ISGP=ISIGN(1,K(I,2)) - NNP=NNP+1 - IF(ISGP.EQ.1) THEN - INP(NNP)=I - ELSE - DO 100 I1=NNP,2,-1 - INP(I1)=INP(I1-1) - 100 CONTINUE - INP(1)=I - ENDIF - IF(K(I,1).EQ.1) ISGP=0 - ELSEIF(K(I,3).GE.NBEG(2).AND.K(I,3).LE.NEND(2)) THEN - IF(ISGM.EQ.0) ISGM=ISIGN(1,K(I,2)) - NNM=NNM+1 - IF(ISGM.EQ.1) THEN - INM(NNM)=I - ELSE - DO 110 I1=NNM,2,-1 - INM(I1)=INM(I1-1) - 110 CONTINUE - INM(1)=I - ENDIF - IF(K(I,1).EQ.1) ISGM=0 - ENDIF - 120 CONTINUE - -C...Boost to W+W- rest frame (not strictly needed). - DO 130 J=1,3 - BEWW(J)=(P(IW1,J)+P(IW2,J))/(P(IW1,4)+P(IW2,4)) - 130 CONTINUE - CALL PYROBO(IW1,IW1,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - CALL PYROBO(IW2,IW2,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - CALL PYROBO(NOLD+1,N,0D0,0D0,-BEWW(1),-BEWW(2),-BEWW(3)) - -C...Select decay vertices of W+ and W-. - TP=HBAR*(-LOG(PYR(0)))*P(IW1,4)/ - & SQRT((P(IW1,5)**2-PMW**2)**2+(P(IW1,5)**2*PGW/PMW)**2) - TM=HBAR*(-LOG(PYR(0)))*P(IW2,4)/ - & SQRT((P(IW2,5)**2-PMW**2)**2+(P(IW2,5)**2*PGW/PMW)**2) - GTMAX=MAX(TP,TM) - DO 140 J=1,3 - XP(J)=TP*P(IW1,J)/P(IW1,4) - XM(J)=TM*P(IW2,J)/P(IW2,4) - 140 CONTINUE - -C...Begin scenario I specifics. - IF(MSTP(115).EQ.1) THEN - -C...Reconstruct velocity and direction of W+ string pieces. - DO 170 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 170 - I1=INP(IIP) - I2=INP(IIP+1) - P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) - P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) - DO 150 J=1,3 - V1(J)=P(I1,J)/P1A - V2(J)=P(I2,J)/P2A - BETP(IIP,J)=0.5D0*(V1(J)+V2(J)) - DIRP(IIP,J)=V1(J)-V2(J) - 150 CONTINUE - BETP(IIP,4)=1D0/SQRT(1D0-BETP(IIP,1)**2-BETP(IIP,2)**2- - & BETP(IIP,3)**2) - DIRL=SQRT(DIRP(IIP,1)**2+DIRP(IIP,2)**2+DIRP(IIP,3)**2) - DO 160 J=1,3 - DIRP(IIP,J)=DIRP(IIP,J)/DIRL - 160 CONTINUE - 170 CONTINUE - -C...Reconstruct velocity and direction of W- string pieces. - DO 200 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 200 - I1=INM(IIM) - I2=INM(IIM+1) - P1A=SQRT(P(I1,1)**2+P(I1,2)**2+P(I1,3)**2) - P2A=SQRT(P(I2,1)**2+P(I2,2)**2+P(I2,3)**2) - DO 180 J=1,3 - V1(J)=P(I1,J)/P1A - V2(J)=P(I2,J)/P2A - BETM(IIM,J)=0.5D0*(V1(J)+V2(J)) - DIRM(IIM,J)=V1(J)-V2(J) - 180 CONTINUE - BETM(IIM,4)=1D0/SQRT(1D0-BETM(IIM,1)**2-BETM(IIM,2)**2- - & BETM(IIM,3)**2) - DIRL=SQRT(DIRM(IIM,1)**2+DIRM(IIM,2)**2+DIRM(IIM,3)**2) - DO 190 J=1,3 - DIRM(IIM,J)=DIRM(IIM,J)/DIRL - 190 CONTINUE - 200 CONTINUE - -C...Loop over number of space-time points. - NACC=0 - SUM=0D0 - DO 250 IPT=1,NPT - -C...Pick x,y,z,t Gaussian (width RHAD and TFRAG, respectively). - R=SQRT(-LOG(PYR(0))) - PHI=2D0*PI*PYR(0) - X=BLOWR*RHAD*R*COS(PHI) - Y=BLOWR*RHAD*R*SIN(PHI) - R=SQRT(-LOG(PYR(0))) - PHI=2D0*PI*PYR(0) - Z=BLOWR*RHAD*R*COS(PHI) - T=GTMAX+BLOWT*SQRT(0.5D0)*TFRAG*R*ABS(SIN(PHI)) - -C...Reject impossible points. Weight for sample distribution. - IF(T**2-X**2-Y**2-Z**2.LT.0D0) GOTO 250 - WTSMP=EXP(-(X**2+Y**2+Z**2)/(BLOWR*RHAD)**2)* - & EXP(-2D0*(T-GTMAX)**2/(BLOWT*TFRAG)**2) - -C...Loop over W+ string pieces and find one with largest weight. - IMAXP=0 - WTMAXP=1D-10 - XD(1)=X-XP(1) - XD(2)=Y-XP(2) - XD(3)=Z-XP(3) - XD(4)=T-TP - DO 220 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 220 - BED=BETP(IIP,1)*XD(1)+BETP(IIP,2)*XD(2)+BETP(IIP,3)*XD(3) - BEDG=BETP(IIP,4)*(BETP(IIP,4)*BED/(1D0+BETP(IIP,4))-XD(4)) - DO 210 J=1,3 - XB(J)=XD(J)+BEDG*BETP(IIP,J) - 210 CONTINUE - XB(4)=BETP(IIP,4)*(XD(4)-BED) - SR2=XB(1)**2+XB(2)**2+XB(3)**2 - SZ2=(DIRP(IIP,1)*XB(1)+DIRP(IIP,2)*XB(2)+ - & DIRP(IIP,3)*XB(3))**2 - WTP=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ - & TFRAG**2) - IF(XB(4)-SQRT(SR2).LT.0D0) WTP=0D0 - IF(WTP.GT.WTMAXP) THEN - IMAXP=IIP - WTMAXP=WTP - ENDIF - 220 CONTINUE - -C...Loop over W- string pieces and find one with largest weight. - IMAXM=0 - WTMAXM=1D-10 - XD(1)=X-XM(1) - XD(2)=Y-XM(2) - XD(3)=Z-XM(3) - XD(4)=T-TM - DO 240 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 240 - BED=BETM(IIM,1)*XD(1)+BETM(IIM,2)*XD(2)+BETM(IIM,3)*XD(3) - BEDG=BETM(IIM,4)*(BETM(IIM,4)*BED/(1D0+BETM(IIM,4))-XD(4)) - DO 230 J=1,3 - XB(J)=XD(J)+BEDG*BETM(IIM,J) - 230 CONTINUE - XB(4)=BETM(IIM,4)*(XD(4)-BED) - SR2=XB(1)**2+XB(2)**2+XB(3)**2 - SZ2=(DIRM(IIM,1)*XB(1)+DIRM(IIM,2)*XB(2)+ - & DIRM(IIM,3)*XB(3))**2 - WTM=EXP(-(SR2-SZ2)/(2D0*RHAD**2))*EXP(-(XB(4)**2-SZ2)/ - & TFRAG**2) - IF(XB(4)-SQRT(SR2).LT.0D0) WTM=0D0 - IF(WTM.GT.WTMAXM) THEN - IMAXM=IIM - WTMAXM=WTM - ENDIF - 240 CONTINUE - -C...Result of integration. - WT=0D0 - IF(IMAXP.NE.0.AND.IMAXM.NE.0) THEN - WT=WTMAXP*WTMAXM/WTSMP - SUM=SUM+WT - NACC=NACC+1 - IAP(NACC)=IMAXP - IAM(NACC)=IMAXM - WTA(NACC)=WT - ENDIF - 250 CONTINUE - RES=BLOWR**3*BLOWT*SUM/NPT - -C...Decide whether to reconnect and, if so, where. - IACC=0 - PREC=1D0-EXP(-FACT*RES) - IF(PREC.GT.PYR(0)) THEN - RSUM=PYR(0)*SUM - DO 260 IA=1,NACC - IACC=IA - RSUM=RSUM-WTA(IA) - IF(RSUM.LE.0D0) GOTO 270 - 260 CONTINUE - 270 IIP=IAP(IACC) - IIM=IAM(IACC) - ENDIF - -C...Begin scenario II and II' specifics. - ELSEIF(MSTP(115).EQ.2.OR.MSTP(115).EQ.3) THEN - -C...Loop through all string pieces, one from W+ and one from W-. - NCROSS=0 - TC(0)=0D0 - DO 340 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 340 - I1P=INP(IIP) - I2P=INP(IIP+1) - DO 330 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 330 - I1M=INM(IIM) - I2M=INM(IIM+1) - -C...Find endpoint velocity vectors. - DO 280 J=1,3 - V1P(J)=P(I1P,J)/P(I1P,4) - V2P(J)=P(I2P,J)/P(I2P,4) - V1M(J)=P(I1M,J)/P(I1M,4) - V2M(J)=P(I2M,J)/P(I2M,4) - 280 CONTINUE - -C...Define q matrix and find t. - DO 290 J=1,3 - Q(1,J)=V2P(J)-V1P(J) - Q(2,J)=-(V2M(J)-V1M(J)) - Q(3,J)=XP(J)-XM(J)-TP*V1P(J)+TM*V1M(J) - Q(4,J)=V1P(J)-V1M(J) - 290 CONTINUE - T=-DETER(1,2,3)/DETER(1,2,4) - -C...Find alpha and beta; i.e. coordinates of crossing point. - S11=Q(1,1)*(T-TP) - S12=Q(2,1)*(T-TM) - S13=Q(3,1)+Q(4,1)*T - S21=Q(1,2)*(T-TP) - S22=Q(2,2)*(T-TM) - S23=Q(3,2)+Q(4,2)*T - DEN=S11*S22-S12*S21 - ALP=(S12*S23-S22*S13)/DEN - BET=(S21*S13-S11*S23)/DEN - -C...Check if solution acceptable. - IANSW=1 - IF(T.LT.GTMAX) IANSW=0 - IF(ALP.LT.0D0.OR.ALP.GT.1D0) IANSW=0 - IF(BET.LT.0D0.OR.BET.GT.1D0) IANSW=0 - -C...Find point of crossing and check that not inconsistent. - DO 300 J=1,3 - XPP(J)=XP(J)+(V1P(J)+ALP*(V2P(J)-V1P(J)))*(T-TP) - XMM(J)=XM(J)+(V1M(J)+BET*(V2M(J)-V1M(J)))*(T-TM) - 300 CONTINUE - D2PM=(XPP(1)-XMM(1))**2+(XPP(2)-XMM(2))**2+ - & (XPP(3)-XMM(3))**2 - D2P=XPP(1)**2+XPP(2)**2+XPP(3)**2 - D2M=XMM(1)**2+XMM(2)**2+XMM(3)**2 - IF(D2PM.GT.1D-4*(D2P+D2M)) IANSW=-1 - -C...Find string eigentimes at crossing. - IF(IANSW.EQ.1) THEN - TAUP=SQRT(MAX(0D0,(T-TP)**2-(XPP(1)-XP(1))**2- - & (XPP(2)-XP(2))**2-(XPP(3)-XP(3))**2)) - TAUM=SQRT(MAX(0D0,(T-TM)**2-(XMM(1)-XM(1))**2- - & (XMM(2)-XM(2))**2-(XMM(3)-XM(3))**2)) - ELSE - TAUP=0D0 - TAUM=0D0 - ENDIF - -C...Order crossings by time. End loop over crossings. - IF(IANSW.EQ.1.AND.NCROSS.LT.20) THEN - NCROSS=NCROSS+1 - DO 310 I1=NCROSS,1,-1 - IF(T.GT.TC(I1-1).OR.I1.EQ.1) THEN - IPC(I1)=IIP - IMC(I1)=IIM - TC(I1)=T - TPC(I1)=TAUP - TMC(I1)=TAUM - GOTO 320 - ELSE - IPC(I1)=IPC(I1-1) - IMC(I1)=IMC(I1-1) - TC(I1)=TC(I1-1) - TPC(I1)=TPC(I1-1) - TMC(I1)=TMC(I1-1) - ENDIF - 310 CONTINUE - 320 CONTINUE - ENDIF - 330 CONTINUE - 340 CONTINUE - -C...Loop over crossings; find first (if any) acceptable one. - IACC=0 - IF(NCROSS.GE.1) THEN - DO 350 IC=1,NCROSS - PNFRAG=EXP(-(TPC(IC)**2+TMC(IC)**2)/TFRAG**2) - IF(PNFRAG.GT.PYR(0)) THEN -C...Scenario II: only compare with fragmentation time. - IF(MSTP(115).EQ.2) THEN - IACC=IC - IIP=IPC(IACC) - IIM=IMC(IACC) - GOTO 360 -C...Scenario II': also require that string length decreases. - ELSE - IIP=IPC(IC) - IIM=IMC(IC) - I1P=INP(IIP) - I2P=INP(IIP+1) - I1M=INM(IIM) - I2M=INM(IIM+1) - ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) - ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) - IF(ELNEW.LT.ELOLD) THEN - IACC=IC - IIP=IPC(IACC) - IIM=IMC(IACC) - GOTO 360 - ENDIF - ENDIF - ENDIF - 350 CONTINUE - 360 CONTINUE - ENDIF - -C...Begin scenario GH specifics. - ELSEIF(MSTP(115).EQ.5) THEN - -C...Loop through all string pieces, one from W+ and one from W-. - IACC=0 - ELMIN=1D0 - DO 380 IIP=1,NNP-1 - IF(K(INP(IIP),2).LT.0) GOTO 380 - I1P=INP(IIP) - I2P=INP(IIP+1) - DO 370 IIM=1,NNM-1 - IF(K(INM(IIM),2).LT.0) GOTO 370 - I1M=INM(IIM) - I2M=INM(IIM+1) - -C...Look for largest decrease of (exponent of) Lambda measure. - ELOLD=FOUR(I1P,I2P)*FOUR(I1M,I2M) - ELNEW=FOUR(I1P,I2M)*FOUR(I1M,I2P) - ELDIF=ELNEW/MAX(1D-10,ELOLD) - IF(ELDIF.LT.ELMIN) THEN - IACC=IIP+IIM - ELMIN=ELDIF - IPC(1)=IIP - IMC(1)=IIM - ENDIF - 370 CONTINUE - 380 CONTINUE - IIP=IPC(1) - IIM=IMC(1) - ENDIF - -C...Common for scenarios I, II, II' and GH: reconnect strings. - IF(IACC.NE.0) THEN - MINT(32)=1 - NJOIN=0 - DO 390 IS=1,NNP+NNM - NJOIN=NJOIN+1 - IF(IS.LE.IIP) THEN - I=INP(IS) - ELSEIF(IS.LE.IIP+NNM-IIM) THEN - I=INM(IS-IIP+IIM) - ELSEIF(IS.LE.IIP+NNM) THEN - I=INM(IS-IIP-NNM+IIM) - ELSE - I=INP(IS-NNM) - ENDIF - IJOIN(NJOIN)=I - IF(K(I,2).LT.0) THEN - CALL PYJOIN(NJOIN,IJOIN) - NJOIN=0 - ENDIF - 390 CONTINUE - -C...Restore original event record if no reconnection. - ELSE - DO 400 I=NSD1+1,NOLD - IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) THEN - K(I,4)=MOD(K(I,4),MSTU(5)**2) - K(I,5)=MOD(K(I,5),MSTU(5)**2) - ENDIF - 400 CONTINUE - DO 410 I=NOLD+1,N - K(K(I,3),1)=3 - 410 CONTINUE - N=NOLD - ENDIF - -C...Boost back system. - CALL PYROBO(IW1,IW1,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) - CALL PYROBO(IW2,IW2,0D0,0D0,BEWW(1),BEWW(2),BEWW(3)) - IF(N.GT.NOLD) CALL PYROBO(NOLD+1,N,0D0,0D0, - & BEWW(1),BEWW(2),BEWW(3)) - -C...Common part for intermediate and instantaneous scenarios. - ELSEIF(MSTP(115).EQ.11.OR.MSTP(115).EQ.12) THEN - MINT(32)=1 - -C...Remove old shower products and reset showering ones. - N=NSD1+4 - DO 420 I=NSD1+1,NSD1+4 - K(I,1)=3 - K(I,4)=MOD(K(I,4),MSTU(5)**2) - K(I,5)=MOD(K(I,5),MSTU(5)**2) - 420 CONTINUE - -C...Identify quark-antiquark pairs. - IQ1=NSD1+1 - IQ2=NSD1+2 - IQ3=NSD1+3 - IF(K(IQ1,2)*K(IQ3,2).LT.0) IQ3=NSD1+4 - IQ4=2*NSD1+7-IQ3 - -C...Reconnect strings. - IJOIN(1)=IQ1 - IJOIN(2)=IQ4 - CALL PYJOIN(2,IJOIN) - IJOIN(1)=IQ3 - IJOIN(2)=IQ2 - CALL PYJOIN(2,IJOIN) - -C...Do new parton showers in intermediate scenario. - IF(MSTP(71).GE.1.AND.MSTP(115).EQ.11) THEN - MSTJ50=MSTJ(50) - MSTJ(50)=0 - CALL PYSHOW(IQ1,IQ2,P(IW1,5)) - CALL PYSHOW(IQ3,IQ4,P(IW2,5)) - MSTJ(50)=MSTJ50 - -C...Do new parton showers in instantaneous scenario. - ELSEIF(MSTP(71).GE.1.AND.MSTP(115).EQ.12) THEN - PPM2=(P(IQ1,4)+P(IQ4,4))**2-(P(IQ1,1)+P(IQ4,1))**2- - & (P(IQ1,2)+P(IQ4,2))**2-(P(IQ1,3)+P(IQ4,3))**2 - PPM=SQRT(MAX(0D0,PPM2)) - CALL PYSHOW(IQ1,IQ4,PPM) - PPM2=(P(IQ3,4)+P(IQ2,4))**2-(P(IQ3,1)+P(IQ2,1))**2- - & (P(IQ3,2)+P(IQ2,2))**2-(P(IQ3,3)+P(IQ2,3))**2 - PPM=SQRT(MAX(0D0,PPM2)) - CALL PYSHOW(IQ3,IQ2,PPM) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYREMN -C...Adds on target remnants (one or two from each side) and -C...includes primordial kT for hadron beams. - - SUBROUTINE PYREMN(IPU1,IPU2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/ -C...Local arrays. - DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(0:6),IS(2),ISN(2),ROBO(5), - &PSYS(0:2,5),PMIN(0:2),QOLD(4),QNEW(4),DBE(3),PSUM(4) - -C...Find event type and remaining energy. - ISUB=MINT(1) - NS=N - IF(MINT(50).EQ.0.OR.MSTP(81).LE.0) THEN - VINT(143)=1D0-VINT(141) - VINT(144)=1D0-VINT(142) - ENDIF - -C...Define initial partons. - NTRY=0 - 100 NTRY=NTRY+1 - DO 130 JT=1,2 - I=MINT(83)+JT+2 - IF(JT.EQ.1) IPU=IPU1 - IF(JT.EQ.2) IPU=IPU2 - K(I,1)=21 - K(I,2)=K(IPU,2) - K(I,3)=I-2 - PMS(JT)=0D0 - VINT(156+JT)=0D0 - VINT(158+JT)=0D0 - IF(MINT(47).EQ.1) THEN - DO 110 J=1,5 - P(I,J)=P(I-2,J) - 110 CONTINUE - ELSEIF(ISUB.EQ.95) THEN - K(I,2)=21 - ELSE - P(I,5)=P(IPU,5) - -C...No primordial kT, or chosen according to truncated Gaussian or -C...exponential, or (for photon) predetermined or power law. - 120 IF(MINT(40+JT).EQ.2.AND.MINT(10+JT).NE.22) THEN - IF(MSTP(91).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(91).EQ.1) THEN - PT=PARP(91)*SQRT(-LOG(PYR(0))) - ELSE - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(92)*LOG(RPT1*RPT2) - ENDIF - IF(PT.GT.PARP(93)) GOTO 120 - ELSEIF(MINT(106+JT).EQ.3) THEN - PTA=SQRT(VINT(282+JT)) - PTB=0D0 - IF(MSTP(66).EQ.5.AND.MSTP(93).EQ.1) THEN - PTB=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(66).EQ.5.AND.MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PTB=-PARP(99)*LOG(RPT1*RPT2) - ENDIF - IF(PTB.GT.PARP(100)) GOTO 120 - PT=SQRT(PTA**2+PTB**2+2D0*PTA*PTB*COS(PARU(2)*PYR(0))) - PT=PT*0.8D0**MINT(57) - IF(NTRY.GT.10) PT=PT*0.8D0**(NTRY-10) - ELSEIF(IABS(MINT(14+JT)).LE.8.OR.MINT(14+JT).EQ.21) THEN - IF(MSTP(93).LE.0) THEN - PT=0D0 - ELSEIF(MSTP(93).EQ.1) THEN - PT=PARP(99)*SQRT(-LOG(PYR(0))) - ELSEIF(MSTP(93).EQ.2) THEN - RPT1=PYR(0) - RPT2=PYR(0) - PT=-PARP(99)*LOG(RPT1*RPT2) - ELSEIF(MSTP(93).EQ.3) THEN - HA=PARP(99)**2 - HB=PARP(100)**2 - PT=SQRT(MAX(0D0,HA*(HA+HB)/(HA+HB-PYR(0)*HB)-HA)) - ELSE - HA=PARP(99)**2 - HB=PARP(100)**2 - IF(MSTP(93).EQ.5) HB=MIN(VINT(48),PARP(100)**2) - PT=SQRT(MAX(0D0,HA*((HA+HB)/HA)**PYR(0)-HA)) - ENDIF - IF(PT.GT.PARP(100)) GOTO 120 - ELSE - PT=0D0 - ENDIF - VINT(156+JT)=PT - PHI=PARU(2)*PYR(0) - P(I,1)=PT*COS(PHI) - P(I,2)=PT*SIN(PHI) - PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - ENDIF - 130 CONTINUE - IF(MINT(47).EQ.1) RETURN - -C...Kinematics construction for initial partons. - I1=MINT(83)+3 - I2=MINT(83)+4 - IF(ISUB.EQ.95) THEN - SHS=0D0 - SHR=0D0 - ELSE - SHS=VINT(141)*VINT(142)*VINT(2)+(P(I1,1)+P(I2,1))**2+ - & (P(I1,2)+P(I2,2))**2 - SHR=SQRT(MAX(0D0,SHS)) - IF((SHS-PMS(1)-PMS(2))**2-4D0*PMS(1)*PMS(2).LE.0D0) GOTO 100 - P(I1,4)=0.5D0*(SHR+(PMS(1)-PMS(2))/SHR) - P(I1,3)=SQRT(MAX(0D0,P(I1,4)**2-PMS(1))) - P(I2,4)=SHR-P(I1,4) - P(I2,3)=-P(I1,3) - -C...Transform partons to overall CM-frame. - ROBO(3)=(P(I1,1)+P(I2,1))/SHR - ROBO(4)=(P(I1,2)+P(I2,2))/SHR - CALL PYROBO(I1,I2,0D0,0D0,-ROBO(3),-ROBO(4),0D0) - ROBO(2)=PYANGL(P(I1,1),P(I1,2)) - CALL PYROBO(I1,I2,0D0,-ROBO(2),0D0,0D0,0D0) - ROBO(1)=PYANGL(P(I1,3),P(I1,1)) - CALL PYROBO(I1,I2,-ROBO(1),0D0,0D0,0D0,0D0) - CALL PYROBO(I2+1,MINT(52),0D0,-ROBO(2),0D0,0D0,0D0) - CALL PYROBO(I1,MINT(52),ROBO(1),ROBO(2),ROBO(3),ROBO(4),0D0) - ROBO(5)=(VINT(141)-VINT(142))/(VINT(141)+VINT(142)) - CALL PYROBO(I1,MINT(52),0D0,0D0,0D0,0D0,ROBO(5)) - ENDIF - -C...Optionally fix up x and Q2 definitions for leptoproduction. - IDISXQ=0 - IF((MINT(43).EQ.2.OR.MINT(43).EQ.3).AND.((ISUB.EQ.10.AND. - &MSTP(23).GE.1).OR.(ISUB.EQ.83.AND.MSTP(23).GE.2))) IDISXQ=1 - IF(IDISXQ.EQ.1) THEN - -C...Find where incoming and outgoing leptons/partons are sitting. - LESD=1 - IF(MINT(42).EQ.1) LESD=2 - LPIN=MINT(83)+3-LESD - LEIN=MINT(84)+LESD - LQIN=MINT(84)+3-LESD - LEOUT=MINT(84)+2+LESD - LQOUT=MINT(84)+5-LESD - IF(K(LEIN,3).GT.LEIN) LEIN=K(LEIN,3) - IF(K(LQIN,3).GT.LQIN) LQIN=K(LQIN,3) - LSCMS=0 - DO 140 I=MINT(84)+5,N - IF(K(I,2).EQ.94) THEN - LSCMS=I - LEOUT=I+LESD - LQOUT=I+3-LESD - ENDIF - 140 CONTINUE - LQBG=IPU1 - IF(LESD.EQ.1) LQBG=IPU2 - -C...Calculate actual and wanted momentum transfer. - XNOM=VINT(43-LESD) - Q2NOM=-VINT(45) - HPK=2D0*(P(LPIN,4)*P(LEIN,4)-P(LPIN,1)*P(LEIN,1)- - & P(LPIN,2)*P(LEIN,2)-P(LPIN,3)*P(LEIN,3))* - & (P(MINT(83)+LESD,4)*VINT(40+LESD)/P(LEIN,4)) - HPT2=MAX(0D0,Q2NOM*(1D0-Q2NOM/(XNOM*HPK))) - FAC=SQRT(HPT2/(P(LEOUT,1)**2+P(LEOUT,2)**2)) - P(N+1,1)=FAC*P(LEOUT,1) - P(N+1,2)=FAC*P(LEOUT,2) - P(N+1,3)=0.25D0*((HPK-Q2NOM/XNOM)/P(LPIN,4)- - & Q2NOM/(P(MINT(83)+LESD,4)*VINT(40+LESD)))*(-1)**(LESD+1) - P(N+1,4)=SQRT(P(LEOUT,5)**2+P(N+1,1)**2+P(N+1,2)**2+ - & P(N+1,3)**2) - DO 150 J=1,4 - QOLD(J)=P(LEIN,J)-P(LEOUT,J) - QNEW(J)=P(LEIN,J)-P(N+1,J) - 150 CONTINUE - -C...Boost outgoing electron and daughters. - IF(LSCMS.EQ.0) THEN - DO 160 J=1,4 - P(LEOUT,J)=P(N+1,J) - 160 CONTINUE - ELSE - DO 170 J=1,3 - P(N+2,J)=(P(N+1,J)-P(LEOUT,J))/(P(N+1,4)+P(LEOUT,4)) - 170 CONTINUE - PINV=2D0/(1D0+P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2) - DO 180 J=1,3 - DBE(J)=PINV*P(N+2,J) - 180 CONTINUE - DO 200 I=LSCMS+1,N - IORIG=I - 190 IORIG=K(IORIG,3) - IF(IORIG.GT.LEOUT) GOTO 190 - IF(I.EQ.LEOUT.OR.IORIG.EQ.LEOUT) - & CALL PYROBO(I,I,0D0,0D0,DBE(1),DBE(2),DBE(3)) - 200 CONTINUE - ENDIF - -C...Copy shower initiator and all outgoing partons. - NCOP=N+1 - K(NCOP,3)=LQBG - DO 210 J=1,5 - P(NCOP,J)=P(LQBG,J) - 210 CONTINUE - DO 240 I=MINT(84)+1,N - ICOP=0 - IF(K(I,1).GT.10) GOTO 240 - IF(I.EQ.LQBG.OR.I.EQ.LQOUT) THEN - ICOP=I - ELSE - IORIG=I - 220 IORIG=K(IORIG,3) - IF(IORIG.EQ.LQBG.OR.IORIG.EQ.LQOUT) THEN - ICOP=IORIG - ELSEIF(IORIG.GT.MINT(84).AND.IORIG.LE.N) THEN - GOTO 220 - ENDIF - ENDIF - IF(ICOP.NE.0) THEN - NCOP=NCOP+1 - K(NCOP,3)=I - DO 230 J=1,5 - P(NCOP,J)=P(I,J) - 230 CONTINUE - ENDIF - 240 CONTINUE - -C...Calculate relative rescaling factors. - SLC=3-2*LESD - PLCSUM=0D0 - DO 250 I=N+2,NCOP - PLCSUM=PLCSUM+(P(I,4)+SLC*P(I,3)) - 250 CONTINUE - DO 260 I=N+2,NCOP - V(I,1)=(P(I,4)+SLC*P(I,3))/PLCSUM - 260 CONTINUE - -C...Transfer extra three-momentum of current. - DO 280 I=N+2,NCOP - DO 270 J=1,3 - P(I,J)=P(I,J)+V(I,1)*(QNEW(J)-QOLD(J)) - 270 CONTINUE - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 280 CONTINUE - -C...Iterate change of initiator momentum to get energy right. - ITER=0 - 290 ITER=ITER+1 - PEEX=-P(N+1,4)-QNEW(4) - PEMV=-P(N+1,3)/P(N+1,4) - DO 300 I=N+2,NCOP - PEEX=PEEX+P(I,4) - PEMV=PEMV+V(I,1)*P(I,3)/P(I,4) - 300 CONTINUE - IF(ABS(PEMV).LT.1D-10) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - PZCH=-PEEX/PEMV - P(N+1,3)=P(N+1,3)+PZCH - P(N+1,4)=SQRT(P(N+1,5)**2+P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) - DO 310 I=N+2,NCOP - P(I,3)=P(I,3)+V(I,1)*PZCH - P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) - 310 CONTINUE - IF(ITER.LT.10.AND.ABS(PEEX).GT.1D-6*P(N+1,4)) GOTO 290 - -C...Modify momenta in event record. - HBE=2D0*(P(N+1,4)+P(LQBG,4))*(P(N+1,3)-P(LQBG,3))/ - & ((P(N+1,4)+P(LQBG,4))**2+(P(N+1,3)-P(LQBG,3))**2) - IF(ABS(HBE).GE.1D0) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - I=MINT(83)+5-LESD - CALL PYROBO(I,I,0D0,0D0,0D0,0D0,HBE) - DO 330 I=N+1,NCOP - ICOP=K(I,3) - DO 320 J=1,4 - P(ICOP,J)=P(I,J) - 320 CONTINUE - 330 CONTINUE - ENDIF - -C...Check minimum invariant mass of remnant system(s). - PSYS(0,4)=P(I1,4)+P(I2,4)+0.5D0*VINT(1)*(VINT(151)+VINT(152)) - PSYS(0,3)=P(I1,3)+P(I2,3)+0.5D0*VINT(1)*(VINT(151)-VINT(152)) - PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) - PMIN(0)=SQRT(PMS(0)) - DO 340 JT=1,2 - PSYS(JT,4)=0.5D0*VINT(1)*VINT(142+JT) - PSYS(JT,3)=PSYS(JT,4)*(-1)**(JT-1) - PMIN(JT)=0D0 - IF(MINT(44+JT).EQ.1) GOTO 340 - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) - IF(MINT(51).NE.0) THEN - MINT(57)=MINT(57)+1 - RETURN - ENDIF - IF(KFLCH(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLCH(JT)) - IF(KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+PYMASS(KFLSP(JT)) - IF(KFLCH(JT)*KFLSP(JT).NE.0) PMIN(JT)=PMIN(JT)+0.5D0*PARP(111) - PMIN(JT)=SQRT(PMIN(JT)**2+P(MINT(83)+JT+2,1)**2+ - & P(MINT(83)+JT+2,2)**2) - 340 CONTINUE - IF(PMIN(0)+PMIN(1)+PMIN(2).GT.VINT(1).OR.(MINT(45).GE.2.AND. - &PMIN(1).GT.PSYS(1,4)).OR.(MINT(46).GE.2.AND.PMIN(2).GT. - &PSYS(2,4))) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - -C...Loop over two remnants; skip if none there. - I=NS - DO 410 JT=1,2 - ISN(JT)=0 - IF(MINT(44+JT).EQ.1) GOTO 410 - IF(JT.EQ.1) IPU=IPU1 - IF(JT.EQ.2) IPU=IPU2 - -C...Store first remnant parton. - I=I+1 - IS(JT)=I - ISN(JT)=1 - DO 350 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 350 CONTINUE - K(I,1)=1 - K(I,2)=KFLSP(JT) - K(I,3)=MINT(83)+JT - P(I,5)=PYMASS(K(I,2)) - -C...First parton colour connections and kinematics. - KCOL=KCHG(PYCOMP(KFLSP(JT)),2) - IF(KCOL.EQ.2) THEN - K(I,1)=3 - K(I,4)=MSTU(5)*IPU+IPU - K(I,5)=MSTU(5)*IPU+IPU - K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I - K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I - ELSEIF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLSP(JT)))/2 - K(I,KFLS+3)=IPU - K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I - ENDIF - IF(KFLCH(JT).EQ.0) THEN - P(I,1)=-P(MINT(83)+JT+2,1) - P(I,2)=-P(MINT(83)+JT+2,2) - PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) - P(I,3)=PSYS(JT,3) - P(I,4)=PSYS(JT,4) - -C...When extra remnant parton or hadron: store extra remnant. - ELSE - I=I+1 - ISN(JT)=2 - DO 360 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 360 CONTINUE - K(I,1)=1 - K(I,2)=KFLCH(JT) - K(I,3)=MINT(83)+JT - P(I,5)=PYMASS(K(I,2)) - -C...Find parton colour connections of extra remnant. - KCOL=KCHG(PYCOMP(KFLCH(JT)),2) - IF(KCOL.EQ.2) THEN - K(I,1)=3 - K(I,4)=MSTU(5)*IPU+IPU - K(I,5)=MSTU(5)*IPU+IPU - K(IPU,4)=MOD(K(IPU,4),MSTU(5))+MSTU(5)*I - K(IPU,5)=MOD(K(IPU,5),MSTU(5))+MSTU(5)*I - ELSEIF(KCOL.NE.0) THEN - K(I,1)=3 - KFLS=(3-KCOL*ISIGN(1,KFLCH(JT)))/2 - K(I,KFLS+3)=IPU - K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I - ENDIF - -C...Relative transverse momentum when two remnants. - LOOP=0 - 370 LOOP=LOOP+1 - CALL PYPTDI(1,P(I-1,1),P(I-1,2)) - IF(IABS(MINT(10+JT)).LT.20) THEN - P(I-1,1)=0D0 - P(I-1,2)=0D0 - ELSE - P(I-1,1)=P(I-1,1)-0.5D0*P(MINT(83)+JT+2,1) - P(I-1,2)=P(I-1,2)-0.5D0*P(MINT(83)+JT+2,2) - ENDIF - PMS(JT+2)=P(I-1,5)**2+P(I-1,1)**2+P(I-1,2)**2 - P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) - P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) - PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 - -C...Meson or baryon; photon as meson. For splitup below. - IMB=1 - IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 - -C***Relative distribution for electron into two electrons. Temporary! - IF(IABS(MINT(10+JT)).LT.20.AND.MINT(14+JT).EQ.-MINT(10+JT)) - & THEN - CHI(JT)=PYR(0) - -C...Relative distribution of electron energy into electron plus parton. - ELSEIF(IABS(MINT(10+JT)).LT.20) THEN - XHRD=VINT(140+JT) - XE=VINT(154+JT) - CHI(JT)=(XE-XHRD)/(1D0-XHRD) - -C...Relative distribution of energy for particle into two jets. - ELSEIF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN - CHIK=PARP(92+2*IMB) - IF(MSTP(92).LE.1) THEN - IF(IMB.EQ.1) CHI(JT)=PYR(0) - IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) - ELSEIF(MSTP(92).EQ.2) THEN - CHI(JT)=1D0-PYR(0)**(1D0/(1D0+CHIK)) - ELSEIF(MSTP(92).EQ.3) THEN - CUT=2D0*0.3D0/VINT(1) - 380 CHI(JT)=PYR(0)**2 - IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25D0* - & (1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 380 - ELSEIF(MSTP(92).EQ.4) THEN - CUT=2D0*0.3D0/VINT(1) - CUTR=(1D0+SQRT(1D0+CUT**2))/CUT - 390 CHIR=CUT*CUTR**PYR(0) - CHI(JT)=(CHIR**2-CUT**2)/(2D0*CHIR) - IF((1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 390 - ELSE - CUT=2D0*0.3D0/VINT(1) - CUTA=CUT**(1D0-PARP(98)) - CUTB=(1D0+CUT)**(1D0-PARP(98)) - 400 CHI(JT)=(CUTA+PYR(0)*(CUTB-CUTA))**(1D0/(1D0-PARP(98))) - IF(((CHI(JT)+CUT)**2/(2D0*(CHI(JT)**2+CUT**2)))** - & (0.5D0*PARP(98))*(1D0-CHI(JT))**CHIK.LT.PYR(0)) GOTO 400 - ENDIF - -C...Relative distribution of energy for particle into jet plus particle. - ELSE - IF(MSTP(94).LE.1) THEN - IF(IMB.EQ.1) CHI(JT)=PYR(0) - IF(IMB.EQ.2) CHI(JT)=1D0-SQRT(PYR(0)) - IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) - ELSEIF(MSTP(94).EQ.2) THEN - CHI(JT)=1D0-PYR(0)**(1D0/(1D0+PARP(93+2*IMB))) - IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1D0-CHI(JT) - ELSEIF(MSTP(94).EQ.3) THEN - CALL PYZDIS(1,0,PMS(JT+4),ZZ) - CHI(JT)=ZZ - ELSE - CALL PYZDIS(1000,0,PMS(JT+4),ZZ) - CHI(JT)=ZZ - ENDIF - ENDIF - -C...Construct total transverse mass; reject if too large. - CHI(JT)=MAX(1D-8,MIN(1D0-1D-8,CHI(JT))) - PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1D0-CHI(JT)) - IF(PMS(JT).GT.PSYS(JT,4)**2) THEN - IF(LOOP.LT.100) THEN - GOTO 370 - ELSE - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - ENDIF - PSYS(JT,3)=SQRT(MAX(0D0,PSYS(JT,4)**2-PMS(JT)))*(-1)**(JT-1) - VINT(158+JT)=CHI(JT) - -C...Subdivide longitudinal momentum according to value selected above. - PW1=CHI(JT)*(PSYS(JT,4)+ABS(PSYS(JT,3))) - P(IS(JT)+1,4)=0.5D0*(PW1+PMS(JT+4)/PW1) - P(IS(JT)+1,3)=0.5D0*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) - P(IS(JT),4)=PSYS(JT,4)-P(IS(JT)+1,4) - P(IS(JT),3)=PSYS(JT,3)-P(IS(JT)+1,3) - ENDIF - 410 CONTINUE - N=I - -C...Check if longitudinal boosts needed - if so pick two systems. - PDEV=ABS(PSYS(0,4)+PSYS(1,4)+PSYS(2,4)-VINT(1))+ - &ABS(PSYS(0,3)+PSYS(1,3)+PSYS(2,3)) - IF(PDEV.LE.1D-6*VINT(1)) RETURN - IF(ISN(1).EQ.0) THEN - IR=0 - IL=2 - ELSEIF(ISN(2).EQ.0) THEN - IR=1 - IL=0 - ELSEIF(VINT(143).GT.0.2D0.AND.VINT(144).GT.0.2D0) THEN - IR=1 - IL=2 - ELSEIF(VINT(143).GT.0.2D0) THEN - IR=1 - IL=0 - ELSEIF(VINT(144).GT.0.2D0) THEN - IR=0 - IL=2 - ELSEIF(PMS(1)/PSYS(1,4)**2.GT.PMS(2)/PSYS(2,4)**2) THEN - IR=1 - IL=0 - ELSE - IR=0 - IL=2 - ENDIF - IG=3-IR-IL - -C...E+-pL wanted for system to be modified. - IF((IG.EQ.1.AND.ISN(1).EQ.0).OR.(IG.EQ.2.AND.ISN(2).EQ.0)) THEN - PPB=VINT(1) - PNB=VINT(1) - ELSE - PPB=VINT(1)-(PSYS(IG,4)+PSYS(IG,3)) - PNB=VINT(1)-(PSYS(IG,4)-PSYS(IG,3)) - ENDIF - -C...To keep x and Q2 in leptoproduction: do not count scattered lepton. - IF(IDISXQ.EQ.1.AND.IG.NE.0) THEN - PPB=PPB-(PSYS(0,4)+PSYS(0,3)) - PNB=PNB-(PSYS(0,4)-PSYS(0,3)) - DO 420 J=1,4 - PSYS(0,J)=0D0 - 420 CONTINUE - DO 450 I=MINT(84)+1,NS - IF(K(I,1).GT.10) GOTO 450 - INCL=0 - IORIG=I - 430 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 430 - IF(INCL.EQ.0) GOTO 450 - DO 440 J=1,4 - PSYS(0,J)=PSYS(0,J)+P(I,J) - 440 CONTINUE - 450 CONTINUE - PMS(0)=MAX(0D0,PSYS(0,4)**2-PSYS(0,3)**2) - PPB=PPB+(PSYS(0,4)+PSYS(0,3)) - PNB=PNB+(PSYS(0,4)-PSYS(0,3)) - ENDIF - -C...Construct longitudinal boosts. - DPMTB=PPB*PNB - DPMTR=PMS(IR) - DPMTL=PMS(IL) - DSQLAM=SQRT(MAX(0D0,(DPMTB-DPMTR-DPMTL)**2-4D0*DPMTR*DPMTL)) - IF(DSQLAM.LE.1D-6*DPMTB) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - DSQSGN=SIGN(1D0,PSYS(IR,3)*PSYS(IL,4)-PSYS(IL,3)*PSYS(IR,4)) - DRKR=(DPMTB+DPMTR-DPMTL+DSQLAM*DSQSGN)/ - &(2D0*(PSYS(IR,4)+PSYS(IR,3))*PNB) - DRKL=(DPMTB+DPMTL-DPMTR+DSQLAM*DSQSGN)/ - &(2D0*(PSYS(IL,4)-PSYS(IL,3))*PPB) - DBER=(DRKR**2-1D0)/(DRKR**2+1D0) - DBEL=-(DRKL**2-1D0)/(DRKL**2+1D0) - -C...Perform longitudinal boosts. - IF(IR.EQ.1.AND.ISN(1).EQ.1.AND.DBER.LE.-0.99999999D0) THEN - P(IS(1),3)=0D0 - P(IS(1),4)=SQRT(P(IS(1),5)**2+P(IS(1),1)**2+P(IS(1),2)**2) - ELSEIF(IR.EQ.1) THEN - CALL PYROBO(IS(1),IS(1)+ISN(1)-1,0D0,0D0,0D0,0D0,DBER) - ELSEIF(IDISXQ.EQ.1) THEN - DO 470 I=I1,NS - INCL=0 - IORIG=I - 460 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 460 - IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBER) - 470 CONTINUE - ELSE - CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBER) - ENDIF - IF(IL.EQ.2.AND.ISN(2).EQ.1.AND.DBEL.GE.0.99999999D0) THEN - P(IS(2),3)=0D0 - P(IS(2),4)=SQRT(P(IS(2),5)**2+P(IS(2),1)**2+P(IS(2),2)**2) - ELSEIF(IL.EQ.2) THEN - CALL PYROBO(IS(2),IS(2)+ISN(2)-1,0D0,0D0,0D0,0D0,DBEL) - ELSEIF(IDISXQ.EQ.1) THEN - DO 490 I=I1,NS - INCL=0 - IORIG=I - 480 IF(IORIG.EQ.LQOUT.OR.IORIG.EQ.LPIN+2) INCL=1 - IORIG=K(IORIG,3) - IF(IORIG.GT.LPIN) GOTO 480 - IF(INCL.EQ.1) CALL PYROBO(I,I,0D0,0D0,0D0,0D0,DBEL) - 490 CONTINUE - ELSE - CALL PYROBO(I1,NS,0D0,0D0,0D0,0D0,DBEL) - ENDIF - -C...Final check that energy-momentum conservation worked. - PESUM=0D0 - PZSUM=0D0 - DO 500 I=MINT(84)+1,N - IF(K(I,1).GT.10) GOTO 500 - PESUM=PESUM+P(I,4) - PZSUM=PZSUM+P(I,3) - 500 CONTINUE - PDEV=ABS(PESUM-VINT(1))+ABS(PZSUM) - IF(PDEV.GT.1D-4*VINT(1)) THEN - MINT(51)=1 - MINT(57)=MINT(57)+1 - RETURN - ENDIF - -C...Calculate rotation and boost from overall CM frame to -C...hadronic CM frame in leptoproduction. - MINT(91)=0 - IF(MINT(82).EQ.1.AND.(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN - MINT(91)=1 - LESD=1 - IF(MINT(42).EQ.1) LESD=2 - LPIN=MINT(83)+3-LESD - -C...Sum upp momenta of everything not lepton or photon to define boost. - DO 510 J=1,4 - PSUM(J)=0D0 - 510 CONTINUE - DO 530 I=1,N - IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 530 - IF(IABS(K(I,2)).GE.11.AND.IABS(K(I,2)).LE.20) GOTO 530 - IF(K(I,2).EQ.22) GOTO 530 - DO 520 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 520 CONTINUE - 530 CONTINUE - VINT(223)=-PSUM(1)/PSUM(4) - VINT(224)=-PSUM(2)/PSUM(4) - VINT(225)=-PSUM(3)/PSUM(4) - -C...Boost incoming hadron to hadronic CM frame to determine rotations. - K(N+1,1)=1 - DO 540 J=1,5 - P(N+1,J)=P(LPIN,J) - V(N+1,J)=V(LPIN,J) - 540 CONTINUE - CALL PYROBO(N+1,N+1,0D0,0D0,VINT(223),VINT(224),VINT(225)) - VINT(222)=-PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+1,0D0,VINT(222),0D0,0D0,0D0) - IF(LESD.EQ.2) THEN - VINT(221)=-PYANGL(P(N+1,3),P(N+1,1)) - ELSE - VINT(221)=PYANGL(-P(N+1,3),P(N+1,1)) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRESD -C...Allows resonances to decay (including parton showers for hadronic -C...channels). - - SUBROUTINE PYRESD(IRES) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT4/ -C...Local arrays and complex and character variables. - DIMENSION IREF(50,8),KDCY(3),KFL1(3),KFL2(3),KFL3(3),KEQL(3), - &KCQM(3),KCQ1(3),KCQ2(3),KCQ3(3),NSD(3),PMMN(3),ILIN(6), - &HGZ(3,3),COUP(6,4),CORL(2,2,2),PK(6,4),PKK(6,6),CTHE(3), - &PHI(3),WDTP(0:400),WDTE(0:400,0:5),DPMO(5),XM(5),VDCY(4), - &ITJUNC(3),CTM2(3) - COMPLEX FGK,HA(6,6),HC(6,6) - REAL TIR,UIR - CHARACTER CODE*9,MASS*9 - -C...The F, Xi and Xj functions of Gunion and Kunszt -C...(Phys. Rev. D33, 665, plus errata from the authors). - FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)* - &HC(I1,I4)+HA(I3,I5)*HC(I3,I4)) - DIGK(DT,DU)=-4D0*D34*D56+DT*(3D0*DT+4D0*DU)+DT**2*(DT*DU/ - &(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+2D0*(D34/D56+D56/D34)) - DJGK(DT,DU)=8D0*(D34+D56)**2-8D0*(D34+D56)*(DT+DU)-6D0*DT*DU- - &2D0*DT*DU*(DT*DU/(D34*D56)-2D0*(1D0/D34+1D0/D56)*(DT+DU)+ - &2D0*(D34/D56+D56/D34)) - -C...Some general constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - SQMZ=PMAS(23,1)**2 - - GMMZ=PMAS(23,1)*PMAS(23,2) - SQMW=PMAS(24,1)**2 - GMMW=PMAS(24,1)*PMAS(24,2) - SH=VINT(44) - -C...Boost and rotate to rest frame of incoming partons, -C...to get proper amount of smearing of decay angles. - IBST=0 - IF(IRES.EQ.0) THEN - IBST=1 - ETOTIN=P(MINT(84)+1,4)+P(MINT(84)+2,4) - BEXIN=(P(MINT(84)+1,1)+P(MINT(84)+2,1))/ETOTIN - BEYIN=(P(MINT(84)+1,2)+P(MINT(84)+2,2))/ETOTIN - BEZIN=(P(MINT(84)+1,3)+P(MINT(84)+2,3))/ETOTIN - CALL PYROBO(MINT(83)+7,N,0D0,0D0,-BEXIN,-BEYIN,-BEZIN) - PHIIN=PYANGL(P(MINT(84)+1,1),P(MINT(84)+1,2)) - CALL PYROBO(MINT(83)+7,N,0D0,-PHIIN,0D0,0D0,0D0) - THEIN=PYANGL(P(MINT(84)+1,3),P(MINT(84)+1,1)) - CALL PYROBO(MINT(83)+7,N,-THEIN,0D0,0D0,0D0,0D0) - ENDIF - -C...Reset original resonance configuration. - DO 100 JT=1,8 - IREF(1,JT)=0 - 100 CONTINUE - -C...Define initial one, two or three objects for subprocess. - IHDEC=0 - IF(IRES.EQ.0) THEN - ISUB=MINT(1) - IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN - IREF(1,1)=MINT(84)+2+ISET(ISUB) - IREF(1,4)=MINT(83)+6+ISET(ISUB) - JTMAX=1 - ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN - IREF(1,1)=MINT(84)+1+ISET(ISUB) - IREF(1,2)=MINT(84)+2+ISET(ISUB) - IREF(1,4)=MINT(83)+5+ISET(ISUB) - IREF(1,5)=MINT(83)+6+ISET(ISUB) - JTMAX=2 - ELSEIF(ISET(ISUB).EQ.5) THEN - IREF(1,1)=MINT(84)+3 - IREF(1,2)=MINT(84)+4 - IREF(1,3)=MINT(84)+5 - IREF(1,4)=MINT(83)+7 - IREF(1,5)=MINT(83)+8 - IREF(1,6)=MINT(83)+9 - JTMAX=3 - ENDIF - -C...Define original resonance for odd cases. - ELSE - ISUB=0 - IF(K(IRES,2).EQ.25.OR.K(IRES,2).EQ.35.OR.K(IRES,2).EQ.36) - & IHDEC=1 - IF(IHDEC.EQ.1) ISUB=3 - IREF(1,1)=IRES - IREF(1,4)=K(IRES,3) - IRESTM=IRES - IF(IREF(1,4).GT.MINT(84)) THEN - 103 ITMPMO=IREF(1,4) - IF(K(ITMPMO,2).EQ.94) THEN - IREF(1,4)=K(ITMPMO,3)+(IRESTM-ITMPMO-1) - IF(K(IREF(1,4),3).LE.MINT(84)) IREF(1,4)=K(IREF(1,4),3) - ELSEIF(K(ITMPMO,2).EQ.K(IRES,2)) THEN - IRESTM=ITMPMO - IREF(1,4)=K(ITMPMO,3) - GOTO 103 - ENDIF - ENDIF - IF(IREF(1,4).GT.MINT(84)) THEN - EMATCH=1D10 - IREF14=IREF(1,4) - DO 106 II=MINT(83)+7,MINT(83)+MINT(4) - IF(K(II,2).EQ.K(IRES,2).AND.ABS(P(II,4)-P(IREF14,4)).LT. - & EMATCH) THEN - IREF(1,4)=II - EMATCH=ABS(P(II,4)-P(IREF14,4)) - ENDIF - 106 CONTINUE - ENDIF - JTMAX=1 - ENDIF - -C...Check if initial resonance has been moved (in resonance + jet). - DO 120 JT=1,3 - IF(IREF(1,JT).GT.0) THEN - IF(K(IREF(1,JT),1).GT.10) THEN - KFA=IABS(K(IREF(1,JT),2)) - IF(KFA.GE.6.AND.KCHG(PYCOMP(KFA),2).NE.0) THEN - KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) - KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) - DO 110 I=IREF(1,JT)+1,N - IF(K(I,2).EQ.K(IREF(1,JT),2).AND.(I.EQ.KDA1.OR. - & I.EQ.KDA2)) THEN - IREF(1,JT)=I - KDA1=MOD(K(IREF(1,JT),4),MSTU(5)) - KDA2=MOD(K(IREF(1,JT),5),MSTU(5)) - ENDIF - 110 CONTINUE - ELSE - KDA=MOD(K(IREF(1,JT),4),MSTU(5)) - IF(MWID(PYCOMP(KFA)).NE.0.AND.KDA.GT.1) IREF(1,JT)=KDA - ENDIF - ENDIF - ENDIF - 120 CONTINUE - -C.....Set decay vertex for initial resonances - DO 140 JT=1,JTMAX - DO 130 I=1,4 - V(IREF(1,JT),I)=0D0 - 130 CONTINUE - 140 CONTINUE - -C...Loop over decay history. - NP=1 - IP=0 - 150 IP=IP+1 - NINH=0 - JTMAX=2 - IF(IREF(IP,2).EQ.0) JTMAX=1 - IF(IREF(IP,3).NE.0) JTMAX=3 - IT4=0 - NSAV=N - -C...Check for Higgs which appears as decay product of user-process. - IF(ISUB.EQ.0) THEN - IHDEC=0 - IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) - & .EQ.36) IHDEC=1 - IF(IHDEC.EQ.1) ISUB=3 - ENDIF - -C...Start treatment of one, two or three resonances in parallel. - 160 N=NSAV - DO 320 JT=1,JTMAX - ID=IREF(IP,JT) - KDCY(JT)=0 - KFL1(JT)=0 - KFL2(JT)=0 - KFL3(JT)=0 - KEQL(JT)=0 - NSD(JT)=ID - ITJUNC(JT)=0 - -C...Check whether particle can/is allowed to decay. - IF(ID.EQ.0) GOTO 310 - KFA=IABS(K(ID,2)) - KCA=PYCOMP(KFA) - IF(MWID(KCA).EQ.0) GOTO 310 - IF(K(ID,1).GT.10.OR.MDCY(KCA,1).EQ.0) GOTO 310 - IF(KFA.EQ.6.OR.KFA.EQ.7.OR.KFA.EQ.8.OR.KFA.EQ.17.OR. - & KFA.EQ.18) IT4=IT4+1 - K(ID,4)=MSTU(5)*(K(ID,4)/MSTU(5)) - K(ID,5)=MSTU(5)*(K(ID,5)/MSTU(5)) - -C...Choose lifetime and determine decay vertex. - IF(K(ID,1).EQ.5) THEN - V(ID,5)=0D0 - ELSEIF(K(ID,1).NE.4) THEN - V(ID,5)=-PMAS(KCA,4)*LOG(PYR(0)) - ENDIF - DO 170 J=1,4 - VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) - 170 CONTINUE - -C...Determine whether decay allowed or not. - MOUT=0 - IF(MSTJ(22).EQ.2) THEN - IF(PMAS(KCA,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(ID,1).NE.5) THEN - K(ID,1)=4 - GOTO 310 - ENDIF - -C...Info for selection of decay channel: sign, pairings. - IF(KCHG(KCA,3).EQ.0) THEN - IPM=2 - ELSE - IPM=(5-ISIGN(1,K(ID,2)))/2 - ENDIF - KFB=0 - IF(JTMAX.EQ.2) THEN - KFB=IABS(K(IREF(IP,3-JT),2)) - ELSEIF(JTMAX.EQ.3) THEN - JT2=JT+1-3*(JT/3) - KFB=IABS(K(IREF(IP,JT2),2)) - IF(KFB.NE.KFA) THEN - JT2=JT+2-3*((JT+1)/3) - KFB=IABS(K(IREF(IP,JT2),2)) - ENDIF - ENDIF - -C...Select decay channel. - IF(ISUB.EQ.1.OR.ISUB.EQ.15.OR.ISUB.EQ.19.OR.ISUB.EQ.22.OR. - & ISUB.EQ.30.OR.ISUB.EQ.35.OR.ISUB.EQ.141) MINT(61)=1 - CALL PYWIDT(KFA,P(ID,5)**2,WDTP,WDTE) - WDTE0S=WDTE(0,1)+WDTE(0,IPM)+WDTE(0,4) - IF(KFB.EQ.KFA) WDTE0S=WDTE0S+WDTE(0,5) - IF(WDTE0S.LE.0D0) GOTO 310 - RKFL=WDTE0S*PYR(0) - IDL=0 - 180 IDL=IDL+1 - IDC=IDL+MDCY(KCA,2)-1 - RKFL=RKFL-(WDTE(IDL,1)+WDTE(IDL,IPM)+WDTE(IDL,4)) - IF(KFB.EQ.KFA) RKFL=RKFL-WDTE(IDL,5) - IF(IDL.LT.MDCY(KCA,3).AND.RKFL.GT.0D0) GOTO 180 - -C...Read out flavours and colour charges of decay channel chosen. - KCQM(JT)=KCHG(KCA,2)*ISIGN(1,K(ID,2)) - IF(KCQM(JT).EQ.-2) KCQM(JT)=2 - KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2)) - KFC1A=PYCOMP(IABS(KFL1(JT))) - IF(KCHG(KFC1A,3).EQ.0) KFL1(JT)=IABS(KFL1(JT)) - KCQ1(JT)=KCHG(KFC1A,2)*ISIGN(1,KFL1(JT)) - IF(KCQ1(JT).EQ.-2) KCQ1(JT)=2 - KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2)) - KFC2A=PYCOMP(IABS(KFL2(JT))) - IF(KCHG(KFC2A,3).EQ.0) KFL2(JT)=IABS(KFL2(JT)) - KCQ2(JT)=KCHG(KFC2A,2)*ISIGN(1,KFL2(JT)) - IF(KCQ2(JT).EQ.-2) KCQ2(JT)=2 - KFL3(JT)=KFDP(IDC,3)*ISIGN(1,K(ID,2)) - KCQ3(JT)=0 - IF(KFL3(JT).NE.0) THEN - KFC3A=PYCOMP(IABS(KFL3(JT))) - IF(KCHG(KFC3A,3).EQ.0) KFL3(JT)=IABS(KFL3(JT)) - KCQ3(JT)=KCHG(KFC3A,2)*ISIGN(1,KFL3(JT)) - IF(KCQ3(JT).EQ.-2) KCQ3(JT)=2 - ENDIF - -C...Set/save further info on channel. - KDCY(JT)=1 - IF(KFB.EQ.KFA) KEQL(JT)=MDME(IDC,1) - NSD(JT)=N - HGZ(JT,1)=VINT(111) - HGZ(JT,2)=VINT(112) - HGZ(JT,3)=VINT(114) - JTZ=JT - -C...Select masses; to begin with assume resonances narrow. - DO 200 I=1,3 - P(N+I,5)=0D0 - PMMN(I)=0D0 - IF(I.EQ.1) THEN - KFLW=IABS(KFL1(JT)) - KCW=KFC1A - ELSEIF(I.EQ.2) THEN - KFLW=IABS(KFL2(JT)) - KCW=KFC2A - ELSEIF(I.EQ.3) THEN - IF(KFL3(JT).EQ.0) GOTO 200 - KFLW=IABS(KFL3(JT)) - KCW=KFC3A - ENDIF - P(N+I,5)=PMAS(KCW,1) -CMRENNA++ -C...This prevents SUSY/t particles from becoming too light. - IF(KFLW/KSUSY1.EQ.1.OR.KFLW/KSUSY1.EQ.2) THEN - PMMN(I)=PMAS(KCW,1) - DO 190 IDC=MDCY(KCW,2),MDCY(KCW,2)+MDCY(KCW,3)-1 - IF(MDME(IDC,1).GT.0.AND.BRAT(IDC).GT.1E-4) THEN - PMSUM=PMAS(PYCOMP(KFDP(IDC,1)),1)+ - & PMAS(PYCOMP(KFDP(IDC,2)),1) - IF(KFDP(IDC,3).NE.0) PMSUM=PMSUM+ - & PMAS(PYCOMP(KFDP(IDC,3)),1) - PMMN(I)=MIN(PMMN(I),PMSUM) - ENDIF - 190 CONTINUE -CMRENNA-- - ELSEIF(KFLW.EQ.6) THEN - PMMN(I)=PMAS(24,1)+PMAS(5,1) - ENDIF - 200 CONTINUE - -C...Check which two out of three are widest. - IWID1=1 - IWID2=2 - PWID1=PMAS(KFC1A,2) - PWID2=PMAS(KFC2A,2) - KFLW1=IABS(KFL1(JT)) - KFLW2=IABS(KFL2(JT)) - IF(KFL3(JT).NE.0) THEN - PWID3=PMAS(KFC3A,2) - IF(PWID3.GT.PWID1.AND.PWID2.GE.PWID1) THEN - IWID1=3 - PWID1=PWID3 - KFLW1=IABS(KFL3(JT)) - ELSEIF(PWID3.GT.PWID2) THEN - IWID2=3 - PWID2=PWID3 - KFLW2=IABS(KFL3(JT)) - ENDIF - ENDIF - -C...If all narrow then only check that masses consistent. - IF(MSTP(42).LE.0.OR.(PWID1.LT.PARP(41).AND. - & PWID2.LT.PARP(41))) THEN -CMRENNA++ -C....Handle near degeneracy cases. - IF(KFA/KSUSY1.EQ.1.OR.KFA/KSUSY1.EQ.2) THEN - IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN - P(N+1,5)=P(ID,5)-P(N+2,5)-0.5D0 - IF(P(N+1,5).LT.0D0) P(N+1,5)=0D0 - ENDIF - ENDIF -CMRENNA-- - IF(P(N+1,5)+P(N+2,5)+P(N+3,5).GT.P(ID,5)) THEN - CALL PYERRM(13,'(PYRESD:) daughter masses too large') - MINT(51)=1 - GOTO 700 - ELSEIF(P(N+1,5)+P(N+2,5)+P(N+3,5)+PARJ(64).GT.P(ID,5)) THEN - CALL PYERRM(3,'(PYRESD:) daughter masses too large') - MINT(51)=1 - GOTO 700 - ENDIF - -C...For three wide resonances select narrower of three -C...according to BW decoupled from rest. - ELSE - PMTOT=P(ID,5) - IF(KFL3(JT).NE.0) THEN - IWID3=6-IWID1-IWID2 - KFLW3=IABS(KFL1(JT))+IABS(KFL2(JT))+IABS(KFL3(JT))- - & KFLW1-KFLW2 - LOOP=0 - 210 LOOP=LOOP+1 - P(N+IWID3,5)=PYMASS(KFLW3) - IF(LOOP.LE.10.AND. P(N+IWID3,5).LE.PMMN(IWID3)) GOTO 210 - PMTOT=PMTOT-P(N+IWID3,5) - ENDIF -C...Select other two correlated within remaining phase space. - IF(IP.EQ.1) THEN - CKIN45=CKIN(45) - CKIN47=CKIN(47) - CKIN(45)=MAX(PMMN(IWID1),CKIN(45)) - CKIN(47)=MAX(PMMN(IWID2),CKIN(47)) - CALL PYOFSH(2,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), - & P(N+IWID2,5)) - CKIN(45)=CKIN45 - CKIN(47)=CKIN47 - ELSE - CKIN(49)=PMMN(IWID1) - CKIN(50)=PMMN(IWID2) - CALL PYOFSH(5,KFA,KFLW1,KFLW2,PMTOT,P(N+IWID1,5), - & P(N+IWID2,5)) - CKIN(49)=0D0 - CKIN(50)=0D0 - ENDIF - IF(MINT(51).EQ.1) GOTO 700 - ENDIF - -C...Begin fill decay products, with colour flow for coloured objects. - MSTU10=MSTU(10) - MSTU(10)=1 - MSTU(19)=1 - -CMRENNA++ -C...1) Three-body decays of SUSY particles (plus special case top). - IF(KFL3(JT).NE.0) THEN - DO 230 I=N+1,N+3 - DO 220 J=1,5 - K(I,J)=0 - V(I,J)=0D0 - 220 CONTINUE - 230 CONTINUE - K(N+1,1)=1 - K(N+1,2)=KFL1(JT) - K(N+2,1)=1 - K(N+2,2)=KFL2(JT) - K(N+3,1)=1 - K(N+3,2)=KFL3(JT) - IDIN=ID - CALL PYTBDY(IDIN) - -C...Set colour flow for t -> W + b + Z. - IF(KFA.EQ.6) THEN - K(N+2,1)=3 - ISID=4 - IF(KCQM(JT).EQ.-1) ISID=5 - IDAU=N+2 - K(ID,ISID)=K(ID,ISID)+IDAU - K(IDAU,ISID)=MSTU(5)*ID - -C...Set colour flow in three-body decays - programmed as special cases. - ELSEIF(KFC2A.LE.6) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+2,ISID)=MSTU(5)*(N+3) - K(N+3,9-ISID)=MSTU(5)*(N+2) - ENDIF - IF(KFL1(JT).EQ.KSUSY1+21) THEN - K(N+1,1)=3 - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+1,ISID)=MSTU(5)*(N+2) - K(N+1,9-ISID)=MSTU(5)*(N+3) - K(N+2,ISID)=MSTU(5)*(N+1) - K(N+3,9-ISID)=MSTU(5)*(N+1) - ENDIF - IF(KFA.EQ.KSUSY1+21) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(ID,ISID)=K(ID,ISID)+(N+2) - K(ID,9-ISID)=K(ID,9-ISID)+(N+3) - K(N+2,ISID)=MSTU(5)*ID - K(N+3,9-ISID)=MSTU(5)*ID - ENDIF -CMRENNA-- - - IF(KFA.GE.KSUSY1+22.AND.KFA.LE.KSUSY1+37.AND. - & IABS(KCQ2(JT)).EQ.1) THEN - K(N+2,1)=3 - K(N+3,1)=3 - ISID=4 - IF(KFL2(JT).LT.0) ISID=5 - K(N+2,ISID)=MSTU(5)*(N+3) - K(N+3,9-ISID)=MSTU(5)*(N+2) - ENDIF - -C...Set colour flow in three-body decays with baryon number violation. -C...Neutralino and chargino decays first. - KCQSUM=KCQ1(JT)+KCQ2(JT)+KCQ3(JT) - IF(KCQM(JT).EQ.0.AND.IABS(KCQSUM).EQ.3) THEN - ITJUNC(JT)=(1+(1-KCQ1(JT))/2) - K(N+4,4)=ITJUNC(JT)*MSTU(5) -C...Insert junction to keep track of colours. - IF(KCQ1(JT).NE.0) K(N+1,1)=3 - IF(KCQ2(JT).NE.0) K(N+2,1)=3 - IF(KCQ3(JT).NE.0) K(N+3,1)=3 -C...Set special junction codes: - K(N+4,1)=42 - K(N+4,2)=88 - -C...Order decay products by invariant mass. (will be used in PYSTRF). - PM12=P(N+1,4)*P(N+2,4)-P(N+1,1)*P(N+2,1)-P(N+1,2)*P(N+2,2)- - & P(N+1,3)*P(N+2,3) - PM13=P(N+1,4)*P(N+3,4)-P(N+1,1)*P(N+3,1)-P(N+1,2)*P(N+3,2)- - & P(N+1,3)*P(N+3,3) - PM23=P(N+2,4)*P(N+3,4)-P(N+2,1)*P(N+3,1)-P(N+2,2)*P(N+3,2)- - & P(N+2,3)*P(N+3,3) - IF(PM12.LT.PM13.AND.PM12.LT.PM23) THEN - K(N+4,4)=N+3+K(N+4,4) - K(N+4,5)=N+1+MSTU(5)*(N+2) - ELSEIF(PM13.LT.PM23) THEN - K(N+4,4)=N+2+K(N+4,4) - K(N+4,5)=N+1+MSTU(5)*(N+3) - ELSE - K(N+4,4)=N+1+K(N+4,4) - K(N+4,5)=N+2+MSTU(5)*(N+3) - ENDIF - DO 240 J=1,5 - P(N+4,J)=0D0 - V(N+4,J)=0D0 - 240 CONTINUE -C...Connect daughters to junction. - DO 250 II=N+1,N+3 - K(II,4)=0 - K(II,5)=0 - K(II,ITJUNC(JT)+3)=MSTU(5)*(N+4) - 250 CONTINUE -C...Particle counter should be stepped up one extra for junction. - N=N+1 - -C...Gluino decays. - ELSEIF (KCQM(JT).EQ.2.AND.IABS(KCQSUM).EQ.3) THEN - ITJUNC(JT)=(5+(1-KCQ1(JT))/2) - K(N+4,4)=ITJUNC(JT)*MSTU(5) -C...Insert junction to keep track of colours. - IF(KCQ1(JT).NE.0) K(N+1,1)=3 - IF(KCQ2(JT).NE.0) K(N+2,1)=3 - IF(KCQ3(JT).NE.0) K(N+3,1)=3 - K(N+4,1)=42 - K(N+4,2)=88 - DO 260 J=1,5 - P(N+4,J)=0D0 - V(N+4,J)=0D0 - 260 CONTINUE - CTMSUM=0D0 - DO 270 II=N+1,N+3 - K(II,4)=0 - K(II,5)=0 -C...Start by connecting all daughters to junction. - K(II,ITJUNC(JT)-1)=MSTU(5)*(N+4) -C...Only consider colour topologies with off shell resonances. - RMQ1=PMAS(PYCOMP(K(II,2)),1) - RMRES=PMAS(PYCOMP(KSUSY1+IABS(K(II,2))),1) - RMGLU=PMAS(PYCOMP(KSUSY1+21),1) - IF (RMGLU-RMQ1.LT.RMRES) THEN -C...Calculate propagators for each colour topology. - RM2Q23=RMGLU**2+RMQ1**2-2D0*(P(II,4)*P(ID,4)+P(II,1) - & *P(ID,1)+P(II,2)*P(ID,2)+P(II,3)*P(ID,3)) - CTM2(II-N)=1D0/(RM2Q23-RMRES**2)**2 - ELSE - CTM2(II-N)=0D0 - ENDIF - CTMSUM=CTMSUM+CTM2(II-N) - 270 CONTINUE - CTMSUM=PYR(0)*CTMSUM -C...Select colour topology J, with most off shell least likely. - J=0 - 280 J=J+1 - CTMSUM=CTMSUM-CTM2(J) - IF (CTMSUM.GT.0D0) GOTO 280 -C...The lucky winner gets its colour (anti-colour) directly from gluino. - K(N+J,ITJUNC(JT)-1)=MSTU(5)*ID - K(ID,ITJUNC(JT)-1)=N+J+(K(ID,ITJUNC(JT)-1)/MSTU(5))*MSTU(5) -C...The other gluino colour is connected to junction - K(ID,10-ITJUNC(JT))=N+4+(K(ID,10-ITJUNC(JT))/MSTU(5))* - & MSTU(5) - K(N+4,4)=K(N+4,4)+ID -C...Lastly, connect junction to remaining daughters. - K(N+4,5)=N+1+MOD(J,3)+MSTU(5)*(N+1+MOD(J+1,3)) -C...Particle counter should be stepped up one extra for junction. - N=N+1 - ENDIF - -C...Update particle counter. - N=N+3 - -C...2) Everything else two-body decay. - ELSE - CALL PY2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) -C...First set colour flow as if mother colour singlet. - IF(KCQ1(JT).NE.0) THEN - K(N-1,1)=3 - IF(KCQ1(JT).NE.-1) K(N-1,4)=MSTU(5)*N - IF(KCQ1(JT).NE.1) K(N-1,5)=MSTU(5)*N - ENDIF - IF(KCQ2(JT).NE.0) THEN - K(N,1)=3 - IF(KCQ2(JT).NE.-1) K(N,4)=MSTU(5)*(N-1) - IF(KCQ2(JT).NE.1) K(N,5)=MSTU(5)*(N-1) - ENDIF -C...Then redirect colour flow if mother (anti)triplet. - IF(KCQM(JT).EQ.0) THEN - ELSEIF(KCQM(JT).NE.2) THEN - ISID=4 - IF(KCQM(JT).EQ.-1) ISID=5 - IDAU=N-1 - IF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.2) IDAU=N - K(ID,ISID)=K(ID,ISID)+IDAU - K(IDAU,ISID)=MSTU(5)*ID -C...Then redirect colour flow if mother octet. - ELSEIF(KCQ1(JT).EQ.0.OR.KCQ2(JT).EQ.0) THEN - IDAU=N-1 - IF(KCQ1(JT).EQ.0) IDAU=N - K(ID,4)=K(ID,4)+IDAU - K(ID,5)=K(ID,5)+IDAU - K(IDAU,4)=MSTU(5)*ID - K(IDAU,5)=MSTU(5)*ID - ELSE - ISID=4 - IF(KCQ1(JT).EQ.-1) ISID=5 - IF(KCQ1(JT).EQ.2) ISID=INT(4.5D0+PYR(0)) - K(ID,ISID)=K(ID,ISID)+(N-1) - K(ID,9-ISID)=K(ID,9-ISID)+N - K(N-1,ISID)=MSTU(5)*ID - K(N,9-ISID)=MSTU(5)*ID - ENDIF - -C...Insert junction - IF(IABS(KCQ1(JT)+KCQ2(JT)-KCQM(JT)).EQ.3) THEN - N=N+1 -C...~q* mother: type 3 junction. ~q mother: type 4. - ITJUNC(JT)=(7+KCQM(JT))/2 -C...Specify junction KF and set colour flow from junction - K(N,1)=42 - K(N,2)=88 - K(N,3)=ID -C...Junction type encoded together with mother: - K(N,4)=ID+ITJUNC(JT)*MSTU(5) - K(N,5)=N-1+MSTU(5)*(N-2) -C...Zero P and V for junction (V filled later) - DO 290 J=1,5 - P(N,J)=0D0 - V(N,J)=0D0 - 290 CONTINUE -C...Set colour flow from mother to junction - K(ID,8-ITJUNC(JT))= N + MSTU(5)*(K(ID,8-ITJUNC(JT))/MSTU(5)) -C...Set colour flow from daughters to junction - DO 300 II=N-2,N-1 - K(II,4) = 0 - K(II,5) = 0 -C...(Anti-)colour mother is junction. - K(II,1+ITJUNC(JT)) = MSTU(5)*(N) - 300 CONTINUE - ENDIF - ENDIF - -C...End loop over resonances for daughter flavour and mass selection. - MSTU(10)=MSTU10 - 310 IF(MWID(KCA).NE.0.AND.(KFL1(JT).EQ.0.OR.KFL3(JT).NE.0)) - & NINH=NINH+1 - IF(IRES.GT.0.AND.MWID(KCA).NE.0.AND.MDCY(KCA,1).NE.0.AND. - & KFL1(JT).EQ.0) THEN - WRITE(CODE,'(I9)') K(ID,2) - WRITE(MASS,'(F9.3)') P(ID,5) - CALL PYERRM(3,'(PYRESD:) Failed to decay particle'// - & CODE//' with mass'//MASS) - MINT(51)=1 - GOTO 700 - ENDIF - 320 CONTINUE - -C...Check for allowed combinations. Skip if no decays. - IF(JTMAX.EQ.1) THEN - IF(KDCY(1).EQ.0) GOTO 690 - ELSEIF(JTMAX.EQ.2) THEN - IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 690 - IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 - ELSEIF(JTMAX.EQ.3) THEN - IF(KDCY(1).EQ.0.AND.KDCY(2).EQ.0.AND.KDCY(3).EQ.0) GOTO 690 - IF(KEQL(1).EQ.4.AND.KEQL(2).EQ.4) GOTO 160 - IF(KEQL(1).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 - IF(KEQL(2).EQ.4.AND.KEQL(3).EQ.4) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(2).EQ.5) GOTO 160 - IF(KEQL(1).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 - IF(KEQL(2).EQ.5.AND.KEQL(3).EQ.5) GOTO 160 - ENDIF - -C...Special case: matrix element option for Z0 decay to quarks. - IF(MSTP(48).EQ.1.AND.ISUB.EQ.1.AND.JTMAX.EQ.1.AND. - &IABS(MINT(11)).EQ.11.AND.IABS(KFL1(1)).LE.5) THEN - -C...Check consistency of MSTJ options set. - IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN - CALL PYERRM(6, - & '(PYRESD:) MSTJ(109) value requires MSTJ(110) = 1') - MSTJ(110)=1 - ENDIF - IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN - CALL PYERRM(6, - & '(PYRESD:) MSTJ(109) value requires MSTJ(111) = 0') - - MSTJ(111)=0 - ENDIF - -C...Select alpha_strong behaviour. - MST111=MSTU(111) - PAR112=PARU(112) - 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) - -C...Find axial fraction in total cross section for scalar gluon model. - PARJ(171)=0D0 - IF((IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.1).OR. - & (MSTJ(101).EQ.5.AND.MSTJ(49).EQ.1)) THEN - POLL=1D0-PARJ(131)*PARJ(132) - SFF=1D0/(16D0*XW*XW1) - SFW=P(ID,5)**4/((P(ID,5)**2-PARJ(123)**2)**2+ - & (PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/P(ID,5))**2) - VE=4D0*XW-1D0 - HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) - HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE* - & (PARJ(132)-PARJ(131))) - KFLC=IABS(KFL1(1)) - PMQ=PYMASS(KFLC) - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0, - & 1D0-(2D0*PMQ/P(ID,5))**2)) - VF=SIGN(1D0,QF)-4D0*QF*XW - RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+ - & VF**2*HF1W)+VQ**3*HF1W - IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) - ENDIF - -C...Choice of jet configuration. - CALL PYXJET(P(ID,5),NJET,CUT) - KFLC=IABS(KFL1(1)) - KFLN=21 - - IF(NJET.EQ.4) THEN - CALL PYX4JT(NJET,CUT,KFLC,P(ID,5),KFLN,X1,X2,X4,X12,X14) - ELSEIF(NJET.EQ.3) THEN - CALL PYX3JT(NJET,CUT,KFLC,P(ID,5),X1,X3) - ELSE - MSTJ(120)=1 - ENDIF - -C...Fill jet configuration; return if incorrect kinematics. - NC=N-2 - IF(NJET.EQ.2.AND.MSTJ(101).NE.5) THEN - CALL PY2ENT(NC+1,KFLC,-KFLC,P(ID,5)) - ELSEIF(NJET.EQ.2) THEN - CALL PY2ENT(-(NC+1),KFLC,-KFLC,P(ID,5)) - ELSEIF(NJET.EQ.3) THEN - CALL PY3ENT(NC+1,KFLC,21,-KFLC,P(ID,5),X1,X3) - ELSEIF(KFLN.EQ.21) THEN - CALL PY4ENT(NC+1,KFLC,KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, - & X12,X14) - ELSE - CALL PY4ENT(NC+1,KFLC,-KFLN,KFLN,-KFLC,P(ID,5),X1,X2,X4, - & X12,X14) - ENDIF - IF(MSTU(24).NE.0) THEN - MINT(51)=1 - MSTU(111)=MST111 - PARU(112)=PAR112 - GOTO 700 - ENDIF - -C...Angular orientation according to matrix element. - IF(MSTJ(106).EQ.1) THEN - CALL PYXDIF(NC,NJET,KFLC,P(ID,5),CHIZ,THEZ,PHIZ) - IF(MINT(11).LT.0) THEZ=PARU(1)-THEZ - CTHE(1)=COS(THEZ) - CALL PYROBO(NC+1,N,0D0,CHIZ,0D0,0D0,0D0) - CALL PYROBO(NC+1,N,THEZ,PHIZ,0D0,0D0,0D0) - ENDIF - -C...Boost partons to Z0 rest frame. - CALL PYROBO(NC+1,N,0D0,0D0,P(ID,1)/P(ID,4), - & P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) - -C...Mark decayed resonance and add documentation lines, - K(ID,1)=K(ID,1)+10 - IDOC=MINT(83)+MINT(4) - DO 340 I=NC+1,N - I1=MINT(83)+MINT(4)+1 - K(I,3)=I1 - IF(MSTP(128).GE.1) K(I,3)=ID - IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN - MINT(4)=MINT(4)+1 - K(I1,1)=21 - K(I1,2)=K(I,2) - K(I1,3)=IREF(IP,4) - DO 330 J=1,5 - P(I1,J)=P(I,J) - 330 CONTINUE - ENDIF - 340 CONTINUE - -C...Generate parton shower. - IF(MSTJ(101).EQ.5) CALL PYSHOW(N-1,N,P(ID,5)) - -C... End special case for Z0: skip ahead. - MSTU(111)=MST111 - PARU(112)=PAR112 - GOTO 680 - ENDIF - -C...Order incoming partons and outgoing resonances. - IF(JTMAX.EQ.2.AND.ISUB.NE.0.AND.MSTP(47).GE.1.AND. - &NINH.EQ.0) THEN - ILIN(1)=MINT(84)+1 - IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2 - IF(K(ILIN(1),2).EQ.21.OR.K(ILIN(1),2).EQ.22) - & ILIN(1)=2*MINT(84)+3-ILIN(1) - ILIN(2)=2*MINT(84)+3-ILIN(1) - IMIN=1 - IF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR.IREF(IP,7) - & .EQ.36) IMIN=3 - IMAX=2 - IORD=1 - IF(K(IREF(IP,1),2).EQ.23) IORD=2 - IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2 - IAKIPD=IABS(K(IREF(IP,IORD),2)) - IF(IAKIPD.EQ.25.OR.IAKIPD.EQ.35.OR.IAKIPD.EQ.36) IORD=3-IORD - IF(KDCY(IORD).EQ.0) IORD=3-IORD - -C...Order decay products of resonances. - DO 350 JT=IORD,3-IORD,3-2*IORD - IF(KDCY(JT).EQ.0) THEN - ILIN(IMAX+1)=NSD(JT) - IMAX=IMAX+1 - ELSEIF(K(NSD(JT)+1,2).GT.0) THEN - ILIN(IMAX+1)=N+2*JT-1 - ILIN(IMAX+2)=N+2*JT - IMAX=IMAX+2 - K(N+2*JT-1,2)=K(NSD(JT)+1,2) - K(N+2*JT,2)=K(NSD(JT)+2,2) - ELSE - ILIN(IMAX+1)=N+2*JT - - ILIN(IMAX+2)=N+2*JT-1 - IMAX=IMAX+2 - K(N+2*JT-1,2)=K(NSD(JT)+1,2) - K(N+2*JT,2)=K(NSD(JT)+2,2) - ENDIF - 350 CONTINUE - -C...Find charge, isospin, left- and righthanded couplings. - DO 370 I=IMIN,IMAX - DO 360 J=1,4 - COUP(I,J)=0D0 - 360 CONTINUE - KFA=IABS(K(ILIN(I),2)) - IF(KFA.EQ.0.OR.KFA.GT.20) GOTO 370 - COUP(I,1)=KCHG(KFA,1)/3D0 - COUP(I,2)=(-1)**MOD(KFA,2) - COUP(I,4)=-2D0*COUP(I,1)*XWV - COUP(I,3)=COUP(I,2)+COUP(I,4) - 370 CONTINUE - -C...Full propagator dependence and flavour correlations for 2 gamma*/Z. - IF(ISUB.EQ.22) THEN - DO 400 I=3,5,2 - I1=IORD - IF(I.EQ.5) I1=3-IORD - DO 390 J1=1,2 - DO 380 J2=1,2 - CORL(I/2,J1,J2)=COUP(1,1)**2*HGZ(I1,1)*COUP(I,1)**2/ - & 16D0+COUP(1,1)*COUP(1,J1+2)*HGZ(I1,2)*COUP(I,1)* - & COUP(I,J2+2)/4D0+COUP(1,J1+2)**2*HGZ(I1,3)* - & COUP(I,J2+2)**2 - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - COWT12=(CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ - & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)) - COMX12=(CORL(1,1,1)+CORL(1,1,2)+CORL(1,2,1)+CORL(1,2,2))* - & (CORL(2,1,1)+CORL(2,1,2)+CORL(2,2,1)+CORL(2,2,2)) - - IF(COWT12.LT.PYR(0)*COMX12) GOTO 160 - ENDIF - ENDIF - -C...Select angular orientation type - Z'/W' only. - MZPWP=0 - IF(ISUB.EQ.141) THEN - IF(PYR(0).LT.PARU(130)) MZPWP=1 - IF(IP.EQ.2) THEN - IF(IABS(K(IREF(2,1),2)).EQ.37) MZPWP=2 - IAKIR=IABS(K(IREF(2,2),2)) - IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 - IF(IAKIR.LE.20) MZPWP=2 - ENDIF - IF(IP.GE.3) MZPWP=2 - ELSEIF(ISUB.EQ.142) THEN - IF(PYR(0).LT.PARU(136)) MZPWP=1 - IF(IP.EQ.2) THEN - IAKIR=IABS(K(IREF(2,2),2)) - IF(IAKIR.EQ.25.OR.IAKIR.EQ.35.OR.IAKIR.EQ.36) MZPWP=2 - IF(IAKIR.LE.20) MZPWP=2 - ENDIF - IF(IP.GE.3) MZPWP=2 - ENDIF - -C...Select random angles (begin of weighting procedure). - 410 DO 420 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 420 - IF(JTMAX.EQ.1.AND.ISUB.NE.0.AND.IHDEC.EQ.0) THEN - CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*PYR(0) - IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33) - PHI(JT)=VINT(24) - ELSE - CTHE(JT)=2D0*PYR(0)-1D0 - PHI(JT)=PARU(2)*PYR(0) - ENDIF - 420 CONTINUE - - IF(JTMAX.EQ.2.AND.MSTP(47).GE.1.AND.NINH.EQ.0) THEN -C...Construct massless four-vectors. - DO 440 I=N+1,N+4 - K(I,1)=1 - DO 430 J=1,5 - P(I,J)=0D0 - V(I,J)=0D0 - 430 CONTINUE - 440 CONTINUE - DO 450 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 450 - ID=IREF(IP,JT) - P(N+2*JT-1,3)=0.5D0*P(ID,5) - P(N+2*JT-1,4)=0.5D0*P(ID,5) - P(N+2*JT,3)=-0.5D0*P(ID,5) - P(N+2*JT,4)=0.5D0*P(ID,5) - CALL PYROBO(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT), - & P(ID,1)/P(ID,4),P(ID,2)/P(ID,4),P(ID,3)/P(ID,4)) - 450 CONTINUE - -C...Store incoming and outgoing momenta, with random rotation to -C...avoid accidental zeroes in HA expressions. - IF(ISUB.NE.0) THEN - DO 470 I=IMIN,IMAX - K(N+4+I,1)=1 - P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+ - & P(ILIN(I),3)**2+P(ILIN(I),5)**2) - P(N+4+I,5)=P(ILIN(I),5) - DO 460 J=1,3 - P(N+4+I,J)=P(ILIN(I),J) - 460 CONTINUE - 470 CONTINUE - 480 THERR=ACOS(2D0*PYR(0)-1D0) - PHIRR=PARU(2)*PYR(0) - CALL PYROBO(N+4+IMIN,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) - DO 500 I=IMIN,IMAX - IF(P(N+4+I,1)**2+P(N+4+I,2)**2.LT.1D-4*(P(N+4+I,1)**2+ - & P(N+4+I,2)**2+P(N+4+I,3)**2)) GOTO 480 - DO 490 J=1,4 - PK(I,J)=P(N+4+I,J) - 490 CONTINUE - 500 CONTINUE - ENDIF - -C...Calculate internal products. - IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25.OR.ISUB.EQ.141.OR. - & ISUB.EQ.142) THEN - DO 520 I1=IMIN,IMAX-1 - DO 510 I2=I1+1,IMAX - HA(I1,I2)=SNGL(SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+ - & PK(I2,3))/(1D-20+PK(I1,1)**2+PK(I1,2)**2)))* - & CMPLX(SNGL(PK(I1,1)),SNGL(PK(I1,2)))- - & SNGL(SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ - & (1D-20+PK(I2,1)**2+PK(I2,2)**2)))* - & CMPLX(SNGL(PK(I2,1)),SNGL(PK(I2,2))) - HC(I1,I2)=CONJG(HA(I1,I2)) - IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2) - IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2) - HA(I2,I1)=-HA(I1,I2) - HC(I2,I1)=-HC(I1,I2) - 510 CONTINUE - 520 CONTINUE - ENDIF - -C...Calculate four-products. - IF(ISUB.NE.0) THEN - DO 540 I=1,2 - DO 530 J=1,4 - PK(I,J)=-PK(I,J) - 530 CONTINUE - 540 CONTINUE - DO 560 I1=IMIN,IMAX-1 - DO 550 I2=I1+1,IMAX - PKK(I1,I2)=2D0*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)- - & PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3)) - PKK(I2,I1)=PKK(I1,I2) - 550 CONTINUE - 560 CONTINUE - ENDIF - ENDIF - - KFAGM=IABS(IREF(IP,7)) - IF(MSTP(47).LE.0.OR.NINH.NE.0) THEN -C...Isotropic decay selected by user. - WT=1D0 - WTMAX=1D0 - - ELSEIF(JTMAX.EQ.3) THEN -C...Isotropic decay when three mother particles. - WT=1D0 - WTMAX=1D0 - - ELSEIF(IT4.GE.1) THEN -C... Isotropic decay t -> b + W etc for 4th generation q and l. - WT=1D0 - WTMAX=1D0 - - ELSEIF(IREF(IP,7).EQ.25.OR.IREF(IP,7).EQ.35.OR. - & IREF(IP,7).EQ.36) THEN -C...Angular weight for h0/A0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons. -C...CP-odd case added by Kari Ertresvag Myklevoll. -C...Now also with mixed Higgs CP-states - ETA=PARP(25) - IF(IP.EQ.1) WTMAX=SH**2 - IF(IP.GE.2) WTMAX=P(IREF(IP,8),5)**4 - KFA=IABS(K(IREF(IP,1),2)) - - IF((KFA.EQ.23.OR.KFA.EQ.24).AND.MSTP(25).GE.3) THEN -C...For mixed CP states need epsilon product. - P10=PK(3,4) - P20=PK(4,4) - P30=PK(5,4) - P40=PK(6,4) - P11=PK(3,1) - P21=PK(4,1) - P31=PK(5,1) - P41=PK(6,1) - P12=PK(3,2) - P22=PK(4,2) - P32=PK(5,2) - P42=PK(6,2) - P13=PK(3,3) - P23=PK(4,3) - P33=PK(5,3) - P43=PK(6,3) - EPSI=P10*P21*P32*P43-P10*P21*P33*P42-P10*P22*P31*P43+P10*P22* - & P33*P41+P10*P23*P31*P42-P10*P23*P32*P41-P11*P20*P32*P43+P11* - & P20*P33*P42+P11*P22*P30*P43-P11*P22*P33*P40-P11*P23*P30*P42+ - & P11*P23*P32*P40+P12*P20*P31*P43-P12*P20*P33*P41-P12*P21*P30* - & P43+P12*P21*P33*P40+P12*P23*P30*P41-P12*P23*P31*P40-P13*P20* - & P31*P42+P13*P20*P32*P41+P13*P21*P30*P42-P13*P21*P32*P40-P13* - & P22*P30*P41+P13*P22*P31*P40 -C...For mixed CP states need gauge boson masses. - XMA=SQRT(MAX(0D0,(PK(3,4)+PK(4,4))**2-(PK(3,1)+PK(4,1))**2- - & (PK(3,2)+PK(4,2))**2-(PK(3,3)+PK(4,3))**2)) - XMB=SQRT(MAX(0D0,(PK(5,4)+PK(6,4))**2-(PK(5,1)+PK(6,1))**2- - & (PK(5,2)+PK(6,2))**2-(PK(5,3)+PK(6,3))**2)) - XMV=PMAS(KFA,1) - ENDIF - -C...Z decay - IF(KFA.EQ.23) THEN - KFLF1A=IABS(KFL1(1)) - EF1=KCHG(KFLF1A,1)/3D0 - AF1=SIGN(1D0,EF1+0.1D0) - VF1=AF1-4D0*EF1*XWV - KFLF2A=IABS(KFL1(2)) - EF2=KCHG(KFLF2A,1)/3D0 - AF2=SIGN(1D0,EF2+0.1D0) - VF2=AF2-4D0*EF2*XWV - VA12AS=4D0*VF1*AF1*VF2*AF2/((VF1**2+AF1**2)*(VF2**2+AF2**2)) - IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) - & THEN -C...CP-even decay - WT=8D0*(1D0+VA12AS)*PKK(3,5)*PKK(4,6)+ - & 8D0*(1D0-VA12AS)*PKK(3,6)*PKK(4,5) - ELSEIF(MSTP(25).LE.2) THEN -C...CP-odd decay - WT=((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 - & -2*PKK(3,4)*PKK(5,6) - & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ - & (PKK(3,4)*PKK(5,6)) - & +VA12AS*(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* - & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6)))/(1+VA12AS) - ELSE -C...Mixed CP states. - WT=32D0*(0.25D0*((1D0+VA12AS)*PKK(3,5)*PKK(4,6) - & +(1D0-VA12AS)*PKK(3,6)*PKK(4,5)) - & -0.5D0*ETA/XMV**2*EPSI*((1D0+VA12AS)*(PKK(3,5)+PKK(4,6)) - & -(1D0-VA12AS)*(PKK(3,6)+PKK(4,5))) - & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 - & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 - & +PKK(3,4)*PKK(5,6) - & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) - & +VA12AS*PKK(3,4)*PKK(5,6) - & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) - & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) - & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 - & +2D0*(ETA*XMA*XMB/XMV**2)**2*(1D0+VA12AS)) - ENDIF - -C...W decay - ELSEIF(KFA.EQ.24) THEN - IF((MSTP(25).EQ.0.AND.IREF(IP,7).NE.36).OR.MSTP(25).EQ.1) - & THEN -C...CP-even decay - WT=16D0*PKK(3,5)*PKK(4,6) - ELSEIF(MSTP(25).LE.2) THEN -C...CP-odd decay - WT=0.5D0*((PKK(3,5)+PKK(4,6))**2 +(PKK(3,6)+PKK(4,5))**2 - & -2*PKK(3,4)*PKK(5,6) - & -2*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2/ - & (PKK(3,4)*PKK(5,6)) - & +(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6))* - & (PKK(3,5)+PKK(4,5)-PKK(3,6)-PKK(4,6))) - ELSE -C...Mixed CP states. - WT=32D0*(0.25D0*2D0*PKK(3,5)*PKK(4,6) - & -0.5D0*ETA/XMV**2*EPSI*2D0*(PKK(3,5)+PKK(4,6)) - & +6.25D-2*ETA**2/XMV**4*(-2D0*PKK(3,4)**2*PKK(5,6)**2 - & -2D0*(PKK(3,5)*PKK(4,6)-PKK(3,6)*PKK(4,5))**2 - & +PKK(3,4)*PKK(5,6) - & *((PKK(3,5)+PKK(4,6))**2+(PKK(3,6)+PKK(4,5))**2) - & +PKK(3,4)*PKK(5,6) - & *(PKK(3,5)+PKK(3,6)-PKK(4,5)-PKK(4,6)) - & *(PKK(3,5)-PKK(3,6)+PKK(4,5)-PKK(4,6)))) - & /(1D0 +2D0*ETA*XMA*XMB/XMV**2 - & +(2D0*ETA*XMA*XMB/XMV**2)**2) - ENDIF - -C...No angular correlations in other Higgs decays. - ELSE - WT=WTMAX - ENDIF - - ELSEIF((KFAGM.EQ.6.OR.KFAGM.EQ.7.OR.KFAGM.EQ.8.OR. - & KFAGM.EQ.17.OR.KFAGM.EQ.18).AND.IABS(K(IREF(IP,1),2)).EQ.24) - & THEN -C...Angular correlation in f -> f' + W -> f' + 2 quarks/leptons. - I1=IREF(IP,8) - IF(MOD(KFAGM,2).EQ.0) THEN - I2=N+1 - I3=N+2 - ELSE - I2=N+2 - I3=N+1 - ENDIF - I4=IREF(IP,2) - WT=(P(I1,4)*P(I2,4)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- - & P(I1,3)*P(I2,3))*(P(I3,4)*P(I4,4)-P(I3,1)*P(I4,1)- - & P(I3,2)*P(I4,2)-P(I3,3)*P(I4,3)) - WTMAX=(P(I1,5)**4-P(IREF(IP,1),5)**4)/8D0 - - ELSEIF(ISUB.EQ.1) THEN -C...Angular weight for gamma*/Z0 -> 2 quarks/leptons. - EI=KCHG(IABS(MINT(15)),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EF=KCHG(IABS(KFL1(1)),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - - VF=AF-4D0*EF*XWV - RMF=MIN(1D0,4D0*PMAS(IABS(KFL1(1)),1)**2/SH) - WT1=EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & (VI**2+AI**2)*VINT(114)*(VF**2+(1D0-RMF)*AF**2) - WT2=RMF*(EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & (VI**2+AI**2)*VINT(114)*VF**2) - WT3=SQRT(1D0-RMF)*(EI*AI*VINT(112)*EF*AF+ - & 4D0*VI*AI*VINT(114)*VF*AF) - WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ - & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) - WTMAX=2D0*(WT1+ABS(WT3)) - - ELSEIF(ISUB.EQ.2) THEN -C...Angular weight for W+/- -> 2 quarks/leptons. - RM3=PMAS(IABS(KFL1(1)),1)**2/SH - RM4=PMAS(IABS(KFL2(1)),1)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 - WTMAX=4D0 - - ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN -C...Angular weight for f + fbar -> gluon/gamma + (gamma*/Z0) -> -C...-> gluon/gamma + 2 quarks/leptons. - CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 - CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 - WT=(CLILF+CRIRF)*(PKK(1,3)**2+PKK(2,4)**2)+ - & (CLIRF+CRILF)*(PKK(1,4)**2+PKK(2,3)**2) - WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* - & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2) - - ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN -C...Angular weight for f + fbar' -> gluon/gamma + W+/- -> -C...-> gluon/gamma + 2 quarks/leptons. - WT=PKK(1,3)**2+PKK(2,4)**2 - WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2 - - ELSEIF(ISUB.EQ.22) THEN -C...Angular weight for f + fbar -> Z0 + Z0 -> 4 quarks/leptons. - S34=P(IREF(IP,IORD),5)**2 - S56=P(IREF(IP,3-IORD),5)**2 - TI=PKK(1,3)+PKK(1,4)+S34 - UI=PKK(1,5)+PKK(1,6)+S56 - TIR=REAL(TI) - UIR=REAL(UI) - FGK135=ABS(FGK(1,2,3,4,5,6)/TIR+FGK(1,2,5,6,3,4)/UIR)**2 - FGK145=ABS(FGK(1,2,4,3,5,6)/TIR+FGK(1,2,5,6,4,3)/UIR)**2 - FGK136=ABS(FGK(1,2,3,4,6,5)/TIR+FGK(1,2,6,5,3,4)/UIR)**2 - FGK146=ABS(FGK(1,2,4,3,6,5)/TIR+FGK(1,2,6,5,4,3)/UIR)**2 - FGK253=ABS(FGK(2,1,5,6,3,4)/TIR+FGK(2,1,3,4,5,6)/UIR)**2 - FGK263=ABS(FGK(2,1,6,5,3,4)/TIR+FGK(2,1,3,4,6,5)/UIR)**2 - FGK254=ABS(FGK(2,1,5,6,4,3)/TIR+FGK(2,1,4,3,5,6)/UIR)**2 - FGK264=ABS(FGK(2,1,6,5,4,3)/TIR+FGK(2,1,4,3,6,5)/UIR)**2 - - WT= - & CORL(1,1,1)*CORL(2,1,1)*FGK135+CORL(1,1,2)*CORL(2,1,1)*FGK145+ - & CORL(1,1,1)*CORL(2,1,2)*FGK136+CORL(1,1,2)*CORL(2,1,2)*FGK146+ - & CORL(1,2,1)*CORL(2,2,1)*FGK253+CORL(1,2,2)*CORL(2,2,1)*FGK263+ - & CORL(1,2,1)*CORL(2,2,2)*FGK254+CORL(1,2,2)*CORL(2,2,2)*FGK264 - WTMAX=16D0*((CORL(1,1,1)+CORL(1,1,2))*(CORL(2,1,1)+CORL(2,1,2))+ - & (CORL(1,2,1)+CORL(1,2,2))*(CORL(2,2,1)+CORL(2,2,2)))*S34*S56* - & ((TI**2+UI**2+2D0*SH*(S34+S56))/(TI*UI)-S34*S56*(1D0/TI**2+ - & 1D0/UI**2)) - - ELSEIF(ISUB.EQ.23) THEN -C...Angular weight for f + fbar' -> Z0 + W+/- -> 4 quarks/leptons. - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FACBW=1D0/((SH-SQMW)**2+GMMW**2) - CAWZ=COUP(2,3)/DT-2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW - CBWZ=COUP(1,3)/DU+2D0*XW1*COUP(1,2)*(SH-SQMW)*FACBW - FGK135=ABS(REAL(CAWZ)*FGK(1,2,3,4,5,6)+ - - & REAL(CBWZ)*FGK(1,2,5,6,3,4)) - FGK136=ABS(REAL(CAWZ)*FGK(1,2,3,4,6,5)+ - & REAL(CBWZ)*FGK(1,2,6,5,3,4)) - WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 - WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2* - & DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU)) - - ELSEIF(ISUB.EQ.24.OR.ISUB.EQ.171.OR.ISUB.EQ.176) THEN -C...Angular weight for f + fbar -> Z0 + h0 -> 2 quarks/leptons + h0 -C...(or H0, or A0). - WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* - & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)* - & COUP(3,3))**2)*PKK(1,4)*PKK(2,3) - WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* - & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) - - ELSEIF(ISUB.EQ.25) THEN -C...Angular weight for f + fbar -> W+ + W- -> 4 quarks/leptons. - POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) - POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FACBW=1D0/((SH-SQMZ)**2+SQMZ*PMAS(23,2)**2) - CDWW=(COUP(1,3)*SQMZ*(SH-SQMZ)*FACBW+COUP(1,2))/SH - CAWW=CDWW+0.5D0*(COUP(1,2)+1D0)/DT - CBWW=CDWW+0.5D0*(COUP(1,2)-1D0)/DU - CCWW=COUP(1,4)*SQMZ*(SH-SQMZ)*FACBW/SH - FGK135=ABS(REAL(CAWW)*FGK(1,2,3,4,5,6)- - & REAL(CBWW)*FGK(1,2,5,6,3,4)) - FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) - IF(MSTP(50).LE.0) THEN - WT=FGK135**2+(CCWW*FGK253)**2 - WTMAX=4D0*D34*D56*(CAWW**2*DIGK(DT,DU)+CBWW**2*DIGK(DU,DT)- - & CAWW*CBWW*DJGK(DT,DU)+CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)- - & DJGK(DT,DU))) - ELSE - WT=POLL*FGK135**2+POLR*(CCWW*FGK253)**2 - WTMAX=4D0*D34*D56*(POLL*(CAWW**2*DIGK(DT,DU)+ - & CBWW**2*DIGK(DU,DT)-CAWW*CBWW*DJGK(DT,DU))+ - & POLR*CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))) - ENDIF - - ELSEIF(ISUB.EQ.26.OR.ISUB.EQ.172.OR.ISUB.EQ.177) THEN -C...Angular weight for f + fbar' -> W+/- + h0 -> 2 quarks/leptons + h0 -C...(or H0, or A0). - WT=PKK(1,3)*PKK(2,4) - WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) - - ELSEIF(ISUB.EQ.30.OR.ISUB.EQ.35) THEN -C...Angular weight for f + g/gamma -> f + (gamma*/Z0) -C...-> f + 2 quarks/leptons. - CLILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CLIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,3)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,3)**2*HGZ(JTZ,3)*COUP(3,4)**2 - CRILF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,3)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,3)**2 - CRIRF=COUP(1,1)**2*HGZ(JTZ,1)*COUP(3,1)**2/16D0+ - & COUP(1,1)*COUP(1,4)*HGZ(JTZ,2)*COUP(3,1)*COUP(3,4)/4D0+ - & COUP(1,4)**2*HGZ(JTZ,3)*COUP(3,4)**2 - IF(K(ILIN(1),2).GT.0) WT=(CLILF+CRIRF)*(PKK(1,4)**2+ - & PKK(3,5)**2)+(CLIRF+CRILF)*(PKK(1,3)**2+PKK(4,5)**2) - IF(K(ILIN(1),2).LT.0) WT=(CLILF+CRIRF)*(PKK(1,3)**2+ - & PKK(4,5)**2)+(CLIRF+CRILF)*(PKK(1,4)**2+PKK(3,5)**2) - WTMAX=(CLILF+CLIRF+CRILF+CRIRF)* - & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2) - - ELSEIF(ISUB.EQ.31.OR.ISUB.EQ.36) THEN -C...Angular weight for f + g/gamma -> f' + W+/- -> f' + 2 fermions. - IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2 - IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2 - WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2 - - ELSEIF(ISUB.EQ.71.OR.ISUB.EQ.72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR. - & ISUB.EQ.77) THEN -C...Angular weight for V_L1 + V_L2 -> V_L3 + V_L4 (V = Z/W). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - - ELSEIF(ISUB.EQ.110) THEN -C...Angular weight for f + fbar -> gamma + h0 -> gamma + X is isotropic. - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.EQ.141) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN -C...Angular weight for f + fbar -> gamma*/Z0/Z'0 -> 2 quarks/leptons. -C...Couplings of incoming flavour. - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - KFAIC=1 - IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 - IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 - IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 - IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN - VPI=PARU(119+2*KFAIC) - API=PARU(120+2*KFAIC) - ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN - VPI=PARJ(178+2*KFAIC) - API=PARJ(179+2*KFAIC) - ELSE - VPI=PARJ(186+2*KFAIC) - API=PARJ(187+2*KFAIC) - ENDIF -C...Couplings of final flavour. - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - KFAFC=1 - IF(KFAF.LE.10.AND.MOD(KFAF,2).EQ.0) KFAFC=2 - IF(KFAF.GT.10.AND.MOD(KFAF,2).NE.0) KFAFC=3 - IF(KFAF.GT.10.AND.MOD(KFAF,2).EQ.0) KFAFC=4 - IF(KFAF.LE.2.OR.KFAF.EQ.11.OR.KFAF.EQ.12) THEN - VPF=PARU(119+2*KFAFC) - APF=PARU(120+2*KFAFC) - ELSEIF(KFAF.LE.4.OR.KFAF.EQ.13.OR.KFAF.EQ.14) THEN - VPF=PARJ(178+2*KFAFC) - APF=PARJ(179+2*KFAFC) - ELSE - VPF=PARJ(186+2*KFAFC) - APF=PARJ(187+2*KFAFC) - ENDIF -C...Asymmetry and weight. - ASYM=2D0*(EI*AI*VINT(112)*EF*AF+EI*API*VINT(113)*EF*APF+ - & 4D0*VI*AI*VINT(114)*VF*AF+(VI*API+VPI*AI)*VINT(115)* - & (VF*APF+VPF*AF)+4D0*VPI*API*VINT(116)*VPF*APF)/ - & (EI**2*VINT(111)*EF**2+EI*VI*VINT(112)*EF*VF+ - & EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* - & (VF**2+AF**2)+(VI*VPI+AI*API)*VINT(115)*(VF*VPF+AF*APF)+ - & (VPI**2+API**2)*VINT(116)*(VPF**2+APF**2)) - WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 - WTMAX=2D0+ABS(ASYM) - ELSEIF(IP.EQ.1.AND.IABS(KFL1(1)).EQ.24) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W-. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* - & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ - & (RM2-RM1)**2) - WT=CFLAT+CCOS2*CTHE(1)**2 - WTMAX=CFLAT+MAX(0D0,CCOS2) - ELSEIF(IP.EQ.1.AND.(KFL1(1).EQ.25.OR.KFL1(1).EQ.35.OR. - & IABS(KFL1(1)).EQ.37)) THEN -C...Angular weight for f + fbar -> Z' -> h0 + A0, H0 + A0, H+ + H-. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN -C...Angular weight for f + fbar -> Z' -> Z0 + h0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) - WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) - WTMAX=1D0+FLAM2/(8D0*RM1) - ELSEIF(MZPWP.EQ.0) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons -C...(W:s like if intermediate Z). - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) - FGK253=ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6)) - WT=(COUP(1,3)*FGK135)**2+(COUP(1,4)*FGK253)**2 - WTMAX=4D0*D34*D56*(COUP(1,3)**2+COUP(1,4)**2)* - & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) - ELSEIF(MZPWP.EQ.1) THEN -C...Angular weight for f + fbar -> Z' -> W+ + W- -> 4 quarks/leptons -C...(W:s approximately longitudinal, like if intermediate H). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - ELSE -C...Angular weight for f + fbar -> Z' -> H+ + H-, Z0 + h0, h0 + A0, -C...H0 + A0 -> 4 quarks/leptons, t + tbar -> b + W+ + bbar + W- . - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.142) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).LT.20) THEN -C...Angular weight for f + fbar' -> W'+/- -> 2 quarks/leptons. - KFAI=IABS(MINT(15)) - KFAIC=1 - IF(KFAI.GT.10) KFAIC=2 - VI=PARU(129+2*KFAIC) - AI=PARU(130+2*KFAIC) - KFAF=IABS(KFL1(1)) - KFAFC=1 - IF(KFAF.GT.10) KFAFC=2 - VF=PARU(129+2*KFAFC) - AF=PARU(130+2*KFAFC) - ASYM=8D0*VI*AI*VF*AF/((VI**2+AI**2)*(VF**2+AF**2)) - WT=1D0+ASYM*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1))+CTHE(1)**2 - WTMAX=2D0+ABS(ASYM) - ELSEIF(IP.EQ.1.AND.IABS(KFL2(1)).EQ.23) THEN -C...Angular weight for f + fbar' -> W'+/- -> W+/- + Z0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - CCOS2=-(1D0/16D0)*((1D0-RM1-RM2)**2-4D0*RM1*RM2)* - & (1D0-2D0*RM1-2D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - CFLAT=-CCOS2+0.5D0*(RM1+RM2)*(1D0-2D0*RM1-2D0*RM2+ - & (RM2-RM1)**2) - WT=CFLAT+CCOS2*CTHE(1)**2 - WTMAX=CFLAT+MAX(0D0,CCOS2) - ELSEIF(IP.EQ.1.AND.KFL2(1).EQ.25) THEN -C...Angular weight for f + fbar -> W'+/- -> W+/- + h0. - RM1=P(NSD(1)+1,5)**2/SH - RM2=P(NSD(1)+2,5)**2/SH - FLAM2=MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2) - WT=1D0+FLAM2*(1D0-CTHE(1)**2)/(8D0*RM1) - WTMAX=1D0+FLAM2/(8D0*RM1) - ELSEIF(MZPWP.EQ.0) THEN -C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons -C...(W/Z like if intermediate W). - D34=P(IREF(IP,IORD),5)**2 - D56=P(IREF(IP,3-IORD),5)**2 - DT=PKK(1,3)+PKK(1,4)+D34 - DU=PKK(1,5)+PKK(1,6)+D56 - FGK135=ABS(FGK(1,2,3,4,5,6)-FGK(1,2,5,6,3,4)) - FGK136=ABS(FGK(1,2,3,4,6,5)-FGK(1,2,6,5,3,4)) - WT=(COUP(5,3)*FGK135)**2+(COUP(5,4)*FGK136)**2 - WTMAX=4D0*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)* - & (DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)) - ELSEIF(MZPWP.EQ.1) THEN -C...Angular weight for f + fbar' -> W' -> W + Z0 -> 4 quarks/leptons -C...(W/Z approximately longitudinal, like if intermediate H). - WT=16D0*PKK(3,5)*PKK(4,6) - WTMAX=SH**2 - ELSE -C...Angular weight for f + fbar -> W' -> W + h0 -> whatever, -C...t + bbar -> t + W + bbar. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.145.OR.ISUB.EQ.162.OR.ISUB.EQ.163.OR.ISUB.EQ.164) - & THEN -C...Isotropic decay of leptoquarks (assumed spin 0). - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.GE.146.AND.ISUB.LE.148) THEN -C...Decays of (spin 1/2) q*/e* -> q/e + (g,gamma) or (Z0,W+-). - SIDE=1D0 - IF(MINT(16).EQ.21.OR.MINT(16).EQ.22) SIDE=-1D0 - IF(IP.EQ.1.AND.(KFL1(1).EQ.21.OR.KFL1(1).EQ.22)) THEN - WT=1D0+SIDE*CTHE(1) - WTMAX=2D0 - ELSEIF(IP.EQ.1) THEN - - RM1=P(NSD(1)+1,5)**2/SH - WT=1D0+SIDE*CTHE(1)*(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) - WTMAX=1D0+(1D0-0.5D0*RM1)/(1D0+0.5D0*RM1) - ELSE -C...W/Z decay assumed isotropic, since not known. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.149) THEN -C...Isotropic decay of techni-eta. - WT=1D0 - WTMAX=1D0 - - ELSEIF(ISUB.EQ.191) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar -> rho_tc0 -> W+ W-, -C...W+ pi_tc-, pi_tc+ W- or pi_tc+ pi_tc-. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar -> rho_tc0 -> f fbar. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - ALEFTI=(EI+VALI*BWZR)**2+(VALI*BWZI)**2 - ARIGHI=(EI+VARI*BWZR)**2+(VARI*BWZI)**2 - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - ALEFTF=(EF+VALF*BWZR)**2+(VALF*BWZI)**2 - ARIGHF=(EF+VARF*BWZR)**2+(VARF*BWZI)**2 - ASAME=ALEFTI*ALEFTF+ARIGHI*ARIGHF - AFLIP=ALEFTI*ARIGHF+ARIGHI*ALEFTF - WT=ASAME*(1D0+CTHESG)**2+AFLIP*(1D0-CTHESG)**2 - WTMAX=4D0*MAX(ASAME,AFLIP) - ELSE -C...Isotropic decay of W/pi_tc produced in rho_tc decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.192) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar' -> rho_tc+ -> W+ Z0, -C...W+ pi_tc0, pi_tc+ Z0 or pi_tc+ pi_tc0. - WT=1D0-CTHE(1)**2 - WTMAX=1D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar' -> rho_tc+ -> f fbar'. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - WT=(1D0+CTHESG)**2 - WTMAX=4D0 - ELSE -C...Isotropic decay of W/Z/pi_tc produced in rho_tc+ decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.193) THEN - IF(IP.EQ.1.AND.IABS(KFL1(1)).GT.21) THEN -C...Angular weight for f + fbar -> omega_tc0 -> -C...gamma pi_tc0 or Z0 pi_tc0. - WT=1D0+CTHE(1)**2 - WTMAX=2D0 - ELSEIF(IP.EQ.1) THEN -C...Angular weight for f + fbar -> omega_tc0 -> f fbar. - CTHESG=CTHE(1)*ISIGN(1,MINT(15)) - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - BLEFTI=(EI-VALI*BWZR)**2+(VALI*BWZI)**2 - BRIGHI=(EI-VARI*BWZR)**2+(VARI*BWZI)**2 - KFAF=IABS(KFL1(1)) - EF=KCHG(KFAF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - BLEFTF=(EF-VALF*BWZR)**2+(VALF*BWZI)**2 - BRIGHF=(EF-VARF*BWZR)**2+(VARF*BWZI)**2 - BSAME=BLEFTI*BLEFTF+BRIGHI*BRIGHF - BFLIP=BLEFTI*BRIGHF+BRIGHI*BLEFTF - WT=BSAME*(1D0+CTHESG)**2+BFLIP*(1D0-CTHESG)**2 - WTMAX=4D0*MAX(BSAME,BFLIP) - ELSE -C...Isotropic decay of Z/pi_tc produced in omega_tc decay. - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.353) THEN -C...Angular weight for Z_R0 -> 2 quarks/leptons. - EI=KCHG(IABS(MINT(15)),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EF=KCHG(PYCOMP(KFL1(1)),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - RMF=MIN(1D0,4D0*PMAS(PYCOMP(KFL1(1)),1)**2/SH) - WT1=(VI**2+AI**2)*(VF**2+(1D0-RMF)*AF**2) - WT2=RMF*(VI**2+AI**2)*VF**2 - WT3=SQRT(1D0-RMF)*4D0*VI*AI*VF*AF - WT=WT1*(1D0+CTHE(1)**2)+WT2*(1D0-CTHE(1)**2)+ - & 2D0*WT3*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)) - WTMAX=2D0*(WT1+ABS(WT3)) - - ELSEIF(ISUB.EQ.354) THEN -C...Angular weight for W_R+/- -> 2 quarks/leptons. - RM3=PMAS(PYCOMP(KFL1(1)),1)**2/SH - RM4=PMAS(PYCOMP(KFL2(1)),1)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - WT=(1D0+BE34*CTHE(1)*ISIGN(1,MINT(15)*KFL1(1)))**2-(RM3-RM4)**2 - WTMAX=4D0 - - ELSEIF(ISUB.EQ.391) THEN -C...Angular weight for f + fbar -> G* -> f + fbar - IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN - WT=1D0-3D0*CTHE(1)**2+4D0*CTHE(1)**4 - WTMAX=2D0 -C...Other G* decays not yet implemented angular distributions. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - - ELSEIF(ISUB.EQ.392) THEN -C...Angular weight for g + g -> G* -> f + fbar - IF(IP.EQ.1.AND.IABS(KFL1(1)).LE.18) THEN - WT=1D0-CTHE(1)**4 - WTMAX=1D0 -C...Other G* decays not yet implemented angular distributions. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - -C...Obtain correct angular distribution by rejection techniques. - ELSE - WT=1D0 - WTMAX=1D0 - ENDIF - IF(WT.LT.PYR(0)*WTMAX) GOTO 410 - -C...Construct massive four-vectors using angles chosen. - 570 DO 670 JT=1,JTMAX - IF(KDCY(JT).EQ.0) GOTO 670 - ID=IREF(IP,JT) - DO 580 J=1,5 - DPMO(J)=P(ID,J) - 580 CONTINUE - DPMO(4)=SQRT(DPMO(1)**2+DPMO(2)**2+DPMO(3)**2+DPMO(5)**2) -CMRENNA++ - IF(KFL3(JT).EQ.0) THEN - CALL PYROBO(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), - & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) - N0=NSD(JT)+2 - ELSE - CALL PYROBO(NSD(JT)+1,NSD(JT)+3,ACOS(CTHE(JT)),PHI(JT), - & DPMO(1)/DPMO(4),DPMO(2)/DPMO(4),DPMO(3)/DPMO(4)) - N0=NSD(JT)+3 - ENDIF - - DO 590 J=1,4 - VDCY(J)=V(ID,J)+V(ID,5)*P(ID,J)/P(ID,5) - 590 CONTINUE -C...Fill in position of decay vertex. - DO 610 I=NSD(JT)+1,N0 - DO 600 J=1,4 - V(I,J)=VDCY(J) - 600 CONTINUE - V(I,5)=0D0 - - 610 CONTINUE -CMRENNA-- - -C...Mark decayed resonances; trace history. - K(ID,1)=K(ID,1)+10 - KFA=IABS(K(ID,2)) - KCA=PYCOMP(KFA) - IF(KCQM(JT).NE.0) THEN -C...Do not kill colour flow through coloured resonance! - ELSE - K(ID,4)=NSD(JT)+1 - K(ID,5)=NSD(JT)+2 -C...If 3-body or 2-body with junction: - IF(KFL3(JT).NE.0.OR.ITJUNC(JT).NE.0) K(ID,5)=NSD(JT)+3 -C...If 3-body with junction: - IF(ITJUNC(JT).NE.0.AND.KFL3(JT).NE.0) K(ID,5)=NSD(JT)+4 - ENDIF - -C...Add documentation lines. - ISUBRG=MAX(1,MIN(500,MINT(1))) - IF(IRES.EQ.0.OR.ISET(ISUBRG).EQ.11) THEN - IDOC=MINT(83)+MINT(4) -CMRENNA+++ - IHI=NSD(JT)+2 - IF(KFL3(JT).NE.0) IHI=IHI+1 - DO 630 I=NSD(JT)+1,IHI -CMRENNA--- - I1=MINT(83)+MINT(4)+1 - K(I,3)=I1 - IF(MSTP(128).GE.1) K(I,3)=ID - IF(MSTP(128).LE.1.AND.MINT(4).LT.MSTP(126)) THEN - MINT(4)=MINT(4)+1 - K(I1,1)=21 - K(I1,2)=K(I,2) - K(I1,3)=IREF(IP,JT+3) - DO 620 J=1,5 - P(I1,J)=P(I,J) - 620 CONTINUE - ENDIF - 630 CONTINUE - ELSE - K(NSD(JT)+1,3)=ID - K(NSD(JT)+2,3)=ID -C...If 3-body or 2-body with junction: - IF(KFL3(JT).NE.0.OR.ITJUNC(JT).GT.0) K(NSD(JT)+3,3)=ID -C...If 3-body with junction: - IF(KFL3(JT).NE.0.AND.ITJUNC(JT).GT.0) K(NSD(JT)+4,3)=ID - ENDIF - -C...Do showering of two or three objects. - NSHBEF=N - IF(MSTP(71).GE.1) THEN - IF(KFL3(JT).EQ.0) THEN - CALL PYSHOW(NSD(JT)+1,NSD(JT)+2,P(ID,5)) - ELSE - CALL PYSHOW(NSD(JT)+1,-3,P(ID,5)) - ENDIF - ENDIF - NSHAFT=N - IF(JT.EQ.1) NAFT1=N - -C...Check if decay products moved by shower. - NSD1=NSD(JT)+1 - NSD2=NSD(JT)+2 - NSD3=NSD(JT)+3 - IF(NSHAFT.GT.NSHBEF) THEN - IF(K(NSD1,1).GT.10) THEN - DO 640 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD1,2)) NSD1=I - 640 CONTINUE - ENDIF - IF(K(NSD2,1).GT.10) THEN - DO 650 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD2,2).AND. - & I.NE.NSD1) NSD2=I - 650 CONTINUE - ENDIF - IF(KFL3(JT).NE.0.AND.K(NSD3,1).GT.10) THEN - DO 660 I=NSHBEF+1,NSHAFT - IF(K(I,1).LT.10.AND.K(I,2).EQ.K(NSD3,2).AND. - & I.NE.NSD1.AND.I.NE.NSD2) NSD3=I - 660 CONTINUE - ENDIF - ENDIF - -C...Store decay products for further treatment. - NP=NP+1 - IREF(NP,1)=NSD1 - IREF(NP,2)=NSD2 - IREF(NP,3)=0 - IF(KFL3(JT).NE.0) IREF(NP,3)=NSD3 - IREF(NP,4)=IDOC+1 - IREF(NP,5)=IDOC+2 - IREF(NP,6)=0 - IF(KFL3(JT).NE.0) IREF(NP,6)=IDOC+3 - IREF(NP,7)=K(IREF(IP,JT),2) - IREF(NP,8)=IREF(IP,JT) - 670 CONTINUE - -C...Fill information for 2 -> 1 -> 2. - 680 IF(JTMAX.EQ.1.AND.KDCY(1).NE.0.AND.ISUB.NE.0) THEN - MINT(7)=MINT(83)+6+2*ISET(ISUB) - MINT(8)=MINT(83)+7+2*ISET(ISUB) - MINT(25)=KFL1(1) - MINT(26)=KFL2(1) - VINT(23)=CTHE(1) - RM3=P(N-1,5)**2/SH - RM4=P(N,5)**2/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - VINT(45)=-0.5D0*SH*(1D0-RM3-RM4-BE34*CTHE(1)) - VINT(46)=-0.5D0*SH*(1D0-RM3-RM4+BE34*CTHE(1)) - VINT(48)=0.25D0*SH*BE34**2*MAX(0D0,1D0-CTHE(1)**2) - VINT(47)=SQRT(VINT(48)) - ENDIF - -C...Possibility of colour rearrangement in W+W- events. - IF((ISUB.EQ.25.OR.ISUB.EQ.22).AND.MSTP(115).GE.1) THEN - IAKF1=IABS(KFL1(1)) - IAKF2=IABS(KFL1(2)) - IAKF3=IABS(KFL2(1)) - IAKF4=IABS(KFL2(2)) - IF(MIN(IAKF1,IAKF2,IAKF3,IAKF4).GE.1.AND. - & MAX(IAKF1,IAKF2,IAKF3,IAKF4).LE.5) CALL - & PYRECO(IREF(1,1),IREF(1,2),NSD(1),NAFT1) - ENDIF - -C...Loop back if needed. - 690 IF(IP.LT.NP) GOTO 150 - -C...Boost back to standard frame. - 700 IF(IBST.EQ.1) CALL PYROBO(MINT(83)+7,N,THEIN,PHIIN,BEXIN,BEYIN, - &BEZIN) - - RETURN - END - -C********************************************************************* - -C...PYR -C...Generates random numbers uniformly distributed between -C...0 and 1, excluding the endpoints. - -C FUNCTION PYR(IDUMMY) ! regular PYR - FUNCTION PYRXXXX(IDUMMY) ! dummy PYR, should be redefined (E.Chudakov) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Equivalence between commonblock and local variables. - EQUIVALENCE (MRPY1,MRPY(1)),(MRPY2,MRPY(2)),(MRPY3,MRPY(3)), - &(MRPY4,MRPY(4)),(MRPY5,MRPY(5)),(MRPY6,MRPY(6)), - &(RRPY98,RRPY(98)),(RRPY99,RRPY(99)),(RRPY00,RRPY(100)) - -C...Initialize generation from given seed. - IF(MRPY2.EQ.0) THEN - IJ=MOD(MRPY1/30082,31329) - KL=MOD(MRPY1,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=0D0 - T=0.5D0 - DO 100 JJ=1,48 - 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.5D0*T - 100 CONTINUE - RRPY(II)=S - 110 CONTINUE - TWOM24=1D0 - DO 120 I24=1,24 - TWOM24=0.5D0*TWOM24 - 120 CONTINUE - RRPY98=362436D0*TWOM24 - RRPY99=7654321D0*TWOM24 - RRPY00=16777213D0*TWOM24 - MRPY2=1 - MRPY3=0 - MRPY4=97 - MRPY5=33 - ENDIF - -C...Generate next random number. - 130 RUNI=RRPY(MRPY4)-RRPY(MRPY5) - IF(RUNI.LT.0D0) RUNI=RUNI+1D0 - RRPY(MRPY4)=RUNI - MRPY4=MRPY4-1 - IF(MRPY4.EQ.0) MRPY4=97 - MRPY5=MRPY5-1 - IF(MRPY5.EQ.0) MRPY5=97 - RRPY98=RRPY98-RRPY99 - IF(RRPY98.LT.0D0) RRPY98=RRPY98+RRPY00 - RUNI=RUNI-RRPY98 - IF(RUNI.LT.0D0) RUNI=RUNI+1D0 - IF(RUNI.LE.0D0.OR.RUNI.GE.1D0) GOTO 130 - -C...Update counters. Random number to output. - MRPY3=MRPY3+1 - IF(MRPY3.EQ.1000000000) THEN - MRPY2=MRPY2+1 - MRPY3=0 - ENDIF - PYR=RUNI - - RETURN - END - -C********************************************************************* - -C...PYRGET -C...Dumps the state of the random number generator on a file -C...for subsequent startup from this state onwards. - - SUBROUTINE PYRGET(LFN,MOVE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Local character variable. - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRPY(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=110,IOSTAT=IERR) - 100 CONTINUE - MRPY(6)=MRPY(6)-NBCK - ENDIF - -C...Unformatted write on unit LFN. - WRITE(LFN,ERR=110,IOSTAT=IERR) (MRPY(I1),I1=1,5), - &(RRPY(I2),I2=1,100) - MRPY(6)=MRPY(6)+1 - RETURN - -C...Write error. - 110 WRITE(CHERR,'(I8)') IERR - CALL PYERRM(18,'(PYRGET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - -C...PYRGHM -C...Auxiliary to PYPOLE. - - SUBROUTINE PYRGHM(MCHI,MA,TANB,MQ,MUR,MD,MTOP,AU,AD,MU, - * MHP,HMP,MCH,SA,CA,SAB,CAB,TANBA,MGLU,DELTAMT,DELTAMB) - IMPLICIT DOUBLE PRECISION(A-H,L,M,O-Z) - DIMENSION VH(2,2),M2(2,2),M2P(2,2) -C...Parameters. - INTEGER MSTU,MSTJ - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - MZ = 91.18D0 - PI = PARU(1) - V = 174.1D0 - ALPHA1 = 0.0101D0 - ALPHA2 = 0.0337D0 - ALPHA3Z = 0.12D0 - TANBA = TANB - TANBT = TANB -C MBOTTOM(MTOP) = 3. GEV - MB = PYMRUN(5,MTOP**2) - ALPHA3 = ALPHA3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPHA3Z* - *LOG(MTOP**2/MZ**2)) -C RMTOP= RUNNING TOP QUARK MASS - RMTOP = MTOP/(1D0+4D0*ALPHA3/3D0/PI) - TQ = LOG((MQ**2+MTOP**2)/MTOP**2) - TU = LOG((MUR**2 + MTOP**2)/MTOP**2) - TD = LOG((MD**2 + MTOP**2)/MTOP**2) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C NEW DEFINITION, TGLU. -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - TGLU = LOG(MGLU**2/MTOP**2) - SINB = TANB/DSQRT(1D0 + TANB**2) - COSB = SINB/TANB - IF(MA.GT.MTOP) - *TANBA = TANB*(1D0-3D0/32D0/PI**2* - *(RMTOP**2/V**2/SINB**2-MB**2/V**2/COSB**2)* - *LOG(MA**2/MTOP**2)) - IF(MA.LT.MTOP.OR.MA.EQ.MTOP) TANBT = TANBA - SINB = TANBT/SQRT(1D0 + TANBT**2) - COSB = 1D0/DSQRT(1D0 + TANBT**2) - G1 = SQRT(ALPHA1*4D0*PI) - G2 = SQRT(ALPHA2*4D0*PI) - G3 = SQRT(ALPHA3*4D0*PI) - HU = RMTOP/V/SINB - HD = MB/V/COSB - CALL PYGFXX(MA,TANBA,MQ,MUR,MD,MTOP,AU,AD,MU,MGLU,VH,STOP1,STOP2, - *SBOT1,SBOT2,DELTAMT,DELTAMB) - IF(MQ.GT.MUR) TP = TQ - TU - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TP = TU - TQ - IF(MQ.GT.MUR) TDP = TU - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) TDP = TQ - IF(MQ.GT.MD) TPD = TQ - TD - IF(MQ.LT.MD.OR.MQ.EQ.MD) TPD = TD - TQ - IF(MQ.GT.MD) TDPD = TD - IF(MQ.LT.MD.OR.MQ.EQ.MD) TDPD = TQ - - IF(MQ.GT.MD) DLAMBDA1 = 6D0/96D0/PI**2*G1**2*HD**2*TPD - IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA1 = 3D0/32D0/PI**2* - * HD**2*(G1**2/3D0+G2**2)*TPD - - IF(MQ.GT.MUR) DLAMBDA2 =12D0/96D0/PI**2*G1**2*HU**2*TP - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA2 = 3D0/32D0/PI**2* - * HU**2*(-G1**2/3D0+G2**2)*TP - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C DLAMBDAP1 AND DLAMBDAP2 ARE THE NEW LOG CORRECTIONS DUE TO -C THE PRESENCE OF THE GLUINO MASS. THEY ARE IN GENERAL VERY SMALL, -C AND ONLY PRESENT IF THERE IS A HIERARCHY OF MASSES BETWEEN THE -C TWO STOPS. -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DLAMBDAP2 = 0D0 - IF(MGLU.LT.MUR.OR.MGLU.LT.MQ) THEN - IF(MQ.GT.MUR.AND.MGLU.GT.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TGLU**2) - ENDIF - - IF(MQ.GT.MUR.AND.MGLU.LT.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) - ENDIF - - IF(MQ.GT.MUR.AND.MGLU.EQ.MUR) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TQ**2-TU**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.GT.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TGLU**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.LT.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) - ENDIF - - IF(MUR.GT.MQ.AND.MGLU.EQ.MQ) THEN - DLAMBDAP2 = -4D0/(16D0*PI**2)**2*HU**4*(TU**2-TQ**2) - ENDIF - ENDIF - DLAMBDA3 = 0D0 - DLAMBDA4 = 0D0 - IF(MQ.GT.MD) DLAMBDA3 = -1D0/32D0/PI**2*G1**2*HD**2*TPD - IF(MQ.LT.MD.OR.MQ.EQ.MD) DLAMBDA3 = 3D0/64D0/PI**2*HD**2* - *(G2**2-G1**2/3D0)*TPD - IF(MQ.GT.MUR) DLAMBDA3 = DLAMBDA3 - - *1D0/16D0/PI**2*G1**2*HU**2*TP - IF(MQ.LT.MUR.OR.MQ.EQ.MUR) DLAMBDA3 = DLAMBDA3 + - * 3D0/64D0/PI**2*HU**2*(G2**2+G1**2/3D0)*TP - IF(MQ.LT.MUR) DLAMBDA4 = -3D0/32D0/PI**2*G2**2*HU**2*TP - IF(MQ.LT.MD) DLAMBDA4 = DLAMBDA4 - 3D0/32D0/PI**2*G2**2* - *HD**2*TPD - LAMBDA1 = ((G1**2 + G2**2)/4D0)* - * (1D0-3D0*HD**2*(TPD + TDPD)/8D0/PI**2) - *+(3D0*HD**4D0/16D0/PI**2) *TPD*(1D0 - *+ (3D0*HD**2/2D0 + HU**2/2D0 - *- 8D0*G3**2) * (TPD + 2D0*TDPD)/16D0/PI**2) - *+(3D0*HD**4D0/8D0/PI**2) *TDPD*(1D0 + (3D0*HD**2/2D0 + HU**2/2D0 - *- 8D0*G3**2) * TDPD/16D0/PI**2) + DLAMBDA1 - LAMBDA2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU**2* - *(TP + TDP)/8D0/PI**2) - *+(3D0*HU**4D0/16D0/PI**2) *TP*(1D0 - *+ (3D0*HU**2/2D0 + HD**2/2D0 - *- 8D0*G3**2) * (TP + 2D0*TDP)/16D0/PI**2) - *+(3D0*HU**4D0/8D0/PI**2) *TDP*(1D0 + (3D0*HU**2/2D0 + HD**2/2D0 - *- 8D0*G3**2) * TDP/16D0/PI**2) + DLAMBDA2 + DLAMBDAP2 - LAMBDA3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* - *(HU**2)*(TP + TDP)/16D0/PI**2 -3D0* - *(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA3 - LAMBDA4 = (- G2**2/2D0)*(1D0 - *-3D0*(HU**2)*(TP + TDP)/16D0/PI**2 - *-3D0*(HD**2)*(TPD + TDPD)/16D0/PI**2) +DLAMBDA4 - - LAMBDA5 = 0D0 - LAMBDA6 = 0D0 - LAMBDA7 = 0D0 - - M2(1,1) = 2D0*V**2*(LAMBDA1*COSB**2+2D0*LAMBDA6* - *COSB*SINB + LAMBDA5*SINB**2) + MA**2*SINB**2 - - M2(2,2) = 2D0*V**2*(LAMBDA5*COSB**2+2D0*LAMBDA7* - *COSB*SINB + LAMBDA2*SINB**2) + MA**2*COSB**2 - M2(1,2) = 2D0*V**2*(LAMBDA6*COSB**2+(LAMBDA3+LAMBDA4)* - *COSB*SINB + LAMBDA7*SINB**2) - MA**2*SINB*COSB - - M2(2,1) = M2(1,2) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC THIS IS THE CONTRIBUTION FROM LIGHT CHARGINOS/NEUTRALINOS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - MSSUSY=DSQRT(.5D0*(MQ**2+MUR**2)+MTOP**2) - - IF(MCHI.GT.MSSUSY) GOTO 100 - IF(MCHI.LT.MTOP) MCHI=MTOP - - TCHAR=LOG(MSSUSY**2/MCHI**2) - - DELTAL12=(9D0/64D0/PI**2*G2**4+5D0/192D0/PI**2*G1**4)*TCHAR - DELTAL3P4=(3D0/64D0/PI**2*G2**4+7D0/192D0/PI**2*G1**4 - *+4D0/32D0/PI**2*G1**2*G2**2)*TCHAR - - DELTAM112=2D0*DELTAL12*V**2*COSB**2 - DELTAM222=2D0*DELTAL12*V**2*SINB**2 - DELTAM122=2D0*DELTAL3P4*V**2*SINB*COSB - - M2(1,1)=M2(1,1)+DELTAM112 - M2(2,2)=M2(2,2)+DELTAM222 - M2(1,2)=M2(1,2)+DELTAM122 - M2(2,1)=M2(2,1)+DELTAM122 - - 100 CONTINUE - -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -CCC END OF CHARGINOS/NEUTRALINOS -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - - DO 120 I = 1,2 - DO 110 J = 1,2 - M2P(I,J) = M2(I,J) + VH(I,J) - 110 CONTINUE - 120 CONTINUE - TRM2P = M2P(1,1) + M2P(2,2) - DETM2P = M2P(1,1)*M2P(2,2) - M2P(1,2)*M2P(2,1) - MH2P = (TRM2P - DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 - HM2P = (TRM2P + DSQRT(TRM2P**2 - 4D0* DETM2P))/2D0 - HMP = DSQRT(HM2P) - MCH2=MA**2+(LAMBDA5-LAMBDA4)*V**2 - MCH=DSQRT(MCH2) - IF(MH2P.LT.0.) GOTO 130 - MHP = SQRT(MH2P) - SIN2ALPHA = 2D0*M2P(1,2)/SQRT(TRM2P**2-4D0*DETM2P) - COS2ALPHA = (M2P(1,1)-M2P(2,2))/SQRT(TRM2P**2-4D0*DETM2P) - IF(COS2ALPHA.GE.0.) THEN - ALPHA = ASIN(SIN2ALPHA)/2D0 - ELSE - ALPHA = -PI/2D0-ASIN(SIN2ALPHA)/2D0 - ENDIF - SA = SIN(ALPHA) - CA = COS(ALPHA) -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC -C -C HERE THE VALUES OF SAB AND CAB ARE DEFINED, IN ORDER -C TO DEFINE THE NEW COUPLINGS OF THE LIGHTEST AND -C HEAVY CP-EVEN HIGGS TO THE BOTTOM QUARK. -C -C -CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC - SAB = SA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0+CA/SA/TANB)) - CAB = CA*(1D0-DELTAMB/(1D0+DELTAMB)*(1D0-SA/CA/TANB)) - 130 CONTINUE - RETURN - END - -C********************************************************************* - -C...PYRNM3 -C...Calculates the running of M3, the SU(3) gluino mass parameter. - - FUNCTION PYRNM3(RGUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION R - DOUBLE PRECISION TOL - EXTERNAL PYALPS - DOUBLE PRECISION PYALPS - DATA TOL/0.001D0/ - DATA R/0.61803399D0/ - - C=1D0-R - - BX=RGUT*PYALPS(RGUT**2) - AX=MIN(50D0,BX*0.5D0) - CX=MAX(2000D0,2D0*BX) - - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - AS1=PYALPS(X1**2) - F1=ABS(X1-RGUT*AS1) - AS2=PYALPS(X2**2) - F2=ABS(X2-RGUT*AS2) - 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN - IF(F2.LT.F1) THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - AS2=PYALPS(X2**2) - F2=ABS(X2-RGUT*AS2) - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - AS1=PYALPS(X1**2) - F1=ABS(X1-RGUT*AS1) - ENDIF - GOTO 100 - ENDIF - IF(F1.LT.F2) THEN - PYRNM3=X1 - XMIN=X1 - ELSE - PYRNM3=X2 - XMIN=X2 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRNMQ -C...Determines the running mass of Squarks. - - FUNCTION PYRNMQ(ID,DTERM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblock. - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - SAVE /PYMSSM/ - -C...Local variables. - DOUBLE PRECISION PI,R - DOUBLE PRECISION TOL - DOUBLE PRECISION CI(3) - EXTERNAL PYALPS - DOUBLE PRECISION PYALPS - DATA TOL/0.001D0/ - DATA PI,R/3.141592654D0,.61803399D0/ - DATA CI/0.47D0,0.07D0,0.02D0/ - - C=1D0-R - CA=CI(ID) - AG=(0.71D0)**2/4D0/PI - AG=RMSS(20) - XM0=RMSS(8) - XMG=RMSS(1) - XM02=XM0*XM0 - XMG2=XMG*XMG - - AS=PYALPS(XM02+6D0*XMG2) - CG=8D0/9D0*((AS/AG)**2-1D0) - BX=XM02+(CA+CG)*XMG2+DTERM - AX=MIN(50D0**2,0.5D0*BX) - CX=MAX(2000D0**2,2D0*BX) - - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - AS1=PYALPS(X1) - CG=8D0/9D0*((AS1/AG)**2-1D0) - F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) - AS2=PYALPS(X2) - CG=8D0/9D0*((AS2/AG)**2-1D0) - F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) - 100 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2))) THEN - IF(F2.LT.F1) THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - AS2=PYALPS(X2) - CG=8D0/9D0*((AS2/AG)**2-1D0) - F2=ABS(XM02+(CA+CG)*XMG2+DTERM-X2) - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - AS1=PYALPS(X1) - CG=8D0/9D0*((AS1/AG)**2-1D0) - F1=ABS(XM02+(CA+CG)*XMG2+DTERM-X1) - ENDIF - GOTO 100 - ENDIF - IF(F1.LT.F2) THEN - PYRNMQ=X1 - XMIN=X1 - ELSE - PYRNMQ=X2 - XMIN=X2 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYROBO -C...Performs rotations and boosts. - - SUBROUTINE PYROBO(IMI,IMA,THE,PHI,BEX,BEY,BEZ) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ -C...Local arrays. - DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) - -C...Find and check range of rotation/boost. - IMIN=IMI - IF(IMIN.LE.0) IMIN=1 - IF(MSTU(1).GT.0) IMIN=MSTU(1) - IMAX=IMA - IF(IMAX.LE.0) IMAX=N - IF(MSTU(2).GT.0) IMAX=MSTU(2) - IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN - CALL PYERRM(11,'(PYROBO:) range outside PYJETS memory') - RETURN - ENDIF - -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)=0D0 - 100 CONTINUE - 110 CONTINUE - MSTU(33)=0 - ENDIF - -C...Rotate, typically from z axis to direction (theta,phi). - IF(THE**2+PHI**2.GT.1D-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)=0D0 - ROT(3,3)=COS(THE) - DO 140 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 140 - DO 120 J=1,3 - PR(J)=P(I,J) - VR(J)=V(I,J) - 120 CONTINUE - DO 130 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) - 130 CONTINUE - 140 CONTINUE - ENDIF - -C...Boost, typically from rest to momentum/energy=beta. - IF(BEX**2+BEY**2+BEZ**2.GT.1D-20) THEN - DBX=BEX - DBY=BEY - DBZ=BEZ - DB=SQRT(DBX**2+DBY**2+DBZ**2) - EPS1=1D0-1D-12 - IF(DB.GT.EPS1) THEN -C...Rescale boost vector if too close to unity. - CALL PYERRM(3,'(PYROBO:) boost vector too large') - DBX=DBX*(EPS1/DB) - DBY=DBY*(EPS1/DB) - DBZ=DBZ*(EPS1/DB) - DB=EPS1 - ENDIF - DGA=1D0/SQRT(1D0-DB**2) - DO 160 I=IMIN,IMAX - IF(K(I,1).LE.0) GOTO 160 - DO 150 J=1,4 - DP(J)=P(I,J) - DV(J)=V(I,J) - 150 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) - 160 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRSET -C...Reads a state of the random number generator from a file -C...for subsequent generation from this state onwards. - - SUBROUTINE PYRSET(LFN,MOVE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDATR/MRPY(6),RRPY(100) - SAVE /PYDATR/ -C...Local character variable. - CHARACTER CHERR*8 - -C...Backspace required number of records (or as many as there are). - IF(MOVE.LT.0) THEN - NBCK=MIN(MRPY(6),-MOVE) - DO 100 IBCK=1,NBCK - BACKSPACE(LFN,ERR=120,IOSTAT=IERR) - 100 CONTINUE - MRPY(6)=MRPY(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) (MRPY(I1),I1=1,5), - & (RRPY(I2),I2=1,100) - 110 CONTINUE - MRPY(6)=MRPY(6)+NFOR - RETURN - -C...Write error. - 120 WRITE(CHERR,'(I8)') IERR - CALL PYERRM(18,'(PYRSET:) error when accessing file, IOSTAT ='// - &CHERR) - - RETURN - END - -C********************************************************************* - -C...PYRVCH -C...Calculates R-violating chargino decay widths. -C...P. Z. Skands - - SUBROUTINE PYRVCH(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP -C...Information from main routine to PYRVGW - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) -C...Auxiliary variables needed for BV (RV Gauge STOre) - COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ - & ,RVLJKI,RVLJIK -C...Running quark masses - DOUBLE PRECISION RMQ(6) -C...Decay product masses on/off - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, - & /RVGSTO/ - - -C...IF R-VIOLATION ON. - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN - KFSM=KFIN-KSUSY1 - IF(KFSM.EQ.24.OR.KFSM.EQ.37) THEN -C...WHICH CHARGINO ? - NCHI = 1 - IF (KFSM.EQ.37) NCHI = 2 - -C...Useful parameters for calculating the A and B constants. -C...SIGN OF MASS (Opposite convention as HERWIG) - ISM = 1 - IF (SMW(NCHI).LT.0D0) ISM = -1 - WMASS = PMAS(PYCOMP(24),1) - COSB = 1/(SQRT(1+RMSS(5)**2)) - SINB = RMSS(5)/SQRT(1+RMSS(5)**2) - GW2 = 4*PARU(103)*PARU(1)/PARU(102) - C1U = UMIX(NCHI,2)/(SQRT(2D0)*COSB*WMASS) - C1V = VMIX(NCHI,2)/(SQRT(2D0)*SINB*WMASS) - C2 = UMIX(NCHI,1) - C3 = VMIX(NCHI,1) -C...Running masses at Q^2=MCHI^2. - SQMCHI = PMAS(PYCOMP(KFSM),1)**2 - DO 100 I=1,6 - RMQ(I)=PYMRUN(I,SQMCHI) - 100 CONTINUE - -C... AB(x,y,z) coefficients: -C x=1-2 : A or B coefficient (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,...) -C z=1-2 : Mass eigenstate number - DO 110 I = 11,15,2 -C...Intermediate sleptons - AB(1,I,1) = 0D0 - AB(1,I,2) = 0D0 - AB(2,I,1) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,2) + - & SFMIX(I,1)*C2 - AB(2,I,2) = -PMAS(PYCOMP(I),1)*C1U*SFMIX(I,4) + - & SFMIX(I,3)*C2 -C...Intermediate sneutrinos - AB(1,I+1,1) = -PMAS(PYCOMP(I),1)*C1U - AB(1,I+1,2) = 0D0 - AB(2,I+1,1) = ISM*C3 - AB(2,I+1,2) = 0D0 -C...Intermediate sdown - J=I-10 - AB(1,J,1) = -RMQ(J+1)*C1V*SFMIX(J,1) - AB(1,J,2) = -RMQ(J+1)*C1V*SFMIX(J,3) - AB(2,J,1) = -ISM*(RMQ(J)*C1U*SFMIX(J,2) - SFMIX(J,1)*C2) - AB(2,J,2) = -ISM*(RMQ(J)*C1U*SFMIX(J,4) - SFMIX(J,3)*C2) -C...Intermediate sup - J=J+1 - AB(1,J,1) = -RMQ(J-1)*C1U*SFMIX(J,1) - AB(1,J,2) = -RMQ(J-1)*C1U*SFMIX(J,3) - AB(2,J,1) = -ISM*(RMQ(J)*C1V*SFMIX(J,2) - SFMIX(J,1)*C3) - AB(2,J,2) = -ISM*(RMQ(J)*C1V*SFMIX(J,4) - SFMIX(J,3)*C3) - 110 CONTINUE - -C...LLE TYPE R-VIOLATION - IF (IMSS(51).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 140 ISC=0,26 - -C...CHI+ -> NUBAR_I + LEPTON+_J + NU_K. - IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 12 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K). - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = -IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> NU_I + NU_J + LEPTON+_K. (NOTE: SYMM. IN I AND J) - 120 IF (MOD(ISC/9,3).LT.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 12 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) =-11 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 -C...I,J SYMMETRY => FACTOR 2 - RVLAMC=2*RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,3).EQ.-15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=IDLAM(LKNT,1)-1 - KFR(2)=IDLAM(LKNT,2)-1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 130 ENDIF - -C * CHI+ -> LEPTON+_I + LEPTON+_J + LEPTON-_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = GW2 * 5D-1 * - & RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 -C...I,J SYMMETRY => FACTOR 2 - RVLAMC=2*RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-15 - & .OR.IDLAM(LKNT,3).EQ.15) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) =-IDLAM(LKNT,1)+1 - KFR(2) =-IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 140 CONTINUE - ENDIF - -C...LQD TYPE R-VIOLATION - IF (IMSS(52).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 180 ISC=0,26 - -C...CHI+ -> NUBAR_I + DBAR_J + U_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.6) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=0 - KFR(2)=0 - KFR(3)=-IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> LEPTON+_I + UBAR_J + U_K. - 150 LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 2 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-11.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.6) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=0 - KFR(2)=0 - KFR(3)=-IDLAM(LKNT,3)+1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> LEPTON+_I + DBAR_J + D_K. - 160 LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1)+1 - KFR(2)=-IDLAM(LKNT,2)+1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - -C * CHI+ -> NU_I + U_J + DBAR_K. - 170 LKNT = LKNT+1 - IDLAM(LKNT,1) = 12 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - DCMASS = .FALSE. - RVLAMC = 3. * GW2 * 5D-1 * - & RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - IF (IDLAM(LKNT,2).EQ.6.OR.IDLAM(LKNT,3).EQ.-5) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=IDLAM(LKNT,1)-1 - KFR(2)=IDLAM(LKNT,2)-1 - KFR(3)=0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - - 180 CONTINUE - ENDIF - -C...UDD TYPE R-VIOLATION -C...These decays need special treatment since more than one BV coupling -C...contributes (with interference). Consider e.g. (symbolically) -C |M|^2 = |l''_{ijk}|^2*(PYRVI1(RES_I) + PYRVI2(RES_I)) -C +|l''_{jik}|^2*(PYRVI1(RES_J) + PYRVI2(RES_J)) -C +l''_{ijk}*l''_{jik}*PYRVI3(PYRVI4(RES_I,RES_J)) -C...The problem is that a single call to PYRVGW would evaluate all -C...these terms and sum them, but without the different couplings. The -C...way out is to call PYRVGW three times, once for the first line, once -C...for the second line, and then once for all the lines (it is -C...impossible to get just the last line out) without multiplying by -C...couplings. The last line is then obtained as the result of the third -C...call minus the results of the two first calls. Each term is then -C...multiplied by its respective coupling before the whole thing is -C...summed up in XLAM. -C...Note that with three interfering resonances, this procedure becomes -C...more complicated, as can be seen in the CHI+ -> 3*DBAR mode. - - IF (IMSS(53).GE.1) THEN -C...LOOP OVER DECAY MODES - DO 190 ISC=1,25 - -C...CHI+ -> U_I + U_J + D_K -C...Decay mode I<->J symmetric. - IF (MOD(ISC/9,3).LE.MOD(ISC/3,3).AND.ISC.NE.13) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = 2 +2*MOD(ISC/9,3) - IDLAM(LKNT,2) = 2 +2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC= 6. * GW2 * 5D-1 - RVLJIK= RVLAMB(MOD(ISC/3,3)+1,MOD(ISC/9,3)+1,MOD(ISC,3) - & +1) - RVLIJK= RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) - & +1) - IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3)) RVLAMC = 5D-1 - & * RVLAMC - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.6.OR.IDLAM(LKNT,2).EQ.6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS =.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = -IDLAM(LKNT,1)+1 - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = -IDLAM(LKNT,1)+1 - KFR(2) = -IDLAM(LKNT,2)+1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIJ) - IF (ABS((XRESI+XRESJ)/XRESIJ-1.).GT.1D-4) THEN - XRESIJ = XRESIJ-XRESI-XRESJ - ELSE - XRESIJ = 0D0 - ENDIF -C...CALCULATE TOTAL WIDTH - XLAM(LKNT) = RVLJIK**2 * XRESI + RVLIJK**2 * XRESJ - & + RVLJIK*RVLIJK * XRESIJ - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF -C...CHI+ -> DBAR_I + DBAR_J + DBAR_K -C...Symmetry I<->J<->K. - IF ((MOD(ISC/9,3).LE.MOD(ISC/3,3)).AND.(MOD(ISC/3,3).LE - & .MOD(ISC,3)).AND.ISC.NE.13) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -1 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 6. * GW2 * 5D-1 - RVLIJK = RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3) - & +1) - RVLKIJ = RVLAMB(MOD(ISC,3)+1,MOD(ISC/9,3)+1,MOD(ISC/3,3) - & +1) - RVLJKI = RVLAMB(MOD(ISC/3,3)+1,MOD(ISC,3)+1,MOD(ISC/9,3) - & +1) - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-5.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS = .TRUE. -C...Collect symmetry factors - IF (MOD(ISC/9,3).EQ.MOD(ISC/3,3).OR.MOD(ISC/3,3).EQ - & .MOD(ISC,3).OR.MOD(ISC/9,3).EQ.MOD(ISC,3)) - & RVLAMC = 5D-1 * RVLAMC -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESK) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIJ) - IF (ABS(XRESIJ/(XRESI+XRESJ)-1.).GT.1D-4) THEN - XRESIJ = XRESI+XRESJ-XRESIJ - ELSE - XRESIJ = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2)-1 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESJK) - IF (ABS(XRESJK/(XRESJ+XRESK)-1.).GT.1D-4) THEN - XRESJK = XRESJ+XRESK-XRESJK - ELSE - XRESJK = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1)-1 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3)-1 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XRESIK) - IF (ABS(XRESIK/(XRESI+XRESK)-1.).GT.1D-4) THEN - XRESIK = XRESI+XRESK-XRESIK - ELSE - XRESIK = 0D0 - ENDIF -C...CALCULATE TOTAL WIDTH - XLAM(LKNT) = - & RVLIJK**2 * XRESI - & + RVLJKI**2 * XRESJ - & + RVLKIJ**2 * XRESK - & + RVLIJK*RVLJKI * XRESIJ - & + RVLIJK*RVLKIJ * XRESIK - & + RVLJKI*RVLKIJ * XRESJK - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2.*PARU(1)*RMS(0))**3*32) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 190 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRVG1 -C...Integrand for resonance contributions - - FUNCTION PYRVG1(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY,PYRVR - DOUBLE PRECISION RVR,PYRVG1,E2,E3,C1,SR1,SR2,A1,A2 - LOGICAL MFLAG - SAVE/PYRVPM/ - RVR = PYRVR(X,RESM(1),RESW(1)) - C1 = 2D0*SQRT(MAX(0D0,X)) - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - DELTAY = 4D0*E2*E3 - PYRVG1 = DELTAY*RVR*X*(A(1)**2+B(1)**2)*(RM(0)**2-X) - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - DELTAY = 4D0*SR1*SR2 - A1 = 4.*A(1)*B(1)*RM(3)*RM(0) - A2 = (A(1)**2+B(1)**2)*(RM(0)**2+RM(3)**2-X) - PYRVG1 = DELTAY*RVR*(X-RM(1)**2-RM(2)**2)*(A1+A2) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVG2 -C...Integrand for L-R interference contributions - - FUNCTION PYRVG2(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - DOUBLE PRECISION X, RM, A, B, RESM, RESW, DELTAY, PYRVS - DOUBLE PRECISION RVS,PYRVG2,E2,E3,C1,SR1,SR2 - LOGICAL MFLAG - SAVE/PYRVPM/ - C1 = 2D0*SQRT(MAX(0D0,X)) - RVS = PYRVS(X,X,RESM(1),RESW(1),RESM(2),RESW(2)) - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - DELTAY = 4D0*E2*E3 - PYRVG2 = DELTAY*RVS*X*(A(1)*A(2)+B(1)*B(2))*(RM(0)**2-X) - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - DELTAY = 4D0*SR1*SR2 - PYRVG2 = DELTAY*RVS*(X-RM(1)**2-RM(2)**2)*((A(1)*A(2) - & + B(1)*B(2))*(RM(0)**2+RM(3)**2-X) - & + 2D0*(A(1)*B(2)+A(2)*B(1))*RM(3)*RM(0)) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVG3 -C...Function to do Y integration over true interference contributions - - FUNCTION PYRVG3(X) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG -C...Second Dalitz variable for PYRVG4 - COMMON/PYG2DX/X1 - DOUBLE PRECISION RM, A, B, RESM, RESW, X, X1 - DOUBLE PRECISION E2, E3, C1, SQ1, SR1, SR2, YMIN, YMAX - DOUBLE PRECISION PYRVG3, PYRVG4, PYGAU2 - LOGICAL MFLAG - EXTERNAL PYGAU2,PYRVG4 - SAVE/PYRVPM/,/PYG2DX/ - PYRVG3=0D0 - C1=2D0*SQRT(MAX(1D-9,X)) - X1=X - IF (.NOT.MFLAG) THEN - E2 = X/C1 - E3 = (RM(0)**2-X)/C1 - YMIN = 0D0 - YMAX = 4D0*E2*E3 - ELSE - E2 = (X-RM(1)**2+RM(2)**2)/C1 - E3 = (RM(0)**2-X-RM(3)**2)/C1 - SQ1 = (E2+E3)**2 - SR1 = SQRT(MAX(0D0,E2**2-RM(2)**2)) - SR2 = SQRT(MAX(0D0,E3**2-RM(3)**2)) - YMIN = SQ1-(SR1+SR2)**2 - YMAX = SQ1-(SR1-SR2)**2 - ENDIF - PYRVG3 = PYGAU2(PYRVG4,YMIN,YMAX,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVG4 -C...Integrand for true intereference contributions - - FUNCTION PYRVG4(Y) - - IMPLICIT NONE - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - COMMON/PYG2DX/X - DOUBLE PRECISION X, Y, PYRVG4, RM, A, B, RESM, RESW, RVS, PYRVS - LOGICAL MFLAG - SAVE /PYRVPM/,/PYG2DX/ - PYRVG4=0D0 - RVS=PYRVS(X,Y,RESM(1),RESW(1),RESM(2),RESW(2)) - IF (.NOT.MFLAG) THEN - PYRVG4 = RVS*B(1)*B(2)*X*Y - ELSE - PYRVG4 = RVS*(RM(1)*RM(3)*A(1)*A(2)*(X+Y-RM(1)**2-RM(3)**2) - & + RM(1)*RM(0)*B(1)*A(2)*(Y-RM(2)**2-RM(3)**2) - & + RM(3)*RM(0)*A(1)*B(2)*(X-RM(1)**2-RM(2)**2) - & + B(1)*B(2)*(X*Y-(RM(1)*RM(3))**2-(RM(0)*RM(2))**2)) - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVGL -C...Calculates R-violating gluino decay widths. -C...See BV part of PYRVCH for comments about the way the BV decay width -C...is calculated. Same comments apply here. -C...P. Z. Skands - - SUBROUTINE PYRVGL(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP -C...Information from main routine to PYRVGW - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) -C...Auxiliary variables needed for BV (RV Gauge STOre) - COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ - & ,RVLJKI,RVLJIK -C...Running quark masses - DOUBLE PRECISION RMQ(6) -C...Decay product masses on/off - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/, - & /RVGSTO/ - -C...IF LQD OR UDD TYPE R-VIOLATION ON. - IF (IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - KFSM=KFIN-KSUSY1 - -C... AB(x,y,z): -C x=1-2 : Select A or B coupling (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,... not used here) -C z=1-2 : Mass eigenstate number - DO 100 I = 1,6 -C...A Couplings - AB(1,I,1) = SFMIX(I,2) - AB(1,I,2) = SFMIX(I,4) -C...B Couplings - AB(2,I,1) = -SFMIX(I,1) - AB(2,I,2) = -SFMIX(I,3) - 100 CONTINUE - GSTR2 = 4D0*PARU(1) * PYALPS(PMAS(PYCOMP(KFIN),1)**2) -C...LQD DECAYS. - IF (IMSS(52).GE.1) THEN -C...STEP IN I,J,K USING SINGLE COUNTER - DO 120 ISC=0,26 -C * GLUINO -> NUBAR_I + DBAR_J + D_K. - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off - RVLAMC=RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2 - & * 5D-1 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2) - KFR(3) = -IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) -C...Normalize - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - 110 LKNT = LKNT+1 - IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) - IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) - IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - -C * GLUINO -> LEPTON+_I + UBAR_J + D_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2* 5D-1 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = -IDLAM(LKNT,2) - KFR(3) = -IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1) = -IDLAM(LKNT-1,1) - IDLAM(LKNT,2) = -IDLAM(LKNT-1,2) - IDLAM(LKNT,3) = -IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - - 120 CONTINUE - ENDIF - -C...UDD DECAYS. - IF (IMSS(53).GE.1) THEN -C...STEP IN I,J,K USING SINGLE COUNTER - DO 130 ISC=0,26 -C * GLUINO -> UBAR_I + DBAR_J + DBAR_K. - IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT)=0D0 -C...Set coupling, and decay product masses on/off. A factor of 2 for -C...(N_C-1) has been used to cancel a factor 0.5. - RVLAMC=RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1) - & **2 * GSTR2 - DCMASS = .FALSE. - IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = 0 - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESI) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2) - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESJ) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESK) -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = IDLAM(LKNT,2) - KFR(3) = 0 -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESIJ) -C...Calculate interference function. (Factor -1/2 to make up for factor -C...-2 in PYRVGW. - IF (ABS((XRESI+XRESJ)/XRESIJ-1D0).GT.1D-4) THEN - XRESIJ = 5D-1 * (XRESI+XRESJ-XRESIJ) - ELSE - XRESIJ = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = 0 - KFR(2) = IDLAM(LKNT,2) - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESJK) - IF (ABS((XRESJ+XRESK)/XRESJK-1).GT.1D-4) THEN - XRESJK = 5D-1 * (XRESJ+XRESK-XRESJK) - ELSE - XRESJK = 0D0 - ENDIF -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = 0 - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XRESIK) - IF (ABS((XRESI+XRESK)/XRESIK-1).GT.1D-4) THEN - XRESIK = 5D-1 * (XRESI+XRESK-XRESIK) - ELSE - XRESIK = 0D0 - ENDIF -C...Calculate total width (factor 1/2 from 1/(N_C-1)) - XLAM(LKNT) = XRESI + XRESJ + XRESK - & + 5D-1 * (XRESIJ + XRESIK + XRESJK) -C...Normalize - XLAM(LKNT) = XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT = LKNT+1 - IDLAM(LKNT,1) =-IDLAM(LKNT-1,1) - IDLAM(LKNT,2) =-IDLAM(LKNT-1,2) - IDLAM(LKNT,3) =-IDLAM(LKNT-1,3) - XLAM(LKNT) = XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - ENDIF - RETURN - END - -C********************************************************************* - -C...PYRVGW -C...Generalized Matrix Element for R-Violating 3-body widths. -C...P. Z. Skands - SUBROUTINE PYRVGW(KFIN,ID1,ID2,ID3,XLAM) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - IMPLICIT INTEGER (I-N) - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - PARAMETER (EPS=1D-4) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - & SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - DOUBLE PRECISION XLIM(3,3) - INTEGER KC(0:3), PYCOMP - LOGICAL DCMASS, DCHECK(6) - SAVE /PYDAT2/,/PYRVNV/,/PYSSMT/ - - XLAM = 0D0 - - KC(0) = PYCOMP(KFIN) - KC(1) = PYCOMP(ID1) - KC(2) = PYCOMP(ID2) - KC(3) = PYCOMP(ID3) - RMS(0) = PMAS(KC(0),1) - RMS(1) = PYMRUN(ID1,PMAS(KC(1),1)**2) - RMS(2) = PYMRUN(ID2,PMAS(KC(2),1)**2) - RMS(3) = PYMRUN(ID3,PMAS(KC(3),1)**2) -C...INITIALIZE OUTER INTEGRATION LIMITS AND KINEMATICS CHECK - XLIM(1,1)=(RMS(1)+RMS(2))**2 - XLIM(1,2)=(RMS(0)-RMS(3))**2 - XLIM(1,3)=XLIM(1,2)-XLIM(1,1) - XLIM(2,1)=(RMS(2)+RMS(3))**2 - XLIM(2,2)=(RMS(0)-RMS(1))**2 - XLIM(2,3)=XLIM(2,2)-XLIM(2,1) - XLIM(3,1)=(RMS(1)+RMS(3))**2 - XLIM(3,2)=(RMS(0)-RMS(2))**2 - XLIM(3,3)=XLIM(3,2)-XLIM(3,1) -C...Check Phase Space - IF (XLIM(1,3).LT.0D0.OR.XLIM(2,3).LT.0D0.OR.XLIM(3,3).LT.0D0) THEN - RETURN - ENDIF - -C...INITIALIZE RESONANCE INFORMATION - DO 110 JRES = 1,3 - DO 100 IMASS = 1,2 - IRES = 2*(JRES-1)+IMASS - INTRES(IRES,1) = 0 - DCHECK(IRES) =.FALSE. -C...NO RIGHT-HANDED NEUTRINOS - IF (((IMASS.EQ.2).AND.((IABS(KFR(JRES)).EQ.12).OR - & .(IABS(KFR(JRES)).EQ.14).OR.(IABS(KFR(JRES)).EQ.16))).OR - & .KFR(JRES).EQ.0) GOTO 100 - RES(IRES,1) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),1) - RES(IRES,2) = PMAS(PYCOMP(IMASS*KSUSY1+IABS(KFR(JRES))),2) - INTRES(IRES,1) = IABS(KFR(JRES)) - INTRES(IRES,2) = IMASS - IF (KFR(JRES).LT.0) INTRES(IRES,3) = 1 - IF (KFR(JRES).GT.0) INTRES(IRES,3) = 0 - 100 CONTINUE - 110 CONTINUE - -C...SUM OVER DIAGRAMS AND INTEGRATE OVER PHASE SPACE - -C...RESONANCE CONTRIBUTIONS -C...(Only sum contributions where the resonance is off shell). -C...Store whether diagram on/off in DCHECK. -C...LOOP OVER MASS STATES - DO 120 J=1,2 - IDR=J - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(1)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(2) - & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(2,3,1) - ENDIF - - IDR=J+2 - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(2)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) - & +RMS(3)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(1,3,2) - ENDIF - - IDR=J+4 - TMIX = SFMIX(INTRES(IDR,1),2*J+INTRES(IDR,3)-1)**2 - IF ((RMS(0).LT.(RMS(3)+RES(IDR,1)).OR.(RES(IDR,1).LT.(RMS(1) - & +RMS(2)))).AND.TMIX.GT.EPS.AND.INTRES(IDR,1).NE.0) THEN - DCHECK(IDR) =.TRUE. - XLAM = XLAM + TMIX * PYRVI1(1,2,3) - ENDIF - 120 CONTINUE -C... L-R INTERFERENCES -C... (Only add contributions where both contributing diagrams -C... are non-resonant). - IDR=1 - IF (DCHECK(1).AND.DCHECK(2)) THEN -C...Bug corrected 11/12 2001. Skands. - XLAM = XLAM + 2D0 * PYRVI2(2,3,1) - & * SFMIX(INTRES(1,1),2+INTRES(1,3)-1) - & * SFMIX(INTRES(2,1),4+INTRES(2,3)-1) - ENDIF - - IDR=3 - IF (DCHECK(3).AND.DCHECK(4)) THEN - XLAM = XLAM + 2D0 * PYRVI2(1,3,2) - & * SFMIX(INTRES(3,1),2+INTRES(3,3)-1) - & * SFMIX(INTRES(4,1),4+INTRES(4,3)-1) - ENDIF - - IDR=5 - IF (DCHECK(5).AND.DCHECK(6)) THEN - XLAM = XLAM + 2D0 * PYRVI2(1,2,3) - & * SFMIX(INTRES(5,1),2+INTRES(5,3)-1) - & * SFMIX(INTRES(6,1),4+INTRES(6,3)-1) - ENDIF -C... TRUE INTERFERENCES -C... (Only add contributions where both contributing diagrams -C... are non-resonant). - PREF=-2D0 - IF ((KFIN-KSUSY1).EQ.24.OR.(KFIN-KSUSY1).EQ.37) PREF=2D0 - DO 140 IKR1 = 1,2 - DO 130 IKR2 = 1,2 - IDR = IKR1+2 - IDR2 = IKR2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(1,3,2) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - - IDR = IKR1+4 - IDR2 = IKR2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(1,2,3) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - - IDR = IKR1+4 - IDR2 = IKR2+2 - IF (DCHECK(IDR).AND.DCHECK(IDR2)) THEN - XLAM = XLAM + PREF*PYRVI3(2,1,3) * - & SFMIX(INTRES(IDR,1),2*IKR1+INTRES(IDR,3)-1) - & *SFMIX(INTRES(IDR2,1),2*IKR2+INTRES(IDR2,3)-1) - ENDIF - 130 CONTINUE - 140 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYRVI1 -C...Function to integrate resonance contributions - - FUNCTION PYRVI1(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI1,PYRVG1,PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG1,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI1 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) -C...A->B and B->A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) -C...Integration boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI1 = PYGAUS(PYRVG1,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVI2 -C...Function to integrate L-R interference contributions - - FUNCTION PYRVI2(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI2, PYRVG2, PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG2,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI2 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) - RESM(2)= RES(IDR+1,1) - RESW(2)= RES(IDR+1,2) -C...A->B and B->A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - A(2) = AB(1+INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) - B(2) = AB(2-INTRES(IDR+1,3),INTRES(IDR+1,1),INTRES(IDR+1,2)) -C...Boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI2 = PYGAUS(PYRVG2,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVI3 -C...Function to integrate true interference contributions - - FUNCTION PYRVI3(ID1,ID2,ID3) - - IMPLICIT NONE - DOUBLE PRECISION LO,HI,PYRVI3, PYRVG3, PYGAUS - DOUBLE PRECISION RES, AB, RM, RESM, RESW, A, B, RMS - INTEGER ID1,ID2,ID3, IDR, IDR2, KFR, INTRES - LOGICAL MFLAG,DCMASS - EXTERNAL PYRVG3,PYGAUS - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - COMMON/PYRVPM/RM(0:3),A(2),B(2),RESM(2),RESW(2),MFLAG - SAVE/PYRVNV/,/PYRVPM/ -C...Initialize mass and width information - PYRVI3 = 0D0 - RM(0) = RMS(0) - RM(1) = RMS(ID1) - RM(2) = RMS(ID2) - RM(3) = RMS(ID3) - RESM(1)= RES(IDR,1) - RESW(1)= RES(IDR,2) - RESM(2)= RES(IDR2,1) - RESW(2)= RES(IDR2,2) -C...A -> B and B -> A for antisparticles - A(1) = AB(1+INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - B(1) = AB(2-INTRES(IDR,3),INTRES(IDR,1),INTRES(IDR,2)) - A(2) = AB(1+INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) - B(2) = AB(2-INTRES(IDR2,3),INTRES(IDR2,1),INTRES(IDR2,2)) -C...Boundaries and mass flag - LO = (RM(1)+RM(2))**2 - HI = (RM(0)-RM(3))**2 - MFLAG = DCMASS - PYRVI3 = PYGAUS(PYRVG3,LO,HI,1D-3) - RETURN - END - -C********************************************************************* - -C...PYRVNE -C...Calculates R-violating neutralino decay widths (pure 1->3 parts). -C...P. Z. Skands - - SUBROUTINE PYRVNE(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2 - & ,DCMASS,KFR(3) - DOUBLE PRECISION XLAM(0:400) - DOUBLE PRECISION ZPMIX(4,4), NMIX(4,4), RMQ(6) - INTEGER IDLAM(400,3), PYCOMP - LOGICAL DCMASS - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/ - -C...R-VIOLATING DECAYS - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN - KFSM=KFIN-KSUSY1 - IF(KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN -C...WHICH NEUTRALINO ? - NCHI=1 - IF (KFSM.EQ.23) NCHI=2 - IF (KFSM.EQ.25) NCHI=3 - IF (KFSM.EQ.35) NCHI=4 -C...SIGN OF MASS (Opposite convention as HERWIG) - ISM = 1 - IF (SMZ(NCHI).LT.0D0) ISM = -ISM - -C...Useful parameters for the calculation of the A and B constants. - WMASS = PMAS(PYCOMP(24),1) - ECHG = 2*SQRT(PARU(103)*PARU(1)) - COSB=1/(SQRT(1+RMSS(5)**2)) - SINB=RMSS(5)/SQRT(1+RMSS(5)**2) - COSW=SQRT(1-PARU(102)) - SINW=SQRT(PARU(102)) - GW=2D0*SQRT(PARU(103)*PARU(1))/SINW -C...Run quark masses to neutralino mass squared (for Higgs-type -C...couplings) - SQMCHI=PMAS(PYCOMP(KFIN),1)**2 - DO 100 I=1,6 - RMQ(I)=PYMRUN(I,SQMCHI) - 100 CONTINUE -C...EXPRESS NEUTRALINO MIXING IN (photino,Zino,~H_u,~H_d) BASIS - DO 110 NCHJ=1,4 - ZPMIX(NCHJ,1)= ZMIX(NCHJ,1)*COSW+ZMIX(NCHJ,2)*SINW - ZPMIX(NCHJ,2)=-ZMIX(NCHJ,1)*SINW+ZMIX(NCHJ,2)*COSW - ZPMIX(NCHJ,3)= ZMIX(NCHJ,3) - ZPMIX(NCHJ,4)= ZMIX(NCHJ,4) - 110 CONTINUE - C1=GW*ZPMIX(NCHI,3)/(2D0*COSB*WMASS) - C1U=GW*ZPMIX(NCHI,4)/(2D0*SINB*WMASS) - C2=ECHG*ZPMIX(NCHI,1) - C3=GW*ZPMIX(NCHI,2)/COSW - EU=2D0/3D0 - ED=-1D0/3D0 -C... AB(x,y,z): -C x=1-2 : Select A or B constant (1:A ; 2:B) -C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ; -C 11-16:e,nu_e,mu,...) -C z=1-2 : Mass eigenstate number -C...CALCULATE COUPLINGS - DO 120 I = 11,15,2 - CMS=PMAS(PYCOMP(I),1) -C...Intermediate sleptons - AB(1,I,1)=ISM*(CMS*C1*SFMIX(I,1) + SFMIX(I,2) - & *(C2-C3*SINW**2)) - AB(1,I,2)=ISM*(CMS*C1*SFMIX(I,3) + SFMIX(I,4) - & *(C2-C3*SINW**2)) - AB(2,I,1)= CMS*C1*SFMIX(I,2) - SFMIX(I,1)*(C2+C3*(5D-1-SINW - & **2)) - AB(2,I,2)=CMS*C1*SFMIX(I,4) - SFMIX(I,3)*(C2+C3*(5D-1-SINW - & **2)) -C...Inermediate sneutrinos - AB(1,I+1,1)=0D0 - AB(2,I+1,1)=5D-1*C3 - AB(1,I+1,2)=0D0 - AB(2,I+1,2)=0D0 -C...Inermediate sdown - J=I-10 - CMS=RMQ(J) - AB(1,J,1)=ISM*(CMS*C1*SFMIX(J,1) - SFMIX(J,2) - & *ED*(C2-C3*SINW**2)) - AB(1,J,2)=ISM*(CMS*C1*SFMIX(J,3) - SFMIX(J,4) - & *ED*(C2-C3*SINW**2)) - AB(2,J,1)=CMS*C1*SFMIX(J,2) + SFMIX(J,1) - & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) - AB(2,J,2)=CMS*C1*SFMIX(J,4) + SFMIX(J,3) - & *(ED*C2-C3*(1D0/2D0+ED*SINW**2)) -C...Inermediate sup - J=J+1 - CMS=RMQ(J) - AB(1,J,1)=ISM*(CMS*C1U*SFMIX(J,1) - SFMIX(J,2) - & *EU*(C2-C3*SINW**2)) - AB(1,J,2)=ISM*(CMS*C1U*SFMIX(J,3) - SFMIX(J,4) - & *EU*(C2-C3*SINW**2)) - AB(2,J,1)=CMS*C1U*SFMIX(J,2) + SFMIX(J,1) - & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) - AB(2,J,2)=CMS*C1U*SFMIX(J,4) + SFMIX(J,3) - & *(EU*C2+C3*(1D0/2D0-EU*SINW**2)) - 120 CONTINUE - - IF (IMSS(51).GE.1) THEN -C...LAMBDA COUPLINGS (LLE TYPE R-VIOLATION) -C * CHI0_I -> NUBAR_I + LEPTON+_J + lEPTON-_K. -C...STEP IN I,J,K USING SINGLE COUNTER - DO 130 ISC=0,26 -C...LAMBDA COUPLING ASYM IN I,J - IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 11 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-15.OR.IDLAM(LKNT,3).EQ.15) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 130 CONTINUE - ENDIF - - IF (IMSS(52).GE.1) THEN -C...LAMBDA' COUPLINGS. (LQD TYPE R-VIOLATION) -C * CHI0 -> NUBAR_I + DBAR_J + D_K - DO 140 ISC=0,26 - LKNT = LKNT+1 - IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) - & DCMASS = .TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - -C * CHI0 -> LEPTON_I+ + UBAR_J + D_K - LKNT = LKNT+1 - IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = 1 +2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1 - & ,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6 - & .OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1)=-IDLAM(LKNT,1) - KFR(2)=-IDLAM(LKNT,2) - KFR(3)=-IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3) - & ,XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - 140 CONTINUE - ENDIF - - IF (IMSS(53).GE.1) THEN -C...LAMBDA'' COUPLINGS. (UDD TYPE R-VIOLATION) -C * CHI0 -> UBAR_I + DBAR_J + DBAR_K - DO 150 ISC=0,26 -C...Symmetry J<->K. Also, LAMB antisymmetric in J and K, so no J=K. - IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN - LKNT = LKNT+1 - IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3) - IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3) - IDLAM(LKNT,3) = -1 -2*MOD(ISC,3) - XLAM(LKNT) = 0D0 -C...Set coupling, and decay product masses on/off - RVLAMC = 6. * RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3) - & +1,MOD(ISC,3)+1)**2 - DCMASS=.FALSE. - IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5 - & .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE. -C...Resonance KF codes (1=I,2=J,3=K) - KFR(1) = IDLAM(LKNT,1) - KFR(2) = IDLAM(LKNT,2) - KFR(3) = IDLAM(LKNT,3) -C...Calculate width. - CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2), - & IDLAM(LKNT,3),XLAM(LKNT)) - XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32) -C...Charge conjugate mode. - LKNT=LKNT+1 - IDLAM(LKNT,1)=-IDLAM(LKNT-1,1) - IDLAM(LKNT,2)=-IDLAM(LKNT-1,2) - IDLAM(LKNT,3)=-IDLAM(LKNT-1,3) - XLAM(LKNT)=XLAM(LKNT-1) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-2 - ENDIF - ENDIF - 150 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYRVR -C...Breit-Wigner for resonance contributions - - FUNCTION PYRVR(Mab2,RM,RW) - - IMPLICIT NONE - DOUBLE PRECISION Mab2,RM,RW,PYRVR - PYRVR = 1D0/((Mab2-RM**2)**2+RM**2*RW**2) - RETURN - END - -C********************************************************************* - -C...PYRVSB -C...Auxiliary function to PYRVSF for calculating R-Violating -C...sfermion widths. Though the decay products are most often treated -C...as massless in the calculation, the kinematical boundary of phase -C...space is tested using the true masses. -C...MODE = 1: All decay products massive -C...MODE = 2: Decay product 1 massless -C...MODE = 3: Decay product 2 massless -C...MODE = 4: All decay products massless - - FUNCTION PYRVSB(KFIN,ID1,ID2,RM2,MODE) - - IMPLICIT DOUBLE PRECISION (A-H,O-Z) - IMPLICIT INTEGER (I-N) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - DOUBLE PRECISION SM(3) - INTEGER PYCOMP, KC(3) - KC(1)=PYCOMP(KFIN) - KC(2)=PYCOMP(ID1) - KC(3)=PYCOMP(ID2) - SM(1)=PMAS(KC(1),1)**2 - SM(2)=PMAS(KC(2),1)**2 - SM(3)=PMAS(KC(3),1)**2 -C...Kinematics check - IF ((SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2).LE.0D0) THEN - PYRVSB=0D0 - RETURN - ENDIF -C...CM momenta squared - IF (MODE.EQ.1) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1)+PMAS(KC(3),1))**2) - & * (SM(1)-(PMAS(KC(2),1)-PMAS(KC(3),1))**2) - ELSE IF (MODE.EQ.2) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(3),1))**2)**2 - ELSE IF (MODE.EQ.3) THEN - P2CM=1./(4*SM(1))*(SM(1)-(PMAS(KC(2),1))**2)**2 - ELSE - P2CM=SM(1)/4. - ENDIF -C...Calculate Width - PYRVSB=RM2*SQRT(MAX(0D0,P2CM))/(8*PARU(1)*SM(1)) - RETURN - END - -C********************************************************************* - -C...PYRVS -C...Interference function - - FUNCTION PYRVS(X,Y,M1,W1,M2,W2) - - IMPLICIT NONE - DOUBLE PRECISION X, Y, PYRVS, PYRVR, M1, M2, W1, W2 - PYRVS = PYRVR(X,M1,W1)*PYRVR(Y,M2,W2)*((X-M1**2)*(Y-M2**2) - & +W1*W2*M1*M2) - RETURN - END - -C********************************************************************* - -C...PYRVSF -C...Calculates R-violating decays of sfermions. -C...P. Z. Skands - - SUBROUTINE PYRVSF(KFIN,XLAM,IDLAM,LKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) -C...Local variables. - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3), PYCOMP - SAVE /PYMSRV/,/PYSSMT/,/PYMSSM/,/PYDAT2/ - -C...IS R-VIOLATION ON ? - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN -C...Mass eigenstate counter - ICNT=INT(KFIN/KSUSY1) -C...SM KF code of SUSY particle - KFSM=KFIN-ICNT*KSUSY1 -C...Squared Sparticle Mass - SM=PMAS(PYCOMP(KFIN),1)**2 -C... Squared mass of top quark - SMT=PMAS(PYCOMP(6),1)**2 -C...IS L-VIOLATION ON ? - IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1)) THEN -C...SLEPTON -> NU(BAR) + LEPTON and UBAR + D - IF(ICNT.NE.0.AND.(KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15)) - & THEN - K=INT((KFSM-9)/2) - DO 110 I=1,3 - DO 100 J=1,3 - IF(I.NE.J) THEN -C...~e,~mu,~tau -> nu_I + lepton-_J - LKNT = LKNT+1 - IDLAM(LKNT,1)= 12 +2*(I-1) - IDLAM(LKNT,2)= 11 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 100 CONTINUE - 110 CONTINUE -C...~e,~mu,~tau -> nu_Ibar + lepton-_K - J=INT((KFSM-9)/2) - DO 130 I=1,3 - IF(I.NE.J) THEN - DO 120 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-12 -2*(I-1) - IDLAM(LKNT,2)= 11 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 120 CONTINUE - ENDIF - 130 CONTINUE -C...~e,~mu,~tau -> u_Jbar + d_K - I=INT((KFSM-9)/2) - DO 150 J=1,3 - DO 140 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-2 -2*(J-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0 - IF (IMSS(52).NE.0) THEN -C...Use massive top quark - IF (IDLAM(LKNT,1).EQ.-6) THEN - RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 - & * (SM-SMT) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) -C...If no top quark, all decay products massless - ELSE - RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 140 CONTINUE - 150 CONTINUE - ENDIF -C * SNEUTRINO -> LEPTON+ + LEPTON- and DBAR + D -C...No right-handed neutrinos - IF(ICNT.EQ.1) THEN - IF(KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16) THEN - J=INT((KFSM-10)/2) - DO 170 I=1,3 - DO 160 K=1,3 - IF (I.NE.J) THEN -C...~nu_J -> lepton+_I + lepton-_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-11 -2*(I-1) - IDLAM(LKNT,2)= 11 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAM(I,J,K)**2 * SM - IF (IMSS(51).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 160 CONTINUE - 170 CONTINUE -C...~nu_I -> dbar_J + d_K - I=INT((KFSM-10)/2) - DO 190 J=1,3 - DO 180 K=1,3 - LKNT = LKNT+1 - IDLAM(LKNT,1)=-1 -2*(J-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=3*RVLAMP(I,J,K)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 180 CONTINUE - 190 CONTINUE - ENDIF - ENDIF -C * SDOWN -> NU(BAR) + D and LEPTON- + U - IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN - J=INT((KFSM+1)/2) - DO 210 I=1,3 - DO 200 K=1,3 -C...~d_J -> nu_Ibar + d_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-12 -2*(I-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 200 CONTINUE - 210 CONTINUE - K=INT((KFSM+1)/2) - DO 240 I=1,3 - DO 230 J=1,3 -C...~d_K -> nu_I + d_J - LKNT = LKNT+1 - IDLAM(LKNT,1)= 12 +2*(I-1) - IDLAM(LKNT,2)= 1 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF -C...~d_K -> lepton_I- + u_J - 220 LKNT = LKNT+1 - IDLAM(LKNT,1)= 11 +2*(I-1) - IDLAM(LKNT,2)= 2 +2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - IF (IMSS(52).NE.0) THEN -C...Use massive top quark - IF (IDLAM(LKNT,2).EQ.6) THEN - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,2) -C...If no top quark, all decay products massless - ELSE - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 230 CONTINUE - 240 CONTINUE - ENDIF -C * SUP -> LEPTON+ + D - IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN - J=NINT(KFSM/2.) - DO 260 I=1,3 - DO 250 K=1,3 -C...~u_J -> lepton_I+ + d_K - LKNT = LKNT+1 - IDLAM(LKNT,1)=-11 -2*(I-1) - IDLAM(LKNT,2)= 1 +2*(K-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 - RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM - IF (IMSS(52).NE.0) XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - 250 CONTINUE - 260 CONTINUE - ENDIF - ENDIF -C...BARYON NUMBER VIOLATING DECAYS - IF (IMSS(53).GE.1) THEN -C * SUP -> DBAR + DBAR - IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN - I = KFSM/2 - DO 280 J=1,3 - DO 270 K=1,3 -C...~u_I -> dbar_J + dbar_K - IF (J.LT.K) THEN -C...(anti-) symmetry J <-> K. - LKNT = LKNT + 1 - IDLAM(LKNT,1) = -1 -2*(J-1) - IDLAM(LKNT,2) = -1 -2*(K-1) - IDLAM(LKNT,3) = 0 - XLAM(LKNT) = 0D0 - RM2 = 2.*(RVLAMB(I,J,K)**2) - & * SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT = LKNT-1 - ENDIF - ENDIF - 270 CONTINUE - 280 CONTINUE - ENDIF -C * SDOWN -> UBAR + DBAR - IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN - K=(KFSM+1)/2 - DO 300 I=1,3 - DO 290 J=1,3 -C...LAMB coupling antisymmetric in J and K. - IF (J.NE.K) THEN -C...~d_K -> ubar_I + dbar_K - LKNT = LKNT + 1 - IDLAM(LKNT,1)= -2 -2*(I-1) - IDLAM(LKNT,2)= -1 -2*(J-1) - IDLAM(LKNT,3)= 0 - XLAM(LKNT)=0D0 -C...Use massive top quark - IF (IDLAM(LKNT,1).EQ.-6) THEN - RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT - & ) - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3) -C...If no top quark, all decay products massless - ELSE - RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM - XLAM(LKNT) = - & PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4) - ENDIF -C...KINEMATICS CHECK - IF (XLAM(LKNT).EQ.0D0) THEN - LKNT=LKNT-1 - ENDIF - ENDIF - 290 CONTINUE - 300 CONTINUE - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSAVE -C...Saves and restores parameter and cross section values for the -C...3 gamma-p and 6 (or 4, or 9, or 13) gamma-gamma alternatives. -C...Also makes random choice between alternatives. - - SUBROUTINE PYSAVE(ISAVE,IGA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT5/,/PYINT7/ -C...Local arrays and saved variables. - DIMENSION NCP(15),NSUBCP(15,20),MSUBCP(15,20),COEFCP(15,20,20), - &NGENCP(15,0:20,3),XSECCP(15,0:20,3),SIGTCP(15,0:6,0:6,0:5), - &INTCP(15,20),RECP(15,20) - SAVE NCP,NSUBCP,MSUBCP,COEFCP,NGENCP,XSECCP,SIGTCP,INTCP,RECP - -C...Save list of subprocesses and cross-section information. - IF(ISAVE.EQ.1) THEN - ICP=0 - DO 120 I=1,500 - IF(MSUB(I).EQ.0.AND.I.NE.96.AND.I.NE.97) GOTO 120 - ICP=ICP+1 - NSUBCP(IGA,ICP)=I - MSUBCP(IGA,ICP)=MSUB(I) - DO 100 J=1,20 - COEFCP(IGA,ICP,J)=COEF(I,J) - 100 CONTINUE - DO 110 J=1,3 - NGENCP(IGA,ICP,J)=NGEN(I,J) - XSECCP(IGA,ICP,J)=XSEC(I,J) - 110 CONTINUE - 120 CONTINUE - NCP(IGA)=ICP - DO 130 J=1,3 - NGENCP(IGA,0,J)=NGEN(0,J) - XSECCP(IGA,0,J)=XSEC(0,J) - 130 CONTINUE - DO 160 I1=0,6 - DO 150 I2=0,6 - DO 140 J=0,5 - SIGTCP(IGA,I1,I2,J)=SIGT(I1,I2,J) - 140 CONTINUE - 150 CONTINUE - 160 CONTINUE - -C...Save various common process variables. - DO 170 J=1,10 - INTCP(IGA,J)=MINT(40+J) - 170 CONTINUE - INTCP(IGA,11)=MINT(101) - INTCP(IGA,12)=MINT(102) - INTCP(IGA,13)=MINT(107) - INTCP(IGA,14)=MINT(108) - INTCP(IGA,15)=MINT(123) - RECP(IGA,1)=CKIN(3) - RECP(IGA,2)=VINT(318) - -C...Save cross-section information only. - ELSEIF(ISAVE.EQ.2) THEN - DO 190 ICP=1,NCP(IGA) - I=NSUBCP(IGA,ICP) - DO 180 J=1,3 - NGENCP(IGA,ICP,J)=NGEN(I,J) - XSECCP(IGA,ICP,J)=XSEC(I,J) - 180 CONTINUE - 190 CONTINUE - DO 200 J=1,3 - NGENCP(IGA,0,J)=NGEN(0,J) - XSECCP(IGA,0,J)=XSEC(0,J) - 200 CONTINUE - -C...Choose between allowed alternatives. - ELSEIF(ISAVE.EQ.3.OR.ISAVE.EQ.4) THEN - IF(ISAVE.EQ.4) THEN - XSUMCP=0D0 - DO 210 IG=1,MINT(121) - XSUMCP=XSUMCP+XSECCP(IG,0,1) - 210 CONTINUE - XSUMCP=XSUMCP*PYR(0) - DO 220 IG=1,MINT(121) - IGA=IG - XSUMCP=XSUMCP-XSECCP(IG,0,1) - IF(XSUMCP.LE.0D0) GOTO 230 - 220 CONTINUE - 230 CONTINUE - ENDIF - -C...Restore cross-section information. - DO 240 I=1,500 - MSUB(I)=0 - 240 CONTINUE - DO 270 ICP=1,NCP(IGA) - I=NSUBCP(IGA,ICP) - MSUB(I)=MSUBCP(IGA,ICP) - DO 250 J=1,20 - COEF(I,J)=COEFCP(IGA,ICP,J) - 250 CONTINUE - DO 260 J=1,3 - NGEN(I,J)=NGENCP(IGA,ICP,J) - XSEC(I,J)=XSECCP(IGA,ICP,J) - 260 CONTINUE - 270 CONTINUE - DO 280 J=1,3 - NGEN(0,J)=NGENCP(IGA,0,J) - XSEC(0,J)=XSECCP(IGA,0,J) - 280 CONTINUE - DO 310 I1=0,6 - DO 300 I2=0,6 - DO 290 J=0,5 - SIGT(I1,I2,J)=SIGTCP(IGA,I1,I2,J) - 290 CONTINUE - 300 CONTINUE - 310 CONTINUE - -C...Restore various common process variables. - DO 320 J=1,10 - MINT(40+J)=INTCP(IGA,J) - 320 CONTINUE - MINT(101)=INTCP(IGA,11) - MINT(102)=INTCP(IGA,12) - MINT(107)=INTCP(IGA,13) - MINT(108)=INTCP(IGA,14) - MINT(123)=INTCP(IGA,15) - CKIN(3)=RECP(IGA,1) - CKIN(1)=2D0*CKIN(3) - VINT(318)=RECP(IGA,2) - -C...Sum up cross-section info (for PYSTAT). - ELSEIF(ISAVE.EQ.5) THEN - DO 330 I=1,500 - MSUB(I)=0 - NGEN(I,1)=0 - NGEN(I,3)=0 - XSEC(I,3)=0D0 - 330 CONTINUE - NGEN(0,1)=0 - NGEN(0,2)=0 - NGEN(0,3)=0 - XSEC(0,3)=0 - DO 350 IG=1,MINT(121) - DO 340 ICP=1,NCP(IG) - I=NSUBCP(IG,ICP) - IF(MSUBCP(IG,ICP).EQ.1) MSUB(I)=1 - NGEN(I,1)=NGEN(I,1)+NGENCP(IG,ICP,1) - NGEN(I,3)=NGEN(I,3)+NGENCP(IG,ICP,3) - XSEC(I,3)=XSEC(I,3)+XSECCP(IG,ICP,3) - 340 CONTINUE - NGEN(0,1)=NGEN(0,1)+NGENCP(IG,0,1) - NGEN(0,2)=NGEN(0,2)+NGENCP(IG,0,2) - NGEN(0,3)=NGEN(0,3)+NGENCP(IG,0,3) - XSEC(0,3)=XSEC(0,3)+XSECCP(IG,0,3) - 350 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSCAT -C...Finds outgoing flavours and event type; sets up the kinematics -C...and colour flow of the hard scattering - - SUBROUTINE PYSCAT - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Commonblocks - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYSSMT/,/PYTCSM/ -C...Local arrays and saved variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5),PMQ(2),Z(2),CTHE(2), - &PHI(2),KUPPO(100),VINTSV(41:66),ILAB(100) - SAVE VINTSV - -C...Read out process - ISUB=MINT(1) - ISUBSV=ISUB - -C...Restore information for low-pT processes - IF(ISUB.EQ.95.AND.MINT(57).GE.1) THEN - DO 100 J=41,66 - 100 VINT(J)=VINTSV(J) - ENDIF - -C...Convert H' or A process into equivalent H one - IHIGG=1 - KFHIGG=25 - IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. - &ISUB.LE.190)) THEN - IHIGG=2 - IF(MOD(ISUB-1,10).GE.5) IHIGG=3 - KFHIGG=33+IHIGG - IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 - IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 - IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 - IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 - IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 - IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 - IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 - IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 - IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 - IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 - IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 - IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 - ENDIF - - IF(ISUB.EQ.401.OR.ISUB.EQ.402) KFHIGG=KFPR(ISUB,1) - -C...Choice of subprocess, number of documentation lines - IDOC=6+ISET(ISUB) - IF(ISUB.EQ.95) IDOC=8 - IF(ISET(ISUB).EQ.5) IDOC=9 - IF(ISET(ISUB).EQ.11) IDOC=4+NUP - MINT(3)=IDOC-6 - IF(IDOC.GE.9.AND.ISET(ISUB).LE.4) IDOC=IDOC+2 - MINT(4)=IDOC - IPU1=MINT(84)+1 - IPU2=MINT(84)+2 - IPU3=MINT(84)+3 - IPU4=MINT(84)+4 - IPU5=MINT(84)+5 - IPU6=MINT(84)+6 - -C...Reset K, P and V vectors. Store incoming particles - DO 120 JT=1,MSTP(126)+100 - I=MINT(83)+JT - IF(I.GT.MSTU(4)) GOTO 120 - DO 110 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 110 CONTINUE - 120 CONTINUE - DO 140 JT=1,2 - I=MINT(83)+JT - K(I,1)=21 - K(I,2)=MINT(10+JT) - DO 130 J=1,5 - P(I,J)=VINT(285+5*JT+J) - 130 CONTINUE - 140 CONTINUE - MINT(6)=2 - KFRES=0 - -C...Store incoming partons in their CM-frame - SH=VINT(44) - SHR=SQRT(SH) - SHP=VINT(26)*VINT(2) - SHPR=SQRT(SHP) - SHUSER=SHR - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) SHUSER=SHPR - DO 150 JT=1,2 - I=MINT(84)+JT - K(I,1)=14 - K(I,2)=MINT(14+JT) - K(I,3)=MINT(83)+2+JT - P(I,3)=0.5D0*SHUSER*(-1D0)**(JT-1) - P(I,4)=0.5D0*SHUSER - 150 CONTINUE - -C...Copy incoming partons to documentation lines - DO 170 JT=1,2 - I1=MINT(83)+4+JT - I2=MINT(84)+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=I1-2 - DO 160 J=1,5 - P(I1,J)=P(I2,J) - 160 CONTINUE - 170 CONTINUE - -C...Choose new quark/lepton flavour for relevant annihilation graphs - IF(ISUB.EQ.12.OR.ISUB.EQ.53.OR.ISUB.EQ.54.OR.ISUB.EQ.58.OR. - &(ISUB.GE.135.AND.ISUB.LE.140).OR.ISUB.EQ.382.OR.ISUB.EQ.385) THEN - IGLGA=21 - IF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) IGLGA=22 - CALL PYWIDT(IGLGA,SH,WDTP,WDTE) - 180 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*PYR(0) - DO 190 I=1,MDCY(IGLGA,3) - KFLF=KFDP(I+MDCY(IGLGA,2)-1,1) - RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) - IF(RKFL.LE.0D0) GOTO 200 - 190 CONTINUE - 200 CONTINUE - IF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.2) THEN - IF(KFLF.GE.4) GOTO 180 - ELSEIF((ISUB.EQ.53.OR.ISUB.EQ.385).AND.MINT(2).LE.4) THEN - KFLF=4 - MINT(2)=MINT(2)-2 - ELSEIF(ISUB.EQ.53.OR.ISUB.EQ.385) THEN - KFLF=5 - MINT(2)=MINT(2)-4 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.1.AND.IABS(MINT(15)).LE.2 - & .AND.IABS(KFLF).GE.3) THEN - FACQQB=VINT(58)**2*4D0/9D0*(VINT(45)**2+VINT(46)**2)/ - & VINT(44)**2 - FACCIB=VINT(46)**2/RTCM(41)**4 - IF(FACQQB/(FACQQB+FACCIB).LT.PYR(0)) GOTO 180 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.2) THEN - KFLF=5 - MINT(2)=1 - ELSEIF(ISUB.EQ.382.AND.ITCM(5).EQ.5.AND.MINT(2).EQ.1) THEN - IF(KFLF.EQ.5) GOTO 180 - ELSEIF(ISUB.EQ.54.OR.ISUB.EQ.135.OR.ISUB.EQ.136) THEN - IF((KCHG(PYCOMP(KFLF),1)/2D0)**2.LT.PYR(0)) GOTO 180 - ELSEIF(ISUB.EQ.58.OR.(ISUB.GE.137.AND.ISUB.LE.140)) THEN - IF((KCHG(PYCOMP(KFLF),1)/3D0)**2.LT.PYR(0)) GOTO 180 - ENDIF - ENDIF - -C...Final state flavours and colour flow: default values - JS=1 - MINT(21)=MINT(15) - MINT(22)=MINT(16) - MINT(23)=0 - MINT(24)=0 - KCC=20 - KCS=ISIGN(1,MINT(15)) - - IF(ISET(ISUB).EQ.11) THEN -C...User-defined processes: find products - MINT(3)=0 - DO 210 IUP=3,NUP - IF(ISTUP(IUP).LT.1.OR.ISTUP(IUP).GT.3) THEN - ELSEIF(NUP.EQ.5.AND.IUP.GE.4.AND.MOTHUP(1,4).EQ.3) THEN - MINT(21+IUP)=IDUP(IUP) - ELSEIF(ISTUP(IUP).EQ.1.AND.(ISTUP(MOTHUP(1,IUP)).EQ.2.OR. - & ISTUP(MOTHUP(1,IUP)).EQ.3).AND.IDUP(MOTHUP(1,IUP)).NE.0) THEN - ELSEIF(IDUP(IUP).EQ.0) THEN - ELSE - MINT(3)=MINT(3)+1 - IF(MINT(3).LE.6) MINT(20+MINT(3))=IDUP(IUP) - ENDIF - 210 CONTINUE - - ELSEIF(ISUB.LE.10) THEN - IF(ISUB.EQ.1) THEN -C...f + fbar -> gamma*/Z0 - KFRES=23 - - ELSEIF(ISUB.EQ.2) THEN -C...f + fbar' -> W+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.3) THEN -C...f + fbar -> h0 (or H0, or A0) - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.4) THEN -C...gamma + W+/- -> W+/- - - ELSEIF(ISUB.EQ.5) THEN -C...Z0 + Z0 -> h0 - XH=SH/SHP - MINT(21)=MINT(15) - MINT(22)=MINT(16) - PMQ(1)=PYMASS(MINT(21)) - PMQ(2)=PYMASS(MINT(22)) - 220 JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 220 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 220 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 220 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 220 - KCC=22 - KFRES=25 - - ELSEIF(ISUB.EQ.6) THEN -C...Z0 + W+/- -> W+/- - - ELSEIF(ISUB.EQ.7) THEN -C...W+ + W- -> Z0 - - ELSEIF(ISUB.EQ.8) THEN -C...W+ + W- -> h0 - XH=SH/SHP - 230 DO 260 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 240 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 240 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 250 - 240 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 250 PMQ(JT)=PYMASS(MINT(20+JT)) - 260 CONTINUE - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 230 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 230 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 230 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 230 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 230 - KCC=22 - KFRES=25 - - ELSEIF(ISUB.EQ.10) THEN -C...f + f' -> f + f' (gamma/Z/W exchange); th = (p(f)-p(f))**2 - IF(MINT(2).EQ.1) THEN - KCC=22 - ELSE -C...W exchange: need to mix flavours according to CKM matrix - DO 280 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 270 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 280 - 270 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 280 CONTINUE - KCC=22 - ENDIF - ENDIF - - ELSEIF(ISUB.LE.20) THEN - IF(ISUB.EQ.11) THEN -C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2 - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.12) THEN -C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2 - MINT(21)=ISIGN(KFLF,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.13) THEN -C...f + fbar -> g + g; th arbitrary - MINT(21)=21 - MINT(22)=21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.14) THEN -C...f + fbar -> g + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=22 - KCC=17+JS - - ELSEIF(ISUB.EQ.15) THEN -C...f + fbar -> g + Z0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=23 - KCC=17+JS - - ELSEIF(ISUB.EQ.16) THEN -C...f + fbar' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.17) THEN -C...f + fbar -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=25 - KCC=17+JS - - ELSEIF(ISUB.EQ.18) THEN -C...f + fbar -> gamma + gamma; th arbitrary - MINT(21)=22 - MINT(22)=22 - - ELSEIF(ISUB.EQ.19) THEN -C...f + fbar -> gamma + Z0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=23 - - ELSEIF(ISUB.EQ.20) THEN -C...f + fbar' -> gamma + W+/-; th = (p(f)-p(W-))**2 or -C...(p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - ENDIF - - ELSEIF(ISUB.LE.30) THEN - IF(ISUB.EQ.21) THEN -C...f + fbar -> gamma + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=25 - - ELSEIF(ISUB.EQ.22) THEN -C...f + fbar -> Z0 + Z0; th arbitrary - MINT(21)=23 - MINT(22)=23 - - ELSEIF(ISUB.EQ.23) THEN -C...f + fbar' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(20+JS)=23 - MINT(23-JS)=ISIGN(24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.24) THEN -C...f + fbar -> Z0 + h0 (or H0, or A0); th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=23 - MINT(23-JS)=KFHIGG - - ELSEIF(ISUB.EQ.25) THEN -C...f + fbar -> W+ + W-; th = (p(f)-p(W-))**2 - MINT(21)=-ISIGN(24,MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.26) THEN -C...f + fbar' -> W+/- + h0 (or H0, or A0); -C...th = (p(f)-p(W-))**2 or (p(fbar')-p(W+))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(24,KCH1+KCH2) - MINT(23-JS)=KFHIGG - - ELSEIF(ISUB.EQ.27) THEN -C...f + fbar -> h0 + h0 - - ELSEIF(ISUB.EQ.28) THEN -C...f + g -> f + g; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - KCC=MINT(2)+6 - IF(MINT(15).EQ.21) KCC=KCC+2 - IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) - IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) - - ELSEIF(ISUB.EQ.29) THEN -C...f + g -> f + gamma; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.30) THEN -C...f + g -> f + Z0; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.31) THEN -C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f' - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) - RVCKM=VINT(180+I)*PYR(0) - DO 290 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 290 - MINT(20+JS)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 300 - 290 CONTINUE - 300 KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.32) THEN -C...f + g -> f + h0; th = (p(f)-p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.33) THEN -C...f + gamma -> f + g; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=21 - KCC=24+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.34) THEN -C...f + gamma -> f + gamma; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - KCC=22 - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.35) THEN -C...f + gamma -> f + Z0; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=23 - KCC=22 - - ELSEIF(ISUB.EQ.36) THEN -C...f + gamma -> f' + W+/-; th=(p(f)-p(f'))**2 - IF(MINT(15).EQ.22) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 310 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 310 - MINT(20+JS)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 320 - 310 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JS)=ISIGN(IB,I) - ENDIF - 320 KCC=22 - - ELSEIF(ISUB.EQ.37) THEN -C...f + gamma -> f + h0 - - ELSEIF(ISUB.EQ.38) THEN -C...f + Z0 -> f + g - - ELSEIF(ISUB.EQ.39) THEN -C...f + Z0 -> f + gamma - - ELSEIF(ISUB.EQ.40) THEN -C...f + Z0 -> f + Z0 - ENDIF - - ELSEIF(ISUB.LE.50) THEN - IF(ISUB.EQ.41) THEN -C...f + Z0 -> f' + W+/- - - ELSEIF(ISUB.EQ.42) THEN -C...f + Z0 -> f + h0 - - ELSEIF(ISUB.EQ.43) THEN -C...f + W+/- -> f' + g - - ELSEIF(ISUB.EQ.44) THEN -C...f + W+/- -> f' + gamma - - ELSEIF(ISUB.EQ.45) THEN -C...f + W+/- -> f' + Z0 - - ELSEIF(ISUB.EQ.46) THEN -C...f + W+/- -> f' + W+/- - - ELSEIF(ISUB.EQ.47) THEN -C...f + W+/- -> f' + h0 - - ELSEIF(ISUB.EQ.48) THEN -C...f + h0 -> f + g - - ELSEIF(ISUB.EQ.49) THEN -C...f + h0 -> f + gamma - - ELSEIF(ISUB.EQ.50) THEN -C...f + h0 -> f + Z0 - ENDIF - - ELSEIF(ISUB.LE.60) THEN - IF(ISUB.EQ.51) THEN -C...f + h0 -> f' + W+/- - - ELSEIF(ISUB.EQ.52) THEN -C...f + h0 -> f + h0 - - ELSEIF(ISUB.EQ.53) THEN -C...g + g -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.54) THEN -C...g + gamma -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.EQ.55) THEN -C...g + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.56) THEN -C...g + W+/- -> f + fbar' - - ELSEIF(ISUB.EQ.57) THEN -C...g + h0 -> f + fbar - - ELSEIF(ISUB.EQ.58) THEN -C...gamma + gamma -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=21 - - ELSEIF(ISUB.EQ.59) THEN -C...gamma + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.60) THEN -C...gamma + W+/- -> f + fbar' - ENDIF - - ELSEIF(ISUB.LE.70) THEN - IF(ISUB.EQ.61) THEN -C...gamma + h0 -> f + fbar - - ELSEIF(ISUB.EQ.62) THEN -C...Z0 + Z0 -> f + fbar - - ELSEIF(ISUB.EQ.63) THEN -C...Z0 + W+/- -> f + fbar' - - ELSEIF(ISUB.EQ.64) THEN -C...Z0 + h0 -> f + fbar - - ELSEIF(ISUB.EQ.65) THEN -C...W+ + W- -> f + fbar - - ELSEIF(ISUB.EQ.66) THEN -C...W+/- + h0 -> f + fbar' - - ELSEIF(ISUB.EQ.67) THEN -C...h0 + h0 -> f + fbar - - ELSEIF(ISUB.EQ.68) THEN -C...g + g -> g + g; th arbitrary - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.69) THEN -C...gamma + gamma -> W+ + W-; th arbitrary - MINT(21)=24 - MINT(22)=-24 - KCC=21 - - ELSEIF(ISUB.EQ.70) THEN -C...gamma + W+/- -> Z0 + W+/-; th=(p(W)-p(W))**2 - IF(MINT(15).EQ.22) MINT(21)=23 - IF(MINT(16).EQ.22) MINT(22)=23 - KCC=21 - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN -C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W- - XH=SH/SHP - MINT(21)=MINT(15) - MINT(22)=MINT(16) - PMQ(1)=PYMASS(MINT(21)) - PMQ(2)=PYMASS(MINT(22)) - 330 JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 330 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 330 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 330 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 330 - KCC=22 - - ELSEIF(ISUB.EQ.73) THEN -C...Z0 + W+/- -> Z0 + W+/- - JS=MINT(2) - XH=SH/SHP - 340 JT=3-MINT(2) - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 350 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 350 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 360 - 350 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 360 PMQ(JT)=PYMASS(MINT(20+JT)) - MINT(23-JT)=MINT(17-JT) - PMQ(3-JT)=PYMASS(MINT(23-JT)) - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 340 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 340 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 340 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 340 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340 - KCC=22 - - ELSEIF(ISUB.EQ.74) THEN -C...Z0 + h0 -> Z0 + h0 - - ELSEIF(ISUB.EQ.75) THEN -C...W+ + W- -> gamma + gamma - - ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN -C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W- - XH=SH/SHP - 370 DO 400 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 380 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 380 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 390 - 380 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 390 PMQ(JT)=PYMASS(MINT(20+JT)) - 400 CONTINUE - JT=INT(1.5D0+PYR(0)) - ZMIN=2D0*PMQ(JT)/SHPR - ZMAX=1D0-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/ - & (SHPR*(SHPR-PMQ(3-JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(ZMIN.GE.ZMAX) GOTO 370 - Z(JT)=ZMIN+(ZMAX-ZMIN)*PYR(0) - IF(-1D0+(1D0+XH)/(1D0-Z(JT))-XH/(1D0-Z(JT))**2.LT. - & (1D0-XH)**2/(4D0*XH)*PYR(0)) GOTO 370 - SQC1=1D0-4D0*PMQ(JT)**2/(Z(JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 370 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) - CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(JT)=MIN(1D0,MAX(-1D0,CTHE(JT))) - Z(3-JT)=1D0-XH/(1D0-Z(JT)) - SQC1=1D0-4D0*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) - IF(SQC1.LT.1D-8) GOTO 370 - C1=SQRT(SQC1) - C2=1D0+2D0*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) - CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2D0*PYR(0)-1D0)*C1))/C1 - CTHE(3-JT)=MIN(1D0,MAX(-1D0,CTHE(3-JT))) - PHIR=PARU(2)*PYR(0) - CPHI=COS(PHIR) - ANG=CTHE(1)*CTHE(2)-SQRT(1D0-CTHE(1)**2)* - & SQRT(1D0-CTHE(2)**2)*CPHI - Z1=2D0-Z(JT) - Z2=ANG*SQRT(Z(JT)**2-4D0*PMQ(JT)**2/SHP) - Z3=1D0-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP - Z(3-JT)=2D0/(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* - & PMQ(3-JT)**2/SHP)) - ZMIN=2D0*PMQ(3-JT)/SHPR - ZMAX=1D0-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) - ZMAX=MIN(1D0-XH,ZMAX) - IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 370 - KCC=22 - - ELSEIF(ISUB.EQ.78) THEN -C...W+/- + h0 -> W+/- + h0 - - ELSEIF(ISUB.EQ.79) THEN -C...h0 + h0 -> h0 + h0 - - ELSEIF(ISUB.EQ.80) THEN -C...q + gamma -> q' + pi+/-; th=(p(q)-p(q'))**2 - IF(MINT(15).EQ.22) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(211,KCHG(IA,1)*I) - IB=3-IA - MINT(20+JS)=ISIGN(IB,I) - KCC=22 - ENDIF - - ELSEIF(ISUB.LE.90) THEN - IF(ISUB.EQ.81) THEN -C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2 - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.82) THEN -C...g + g -> Q + Qbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.83) THEN -C...f + q -> f' + Q; th = (p(f) - p(f'))**2 - KFOLD=MINT(16) - IF(MINT(2).EQ.2) KFOLD=MINT(15) - KFAOLD=IABS(KFOLD) - IF(KFAOLD.GT.10) THEN - KFANEW=KFAOLD+2*MOD(KFAOLD,2)-1 - ELSE - RCKM=VINT(180+KFOLD)*PYR(0) - IPM=(5-ISIGN(1,KFOLD))/2 - KFANEW=-MOD(KFAOLD+1,2) - 410 KFANEW=KFANEW+2 - IDC=MDCY(KFAOLD,2)+(KFANEW+1)/2+2 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) THEN - IF(MOD(KFAOLD,2).EQ.0) RCKM=RCKM- - & VCKM(KFAOLD/2,(KFANEW+1)/2) - IF(MOD(KFAOLD,2).EQ.1) RCKM=RCKM- - & VCKM(KFANEW/2,(KFAOLD+1)/2) - ENDIF - IF(KFANEW.LE.6.AND.RCKM.GT.0D0) GOTO 410 - ENDIF - IF(MINT(2).EQ.1) THEN - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=ISIGN(KFANEW,MINT(16)) - ELSE - MINT(21)=ISIGN(KFANEW,MINT(15)) - MINT(22)=ISIGN(MINT(55),MINT(16)) - JS=2 - ENDIF - KCC=22 - - ELSEIF(ISUB.EQ.84) THEN -C...g + gamma -> Q + Qbar; th arbitary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.EQ.85) THEN -C...gamma + gamma -> F + Fbar; th arbitary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(56),KCS) - MINT(22)=-MINT(21) - KCC=21 - - ELSEIF(ISUB.GE.86.AND.ISUB.LE.89) THEN -C...g + g -> (J/Psi, chi_0c, chi_1c or chi_2c) + g - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=24 - KCS=(-1)**INT(1.5D0+PYR(0)) - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.95) THEN -C...Low-pT ( = energyless g + g -> g + g) - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.96) THEN -C...Multiple interactions (should be reassigned to QCD process) - ENDIF - - ELSEIF(ISUB.LE.110) THEN - IF(ISUB.EQ.101) THEN -C...g + g -> gamma*/Z0 - KCC=21 - KFRES=22 - - ELSEIF(ISUB.EQ.102) THEN -C...g + g -> h0 (or H0, or A0) - KCC=21 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.103) THEN -C...gamma + gamma -> h0 (or H0, or A0) - KCC=21 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.104.OR.ISUB.EQ.105) THEN -C...g + g -> chi_0c or chi_2c. - KCC=21 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.106) THEN -C...g + g -> J/Psi + gamma - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=21 - - ELSEIF(ISUB.EQ.107) THEN -C...g + gamma -> J/Psi + g - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - KCC=22 - IF(MINT(16).EQ.22) KCC=33 - - ELSEIF(ISUB.EQ.108) THEN -C...gamma + gamma -> J/Psi + gamma - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - - ELSEIF(ISUB.EQ.110) THEN -C...f + fbar -> gamma + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=22 - MINT(23-JS)=KFHIGG - ENDIF - - ELSEIF(ISUB.LE.120) THEN - IF(ISUB.EQ.111) THEN -C...f + fbar -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=21 - MINT(23-JS)=KFHIGG - KCC=17+JS - - ELSEIF(ISUB.EQ.112) THEN -C...f + g -> f + h0; th = (p(f) - p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=KFHIGG - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.113) THEN -C...g + g -> g + h0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=KFHIGG - KCC=22+JS - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.114) THEN -C...g + g -> gamma + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(21)=22 - MINT(22)=22 - KCC=21 - - ELSEIF(ISUB.EQ.115) THEN -C...g + g -> g + gamma; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=22 - KCC=22+JS - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.116) THEN -C...g + g -> gamma + Z0 - - ELSEIF(ISUB.EQ.117) THEN -C...g + g -> Z0 + Z0 - - ELSEIF(ISUB.EQ.118) THEN -C...g + g -> W+ + W- - ENDIF - - ELSEIF(ISUB.LE.140) THEN - IF(ISUB.EQ.121) THEN -C...g + g -> Q + Qbar + h0 - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) - MINT(22)=-MINT(21) - KCC=11+INT(0.5D0+PYR(0)) - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.122) THEN -C...q + qbar -> Q + Qbar + h0 - MINT(21)=ISIGN(KFPR(ISUBSV,2),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.123) THEN -C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as -C...inner process) - KCC=22 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.124) THEN -C...f + f' -> f" + f"' + h0 (or H0, or A) (W+ + W- -> h0 as -C...inner process) - DO 430 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 420 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 420 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 430 - 420 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 430 CONTINUE - KCC=22 - KFRES=KFHIGG - - ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN -C...f + gamma*_(T,L) -> f + g; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(23-JS)=21 - KCC=24+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN -C...f + gamma*_(T,L) -> f + gamma; th=(p(f)-p(f))**2 - IF(MINT(15).EQ.22) JS=2 - KCC=22 - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN -C...g + gamma*_(T,L) -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=27 - IF(MINT(16).EQ.21) KCC=28 - - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN -C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=21 - - ENDIF - - ELSEIF(ISUB.LE.160) THEN - IF(ISUB.EQ.141) THEN -C...f + fbar -> gamma*/Z0/Z'0 - KFRES=32 - - ELSEIF(ISUB.EQ.142) THEN -C...f + fbar' -> W'+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(34,KCH1+KCH2) - - ELSEIF(ISUB.EQ.143) THEN -C...f + fbar' -> H+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.144) THEN -C...f + fbar' -> R - KFRES=ISIGN(41,MINT(15)+MINT(16)) - - ELSEIF(ISUB.EQ.145) THEN -C...q + l -> LQ (leptoquark) - IF(IABS(MINT(16)).LE.8) JS=2 - KFRES=ISIGN(42,MINT(14+JS)) - KCC=28+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.146) THEN -C...e + gamma -> e* (excited lepton) - IF(MINT(15).EQ.22) JS=2 - KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) - KCC=22 - - ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN -C...q + g -> q* (excited quark) - IF(MINT(15).EQ.21) JS=2 - KFRES=ISIGN(KFPR(ISUB,1),MINT(14+JS)) - KCC=30+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.149) THEN -C...g + g -> eta_tc - KFRES=KTECHN+331 - KCC=23 - KCS=(-1)**INT(1.5D0+PYR(0)) - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.161) THEN -C...f + g -> f' + H+/-; th = (p(f)-p(f'))**2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(37,KCHG(IA,1)*I) - IB=IA+MOD(IA,2)-MOD(IA+1,2) - MINT(20+JS)=ISIGN(IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.162) THEN -C...q + g -> LQ + lbar; LQ=leptoquark; th=(p(q)-p(LQ))^2 - IF(MINT(15).EQ.21) JS=2 - MINT(20+JS)=ISIGN(42,MINT(14+JS)) - KFLQL=KFDP(MDCY(42,2),2) - MINT(23-JS)=-ISIGN(KFLQL,MINT(14+JS)) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.163) THEN -C...g + g -> LQ + LQbar; LQ=leptoquark; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(42,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.164) THEN -C...q + qbar -> LQ + LQbar; LQ=leptoquark; th=(p(q)-p(LQ))**2 - MINT(21)=ISIGN(42,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.165) THEN -C...q + qbar -> l- + l+; th=(p(q)-p(l-))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.166) THEN -C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 - IF(MOD(MINT(15),2).EQ.0) THEN - MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) - ELSE - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) - ENDIF - - ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN -C...q + q' -> q" + q* (excited quark) - KFQSTR=KFPR(ISUB,2) - KFQEXC=MOD(KFQSTR,KEXCIT) - JS=MINT(2) - MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) - IF(IABS(MINT(15)).NE.KFQEXC.AND.IABS(MINT(16)).NE.KFQEXC) - & MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) - KCC=22 - JS=3-JS - - ELSEIF(ISUB.EQ.169) THEN -C...q + qbar -> e + e* (excited lepton) - KFQSTR=KFPR(ISUB,2) - KFQEXC=MOD(KFQSTR,KEXCIT) - JS=MINT(2) - MINT(20+JS)=ISIGN(KFQSTR,MINT(14+JS)) - MINT(23-JS)=ISIGN(KFQEXC,MINT(17-JS)) - JS=3-JS - - ELSEIF(ISUB.EQ.191) THEN -C...f + fbar -> rho_tc0. - KFRES=KTECHN+113 - - ELSEIF(ISUB.EQ.192) THEN -C...f + fbar' -> rho_tc+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KTECHN+213,KCH1+KCH2) - - ELSEIF(ISUB.EQ.193) THEN -C...f + fbar -> omega_tc0. - KFRES=KTECHN+223 - - ELSEIF(ISUB.EQ.194) THEN -C...f + fbar -> f' + fbar' via mixture of s-channel -C...rho_tc and omega_tc; th=(p(f)-p(f'))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.195) THEN -C...f + fbar' -> f'' + fbar''' via s-channel -C...rho_tc+ th=(p(f)-p(f'))**2 -C...q + qbar' -> l + nu; th=(p(u)-p(nu))**2 or (p(ubar)-p(nubar))**2 - IF(MOD(MINT(15),2).EQ.0) THEN - MINT(21)=ISIGN(KFPR(ISUB,1)+1,MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1),MINT(16)) - ELSE - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,1)+1,MINT(16)) - ENDIF - ENDIF - -CMRENNA++ - ELSEIF(ISUB.LE.215) THEN - IF(ISUB.EQ.201) THEN -C...f + fbar -> ~e_L + ~e_Lbar - MINT(21)=ISIGN(KSUSY1+11,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.202) THEN -C...f + fbar -> ~e_R + ~e_Rbar - MINT(21)=ISIGN(KSUSY2+11,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.203) THEN -C...f + fbar -> ~e_L + ~e_Rbar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.204) THEN -C...f + fbar -> ~mu_L + ~mu_Lbar - MINT(21)=ISIGN(KSUSY1+13,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.205) THEN -C...f + fbar -> ~mu_R + ~mu_Rbar - MINT(21)=ISIGN(KSUSY2+13,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.206) THEN -C...f + fbar -> ~mu_L + ~mu_Rbar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.207) THEN -C...f + fbar -> ~tau_1 + ~tau_1bar - MINT(21)=ISIGN(KSUSY1+15,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.208) THEN -C...f + fbar -> ~tau_2 + ~tau_2bar - MINT(21)=ISIGN(KSUSY2+15,KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.209) THEN -C...f + fbar -> ~tau_1 + ~tau_2bar - IF(MINT(15).LT.0) JS=2 - IF(MINT(2).EQ.1) THEN - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=-KFPR(ISUB,2) - ELSE - MINT(20+JS)=-KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ENDIF - - ELSEIF(ISUB.EQ.210) THEN -C...q + qbar' -> ~l_L + ~nulbar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KFPR(ISUB,1),KCH1+KCH2) - MINT(22)=ISIGN(KFPR(ISUB,2),KCH1+KCH2) - - ELSEIF(ISUB.EQ.211) THEN -C...q + qbar'-> ~tau_1 + ~nutaubar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KSUSY1+15,KCH1+KCH2) - MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) - - ELSEIF(ISUB.EQ.212) THEN -C...q + qbar'-> ~tau_2 + ~nutaubar; th arbitrary - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - MINT(21)=-ISIGN(KSUSY2+15,KCH1+KCH2) - MINT(22)=ISIGN(KSUSY1+16,KCH1+KCH2) - - ELSEIF(ISUB.EQ.213) THEN -C...f + fbar -> ~nul + ~nulbar - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.214) THEN -C...f + fbar -> ~nutau + ~nutaubar - MINT(21)=ISIGN(KSUSY1+16,KCS) - MINT(22)=-MINT(21) - ENDIF - - ELSEIF(ISUB.LE.225) THEN - IF(ISUB.EQ.216) THEN -C...f + fbar -> ~chi01 + ~chi01 - MINT(21)=KSUSY1+22 - MINT(22)=KSUSY1+22 - - ELSEIF(ISUB.EQ.217) THEN -C...f + fbar -> ~chi02 + ~chi02 - MINT(21)=KSUSY1+23 - MINT(22)=KSUSY1+23 - - ELSEIF(ISUB.EQ.218 ) THEN -C...f + fbar -> ~chi03 + ~chi03 - MINT(21)=KSUSY1+25 - MINT(22)=KSUSY1+25 - - ELSEIF(ISUB.EQ.219 ) THEN -C...f + fbar -> ~chi04 + ~chi04 - MINT(21)=KSUSY1+35 - MINT(22)=KSUSY1+35 - - ELSEIF(ISUB.EQ.220 ) THEN -C...f + fbar -> ~chi01 + ~chi02 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+23 - - ELSEIF(ISUB.EQ.221 ) THEN -C...f + fbar -> ~chi01 + ~chi03 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+25 - - ELSEIF(ISUB.EQ.222) THEN -C...f + fbar -> ~chi01 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=KSUSY1+35 - - ELSEIF(ISUB.EQ.223) THEN -C...f + fbar -> ~chi02 + ~chi03 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=KSUSY1+25 - - ELSEIF(ISUB.EQ.224) THEN -C...f + fbar -> ~chi02 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=KSUSY1+35 - - ELSEIF(ISUB.EQ.225) THEN -C...f + fbar -> ~chi03 + ~chi04 - IF(MINT(15).LT.0) JS=2 -C IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=KSUSY1+35 - ENDIF - - ELSEIF(ISUB.LE.236) THEN - IF(ISUB.EQ.226) THEN -C...f + fbar -> ~chi+-1 + ~chi-+1 -C...th=(p(q)-p(chi+))**2 or (p(qbar)-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - MINT(21)=ISIGN(KSUSY1+24,KCH1) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.227) THEN -C...f + fbar -> ~chi+-2 + ~chi-+2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - MINT(21)=ISIGN(KSUSY1+37,KCH1) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.228) THEN -C...f + fbar -> ~chi+-1 + ~chi-+2 -C...th=(p(q)-p(chi1+))**2 or th=(p(qbar)-p(chi1-))**2 -C...js=1 if pyr<.5, js=2 if pyr>.5 -C...if 15=q, 16=qbar and js=1, chi1+ + chi2-, th=(q-chi1+)**2 -C...if 15=qbar, 16=q and js=1, chi2- + chi1+, th=(q-chi1+)**2 -C...if 15=q, 16=qbar and js=2, chi1- + chi2+, th=(qbar-chi1-)**2 -C...if 15=qbar, 16=q and js=2, chi2+ + chi1-, th=(q-chi1-)**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=INT(1-KCH1)/2 - IF(MINT(2).EQ.1) THEN - MINT(21)= ISIGN(KSUSY1+24,KCH1) - MINT(22)= -ISIGN(KSUSY1+37,KCH1) -c IF(KCH2.EQ.0) JS=2 - ELSE - MINT(21)= ISIGN(KSUSY1+37,KCH1) - MINT(22)= -ISIGN(KSUSY1+24,KCH1) - JS=2 -c IF(KCH2.EQ.1) JS=2 - ENDIF - - ELSEIF(ISUB.EQ.229) THEN -C...q + qbar' -> ~chi01 + ~chi+-1 -C...th=(p(u)-p(chi+))**2 or (p(ubar)-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) -C...CHECK THIS - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.230) THEN -C...q + qbar' -> ~chi02 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.231) THEN -C...q + qbar' -> ~chi03 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.232) THEN -C...q + qbar' -> ~chi04 + ~chi+-1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+35 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - - ELSEIF(ISUB.EQ.233) THEN -C...q + qbar' -> ~chi01 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+22 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.234) THEN -C...q + qbar' -> ~chi02 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+23 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.235) THEN -C...q + qbar' -> ~chi03 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+25 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - - ELSEIF(ISUB.EQ.236) THEN -C...q + qbar' -> ~chi04 + ~chi+-2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MOD(MINT(15),2).EQ.0) JS=2 - MINT(20+JS)=KSUSY1+35 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - ENDIF - - ELSEIF(ISUB.LE.245) THEN - IF(ISUB.EQ.237) THEN -C...q + qbar -> ~chi01 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+22 - KCC=17+JS - - ELSEIF(ISUB.EQ.238) THEN -C...q + qbar -> ~chi02 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+23 - KCC=17+JS - - ELSEIF(ISUB.EQ.239) THEN -C...q + qbar -> ~chi03 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+25 - KCC=17+JS - - ELSEIF(ISUB.EQ.240) THEN -C...q + qbar -> ~chi04 + ~g -C...th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=KSUSY1+35 - KCC=17+JS - - ELSEIF(ISUB.EQ.241) THEN -C...q + qbar' -> ~chi+-1 + ~g -C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ -C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- -C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- -C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ -C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - JS=1 - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=ISIGN(KSUSY1+24,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.242) THEN -C...q + qbar' -> ~chi+-2 + ~g -C...if 15=u, 16=dbar, then (kch1+kch2)>0, js=1, chi+ -C...if 15=d, 16=ubar, then (kch1+kch2)<0, js=2, chi- -C...if 15=ubar, 16=d, then (kch1+kch2)<0, js=1, chi- -C...if 15=dbar, 16=u, then (kch1+kch2)>0, js=2, chi+ -C...th=(p(q)-p(chi+))**2 or (p(qbar')-p(chi-))**2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - JS=1 - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=KSUSY1+21 - MINT(23-JS)=ISIGN(KSUSY1+37,KCH1+KCH2) - KCC=17+JS - - ELSEIF(ISUB.EQ.243) THEN -C...q + qbar -> ~g + ~g ; th arbitrary - MINT(21)=KSUSY1+21 - MINT(22)=KSUSY1+21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.244) THEN -C...g + g -> ~g + ~g ; th arbitrary - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=KSUSY1+21 - MINT(22)=KSUSY1+21 - ENDIF - - ELSEIF(ISUB.LE.260) THEN - IF(ISUB.EQ.246) THEN -C...qj + g -> ~qj_L + ~chi01 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.247) THEN -C...qj + g -> ~qj_R + ~chi01 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+22 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.248) THEN -C...qj + g -> ~qj_L + ~chi02 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.249) THEN -C...qj + g -> ~qj_R + ~chi02 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+23 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.250) THEN -C...qj + g -> ~qj_L + ~chi03 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.251) THEN -C...qj + g -> ~qj_R + ~chi03 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+25 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.252) THEN -C...qj + g -> ~qj_L + ~chi04 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+35 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.253) THEN -C...qj + g -> ~qj_R + ~chi04 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+35 - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.254) THEN -C...qj + g -> ~qk_L + ~chi+-1 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY1+IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.255) THEN -C...qj + g -> ~qk_L + ~chi+-1 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(23-JS)=ISIGN(KSUSY1+24,KCHG(IA,1)*I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY2+IB,I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.256) THEN -C...qj + g -> ~qk_L + ~chi+-2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY1+IB,I) - MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.257) THEN -C...qj + g -> ~qk_R + ~chi+-2 - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - IB=-IA+INT((IA+1)/2)*4-1 - MINT(20+JS)=ISIGN(KSUSY2+IB,I) - MINT(23-JS)=ISIGN(KSUSY1+37,KCHG(IA,1)*I) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.258) THEN -C...qj + g -> ~qj_L + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - - ELSEIF(ISUB.EQ.259) THEN -C...qj + g -> ~qj_R + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - ENDIF - - ELSEIF(ISUB.LE.270) THEN - IF(ISUB.EQ.261) THEN -C...f + fbar -> ~t_1 + ~t_1bar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.262) THEN -C...f + fbar -> ~t_2 + ~t_2bar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.263) THEN -C...f + fbar -> ~t_1 + ~t_2bar; th = (p(q)-p(sq))**2 - IF((KCS.GT.0.AND.MINT(2).EQ.1).OR. - & (KCS.LT.0.AND.MINT(2).EQ.2)) THEN - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-ISIGN(KFPR(ISUB,2),KCS) - ELSE - JS=2 - MINT(21)=ISIGN(KFPR(ISUB,2),KCS) - MINT(22)=-ISIGN(KFPR(ISUB,1),KCS) - ENDIF -C...Correct color combination - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.264) THEN -C...g + g -> ~t_1 + ~t_1bar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.265) THEN -C...g + g -> ~t_2 + ~t_2bar; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - ENDIF - - ELSEIF(ISUB.LE.296) THEN - IF(ISUB.EQ.271.OR.ISUB.EQ.281.OR.ISUB.EQ.291) THEN -C...qi + qj -> ~qi_L + ~qj_L - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) - - ELSEIF(ISUB.EQ.272.OR.ISUB.EQ.282.OR.ISUB.EQ.292) THEN -C...qi + qj -> ~qi_R + ~qj_R - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) - - ELSEIF(ISUB.EQ.273.OR.ISUB.EQ.283.OR.ISUB.EQ.293) THEN -C...qi + qj -> ~qi_L + ~qj_R - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.274.OR.ISUB.EQ.284) THEN -C...qi + qjbar -> ~qi_L + ~qj_Lbar; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KSUSY1+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY1+IABS(MINT(16)),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.275.OR.ISUB.EQ.285) THEN -C...qi + qjbar -> ~qi_R + ~qj_Rbar ; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KSUSY2+IABS(MINT(15)),MINT(15)) - MINT(22)=ISIGN(KSUSY2+IABS(MINT(16)),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.276.OR.ISUB.EQ.286.OR.ISUB.EQ.296) THEN -C...qi + qjbar -> ~qi_L + ~qj_Rbar ; th = (p(f)-p(sf'))**2 - MINT(21)=ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=ISIGN(KFPR(ISUB,2),MINT(16)) - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.277.OR.ISUB.EQ.287) THEN -C...f + fbar -> ~qi_L + ~qi_Lbar ; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.278.OR.ISUB.EQ.288) THEN -C...f + fbar -> ~qi_R + ~qi_Rbar; th = (p(q)-p(sq))**2 - ISGN=1 - IF(MINT(43).EQ.1.AND.PYR(0).GT.0.5D0) ISGN=-1 - MINT(21)=ISGN*ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - IF(MINT(43).EQ.4) KCC=4 - - ELSEIF(ISUB.EQ.279.OR.ISUB.EQ.289) THEN -C...g + g -> ~qi_L + ~qi_Lbar ; th arbitrary -C...pure LL + RR - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.280.OR.ISUB.EQ.290) THEN -C...g + g -> ~qi_R + ~qi_Rbar ; th arbitrary - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.294) THEN -C...qj + g -> ~qj_L + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY1+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - - ELSEIF(ISUB.EQ.295) THEN -C...qj + g -> ~qj_R + ~g - IF(MINT(15).EQ.21) JS=2 - I=MINT(14+JS) - IA=IABS(I) - MINT(20+JS)=ISIGN(KSUSY2+IA,I) - MINT(23-JS)=KSUSY1+21 - KCC=MINT(2)+6 - IF(JS.EQ.2) KCC=KCC+2 - KCS=ISIGN(1,I) - ENDIF - - ELSEIF(ISUB.LE.340) THEN - - IF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN -C...q + qbar' -> H+ + H0 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(37,KCH1+KCH2) - MINT(23-JS)=KFPR(ISUB,2) - ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN -C...f + fbar -> A0 + H0; th arbitrary - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - ELSEIF(ISUB.EQ.301) THEN -C...f + fbar -> H+ H- - MINT(21)=ISIGN(KFPR(ISUB,1),KCS) - MINT(22)=-MINT(21) - ENDIF -CMRENNA-- - - ELSEIF(ISUB.LE.360) THEN - - IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN -C...l + l -> H_L++/--, H_R++/-- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) - - ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN -C...l + gamma -> l' + H++/--; th=(p(l)-p(H))**2 - IF(MINT(15).EQ.22) JS=2 - MINT(20+JS)=ISIGN(KFPR(ISUB,1),-MINT(14+JS)) - MINT(23-JS)=ISIGN(KFPR(ISUB,2),-MINT(14+JS)) - KCC=22 - - ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN -C...f + fbar -> H++ + H--; th = (p(f)-p(H--))**2 - MINT(21)=-ISIGN(KFPR(ISUB,1),MINT(15)) - MINT(22)=-MINT(21) - - ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN -C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- -C...as inner process). - DO 450 JT=1,2 - I=MINT(14+JT) - IA=IABS(I) - IF(IA.LE.10) THEN - RVCKM=VINT(180+I)*PYR(0) - DO 440 J=1,MSTP(1) - IB=2*J-1+MOD(IA,2) - IPM=(5-ISIGN(1,I))/2 - IDC=J+MDCY(IA,2)+2 - IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 440 - MINT(20+JT)=ISIGN(IB,I) - RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) - IF(RVCKM.LE.0D0) GOTO 450 - 440 CONTINUE - ELSE - IB=2*((IA+1)/2)-1+MOD(IA,2) - MINT(20+JT)=ISIGN(IB,I) - ENDIF - 450 CONTINUE - KCC=22 - KFRES=ISIGN(KFPR(ISUB,1),MINT(15)) - IF(MOD(MINT(15),2).EQ.1) KFRES=-KFRES - - ELSEIF(ISUB.EQ.353) THEN -C...f + fbar -> Z_R0 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.354) THEN -C...f + fbar' -> W+/- - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - KFRES=ISIGN(KFPR(ISUB,1),KCH1+KCH2) - - ENDIF - - ELSEIF(ISUB.LE.380) THEN - - IF(ISUB.LE.363.OR.ISUB.EQ.368) THEN -C...f + fbar -> charged+ charged- technicolor - KSW=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUB,1),KSW) - MINT(22)=-ISIGN(KFPR(ISUB,2),KSW) - - ELSEIF(ISUB.LE.367) THEN -C...f + fbar -> neutral neutral technicolor - MINT(21)=KFPR(ISUB,1) - MINT(22)=KFPR(ISUB,2) - - ELSEIF(ISUB.EQ.374.OR.ISUB.EQ.375) THEN -C...f + fbar' -> neutral charged technicolor - IN=1 - IC=2 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 - MINT(23-JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) - MINT(20+JS)=KFPR(ISUB,IN) - - ELSEIF(ISUB.GE.370.AND.ISUB.LE.377) THEN -C...f + fbar' -> charged neutral technicolor - IN=2 - IC=1 - KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) - KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) - IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 - MINT(20+JS)=ISIGN(KFPR(ISUB,IC),KCH1+KCH2) - MINT(23-JS)=KFPR(ISUB,IN) - ENDIF - - ELSEIF(ISUB.LE.400) THEN - IF(ISUB.EQ.381) THEN -C...f + f' -> f + f' (g exchange); th = (p(f)-p(f))**2, TC extensions - KCC=MINT(2) - IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 - - ELSEIF(ISUB.EQ.382) THEN -C...f + fbar -> f' + fbar'; th = (p(f)-p(f'))**2, TC extensions - MINT(21)=ISIGN(KFLF,MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.383) THEN -C...f + fbar -> g + g; th arbitrary, TC extensions - MINT(21)=21 - MINT(22)=21 - KCC=MINT(2)+4 - - ELSEIF(ISUB.EQ.384) THEN -C...f + g -> f + g; th = (p(f)-p(f))**2, TC extensions - IF(MINT(15).EQ.21) JS=2 - KCC=MINT(2)+6 - IF(MINT(15).EQ.21) KCC=KCC+2 - IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) - IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) - - ELSEIF(ISUB.EQ.385) THEN -C...g + g -> f + fbar; th arbitrary, TC extensions - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFLF,KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.386) THEN -C...g + g -> g + g; th arbitrary, TC extensions - KCC=MINT(2)+12 - KCS=(-1)**INT(1.5D0+PYR(0)) - - ELSEIF(ISUB.EQ.387) THEN -C...q + qbar -> Q + Qbar; th = (p(q)-p(Q))**2, TC extensions - MINT(21)=ISIGN(MINT(55),MINT(15)) - MINT(22)=-MINT(21) - KCC=4 - - ELSEIF(ISUB.EQ.388) THEN -C...g + g -> Q + Qbar; th arbitrary, TC extensions - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(MINT(55),KCS) - MINT(22)=-MINT(21) - KCC=MINT(2)+10 - - ELSEIF(ISUB.EQ.391) THEN -C...f + fbar -> G*. - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.392) THEN -C...g + g -> G*. - KCC=21 - KFRES=KFPR(ISUB,1) - - ELSEIF(ISUB.EQ.393) THEN -C...q + qbar -> g + G*; th arbitrary. - IF(PYR(0).GT.0.5D0) JS=2 - MINT(20+JS)=KFPR(ISUB,1) - MINT(23-JS)=KFPR(ISUB,2) - KCC=17+JS - - ELSEIF(ISUB.EQ.394) THEN -C...q + g -> q + G*; th = (p(f) - p(f))**2 - IF(MINT(15).EQ.21) JS=2 - MINT(23-JS)=KFPR(ISUB,2) - KCC=15+JS - KCS=ISIGN(1,MINT(14+JS)) - - ELSEIF(ISUB.EQ.395) THEN -C...g + g -> G* + g; th arbitrary. - IF(PYR(0).GT.0.5D0) JS=2 - MINT(23-JS)=KFPR(ISUB,2) - KCC=22+JS - ENDIF - - ELSEIF(ISUB.LE.402) THEN - IF(ISUB.EQ.401) THEN -C...g + g -> t + b + H+/- - KCS=(-1)**INT(1.5D0+PYR(0)) - MINT(21)=ISIGN(KFPR(ISUBSV,2),KCS) - MINT(22)=ISIGN(5,-KCS) - KCC=11+INT(0.5D0+PYR(0)) - KFRES=ISIGN(KFHIGG,-KCS) - - ELSEIF(ISUB.EQ.402) THEN -C...q + qbar -> t + b + H+/- - KFL=(-1)**INT(1.5D0+PYR(0)) ! Top or bottom - MINT(21)=ISIGN(INT(6.+.5*KFL),KCS) - MINT(22)=ISIGN(INT(6.-.5*KFL),-KCS) - KCC=4 - KFRES=ISIGN(KFHIGG,-KFL*KCS) - ENDIF - ENDIF - - IF(ISET(ISUB).EQ.11) THEN -C...Store documentation for user-defined processes - BEZUP=(PUP(3,1)+PUP(3,2))/(PUP(4,1)+PUP(4,2)) - KUPPO(1)=MINT(83)+5 - KUPPO(2)=MINT(83)+6 - I=MINT(83)+6 - DO 470 IUP=3,NUP - KUPPO(IUP)=0 - IF(MSTP(128).GE.2.AND.MOTHUP(1,IUP).GE.3) THEN - IDOC=IDOC-1 - MINT(4)=MINT(4)-1 - GOTO 470 - ENDIF - I=I+1 - KUPPO(IUP)=I - K(I,1)=21 - K(I,2)=IDUP(IUP) - IF(IDUP(IUP).EQ.0) K(I,2)=90 - K(I,3)=0 - IF(MOTHUP(1,IUP).GE.3) K(I,3)=KUPPO(MOTHUP(1,IUP)) - K(I,4)=0 - K(I,5)=0 - DO 460 J=1,5 - P(I,J)=PUP(J,IUP) - 460 CONTINUE - V(I,5)=VTIMUP(IUP) - 470 CONTINUE - CALL PYROBO(MINT(83)+7,MINT(83)+4+NUP,0D0,VINT(24),0D0,0D0, - & -BEZUP) - -C...Store final state partons for user-defined processes - N=IPU2 - DO 490 IUP=3,NUP - N=N+1 - K(N,1)=1 - IF(ISTUP(IUP).EQ.2.OR.ISTUP(IUP).EQ.3) K(N,1)=11 - K(N,2)=IDUP(IUP) - IF(IDUP(IUP).EQ.0) K(N,2)=90 - IF(MSTP(128).LE.0.OR.MOTHUP(1,IUP).EQ.0) THEN - K(N,3)=KUPPO(IUP) - ELSE - K(N,3)=MINT(84)+MOTHUP(1,IUP) - ENDIF - K(N,4)=0 - K(N,5)=0 - DO 480 J=1,5 - P(N,J)=PUP(J,IUP) - 480 CONTINUE - V(N,5)=VTIMUP(IUP) - 490 CONTINUE - CALL PYROBO(IPU3,N,0D0,VINT(24),0D0,0D0,-BEZUP) - -C...Arrange colour flow for user-defined processes - NLBL=0 - DO 540 IUP1=1,NUP - I1=MINT(84)+IUP1 - IF(KCHG(PYCOMP(K(I1,2)),2).EQ.0) GOTO 540 - IF(K(I1,1).EQ.1) K(I1,1)=3 - IF(K(I1,1).EQ.11) K(I1,1)=14 -C...Find a not yet considered colour/anticolour line. - DO 530 ISDE1=1,2 - IF(ICOLUP(ISDE1,IUP1).EQ.0) GOTO 530 - NMAT=0 - DO 500 ILBL=1,NLBL - IF(ICOLUP(ISDE1,IUP1).EQ.ILAB(ILBL)) NMAT=1 - 500 CONTINUE - IF(NMAT.EQ.0) THEN - NLBL=NLBL+1 - ILAB(NLBL)=ICOLUP(ISDE1,IUP1) -C...Find all others belonging to same line. - I3=I1 - I4=0 - DO 520 IUP2=IUP1+1,NUP - I2=MINT(84)+IUP2 - DO 510 ISDE2=1,2 - IF(ICOLUP(ISDE2,IUP2).EQ.ICOLUP(ISDE1,IUP1)) THEN - IF(ISDE2.EQ.ISDE1) THEN - K(I3,3+ISDE2)=K(I3,3+ISDE2)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I3 - I3=I2 - ELSEIF(I4.NE.0) THEN - K(I4,3+ISDE2)=K(I4,3+ISDE2)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I4 - I4=I2 - ELSEIF(IUP2.LE.2) THEN - K(I1,3+ISDE1)=K(I1,3+ISDE1)+I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+I1 - I4=I2 - ELSE - K(I1,3+ISDE1)=K(I1,3+ISDE1)+MSTU(5)*I2 - K(I2,3+ISDE2)=K(I2,3+ISDE2)+MSTU(5)*I1 - I4=I2 - ENDIF - ENDIF - 510 CONTINUE - 520 CONTINUE - ENDIF - 530 CONTINUE - 540 CONTINUE - - ELSEIF(IDOC.EQ.7) THEN -C...Resonance not decaying; store kinematics - I=MINT(83)+7 - K(IPU3,1)=1 - K(IPU3,2)=KFRES - K(IPU3,3)=I - P(IPU3,4)=SHUSER - P(IPU3,5)=SHUSER - K(I,1)=21 - K(I,2)=KFRES - P(I,4)=SHUSER - P(I,5)=SHUSER - N=IPU3 - MINT(21)=KFRES - MINT(22)=0 - -C...Special cases: colour flow in coloured resonances - KCRES=PYCOMP(KFRES) - IF(KCHG(KCRES,2).NE.0) THEN - K(IPU3,1)=3 - DO 550 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & MINT(84)+ICOL(KCC,1,JC) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & MINT(84)+ICOL(KCC,2,JC) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - 550 CONTINUE - ELSE - K(IPU1,4)=IPU2 - K(IPU1,5)=IPU2 - K(IPU2,4)=IPU1 - K(IPU2,5)=IPU1 - ENDIF - - ELSEIF(IDOC.EQ.8) THEN -C...2 -> 2 processes: store outgoing partons in their CM-frame - DO 560 JT=1,2 - I=MINT(84)+2+JT - KCA=PYCOMP(MINT(20+JT)) - K(I,1)=1 - IF(KCHG(KCA,2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - KFAA=IABS(K(I,2)) - IF(KFPR(ISUBSV,1+MOD(JS+JT,2)).NE.0) THEN - P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) - ELSE - P(I,5)=PYMASS(K(I,2)) - ENDIF - IF((KFAA.EQ.6.OR.KFAA.EQ.7.OR.KFAA.EQ.8).AND. - & P(I,5).LT.PARP(42)) P(I,5)=PYMASS(K(I,2)) - 560 CONTINUE - IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN - KFA1=IABS(MINT(21)) - KFA2=IABS(MINT(22)) - IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21)) - & THEN - MINT(51)=1 - RETURN - ENDIF - P(IPU3,5)=0D0 - P(IPU4,5)=0D0 - ENDIF - P(IPU3,4)=0.5D0*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR) - P(IPU3,3)=SQRT(MAX(0D0,P(IPU3,4)**2-P(IPU3,5)**2)) - P(IPU4,4)=SHR-P(IPU3,4) - P(IPU4,3)=-P(IPU3,3) - N=IPU4 - MINT(7)=MINT(83)+7 - MINT(8)=MINT(83)+8 - -C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4) - CALL PYROBO(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) - - ELSEIF(IDOC.EQ.9) THEN -C...2 -> 3 processes: store outgoing partons in their CM frame - DO 570 JT=1,2 - I=MINT(84)+2+JT - KCA=PYCOMP(MINT(20+JT)) - K(I,1)=1 - IF(KCHG(KCA,2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-3 - JTA=JT -C...t and b in opposide order in event list as compared to matrix element? - IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) JTA=3-JT - IF(IABS(K(I,2)).LE.22) THEN - P(I,5)=PYMASS(K(I,2)) - ELSE - P(I,5)=SQRT(VINT(63+MOD(JS+JTA,2))) - ENDIF - PT=SQRT(MAX(0D0,VINT(197+5*JTA)-P(I,5)**2+VINT(196+5*JTA)**2)) - P(I,1)=PT*COS(VINT(198+5*JTA)) - P(I,2)=PT*SIN(VINT(198+5*JTA)) - 570 CONTINUE - K(IPU5,1)=1 - K(IPU5,2)=KFRES - K(IPU5,3)=MINT(83)+IDOC - P(IPU5,5)=SHR - P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) - P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) - PMS1=P(IPU3,5)**2+P(IPU3,1)**2+P(IPU3,2)**2 - PMS2=P(IPU4,5)**2+P(IPU4,1)**2+P(IPU4,2)**2 - PMS3=P(IPU5,5)**2+P(IPU5,1)**2+P(IPU5,2)**2 - PMT3=SQRT(PMS3) - P(IPU5,3)=PMT3*SINH(VINT(211)) - P(IPU5,4)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-P(IPU5,4))**2-P(IPU5,3)**2 - SQL12=(PMS12-PMS1-PMS2)**2-4D0*PMS1*PMS2 - IF(SQL12.LE.0D0) THEN - MINT(51)=1 - RETURN - ENDIF - P(IPU3,3)=(-P(IPU5,3)*(PMS12+PMS1-PMS2)+ - & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) - P(IPU4,3)=-P(IPU3,3)-P(IPU5,3) - IF(ISUB.EQ.402.AND.IABS(MINT(21)).EQ.5) THEN -C...t and b in opposide order in event list as compared to matrix element - P(IPU4,3)=(-P(IPU5,3)*(PMS12+PMS2-PMS1)+ - & VINT(213)*(SHPR-P(IPU5,4))*SQRT(SQL12))/(2D0*PMS12) - P(IPU3,3)=-P(IPU4,3)-P(IPU5,3) - END IF - P(IPU3,4)=SQRT(PMS1+P(IPU3,3)**2) - P(IPU4,4)=SQRT(PMS2+P(IPU4,3)**2) - MINT(23)=KFRES - N=IPU5 - MINT(7)=MINT(83)+7 - MINT(8)=MINT(83)+8 - - ELSEIF(IDOC.EQ.11) THEN -C...Z0 + Z0 -> h0, W+ + W- -> h0: store Higgs and outgoing partons - PHI(1)=PARU(2)*PYR(0) - PHI(2)=PHI(1)-PHIR - DO 580 JT=1,2 - I=MINT(84)+2+JT - K(I,1)=1 - IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - P(I,5)=PYMASS(K(I,2)) - IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) THEN - MINT(51)=1 - RETURN - ENDIF - PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) - PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) - P(I,1)=PTABS*COS(PHI(JT)) - P(I,2)=PTABS*SIN(PHI(JT)) - P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) - P(I,4)=0.5D0*SHPR*Z(JT) - IZW=MINT(83)+6+JT - K(IZW,1)=21 - K(IZW,2)=23 - IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))) - K(IZW,3)=IZW-2 - P(IZW,1)=-P(I,1) - P(IZW,2)=-P(I,2) - P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) - P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) - P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) - 580 CONTINUE - I=MINT(83)+9 - K(IPU5,1)=1 - K(IPU5,2)=KFRES - K(IPU5,3)=I - P(IPU5,5)=SHR - P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) - P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) - P(IPU5,3)=-P(IPU3,3)-P(IPU4,3) - P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4) - K(I,1)=21 - K(I,2)=KFRES - DO 590 J=1,5 - P(I,J)=P(IPU5,J) - 590 CONTINUE - N=IPU5 - MINT(23)=KFRES - - ELSEIF(IDOC.EQ.12) THEN -C...Z0 and W+/- scattering: store bosons and outgoing partons - PHI(1)=PARU(2)*PYR(0) - PHI(2)=PHI(1)-PHIR - JTRAN=INT(1.5D0+PYR(0)) - DO 600 JT=1,2 - I=MINT(84)+2+JT - K(I,1)=1 - IF(KCHG(PYCOMP(MINT(20+JT)),2).NE.0) K(I,1)=3 - K(I,2)=MINT(20+JT) - K(I,3)=MINT(83)+IDOC+JT-2 - P(I,5)=PYMASS(K(I,2)) - IF(0.5D0*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0D0 - PABS=SQRT(MAX(0D0,(0.5D0*SHPR*Z(JT))**2-P(I,5)**2)) - PTABS=PABS*SQRT(MAX(0D0,1D0-CTHE(JT)**2)) - P(I,1)=PTABS*COS(PHI(JT)) - P(I,2)=PTABS*SIN(PHI(JT)) - P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) - P(I,4)=0.5D0*SHPR*Z(JT) - IZW=MINT(83)+6+JT - K(IZW,1)=21 - IF(MINT(14+JT).EQ.MINT(20+JT)) THEN - K(IZW,2)=23 - ELSE - K(IZW,2)=ISIGN(24,PYCHGE(MINT(14+JT))-PYCHGE(MINT(20+JT))) - ENDIF - K(IZW,3)=IZW-2 - P(IZW,1)=-P(I,1) - P(IZW,2)=-P(I,2) - P(IZW,3)=(0.5D0*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) - P(IZW,4)=0.5D0*SHPR*(1D0-Z(JT)) - P(IZW,5)=-SQRT(MAX(0D0,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) - IPU=MINT(84)+4+JT - K(IPU,1)=3 - K(IPU,2)=KFPR(ISUB,JT) - IF(ISUB.EQ.72.AND.JT.EQ.JTRAN) K(IPU,2)=-K(IPU,2) - IF(ISUB.EQ.73.OR.ISUB.EQ.77) K(IPU,2)=K(IZW,2) - K(IPU,3)=MINT(83)+8+JT - IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN - P(IPU,5)=PYMASS(K(IPU,2)) - ELSE - P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2))) - ENDIF - MINT(22+JT)=K(IPU,2) - 600 CONTINUE -C...Find rotation and boost for hard scattering subsystem - I1=MINT(83)+7 - I2=MINT(83)+8 - BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4)) - BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4)) - BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4)) - GAMCM=(P(I1,4)+P(I2,4))/SHR - BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3) - PX=P(I1,1)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEXCM - PY=P(I1,2)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEYCM - PZ=P(I1,3)+GAMCM*(GAMCM/(1D0+GAMCM)*BEPCM-P(I1,4))*BEZCM - THECM=PYANGL(PZ,SQRT(PX**2+PY**2)) - PHICM=PYANGL(PX,PY) -C...Store hard scattering subsystem. Rotate and boost it - SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4D0*P(IPU5,5)**2* - & P(IPU6,5)**2 - PABS=SQRT(MAX(0D0,SQLAM/(4D0*SH))) - CTHWZ=VINT(23) - STHWZ=SQRT(MAX(0D0,1D0-CTHWZ**2)) - PHIWZ=VINT(24)-PHICM - P(IPU5,1)=PABS*STHWZ*COS(PHIWZ) - P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ) - P(IPU5,3)=PABS*CTHWZ - P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2) - P(IPU6,1)=-P(IPU5,1) - P(IPU6,2)=-P(IPU5,2) - P(IPU6,3)=-P(IPU5,3) - P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2) - CALL PYROBO(IPU5,IPU6,THECM,PHICM,BEXCM,BEYCM,BEZCM) - DO 620 JT=1,2 - I1=MINT(83)+8+JT - I2=MINT(84)+4+JT - K(I1,1)=21 - K(I1,2)=K(I2,2) - DO 610 J=1,5 - P(I1,J)=P(I2,J) - 610 CONTINUE - 620 CONTINUE - N=IPU6 - MINT(7)=MINT(83)+9 - MINT(8)=MINT(83)+10 - ENDIF - - IF(ISET(ISUB).EQ.11) THEN - ELSEIF(IDOC.GE.8) THEN -C...Store colour connection indices - DO 630 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) - 630 CONTINUE - -C...Copy outgoing partons to documentation lines - IMAX=2 - IF(IDOC.EQ.9) IMAX=3 - DO 650 I=1,IMAX - I1=MINT(83)+IDOC-IMAX+I - I2=MINT(84)+2+I - K(I1,1)=21 - K(I1,2)=K(I2,2) - IF(IDOC.LE.9) K(I1,3)=0 - IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I - DO 640 J=1,5 - P(I1,J)=P(I2,J) - 640 CONTINUE - 650 CONTINUE - - ELSEIF(IDOC.EQ.9) THEN -C...Store colour connection indices - DO 660 J=1,2 - JC=J - IF(KCS.EQ.-1) JC=3-J - IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= - & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)+ - & MAX(0,MIN(1,ICOL(KCC,1,JC)-2)) - IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= - & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)+ - & MAX(0,MIN(1,ICOL(KCC,2,JC)-2)) - IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) - IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU5,1).EQ.3) K(IPU5,J+3)= - & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) - 660 CONTINUE - -C...Copy outgoing partons to documentation lines - DO 680 I=1,3 - I1=MINT(83)+IDOC-3+I - I2=MINT(84)+2+I - K(I1,1)=21 - K(I1,2)=K(I2,2) - K(I1,3)=0 - DO 670 J=1,5 - P(I1,J)=P(I2,J) - 670 CONTINUE - 680 CONTINUE - ENDIF - -C...Low-pT events: remove gluons used for string drawing purposes - IF(ISUB.EQ.95) THEN - K(IPU3,1)=K(IPU3,1)+10 - K(IPU4,1)=K(IPU4,1)+10 - DO 690 J=41,66 - VINTSV(J)=VINT(J) - VINT(J)=0D0 - 690 CONTINUE - DO 710 I=MINT(83)+5,MINT(83)+8 - DO 700 J=1,5 - P(I,J)=0D0 - 700 CONTINUE - 710 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSFDC -C...Calculates decays of sfermions. - - SUBROUTINE PYSFDC(KFIN,XLAM,IDLAM,IKNT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - COMPLEX*16 ZMIXC(4,4),VMIXC(2,2),UMIXC(2,2) - COMPLEX*16 CAL,CAR,CBL,CBR,CALP,CARP,CBLP,CBRP,CA,CB - INTEGER KFIN,KCIN - DOUBLE PRECISION XMI,XMJ,XMF,XMSF1,XMSF2,XMW,XMW2,XMZ,AXMJ - DOUBLE PRECISION XMI2,XMI3,XMA2,XMB2,XMFP - DOUBLE PRECISION PYLAMF,XL - DOUBLE PRECISION TANW,XW,AEM,C1,AS - DOUBLE PRECISION AL,AR,BL,BR - DOUBLE PRECISION CH1,CH2,CH3,CH4 - DOUBLE PRECISION XMBOT,XMTOP - DOUBLE PRECISION XLAM(0:400) - INTEGER IDLAM(400,3) - INTEGER LKNT,IX,ILR,IDU,J,I,IKNT,IFL,II - DOUBLE PRECISION SR2 - DOUBLE PRECISION CBETA,SBETA - DOUBLE PRECISION CW - DOUBLE PRECISION BETA,ALFA,XMU,AT,AB,ATRIT,ATRIB,ATRIL - DOUBLE PRECISION COSA,SINA,TANB - DOUBLE PRECISION PYALEM,PI,PYALPS,EI - DOUBLE PRECISION GHRR,GHLL,GHLR,XMB,BLR - INTEGER IG,KF1,KF2 - INTEGER IGG(4),KFNCHI(4),KFCCHI(2) - DATA IGG/23,25,35,36/ - DATA PI/3.141592654D0/ - DATA SR2/1.4142136D0/ - DATA KFNCHI/1000022,1000023,1000025,1000035/ - DATA KFCCHI/1000024,1000037/ - -C...COUNT THE NUMBER OF DECAY MODES - LKNT=0 - -C...NO NU_R DECAYS - IF(KFIN.EQ.KSUSY2+12.OR.KFIN.EQ.KSUSY2+14.OR. - &KFIN.EQ.KSUSY2+16) RETURN - - XMW=PMAS(24,1) - XMW2=XMW**2 - XMZ=PMAS(23,1) - XW=PARU(102) - TANW = SQRT(XW/(1D0-XW)) - CW=SQRT(1D0-XW) - - DO 110 I=1,4 - DO 100 J=1,4 - ZMIXC(J,I)=DCMPLX(ZMIX(J,I),ZMIXI(J,I)) - 100 CONTINUE - 110 CONTINUE - DO 130 I=1,2 - DO 120 J=1,2 - VMIXC(J,I)=DCMPLX(VMIX(J,I),VMIXI(J,I)) - UMIXC(J,I)=DCMPLX(UMIX(J,I),UMIXI(J,I)) - 120 CONTINUE - 130 CONTINUE - -C...KCIN - KCIN=PYCOMP(KFIN) -C...ILR is 1 for left and 2 for right. - ILR=KFIN/KSUSY1 -C...IFL is matching non-SUSY flavour. - IFL=MOD(KFIN,KSUSY1) -C...IDU is weak isospin, 1 for down and 2 for up. - IDU=2-MOD(IFL,2) - - XMI=PMAS(KCIN,1) - XMI2=XMI**2 - AEM=PYALEM(XMI2) - AS =PYALPS(XMI2) - C1=AEM/XW - XMI3=XMI**3 - EI=KCHG(IFL,1)/3D0 - - XMBOT=PYMRUN(5,XMI2) - XMTOP=PYMRUN(6,XMI2) - - TANB=RMSS(5) - BETA=ATAN(TANB) - ALFA=RMSS(18) - CBETA=COS(BETA) - SBETA=TANB*CBETA - SINA=SIN(ALFA) - COSA=COS(ALFA) - XMU=-RMSS(4) - ATRIT=RMSS(16) - ATRIB=RMSS(15) - ATRIL=RMSS(17) - -C...2-BODY DECAYS OF SFERMION -> GRAVITINO + FERMION - - IF(IMSS(11).EQ.1) THEN - XMP=RMSS(29) - IDG=39+KSUSY1 - XMGR=PMAS(PYCOMP(IDG),1) - XFAC=(XMI2/(XMP*XMGR))**2*XMI/48D0/PI - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(XMI.GT.XMGR+XMF) THEN - LKNT=LKNT+1 - IDLAM(LKNT,1)=IDG - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - XLAM(LKNT)=XFAC*(1D0-XMF**2/XMI2)**4 - ENDIF - ENDIF - -C...2-BODY DECAYS OF SFERMION -> FERMION + GAUGE/GAUGINO - -C...CHARGED DECAYS: - DO 140 IX=1,2 -C...DI -> U CHI1-,CHI2- - IF(IDU.EQ.1) THEN - XMFP=PMAS(IFL+1,1) - XMF =PMAS(IFL,1) -C...UI -> D CHI1+,CHI2+ - ELSE - XMFP=PMAS(IFL-1,1) - XMF =PMAS(IFL,1) - ENDIF - XMJ=SMW(IX) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMFP) THEN - XMA2=XMJ**2 - XMB2=XMFP**2 - IF(IDU.EQ.2) THEN - IF(IFL.EQ.6) THEN - XMFP=XMBOT - XMF =XMTOP - ELSEIF(IFL.LT.6) THEN - XMF=0D0 - XMFP=0D0 - ENDIF - CBL=VMIXC(IX,1) - CAL=-XMFP*UMIXC(IX,2)/SR2/XMW/CBETA - CBR=-XMF*VMIXC(IX,2)/SR2/XMW/SBETA - CAR=0D0 - ELSE - IF(IFL.EQ.5) THEN - XMF =XMBOT - XMFP=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - XMFP=0D0 - ENDIF - CBL=UMIXC(IX,1) - CAL=-XMFP*VMIXC(IX,2)/SR2/XMW/SBETA - CBR=-XMF*UMIXC(IX,2)/SR2/XMW/CBETA - CAR=0D0 - ENDIF - - CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR - CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR - CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL - CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL - CAL=CALP - CBL=CBLP - CAR=CARP - CBR=CBRP - -C...F1 -> F` CHI - IF(ILR.EQ.1) THEN - CA=CAL - CB=CBL -C...F2 -> F` CHI - ELSE - CA=CAR - CB=CBR - ENDIF - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMA2,XMB2) -C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT - XLAM(LKNT)=2D0*C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMFP) - IDLAM(LKNT,3)=0 - IF(IDU.EQ.1) THEN - IDLAM(LKNT,1)=-KFCCHI(IX) - IDLAM(LKNT,2)=IFL+1 - ELSE - IDLAM(LKNT,1)=KFCCHI(IX) - IDLAM(LKNT,2)=IFL-1 - ENDIF - ENDIF - 140 CONTINUE - -C...NEUTRAL DECAYS - DO 150 IX=1,4 -C...DI -> D CHI10 - XMF=PMAS(IFL,1) - XMJ=SMZ(IX) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMF) THEN - XMA2=XMJ**2 - XMB2=XMF**2 - IF(IDU.EQ.1) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ENDIF - CBL=-ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI+1) - CAL=XMF*ZMIXC(IX,3)/XMW/CBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ELSE - IF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ENDIF - CBL=ZMIXC(IX,2)+TANW*ZMIXC(IX,1)*(2D0*EI-1) - CAL=XMF*ZMIXC(IX,4)/XMW/SBETA - CAR=-2D0*EI*TANW*ZMIXC(IX,1) - CBR=CAL - ENDIF - - CALP=SFMIX(IFL,1)*CAL + SFMIX(IFL,2)*CAR - CBLP=SFMIX(IFL,1)*CBL + SFMIX(IFL,2)*CBR - CARP=SFMIX(IFL,4)*CAR + SFMIX(IFL,3)*CAL - CBRP=SFMIX(IFL,4)*CBR + SFMIX(IFL,3)*CBL - CAL=CALP - CBL=CBLP - CAR=CARP - CBR=CBRP - -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - CA=CAL - CB=CBL -C...F2 -> F CHI - ELSE - CA=CAR - CB=CBR - ENDIF - LKNT=LKNT+1 - XL=PYLAMF(XMI2,XMA2,XMB2) -C...SPIN AVERAGE = 1/1 NOT 1/2....NO COLOR ENHANCEMENT - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (ABS(CA)**2+ABS(CB)**2)-4D0*DBLE(CA*DCONJG(CB))*XMJ*XMF) - IDLAM(LKNT,1)=KFNCHI(IX) - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - ENDIF - 150 CONTINUE - -C...2-BODY DECAYS TO SM GAUGE AND HIGGS BOSONS -C...IG=23,25,35,36 - DO 160 II=1,4 - IG=IGG(II) - IF(ILR.EQ.1) GOTO 160 - XMB=PMAS(IG,1) - XMSF1=PMAS(PYCOMP(KFIN-KSUSY1),1) - IF(XMI.LT.XMSF1+XMB) GOTO 160 - IF(IG.EQ.23) THEN - BL=-SIGN(.5D0,EI)/CW+EI*XW/CW - BR=EI*XW/CW - BLR=0D0 - ELSEIF(IG.EQ.25) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IDU.EQ.2) THEN - GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*COSA/SBETA - GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*COSA/SBETA - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*(-SINA)/CBETA - GHRR=XMZ/CW*(EI*XW)*(-SIN(ALFA+BETA))+ - & XMF**2/XMW*(-SINA)/CBETA - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW/SBETA*(-XMU*SINA+ - & AT*COSA) - ELSE - GHLR=XMF/2D0/XMW/CBETA*(XMU*COSA- - & AT*SINA) - ENDIF - BL=GHLL - BR=GHRR - BLR=-GHLR - ELSEIF(IG.EQ.35) THEN - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IDU.EQ.2) THEN - GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*SINA/SBETA - GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*SINA/SBETA - ELSE - GHLL=XMZ/CW*(0.5D0-EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*COSA/CBETA - GHRR=XMZ/CW*(EI*XW)*COS(ALFA+BETA)+ - & XMF**2/XMW*COSA/CBETA - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........Need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW/SBETA*(XMU*COSA+ - & AT*SINA) - ELSE - GHLR=XMF/2D0/XMW/CBETA*(XMU*SINA+ - & AT*COSA) - ENDIF - BL=GHLL - BR=GHRR - BLR=GHLR - ELSEIF(IG.EQ.36) THEN - GHLL=0D0 - GHRR=0D0 - IF(IFL.EQ.5) THEN - XMF=XMBOT - ELSEIF(IFL.EQ.6) THEN - XMF=XMTOP - ELSEIF(IFL.LT.5) THEN - XMF=0D0 - ELSE - XMF=PMAS(IFL,1) - ENDIF - IF(IFL.EQ.5) THEN - AT=ATRIB - ELSEIF(IFL.EQ.6) THEN - AT=ATRIT - ELSEIF(IFL.EQ.15) THEN - AT=ATRIL - ELSE - AT=0D0 - ENDIF -C.........Need to complexify - IF(IDU.EQ.2) THEN - GHLR=XMF/2D0/XMW*(-XMU+AT/TANB) - ELSE - GHLR=XMF/2D0/XMW/(-XMU+AT*TANB) - ENDIF - BL=GHLL - BR=GHRR - BLR=GHLR - ENDIF - AL=SFMIX(IFL,1)*SFMIX(IFL,3)*BL+ - & SFMIX(IFL,2)*SFMIX(IFL,4)*BR+ - & (SFMIX(IFL,1)*SFMIX(IFL,4)+SFMIX(IFL,3)*SFMIX(IFL,2))*BLR - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 - IF(IG.EQ.23) THEN - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - ELSE - XLAM(LKNT)=C1/4D0/XMI3*SQRT(XL)*AL**2 - ENDIF - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KFIN-KSUSY1 - IDLAM(LKNT,2)=IG - 160 CONTINUE - -C...SF -> SF' + W - XMB=PMAS(24,1) - IF(MOD(IFL,2).EQ.0) THEN - KF1=KSUSY1+IFL-1 - ELSE - KF1=KSUSY1+IFL+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - IF(XMI.GT.XMB+XMSF1) THEN - IF(MOD(IFL,2).EQ.0) THEN - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,1) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,1) - ENDIF - ELSE - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,1) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,1) - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) - ENDIF - IF(XMI.GT.XMB+XMSF2) THEN - IF(MOD(IFL,2).EQ.0) THEN - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL-1,3) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL-1,3) - ENDIF - ELSE - IF(ILR.EQ.1) THEN - AL=1D0/SR2*SFMIX(IFL,1)*SFMIX(IFL+1,3) - ELSE - AL=1D0/SR2*SFMIX(IFL,3)*SFMIX(IFL+1,3) - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF2**2,XMB**2) - LKNT=LKNT+1 - XLAM(LKNT)=C1/4D0/XMI3*XL**1.5D0/XMB**2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=SIGN(24,KCHG(IFL,1)) - ENDIF - -C...SF -> SF' + HC - XMB=PMAS(37,1) - IF(MOD(IFL,2).EQ.0) THEN - KF1=KSUSY1+IFL-1 - ELSE - KF1=KSUSY1+IFL+1 - ENDIF - KF2=KF1+KSUSY1 - XMSF1=PMAS(PYCOMP(KF1),1) - XMSF2=PMAS(PYCOMP(KF2),1) - IF(XMI.GT.XMB+XMSF1) THEN - XMF=0D0 - XMFP=0D0 - AT=0D0 - AB=0D0 - IF(MOD(IFL,2).EQ.0) THEN -C...T1-> B1 HC - IF(ILR.EQ.1) THEN - CH1=-SFMIX(IFL,1)*SFMIX(IFL-1,1) - CH2= SFMIX(IFL,2)*SFMIX(IFL-1,2) - CH3=-SFMIX(IFL,1)*SFMIX(IFL-1,2) - CH4=-SFMIX(IFL,2)*SFMIX(IFL-1,1) -C...T2-> B1 HC - ELSE - CH1= SFMIX(IFL,3)*SFMIX(IFL-1,1) - CH2=-SFMIX(IFL,4)*SFMIX(IFL-1,2) - CH3= SFMIX(IFL,3)*SFMIX(IFL-1,2) - CH4= SFMIX(IFL,4)*SFMIX(IFL-1,1) - ENDIF - IF(IFL.EQ.6) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ELSE -C...B1 -> T1 HC - IF(ILR.EQ.1) THEN - CH1=-SFMIX(IFL+1,1)*SFMIX(IFL,1) - CH2= SFMIX(IFL+1,2)*SFMIX(IFL,2) - CH3=-SFMIX(IFL+1,1)*SFMIX(IFL,2) - CH4=-SFMIX(IFL+1,2)*SFMIX(IFL,1) -C...B2-> T1 HC - ELSE - CH1= SFMIX(IFL,3)*SFMIX(IFL+1,1) - CH2=-SFMIX(IFL,4)*SFMIX(IFL+1,2) - CH3= SFMIX(IFL,4)*SFMIX(IFL+1,1) - CH4= SFMIX(IFL,3)*SFMIX(IFL+1,2) - ENDIF - IF(IFL.EQ.5) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 -C.......Need to complexify - AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ - & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ - & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF1 - IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) - ENDIF - IF(XMI.GT.XMB+XMSF2) THEN - XMF=0D0 - XMFP=0D0 - AT=0D0 - AB=0D0 - IF(MOD(IFL,2).EQ.0) THEN -C...T1-> B2 HC - IF(ILR.EQ.1) THEN - CH1= SFMIX(IFL-1,3)*SFMIX(IFL,1) - CH2=-SFMIX(IFL-1,4)*SFMIX(IFL,2) - CH3= SFMIX(IFL-1,4)*SFMIX(IFL,1) - CH4= SFMIX(IFL-1,3)*SFMIX(IFL,2) -C...T2-> B2 HC - ELSE - CH1= -SFMIX(IFL,3)*SFMIX(IFL-1,3) - CH2= SFMIX(IFL,4)*SFMIX(IFL-1,4) - CH3= -SFMIX(IFL,3)*SFMIX(IFL-1,4) - CH4= -SFMIX(IFL,4)*SFMIX(IFL-1,3) - ENDIF - IF(IFL.EQ.6) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ELSE -C...B1 -> T2 HC - IF(ILR.EQ.1) THEN - CH1= SFMIX(IFL+1,3)*SFMIX(IFL,1) - CH2=-SFMIX(IFL+1,4)*SFMIX(IFL,2) - CH3= SFMIX(IFL+1,3)*SFMIX(IFL,2) - CH4= SFMIX(IFL+1,4)*SFMIX(IFL,1) -C...B2-> T2 HC - ELSE - CH1= -SFMIX(IFL+1,3)*SFMIX(IFL,3) - CH2= SFMIX(IFL+1,4)*SFMIX(IFL,4) - CH3= -SFMIX(IFL+1,3)*SFMIX(IFL,4) - CH4= -SFMIX(IFL+1,4)*SFMIX(IFL,3) - ENDIF - IF(IFL.EQ.5) THEN - XMF=XMTOP - XMFP=XMBOT - AT=ATRIT - AB=ATRIB - ENDIF - ENDIF - XL=PYLAMF(XMI2,XMSF1**2,XMB**2) - LKNT=LKNT+1 -C.......Need to complexify - AL=CH1*(XMW2*2D0*CBETA*SBETA-XMFP**2*TANB-XMF**2/TANB)+ - & CH2*2D0*XMF*XMFP/(2D0*CBETA*SBETA)+ - & CH3*XMFP*(-XMU+AB*TANB)+CH4*XMF*(-XMU+AT/TANB) - XLAM(LKNT)=C1/8D0/XMI3*SQRT(XL)/XMW2*AL**2 - IDLAM(LKNT,3)=0 - IDLAM(LKNT,1)=KF2 - IDLAM(LKNT,2)=SIGN(37,KCHG(IFL,1)) - ENDIF - -C...2-BODY DECAYS OF SQUARK -> QUARK GLUINO - - IF(IFL.LE.6) THEN - XMFP=0D0 - XMF=0D0 - IF(IFL.EQ.6) XMF=PMAS(6,1) - IF(IFL.EQ.5) XMF=PMAS(5,1) - XMJ=PMAS(PYCOMP(KSUSY1+21),1) - AXMJ=ABS(XMJ) - IF(XMI.GE.AXMJ+XMF) THEN - AL=-SFMIX(IFL,3) - BL=SFMIX(IFL,1) - AR=-SFMIX(IFL,4) - BR=SFMIX(IFL,2) -C...F1 -> F CHI - IF(ILR.EQ.1) THEN - XCA=AL - XCB=BL -C...F2 -> F CHI - ELSE - XCA=AR - XCB=BR - ENDIF - LKNT=LKNT+1 - XMA2=XMJ**2 - XMB2=XMF**2 - XL=PYLAMF(XMI2,XMA2,XMB2) - XLAM(LKNT)=4D0/3D0*AS/2D0/XMI3*SQRT(XL)*((XMI2-XMB2-XMA2)* - & (XCA**2+XCB**2)+4D0*XCA*XCB*XMJ*XMF) - IDLAM(LKNT,1)=KSUSY1+21 - IDLAM(LKNT,2)=IFL - IDLAM(LKNT,3)=0 - ENDIF - ENDIF - -C...IF NOTHING ELSE FOR T1, THEN T1* -> C+CHI0 - IF(KFIN.EQ.KSUSY1+6.AND.PMAS(KCIN,1).GT. - &PMAS(PYCOMP(KSUSY1+22),1)+PMAS(4,1)) THEN -C...THIS IS A BACK-OF-THE-ENVELOPE ESTIMATE -C...M = 1/(16PI**2)G**3 = G*2/(4PI) G/(4PI) = C1 * G/(4PI) -C...M*M = C1**2 * G**2/(16PI**2) -C...G = 1/(8PI)P/MI**2 * M*M = C1**3/(32PI**2)*LAM/(2*MI**3) - LKNT=LKNT+1 - XL=PYLAMF(XMI2,0D0,PMAS(PYCOMP(KSUSY1+22),1)**2) - XLAM(LKNT)=C1**3/64D0/PI**2/XMI3*SQRT(XL) - IF(XLAM(LKNT).EQ.0) XLAM(LKNT)=1D-3 - IDLAM(LKNT,1)=KSUSY1+22 - IDLAM(LKNT,2)=4 - IDLAM(LKNT,3)=0 - ENDIF - -C...R-violating sfermion decays (SKANDS). - CALL PYRVSF(KFIN,XLAM,IDLAM,LKNT) - - IKNT=LKNT - XLAM(0)=0D0 - DO 170 I=1,IKNT - IF(XLAM(I).LT.0D0) XLAM(I)=0D0 - XLAM(0)=XLAM(0)+XLAM(I) - 170 CONTINUE - IF(XLAM(0).EQ.0D0) XLAM(0)=1D-3 - - RETURN - END - -C********************************************************************* - -C...PYSGEX -C...Subprocess cross sections for assorted exotic processes, -C...including Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGEX(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.160) THEN - IF(ISUB.EQ.141) THEN -C...f + fbar -> gamma*/Z0/Z'0 - SQMZP=PMAS(32,1)**2 - MINT(61)=2 - CALL PYWIDT(32,SH,WDTP,WDTE) - HP0=AEM/3D0*SH - HP1=AEM/3D0*XWC*SH - HP2=HP1 - HS=SHR*VINT(117) - HSP=SHR*WDTP(0) - FACZP=4D0*COMFAC*3D0 - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - IA=IABS(I) - IF(IA.LT.10) THEN - IF(IA.LE.2) THEN - VPI=PARU(123-2*MOD(IABS(I),2)) - API=PARU(124-2*MOD(IABS(I),2)) - ELSEIF(IA.LE.4) THEN - VPI=PARJ(182-2*MOD(IABS(I),2)) - API=PARJ(183-2*MOD(IABS(I),2)) - ELSE - VPI=PARJ(190-2*MOD(IABS(I),2)) - API=PARJ(191-2*MOD(IABS(I),2)) - ENDIF - ELSE - IF(IA.LE.12) THEN - VPI=PARU(127-2*MOD(IABS(I),2)) - API=PARU(128-2*MOD(IABS(I),2)) - ELSEIF(IA.LE.14) THEN - VPI=PARJ(186-2*MOD(IABS(I),2)) - API=PARJ(187-2*MOD(IABS(I),2)) - ELSE - VPI=PARJ(194-2*MOD(IABS(I),2)) - API=PARJ(195-2*MOD(IABS(I),2)) - ENDIF - ENDIF - HI0=HP0 - IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 - HI1=HP1 - IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 - HI2=HP2 - IF(IABS(I).LE.10) HI2=HI2*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZP*(EI**2/SH2*HI0*HP0*VINT(111)+EI*VI* - & (1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)*(HI0*HP1+HI1*HP0)* - & VINT(112)+EI*VPI*(1D0-SQMZP/SH)/((SH-SQMZP)**2+HSP**2)* - & (HI0*HP2+HI2*HP0)*VINT(113)+(VI**2+AI**2)/ - & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)+(VI*VPI+AI*API)* - & ((SH-SQMZ)*(SH-SQMZP)+HS*HSP)/(((SH-SQMZ)**2+HS**2)* - & ((SH-SQMZP)**2+HSP**2))*(HI1*HP2+HI2*HP1)*VINT(115)+ - & (VPI**2+API**2)/((SH-SQMZP)**2+HSP**2)*HI2*HP2*VINT(116)) - 100 CONTINUE - - ELSEIF(ISUB.EQ.142) THEN -C...f + fbar' -> W'+/- - SQMWP=PMAS(34,1)**2 - CALL PYWIDT(34,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMWP)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - IA=IABS(I) - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 110 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*(PARU(133)**2+PARU(134)**2) - IF(IA.LE.10) HI=HP*(PARU(131)**2+PARU(132)**2)* - & VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.144) THEN -C...f + fbar' -> R - SQMR=PMAS(41,1)**2 - CALL PYWIDT(41,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMR)**2+HS**2)*3D0 - HP=AEM/(12D0*XW)*SH - DO 140 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 - IA=IABS(I) - DO 130 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 - JA=IABS(J) - IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 130 - HI=HP - IF(IA.LE.10) HI=HI*FACA/3D0 - HF=SHR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 130 CONTINUE - 140 CONTINUE - - ELSEIF(ISUB.EQ.145) THEN -C...q + l -> LQ (leptoquark) - SQMLQ=PMAS(42,1)**2 - CALL PYWIDT(42,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMLQ)**2+HS**2) - IF(ABS(SHR-PMAS(42,1)).GT.PARP(48)*PMAS(42,2)) FACBW=0D0 - HP=AEM/4D0*SH - KFLQQ=KFDP(MDCY(42,2),1) - KFLQL=KFDP(MDCY(42,2),2) - DO 160 I=MMIN1,MMAX1 - IF(KFAC(1,I).EQ.0) GOTO 160 - IA=IABS(I) - IF(IA.NE.KFLQQ.AND.IA.NE.IABS(KFLQL)) GOTO 160 - DO 150 J=MMIN2,MMAX2 - IF(KFAC(2,J).EQ.0) GOTO 150 - JA=IABS(J) - IF(JA.NE.KFLQQ.AND.JA.NE.IABS(KFLQL)) GOTO 150 - IF(I*J.NE.KFLQQ*KFLQL) GOTO 150 - IF(JA.EQ.IA) GOTO 150 - IF(IA.EQ.KFLQQ) KCHLQ=ISIGN(1,I) - IF(JA.EQ.KFLQQ) KCHLQ=ISIGN(1,J) - HI=HP*PARU(151) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHLQ)/2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 150 CONTINUE - 160 CONTINUE - - ELSEIF(ISUB.EQ.146) THEN -C...e + gamma* -> e* (excited lepton) - KFQSTR=KFPR(ISUB,1) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) - QF=-RTCM(43)/2D0-RTCM(44)/2D0 - FACBW=FACBW*AEM*QF**2*SH/RTCM(41)**2 - IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) - & FACBW=0D0 - HP=SH - DO 180 I=-KFQEXC,KFQEXC,2*KFQEXC - DO 170 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 170 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 170 - HI=HP - IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 170 CONTINUE - 180 CONTINUE - - ELSEIF(ISUB.EQ.147.OR.ISUB.EQ.148) THEN -C...d + g -> d* and u + g -> u* (excited quarks) - KFQSTR=KFPR(ISUB,1) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - CALL PYWIDT(KFQSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC/((SH-PMAS(KCQSTR,1)**2)**2+HS**2) - FACBW=FACBW*AS*RTCM(45)**2*SH/(3D0*RTCM(41)**2) - IF(ABS(SHR-PMAS(KCQSTR,1)).GT.PARP(48)*PMAS(KCQSTR,2)) - & FACBW=0D0 - HP=SH - DO 200 I=-KFQEXC,KFQEXC,2*KFQEXC - DO 190 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 190 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 190 - HI=HP - IF(I.GT.0) HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(I.LT.0) HF=SHR*(WDTE(0,1)+WDTE(0,3)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 190 CONTINUE - 200 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.190) THEN - IF(ISUB.EQ.162) THEN -C...q + g -> LQ + lbar; LQ=leptoquark - SQMLQ=PMAS(42,1)**2 - FACLQ=COMFAC*FACA*PARU(151)*(AS*AEM/6D0)*(-TH/SH)* - & (UH2+SQMLQ**2)/(UH-SQMLQ)**2 - KFLQQ=KFDP(MDCY(42,2),1) - DO 220 I=MMINA,MMAXA - IF(IABS(I).NE.KFLQQ) GOTO 220 - KCHLQ=ISIGN(1,I) - DO 210 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 210 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 210 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLQ*WIDS(42,(5-KCHLQ)/2) - 210 CONTINUE - 220 CONTINUE - - ELSEIF(ISUB.EQ.163) THEN -C...g + g -> LQ + LQbar; LQ=leptoquark - SQMLQ=PMAS(42,1)**2 - FACLQ=COMFAC*FACA*WIDS(42,1)*(AS**2/2D0)* - & (7D0/48D0+3D0*(UH-TH)**2/(16D0*SH2))*(1D0+2D0*SQMLQ*TH/ - & (TH-SQMLQ)**2+2D0*SQMLQ*UH/(UH-SQMLQ)**2+4D0*SQMLQ**2/ - & ((TH-SQMLQ)*(UH-SQMLQ))) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 230 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 -C...Since don't know proper colour flow, randomize between alternatives - ISIG(NCHN,3)=INT(1.5D0+PYR(0)) - SIGH(NCHN)=FACLQ - 230 CONTINUE - - ELSEIF(ISUB.EQ.164) THEN -C...q + qbar -> LQ + LQbar; LQ=leptoquark - DELTA=0.25D0*(SQM3-SQM4)**2/SH - SQMLQ=0.5D0*(SQM3+SQM4)-DELTA - TH=TH-DELTA - UH=UH-DELTA -C SQMLQ=PMAS(42,1)**2 - FACLQA=COMFAC*WIDS(42,1)*(AS**2/9D0)* - & (SH*(SH-4D0*SQMLQ)-(UH-TH)**2)/SH2 - FACLQS=COMFAC*WIDS(42,1)*((PARU(151)**2*AEM**2/8D0)* - & (-SH*TH-(SQMLQ-TH)**2)/TH2+(PARU(151)*AEM*AS/18D0)* - & ((SQMLQ-TH)*(UH-TH)+SH*(SQMLQ+TH))/(SH*TH)) - KFLQQ=KFDP(MDCY(42,2),1) - DO 240 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 240 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLQA - IF(IABS(I).EQ.KFLQQ) SIGH(NCHN)=FACLQA+FACLQS - 240 CONTINUE - - ELSEIF(ISUB.EQ.167.OR.ISUB.EQ.168) THEN -C...q + q' -> q" + d* and q + q' -> q" + u* (excited quarks) - KFQSTR=KFPR(ISUB,2) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - FACQSA=COMFAC*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH) - FACQSB=COMFAC*0.25D0*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* - & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) -C...Propagators: as simulated in PYOFSH and as desired - GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) - HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) - CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) - GMMQC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) - FACQSA=FACQSA*HBW4C/HBW4 - FACQSB=FACQSB*HBW4C/HBW4 -C...Branching ratios. - BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) - BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) - DO 260 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 260 - DO 250 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 250 - IF(IA.EQ.KFQEXC.AND.I.EQ.J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS - IF(I.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRPOS - IF(J.LT.0) SIGH(NCHN)=(4D0/3D0)*FACQSA*BRNEG - ELSEIF((IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC).AND.I*J.GT.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 - IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSA*BRPOS - IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSA*BRNEG - ELSEIF(IA.EQ.KFQEXC.AND.I.EQ.-J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=(8D0/3D0)*FACQSB*BRNEG - ELSEIF(I.EQ.-J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG - ELSEIF(IA.EQ.KFQEXC.OR.JA.EQ.KFQEXC) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(JA.EQ.KFQEXC) ISIG(NCHN,3)=2 - IF(ISIG(NCHN,ISIG(NCHN,3)).GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(ISIG(NCHN,ISIG(NCHN,3)).LT.0) SIGH(NCHN)=FACQSB*BRNEG - ENDIF - 250 CONTINUE - 260 CONTINUE - - ELSEIF(ISUB.EQ.169) THEN -C...q + qbar -> e + e* (excited lepton) - KFQSTR=KFPR(ISUB,2) - KCQSTR=PYCOMP(KFQSTR) - KFQEXC=MOD(KFQSTR,KEXCIT) - FACQSB=(COMFAC/12D0)*(SH/RTCM(41)**2)**2*(1D0-SQM4/SH)* - & (1D0+SQM4/SH)*(1D0+CTH)*(1D0+((SH-SQM4)/(SH+SQM4))*CTH) -C...Propagators: as simulated in PYOFSH and as desired - GMMQ=PMAS(KCQSTR,1)*PMAS(KCQSTR,2) - HBW4=GMMQ/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQ**2) - CALL PYWIDT(KFQSTR,SQM4,WDTP,WDTE) - GMMQC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMQC/((SQM4-PMAS(KCQSTR,1)**2)**2+GMMQC**2) - FACQSB=FACQSB*HBW4C/HBW4 -C...Branching ratios. - BRPOS=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) - BRNEG=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) - DO 270 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.6.OR.KFAC(1,I).EQ.0) GOTO 270 - J=-I - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.6.OR.KFAC(2,J).EQ.0) GOTO 270 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(I.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(I.LT.0) SIGH(NCHN)=FACQSB*BRNEG - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(J.GT.0) SIGH(NCHN)=FACQSB*BRPOS - IF(J.LT.0) SIGH(NCHN)=FACQSB*BRNEG - 270 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.360) THEN - IF(ISUB.EQ.341.OR.ISUB.EQ.342) THEN -C...l + l -> H_L++/-- or H_R++/--. - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - CALL PYWIDT(KFRES,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=8D0*COMFAC/((SH-PMAS(KFREC,1)**2)**2+HS**2) - DO 290 I=MMIN1,MMAX1 - IA=IABS(I) - IF((IA.NE.11.AND.IA.NE.13.AND.IA.NE.15).OR.KFAC(1,I).EQ.0) - & GOTO 290 - DO 280 J=MMIN2,MMAX2 - JA=IABS(J) - IF((JA.NE.11.AND.JA.NE.13.AND.JA.NE.15).OR.KFAC(2,J).EQ.0) - & GOTO 280 - IF(I*J.LT.0) GOTO 280 - KCHH=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HI=SH*PARP(181+3*((IA-11)/2)+(JA-11)/2)**2/(8D0*PARU(1)) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 280 CONTINUE - 290 CONTINUE - - ELSEIF(ISUB.GE.343.AND.ISUB.LE.348) THEN -C...l + gamma -> H_L++/-- l' or l + gamma -> H_R++/-- l'. - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) -C...Propagators: as simulated in PYOFSH and as desired - HBW3=PMAS(KFREC,1)*PMAS(KFREC,2)/((SQM3-PMAS(KFREC,1)**2)**2+ - & (PMAS(KFREC,1)*PMAS(KFREC,2))**2) - CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) - GMMC=SQRT(SQM3)*WDTP(0) - HBW3C=GMMC/((SQM3-PMAS(KFREC,1)**2)**2+GMMC**2) - FHCC=COMFAC*AEM*HBW3C/HBW3 - DO 310 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.11.AND.IA.NE.13.AND.IA.NE.15) GOTO 310 - SQML=PMAS(IA,1)**2 - J=ISIGN(KFPR(ISUB,2),-I) - KCHH=ISIGN(2,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4))/WDTP(0) - SMM1=8D0*(SH+TH-SQM3)*(SH+TH-2D0*SQM3-SQML-SQM4)/ - & (UH-SQM3)**2 - SMM2=2D0*((2D0*SQM3-3D0*SQML)*SQM4+(SQML-2D0*SQM4)*TH- - & (TH-SQM4)*SH)/(TH-SQM4)**2 - SMM3=2D0*((2D0*SQM3-3D0*SQM4+TH)*SQML-(2D0*SQML-SQM4+TH)* - & SH)/(SH-SQML)**2 - SMM12=4D0*((2D0*SQML-SQM4-2D0*SQM3+TH)*SH+(TH-3D0*SQM3- - & 3D0*SQM4)*TH+(2D0*SQM3-2D0*SQML+3D0*SQM4)*SQM3)/ - & ((UH-SQM3)*(TH-SQM4)) - SMM13=-4D0*((TH+SQML-2D0*SQM4)*TH-(SQM3+3D0*SQML-2D0*SQM4)* - & SQM3+(SQM3+3D0*SQML+TH)*SH-(TH-SQM3+SH)**2)/ - & ((UH-SQM3)*(SH-SQML)) - SMM23=-4D0*((SQML-SQM4+SQM3)*TH-SQM3**2+SQM3*(SQML+SQM4)- - & 3D0*SQML*SQM4-(SQML-SQM4-SQM3+TH)*SH)/ - & ((SH-SQML)*(TH-SQM4)) - SMM=(SH/(SH-SQML))**2*(SMM1+SMM2+SMM3+SMM12+SMM13+SMM23)* - & PARP(181+3*((IA-11)/2)+(IABS(J)-11)/2)**2/(4D0*PARU(1)) - DO 300 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 300 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 300 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=0 - SIGH(NCHN)=FHCC*SMM*WIDSC - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.349.OR.ISUB.EQ.350) THEN -C...f + fbar -> H_L++ + H_L-- or H_R++ + H_R-- - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - SQMH=PMAS(KFREC,1)**2 - GMMH=PMAS(KFREC,1)*PMAS(KFREC,2) -C...Propagators: H++/-- as simulated in PYOFSH and as desired - HBW3=GMMH/((SQM3-SQMH)**2+GMMH**2) - CALL PYWIDT(KFRES,SQM3,WDTP,WDTE) - GMMH3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMH3/((SQM3-SQMH)**2+GMMH3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFRES,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) -C...Kinematical and coupling functions - FACHH=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*(TH*UH-SQM3*SQM4) - XWHH=(1D0-2D0*XWV)/(8D0*XWV*(1D0-XWV)) -C...Loop over allowed flavours - DO 320 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF(ISUB.EQ.349) THEN - HBWZ=1D0/((SH-SQMZ)**2+GMMZ**2) - IF(IABS(I).LT.10) THEN - DSIGHH=8D0*AEM**2*(EI**2/SH2+ - & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ - & (VI**2+AI**2)*XWHH**2*HBWZ) - ELSE - IAOFF=181+3*((IABS(I)-11)/2) - HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ - & (4D0*PARU(1)) - DSIGHH=8D0*AEM**2*(EI**2/SH2+ - & 2D0*EI*VI*XWHH*(SH-SQMZ)*HBWZ/SH+ - & (VI**2+AI**2)*XWHH**2*HBWZ)+ - & 8D0*AEM*(EI*HSUM/(SH*TH)+ - & (VI+AI)*XWHH*HSUM*(SH-SQMZ)*HBWZ/TH)+ - & 4D0*HSUM**2/TH2 - ENDIF - ELSE - IF(IABS(I).LT.10) THEN - DSIGHH=8D0*AEM**2*EI**2/SH2 - ELSE - IAOFF=181+3*((IABS(I)-11)/2) - HSUM=(PARP(IAOFF)**2+PARP(IAOFF+1)**2+PARP(IAOFF+2)**2)/ - & (4D0*PARU(1)) - DSIGHH=8D0*AEM**2*EI**2/SH2+8D0*AEM*EI*HSUM/(SH*TH)+ - & 4D0*HSUM**2/TH2 - ENDIF - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHH*FCOI*DSIGHH - 320 CONTINUE - - ELSEIF(ISUB.EQ.351.OR.ISUB.EQ.352) THEN -C...f + f' -> f" + f"' + H++/-- (W+/- + W+/- -> H++/-- as inner process) - KFRES=KFPR(ISUB,1) - KFREC=PYCOMP(KFRES) - SQMH=PMAS(KFREC,1)**2 - IF(ISUB.EQ.351) FACNOR=PARP(190)**8*PARP(192)**2 - IF(ISUB.EQ.352) FACNOR=PARP(191)**6*2D0* - & PMAS(PYCOMP(9900024),1)**2 - FACWW=COMFAC*FACNOR*TAUP*VINT(2)*VINT(219) - FACPRT=1D0/((VINT(204)**2-VINT(215))* - & (VINT(209)**2-VINT(216))) - FACPRU=1D0/((VINT(204)**2+2D0*VINT(217))* - & (VINT(209)**2+2D0*VINT(218))) - CALL PYWIDT(KFRES,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=(1D0/PARU(1))*VINT(2)/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFREC,1)).GT.PARP(48)*PMAS(KFREC,2)) - & FACBW=0D0 - DO 340 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340 - IF(ISUB.EQ.352.AND.IABS(I).GT.10) GOTO 340 - KCHWI=(1-2*MOD(IABS(I),2))*ISIGN(1,I) - DO 330 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330 - IF(ISUB.EQ.352.AND.IABS(J).GT.10) GOTO 330 - KCHWJ=(1-2*MOD(IABS(J),2))*ISIGN(1,J) - KCHH=KCHWI+KCHWJ - IF(IABS(KCHH).NE.2) GOTO 330 - FACLR=VINT(180+I)*VINT(180+J) - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHH/2)/2)+WDTE(0,4)) - IF(I.EQ.J.AND.IABS(I).GT.10) THEN - FACPRP=0.5D0*(FACPRT+FACPRU)**2 - ELSE - FACPRP=FACPRT**2 - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLR*FACWW*FACPRP*FACBW*HF - 330 CONTINUE - 340 CONTINUE - - ELSEIF(ISUB.EQ.353) THEN -C...f + fbar -> Z_R0 - SQMZR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 - CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMZR)**2+HS**2)*3D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HP=(AEM/(3D0*(1D0-2D0*XW)))*XWC*SH - DO 350 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350 - IF(IABS(I).LE.8) THEN - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0)*(1D0-2D0*XW) - VI=SIGN(1D0,EI+0.1D0)-4D0*EI*XW - ELSE - AI=-(1D0-2D0*XW) - VI=-1D0+4D0*XW - ENDIF - HI=HP*(VI**2+AI**2) - IF(IABS(I).LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 350 CONTINUE - - ELSEIF(ISUB.EQ.354) THEN -C...f + fbar' -> W_R+/- - SQMWR=PMAS(PYCOMP(KFPR(ISUB,1)),1)**2 - CALL PYWIDT(KFPR(ISUB,1),SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMWR)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 370 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370 - IA=IABS(I) - DO 360 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 360 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*2D0 - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 360 CONTINUE - 370 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.400) THEN - IF(ISUB.EQ.391) THEN -C...f + fbar -> G*. - KFGSTR=KFPR(ISUB,1) - KCGSTR=PYCOMP(KFGSTR) - CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACG=COMFAC*PARP(50)**2/(16D0*PARU(1))*SH*HF/ - & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) -C...Modify cross section in wings of peak. - FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4 - DO 380 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 - HI=1D0 - IF(IABS(I).LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG*HI - 380 CONTINUE - - ELSEIF(ISUB.EQ.392) THEN -C...g + g -> G*. - KFGSTR=KFPR(ISUB,1) - KCGSTR=PYCOMP(KFGSTR) - CALL PYWIDT(KFGSTR,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACG=COMFAC*PARP(50)**2/(32D0*PARU(1))*SH*HF/ - & ((SH-PMAS(KCGSTR,1)**2)**2+HS**2) -C...Modify cross section in wings of peak. - FACG = FACG * SH**2 / PMAS(KCGSTR,1)**4 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 390 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 390 CONTINUE - - ELSEIF(ISUB.EQ.393) THEN -C...q + qbar -> g + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=COMFAC*PARP(50)**2*AS*SH/(72D0*PARU(1)*SQM4)* - & (4D0*(TH2+UH2)/SH2+9D0*(TH+UH)/SH+(TH2/UH+UH2/TH)/SH+ - & 3D0*(4D0+TH/UH+UH/TH)+4D0*(SH/UH+SH/TH)+ - & 2D0*SH2/(TH*UH)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - DO 400 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 400 CONTINUE - - ELSEIF(ISUB.EQ.394) THEN -C...q + g -> q + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=-COMFAC*PARP(50)**2*AS*SH/(192D0*PARU(1)*SQM4)* - & (4D0*(SH2+UH2)/(TH*SH)+9D0*(SH+UH)/SH+SH/UH+UH2/SH2+ - & 3D0*TH*(4D0+SH/UH+UH/SH)/SH+4D0*TH2*(1D0/UH+1D0/SH)/SH+ - & 2D0*TH2*TH/(UH*SH2)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - DO 420 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 420 - DO 410 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 410 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - 410 CONTINUE - 420 CONTINUE - - ELSEIF(ISUB.EQ.395) THEN -C...g + g -> g + G*. - KFGSTR=KFPR(ISUB,2) - KCGSTR=PYCOMP(KFGSTR) - FACG=COMFAC*3D0*PARP(50)**2*AS*SH/(32D0*PARU(1)*SQM4)* - & ((TH2+TH*UH+UH2)**2/(SH2*TH*UH)+2D0*(TH2/UH+UH2/TH)/SH+ - & 3D0*(TH/UH+UH/TH)+2D0*(SH/UH+SH/TH)+SH2/(TH*UH)) -C...Propagators: as simulated in PYOFSH and as desired - GMMG=PMAS(KCGSTR,1)*PMAS(KCGSTR,2) - HBW4=GMMG/((SQM4-PMAS(KCGSTR,1)**2)**2+GMMG**2) - CALL PYWIDT(KFGSTR,SQM4,WDTP,WDTE) - HS=SQRT(SQM4)*WDTP(0) - HF=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HBW4C=HF/((SQM4-PMAS(KCGSTR,1)**2)**2+HS**2) - FACG=FACG*HBW4C/HBW4 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACG - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGHF -C...Subprocess cross sections for heavy flavour production, -C...open and closed. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGHF(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.100) THEN - IF(ISUB.EQ.81) THEN -C...q + qbar -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ - & 2D0*SQMAVG/SH) - IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQB=FACQQB*WID2 - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 100 CONTINUE - - ELSEIF(ISUB.EQ.82) THEN -C...g + g -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 - IF(MSTP(35).GE.1) THEN - FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) - FACQQ1=FACQQ1*FATRE - FACQQ2=FACQQ2*FATRE - ENDIF - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ1=FACQQ1*WID2 - FACQQ2=FACQQ2*WID2 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 110 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 110 CONTINUE - - ELSEIF(ISUB.EQ.83) THEN -C...f + q -> f' + Q - FACQQS=COMFAC*(0.5D0*AEM/XW)**2*SH*(SH-SQM3)/(SQMW-TH)**2 - FACQQU=COMFAC*(0.5D0*AEM/XW)**2*UH*(UH-SQM3)/(SQMW-TH)**2 - DO 130 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 130 - DO 120 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 120 - IF(I*J.GT.0.AND.MOD(IABS(I+J),2).EQ.0) GOTO 120 - IF(I*J.LT.0.AND.MOD(IABS(I+J),2).EQ.1) GOTO 120 - IF(IABS(I).LT.MINT(55).AND.MOD(IABS(I+MINT(55)),2).EQ.1) - & THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, - & (IABS(I)+1)/2)*VINT(180+J) - IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(I)/2, - & (MINT(55)+1)/2)*VINT(180+J) - WID2=1D0 - IF(I.GT.0) THEN - IF(MINT(55).EQ.6) WID2=WIDS(6,2) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),2) - ELSE - IF(MINT(55).EQ.6) WID2=WIDS(6,3) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),3) - ENDIF - IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 - IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 - ENDIF - IF(IABS(J).LT.MINT(55).AND.MOD(IABS(J+MINT(55)),2).EQ.1) - & THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(MOD(MINT(55),2).EQ.0) FACCKM=VCKM(MINT(55)/2, - & (IABS(J)+1)/2)*VINT(180+I) - IF(MOD(MINT(55),2).EQ.1) FACCKM=VCKM(IABS(J)/2, - & (MINT(55)+1)/2)*VINT(180+I) - IF(J.GT.0) THEN - IF(MINT(55).EQ.6) WID2=WIDS(6,2) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),2) - ELSE - IF(MINT(55).EQ.6) WID2=WIDS(6,3) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2= - & WIDS(MINT(55),3) - ENDIF - IF(I*J.GT.0) SIGH(NCHN)=FACQQS*FACCKM*WID2 - IF(I*J.LT.0) SIGH(NCHN)=FACQQU*FACCKM*WID2 - ENDIF - 120 CONTINUE - 130 CONTINUE - - ELSEIF(ISUB.EQ.84) THEN -C...g + gamma -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQ=COMFAC*AS*AEM*(KCHG(IABS(MINT(55)),1)/3D0)**2* - & (THQ**2+UHQ**2+4D0*SQMAVG*SH*(1D0-SQMAVG*SH/(THQ*UHQ)))/ - & (THQ*UHQ) - IF(MSTP(35).GE.1) FACQQ=FACQQ*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ=FACQQ*WID2 - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.EQ.85) THEN -C...gamma + gamma -> F + Fbar (heavy fermion, quark or lepton) - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACFF=COMFAC*AEM**2*(KCHG(IABS(MINT(56)),1)/3D0)**4*2D0* - & ((1D0-PARJ(131)*PARJ(132))*(THQ*UHQ-SQMAVG*SH)* - & (UHQ**2+THQ**2+2D0*SQMAVG*SH)+(1D0+PARJ(131)*PARJ(132))* - & SQMAVG*SH**2*(SH-2D0*SQMAVG))/(THQ*UHQ)**2 - IF(IABS(MINT(56)).LT.10) FACFF=3D0*FACFF - IF(IABS(MINT(56)).LT.10.AND.MSTP(35).GE.1) - & FACFF=FACFF*PYHFTH(SH,SQMAVG,1D0) - WID2=1D0 - IF(MINT(56).EQ.6) WID2=WIDS(6,1) - IF(MINT(56).EQ.7.OR.MINT(56).EQ.8) WID2=WIDS(MINT(56),1) - IF(MINT(56).EQ.17) WID2=WIDS(17,1) - FACFF=FACFF*WID2 - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ELSEIF(ISUB.EQ.86) THEN -C...g + g -> J/Psi + g - FACQQG=COMFAC*AS**3*(5D0/9D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.87) THEN -C...g + g -> chi_0c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & (9D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- - & 6D0*RGTW*PGTW**3*QGTW*(2D0*RGTW**4-5D0*RGTW**2*PGTW+PGTW**2)- - & PGTW**2*QGTW**2*(RGTW**4+2D0*RGTW**2*PGTW-PGTW**2)+ - & 2D0*RGTW*PGTW*QGTW**3*(RGTW**2-PGTW)+6D0*RGTW**2*QGTW**4)/ - & (QGTW*(QGTW-RGTW*PGTW)**4) - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.88) THEN -C...g + g -> chi_1c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*12D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & PGTW**2*(RGTW*PGTW**2*(RGTW**2-4D0*PGTW)+2D0*QGTW*(-RGTW**4+ - & 5D0*RGTW**2*PGTW+PGTW**2)-15D0*RGTW*QGTW**2)/ - & (QGTW-RGTW*PGTW)**4 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.89) THEN -C...g + g -> chi_2c + g - PGTW=(SH*TH+TH*UH+UH*SH)/SH2 - QGTW=(SH*TH*UH)/SH**3 - RGTW=SQM3/SH - FACQQG=COMFAC*AS**3*4D0*(PARP(39)/SQRT(SQM3))*(1D0/SH)* - & (12D0*RGTW**2*PGTW**4*(RGTW**4-2D0*RGTW**2*PGTW+PGTW**2)- - & 3D0*RGTW*PGTW**3*QGTW*(8D0*RGTW**4-RGTW**2*PGTW+4D0*PGTW**2)+ - & 2D0*PGTW**2*QGTW**2*(-7D0*RGTW**4+43D0*RGTW**2*PGTW+PGTW**2)+ - & RGTW*PGTW*QGTW**3*(16D0*RGTW**2-61D0*PGTW)+12D0*RGTW**2* - & QGTW**4)/(QGTW*(QGTW-RGTW*PGTW)**4) - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.104) THEN -C...g + g -> chi_c0. - KC=PYCOMP(10441) - FACBW=COMFAC*12D0*AS**2*PARP(39)*PMAS(KC,2)/ - & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) - IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACBW - ENDIF - - ELSEIF(ISUB.EQ.105) THEN -C...g + g -> chi_c2. - KC=PYCOMP(445) - FACBW=COMFAC*16D0*AS**2*PARP(39)*PMAS(KC,2)/ - & ((SH-PMAS(KC,1)**2)**2+(PMAS(KC,1)*PMAS(KC,2))**2) - IF(ABS(SQRT(SH)-PMAS(KC,1)).GT.50D0*PMAS(KC,2)) FACBW=0D0 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACBW - ENDIF - - ELSEIF(ISUB.EQ.106) THEN -C...g + g -> J/Psi + gamma. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM*EQ**2*AS**2*(4D0/3D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.107) THEN -C...g + gamma -> J/Psi + g. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM*EQ**2*AS**2*(32D0/3D0)*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - - ELSEIF(ISUB.EQ.108) THEN -C...gamma + gamma -> J/Psi + gamma. - EQ=2D0/3D0 - FACQQG=COMFAC*AEM**3*EQ**6*384D0*PARP(38)*SQRT(SQM3)* - & (((SH*(SH-SQM3))**2+(TH*(TH-SQM3))**2+(UH*(UH-SQM3))**2)/ - & ((TH-SQM3)*(UH-SQM3))**2)/(SH-SQM3)**2 - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQG - ENDIF - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGHG -C...Subprocess cross sections for Higgs processes, -C...except Higgs pairs in PYSGSU, but including WW scattering. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGHG(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSUBS/,/PYMSSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 A004,A204,A114,A00U,A20U,A11U - COMPLEX*16 CIGTOT,CIZTOT,F0ALP,F1ALP,F2ALP,F0BET,F1BET,F2BET,FIF - -C...Convert H or A process into equivalent h one - IHIGG=1 - KFHIGG=25 - IF(ISUB.EQ.401.OR.ISUB.EQ.402) THEN - KFHIGG=KFPR(ISUB,1) - END IF - IF((ISUB.GE.151.AND.ISUB.LE.160).OR.(ISUB.GE.171.AND. - &ISUB.LE.190)) THEN - IHIGG=2 - IF(MOD(ISUB-1,10).GE.5) IHIGG=3 - KFHIGG=33+IHIGG - IF(ISUB.EQ.151.OR.ISUB.EQ.156) ISUB=3 - IF(ISUB.EQ.152.OR.ISUB.EQ.157) ISUB=102 - IF(ISUB.EQ.153.OR.ISUB.EQ.158) ISUB=103 - IF(ISUB.EQ.171.OR.ISUB.EQ.176) ISUB=24 - IF(ISUB.EQ.172.OR.ISUB.EQ.177) ISUB=26 - IF(ISUB.EQ.173.OR.ISUB.EQ.178) ISUB=123 - IF(ISUB.EQ.174.OR.ISUB.EQ.179) ISUB=124 - IF(ISUB.EQ.181.OR.ISUB.EQ.186) ISUB=121 - IF(ISUB.EQ.182.OR.ISUB.EQ.187) ISUB=122 - IF(ISUB.EQ.183.OR.ISUB.EQ.188) ISUB=111 - IF(ISUB.EQ.184.OR.ISUB.EQ.189) ISUB=112 - IF(ISUB.EQ.185.OR.ISUB.EQ.190) ISUB=113 - ENDIF - SQMH=PMAS(KFHIGG,1)**2 - GMMH=PMAS(KFHIGG,1)*PMAS(KFHIGG,2) - -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - IF((MSTP(46).GE.3.AND.MSTP(46).LE.6).AND.(ISUB.EQ.71.OR.ISUB.EQ. - &72.OR.ISUB.EQ.73.OR.ISUB.EQ.76.OR.ISUB.EQ.77)) THEN -C...Calculate M_R and N_R functions for Higgs-like and QCD-like models - IF(MSTP(46).LE.4) THEN - HDTLH=LOG(PMAS(25,1)/PARP(44)) - HDTMR=(4.5D0*PARU(1)/SQRT(3D0)-74D0/9D0)/8D0+HDTLH/12D0 - HDTNR=-1D0/18D0+HDTLH/6D0 - ELSE - HDTNM=0.125D0*(1D0/(288D0*PARU(1)**2)+(PARP(47)/PARP(45))**2) - HDTLQ=LOG(PARP(45)/PARP(44)) - HDTMR=-(4D0*PARU(1))**2*0.5D0*HDTNM+HDTLQ/12D0 - HDTNR=(4D0*PARU(1))**2*HDTNM+HDTLQ/6D0 - ENDIF - -C...Calculate lowest and next-to-lowest order partial wave amplitudes - HDTV=1D0/(16D0*PARU(1)*PARP(47)**2) - A00L=DBLE(HDTV*SH) - A20L=-0.5D0*A00L - A11L=A00L/6D0 - HDTLS=LOG(SH/PARP(44)**2) - A004=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* - & CMPLX(DBLE((176D0*HDTMR+112D0*HDTNR)/3D0+11D0/27D0- - & (50D0/9D0)*HDTLS),DBLE(4D0*PARU(1))) - A204=DBLE((HDTV*SH)**2/(4D0*PARU(1)))* - & CMPLX(DBLE(32D0*(HDTMR+2D0*HDTNR)/3D0+25D0/54D0- - & (20D0/9D0)*HDTLS),DBLE(PARU(1))) - A114=DBLE((HDTV*SH)**2/(6D0*PARU(1)))* - & CMPLX(DBLE(4D0*(-2D0*HDTMR+HDTNR)-1D0/18D0),DBLE(PARU(1)/6D0)) - -C...Unitarize partial wave amplitudes with Pade or K-matrix method - IF(MSTP(46).EQ.3.OR.MSTP(46).EQ.5) THEN - A00U=A00L/(1D0-A004/A00L) - A20U=A20L/(1D0-A204/A20L) - A11U=A11L/(1D0-A114/A11L) - ELSE - A00U=(A00L+DBLE(A004))/(1D0-DCMPLX(0.D0,A00L+DBLE(A004))) - A20U=(A20L+DBLE(A204))/(1D0-DCMPLX(0.D0,A20L+DBLE(A204))) - A11U=(A11L+DBLE(A114))/(1D0-DCMPLX(0.D0,A11L+DBLE(A114))) - ENDIF - ENDIF - -C...Differential cross section expressions. - - IF(ISUB.LE.60) THEN - IF(ISUB.EQ.3) THEN -C...f + fbar -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - IA=IABS(I) - RMQ=PYMRUN(IA,SH)**2/SH - HI=HP*RMQ - IF(IA.LE.10) HI=HP*RMQ*FACA/3D0 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - HI=HI*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - HI=HI/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - HI=HI*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 100 CONTINUE - - ELSEIF(ISUB.EQ.5) THEN -C...Z0 + Z0 -> h0 - CALL PYWIDT(25,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HI=HP/4D0 - FACI=8D0/(PARU(1)**2*XW1)*(AEM*XWC)**2 - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACI*(VI**2+AI**2)*(VJ**2+AJ**2)*HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.8) THEN -C...W+ + W- -> h0 - CALL PYWIDT(25,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(25,1)).GT.PARP(48)*PMAS(25,2)) FACBW=0D0 - HP=AEM/(8D0*XW)*SH/SQMW*SH - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - HI=HP/2D0 - FACI=1D0/(4D0*PARU(1)**2)*(AEM/XW)**2 - DO 140 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 140 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 130 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 130 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 130 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACI*VINT(180+I)*VINT(180+J)*HI*FACBW*HF - 130 CONTINUE - 140 CONTINUE - - ELSEIF(ISUB.EQ.24) THEN -C...f + fbar -> Z0 + h0 (or H0, or A0) -C...Propagators: Z0, h0 as simulated in PYOFSH and as desired - HBW3=GMMZ/((SQM3-SQMZ)**2+GMMZ**2) - CALL PYWIDT(23,SQM3,WDTP,WDTE) - GMMZ3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMZ3/((SQM3-SQMZ)**2+GMMZ3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACHZ=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4)*8D0*(AEM*XWC)**2* - & (THUH+2D0*SH*SQM3)/((SH-SQMZ)**2+GMMZ**2) - FACHZ=FACHZ*WIDS(23,2)*WIDS(KFHIGG,2) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHZ=FACHZ* - & PARU(154+10*IHIGG)**2 - DO 150 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHZ*FCOI*(VI**2+AI**2) - 150 CONTINUE - - ELSEIF(ISUB.EQ.26) THEN -C...f + fbar' -> W+/- + h0 (or H0, or A0) -C...Propagators: W+-, h0 as simulated in PYOFSH and as desired - HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM3,WDTP,WDTE) - GMMW3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - GMMH4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMH4/((SQM4-SQMH)**2+GMMH4**2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACHW=COMFAC*0.125D0*(AEM/XW)**2*(THUH+2D0*SH*SQM3)/ - & ((SH-SQMW)**2+GMMW**2)*(HBW3C/HBW3)*(HBW4C/HBW4) - FACHW=FACHW*WIDS(KFHIGG,2) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACHW=FACHW* - & PARU(155+10*IHIGG)**2 - DO 170 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 170 - DO 160 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(1,J).EQ.0) GOTO 160 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 160 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=1D0 - IF(IA.LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHW*FCOI*FCKM*WIDS(24,(5-KCHW)/2) - 160 CONTINUE - 170 CONTINUE - - ELSEIF(ISUB.EQ.32) THEN -C...f + g -> f + h0 (q + g -> q + h0 only) - FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24D0 -C...H propagator: as simulated in PYOFSH and as desired - SQMHC=PMAS(25,1)**2 - GMMHC=PMAS(25,1)*PMAS(25,2) - HBW4=GMMHC/((SQM4-SQMHC)**2+GMMHC**2) - CALL PYWIDT(25,SQM4,WDTP,WDTE) - GMMHCC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMHCC/((SQM4-SQMHC)**2+GMMHCC**2) - FHCQ=FHCQ*HBW4C/HBW4 - DO 190 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.5) GOTO 190 - SQML=PYMRUN(IA,SH)**2 - SQMQ=PMAS(IA,1)**2 - FACHCQ=FHCQ*SQML/SQMW* - & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH- - & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* - & (SQMHC-SQMQ-SH)/SH) - DO 180 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHCQ*WIDS(25,2) - 180 CONTINUE - 190 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.71) THEN -C...Z0 + Z0 -> Z0 + Z0 - IF(SH.LE.4.01D0*SQMZ) GOTO 220 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-4D0*SQMZ/SH - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 220 - SHANG=1D0/XW1*SQMW/SQMZ*(1D0+BE2)**2 - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - THANG=1D0/XW1*SQMW/SQMZ*(BE2-CTH)**2 - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - UHANG=1D0/XW1*SQMW/SQMZ*(BE2+CTH)**2 - AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG - AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG - FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* - & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATHRE+AUHRE)**2+ - & (ASHIM+ATHIM+AUHIM)**2) - IF(MSTP(46).EQ.2) FACZZ=0D0 - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZZ=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* - & ABS(A00U+2D0*A20U)**2 - ENDIF - FACZZ=FACZZ*WIDS(23,1) - - DO 210 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - DO 200 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 200 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*AVI*AVJ - 200 CONTINUE - 210 CONTINUE - 220 CONTINUE - - ELSEIF(ISUB.EQ.72) THEN -C...Z0 + Z0 -> W+ + W- - IF(SH.LE.4.01D0*SQMZ) GOTO 250 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) - CTH2=CTH**2 - TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) - UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 250 - SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* - & (1D0-2D0*SQMZ/SH) - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - ATWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - AUWIM=0D0 - A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) - A4IM=0D0 - FACWW=COMFAC*1D0/(4096D0*PARU(1)**2*16D0*XW1**2)* - & (AEM/XW)**4*(SH/SQMW)**2*(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACWW=FACWW*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACWW=FACWW*((ASHRE+ATWRE+AUWRE+A4RE)**2+ - & (ASHIM+ATWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACWW=FACWW*((ATWRE+AUWRE+A4RE)**2+ - & (ATWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACWW=COMFAC*(AEM/(16D0*PARU(1)*XW*XW1))**2*(64D0/9D0)* - & ABS(A00U-A20U)**2 - ENDIF - FACWW=FACWW*WIDS(24,1) - - DO 240 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - DO 230 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AJ-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*AVI*AVJ - 230 CONTINUE - 240 CONTINUE - 250 CONTINUE - - ELSEIF(ISUB.EQ.73) THEN -C...Z0 + W+/- -> Z0 + W+/- - IF(SH.LE.2D0*SQMZ+2D0*SQMW) GOTO 280 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-2D0*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2 - EP1=1D0-(SQMZ-SQMW)/SH - EP2=1D0+(SQMZ-SQMW)/SH - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=(SQMZ-SQMW)**2/SH-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 280 - THANG=(BE2-EP1*CTH)*(BE2-EP2*CTH) - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - ASWRE=-XW1/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+ - & 1D0/4D0*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4D0*BE2*CTH)+ - & 2D0*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH- - & 1D0/16D0*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2) - ASWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)* - & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)* - & (BE2+EP1*EP2*CTH)*(2D0*EP2-EP2*CTH+EP1)- - & BE2*(EP2+EP1*CTH)**2*(BE2-EP2**2*CTH)-1D0/8D0* - & (BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+ - & 1D0/32D0*SH/SQMW*(BE2+EP1*EP2*CTH)**2* - & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)* - & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)* - & (2D0*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2* - & (BE2-EP1**2*CTH)-1D0/8D0*(BE2+EP1*EP2*CTH)**2* - & ((EP1+EP2)**2+2D0*BE2*(1D0-CTH))+1D0/32D0*SH/SQMW* - & (BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2) - AUWIM=0D0 - A4RE=XW1/SQMZ*(EP1**2*EP2**2*(CTH**2-1D0)- - & 2D0*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2D0*BE2*EP1*EP2) - A4IM=0D0 - FACZW=COMFAC*1D0/(4096D0*PARU(1)**2*4D0*XW1)*(AEM/XW)**4* - & (SH/SQMW)**2*SQRT(SQMZ/SQMW)*SH2 - IF(MSTP(46).LE.0) FACZW=0D0 - IF(MSTP(46).EQ.1) FACZW=FACZW*((ATHRE+ASWRE+AUWRE+A4RE)**2+ - & (ATHIM+ASWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACZW=FACZW*((ASWRE+AUWRE+A4RE)**2+ - & (ASWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZW=COMFAC*AEM**2/(64D0*PARU(1)**2*XW**2*XW1)*16D0* - & ABS(A20U+3D0*A11U*DBLE(CTH))**2 - ENDIF - FACZW=FACZW*WIDS(23,2) - - DO 270 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 270 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - AVI=AI**2+VI**2 - KCHWI=ISIGN(1,KCHG(IABS(I),1)*ISIGN(1,I)) - DO 260 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 260 - EJ=KCHG(IABS(J),1)/3D0 - AJ=SIGN(1D0,EJ) - VJ=AI-4D0*EJ*XWV - AVJ=AJ**2+VJ**2 - KCHWJ=ISIGN(1,KCHG(IABS(J),1)*ISIGN(1,J)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*AVI*VINT(180+J)*WIDS(24,(5-KCHWJ)/2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACZW*VINT(180+I)*WIDS(24,(5-KCHWI)/2)*AVJ - 260 CONTINUE - 270 CONTINUE - 280 CONTINUE - - ELSEIF(ISUB.EQ.75) THEN -C...W+ + W- -> gamma + gamma - - ELSEIF(ISUB.EQ.76) THEN -C...W+ + W- -> Z0 + Z0 - IF(SH.LE.4.01D0*SQMZ) GOTO 310 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=SQRT((1D0-4D0*SQMW/SH)*(1D0-4D0*SQMZ/SH)) - CTH2=CTH**2 - TH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH-BE2*CTH) - UH=-0.5D0*SH*(1D0-2D0*(SQMW+SQMZ)/SH+BE2*CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 310 - SHANG=4D0*SQRT(SQMW/(SQMZ*XW1))*(1D0-2D0*SQMW/SH)* - & (1D0-2D0*SQMZ/SH) - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - ATWRE=XW1/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3D0/2D0+BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2+ - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - ATWIM=0D0 - AUWRE=XW1/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3D0/2D0-BE2/2D0* - & CTH-(SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4D0* - & ((SQMW+SQMZ)/SH*(1D0-3D0*CTH2)+8D0*SQMW*SQMZ/SH2* - & (2D0*CTH2-1D0)+4D0*(SQMW**2+SQMZ**2)/SH2*CTH2- - & 2D0*(SQMW+SQMZ)/SH*BE2*CTH)) - AUWIM=0D0 - A4RE=2D0*XW1/SQMZ*(3D0-CTH2-4D0*(SQMW+SQMZ)/SH) - A4IM=0D0 - FACZZ=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* - & (SH/SQMW)**2*SH2 - IF(MSTP(46).LE.0) FACZZ=FACZZ*(ASHRE**2+ASHIM**2) - IF(MSTP(46).EQ.1) FACZZ=FACZZ*((ASHRE+ATWRE+AUWRE+A4RE)**2+ - & (ASHIM+ATWIM+AUWIM+A4IM)**2) - IF(MSTP(46).EQ.2) FACZZ=FACZZ*((ATWRE+AUWRE+A4RE)**2+ - & (ATWIM+AUWIM+A4IM)**2) - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FACZZ=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* - & ABS(A00U-A20U)**2 - ENDIF - FACZZ=FACZZ*WIDS(23,1) - - DO 300 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 290 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 290 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*VINT(180+I)*VINT(180+J) - 290 CONTINUE - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.77) THEN -C...W+/- + W+/- -> W+/- + W+/- - IF(SH.LE.4.01D0*SQMW) GOTO 340 - - IF(MSTP(46).LE.2) THEN -C...Exact scattering ME:s for on-mass-shell gauge bosons - BE2=1D0-4D0*SQMW/SH - BE4=BE2**2 - CTH2=CTH**2 - CTH3=CTH**3 - TH=-0.5D0*SH*BE2*(1D0-CTH) - UH=-0.5D0*SH*BE2*(1D0+CTH) - IF(MAX(TH,UH).GT.-1D0) GOTO 340 - SHANG=(1D0+BE2)**2 - ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG - ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG - THANG=(BE2-CTH)**2 - ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG - ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG - UHANG=(BE2+CTH)**2 - AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG - AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG - SGZANG=1D0/SQMW*BE2*(3D0-BE2)**2*CTH - ASGRE=XW*SGZANG - ASGIM=0D0 - ASZRE=XW1*SH/(SH-SQMZ)*SGZANG - ASZIM=0D0 - TGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)+BE2*(4D0-10D0*BE2+ - & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2+BE2*CTH3) - ATGRE=0.5D0*XW*SH/TH*TGZANG - ATGIM=0D0 - ATZRE=0.5D0*XW1*SH/(TH-SQMZ)*TGZANG - ATZIM=0D0 - UGZANG=1D0/SQMW*(BE2*(4D0-2D0*BE2+BE4)-BE2*(4D0-10D0*BE2+ - & BE4)*CTH+(2D0-11D0*BE2+10D0*BE4)*CTH2-BE2*CTH3) - AUGRE=0.5D0*XW*SH/UH*UGZANG - AUGIM=0D0 - AUZRE=0.5D0*XW1*SH/(UH-SQMZ)*UGZANG - AUZIM=0D0 - A4ARE=1D0/SQMW*(1D0+2D0*BE2-6D0*BE2*CTH-CTH2) - A4AIM=0D0 - A4SRE=2D0/SQMW*(1D0+2D0*BE2-CTH2) - A4SIM=0D0 - FWW=COMFAC*1D0/(4096D0*PARU(1)**2)*(AEM/XW)**4* - & (SH/SQMW)**2*SH2 - IF(MSTP(46).LE.0) THEN - AWWARE=ASHRE - AWWAIM=ASHIM - AWWSRE=0D0 - AWWSIM=0D0 - ELSEIF(MSTP(46).EQ.1) THEN - AWWARE=ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4ARE - AWWAIM=ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4AIM - AWWSRE=-ATHRE-AUHRE+ATGRE+ATZRE+AUGRE+AUZRE+A4SRE - AWWSIM=-ATHIM-AUHIM+ATGIM+ATZIM+AUGIM+AUZIM+A4SIM - ELSE - AWWARE=ASGRE+ASZRE+ATGRE+ATZRE+A4ARE - AWWAIM=ASGIM+ASZIM+ATGIM+ATZIM+A4AIM - AWWSRE=ATGRE+ATZRE+AUGRE+AUZRE+A4SRE - AWWSIM=ATGIM+ATZIM+AUGIM+AUZIM+A4SIM - ENDIF - AWWA2=AWWARE**2+AWWAIM**2 - AWWS2=AWWSRE**2+AWWSIM**2 - - ELSE -C...Strongly interacting Z_L/W_L model of Dobado, Herrero, Terron - FWWA=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*(64D0/9D0)* - & ABS(A00U+0.5D0*A20U+4.5D0*A11U*DBLE(CTH))**2 - FWWS=COMFAC*(AEM/(4D0*PARU(1)*XW))**2*64D0*ABS(A20U)**2 - ENDIF - - DO 330 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 330 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 320 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 320 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.LT.0D0) THEN -C...W+W- - IF(MSTP(45).EQ.1) GOTO 320 - IF(MSTP(46).LE.2) FACWW=FWW*AWWA2*WIDS(24,1) - IF(MSTP(46).GE.3) FACWW=FWWA*WIDS(24,1) - ELSE -C...W+W+/W-W- - IF(MSTP(45).EQ.2) GOTO 320 - IF(MSTP(46).LE.2) FACWW=FWW*AWWS2 - IF(MSTP(46).GE.3) FACWW=FWWS - IF(EI.GT.0D0) FACWW=FACWW*WIDS(24,4) - IF(EI.LT.0D0) FACWW=FACWW*WIDS(24,5) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*VINT(180+I)*VINT(180+J) - IF(EI*EJ.GT.0D0) SIGH(NCHN)=0.5D0*SIGH(NCHN) - 320 CONTINUE - 330 CONTINUE - 340 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.120) THEN - IF(ISUB.EQ.102) THEN -C...g + g -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HI=SHR*WDTP(13)/32D0 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 350 CONTINUE - - ELSEIF(ISUB.EQ.103) THEN -C...gamma + gamma -> h0 (or H0, or A0) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=4D0*COMFAC/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - HI=SHR*WDTP(14)*2D0 - IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 360 - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 360 CONTINUE - - ELSEIF(ISUB.EQ.110) THEN -C...f + fbar -> gamma + h0 - THUH=MAX(TH*UH,SH*CKIN(3)**2) - FACHG=COMFAC*(3D0*AEM**4)/(2D0*PARU(1)**2*XW*SQMW)*SH*THUH - FACHG=FACHG*WIDS(KFHIGG,2) -C...Calculate loop contributions for intermediate gamma* and Z0 - CIGTOT=DCMPLX(0D0,0D0) - CIZTOT=DCMPLX(0D0,0D0) - JMAX=3*MSTP(1)+1 - DO 370 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - FNC=1D0 - EJ=KCHG(J,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - BALP=SQM4/(2D0*PMAS(J,1))**2 - BBET=SH/(2D0*PMAS(J,1))**2 - ELSEIF(J.LE.3*MSTP(1)) THEN - FNC=3D0 - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - BALP=SQM4/(2D0*PMAS(10+JL,1))**2 - BBET=SH/(2D0*PMAS(10+JL,1))**2 - ELSE - BALP=SQM4/(2D0*PMAS(24,1))**2 - BBET=SH/(2D0*PMAS(24,1))**2 - ENDIF - BABI=1D0/(BALP-BBET) - IF(BALP.LT.1D0) THEN - F0ALP=DCMPLX(DBLE(ASIN(SQRT(BALP))),0D0) - F1ALP=F0ALP**2 - ELSE - F0ALP=DCMPLX(DBLE(LOG(SQRT(BALP)+SQRT(BALP-1D0))), - & -DBLE(0.5D0*PARU(1))) - F1ALP=-F0ALP**2 - ENDIF - F2ALP=DBLE(SQRT(ABS(BALP-1D0)/BALP))*F0ALP - IF(BBET.LT.1D0) THEN - F0BET=DCMPLX(DBLE(ASIN(SQRT(BBET))),0D0) - F1BET=F0BET**2 - ELSE - F0BET=DCMPLX(DBLE(LOG(SQRT(BBET)+SQRT(BBET-1D0))), - & -DBLE(0.5D0*PARU(1))) - F1BET=-F0BET**2 - ENDIF - F2BET=DBLE(SQRT(ABS(BBET-1D0)/BBET))*F0BET - IF(J.LE.3*MSTP(1)) THEN - FIF=DBLE(0.5D0*BABI)+DBLE(BABI**2)*(DBLE(0.5D0*(1D0-BALP+ - & BBET))*(F1BET-F1ALP)+DBLE(BBET)*(F2BET-F2ALP)) - CIGTOT=CIGTOT+DBLE(FNC*EJ**2)*FIF - CIZTOT=CIZTOT+DBLE(FNC*EJ*VJ)*FIF - ELSE - TXW=XW/XW1 - CIGTOT=CIGTOT-0.5*(DBLE(BABI*(1.5D0+BALP))+DBLE(BABI**2)* - & (DBLE(1.5D0-3D0*BALP+4D0*BBET)*(F1BET-F1ALP)+ - & DBLE(BBET*(2D0*BALP+3D0))*(F2BET-F2ALP))) - CIZTOT=CIZTOT-DBLE(0.5D0*BABI*XW1)*(DBLE(5D0-TXW+2D0*BALP* - & (1D0-TXW))*(1D0+DBLE(2D0*BABI*BBET)*(F2BET-F2ALP))+ - & DBLE(BABI*(4D0*BBET*(3D0-TXW)-(2D0*BALP-1D0)*(5D0-TXW)))* - & (F1BET-F1ALP)) - ENDIF - 370 CONTINUE - CIGTOT=CIGTOT/DBLE(SH) - CIZTOT=CIZTOT*DBLE(XWC)/DCMPLX(DBLE(SH-SQMZ),DBLE(GMMZ)) -C...Loop over initial flavours - DO 380 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHG*FCOI*(ABS(DBLE(EI)*CIGTOT+DBLE(VI)* - & CIZTOT)**2+AI**2*ABS(CIZTOT)**2) - 380 CONTINUE - - ELSEIF(ISUB.EQ.111) THEN -C...f + fbar -> g + h0 (q + qbar -> g + h0 only) - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACGH=COMFAC*FACA*(2D0/9D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (TH**2+UH**2)/(SH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACGH=FACGH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A5STUR=0D0 - A5STUI=0D0 - DO 390 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPSH=4D0*SQMQ/SQMH - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - A5STUR=A5STUR+EPSH*(1D0+SH/(TH+UH)*(W1SR-W1HR)+ - & (0.25D0-SQMQ/(TH+UH))*(W2SR-W2HR)) - A5STUI=A5STUI+EPSH*(SH/(TH+UH)*(W1SI-W1HI)+ - & (0.25D0-SQMQ/(TH+UH))*(W2SI-W2HI)) - 390 CONTINUE - FACGH=COMFAC*FACA/(144D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* - & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2) - FACGH=FACGH*WIDS(25,2) - ENDIF - DO 400 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGH - 400 CONTINUE - - ELSEIF(ISUB.EQ.112) THEN -C...f + g -> f + h0 (q + g -> q + h0 only) - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACQH=COMFAC*FACA*(1D0/12D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (SH**2+UH**2)/(-TH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACQH=FACQH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A5TSUR=0D0 - A5TSUI=0D0 - DO 410 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPST=4D0*SQMQ/TH - EPSH=4D0*SQMQ/SQMH - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - A5TSUR=A5TSUR+EPSH*(1D0+TH/(SH+UH)*(W1TR-W1HR)+ - & (0.25D0-SQMQ/(SH+UH))*(W2TR-W2HR)) - A5TSUI=A5TSUI+EPSH*(TH/(SH+UH)*(W1TI-W1HI)+ - & (0.25D0-SQMQ/(SH+UH))*(W2TI-W2HI)) - 410 CONTINUE - FACQH=COMFAC*FACA/(384D0*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* - & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2) - FACQH=FACQH*WIDS(25,2) - ENDIF - DO 430 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 - DO 420 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQH - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.113) THEN -C...g + g -> g + h0 - IF(MSTP(38).NE.0) THEN -C...Simple case: only do gg <-> h exactly. - CALL PYWIDT(KFHIGG,SQM4,WDTP,WDTE) - FACGH=COMFAC*FACA*(3D0/16D0)*AS*(WDTP(13)/SQRT(SQM4))* - & (SH**4+TH**4+UH**4+SQM4**4)/(SH*TH*UH*SQM4) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMH/((SQM4-SQMH)**2+GMMH**2) - GMMHC=SQRT(SQM4)*WDTP(0) - HBW4C=SQRT(SQM4)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/ - & ((SQM4-SQMH)**2+GMMHC**2) - FACGH=FACGH*HBW4C/HBW4 - ELSE -C...Messy case: do full loop integrals - A2STUR=0D0 - A2STUI=0D0 - A2USTR=0D0 - A2USTI=0D0 - A2TUSR=0D0 - A2TUSI=0D0 - A4STUR=0D0 - A4STUI=0D0 - DO 440 I=1,2*MSTP(1) - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPST=4D0*SQMQ/TH - EPSU=4D0*SQMQ/UH - EPSH=4D0*SQMQ/SQMH - IF(EPSH.LT.1D-6) GOTO 440 - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSU,W1UR,W1UI) - CALL PYWAUX(1,EPSH,W1HR,W1HI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSU,W2UR,W2UI) - CALL PYWAUX(2,EPSH,W2HR,W2HI) - CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) - CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) - CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) - CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) - CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) - CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) - CALL PYI3AU(EPSH,SQMH/SH*TH/UH,YHSTUR,YHSTUI) - CALL PYI3AU(EPSH,SQMH/SH*UH/TH,YHSUTR,YHSUTI) - CALL PYI3AU(EPSH,SQMH/TH*SH/UH,YHTSUR,YHTSUI) - CALL PYI3AU(EPSH,SQMH/TH*UH/SH,YHTUSR,YHTUSI) - CALL PYI3AU(EPSH,SQMH/UH*SH/TH,YHUSTR,YHUSTI) - CALL PYI3AU(EPSH,SQMH/UH*TH/SH,YHUTSR,YHUTSI) - W3STUR=YHSTUR-Y3STUR-Y3UTSR - W3STUI=YHSTUI-Y3STUI-Y3UTSI - W3SUTR=YHSUTR-Y3SUTR-Y3TUSR - W3SUTI=YHSUTI-Y3SUTI-Y3TUSI - W3TSUR=YHTSUR-Y3TSUR-Y3USTR - W3TSUI=YHTSUI-Y3TSUI-Y3USTI - W3TUSR=YHTUSR-Y3TUSR-Y3SUTR - W3TUSI=YHTUSI-Y3TUSI-Y3SUTI - W3USTR=YHUSTR-Y3USTR-Y3TSUR - W3USTI=YHUSTI-Y3USTI-Y3TSUI - W3UTSR=YHUTSR-Y3UTSR-Y3STUR - W3UTSI=YHUTSI-Y3UTSI-Y3STUI - B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2D0*TH*UH* - & (UH+2D0*SH)/(SH+UH)**2*(W1TR-W1HR)+(SQMQ-SH/4D0)* - & (0.5D0*W2SR+0.5D0*W2HR-W2TR+W3STUR)+SH2*(2D0*SQMQ/ - & (SH+UH)**2-0.5D0/(SH+UH))*(W2TR-W2HR)+0.5D0*TH*UH/SH* - & (W2HR-2D0*W2TR)+0.125D0*(SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUR) - B2STUI=SQMQ/SQMH**2*(2D0*TH*UH*(UH+2D0*SH)/(SH+UH)**2* - & (W1TI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2TI+ - & W3STUI)+SH2*(2D0*SQMQ/(SH+UH)**2-0.5D0/(SH+UH))* - & (W2TI-W2HI)+0.5D0*TH*UH/SH*(W2HI-2D0*W2TI)+0.125D0* - & (SH-12D0*SQMQ-4D0*TH*UH/SH)*W3TSUI) - B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2D0*UH*TH* - & (TH+2D0*SH)/(SH+TH)**2*(W1UR-W1HR)+(SQMQ-SH/4D0)* - & (0.5D0*W2SR+0.5D0*W2HR-W2UR+W3SUTR)+SH2*(2D0*SQMQ/ - & (SH+TH)**2-0.5D0/(SH+TH))*(W2UR-W2HR)+0.5D0*UH*TH/SH* - & (W2HR-2D0*W2UR)+0.125D0*(SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTR) - B2SUTI=SQMQ/SQMH**2*(2D0*UH*TH*(TH+2D0*SH)/(SH+TH)**2* - & (W1UI-W1HI)+(SQMQ-SH/4D0)*(0.5D0*W2SI+0.5D0*W2HI-W2UI+ - & W3SUTI)+SH2*(2D0*SQMQ/(SH+TH)**2-0.5D0/(SH+TH))* - & (W2UI-W2HI)+0.5D0*UH*TH/SH*(W2HI-2D0*W2UI)+0.125D0* - & (SH-12D0*SQMQ-4D0*UH*TH/SH)*W3USTI) - B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2D0*SH*UH* - & (UH+2D0*TH)/(TH+UH)**2*(W1SR-W1HR)+(SQMQ-TH/4D0)* - & (0.5D0*W2TR+0.5D0*W2HR-W2SR+W3TSUR)+TH2*(2D0*SQMQ/ - & (TH+UH)**2-0.5D0/(TH+UH))*(W2SR-W2HR)+0.5D0*SH*UH/TH* - & (W2HR-2D0*W2SR)+0.125D0*(TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUR) - B2TSUI=SQMQ/SQMH**2*(2D0*SH*UH*(UH+2D0*TH)/(TH+UH)**2* - & (W1SI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2SI+ - & W3TSUI)+TH2*(2D0*SQMQ/(TH+UH)**2-0.5D0/(TH+UH))* - & (W2SI-W2HI)+0.5D0*SH*UH/TH*(W2HI-2D0*W2SI)+0.125D0* - & (TH-12D0*SQMQ-4D0*SH*UH/TH)*W3STUI) - B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2D0*UH*SH* - & (SH+2D0*TH)/(TH+SH)**2*(W1UR-W1HR)+(SQMQ-TH/4D0)* - & (0.5D0*W2TR+0.5D0*W2HR-W2UR+W3TUSR)+TH2*(2D0*SQMQ/ - & (TH+SH)**2-0.5D0/(TH+SH))*(W2UR-W2HR)+0.5D0*UH*SH/TH* - & (W2HR-2D0*W2UR)+0.125D0*(TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSR) - B2TUSI=SQMQ/SQMH**2*(2D0*UH*SH*(SH+2D0*TH)/(TH+SH)**2* - & (W1UI-W1HI)+(SQMQ-TH/4D0)*(0.5D0*W2TI+0.5D0*W2HI-W2UI+ - & W3TUSI)+TH2*(2D0*SQMQ/(TH+SH)**2-0.5D0/(TH+SH))* - & (W2UI-W2HI)+0.5D0*UH*SH/TH*(W2HI-2D0*W2UI)+0.125D0* - & (TH-12D0*SQMQ-4D0*UH*SH/TH)*W3UTSI) - B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2D0*SH*TH* - & (TH+2D0*UH)/(UH+TH)**2*(W1SR-W1HR)+(SQMQ-UH/4D0)* - & (0.5D0*W2UR+0.5D0*W2HR-W2SR+W3USTR)+UH2*(2D0*SQMQ/ - & (UH+TH)**2-0.5D0/(UH+TH))*(W2SR-W2HR)+0.5D0*SH*TH/UH* - & (W2HR-2D0*W2SR)+0.125D0*(UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTR) - B2USTI=SQMQ/SQMH**2*(2D0*SH*TH*(TH+2D0*UH)/(UH+TH)**2* - & (W1SI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2SI+ - & W3USTI)+UH2*(2D0*SQMQ/(UH+TH)**2-0.5D0/(UH+TH))* - & (W2SI-W2HI)+0.5D0*SH*TH/UH*(W2HI-2D0*W2SI)+0.125D0* - & (UH-12D0*SQMQ-4D0*SH*TH/UH)*W3SUTI) - B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2D0*TH*SH* - & (SH+2D0*UH)/(UH+SH)**2*(W1TR-W1HR)+(SQMQ-UH/4D0)* - & (0.5D0*W2UR+0.5D0*W2HR-W2TR+W3UTSR)+UH2*(2D0*SQMQ/ - & (UH+SH)**2-0.5D0/(UH+SH))*(W2TR-W2HR)+0.5D0*TH*SH/UH* - & (W2HR-2D0*W2TR)+0.125D0*(UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSR) - B2UTSI=SQMQ/SQMH**2*(2D0*TH*SH*(SH+2D0*UH)/(UH+SH)**2* - & (W1TI-W1HI)+(SQMQ-UH/4D0)*(0.5D0*W2UI+0.5D0*W2HI-W2TI+ - & W3UTSI)+UH2*(2D0*SQMQ/(UH+SH)**2-0.5D0/(UH+SH))* - & (W2TI-W2HI)+0.5D0*TH*SH/UH*(W2HI-2D0*W2TI)+0.125D0* - & (UH-12D0*SQMQ-4D0*TH*SH/UH)*W3TUSI) - B4STUR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2SR-W2HR+W3STUR)) - B4STUI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2SI-W2HI+W3STUI) - B4TUSR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2TR-W2HR+W3TUSR)) - B4TUSI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2TI-W2HI+W3TUSI) - B4USTR=0.25D0*EPSH*(-2D0/3D0+0.25D0*(EPSH-1D0)* - & (W2UR-W2HR+W3USTR)) - B4USTI=0.25D0*EPSH*0.25D0*(EPSH-1D0)*(W2UI-W2HI+W3USTI) - A2STUR=A2STUR+B2STUR+B2SUTR - A2STUI=A2STUI+B2STUI+B2SUTI - A2USTR=A2USTR+B2USTR+B2UTSR - A2USTI=A2USTI+B2USTI+B2UTSI - A2TUSR=A2TUSR+B2TUSR+B2TSUR - A2TUSI=A2TUSI+B2TUSI+B2TSUI - A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR - A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI - 440 CONTINUE - FACGH=COMFAC*FACA*3D0/(128D0*PARU(1)**2)*AEM/XW*AS**3* - & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+ - & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2) - FACGH=FACGH*WIDS(25,2) - ENDIF - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 450 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGH - 450 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.170) THEN - IF(ISUB.EQ.121) THEN -C...g + g -> Q + Qbar + h0 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 460 - IA=KFPR(ISUBSV,2) - PMF=PYMRUN(IA,SH) - FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* - & (0.5D0*PMF/PMAS(24,1))**2 - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - FACQQH=FACQQH*WID2 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - FACQQH=FACQQH/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - CALL PYQQBH(WTQQBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQH*WTQQBH*FACBW - 460 CONTINUE - - ELSEIF(ISUB.EQ.122) THEN -C...q + qbar -> Q + Qbar + h0 - IA=KFPR(ISUBSV,2) - PMF=PYMRUN(IA,SH) - FACQQH=COMFAC*(4D0*PARU(1)*AEM/XW)*(4D0*PARU(1)*AS)**2* - & (0.5D0*PMF/PMAS(24,1))**2 - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - FACQQH=FACQQH*WID2 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IKFI=1 - IF(IA.LE.10.AND.MOD(IA,2).EQ.0) IKFI=2 - IF(IA.GT.10) IKFI=3 - FACQQH=FACQQH*PARU(150+10*IHIGG+IKFI)**2 - IF(IMSS(1).NE.0.AND.IA.EQ.5) THEN - FACQQH=FACQQH/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - FACQQH=FACQQH*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - CALL PYQQBH(WTQQBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 470 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQH*WTQQBH*FACBW - 470 CONTINUE - - ELSEIF(ISUB.EQ.123) THEN -C...f + f' -> f + f' + h0 (or H0, or A0) (Z0 + Z0 -> h0 as -C...inner process) - FACNOR=COMFAC*(4D0*PARU(1)*AEM/(XW*XW1))**3*SQMZ/32D0 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* - & PARU(154+10*IHIGG)**2 - FACPRP=1D0/((VINT(215)-VINT(204)**2)* - & (VINT(216)-VINT(209)**2))**2 - FACZZ1=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) - FACZZ2=FACNOR*FACPRP*VINT(217)*VINT(218) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 490 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 490 - IA=IABS(I) - DO 480 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 480 - JA=IABS(J) - EI=KCHG(IA,1)*ISIGN(1,I)/3D0 - AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 - AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) - VJ=AJ-4D0*EJ*XWV - FACLR1=(VI**2+AI**2)*(VJ**2+AJ**2)+4D0*VI*AI*VJ*AJ - FACLR2=(VI**2+AI**2)*(VJ**2+AJ**2)-4D0*VI*AI*VJ*AJ - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACLR1*FACZZ1+FACLR2*FACZZ2)*FACBW - 480 CONTINUE - 490 CONTINUE - - ELSEIF(ISUB.EQ.124) THEN -C...f + f' -> f" + f"' + h0 (or H0, or A0) (W+ + W- -> h0 as -C...inner process) - FACNOR=COMFAC*(4D0*PARU(1)*AEM/XW)**3*SQMW - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) FACNOR=FACNOR* - & PARU(155+10*IHIGG)**2 - FACPRP=1D0/((VINT(215)-VINT(204)**2)* - & (VINT(216)-VINT(209)**2))**2 - FACWW=FACNOR*FACPRP*(0.5D0*TAUP*VINT(2))*VINT(219) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 510 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 510 - EI=SIGN(1D0,DBLE(I))*KCHG(IABS(I),1) - DO 500 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 500 - EJ=SIGN(1D0,DBLE(J))*KCHG(IABS(J),1) - IF(EI*EJ.GT.0D0) GOTO 500 - FACLR=VINT(180+I)*VINT(180+J) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACLR*FACWW*FACBW - 500 CONTINUE - 510 CONTINUE - - ELSEIF(ISUB.EQ.143) THEN -C...f + fbar' -> H+/- - SQMHC=PMAS(37,1)**2 - CALL PYWIDT(37,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMHC)**2+HS**2) - HP=AEM/(8D0*XW)*SH/SQMW*SH - DO 530 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530 - IA=IABS(I) - IM=(MOD(IA,10)+1)/2 - DO 520 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520 - JA=IABS(J) - JM=(MOD(JA,10)+1)/2 - IF(I*J.GT.0.OR.IA.EQ.JA.OR.IM.NE.JM) GOTO 520 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 520 - IF(MOD(IA,2).EQ.0) THEN - IU=IA - IL=JA - ELSE - IU=JA - IL=IA - ENDIF - RML=PYMRUN(IL,SH)**2/SH - RMU=PYMRUN(IU,SH)**2/SH - HI=HP*(RML*PARU(141)**2+RMU/PARU(141)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - KCHHC=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 520 CONTINUE - 530 CONTINUE - - ELSEIF(ISUB.EQ.161) THEN -C...f + g -> f' + H+/- (b + g -> t + H+/- only) -C...(choice of only b and t to avoid kinematics problems) - FHCQ=COMFAC*FACA*AS*AEM/XW*1D0/24 -C...H propagator: as simulated in PYOFSH and as desired - SQMHC=PMAS(37,1)**2 - GMMHC=PMAS(37,1)*PMAS(37,2) - HBW4=GMMHC/((SQM4-SQMHC)**2+GMMHC**2) - CALL PYWIDT(37,SQM4,WDTP,WDTE) - GMMHCC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMHCC/((SQM4-SQMHC)**2+GMMHCC**2) - FHCQ=FHCQ*HBW4C/HBW4 - DO 550 I=MMINA,MMAXA - IA=IABS(I) - IF(IA.NE.5) GOTO 550 - SQML=PYMRUN(IA,SH)**2 - IUA=IA+MOD(IA,2) - SQMQ=PYMRUN(IUA,SH)**2 - FACHCQ=FHCQ*(SQML*PARU(141)**2+SQMQ/PARU(141)**2)/SQMW* - & (SH/(SQMQ-UH)+2D0*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH- - & 2D0*SQMQ/(SQMQ-UH)+2D0*(SQMHC-UH)/(SQMQ-UH)* - & (SQMHC-SQMQ-SH)/SH) - KCHHC=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - DO 540 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 540 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 540 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACHCQ*WIDS(37,(5-KCHHC)/2) - IF(IUA.EQ.6) SIGH(NCHN)=SIGH(NCHN)*WIDS(6,(5+KCHHC)/2) - 540 CONTINUE - 550 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.402) THEN - IF(ISUB.EQ.401) THEN -C... g + g -> t + bbar + H- - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 560 - IA=KFPR(ISUBSV,2) - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - CALL PYSTBH(WTTBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=2d0*WID2*COMFAC*WTTBH*FACBW - 560 CONTINUE - - ELSEIF(ISUB.EQ.402) THEN -C... q + qbar -> t + bbar + H- - IA=KFPR(ISUBSV,2) - WID2=1D0 - IF(IA.EQ.6.OR.IA.EQ.7.OR.IA.EQ.8) WID2=WIDS(IA,1) - CALL PYSTBH(WTTBH) - CALL PYWIDT(KFHIGG,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - FACBW=(1D0/PARU(1))*VINT(2)*HF/((SH-SQMH)**2+HS**2) - IF(ABS(SHR-PMAS(KFHIGG,1)).GT.PARP(48)*PMAS(KFHIGG,2)) - & FACBW=0D0 - DO 570 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 570 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=2d0*WID2*COMFAC*WTTBH*FACBW - 570 CONTINUE - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGQC -C...Subprocess cross sections for QCD processes, -C...including photons. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGQC(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYINT7/,/PYSGCM/ -C...Local arrays - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - -C...Differential cross section expressions. - - IF(ISUB.LE.20) THEN - IF(ISUB.EQ.10) THEN -C...f + f' -> f + f' (gamma/Z/W exchange) - FACGGF=COMFAC*AEM**2*2D0*(SH2+UH2)/TH2 - FACGZF=COMFAC*AEM**2*XWC*4D0*SH2/(TH*(TH-SQMZ)) - FACZZF=COMFAC*(AEM*XWC)**2*2D0*SH2/(TH-SQMZ)**2 - FACWWF=COMFAC*(0.5D0*AEM/XW)**2*SH2/(TH-SQMW)**2 - DO 110 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 110 - IA=IABS(I) - DO 100 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 100 - JA=IABS(J) -C...Electroweak couplings - EI=KCHG(IA,1)*ISIGN(1,I)/3D0 - AI=SIGN(1D0,KCHG(IA,1)+0.5D0)*ISIGN(1,I) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)*ISIGN(1,J)/3D0 - AJ=SIGN(1D0,KCHG(JA,1)+0.5D0)*ISIGN(1,J) - VJ=AJ-4D0*EJ*XWV - EPSIJ=ISIGN(1,I*J) -C...gamma/Z exchange, only gamma exchange, or only Z exchange - IF(MSTP(21).GE.1.AND.MSTP(21).LE.4) THEN - IF(MSTP(21).EQ.1.OR.MSTP(21).EQ.4) THEN - FACNCF=FACGGF*EI**2*EJ**2+FACGZF*EI*EJ* - & (VI*VJ*(1D0+UH2/SH2)+AI*AJ*EPSIJ*(1D0-UH2/SH2))+ - & FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)*(1D0+UH2/SH2)+ - & 4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) - ELSEIF(MSTP(21).EQ.2) THEN - FACNCF=FACGGF*EI**2*EJ**2 - ELSE - FACNCF=FACZZF*((VI**2+AI**2)*(VJ**2+AJ**2)* - & (1D0+UH2/SH2)+4D0*VI*VJ*AI*AJ*EPSIJ*(1D0-UH2/SH2)) - ENDIF -C...Extrafactor 2 for only one incoming neutrino spin state. - IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACNCF=2D0*FACNCF - IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACNCF=2D0*FACNCF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACNCF - ENDIF -C...W exchange - IF((MSTP(21).EQ.1.OR.MSTP(21).EQ.5).AND.AI*AJ.LT.0D0) THEN - FACCCF=FACWWF*VINT(180+I)*VINT(180+J) - IF(EPSIJ.LT.0D0) FACCCF=FACCCF*UH2/SH2 - IF(IA.GT.10.AND.MOD(IA,2).EQ.0) FACCCF=2D0*FACCCF - IF(JA.GT.10.AND.MOD(JA,2).EQ.0) FACCCF=2D0*FACCCF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACCCF - ENDIF - 100 CONTINUE - 110 CONTINUE - - ELSEIF(ISUB.EQ.11) THEN -C...f + f' -> f + f' (g exchange) - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- - & MSTP(34)*2D0/3D0*UH2/(SH*TH)) - FACQQ2=COMFAC*AS**2*4D0/9D0*((SH2+TH2)/UH2- - & MSTP(34)*2D0/3D0*SH2/(TH*UH)) - DO 130 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 130 - DO 120 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 120 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - IF(I.EQ.J) THEN - SIGH(NCHN)=0.5D0*SIGH(NCHN) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACQQ2 - ENDIF - 120 CONTINUE - 130 CONTINUE - - ELSEIF(ISUB.EQ.12) THEN -C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) - CALL PYWIDT(21,SH,WDTP,WDTE) - FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - DO 140 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 140 CONTINUE - - ELSEIF(ISUB.EQ.13) THEN -C...f + fbar -> g + g (q + qbar -> g + g only) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2) - DO 150 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - 150 CONTINUE - - ELSEIF(ISUB.EQ.14) THEN -C...f + fbar -> g + gamma (q + qbar -> g + gamma only) - FACGG=COMFAC*AS*AEM*8D0/9D0*(TH2+UH2)/(TH*UH) - DO 160 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 - EI=KCHG(IABS(I),1)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGG*EI**2 - 160 CONTINUE - - ELSEIF(ISUB.EQ.18) THEN -C...f + fbar -> gamma + gamma - FACGG=COMFAC*AEM**2*2D0*(TH2+UH2)/(TH*UH) - DO 170 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 170 - EI=KCHG(IABS(I),1)/3D0 - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG*FCOI*EI**4 - 170 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.28) THEN -C...f + g -> f + g (q + g -> q + g only) - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH) - DO 190 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 190 - DO 180 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 180 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 180 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2 - 180 CONTINUE - 190 CONTINUE - - ELSEIF(ISUB.EQ.29) THEN -C...f + g -> f + gamma (q + g -> q + gamma only) - FGQ=COMFAC*FACA*AS*AEM*1D0/3D0*(SH2+UH2)/(-SH*UH) - DO 210 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 200 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 200 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 200 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 200 CONTINUE - 210 CONTINUE - - ELSEIF(ISUB.EQ.33) THEN -C...f + gamma -> f + g (q + gamma -> q + g only) - FGQ=COMFAC*AS*AEM*8D0/3D0*(SH2+UH2)/(-SH*UH) - DO 230 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 230 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 220 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 220 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 220 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 220 CONTINUE - 230 CONTINUE - - ELSEIF(ISUB.EQ.34) THEN -C...f + gamma -> f + gamma - FGQ=COMFAC*AEM**2*2D0*(SH2+UH2)/(-SH*UH) - DO 250 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 250 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**4 - DO 240 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 240 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 240 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 240 CONTINUE - 250 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.80) THEN - IF(ISUB.EQ.53) THEN -C...g + g -> f + fbar (g + g -> q + qbar only) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 270 - IDC0=MDCY(21,2)-1 -C...Begin by d, u, s flavours. - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 -C...Next c and b flavours: modified that and uhat for fixed -C...cos(theta-hat). - DO 260 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 260 CONTINUE - 270 CONTINUE - - ELSEIF(ISUB.EQ.54) THEN -C...g + gamma -> f + fbar (g + gamma -> q + qbar only) - CALL PYWIDT(21,SH,WDTP,WDTE) - WDTESU=0D0 - DO 280 I=1,MIN(8,MDCY(21,3)) - EF=KCHG(I,1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 280 CONTINUE - FACQQ=COMFAC*AEM*AS*WDTESU*(TH2+UH2)/(TH*UH) - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.EQ.58) THEN -C...gamma + gamma -> f + fbar - CALL PYWIDT(22,SH,WDTP,WDTE) - WDTESU=0D0 - DO 290 I=1,MIN(12,MDCY(22,3)) - IF(I.LE.8) EF= KCHG(I,1)/3D0 - IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 290 CONTINUE - FACFF=COMFAC*AEM**2*WDTESU*2D0*(TH2+UH2)/(TH*UH) - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ELSEIF(ISUB.EQ.68) THEN -C...g + g -> g + g - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 300 - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+2D0*TH/SH+ - & TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+2D0*SH/UH+ - & SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+2D0*UH/TH+ - & UH2/TH2) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=0.5D0*FACGG3 - 300 CONTINUE - - ELSEIF(ISUB.EQ.80) THEN -C...q + gamma -> q' + pi+/- - FQPI=COMFAC*(2D0*AEM/9D0)*(-SH/TH)*(1D0/SH2+1D0/TH2) - ASSH=PYALPS(MAX(0.5D0,0.5D0*SH)) - Q2FPSH=0.55D0/LOG(MAX(2D0,2D0*SH)) - DELSH=UH*SQRT(ASSH*Q2FPSH) - ASUH=PYALPS(MAX(0.5D0,-0.5D0*UH)) - Q2FPUH=0.55D0/LOG(MAX(2D0,-2D0*UH)) - DELUH=SH*SQRT(ASUH*Q2FPUH) - DO 320 I=MAX(-2,MMINA),MIN(2,MMAXA) - IF(I.EQ.0) GOTO 320 - EI=KCHG(IABS(I),1)/3D0 - EJ=SIGN(1D0-ABS(EI),EI) - DO 310 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 310 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 310 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FQPI*(EI*DELSH+EJ*DELUH)**2 - 310 CONTINUE - 320 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.91) THEN -C...Elastic scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,1) - - ELSEIF(ISUB.EQ.92) THEN -C...Single diffractive scattering (first side, i.e. XB) - SIGS=VINT(315)*VINT(316)*SIGT(0,0,2) - - ELSEIF(ISUB.EQ.93) THEN -C...Single diffractive scattering (second side, i.e. AX) - SIGS=VINT(315)*VINT(316)*SIGT(0,0,3) - - ELSEIF(ISUB.EQ.94) THEN -C...Double diffractive scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,4) - - ELSEIF(ISUB.EQ.95) THEN -C...Low-pT scattering - SIGS=VINT(315)*VINT(316)*SIGT(0,0,5) - - ELSEIF(ISUB.EQ.96) THEN -C...Multiple interactions: sum of QCD processes - CALL PYWIDT(21,SH,WDTP,WDTE) - -C...q + q' -> q + q' - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)/TH2 - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)/TH2*FACA- - & MSTP(34)*2D0/3D0*UH2/(SH*TH)) - FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)/UH2 - FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) - RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) - DO 340 I=-5,5 - IF(I.EQ.0) GOTO 340 - DO 330 J=-5,5 - IF(J.EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=111 - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - IF(I.EQ.J) THEN - SIGH(NCHN)=0.5D0*FACQQ1*RATQQI - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=112 - SIGH(NCHN)=0.5D0*FACQQ2*RATQQI - ENDIF - 330 CONTINUE - 340 CONTINUE - -C...q + qbar -> q' + qbar' or g + g - FACQQB=COMFAC*AS**2*4D0/9D0*(TH2+UH2)/SH2* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4)) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2) - DO 350 I=-5,5 - IF(I.EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=121 - SIGH(NCHN)=FACQQB - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=131 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=132 - SIGH(NCHN)=0.5D0*FACGG2 - 350 CONTINUE - -C...q + g -> q + g - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH) - DO 370 I=-5,5 - IF(I.EQ.0) GOTO 370 - DO 360 ISDE=1,2 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=281 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=282 - SIGH(NCHN)=FACQG2 - 360 CONTINUE - 370 CONTINUE - -C...g + g -> q + qbar (only d, u, s) - IDC0=MDCY(21,2)-1 - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=531 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=532 - SIGH(NCHN)=FACQQ2 - -C...g + g -> c + cbar, b + bbar: modified that/uhat for fixed -C...cos(theta-hat) - DO 380 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=531+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=532+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 380 CONTINUE - -C...g + g -> g + g - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ - & 2D0*TH/SH+TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ - & 2D0*SH/UH+SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3+ - & 2D0*UH/TH+UH2/TH2) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=681 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=682 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=683 - SIGH(NCHN)=0.5D0*FACGG3 - - ELSEIF(ISUB.EQ.99) THEN -C...f + gamma* -> f. - IF(MINT(107).EQ.4) THEN - Q2GA=VINT(307) - P2GA=VINT(308) - ISDE=2 - ELSE - Q2GA=VINT(308) - P2GA=VINT(307) - ISDE=1 - ENDIF - COMFAC=PARU(5)*4D0*PARU(1)**2*PARU(101)*VINT(315)*VINT(316) - PM2RHO=PMAS(PYCOMP(113),1)**2 - IF(MSTP(19).EQ.0) THEN - COMFAC=COMFAC/Q2GA - ELSEIF(MSTP(19).EQ.1) THEN - COMFAC=COMFAC/(Q2GA+PM2RHO) -C ...patty -C To use MSTP(19).EQ.1 (less Q2 suppression) with the right factor (1-x)^-1 -C - W2GA=VINT(2) - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - XGA=Q2GA/(W2GA+VINT(307)+VINT(308)) - ELSE - XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2) - ENDIF - COMFAC=COMFAC/MAX(1D-2,1D0-XGA) - ELSEIF(MSTP(19).EQ.2) THEN - COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 - ELSE - COMFAC=COMFAC*Q2GA/(Q2GA+PM2RHO)**2 - W2GA=VINT(2) - IF(MINT(11).EQ.22.AND.MINT(12).EQ.22) THEN - RDRDS=4.1D-3*W2GA**2.167D0/((Q2GA+0.15D0*W2GA)**2* - & Q2GA**0.75D0)*(1D0+0.11D0*Q2GA*P2GA/(1D0+0.02D0*P2GA**2)) - XGA=Q2GA/(W2GA+VINT(307)+VINT(308)) - ELSE - RDRDS=1.5D-4*W2GA**2.167D0/((Q2GA+0.041D0*W2GA)**2* - & Q2GA**0.57D0) - XGA=Q2GA/(W2GA+Q2GA-PMAS(PYCOMP(MINT(10+ISDE)),1)**2) - ENDIF - COMFAC=COMFAC*EXP(-MAX(1D-10,RDRDS)) - IF(MSTP(19).EQ.4) COMFAC=COMFAC/MAX(1D-2,1D0-XGA) - ENDIF - DO 390 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(ISDE,I).EQ.0) GOTO 390 - IF(IABS(I).LT.10.AND.IABS(I).GT.MSTP(58)) GOTO 390 - EI=KCHG(IABS(I),1)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*EI**2 - 390 CONTINUE - ENDIF - - ELSE - IF(ISUB.EQ.114.OR.ISUB.EQ.115) THEN -C...g + g -> gamma + gamma or g + g -> g + gamma - A0STUR=0D0 - A0STUI=0D0 - A0TSUR=0D0 - A0TSUI=0D0 - A0UTSR=0D0 - A0UTSI=0D0 - A1STUR=0D0 - A1STUI=0D0 - A2STUR=0D0 - A2STUI=0D0 - ALST=LOG(-SH/TH) - ALSU=LOG(-SH/UH) - ALTU=LOG(TH/UH) - IMAX=2*MSTP(1) - IF(MSTP(38).GE.1.AND.MSTP(38).LE.8) IMAX=MSTP(38) - DO 400 I=1,IMAX - EI=KCHG(IABS(I),1)/3D0 - EIWT=EI**2 - IF(ISUB.EQ.115) EIWT=EI - SQMQ=PMAS(I,1)**2 - EPSS=4D0*SQMQ/SH - EPST=4D0*SQMQ/TH - EPSU=4D0*SQMQ/UH - IF((MSTP(38).GE.1.AND.MSTP(38).LE.8).OR.EPSS.LT.1D-4) THEN - B0STUR=1D0+(TH-UH)/SH*ALTU+0.5D0*(TH2+UH2)/SH2*(ALTU**2+ - & PARU(1)**2) - B0STUI=0D0 - B0TSUR=1D0+(SH-UH)/TH*ALSU+0.5D0*(SH2+UH2)/TH2*ALSU**2 - B0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*ALSU) - B0UTSR=1D0+(SH-TH)/UH*ALST+0.5D0*(SH2+TH2)/UH2*ALST**2 - B0UTSI=-PARU(1)*((SH-TH)/UH+(SH2+TH2)/UH2*ALST) - B1STUR=-1D0 - B1STUI=0D0 - B2STUR=-1D0 - B2STUI=0D0 - ELSE - CALL PYWAUX(1,EPSS,W1SR,W1SI) - CALL PYWAUX(1,EPST,W1TR,W1TI) - CALL PYWAUX(1,EPSU,W1UR,W1UI) - CALL PYWAUX(2,EPSS,W2SR,W2SI) - CALL PYWAUX(2,EPST,W2TR,W2TI) - CALL PYWAUX(2,EPSU,W2UR,W2UI) - CALL PYI3AU(EPSS,TH/UH,Y3STUR,Y3STUI) - CALL PYI3AU(EPSS,UH/TH,Y3SUTR,Y3SUTI) - CALL PYI3AU(EPST,SH/UH,Y3TSUR,Y3TSUI) - CALL PYI3AU(EPST,UH/SH,Y3TUSR,Y3TUSI) - CALL PYI3AU(EPSU,SH/TH,Y3USTR,Y3USTI) - CALL PYI3AU(EPSU,TH/SH,Y3UTSR,Y3UTSI) - B0STUR=1D0+(1D0+2D0*TH/SH)*W1TR+(1D0+2D0*UH/SH)*W1UR+ - & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TR+W2UR)- - & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTR+Y3TUSR)- - & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUR+Y3UTSR)+ - & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ - & 0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) - B0STUI=(1D0+2D0*TH/SH)*W1TI+(1D0+2D0*UH/SH)*W1UI+ - & 0.5D0*((TH2+UH2)/SH2-EPSS)*(W2TI+W2UI)- - & 0.25D0*EPST*(1D0-0.5D0*EPSS)*(Y3SUTI+Y3TUSI)- - & 0.25D0*EPSU*(1D0-0.5D0*EPSS)*(Y3STUI+Y3UTSI)+ - & 0.25D0*(-2D0*(TH2+UH2)/SH2+4D0*EPSS+EPST+EPSU+ - & 0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) - B0TSUR=1D0+(1D0+2D0*SH/TH)*W1SR+(1D0+2D0*UH/TH)*W1UR+ - & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SR+W2UR)- - & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSR+Y3SUTR)- - & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUR+Y3USTR)+ - & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ - & 0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR) - B0TSUI=(1D0+2D0*SH/TH)*W1SI+(1D0+2D0*UH/TH)*W1UI+ - & 0.5D0*((SH2+UH2)/TH2-EPST)*(W2SI+W2UI)- - & 0.25D0*EPSS*(1D0-0.5D0*EPST)*(Y3TUSI+Y3SUTI)- - & 0.25D0*EPSU*(1D0-0.5D0*EPST)*(Y3TSUI+Y3USTI)+ - & 0.25D0*(-2D0*(SH2+UH2)/TH2+4D0*EPST+EPSS+EPSU+ - & 0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI) - B0UTSR=1D0+(1D0+2D0*TH/UH)*W1TR+(1D0+2D0*SH/UH)*W1SR+ - & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TR+W2SR)- - & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTR+Y3TSUR)- - & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSR+Y3STUR)+ - & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ - & 0.5D0*EPST*EPSS)*(Y3TUSR+Y3SUTR) - B0UTSI=(1D0+2D0*TH/UH)*W1TI+(1D0+2D0*SH/UH)*W1SI+ - & 0.5D0*((TH2+SH2)/UH2-EPSU)*(W2TI+W2SI)- - & 0.25D0*EPST*(1D0-0.5D0*EPSU)*(Y3USTI+Y3TSUI)- - & 0.25D0*EPSS*(1D0-0.5D0*EPSU)*(Y3UTSI+Y3STUI)+ - & 0.25D0*(-2D0*(TH2+SH2)/UH2+4D0*EPSU+EPST+EPSS+ - & 0.5D0*EPST*EPSS)*(Y3TUSI+Y3SUTI) - B1STUR=-1D0-0.25D0*(EPSS+EPST+EPSU)*(W2SR+W2TR+W2UR)+ - & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTR+Y3TUSR)+ - & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUR+Y3UTSR)+ - & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUR+Y3USTR) - B1STUI=-0.25D0*(EPSS+EPST+EPSU)*(W2SI+W2TI+W2UI)+ - & 0.25D0*(EPSU+0.5D0*EPSS*EPST)*(Y3SUTI+Y3TUSI)+ - & 0.25D0*(EPST+0.5D0*EPSS*EPSU)*(Y3STUI+Y3UTSI)+ - & 0.25D0*(EPSS+0.5D0*EPST*EPSU)*(Y3TSUI+Y3USTI) - B2STUR=-1D0+0.125D0*EPSS*EPST*(Y3SUTR+Y3TUSR)+ - & 0.125D0*EPSS*EPSU*(Y3STUR+Y3UTSR)+ - & 0.125D0*EPST*EPSU*(Y3TSUR+Y3USTR) - B2STUI=0.125D0*EPSS*EPST*(Y3SUTI+Y3TUSI)+ - & 0.125D0*EPSS*EPSU*(Y3STUI+Y3UTSI)+ - & 0.125D0*EPST*EPSU*(Y3TSUI+Y3USTI) - ENDIF - A0STUR=A0STUR+EIWT*B0STUR - A0STUI=A0STUI+EIWT*B0STUI - A0TSUR=A0TSUR+EIWT*B0TSUR - A0TSUI=A0TSUI+EIWT*B0TSUI - A0UTSR=A0UTSR+EIWT*B0UTSR - A0UTSI=A0UTSI+EIWT*B0UTSI - A1STUR=A1STUR+EIWT*B1STUR - A1STUI=A1STUI+EIWT*B1STUI - A2STUR=A2STUR+EIWT*B2STUR - A2STUI=A2STUI+EIWT*B2STUI - 400 CONTINUE - ASQSUM=A0STUR**2+A0STUI**2+A0TSUR**2+A0TSUI**2+A0UTSR**2+ - & A0UTSI**2+4D0*A1STUR**2+4D0*A1STUI**2+A2STUR**2+A2STUI**2 - FACGG=COMFAC*FACA/(16D0*PARU(1)**2)*AS**2*AEM**2*ASQSUM - FACGP=COMFAC*FACA*5D0/(192D0*PARU(1)**2)*AS**3*AEM*ASQSUM - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - IF(ISUB.EQ.114) SIGH(NCHN)=0.5D0*FACGG - IF(ISUB.EQ.115) SIGH(NCHN)=FACGP - 410 CONTINUE - - ELSEIF(ISUB.EQ.131.OR.ISUB.EQ.132) THEN -C...f + gamma*_(T,L) -> f + g (q + gamma*_(T,L) -> q + g only) - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - IF(ISUB.EQ.131) THEN - FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**2* - & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) - ELSE - FGQ=COMFAC*AS*AEM*8D0/3D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) - ENDIF - DO 430 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 430 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**2 - DO 420 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 420 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.133.OR.ISUB.EQ.134) THEN -C...f + gamma*_(T,L) -> f + gamma - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - IF(ISUB.EQ.133) THEN - FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**2* - & ((SH2+UH2-2D0*PH*TH)/(-SH*UH)-2D0*PH*TH/(SH+PH)**2) - ELSE - FGQ=COMFAC*AEM**2*2D0*SH**2/(SH+PH)**4*(-4D0*PH*TH) - ENDIF - DO 450 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 450 - EI=KCHG(IABS(I),1)/3D0 - FACGQ=FGQ*EI**4 - DO 440 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 440 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 440 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGQ - 440 CONTINUE - 450 CONTINUE - - ELSEIF(ISUB.EQ.135.OR.ISUB.EQ.136) THEN -C...g + gamma*_(T,L) -> f + fbar (g + gamma*_(T,L) -> q + qbar only) - PH=0D0 - IF(MINT(15).EQ.22.AND.MINT(107).EQ.0.AND.VINT(3).LT.0D0) - & PH=VINT(3)**2 - IF(MINT(16).EQ.22.AND.MINT(108).EQ.0.AND.VINT(4).LT.0D0) - & PH=VINT(4)**2 - CALL PYWIDT(21,SH,WDTP,WDTE) - WDTESU=0D0 - DO 460 I=1,MIN(8,MDCY(21,3)) - EF=KCHG(I,1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 460 CONTINUE - IF(ISUB.EQ.135) THEN - FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**2* - & ((TH2+UH2-2D0*PH*SH)/(TH*UH)+4D0*PH*SH/(SH+PH)**2) - ELSE - FACQQ=COMFAC*AEM*AS*WDTESU*SH**2/(SH+PH)**4*8D0*PH*SH - ENDIF - IF(KFAC(1,21)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - IF(KFAC(1,22)*KFAC(2,21).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ - ENDIF - - ELSEIF(ISUB.GE.137.AND.ISUB.LE.140) THEN -C...gamma*_(T,L) + gamma*_(T,L) -> f + fbar - PH1=0D0 - IF(VINT(3).LT.0D0) PH1=VINT(3)**2 - PH2=0D0 - IF(VINT(4).LT.0D0) PH2=VINT(4)**2 - CALL PYWIDT(22,SH,WDTP,WDTE) - WDTESU=0D0 - DO 470 I=1,MIN(12,MDCY(22,3)) - IF(I.LE.8) EF= KCHG(I,1)/3D0 - IF(I.GE.9) EF= KCHG(9+2*(I-8),1)/3D0 - WDTESU=WDTESU+EF**2*(WDTE(I,1)+WDTE(I,2)+WDTE(I,3)+ - & WDTE(I,4)) - 470 CONTINUE - DLAMB2=(TH+UH)**2-4D0*PH1*PH2 - IF(ISUB.EQ.137) THEN - FPARAM=-SH*(TH+UH)/DLAMB2 - FACFF=COMFAC*AEM**2*WDTESU*2D0*SH2/(DLAMB2*TH2*UH2)* - & (TH*UH-PH1*PH2)*((TH2+UH2)*(1D0-2D0*FPARAM*(1D0-FPARAM))- - & 2D0*PH1*PH2*FPARAM**2) - ELSEIF(ISUB.EQ.138) THEN - FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* - & PH2*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH1*SH*(TH-UH)**2/DLAMB2)+ - & 2D0*PH1**2*(TH-UH)**2) - ELSEIF(ISUB.EQ.139) THEN - FACFF=COMFAC*AEM**2*WDTESU*4D0*SH2*SH/(DLAMB2**2*TH2*UH2)* - & PH1*(4D0*(TH*UH-PH1*PH2)*(TH*UH+PH2*SH*(TH-UH)**2/DLAMB2)+ - & 2D0*PH2**2*(TH-UH)**2) - ELSE - FACFF=COMFAC*AEM**2*WDTESU*32D0*SH2**2/(DLAMB2**3*TH2*UH2)* - & PH1*PH2*(TH*UH-PH1*PH2)*(TH-UH)**2 - ENDIF - IF(KFAC(1,22)*KFAC(2,22).NE.0) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACFF - ENDIF - - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSGSU -C...Subprocess cross sections for SUSY processes, -C...including Higgs pair production. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGSU(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 OLPP,ORPP,OLP,ORP,OL,OR,QLL,QLR - COMPLEX*16 QRR,QRL,GLIJ,GRIJ,PROPW,PROPZ - COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) - -CMRENNA++ -C...Z and W width, combinations of weak mixing angle - ZWID=PMAS(23,2) - WWID=PMAS(24,2) - TANW=SQRT(XW/XW1) - CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) - -C...Convert almost equivalent SUSY processes into each other -C...Extract differences in flavours and couplings - -C...Sleptons and sneutrinos - IF(ISUB.EQ.201.OR.ISUB.EQ.204.OR.ISUB.EQ.207) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=201 - ILR=0 - ELSEIF(ISUB.EQ.202.OR.ISUB.EQ.205.OR.ISUB.EQ.208) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=201 - ILR=1 - ELSEIF(ISUB.EQ.203.OR.ISUB.EQ.206.OR.ISUB.EQ.209) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - ISUB=203 - ELSEIF(ISUB.GE.210.AND.ISUB.LE.212) THEN - IF(ISUB.EQ.210) THEN - RKF=2.0D0 - ELSEIF(ISUB.EQ.211) THEN - RKF=SFMIX(15,1)**2 - ELSEIF(ISUB.EQ.212) THEN - RKF=SFMIX(15,2)**2 - ENDIF - ISUB=210 - ELSEIF(ISUB.EQ.213.OR.ISUB.EQ.214) THEN - IF(ISUB.EQ.213) THEN - KFID=MOD(KFPR(ISUB,1),KSUSY1) - RKF=2.0D0 - ELSEIF(ISUB.EQ.214) THEN - KFID=16 - RKF=1.0D0 - ENDIF - ISUB=213 - -C...Neutralinos - ELSEIF(ISUB.GE.216.AND.ISUB.LE.225) THEN - IF(ISUB.EQ.216) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.217) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.218) THEN - IZID1=3 - IZID2=3 - ELSEIF(ISUB.EQ.219) THEN - IZID1=4 - IZID2=4 - ELSEIF(ISUB.EQ.220) THEN - IZID1=1 - IZID2=2 - ELSEIF(ISUB.EQ.221) THEN - IZID1=1 - IZID2=3 - ELSEIF(ISUB.EQ.222) THEN - IZID1=1 - IZID2=4 - ELSEIF(ISUB.EQ.223) THEN - IZID1=2 - IZID2=3 - ELSEIF(ISUB.EQ.224) THEN - IZID1=2 - IZID2=4 - ELSEIF(ISUB.EQ.225) THEN - IZID1=3 - IZID2=4 - ENDIF - ISUB=216 - -C...Charginos - ELSEIF(ISUB.GE.226.AND.ISUB.LE.228) THEN - IF(ISUB.EQ.226) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.227) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.228) THEN - IZID1=1 - IZID2=2 - ENDIF - ISUB=226 - -C...Neutralino + chargino - ELSEIF(ISUB.GE.229.AND.ISUB.LE.236) THEN - IF(ISUB.EQ.229) THEN - IZID1=1 - IZID2=1 - ELSEIF(ISUB.EQ.230) THEN - IZID1=1 - IZID2=2 - ELSEIF(ISUB.EQ.231) THEN - IZID1=1 - IZID2=3 - ELSEIF(ISUB.EQ.232) THEN - IZID1=1 - IZID2=4 - ELSEIF(ISUB.EQ.233) THEN - IZID1=2 - IZID2=1 - ELSEIF(ISUB.EQ.234) THEN - IZID1=2 - IZID2=2 - ELSEIF(ISUB.EQ.235) THEN - IZID1=2 - IZID2=3 - ELSEIF(ISUB.EQ.236) THEN - IZID1=2 - IZID2=4 - ENDIF - ISUB=229 - -C...Gluino + neutralino - ELSEIF(ISUB.GE.237.AND.ISUB.LE.240) THEN - IF(ISUB.EQ.237) THEN - IZID=1 - ELSEIF(ISUB.EQ.238) THEN - IZID=2 - ELSEIF(ISUB.EQ.239) THEN - IZID=3 - ELSEIF(ISUB.EQ.240) THEN - IZID=4 - ENDIF - ISUB=237 - -C...Gluino + chargino - ELSEIF(ISUB.GE.241.AND.ISUB.LE.242) THEN - IF(ISUB.EQ.241) THEN - IZID=1 - ELSEIF(ISUB.EQ.242) THEN - IZID=2 - ENDIF - ISUB=241 - -C...Squark + neutralino - ELSEIF(ISUB.GE.246.AND.ISUB.LE.253) THEN - ILR=0 - IF(MOD(ISUB,2).NE.0) ILR=1 - IF(ISUB.LE.247) THEN - IZID=1 - ELSEIF(ISUB.LE.249) THEN - IZID=2 - ELSEIF(ISUB.LE.251) THEN - IZID=3 - ELSEIF(ISUB.LE.253) THEN - IZID=4 - ENDIF - ISUB=246 - RKF=5D0 - -C...Squark + chargino - ELSEIF(ISUB.GE.254.AND.ISUB.LE.257) THEN - IF(ISUB.LE.255) THEN - IZID=1 - ELSEIF(ISUB.LE.257) THEN - IZID=2 - ENDIF - IF(MOD(ISUB,2).EQ.0) THEN - ILR=0 - ELSE - ILR=1 - ENDIF - ISUB=254 - RKF=5D0 - -C...Squark + gluino - ELSEIF(ISUB.EQ.258.OR.ISUB.EQ.259) THEN - ISUB=258 - RKF=4D0 - -C...Stops - ELSEIF(ISUB.EQ.261.OR.ISUB.EQ.262) THEN - ILR=0 - IF(ISUB.EQ.262) ILR=1 - ISUB=261 - ELSEIF(ISUB.EQ.265) THEN - ISUB=264 - -C...Squarks - ELSEIF(ISUB.GE.271.AND.ISUB.LE.280) THEN - ILR=0 - IF(ISUB.LE.273) THEN - IF(ISUB.EQ.273) ILR=1 - ISUB=271 - RKF=16D0 - ELSEIF(ISUB.LE.276) THEN - IF(ISUB.EQ.276) ILR=1 - ISUB=274 - RKF=16D0 - ELSEIF(ISUB.LE.278) THEN - IF(ISUB.EQ.278) ILR=1 - ISUB=277 - RKF=4D0 - ELSE - IF(ISUB.EQ.280) ILR=1 - ISUB=279 - RKF=4D0 - ENDIF -C...Sbottoms - ELSEIF(ISUB.GE.281.AND.ISUB.LE.296) THEN - ILR=0 - IF(ISUB.LE.283) THEN - IF(ISUB.EQ.283) ILR=1 - ISUB=271 - RKF=4D0 - ELSEIF(ISUB.LE.286) THEN - IF(ISUB.EQ.286) ILR=1 - ISUB=274 - RKF=4D0 - ELSEIF(ISUB.LE.288) THEN - IF(ISUB.EQ.288) ILR=1 - ISUB=277 - RKF=1D0 - ELSEIF(ISUB.LE.290) THEN - IF(ISUB.EQ.290) ILR=1 - ISUB=279 - RKF=1D0 - ELSEIF(ISUB.LE.293) THEN - IF(ISUB.EQ.293) ILR=1 - ISUB=271 - RKF=1D0 - ELSEIF(ISUB.EQ.296) THEN - ILR=1 - ISUB=274 - RKF=1D0 -C...Squark + gluino - ELSEIF(ISUB.EQ.294.OR.ISUB.EQ.295) THEN - ISUB=258 - RKF=1D0 - ENDIF -C...H+/- + H0 - ELSEIF(ISUB.EQ.297.OR.ISUB.EQ.298) THEN - IF(ISUB.EQ.297) THEN - RKF=.5D0*PARU(195)**2 - ELSEIF(ISUB.EQ.298) THEN - RKF=.5D0*(1D0-PARU(195)**2) - ENDIF - ISUB=210 -C...A0 + H0 - ELSEIF(ISUB.EQ.299.OR.ISUB.EQ.300) THEN - IF(ISUB.EQ.299) THEN - RKF=PARU(186)**2 - KFID=25 - ELSEIF(ISUB.EQ.300) THEN - RKF=PARU(187)**2 - KFID=35 - ENDIF - ISUB=213 -C...H+ + H- - ELSEIF(ISUB.EQ.301) THEN - KFID=37 - RKF=1D0 - ISUB=201 - ENDIF - -C...Supersymmetric processes - all of type 2 -> 2 : -C...correct final-state Breit-Wigners from fixed to running width. - IF(MSTP(42).GT.0) THEN - DO 100 I=1,2 - KFLW=KFPR(ISUBSV,I) - KCW=PYCOMP(KFLW) - IF(PMAS(KCW,2).LT.PARP(41)) GOTO 100 - IF(I.EQ.1) SQMI=SQM3 - IF(I.EQ.2) SQMI=SQM4 - SQMS=PMAS(KCW,1)**2 - GMMS=PMAS(KCW,1)*PMAS(KCW,2) - HBWS=GMMS/((SQMI-SQMS)**2+GMMS**2) - CALL PYWIDT(KFLW,SQMI,WDTP,WDTE) - GMMI=SQRT(SQMI)*WDTP(0) - HBWI=GMMI/((SQMI-SQMS)**2+GMMI**2) - COMFAC=COMFAC*(HBWI/HBWS) - 100 CONTINUE - ENDIF - -C...Differential cross section expressions. - - IF(ISUB.LE.210) THEN - IF(ISUB.EQ.201) THEN -C...f + fbar -> e_L + e_Lbar - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - DO 130 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 130 - EI=KCHG(IA,1)/3D0 - TT3I=SIGN(1D0,EI+1D-6)/2D0 - EJ=-1D0 - TT3J=-1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - IF(ISUBSV.EQ.301) THEN - A1=1D0 - A2=0D0 - ELSEIF(ILR.EQ.1) THEN - A1=SFMIX(KFID,3)**2 - A2=SFMIX(KFID,4)**2 - ELSEIF(ILR.EQ.0) THEN - A1=SFMIX(KFID,1)**2 - A2=SFMIX(KFID,2)**2 - ENDIF - XLQ=(TT3J-EJ*XW)*A1 - XRQ=(-EJ*XW)*A2 - XLF=(TT3I-EI*XW) - XRF=(-EI*XW) - TAA=(EI*EJ)**2*(POLL+POLR) - TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ+XRQ)**2/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*ZWID/SH**2) - TAZ=2D0*EI*EJ*(XLQ+XRQ)*(XLF*POLL+XRF*POLR)/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - TNN=0.0D0 - TAN=0.0D0 - TZN=0.0D0 - IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN - FAC2=SQRT(2D0) - TNN1=0D0 - TNN2=0D0 - TNN3=0D0 - DO 120 II=1,4 - DK=1D0/(TH-SMZ(II)**2) - FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* - & ZMIX(II,1)) - FREK=FAC2*TANW*EI*ZMIX(II,1) - TNN1=TNN1+FLEK**2*DK - TNN2=TNN2+FREK**2*DK - DO 110 JJ=1,4 - DL=1D0/(TH-SMZ(JJ)**2) - FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* - & ZMIX(JJ,1)) - FREL=FAC2*TANW*EJ*ZMIX(JJ,1) - TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) - 110 CONTINUE - 120 CONTINUE - TNN=(UH*TH-SQM3*SQM4)*(A1**2*TNN1**2*POLL+ - & A2**2*TNN2**2*POLR) - TNN=(TNN+SH*A1*A2*TNN3*((1D0-PARJ(131))*(1D0-PARJ(132))+ - & (1D0+PARJ(131))*(1D0+PARJ(132))))/4D0/XW**2 - TZN=(UH*TH-SQM3*SQM4)*(XLQ+XRQ)* - & (TNN1*XLF*A1*POLL+TNN2*XRF*A2*POLR) - TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* - & (1D0-SQMZ/SH)/SH - TZN=TZN/XW**2/XW1 - TAN=EI*EJ*(UH*TH-SQM3*SQM4)/SH*(A1*TNN1*POLL+ - & A2*TNN2*POLR)/XW - ENDIF - FACQQ1=COMFAC*AEM**2*(TAA+TZZ+TAZ)*FCOL/3D0 - FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH**2 - FACQQ2=COMFAC*AEM**2*(TNN+TZN+TAN)*FCOL/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1+FACQQ2 - 130 CONTINUE - - ELSEIF(ISUB.EQ.203) THEN -C...f + fbar -> e_L + e_Rbar - DO 160 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 160 - EI=KCHG(IABS(I),1)/3D0 - TT3I=SIGN(1D0,EI)/2D0 - EJ=-1 - TT3J=-1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - A1=SFMIX(KFID,1)**2 - A2=SFMIX(KFID,2)**2 - XLQ=(TT3J-EJ*XW) - XRQ=(-EJ*XW) - XLF=(TT3I-EI*XW) - XRF=(-EI*XW) - TZZ=(XLF**2*POLL+XRF**2*POLR)*(XLQ-XRQ)**2 - & /XW**2/XW1**2*A1*A2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TNN=0.0D0 - TZN=0.0D0 - TNNA=0D0 - TNNB=0D0 - IF(IA.GE.11.AND.IA.LE.18.AND.KFID.EQ.IA) THEN - FAC2=SQRT(2D0) - TNN1=0D0 - TNN2=0D0 - TNN3=0D0 - DO 150 II=1,4 - DK=1D0/(TH-SMZ(II)**2) - FLEK=-FAC2*(TT3I*ZMIX(II,2)-TANW*(TT3I-EI)* - & ZMIX(II,1)) - FREK=FAC2*TANW*EI*ZMIX(II,1) - TNN1=TNN1+FLEK**2*DK - TNN2=TNN2+FREK**2*DK - DO 140 JJ=1,4 - DL=1D0/(TH-SMZ(JJ)**2) - FLEL=-FAC2*(TT3J*ZMIX(JJ,2)-TANW*(TT3J-EJ)* - & ZMIX(JJ,1)) - FREL=FAC2*TANW*EJ*ZMIX(JJ,1) - TNN3=TNN3+FLEK*FREK*FLEL*FREL*DK*DL*SMZ(II)*SMZ(JJ) - 140 CONTINUE - 150 CONTINUE - TNN=(UH*TH-SQM3*SQM4)*A1*A2*(TNN2**2*POLR+TNN1**2*POLL) - TNNA=(TNN+SH*(A1**2*POLLL+A2**2*POLRR)*TNN3)/4D0 - TNNB=(TNN+SH*(A1**2*POLRR+A2**2*POLLL)*TNN3)/4D0 - TZN=(UH*TH-SQM3*SQM4)*A1*A2 - TZN=TZN*(XLQ-XRQ)*(XLF*TNN1*POLL-XRF*TNN2*POLR)/XW1 - TZN=TZN/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)* - & (1D0-SQMZ/SH)/SH - ENDIF - FACQQ0=COMFAC*AEM**2*TZZ*FCOL/3D0*(UH*TH-SQM3*SQM4)/SH2 - FACQQ2=COMFAC*AEM**2/XW**2*(TNNA+TZN)*FCOL/3D0 - FACQQ1=COMFAC*AEM**2/XW**2*(TNNB+TZN)*FCOL/3D0 -C%%%%%%%%%%% - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACQQ0+FACQQ1)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=(FACQQ0+FACQQ2)*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 160 CONTINUE - - ELSEIF(ISUB.EQ.210) THEN -C...q + qbar' -> W*- > ~l_L + ~nu_L - FAC0=RKF*COMFAC*AEM**2/XW**2/12D0 - FAC1=(TH*UH-SQM3*SQM4)/((SH-SQMW)**2+WWID**2*SQMW) - DO 180 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 180 - DO 170 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 170 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 170 - FCKM=3D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(ISUBSV.EQ.297.OR.ISUBSV.EQ.298) THEN - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ELSE - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),5-KCHW)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - ENDIF - SIGH(NCHN)=FAC0*FAC1*FCKM*FACR - 170 CONTINUE - 180 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.220) THEN - IF(ISUB.EQ.213) THEN -C...f + fbar -> ~nu_L + ~nu_Lbar - IF(ISUBSV.EQ.299.OR.ISUBSV.EQ.300) THEN - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ELSE - FACR=WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ENDIF - COMFAC=COMFAC*FACR - PROPZ2=(SH-SQMZ)**2+ZWID**2*SQMZ - XLL=0.5D0 - XLR=0.0D0 - DO 190 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 190 - EI=KCHG(IA,1)/3D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - XLQ=(SIGN(1D0,EI)-2D0*EI*XW)/2D0 - XRQ=-EI*XW - TZC=0.0D0 - TCC=0.0D0 - IF(IA.GE.11.AND.KFID.EQ.IA+1) THEN - TZC=VMIX(1,1)**2/(TH-SMW(1)**2)+VMIX(2,1)**2/ - & (TH-SMW(2)**2) - TCC=TZC**2 - TZC=TZC/XW1*(SH-SQMZ)/PROPZ2*XLQ*XLL - ENDIF - FACQQ1=(XLQ**2+XRQ**2)*(XLL+XLR)**2/XW1**2/PROPZ2 - FACQQ2=TZC+TCC/4D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=(FACQQ1+FACQQ2)*RKF*(UH*TH-SQM3*SQM4)*COMFAC - & *AEM**2*FCOL/3D0/XW**2 - 190 CONTINUE - - ELSEIF(ISUB.EQ.216) THEN -C...q + qbar -> ~chi0_1 + ~chi0_1 - IF(IZID1.EQ.IZID2) THEN - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ELSE - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - ENDIF - FACXX=COMFAC*AEM**2/3D0/XW**2 - IF(IZID1.EQ.IZID2) FACXX=FACXX/2D0 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMZ(IZID1)*SMZ(IZID2)*SH - PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 - PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) - DO 200 I=1,4 - ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) - IF(IZID2.NE.IZID1) THEN - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - ENDIF - 200 CONTINUE - OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- - & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 - ORPP=DCONJG(OLPP) - DO 210 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 210 - EI=KCHG(IABS(I),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2 - XMR2=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2 - GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* - & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) - GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 - QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) - QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) - & /DCMPLX(TH-XML2) - QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) - QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ - & -DCONJG(GRIJ)/DCMPLX(UH-XMR2) - FCOL=1D0 - IF(IABS(I).GE.11) FCOL=3D0 - FACGG1=(ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ - & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ - & QRL*DCONJG(QRR)*POLR)*WS2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACXX*FACGG1*FCOL - 210 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.230) THEN - IF(ISUB.EQ.226) THEN -C...f + fbar -> ~chi+_1 + ~chi-_1 - FACXX=COMFAC*AEM**2/3D0 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMW(IZID1)*SMW(IZID2)*SH - PROPZ2 = (SH-SQMZ)**2 + SQMZ*ZWID**2 - PROPZ=DCMPLX(SH-SQMZ,-ZWID*PMAS(23,1))/DCMPLX(PROPZ2) - DIFF=0D0 - IF(IZID1.EQ.IZID2) DIFF=1D0 - DO 220 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - IF(IZID2.NE.IZID1) THEN - VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) - UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) - ENDIF - 220 CONTINUE - OLP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- - & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0+DCMPLX(XW*DIFF) - ORP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- - & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0+DCMPLX(XW*DIFF) - DO 230 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 230 - EI=KCHG(IABS(I),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - QRL=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*ORP - QLL=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)*PROPZ*ORP - QRR=DCMPLX(-EI/SH*DIFF)-DCMPLX(EI/XW1)*PROPZ*OLP - IF(MOD(I,2).EQ.0) THEN - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)-1),1)**2 - QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* - & PROPZ*OLP-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))* - & DCMPLX(T3I/XW/(TH-XML2)) - ELSE - XML2=PMAS(PYCOMP(KSUSY1+IABS(I)+1),1)**2 - QLR=DCMPLX(-EI/SH*DIFF)+DCMPLX((T3I-XW*EI)/XW/XW1)* - & PROPZ*OLP-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))* - & DCMPLX(T3I/XW/(TH-XML2)) - ENDIF - FCOL=1D0 - IF(IABS(I).GE.11) FCOL=3D0 - FACSUM=((ABS(QLL)**2*POLL+ABS(QRR)**2*POLR)*WU2+ - & (ABS(QRL)**2*POLR+ABS(QLR)**2*POLL)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)*POLL+ - & QRL*DCONJG(QRR)*POLR)*WS2)*FACXX*FCOL - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(IZID1.EQ.IZID2) THEN - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - ELSE - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACSUM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - ENDIF - 230 CONTINUE - - ELSEIF(ISUB.EQ.229) THEN -C...q + qbar' -> ~chi0_1 + ~chi+-_1 - FACXX=COMFAC*AEM**2/6D0/XW**2 - ZM12=SQM3 - ZM22=SQM4 - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = SMW(IZID1)*SMZ(IZID2)*SH - RT2I = 1D0/SQRT(2D0) - PROPW = DCMPLX(SH-SQMW,-WWID*PMAS(24,1))/ - & DCMPLX((SH-SQMW)**2+WWID**2*SQMW,0D0) - DO 240 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - 240 CONTINUE - DO 250 I=1,4 - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 250 CONTINUE - OL=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- - & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I)*PROPW - OR=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ - & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I)*PROPW - - DO 270 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 270 - EI=KCHG(IA,1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - DO 260 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 260 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 260 - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - FCKM=3D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - IF(MOD(IA,2).EQ.0) THEN - ZMI2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - ZMJ2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* - & TANW+ZMIXC(IZID2,2)*T3I)/DCMPLX(UH-ZMI2) - QLR=OR-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) - & /DCMPLX(TH-ZMJ2) - ELSE - ZMI2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - ZMJ2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - QLL=OL+VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* - & TANW+ZMIXC(IZID2,2)*T3J)/DCMPLX(UH-ZMJ2) - QLR=OR-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) - & /DCMPLX(TH-ZMI2) - ENDIF - ZINTR=DBLE(QLR*DCONJG(QLL)) - FACGG1=FACXX*(ABS(QLL)**2*WU2+ABS(QLR)**2*WT2+ - & 2D0*ZINTR*WS2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGG1*FCKM*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - 260 CONTINUE - 270 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.240) THEN - IF(ISUB.EQ.237) THEN -C...q + qbar -> gluino + ~chi0_1 - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - FAC0=COMFAC*AS*AEM*4D0/9D0/XW - GM2=SQM3 - ZM2=SQM4 - DO 280 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 280 - EI=KCHG(IABS(I),1)/3D0 - IA=IABS(I) - XLQC = -TANW*EI*ZMIX(IZID,1) - XRQC =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* - & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 - XLQ2=XLQC**2 - XRQ2=XRQC**2 - XML2=PMAS(PYCOMP(KSUSY1+IA),1)**2 - XMR2=PMAS(PYCOMP(KSUSY2+IA),1)**2 - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XML2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XML2)**2 - ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XML2)/(UH-XML2) - SGCHIL=XLQ2*(ATKIN+AUKIN-2D0*ATUKIN) - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMR2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMR2)**2 - ATUKIN=SMZ(IZID)*SQRT(GM2)*SH/(TH-XMR2)/(UH-XMR2) - SGCHIR=XRQ2*(ATKIN+AUKIN-2D0*ATUKIN) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FAC0*(SGCHIL+SGCHIR) - 280 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.250) THEN - IF(ISUB.EQ.241) THEN -C...q + qbar' -> ~chi+-_1 + gluino - FACWG=COMFAC*AS*AEM/XW*2D0/9D0 - GM2=SQM3 - ZM2=SQM4 - FAC01=2D0*UMIX(IZID,1)*VMIX(IZID,1) - FAC0=UMIX(IZID,1)**2 - FAC1=VMIX(IZID,1)**2 - DO 300 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 300 - DO 290 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 290 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290 - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - KCHSUM=KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J) - KCHW=2 - IF(KCHSUM.LT.0) KCHW=3 - XMU2=PMAS(PYCOMP(KSUSY1+2),1)**2 - XMD2=PMAS(PYCOMP(KSUSY1+1),1)**2 - ATKIN=(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2 - AUKIN=(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2 - ATUKIN=SMW(IZID)*SQRT(GM2)*SH/(TH-XMU2)/(UH-XMD2) - XMU2=PMAS(PYCOMP(KSUSY2+2),1)**2 - XMD2=PMAS(PYCOMP(KSUSY2+1),1)**2 - ATKIN=(ATKIN+(TH-GM2)*(TH-ZM2)/(TH-XMU2)**2)/2D0 - AUKIN=(AUKIN+(UH-GM2)*(UH-ZM2)/(UH-XMD2)**2)/2D0 - ATUKIN=(ATUKIN+SMW(IZID)*SQRT(GM2)* - & SH/(TH-XMU2)/(UH-XMD2))/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWG*FCKM*(FAC0*ATKIN+FAC1*AUKIN- - & FAC01*ATUKIN)*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHW) - 290 CONTINUE - 300 CONTINUE - - ELSEIF(ISUB.EQ.243) THEN -C...q + qbar -> gluino + gluino - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - XMT=SQM3-TH - XMU=SQM3-UH - DO 310 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 - NCHN=NCHN+1 - XSU=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-UH - XST=PMAS(PYCOMP(KSUSY1+IABS(I)),1)**2-TH - FACGG1=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ - & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ - & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + - & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) - XSU=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-UH - XST=PMAS(PYCOMP(KSUSY2+IABS(I)),1)**2-TH - FACGG2=COMFAC*AS**2*8D0/3D0*( (XMT**2+XMU**2+ - & 2D0*SQM3*SH)/SH2 +4D0/9D0*(XMT**2/XST**2+ - & XMU**2/XSU**2) - (XMT**2+SH*SQM3)/SH/XST + - & SQM3*SH/XST/XSU/9D0- (XMU**2+SH*SQM3)/SH/XSU ) - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 -C...1/2 for identical particles - SIGH(NCHN)=0.25D0*(FACGG1+FACGG2) - 310 CONTINUE - - ELSEIF(ISUB.EQ.244) THEN -C...g + g -> gluino + gluino - COMFAC=COMFAC*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - XMT=SQM3-TH - XMU=SQM3-UH - FACQQ1=COMFAC*AS**2*9D0/4D0*( - & (XMT*XMU-2D0*SQM3*(TH+SQM3))/XMT**2 - - & (XMT*XMU+SQM3*(UH-TH))/SH/XMT ) - FACQQ2=COMFAC*AS**2*9D0/4D0*( - & (XMU*XMT-2D0*SQM3*(UH+SQM3))/XMU**2 - - & (XMU*XMT+SQM3*(TH-UH))/SH/XMU ) - FACQQ3=COMFAC*AS**2*9D0/4D0*(2D0*XMT*XMU/SH2 + - & SQM3*(SH-4D0*SQM3)/XMT/XMU) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 320 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2/2D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=FACQQ3/2D0 - 320 CONTINUE - - ELSEIF(ISUB.EQ.246) THEN -C...g + q_j -> ~chi0_1 + ~q_j - FAC0=COMFAC*AS*AEM/6D0/XW - ZM2=SQM4 - QM2=SQM3 - FACZQ0=FAC0*( (ZM2-TH)/SH + - & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - - & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - DO 340 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 340 - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 - EI=KCHG(IABS(I),1)/3D0 - IA=IABS(I) - XRQZ = -TANW*EI*ZMIX(IZID,1) - XLQZ =(SIGN(1D0,EI)*ZMIX(IZID,2)-TANW* - & (SIGN(1D0,EI)-2D0*EI)*ZMIX(IZID,1))/2D0 - IF(ILR.EQ.0) THEN - BS=XLQZ**2*SFMIX(IA,1)**2+XRQZ**2*SFMIX(IA,2)**2 - ELSE - BS=XLQZ**2*SFMIX(IA,3)**2+XRQZ**2*SFMIX(IA,4)**2 - ENDIF - FACZQ=FACZQ0*BS - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 330 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 330 CONTINUE - 340 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.260) THEN - IF(ISUB.EQ.254) THEN -C...g + q_j -> ~chi1_1 + ~q_i - FAC0=COMFAC*AS*AEM/12D0/XW - ZM2=SQM4 - QM2=SQM3 - AU=UMIX(IZID,1)**2 - AD=VMIX(IZID,1)**2 - FACZQ0=FAC0*( (ZM2-TH)/SH + - & (UH-ZM2)*(UH+QM2)/(UH-QM2)**2 - - & (SH*(UH+ZM2)+2D0*(QM2-ZM2)*(ZM2-UH))/SH/(UH-QM2) ) - KFNSQ1=MOD(KFPR(ISUBSV,1),KSUSY1) - IF(MOD(KFNSQ1,2).EQ.0) THEN - KFNSQ=KFNSQ1-1 - KCHW=2 - ELSE - KFNSQ=KFNSQ1+1 - KCHW=3 - ENDIF - DO 360 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 360 - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 - IA=IABS(I) - IF(MOD(IA,2).EQ.0) THEN - FACZQ=FACZQ0*AU - ELSE - FACZQ=FACZQ0*AD - ENDIF - FACZQ=FACZQ*SFMIX(KFNSQ1,1+2*ILR)**2 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - KCHWQ=KCHW - IF(I.LT.0) KCHWQ=5-KCHW - DO 350 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHWQ) - 350 CONTINUE - 360 CONTINUE - - ELSEIF(ISUB.EQ.258) THEN -C...g + q_j -> gluino + ~q_i - XG2=SQM4 - XQ2=SQM3 - XMT=XG2-TH - XMU=XG2-UH - XST=XQ2-TH - XSU=XQ2-UH - FACQG1=0.5D0*4D0/9D0*XMT/SH + (XMT*SH+2D0*XG2*XST)/XMT**2 - - & ( (SH-XQ2+XG2)*(-XST)-SH*XG2 )/SH/(-XMT) + - & 0.5D0*1D0/2D0*( XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST) + - & (-XMU)*(TH+XG2+2D0*XQ2) )/2D0/XMT/XSU - FACQG2= 4D0/9D0*(-XMU)*(UH+XQ2)/XSU**2 + 1D0/18D0* - & (SH*(UH+XG2) - & +2D0*(XQ2-XG2)*XMU)/SH/(-XSU) + 0.5D0*4D0/9D0*XMT/SH + - & 0.5D0*1D0/2D0*(XST*(TH+2D0*UH+XG2)-XMT*(SH-2D0*XST)+ - & (-XMU)*(TH+XG2+2D0*XQ2))/2D0/XMT/XSU - FACQG1=COMFAC*AS**2*FACQG1/2D0 - FACQG2=COMFAC*AS**2*FACQG2/2D0 - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - DO 380 I=-KFNSQ,KFNSQ,2*KFNSQ - IF(I.LT.MMINA.OR.I.GT.MMAXA) GOTO 380 - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 380 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - FACSEL=RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - DO 370 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 370 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 370 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1*FACSEL - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2*FACSEL - 370 CONTINUE - 380 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.270) THEN - IF(ISUB.EQ.261) THEN -C...q_i + q_ibar -> ~t_1 + ~t_1bar - FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 )* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - FAC0=AS**2*4D0/9D0 - DO 390 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390 - IF(IA.GE.11.AND.IA.LE.18) THEN - EI=KCHG(IA,1)/3D0 - EJ=KCHG(KFNSQ,1)/3D0 - T3I=SIGN(1D0,EI)/2D0 - T3J=SIGN(1D0,EJ)/2D0 - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,2*ILR+1)**2 - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2*ILR+2)**2 - XLF=2D0*(T3I-EI*XW) - XRF=2D0*(-EI*XW) - TAA=0.5D0*(EI*EJ)**2 - TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*FAC0 - 390 CONTINUE - - ELSEIF(ISUB.EQ.263) THEN -C...f + fbar -> ~t1 + ~t2bar - DO 400 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 400 - EI=KCHG(IABS(I),1)/3D0 - TT3I=SIGN(1D0,EI)/2D0 - EJ=2D0/3D0 - TT3J=1D0/2D0 - FCOL=1D0 -C...Color factor for e+ e- - IF(IA.GE.11) FCOL=3D0 - XLQ=2D0*(TT3J-EJ*XW) - XRQ=2D0*(-EJ*XW) - XLF=2D0*(TT3I-EI*XW) - XRF=2D0*(-EI*XW) - TZZ=(XLF**2+XRF**2)*(XLQ-XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ*(SFMIX(6,1)*SFMIX(6,2))**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) -C...Factor of 2 for t1 t2bar + t2 t1bar - FACQQ1=2D0*COMFAC*AEM**2*TZZ*FCOL*4D0 - FACQQ1=FACQQ1*( UH*TH-SQM3*SQM4 )/SH2 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),2)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ1*WIDS(PYCOMP(KFPR(ISUBSV,1)),3)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),2) - 400 CONTINUE - - ELSEIF(ISUB.EQ.264) THEN -C...g + g -> ~t_1 + ~t_1bar - XSU=SQM3-UH - XST=SQM3-TH - FAC0=COMFAC*AS**2*(7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 )*0.5D0* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) - FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 410 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.280) THEN - IF(ISUB.EQ.271) THEN -C...q + q' -> ~q + ~q' (~g exchange) - XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 - XMT=XMG2-TH - XMU=XMG2-UH - XSU1=SQM3-UH - XSU2=SQM4-UH - XST1=SQM3-TH - XST2=SQM4-TH - IF(ILR.EQ.1) THEN - FACQQ1=COMFAC*AS**2*4D0/9D0*( -(XST1*XST2+SH*TH)/XMT**2 ) - FACQQ2=COMFAC*AS**2*4D0/9D0*( -(XSU1*XSU2+SH*UH)/XMU**2 ) - FACQQB=0.0D0 - ELSE - FACQQ1=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMT**2 ) - FACQQ2=0.5D0*COMFAC*AS**2*4D0/9D0*( SH*XMG2/XMU**2 ) - FACQQB=0.5D0*COMFAC*AS**2*4D0/9D0*( -2D0*SH*XMG2/3D0/ - & XMT/XMU ) - ENDIF - KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) - KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) - DO 430 I=-KFNSQI,KFNSQI,2*KFNSQI - IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 430 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 420 J=-KFNSQJ,KFNSQJ,2*KFNSQJ - IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 420 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 - IF(I*J.LT.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - IF(I.EQ.J) THEN - IF(ILR.EQ.0) THEN - SIGH(NCHN)=0.5D0*(FACQQ1+0.5D0*FACQQB)*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) - ELSE - SIGH(NCHN)=0.5D0*FACQQ1*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(ILR.EQ.0) THEN - SIGH(NCHN)=0.5D0*(FACQQ2+0.5D0*FACQQB)*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ+2) - ELSE - SIGH(NCHN)=0.5D0*FACQQ2*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),KCHQ) - ENDIF - ENDIF - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.274) THEN -C...q + qbar' -> ~q + ~qbar' - XMG2=PMAS(PYCOMP(KSUSY1+21),1)**2 - XMT=XMG2-TH - XMU=XMG2-UH - IF(ILR.EQ.0) THEN -C...Mrenna...Normalization.and.1/XMT - FACQQ1=COMFAC*AS**2*2D0/9D0*( - & (UH*TH-SQM3*SQM4)/XMT**2 ) - FACQQB=COMFAC*AS**2*2D0/9D0*( - & (UH*TH-SQM3*SQM4)/SH2*(2D0-2D0/3D0*SH/XMT)) - FACQQB=FACQQB+FACQQ1 - ELSE - FACQQ1=COMFAC*AS**2*4D0/9D0*( XMG2*SH/XMT**2 ) - FACQQB=FACQQ1 - ENDIF - KFNSQI=MOD(KFPR(ISUBSV,1),KSUSY1) - KFNSQJ=MOD(KFPR(ISUBSV,2),KSUSY1) - DO 450 I=-KFNSQI,KFNSQI,2*KFNSQI - IF(I.LT.MMIN1.OR.I.GT.MMAX1) GOTO 450 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 450 - KCHQ=2 - IF(I.LT.0) KCHQ=3 - DO 440 J=-KFNSQJ,KFNSQJ,2*KFNSQJ - IF(J.LT.MMIN2.OR.J.GT.MMAX2) GOTO 440 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 440 - IF(I*J.GT.0) GOTO 440 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),KCHQ)* - & WIDS(PYCOMP(KFPR(ISUBSV,2)),5-KCHQ) - IF(I.EQ.-J) SIGH(NCHN)=FACQQB*RKF* - & WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 440 CONTINUE - 450 CONTINUE - - ELSEIF(ISUB.EQ.277) THEN -C...q_i + q_ibar -> ~q_j + ~q_jbar ,i .ne. j -C...if i .eq. j covered in 274 - FACQQ1=COMFAC*( (UH*TH-SQM3*SQM4)/ SH**2 ) - KFNSQ=MOD(KFPR(ISUBSV,1),KSUSY1) - FAC0=0D0 - DO 460 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.(IA.GT.MSTP(58).AND.IA.LE.10).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 - IF(IA.EQ.KFNSQ) GOTO 460 - IF(IA.EQ.11.OR.IA.EQ.13.OR.IA.EQ.15) THEN - EI=KCHG(IA,1)/3D0 - EJ=KCHG(KFNSQ,1)/3D0 - T3J=SIGN(0.5D0,EJ) - T3I=SIGN(1D0,EI)/2D0 - IF(ILR.EQ.0) THEN - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,1) - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,2) - ELSE - XLQ=2D0*(T3J-EJ*XW)*SFMIX(KFNSQ,3) - XRQ=2D0*(-EJ*XW)*SFMIX(KFNSQ,4) - ENDIF - XLF=2D0*(T3I-EI*XW) - XRF=2D0*(-EI*XW) - IF(ILR.EQ.0) THEN - XRQ=0D0 - ELSE - XLQ=0D0 - ENDIF - TAA=0.5D0*(EI*EJ)**2 - TZZ=(XLF**2+XRF**2)*(XLQ+XRQ)**2/64D0/XW**2/XW1**2 - TZZ=TZZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2) - TAZ=EI*EJ*(XLQ+XRQ)*(XLF+XRF)/8D0/XW/XW1 - TAZ=TAZ/((1D0-SQMZ/SH)**2+SQMZ*(ZWID/SH)**2)*(1D0-SQMZ/SH) - FAC0=AEM**2*12D0*(TAA+TZZ+TAZ) - ELSEIF(IA.LE.6) THEN - FAC0=AS**2*8D0/9D0/2D0 - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1*FAC0*RKF*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 460 CONTINUE - - ELSEIF(ISUB.EQ.279) THEN -C...g + g -> ~q_j + ~q_jbar - XSU=SQM3-UH - XST=SQM3-TH -C...5=RKF because ~t ~tbar treated separately - FAC0=RKF*COMFAC*AS**2*( 7D0/48D0+3D0*(UH-TH)**2/16D0/SH2 ) - FACQQ1=FAC0*(0.5D0+2D0*SQM3*TH/XST**2 + 2D0*SQM3**2/XSU/XST) - FACQQ2=FAC0*(0.5D0+2D0*SQM3*UH/XSU**2 + 2D0*SQM3**2/XSU/XST) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2/2D0*WIDS(PYCOMP(KFPR(ISUBSV,1)),1) - 470 CONTINUE - - ENDIF - ENDIF -CMRENNA-- - - RETURN - END - -C********************************************************************* - -C...PYSGTC -C...Subprocess cross sections for Technicolor processes. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGTC(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYINT1/,/PYINT2/, - &/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION WDTP(0:400),WDTE(0:400,0:5) - COMPLEX*16 SSMZ,SSMR,SSMO,DETD,F2L,F2R,DARHO,DZRHO,DAOME,DZOME - COMPLEX*16 DAA,DZZ,DAZ,DWW,DWRHO - COMPLEX*16 ZTC(6,6),YTC(6,6),DGGS,DGGT,DGGU,DGVS,DGVT,DGVU - COMPLEX*16 DQQS,DQQT,DQQU,DQTS,DQGS,DTGS - COMPLEX*16 DVVS,DVVT,DVVU - INTEGER INDX(6) - -C...Combinations of weak mixing angle. - TANW=SQRT(XW/XW1) - CT2W=(1D0-2D0*XW)/(2D0*XW/TANW) - -C...Convert almost equivalent technicolor processes into -C...a few basic processes, and set distinguishing parameters. - IF(ISUB.GE.361.AND.ISUB.LE.379) THEN - SQTV=RTCM(12)**2 - SQTA=RTCM(13)**2 - SN2W=2D0*SQRT(PARU(102)*(1D0-PARU(102))) - CS2W=1D0-2D0*PARU(102) - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=CS2W/SN2W - CSXI=COS(ASIN(RTCM(3))) - CSXIP=COS(ASIN(RTCM(4))) - QUPD=2D0*RTCM(2)-1D0 - Q2UD=RTCM(2)**2+(RTCM(2)-1D0)**2 -C... rho_tc0 -> W_L W_L - IF(ISUB.EQ.361) THEN - KFA=24 - KFB=24 - CAB2=RTCM(3)**4 -C... rho_tc0 -> W_L pi_tc- - ELSEIF(ISUB.EQ.362) THEN - KFA=24 - KFB=KTECHN+211 - ISUB=361 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... pi_tc pi_tc - ELSEIF(ISUB.EQ.363) THEN - KFA=KTECHN+211 - KFB=KTECHN+211 - ISUB=361 - CAB2=(1D0-RTCM(3)**2)**2 -C... rho_tc0/omega_tc -> gamma pi_tc - ELSEIF(ISUB.EQ.364) THEN - KFA=22 - KFB=KTECHN+111 - VOGP=CSXI/RTCM(12) -C..........!!! - VRGP=VOGP*QUPD - AOGP=0D0 - ARGP=0D0 - VAGP=2D0*QUPD*CSXI - VZGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W -C... gamma pi_tc' - ELSEIF(ISUB.EQ.365) THEN - KFA=22 - KFB=KTECHN+221 - ISUB=364 - VRGP=CSXIP/RTCM(12) -C..........!!!! - VOGP=VRGP*QUPD - AOGP=0D0 - ARGP=0D0 - VAGP=2D0*Q2UD*CSXIP - VZGP=CSXIP/SN2W*(1D0-4D0*PARU(102)*Q2UD) -C... Z pi_tc - ELSEIF(ISUB.EQ.366) THEN - KFA=23 - KFB=KTECHN+111 - ISUB=364 - VOGP=CSXI*CT2W/RTCM(12) - VRGP=-QUPD*CSXI*TANW/RTCM(12) - AOGP=0D0 - ARGP=0D0 - VAGP=QUPD*CSXI*(1D0-4D0*PARU(102))/SN2W - VZGP=-QUPD*CSXI*CS2W/(1D0-PARU(102)) -C... Z pi_tc' - ELSEIF(ISUB.EQ.367) THEN - KFA=23 - KFB=KTECHN+221 - ISUB=364 - VRGP=CSXIP*CT2W/RTCM(12) - VOGP=-QUPD*CSXIP*TANW/RTCM(12) - AOGP=0D0 - ARGP=0D0 - VAGP=CSXIP*(1D0-4D0*Q2UD*PARU(102))/SN2W - VZGP=2D0*CSXIP*(CS2W+4D0*Q2UD*PARU(102)**2)/SN2W**2 -C... W_T pi_tc - ELSEIF(ISUB.EQ.368) THEN - KFA=24 - KFB=KTECHN+211 - ISUB=364 - VOGP=CSXI/(2D0*SQRT(PARU(102)))/RTCM(12) - VRGP=0D0 - AOGP=0D0 -C..........!!!! - ARGP=-CSXI/(2D0*SQRT(PARU(102)))/RTCM(13) - VAGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) - VZGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) -C... rho_tc+ -> W_L Z_L - ELSEIF(ISUB.EQ.370) THEN - KFA=24 - KFB=23 - CAB2=RTCM(3)**4 -C... W_L pi_tc0 - ELSEIF(ISUB.EQ.371) THEN - KFA=24 - KFB=KTECHN+111 - ISUB=370 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... Z_L pi_tc+ - ELSEIF(ISUB.EQ.372) THEN - KFA=KTECHN+211 - KFB=23 - ISUB=370 - CAB2=RTCM(3)**2*(1D0-RTCM(3)**2) -C... pi_tc+ pi_tc0 - ELSEIF(ISUB.EQ.373) THEN - KFA=KTECHN+211 - KFB=KTECHN+111 - ISUB=370 - CAB2=(1D0-RTCM(3)**2)**2 -C... gamma pi_tc+ - ELSEIF(ISUB.EQ.374) THEN - KFA=KTECHN+211 - KFB=22 - VRGP=QUPD*CSXI - ARGP=0D0 - VWGP=QUPD*CSXI/(2D0*SQRT(PARU(102))) -C... Z_T pi_tc+ - ELSEIF(ISUB.EQ.375) THEN - KFA=KTECHN+211 - KFB=23 - ISUB=374 - VRGP=-QUPD*CSXI*TANW - ARGP=CSXI/(2D0*SQRT(PARU(102)*(1D0-PARU(102)))) - VWGP=-QUPD*CSXI/(2D0*SQRT(1D0-PARU(102))) -C... W_T pi_tc0 - ELSEIF(ISUB.EQ.376) THEN - KFA=24 - KFB=KTECHN+111 - ISUB=374 - VRGP=0D0 - ARGP=-CSXI/(2D0*SQRT(PARU(102))) - VWGP=0D0 -C... W_T pi_tc0' - ELSEIF(ISUB.EQ.377) THEN - KFA=24 - KFB=KTECHN+221 - ISUB=374 - ARGP=0D0 - VRGP=CSXIP/(2D0*SQRT(PARU(102))) - VWGP=CSXIP/(2D0*PARU(102)) - ENDIF - ENDIF - -C...QCD 2 -> 2 processes: corrections from virtual technicolor exchange. - IF(ISUB.GE.381.AND.ISUB.LE.388) THEN - IF(ITCM(5).LE.4) THEN - SQDQQS=1D0/SH2 - SQDQQT=1D0/TH2 - SQDQQU=1D0/UH2 - SQDGGS=SQDQQS - SQDGGT=SQDQQT - SQDGGU=SQDQQU - REDGGS=1D0/SH - REDGGT=1D0/TH - REDGGU=1D0/UH - REDGTU=1D0/UH/TH - REDGSU=1D0/SH/UH - REDGST=1D0/SH/TH - REDQST=1D0/SH/TH - REDQTU=1D0/UH/TH - SQDLGS=0D0 - SQDLGT=0D0 - SQDQTS=SQDQQS - ELSEIF(ITCM(5).EQ.5) THEN - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSE - IMDL=2 - ENDIF - ALPRHT=2.91D0*(3D0/ITCM(1)) - SIN2T=2D0*TANT3/(TANT3**2+1D0) - SINT3=TANT3/SQRT(TANT3**2+1D0) - XIG=SQRT(PYALPS(SH)/ALPRHT) - X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0)/SIN2T - X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0)/SIN2T - X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- - & SINT3**2)*2D0/SIN2T - X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- - & SINT3**2)*2D0/SIN2T - - SM1122=.5D0*(2D0-RTCM(29)**2-RTCM(31)**2)*RTCM(28)**2 - SM1112=X12*RTCM(28)**2*SIN2T - SM1121=-X21*RTCM(28)**2*SIN2T - SM2212=-SM1112 - SM2221=-SM1121 - SM1221=-.5D0*((1D0-RTCM(29)**2)*SIN(2D0*RTCM(30))+ - & (1D0-RTCM(31)**2)*SIN(2D0*RTCM(32)))*RTCM(28)**2 - -C.........SH LOOP - ZTC(1,1)=DCMPLX(SH,0D0) - CALL PYWIDT(3100021,SH,WDTP,WDTE) - IF(WDTP(0).GT.RTCM(33)*SHR) WDTP(0)=RTCM(33)*SHR - ZTC(2,2)=DCMPLX(SH-PMAS(PYCOMP(3100021),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3100113,SH,WDTP,WDTE) - ZTC(3,3)=DCMPLX(SH-PMAS(PYCOMP(3100113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3400113,SH,WDTP,WDTE) - ZTC(4,4)=DCMPLX(SH-PMAS(PYCOMP(3400113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3200113,SH,WDTP,WDTE) - ZTC(5,5)=DCMPLX(SH-PMAS(PYCOMP(3200113),1)**2,-SHR*WDTP(0)) - CALL PYWIDT(3300113,SH,WDTP,WDTE) - ZTC(6,6)=DCMPLX(SH-PMAS(PYCOMP(3300113),1)**2,-SHR*WDTP(0)) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(SH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(SH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(SH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(SH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(SH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - - DO 110 I=1,5 - DO 100 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 100 CONTINUE - 110 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 130 I=1,6 - DO 120 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 120 CONTINUE - 130 CONTINUE - - DO 140 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 140 CONTINUE - DGGS=YTC(1,1) - DVVS=YTC(2,2) - DGVS=YTC(1,2) - - XIG=SQRT(PYALPS(-TH)/ALPRHT) -C.........TH LOOP - ZTC(1,1)=DCMPLX(TH) - ZTC(2,2)=DCMPLX(TH-PMAS(PYCOMP(3100021),1)**2) - ZTC(3,3)=DCMPLX(TH-PMAS(PYCOMP(3100113),1)**2) - ZTC(4,4)=DCMPLX(TH-PMAS(PYCOMP(3400113),1)**2) - ZTC(5,5)=DCMPLX(TH-PMAS(PYCOMP(3200113),1)**2) - ZTC(6,6)=DCMPLX(TH-PMAS(PYCOMP(3300113),1)**2) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(TH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(TH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(TH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(TH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(TH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - DO 160 I=1,5 - DO 150 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 150 CONTINUE - 160 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 180 I=1,6 - DO 170 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 170 CONTINUE - 180 CONTINUE - DO 190 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 190 CONTINUE - DGGT=YTC(1,1) - DVVT=YTC(2,2) - DGVT=YTC(1,2) - - XIG=SQRT(PYALPS(-UH)/ALPRHT) -C.........UH LOOP - ZTC(1,1)=DCMPLX(UH,0D0) - ZTC(2,2)=DCMPLX(UH-PMAS(PYCOMP(3100021),1)**2) - ZTC(3,3)=DCMPLX(UH-PMAS(PYCOMP(3100113),1)**2) - ZTC(4,4)=DCMPLX(UH-PMAS(PYCOMP(3400113),1)**2) - ZTC(5,5)=DCMPLX(UH-PMAS(PYCOMP(3200113),1)**2) - ZTC(6,6)=DCMPLX(UH-PMAS(PYCOMP(3300113),1)**2) - ZTC(1,2)=(0D0,0D0) - ZTC(1,3)=DCMPLX(UH*XIG,0D0) - ZTC(1,4)=ZTC(1,3) - ZTC(1,5)=ZTC(1,2) - ZTC(1,6)=ZTC(1,2) - ZTC(2,3)=DCMPLX(UH*XIG*X11,0D0) - ZTC(2,4)=DCMPLX(UH*XIG*X22,0D0) - ZTC(2,5)=DCMPLX(UH*XIG*X12,0D0) - ZTC(2,6)=DCMPLX(UH*XIG*X21,0D0) - ZTC(3,4)=-SM1122 - ZTC(3,5)=-SM1112 - ZTC(3,6)=-SM1121 - ZTC(4,5)=-SM2212 - ZTC(4,6)=-SM2221 - ZTC(5,6)=-SM1221 - DO 210 I=1,5 - DO 200 J=I+1,6 - ZTC(J,I)=ZTC(I,J) - 200 CONTINUE - 210 CONTINUE - CALL PYLDCM(ZTC,6,6,INDX,D) - DO 230 I=1,6 - DO 220 J=1,6 - YTC(I,J)=(0D0,0D0) - IF(I.EQ.J) YTC(I,J)=(1D0,0D0) - 220 CONTINUE - 230 CONTINUE - DO 240 I=1,6 - CALL PYBKSB(ZTC,6,6,INDX,YTC(1,I)) - 240 CONTINUE - DGGU=YTC(1,1) - DVVU=YTC(2,2) - DGVU=YTC(1,2) - - IF(IMDL.EQ.1) THEN - DQQS=DGGS+DVVS*DCMPLX(TANT3**2)-DGVS*DCMPLX(2D0*TANT3) - DQQT=DGGT+DVVT*DCMPLX(TANT3**2)-DGVT*DCMPLX(2D0*TANT3) - DQQU=DGGU+DVVU*DCMPLX(TANT3**2)-DGVU*DCMPLX(2D0*TANT3) - DQTS=DGGS-DVVS-DGVS*DCMPLX(TANT3-1D0/TANT3) - DQGS=DGGS-DGVS*DCMPLX(TANT3) - DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - ELSE - DQQS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) - DQQT=DGGT+DVVT*DCMPLX(1D0/TANT3**2)+DGVT*DCMPLX(2D0/TANT3) - DQQU=DGGU+DVVU*DCMPLX(1D0/TANT3**2)+DGVU*DCMPLX(2D0/TANT3) - DQTS=DGGS+DVVS*DCMPLX(1D0/TANT3**2)+DGVS*DCMPLX(2D0/TANT3) - DQGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - DTGS=DGGS+DGVS*DCMPLX(1D0/TANT3) - ENDIF - - SQDQTS=ABS(DQTS)**2 - SQDQQS=ABS(DQQS)**2 - SQDQQT=ABS(DQQT)**2 - SQDQQU=ABS(DQQU)**2 - SQDLGS=ABS(DCMPLX(SH)*DQGS-DCMPLX(1D0))**2 - REDLGS=DBLE(DQGS) - SQDHGS=ABS(DCMPLX(SH)*DTGS-DCMPLX(1D0))**2 - REDHGS=DBLE(DTGS) - SQDLGT=ABS(DCMPLX(TH)*DGGT-DCMPLX(1D0))**2 - - SQDGGS=ABS(DGGS)**2 - SQDGGT=ABS(DGGT)**2 - SQDGGU=ABS(DGGU)**2 - REDGGS=DBLE(DGGS) - REDGGT=DBLE(DGGT) - REDGGU=DBLE(DGGU) - REDGTU=DBLE(DGGU*DCONJG(DGGT)) - REDGSU=DBLE(DGGU*DCONJG(DGGS)) - REDGST=DBLE(DGGS*DCONJG(DGGT)) - REDQST=DBLE(DQQS*DCONJG(DQQT)) - REDQTU=DBLE(DQQT*DCONJG(DQQU)) - ENDIF - ENDIF - - -C...Differential cross section expressions. - - IF(ISUB.LE.190) THEN - IF(ISUB.EQ.149) THEN -C...g + g -> eta_tc - KCTC=PYCOMP(KTECHN+331) - CALL PYWIDT(KTECHN+331,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=COMFAC*0.5D0/((SH-PMAS(KCTC,1)**2)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HP=SH - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 250 - HI=HP*WDTP(3) - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 250 CONTINUE - - ELSEIF(ISUB.EQ.165) THEN -C...q + qbar -> l+ + l- (including contact term for compositeness) - ZRATR=XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - ZRATI=XWC*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - KFF=IABS(KFPR(ISUB,1)) - EF=KCHG(KFF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=VF+AF - VARF=VF-AF - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - WID2=1D0 - IF(KFF.EQ.6) WID2=WIDS(6,1) - IF(KFF.EQ.7.OR.KFF.EQ.8) WID2=WIDS(KFF,1) - IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) - DO 260 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=VI+AI - VARI=VI-AI - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF((ITCM(5).EQ.1.AND.IABS(I).LE.2).OR.ITCM(5).EQ.2) THEN - FGZA=(EI*EF+VALI*VALF*ZRATR+RTCM(42)*SH/ - & (AEM*RTCM(41)**2))**2+(VALI*VALF*ZRATI)**2+ - & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 - ELSE - FGZA=(EI*EF+VALI*VALF*ZRATR)**2+(VALI*VALF*ZRATI)**2+ - & (EI*EF+VARI*VARF*ZRATR)**2+(VARI*VARF*ZRATI)**2 - ENDIF - FGZB=(EI*EF+VALI*VARF*ZRATR)**2+(VALI*VARF*ZRATI)**2+ - & (EI*EF+VARI*VALF*ZRATR)**2+(VARI*VALF*ZRATI)**2 - FGZAB=AEM**2*(FGZA*UH2/SH2+FGZB*TH2/SH2) - IF((ITCM(5).EQ.3.AND.IABS(I).EQ.2).OR.(ITCM(5).EQ.4.AND. - & MOD(IABS(I),2).EQ.0)) FGZAB=FGZAB+SH2/(2D0*RTCM(41)**4) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*FCOI*FCOF*FGZAB*WID2 - 260 CONTINUE - - ELSEIF(ISUB.EQ.166) THEN -C...q + q'bar -> l + nu_l (including contact term for compositeness) - WFAC=(1D0/4D0)*(AEM/XW)**2*UH2/((SH-SQMW)**2+GMMW**2) - WCIFAC=WFAC+SH2/(4D0*RTCM(41)**4) - KFF=IABS(KFPR(ISUB,1)) - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - DO 280 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 280 - IA=IABS(I) - DO 270 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 270 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 270 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 270 - FCOI=1D0 - IF(IA.LE.10) FCOI=VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - WID2=1D0 - IF((I.GT.0.AND.MOD(I,2).EQ.0).OR.(J.GT.0.AND. - & MOD(J,2).EQ.0)) THEN - IF(KFF.EQ.5) WID2=WIDS(6,2) - IF(KFF.EQ.7) WID2=WIDS(8,2)*WIDS(7,3) - IF(KFF.EQ.17) WID2=WIDS(18,2)*WIDS(17,3) - ELSE - IF(KFF.EQ.5) WID2=WIDS(6,3) - IF(KFF.EQ.7) WID2=WIDS(8,3)*WIDS(7,2) - IF(KFF.EQ.17) WID2=WIDS(18,3)*WIDS(17,2) - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=COMFAC*FCOI*FCOF*WFAC*WID2 - IF((ITCM(5).EQ.3.AND.IA.LE.2.AND.JA.LE.2).OR.ITCM(5).EQ.4) - & SIGH(NCHN)=COMFAC*FCOI*FCOF*WCIFAC*WID2 - 270 CONTINUE - 280 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.200) THEN - IF(ISUB.EQ.191) THEN -C...q + qbar -> rho_tc0. - KCTC=PYCOMP(KTECHN+113) - SQMRHT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 290 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 290 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - HI=HP*((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 290 CONTINUE - - ELSEIF(ISUB.EQ.192) THEN -C...q + qbar' -> rho_tc+/-. - KCTC=PYCOMP(KTECHN+213) - SQMRHT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMRHT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMRHT**2/SH)* - & (0.25D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) - DO 310 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 310 - IA=IABS(I) - DO 300 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 300 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 300 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 300 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHR)/2)+WDTE(0,4)) - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 300 CONTINUE - 310 CONTINUE - - ELSEIF(ISUB.EQ.193) THEN -C...q + qbar -> omega_tc0. - KCTC=PYCOMP(KTECHN+223) - SQMOMT=PMAS(KCTC,1)**2 - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=12D0*COMFAC/((SH-SQMOMT)**2+HS**2) - IF(ABS(SHR-PMAS(KCTC,1)).GT.PARP(48)*PMAS(KCTC,2)) FACBW=0D0 - HF=SHR*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/6D0)*(AEM**2/ALPRHT)*(SQMOMT**2/SH)* - & (2D0*RTCM(2)-1D0)**2 - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 320 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - HI=HP*((EI-VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI-VARI*BWZR)**2+(VARI*BWZI)**2) - IF(IA.LE.10) HI=HI*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*FACBW*HF - 320 CONTINUE - - ELSEIF(ISUB.EQ.194) THEN -C...f + fbar -> f' + fbar' via s-channel rho_tc and omega_tc. - KFA=KFPR(ISUBSV,1) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=AEM**2*COMFAC - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) - - QUPD=2D0*RTCM(2)-1D0 - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DAA=(-Sfzr*SSMO - Sfzo*SSMR + SSMO*SSMR*SSMZ)/DETD/SH - DZZ=(-Sfar*SSMO - Sfao*SSMR + SSMO*SSMR)/DETD/SH - DAZ=(far*fzr*SSMO + fao*fzo*SSMR)/DETD/SH - - XWRHT=1D0/(4D0*XW*(1D0-XW)) - KFF=IABS(KFPR(ISUB,1)) - EF=KCHG(KFF,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - VALF=0.5D0*(VF+AF) - VARF=0.5D0*(VF-AF) - FCOF=1D0 - IF(KFF.LE.10) FCOF=3D0 - - WID2=1D0 - IF(KFF.GE.6.AND.KFF.LE.8) WID2=WIDS(KFF,1) - IF(KFF.EQ.17.OR.KFF.EQ.18) WID2=WIDS(KFF,1) - DZZ=DZZ*DCMPLX(XWRHT,0D0) - DAZ=DAZ*DCMPLX(SQRT(XWRHT),0D0) - - DO 330 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 330 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - FCOI=FCOF - IF(IABS(I).LE.10) FCOI=FCOI/3D0 - DIFLL=ABS(EI*EF*DAA+VALI*VALF*DZZ+DAZ*(EI*VALF+EF*VALI))**2 - DIFRR=ABS(EI*EF*DAA+VARI*VARF*DZZ+DAZ*(EI*VARF+EF*VARI))**2 - DIFLR=ABS(EI*EF*DAA+VALI*VARF*DZZ+DAZ*(EI*VARF+EF*VALI))**2 - DIFRL=ABS(EI*EF*DAA+VARI*VALF*DZZ+DAZ*(EI*VALF+EF*VARI))**2 - FACSIG=(DIFLL+DIFRR)*((UH-SQM4)**2+SH*SQM4)+ - & (DIFLR+DIFRL)*((TH-SQM3)**2+SH*SQM3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=HP*FCOI*FACSIG*WID2 - 330 CONTINUE - - ELSEIF(ISUB.EQ.195) THEN -C...f + fbar' -> f'' + fbar''' via s-channel rho_tc+ - KFA=KFPR(ISUBSV,1) - KFB=KFA+1 - ALPRHT=2.91D0*(3D0/ITCM(1)) - FACTC=COMFAC*(AEM**2/12D0/XW**2)*(UH-SQM3)*(UH-SQM4)*3D0 - - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - - FCOF=1D0 - IF(KFA.LE.8) FCOF=3D0 - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - HP=FACTC*ABS(SSMR/DETD)**2/SH**2*FCOF - - DO 350 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 350 - IA=IABS(I) - DO 340 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 340 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 340 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 340 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(KFA,(5-KCHR)/2)*WIDS(KFB,(5+KCHR)/2) - 340 CONTINUE - 350 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.380) THEN - IF(ISUB.EQ.361) THEN -C...f + fbar -> W_L W_L, W_L pi_tc, pi_tc pi_tc - FACA=(SH**2*BE34**2-(TH-UH)**2) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/12D0)*AEM**2*CAB2*COMFAC*FACA*3D0 - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DARHO=-(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH - DZRHO=-(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH - DAA=-(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH - DZZ=-(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH - DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH - - DO 360 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 360 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.25D0*(VI+AI) - VARI=0.25D0*(VI-AI) - F2L=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ - $ VALI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) - F2R=EI*(DARHO/FAR+DAA+CT2W*DAZ)+ - $ VARI*(CT2W*DZRHO/FZR+CT2W*DZZ+DAZ)/SQRT(XW*XW1) - HI=ABS(F2L)**2+ABS(F2R)**2 - IF(IA.LE.10) HI=HI/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(KFA.EQ.KFB) THEN - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),1) - ELSE - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) - ENDIF - 360 CONTINUE - - ELSEIF(ISUB.EQ.364) THEN -C...f + fbar -> gamma pi_tc, gamma pi_tc', Z pi_tc, Z pi_tc', -C...W pi_tc - VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) - AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3) - FANOM=SQRT(PARU(1)*AEM)*ITCM(1)/PARU(2)**2/RTCM(1) - - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/24D0)*AEM**2*COMFAC*3D0*SH - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - SFAR=FAR**2 - SFAO=FAO**2 - SFZR=FZR**2 - SFZO=FZO**2 - CALL PYWIDT(23,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(23,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+113),1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - SSMO=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+223),1)**2/SH,WDTP(0)/SHR) - DETD=(FAR*FZO-FAO*FZR)**2+SSMZ*SSMR*SSMO-SFZR*SSMO- - $ SFZO*SSMR-SFAR*SSMO*SSMZ-SFAO*SSMR*SSMZ - DARHO=(-FAR*SFZO+FAO*FZO*FZR+FAR*SSMO*SSMZ)/DETD/SH - DZRHO=(-FZR*SFAO+FAO*FZO*FAR+FZR*SSMO)/DETD/SH - DAOME=(-FAO*SFZR+FAR*FZO*FZR+FAO*SSMR*SSMZ)/DETD/SH - DZOME=(-FZO*SFAR+FAR*FAO*FZR+FZO*SSMR)/DETD/SH - DAA=(SFZO*SSMR+SFZR*SSMO-SSMO*SSMR*SSMZ)/DETD/SH - DZZ=(SFAO*SSMR+SFAR*SSMO-SSMO*SSMR)/DETD/SH - DAZ=(FAR*FZR*SSMO+FAO*FZO*SSMR)/DETD/SH - - DO 370 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 370 - IA=IABS(I) - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.25D0*(VI+AI) - VARI=0.25D0*(VI-AI) -C...........Add in anomaly contribution - F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*VRGP - F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*VOGP - F2L=F2L+FANOM*(VAGP*(EI*DAA+VALI*DAZ/SQRT(XW*XW1))+ - $ VZGP*(EI*DAZ+VALI*DZZ/SQRT(XW*XW1))) - F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*VRGP - F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*VOGP - F2R=F2R+FANOM*(VAGP*(EI*DAA+VARI*DAZ/SQRT(XW*XW1))+ - $ VZGP*(EI*DAZ+VARI*DZZ/SQRT(XW*XW1))) - HI=(ABS(F2L)**2+ABS(F2R)**2)*VFAC - F2L=(EI*DARHO+VALI*DZRHO/SQRT(XW*XW1))*ARGP - F2L=F2L+(EI*DAOME+VALI*DZOME/SQRT(XW*XW1))*AOGP - F2R=(EI*DARHO+VARI*DZRHO/SQRT(XW*XW1))*ARGP - F2R=F2R+(EI*DAOME+VARI*DZOME/SQRT(XW*XW1))*AOGP - HJ=(ABS(F2L)**2+ABS(F2R)**2)*AFAC - HI=HI+HJ - IF(IA.LE.10) HI=HI/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(ISUBSV.NE.368) THEN - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),2) - ELSE - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),2)*WIDS(PYCOMP(KFB),3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=HI*HP*WIDS(PYCOMP(KFA),3)*WIDS(PYCOMP(KFB),2) - ENDIF - 370 CONTINUE - - ELSEIF(ISUB.EQ.370) THEN -C...f + fbar' -> W_L Z_L, W_L pi_tc, Z_L pi_tc, pi_tc pi_tc - - FACA=(SH**2*BE34**2-(TH-UH)**2) - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/96D0)*AEM**2*CAB2*COMFAC*FACA*3D0/XW**2 - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - DWW=SSMR/DETD/SH - DWRHO=-1D0/DETD/SH - HP=HP*ABS(DWW+DWRHO)**2 - DO 390 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 390 - IA=IABS(I) - DO 380 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 380 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 380 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 380 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* - & WIDS(PYCOMP(KFB),2) - 380 CONTINUE - 390 CONTINUE - - ELSEIF(ISUB.EQ.374) THEN -C...f + fbar' -> gamma pi_tc - FANOM=SQRT(AEM)*ITCM(1)/2D0/PARU(2)/RTCM(1) - VFAC=(TH**2+UH**2-2D0*SQM3*SQM4) - AFAC=(TH**2+UH**2-2D0*SQM3*SQM4+4D0*SH*SQM3)/SQTA*ARGP**2 - ALPRHT=2.91D0*(3D0/ITCM(1)) - HP=(1D0/48D0)*AEM**2/XW*COMFAC*3D0*SH - FWR=SQRT(AEM/ALPRHT)/(2D0*SQRT(XW)) - CALL PYWIDT(24,SH,WDTP,WDTE) - SSMZ=DCMPLX(1D0-PMAS(24,1)**2/SH,WDTP(0)/SHR) - CALL PYWIDT(KTECHN+213,SH,WDTP,WDTE) - SSMR=DCMPLX(1D0-PMAS(PYCOMP(KTECHN+213),1)**2/SH,WDTP(0)/SHR) - DETD=SSMZ*SSMR-DCMPLX(FWR**2,0D0) - DWW=SSMR/DETD/SH - DWRHO=-DCMPLX(FWR,0D0)/DETD/SH - HP=HP*(AFAC*ABS(DWRHO)**2+ - $ VFAC*ABS(FANOM*DWW*VWGP+DWRHO*VRGP/SQRT(SQTV))**2) - DO 410 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410 - IA=IABS(I) - DO 400 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 400 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 400 - KCHR=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=HI*WIDS(PYCOMP(KFA),(5-KCHR)/2)* - & WIDS(PYCOMP(KFB),2) - 400 CONTINUE - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.390) THEN - IF(ISUB.EQ.381) THEN -C...f + f' -> f + f' (g exchange) - FACQQ1=COMFAC*AS**2*4D0/9D0*(SH2+UH2)*SQDQQT - FACQQB=COMFAC*AS**2*4D0/9D0*((SH2+UH2)*SQDQQT*FACA- - & MSTP(34)*2D0/3D0*UH2*REDQST) - FACQQ2=COMFAC*AS**2*4D0/9D0*(SH2+TH2)*SQDQQU - FACQQI=-COMFAC*AS**2*4D0/9D0*MSTP(34)*2D0/3D0*SH2/(TH*UH) - RATQQI=(FACQQ1+FACQQ2+FACQQI)/(FACQQ1+FACQQ2) - IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN -C...Modifications from contact interactions (compositeness) - FACCI1=FACQQ1+COMFAC*(SH2/RTCM(41)**4) - FACCIB=FACQQB+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* - & (UH2/TH+UH2/SH)+COMFAC*(5D0/3D0)*(UH2/RTCM(41)**4) - FACCI2=FACQQ2+COMFAC*(8D0/9D0)*(AS*RTCM(42)/RTCM(41)**2)* - & (SH2/TH+SH2/UH)+COMFAC*(5D0/3D0)*(SH2/RTCM(41)**4) - FACCI3=FACQQ1+COMFAC*(UH2/RTCM(41)**4) - RATCII=(FACCI1+FACCI2+FACQQI)/(FACCI1+FACCI2) - ELSEIF(ITCM(5).EQ.5) THEN - FACCI1=FACQQ1 - FACCIB=FACQQB - FACCI2=FACQQ2 - FACCI3=FACQQ1 -CSM.......Check this change from -CSM RATCII=1D0 - RATCII=RATQQI - ENDIF - DO 430 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.MSTP(58).OR.KFAC(1,I).EQ.0) GOTO 430 - DO 420 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.MSTP(58).OR.KFAC(2,J).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.(IA.GE.3.OR. - & JA.GE.3))) THEN - SIGH(NCHN)=FACQQ1 - IF(I.EQ.-J) SIGH(NCHN)=FACQQB - ELSE - SIGH(NCHN)=FACCI1 - IF(I*J.LT.0) SIGH(NCHN)=FACCI3 - IF(I.EQ.-J) SIGH(NCHN)=FACCIB - ENDIF - IF(I.EQ.J) THEN - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=2 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IA.GE.3)) THEN - SIGH(NCHN-1)=0.5D0*FACQQ1*RATQQI - SIGH(NCHN)=0.5D0*FACQQ2*RATQQI - ELSE - SIGH(NCHN-1)=0.5D0*FACCI1*RATCII - SIGH(NCHN)=0.5D0*FACCI2*RATCII - ENDIF - ENDIF - 420 CONTINUE - 430 CONTINUE - - ELSEIF(ISUB.EQ.382) THEN -C...f + fbar -> f' + fbar' (q + qbar -> q' + qbar' only) - CALL PYWIDT(21,SH,WDTP,WDTE) - FACQQF=COMFAC*AS**2*4D0/9D0*(TH2+UH2) - FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - IF(ITCM(5).EQ.1) THEN -C...Modifications from contact interactions (compositeness) - FACCIB=FACQQB - DO 440 I=1,2 - FACCIB=FACCIB+COMFAC*(UH2/RTCM(41)**4)*(WDTE(I,1)+ - & WDTE(I,2)+WDTE(I,4)) - 440 CONTINUE - ELSEIF(ITCM(5).GE.2.AND.ITCM(5).LE.4) THEN - FACCIB=FACQQB+COMFAC*(UH2/RTCM(41)**4)* - & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) - ELSEIF(ITCM(5).EQ.5) THEN - FACQQB=FACQQF*SQDQQS*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)- - & WDTE(5,1)-WDTE(5,2)-WDTE(5,4)) - FACCIB=FACQQF*SQDQTS*(WDTE(5,1)+WDTE(5,2)+WDTE(5,4)) - ENDIF - DO 450 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 450 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - IF(ITCM(5).LE.0.OR.(ITCM(5).EQ.1.AND.IABS(I).GE.3)) THEN - SIGH(NCHN)=FACQQB - ELSEIF(ITCM(5).EQ.5) THEN - SIGH(NCHN)=FACQQB - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACCIB - ELSE - SIGH(NCHN)=FACCIB - ENDIF - 450 CONTINUE - - ELSEIF(ISUB.EQ.383) THEN -C...f + fbar -> g + g (q + qbar -> g + g only) - FACGG1=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) - FACGG2=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS) - IF(ITCM(5).EQ.5) THEN - FACGG3=COMFAC*AS**2*32D0/27D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) - FACGG4=COMFAC*AS**2*32D0/27D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDHGS) - ENDIF - DO 460 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 460 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - IF(ITCM(5).EQ.5.AND.IABS(I).EQ.5) SIGH(NCHN)=0.5D0*FACGG4 - 460 CONTINUE - - ELSEIF(ISUB.EQ.384) THEN -C...f + g -> f + g (q + g -> q + g only) - FACQG1=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*UH2/TH2- - & UH/SH-9D0/4D0*SH*UH/TH2*SQDLGT)*FACA - FACQG2=COMFAC*AS**2*4D0/9D0*((2D0+MSTP(34)*1D0/4D0)*SH2/TH2- - & SH/UH-9D0/4D0*SH*UH/TH2*SQDLGT) - DO 480 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.10) GOTO 480 - DO 470 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 470 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 470 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQG1 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQG2 - 470 CONTINUE - 480 CONTINUE - - ELSEIF(ISUB.EQ.385) THEN -C...g + g -> f + fbar (g + g -> q + qbar only) - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500 - IDC0=MDCY(21,2)-1 -C...Begin by d, u, s flavours. - FLAVWT=0D0 - IF(MDME(IDC0+1,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(1,1)**2/SH)) - IF(MDME(IDC0+2,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(2,1)**2/SH)) - IF(MDME(IDC0+3,1).GE.1) FLAVWT=FLAVWT+ - & SQRT(MAX(0D0,1D0-4D0*PMAS(3,1)**2/SH)) - FACQQ1=COMFAC*AS**2*1D0/6D0*(UH/TH-(2D0+MSTP(34)*1D0/4D0)* - & UH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA - FACQQ2=COMFAC*AS**2*1D0/6D0*(TH/UH-(2D0+MSTP(34)*1D0/4D0)* - & TH2/SH2+9D0/4D0*TH*UH/SH2*SQDLGS)*FLAVWT*FACA - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 -C...Next c and b flavours: modified that and uhat for fixed -C...cos(theta-hat). - DO 490 IFL=4,5 - SQMAVG=PMAS(IFL,1)**2 - IF(MDME(IDC0+IFL,1).GE.1.AND.SH.GT.4.04D0*SQMAVG) THEN - BE34=SQRT(1D0-4D0*SQMAVG/SH) - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - IF(ITCM(5).GE.5) THEN - IF(IFL.EQ.4) THEN - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - ELSE - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - ENDIF - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1*BE34 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2*BE34 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1+2*(IFL-3) - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2+2*(IFL-3) - SIGH(NCHN)=FACQQ2 - ENDIF - 490 CONTINUE - 500 CONTINUE - - ELSEIF(ISUB.EQ.386) THEN -C...g + g -> g + g - IF(ITCM(5).LE.4) THEN - FACGG1=COMFAC*AS**2*9D0/4D0*(SH2/TH2+2D0*SH/TH+3D0+ - & 2D0*TH/SH+TH2/SH2)*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*(UH2/SH2+2D0*UH/SH+3D0+ - & 2D0*SH/UH+SH2/UH2)*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*(TH2/UH2+2D0*TH/UH+3D0+ - & 2D0*UH/TH+UH2/TH2) - ELSE - GST= (12D0 + 40D0*TH/SH + 56D0*TH2/SH2 + 32D0*TH**3/SH**3 + - & 16D0*TH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*TH + 16D0*TH2)+ - & 4D0*REDGST*(SH + 2D0*TH)* - & (2D0*SH**3 - 3D0*SH2*TH - 2D0*SH*TH2 + 2D0*TH**3)/SH2 + - & 2D0*REDGGS*(2D0*SH - 12D0*TH2/SH - 8D0*TH**3/SH2) + - & 2D0*REDGGT*(4D0*SH - 22D0*TH - 68D0*TH2/SH - 60D0*TH**3/SH2- - & 32D0*TH**4/SH**3 - 16D0*TH**5/SH**4) + - & SQDGGT*(16D0*SH2 + 16D0*SH*TH + 68D0*TH2 + 144D0*TH**3/SH + - & 96D0*TH**4/SH2 + 32D0*TH**5/SH**3 + 16D0*TH**6/SH**4))/16D0 - GSU= (12D0 + 40D0*UH/SH + 56D0*UH2/SH2 + 32D0*UH**3/SH**3 + - & 16D0*UH**4/SH**4 + SQDGGS*(4D0*SH2 + 16D0*SH*UH + 16D0*UH2)+ - & 4D0*REDGSU*(SH + 2D0*UH)* - & (2D0*SH**3 - 3D0*SH2*UH - 2D0*SH*UH2 + 2D0*UH**3)/SH2 + - & 2D0*REDGGS*(2D0*SH - 12D0*UH2/SH - 8D0*UH**3/SH2) + - & 2D0*REDGGU*(4D0*SH - 22D0*UH - 68D0*UH2/SH - 60D0*UH**3/SH2- - & 32D0*UH**4/SH**3 - 16D0*UH**5/SH**4) + - & SQDGGU*(16D0*SH2 + 16D0*SH*UH + 68D0*UH2 + 144D0*UH**3/SH + - & 96D0*UH**4/SH2 + 32D0*UH**5/SH**3 + 16D0*UH**6/SH**4))/16D0 - GUT= (12D0 - 16D0*TH*(TH - UH)**2*UH/SH**4 + - & 4D0*REDGGU*(2D0*TH**5 - 15D0*TH**4*UH - 48D0*TH**3*UH2 - - & 58D0*TH2*UH**3 - 10D0*TH*UH**4 + UH**5)/SH**4 + - & 4D0*REDGGT*(TH**5 - 10D0*TH**4*UH - 58D0*TH**3*UH2 - - & 48D0*TH2*UH**3 - 15D0*TH*UH**4 + 2D0*UH**5)/SH**4 + - & 4D0*SQDGGU*(4D0*TH**6 + 20D0*TH**5*UH + 57D0*TH**4*UH2 + - & 72D0*TH**3*UH**3+ 38D0*TH2*UH**4+4D0*TH*UH**5 +UH**6)/SH**4+ - & 4D0*SQDGGT*(4D0*UH**6 + 4D0*TH**5*UH + 38D0*TH**4*UH2 + - & 72D0*TH**3*UH**3 +57D0*TH2*UH**4+20D0*TH*UH**5+TH**6)/SH**4+ - & 2D0*REDGTU*((TH - UH)**2* (TH**4 + 20D0*TH**3*UH + - & 30D0*TH2*UH2 + 20D0*TH*UH**3 + UH**4) + - & SH2*(7D0*TH**4 + 52D0*TH**3*UH + 274D0*TH2*UH2 + - & 52D0*TH*UH**3 + 7D0*UH**4))/(2D0*SH**4))/16D0 - FACGG1=COMFAC*AS**2*9D0/4D0*GST*FACA - FACGG2=COMFAC*AS**2*9D0/4D0*GSU*FACA - FACGG3=COMFAC*AS**2*9D0/4D0*GUT - ENDIF - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACGG1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=0.5D0*FACGG2 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=3 - SIGH(NCHN)=0.5D0*FACGG3 - 510 CONTINUE - - ELSEIF(ISUB.EQ.387) THEN -C...q + qbar -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - FACQQB=COMFAC*AS**2*4D0/9D0*((THQ**2+UHQ**2)/SH2+ - & 2D0*SQMAVG/SH) - IF(ITCM(5).GE.5) THEN - IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN - FACQQB=FACQQB*SH2*SQDQTS - ELSE - FACQQB=FACQQB*SH2*SQDQQS - ENDIF - ENDIF - IF(MSTP(35).GE.1) FACQQB=FACQQB*PYHFTH(SH,SQMAVG,0D0) - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQB=FACQQB*WID2 - DO 520 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 520 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQB - 520 CONTINUE - - ELSEIF(ISUB.EQ.388) THEN -C...g + g -> Q + Qbar - SQMAVG=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - THQ=-0.5D0*SH*(1D0-BE34*CTH) - UHQ=-0.5D0*SH*(1D0+BE34*CTH) - THUHQ=THQ*UHQ-SQMAVG*SH - IF(MSTP(34).EQ.0) THEN - FACQQ1=UHQ/THQ-2D0*UHQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/THQ**2 - FACQQ2=THQ/UHQ-2D0*THQ**2/SH2+4D0*(SQMAVG/SH)*THUHQ/UHQ**2 - ELSE - FACQQ1=UHQ/THQ-2.25D0*UHQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & THQ**2+0.5D0*SQMAVG*(THQ+SQMAVG)/THQ**2-SQMAVG**2/(SH*THQ) - FACQQ2=THQ/UHQ-2.25D0*THQ**2/SH2+4.5D0*(SQMAVG/SH)*THUHQ/ - & UHQ**2+0.5D0*SQMAVG*(UHQ+SQMAVG)/UHQ**2-SQMAVG**2/(SH*UHQ) - ENDIF - IF(ITCM(5).GE.5) THEN - IF(MINT(55).EQ.5.OR.MINT(55).EQ.6) THEN - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDHGS+ - & 2.25D0*THQ*UHQ/SH2*SQDHGS - ELSE - FACQQ1=FACQQ1+2.25D0*SQMAVG*(THQ-UHQ)/(SH*THQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - FACQQ2=FACQQ2+2.25D0*SQMAVG*(UHQ-THQ)/(SH*UHQ)*REDLGS+ - & 2.25D0*THQ*UHQ/SH2*SQDLGS - ENDIF - ENDIF - FACQQ1=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ1 - FACQQ2=COMFAC*FACA*AS**2*(1D0/6D0)*FACQQ2 - IF(MSTP(35).GE.1) THEN - FATRE=PYHFTH(SH,SQMAVG,2D0/7D0) - FACQQ1=FACQQ1*FATRE - FACQQ2=FACQQ2*FATRE - ENDIF - WID2=1D0 - IF(MINT(55).EQ.6) WID2=WIDS(6,1) - IF(MINT(55).EQ.7.OR.MINT(55).EQ.8) WID2=WIDS(MINT(55),1) - FACQQ1=FACQQ1*WID2 - FACQQ2=FACQQ2*WID2 - IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 530 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACQQ1 - NCHN=NCHN+1 - ISIG(NCHN,1)=21 - ISIG(NCHN,2)=21 - ISIG(NCHN,3)=2 - SIGH(NCHN)=FACQQ2 - 530 CONTINUE - ENDIF - ENDIF - -CMRENNA-- - - RETURN - END - -C********************************************************************* - -C...PYSGWZ -C...Subprocess cross sections for W/Z processes, -C...except that longitudinal WW scattering is in Higgs sector. -C...Auxiliary to PYSIGH. - - SUBROUTINE PYSGWZ(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/,/PYINT4/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex numbers - DIMENSION WDTP(0:400),WDTE(0:400,0:5),HGZ(6,3),HL3(3),HR3(3), - &HL4(3),HR4(3) - COMPLEX*16 COULCK,COULCP,COULCD,COULCR,COULCS - -C...Differential cross section expressions. - - IF(ISUB.LE.20) THEN - IF(ISUB.EQ.1) THEN -C...f + fbar -> gamma*/Z0 - MINT(61)=2 - CALL PYWIDT(23,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACZ=4D0*COMFAC*3D0 - HP0=AEM/3D0*SH - HP1=AEM/3D0*XWC*SH - DO 100 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 100 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - HI0=HP0 - IF(IABS(I).LE.10) HI0=HI0*FACA/3D0 - HI1=HP1 - IF(IABS(I).LE.10) HI1=HI1*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZ*(EI**2/SH2*HI0*HP0*VINT(111)+ - & EI*VI*(1D0-SQMZ/SH)/((SH-SQMZ)**2+HS**2)* - & (HI0*HP1+HI1*HP0)*VINT(112)+(VI**2+AI**2)/ - & ((SH-SQMZ)**2+HS**2)*HI1*HP1*VINT(114)) - 100 CONTINUE - - ELSEIF(ISUB.EQ.2) THEN -C...f + fbar' -> W+/- - CALL PYWIDT(24,SH,WDTP,WDTE) - HS=SHR*WDTP(0) - FACBW=4D0*COMFAC/((SH-SQMW)**2+HS**2)*3D0 - HP=AEM/(24D0*XW)*SH - DO 120 I=MMIN1,MMAX1 - IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 120 - IA=IABS(I) - DO 110 J=MMIN2,MMAX2 - IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 110 - JA=IABS(J) - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 110 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 110 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - HI=HP*2D0 - IF(IA.LE.10) HI=HI*VCKM((IA+1)/2,(JA+1)/2)*FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - HF=SHR*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) - SIGH(NCHN)=HI*FACBW*HF - 110 CONTINUE - 120 CONTINUE - - ELSEIF(ISUB.EQ.15) THEN -C...f + fbar -> g + (gamma*/Z0) (q + qbar -> g + (gamma*/Z0) only) - FACZG=COMFAC*AS*AEM*(8D0/9D0)*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 130 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 130 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 130 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 140 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58).OR. - & KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 140 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZG*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - 140 CONTINUE - - ELSEIF(ISUB.EQ.16) THEN -C...f + fbar' -> g + W+/- (q + qbar' -> g + W+/- only) - FACWG=COMFAC*AS*AEM/XW*2D0/9D0*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACWG=FACWG*HBW4C/HBW4 - DO 160 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.10.OR.KFAC(1,I).EQ.0) GOTO 160 - DO 150 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.10.OR.KFAC(2,J).EQ.0) GOTO 150 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 150 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - FCKM=VCKM((IA+1)/2,(JA+1)/2) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWG*FCKM*WIDSC - 150 CONTINUE - 160 CONTINUE - - ELSEIF(ISUB.EQ.19) THEN -C...f + fbar -> gamma + (gamma*/Z0) - FACGZ=COMFAC*2D0*AEM**2*(TH2+UH2+2D0*SQM4*SH)/(TH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 170 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 170 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 170 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 180 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGZ*FCOI*EI**2*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - 180 CONTINUE - - ELSEIF(ISUB.EQ.20) THEN -C...f + fbar' -> gamma + W+/- - FACGW=COMFAC*0.5D0*AEM**2/XW -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACGW=FACGW*HBW4C/HBW4 -C...Anomalous couplings - TERM1=(TH2+UH2+2D0*SQM4*SH)/(TH*UH) - TERM2=0D0 - TERM3=0D0 - IF(ITCM(5).GE.1.AND.ITCM(5).LE.4) THEN - TERM2=RTCM(46)*(TH-UH)/(TH+UH) - TERM3=0.5D0*RTCM(46)**2*(TH*UH+(TH2+UH2)*SH/ - & (4D0*SQMW))/(TH+UH)**2 - ENDIF - DO 200 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 200 - DO 190 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 190 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 190 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 190 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - IF(IA.LE.10) THEN - FACWR=UH/(TH+UH)-1D0/3D0 - FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=FACA/3D0 - ELSE - FACWR=-TH/(TH+UH) - FCKM=1D0 - FCOI=1D0 - ENDIF - FACWK=TERM1*FACWR**2+TERM2*FACWR+TERM3 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACGW*FACWK*FCOI*FCKM*WIDSC - 190 CONTINUE - 200 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.40) THEN - IF(ISUB.EQ.22) THEN -C...f + fbar -> (gamma*/Z0) + (gamma*/Z0) -C...Kinematics dependence - FACZZ=COMFAC*AEM**2*((TH2+UH2+2D0*(SQM3+SQM4)*SH)/(TH*UH)- - & SQM3*SQM4*(1D0/TH2+1D0/UH2)) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - DO 220 I=1,6 - DO 210 J=1,3 - HGZ(I,J)=0D0 - 210 CONTINUE - 220 CONTINUE - RADC3=1D0+PYALPS(SQM3)/PARU(1) - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 230 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 230 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2) IMDM=1 - IF(MDME(IDC,1).EQ.4.OR.MDME(IDC,1).EQ.5) IMDM=MDME(IDC,1)-2 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM3 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC3 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.GE.1) THEN - HGZ(1,IMDM)=HGZ(1,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HGZ(2,IMDM)=HGZ(2,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HGZ(3,IMDM)=HGZ(3,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.GE.1) THEN - HGZ(4,IMDM)=HGZ(4,IMDM)+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HGZ(5,IMDM)=HGZ(5,IMDM)+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HGZ(6,IMDM)=HGZ(6,IMDM)+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 230 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW3=(1D0/PARU(1))*GMMZ/((SQM3-SQMZ)**2+GMMZ**2) - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM3,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - DO 240 J=1,3 - HGZ(1,J)=HGZ(1,J)*HFAEM*VINT(111)/SQM3 - HGZ(2,J)=HGZ(2,J)*HFAEM*VINT(112)/SQM3 - HGZ(3,J)=HGZ(3,J)*HFAEM*VINT(114)/SQM3 - 240 CONTINUE - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - DO 250 J=1,3 - HGZ(4,J)=HGZ(4,J)*HFAEM*VINT(111)/SQM4 - HGZ(5,J)=HGZ(5,J)*HFAEM*VINT(112)/SQM4 - HGZ(6,J)=HGZ(6,J)*HFAEM*VINT(114)/SQM4 - 250 CONTINUE -C...Loop over flavours; separate left- and right-handed couplings - DO 270 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - VALI=VI-AI - VARI=VI+AI - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - DO 260 J=1,3 - HL3(J)=EI**2*HGZ(1,J)+EI*VALI*HGZ(2,J)+VALI**2*HGZ(3,J) - HR3(J)=EI**2*HGZ(1,J)+EI*VARI*HGZ(2,J)+VARI**2*HGZ(3,J) - HL4(J)=EI**2*HGZ(4,J)+EI*VALI*HGZ(5,J)+VALI**2*HGZ(6,J) - HR4(J)=EI**2*HGZ(4,J)+EI*VARI*HGZ(5,J)+VARI**2*HGZ(6,J) - 260 CONTINUE - FACLR=HL3(1)*HL4(1)+HL3(1)*(HL4(2)+HL4(3))+ - & HL4(1)*(HL3(2)+HL3(3))+HL3(2)*HL4(3)+HL4(2)*HL3(3)+ - & HR3(1)*HR4(1)+HR3(1)*(HR4(2)+HR4(3))+ - & HR4(1)*(HR3(2)+HR3(3))+HR3(2)*HR4(3)+HR4(2)*HR3(3) - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=0.5D0*FACZZ*FCOI*FACLR/(HBW3*HBW4) - 270 CONTINUE - - ELSEIF(ISUB.EQ.23) THEN -C...f + fbar' -> Z0 + W+/- (Z0 only, i.e. no gamma* admixture.) - FACZW=COMFAC*0.5D0*(AEM/XW)**2 - FACZW=FACZW*WIDS(23,2) - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - FACBW=1D0/((SH-SQMW)**2+GMMW**2) - DO 290 I=MMIN1,MMAX1 - IA=IABS(I) - IF(I.EQ.0.OR.IA.GT.20.OR.KFAC(1,I).EQ.0) GOTO 290 - DO 280 J=MMIN2,MMAX2 - JA=IABS(J) - IF(J.EQ.0.OR.JA.GT.20.OR.KFAC(2,J).EQ.0) GOTO 280 - IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 280 - IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) - & GOTO 280 - KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - EJ=KCHG(JA,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - IF(VI+AI.GT.0) THEN - VISAV=VI - AISAV=AI - VI=VJ - AI=AJ - VJ=VISAV - AJ=AISAV - ENDIF - FCKM=1D0 - IF(IA.LE.10) FCKM=VCKM((IA+1)/2,(JA+1)/2) - FCOI=1D0 - IF(IA.LE.10) FCOI=FACA/3D0 - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=J - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*FCOI*FCKM*(FACBW*((9D0-8D0*XW)/4D0*THUH+ - & (8D0*XW-6D0)/4D0*SH*(SQM3+SQM4))+(THUH-SH*(SQM3+SQM4))* - & (SH-SQMW)*FACBW*0.5D0*((VJ+AJ)/TH-(VI+AI)/UH)+ - & THUH/(16D0*XW1)*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+ - & SH*(SQM3+SQM4)/(8D0*XW1)*(VI+AI)*(VJ+AJ)/(TH*UH))* - & WIDS(24,(5-KCHW)/2) -C***Protect against slightly negative cross sections. (Reason yet to be -C***sorted out. One possibility: addition of width to the W propagator.) - SIGH(NCHN)=MAX(0D0,SIGH(NCHN)) - 280 CONTINUE - 290 CONTINUE - - ELSEIF(ISUB.EQ.25) THEN -C...f + fbar -> W+ + W- -C...Propagators: Z0, W+- as simulated in PYOFSH and as desired - GMMZC=GMMZ - HBWZC=SH**2/((SH-SQMZ)**2+GMMZC**2) - HBW3=GMMW/((SQM3-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM3,WDTP,WDTE) - GMMW3=SQRT(SQM3)*WDTP(0) - HBW3C=GMMW3/((SQM3-SQMW)**2+GMMW3**2) - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMW4=SQRT(SQM4)*WDTP(0) - HBW4C=GMMW4/((SQM4-SQMW)**2+GMMW4**2) -C...Kinematical functions - THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) - THUH34=(2D0*SH*(SQM3+SQM4)+THUH)/(SQM3*SQM4) - GS=(((SH-SQM3-SQM4)**2-4D0*SQM3*SQM4)*THUH34+12D0*THUH)/SH2 - GT=THUH34+4D0*THUH/TH2 - GST=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/TH)/SH - GU=THUH34+4D0*THUH/UH2 - GSU=((SH-SQM3-SQM4)*THUH34+4D0*(SH*(SQM3+SQM4)-THUH)/UH)/SH -C...Common factors and couplings - FACWW=COMFAC*(HBW3C/HBW3)*(HBW4C/HBW4) - FACWW=FACWW*WIDS(24,1) - CGG=AEM**2/2D0 - CGZ=AEM**2/(4D0*XW)*HBWZC*(1D0-SQMZ/SH) - CZZ=AEM**2/(32D0*XW**2)*HBWZC - CNG=AEM**2/(4D0*XW) - CNZ=AEM**2/(16D0*XW**2)*HBWZC*(1D0-SQMZ/SH) - CNN=AEM**2/(16D0*XW**2) -C...Coulomb factor for W+W- pair - IF(MSTP(40).GE.1.AND.MSTP(40).LE.3) THEN - COULE=(SH-4D0*SQMW)/(4D0*PMAS(24,1)) - COULP=MAX(1D-10,0.5D0*BE34*SQRT(SH)) - IF(COULE.LT.100D0*PMAS(24,2)) THEN - COULP1=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ - & PMAS(24,2)**2)-COULE)) - ELSE - COULP1=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/COULE)) - ENDIF - IF(COULE.GT.-100D0*PMAS(24,2)) THEN - COULP2=SQRT(0.5D0*PMAS(24,1)*(SQRT(COULE**2+ - & PMAS(24,2)**2)+COULE)) - ELSE - COULP2=SQRT(0.5D0*PMAS(24,1)*(0.5D0*PMAS(24,2)**2/ - & ABS(COULE))) - ENDIF - IF(MSTP(40).EQ.1) THEN - COULDC=PARU(1)-2D0*ATAN((COULP1**2+COULP2**2-COULP**2)/ - & MAX(1D-10,2D0*COULP*COULP1)) - FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) - ELSEIF(MSTP(40).EQ.2) THEN - COULCK=DCMPLX(DBLE(COULP1),DBLE(COULP2)) - COULCP=DCMPLX(0D0,DBLE(COULP)) - COULCD=(COULCK+COULCP)/(COULCK-COULCP) - COULCR=1D0+DBLE(PARU(101)*SQRT(SH))/ - & (4D0*COULCP)*LOG(COULCD) - COULCS=DCMPLX(0D0,0D0) - NSTP=100 - DO 300 ISTP=1,NSTP - COULXX=(ISTP-0.5)/NSTP - COULCS=COULCS+(1D0/COULXX)*LOG((1D0+COULXX*COULCD)/ - & (1D0+COULXX/COULCD)) - 300 CONTINUE - COULCR=COULCR+DBLE(PARU(101)**2*SH)/(16D0*COULCP*COULCK)* - & (COULCS/NSTP) - FACCOU=ABS(COULCR)**2 - ELSEIF(MSTP(40).EQ.3) THEN - COULDC=PARU(1)-2D0*(1D0-BE34)**2*ATAN((COULP1**2+ - & COULP2**2-COULP**2)/MAX(1D-10,2D0*COULP*COULP1)) - FACCOU=1D0+0.5D0*PARU(101)*COULDC/MAX(1D-5,BE34) - ENDIF - ELSEIF(MSTP(40).EQ.4) THEN - FACCOU=1D0+0.5D0*PARU(101)*PARU(1)/MAX(1D-5,BE34) - ELSE - FACCOU=1D0 - ENDIF - VINT(95)=FACCOU - FACWW=FACWW*FACCOU -C...Loop over allowed flavours - DO 310 I=MMINA,MMAXA - IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - FCOI=1D0 - IF(IABS(I).LE.10) FCOI=FACA/3D0 - IF(MSTP(50).LE.0.OR.IABS(I).LE.10) THEN - IF(AI.LT.0D0) THEN - DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS+ - & (CNG*EI+CNZ*(VI+AI))*GST+CNN*GT - ELSE - DSIGWW=(CGG*EI**2+CGZ*VI*EI+CZZ*(VI**2+AI**2))*GS- - & (CNG*EI+CNZ*(VI+AI))*GSU+CNN*GU - ENDIF - ELSE - XMW02=0.5D0*(SQM3+SQM4)-0.25D0*(SQM3-SQM4)**2/SH - BET=SQRT(1D0-4D0*XMW02/SH) - GAT=1D0/SQRT(1D0-BET**2) - STHE2=1D0-CTH**2 - AMPZG=BET**3*(16D0+(4D0*BET**2*GAT**2+3D0/GAT**2)*STHE2) - AMPNU=BET*(2D0+BET**2*GAT**2*STHE2/2D0+ - & 2D0*BET**2*(1D0-BET**2)*STHE2/(1D0-2D0*BET*CTH+BET**2)**2) - AMPNG=BET*((1D0+BET**2)*(4D0+BET**2*GAT**2*STHE2)+ - & 2D0*(1D0-BET**2)*(BET**2*STHE2-2D0*(1D0-BET**2))/ - & (1D0-2D0*BET*CTH+BET**2)) - PROPI1=(0.25D0*SQMZ/XMW02)*HBWZC*(1D0-SQMZ/SH) - PROPI2=(0.25D0*SQMZ/XMW02)**2*HBWZC - A0=(2D0*(XMW02/SQMZ)-(1D0-BET**2)*XW)*POLL - A1=(2D0*(XMW02/SQMZ)**2-2*XMW02/SQMZ*(1D0-BET**2)*XW)*POLL - A2=(1D0-BET**2)**2*XW**2*(POLR+POLL)/2D0 - ATOT=AMPNU*POLL+(A1+A2)*PROPI2*AMPZG-A0*PROPI1*AMPNG - ATOT=ATOT*CNN/SQMW*SH/BET*2D0 - DSIGWW=ATOT - ENDIF - NCHN=NCHN+1 - ISIG(NCHN,1)=I - ISIG(NCHN,2)=-I - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW*FCOI*DSIGWW - 310 CONTINUE - - ELSEIF(ISUB.EQ.30) THEN -C...f + g -> f + (gamma*/Z0) (q + g -> q + (gamma*/Z0) only) - FZQ=COMFAC*FACA*AS*AEM*(1D0/3D0)*(SH2+UH2+2D0*SQM4*TH)/ - & (-SH*UH) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 320 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 320 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 320 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 340 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 340 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FACZQ=FZQ*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - DO 330 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 330 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 330 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ - 330 CONTINUE - 340 CONTINUE - - ELSEIF(ISUB.EQ.31) THEN -C...f + g -> f' + W+/- (q + g -> q' + W+/- only) - FACWQ=COMFAC*FACA*AS*AEM/XW*1D0/12D0* - & (SH2+UH2+2D0*SQM4*TH)/(-SH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FACWQ=FACWQ*HBW4C/HBW4 - DO 360 I=MMINA,MMAXA - IF(I.EQ.0.OR.IABS(I).GT.MSTP(58)) GOTO 360 - IA=IABS(I) - KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - DO 350 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 350 - IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 350 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=21 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC - 350 CONTINUE - 360 CONTINUE - - ELSEIF(ISUB.EQ.35) THEN -C...f + gamma -> f + (gamma*/Z0) - IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) THEN - FZQN=SH2+UH2+2D0*(SQM4-VINT(3)**2)*TH - FZQDTM=VINT(3)**2*SQM4-SH*(UH-VINT(4)**2) - ELSEIF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) THEN - FZQN=SH2+UH2+2D0*(SQM4-VINT(4)**2)*TH - FZQDTM=VINT(4)**2*SQM4-SH*(UH-VINT(3)**2) - ELSE - FZQN=SH2+UH2+2D0*SQM4*TH - FZQDTM=-SH*UH - ENDIF - FZQN=COMFAC*2D0*AEM**2*MAX(0D0,FZQN) -C...gamma, gamma/Z interference and Z couplings to final fermion pairs - HFGG=0D0 - HFGZ=0D0 - HFZZ=0D0 - RADC4=1D0+PYALPS(SQM4)/PARU(1) - DO 370 I=1,MIN(16,MDCY(23,3)) - IDC=I+MDCY(23,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 370 - IMDM=0 - IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.2.OR.MDME(IDC,1).EQ.4) - & IMDM=1 - IF(I.LE.8) THEN - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ELSEIF(I.LE.16) THEN - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - ENDIF - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SQM4 - IF(4D0*RM1.LT.1D0) THEN - FCOF=1D0 - IF(I.LE.8) FCOF=3D0*RADC4 - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IMDM.EQ.1) THEN - HFGG=HFGG+FCOF*EF**2*(1D0+2D0*RM1)*BE34 - HFGZ=HFGZ+FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - HFZZ=HFZZ+FCOF*(VF**2*(1D0+2D0*RM1)+ - & AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - ENDIF - 370 CONTINUE -C...Propagators: as simulated in PYOFSH and as desired - HBW4=(1D0/PARU(1))*GMMZ/((SQM4-SQMZ)**2+GMMZ**2) - MINT15=MINT(15) - MINT(15)=1 - MINT(61)=1 - CALL PYWIDT(23,SQM4,WDTP,WDTE) - MINT(15)=MINT15 - HFAEM=(PARU(108)/PARU(2))*(2D0/3D0) - HFGG=HFGG*HFAEM*VINT(111)/SQM4 - HFGZ=HFGZ*HFAEM*VINT(112)/SQM4 - HFZZ=HFZZ*HFAEM*VINT(114)/SQM4 -C...Loop over flavours; consider full gamma/Z structure - DO 390 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 390 - EI=KCHG(IABS(I),1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - FACZQ=EI**2*(EI**2*HFGG+EI*VI*HFGZ+ - & (VI**2+AI**2)*HFZZ)/HBW4 - FZQD=MAX(PMAS(IABS(I),1)**2*SQM4,FZQDTM) - DO 380 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 380 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 380 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZQ*FZQN/FZQD - 380 CONTINUE - 390 CONTINUE - - ELSEIF(ISUB.EQ.36) THEN -C...f + gamma -> f' + W+/- - FWQ=COMFAC*AEM**2/(2D0*XW)* - & (SH2+UH2+2D0*SQM4*TH)/(SQPTH*SQM4-SH*UH) -C...Propagators: as simulated in PYOFSH and as desired - HBW4=GMMW/((SQM4-SQMW)**2+GMMW**2) - CALL PYWIDT(24,SQM4,WDTP,WDTE) - GMMWC=SQRT(SQM4)*WDTP(0) - HBW4C=GMMWC/((SQM4-SQMW)**2+GMMWC**2) - FWQ=FWQ*HBW4C/HBW4 - DO 410 I=MMINA,MMAXA - IF(I.EQ.0) GOTO 410 - IA=IABS(I) - EIA=ABS(KCHG(IABS(I),1)/3D0) - FACWQ=FWQ*(EIA-SH/(SH+UH))**2 - KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) - WIDSC=(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))/WDTP(0) - DO 400 ISDE=1,2 - IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,22).EQ.0) GOTO 400 - IF(ISDE.EQ.2.AND.KFAC(1,22)*KFAC(2,I).EQ.0) GOTO 400 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=I - ISIG(NCHN,3-ISDE)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWQ*VINT(180+I)*WIDSC - 400 CONTINUE - 410 CONTINUE - ENDIF - - ELSEIF(ISUB.LE.100) THEN - IF(ISUB.EQ.69) THEN -C...gamma + gamma -> W+ + W- - SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) - FPROP=SH2/((SQMWE-TH)*(SQMWE-UH)) - FACWW=COMFAC*6D0*AEM**2*(1D0-FPROP*(4D0/3D0+2D0*SQMWE/SH)+ - & FPROP**2*(2D0/3D0+2D0*(SQMWE/SH)**2))*WIDS(24,1) - IF(KFAC(1,22)*KFAC(2,22).EQ.0) GOTO 420 - NCHN=NCHN+1 - ISIG(NCHN,1)=22 - ISIG(NCHN,2)=22 - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACWW - 420 CONTINUE - - ELSEIF(ISUB.EQ.70) THEN -C...gamma + W+/- -> Z0 + W+/- - SQMWE=MAX(0.5D0*SQMW,SQRT(SQM3*SQM4)) - FPROP=(TH-SQMWE)**2/(-SH*(SQMWE-UH)) - FACZW=COMFAC*6D0*AEM**2*(XW1/XW)* - & (1D0-FPROP*(4D0/3D0+2D0*SQMWE/(TH-SQMWE))+ - & FPROP**2*(2D0/3D0+2D0*(SQMWE/(TH-SQMWE))**2))*WIDS(23,2) - DO 440 KCHW=1,-1,-2 - DO 430 ISDE=1,2 - IF(KFAC(ISDE,22)*KFAC(3-ISDE,24*KCHW).EQ.0) GOTO 430 - NCHN=NCHN+1 - ISIG(NCHN,ISDE)=22 - ISIG(NCHN,3-ISDE)=24*KCHW - ISIG(NCHN,3)=1 - SIGH(NCHN)=FACZW*WIDS(24,(5-KCHW)/2) - 430 CONTINUE - 440 CONTINUE - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSHOW -C...Generates timelike parton showers from given partons. - - SUBROUTINE PYSHOW(IP1,IP2,QMAX) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION PMTH(5,140),PS(5),PMA(100),PMSD(100),IEP(100),IPA(100), - &KFLA(100),KFLD(100),KFL(100),ITRY(100),ISI(100),ISL(100),DP(100), - &DPT(5,4),KSH(0:140),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2), - &PHIIIS(2,2),ISII(2),ISSET(2),ISCOL(0:140),ISCHG(0:140), - &IREF(1000) - -C...Check that QMAX not too low. - IF(MSTJ(41).LE.0) THEN - RETURN - ELSEIF(MSTJ(41).EQ.1) THEN - IF(QMAX.LE.PARJ(82).AND.IP2.GT.-8) RETURN - ELSE - IF(QMAX.LE.MIN(PARJ(82),PARJ(83),PARJ(90)).AND.IP2.GT.-8) - & RETURN - ENDIF - -C...Initialization of cutoff masses etc. - DO 100 IFL=0,40 - ISCOL(IFL)=0 - ISCHG(IFL)=0 - KSH(IFL)=0 - 100 CONTINUE - ISCOL(21)=1 - KSH(21)=1 - PMTH(1,21)=PYMASS(21) - PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25D0*PARJ(82)**2) - PMTH(3,21)=2D0*PMTH(2,21) - PMTH(4,21)=PMTH(3,21) - PMTH(5,21)=PMTH(3,21) - PMTH(1,22)=PYMASS(22) - PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25D0*PARJ(83)**2) - PMTH(3,22)=2D0*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)) - PMQT1E=MIN(PMQTH1,PARJ(90)) - PMQTH2=PMTH(2,21) - IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) - PMQT2E=MIN(PMQTH2,0.5D0*PARJ(90)) - DO 110 IFL=1,5 - ISCOL(IFL)=1 - IF(MSTJ(41).GE.2) ISCHG(IFL)=1 - KSH(IFL)=1 - PMTH(1,IFL)=PYMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PMQTH1**2) - PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 - PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) - 110 CONTINUE - DO 120 IFL=11,15,2 - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IFL)=1 - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) KSH(IFL)=1 - PMTH(1,IFL)=PYMASS(IFL) - PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25D0*PARJ(90)**2) - PMTH(3,IFL)=PMTH(2,IFL)+0.5D0*PARJ(90) - PMTH(4,IFL)=PMTH(3,IFL) - PMTH(5,IFL)=PMTH(3,IFL) - 120 CONTINUE - PT2MIN=MAX(0.5D0*PARJ(82),1.1D0*PARJ(81))**2 - ALAMS=PARJ(81)**2 - ALFM=LOG(PT2MIN/ALAMS) - -C...Store positions of shower initiating partons. - MPSPD=0 - IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN - NPA=1 - IPA(1)=IP1 - ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- - & MSTU(32))) THEN - NPA=2 - IPA(1)=IP1 - IPA(2)=IP2 - ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0 - & .AND.IP2.GE.-80) THEN - NPA=IABS(IP2) - DO 130 I=1,NPA - IPA(I)=IP1+I-1 - 130 CONTINUE - ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND. - &IP2.EQ.-100) THEN - MPSPD=1 - NPA=2 - IPA(1)=IP1+6 - IPA(2)=IP1+7 - ELSE - CALL PYERRM(12, - & '(PYSHOW:) 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)=0D0 - 140 CONTINUE - PM=0D0 - KFLA(2)=0 - DO 160 I=1,NPA - KFLA(I)=IABS(K(IPA(I),2)) - PMA(I)=P(IPA(I),5) -C...Special cutoff masses for initial partons (may be a heavy quark, -C...squark, ..., and need not be on the mass shell). - IR=30+I - IF(NPA.LE.1) IREF(I)=IR - IF(NPA.GE.2) IREF(I+1)=IR - ISCOL(IR)=0 - ISCHG(IR)=0 - KSH(IR)=0 - IF(KFLA(I).LE.8) THEN - ISCOL(IR)=1 - IF(MSTJ(41).GE.2) ISCHG(IR)=1 - ELSEIF(KFLA(I).EQ.11.OR.KFLA(I).EQ.13.OR.KFLA(I).EQ.15.OR. - & KFLA(I).EQ.17) THEN - IF(MSTJ(41).EQ.2.OR.MSTJ(41).GE.4) ISCHG(IR)=1 - ELSEIF(KFLA(I).EQ.21) THEN - ISCOL(IR)=1 - ELSEIF((KFLA(I).GE.KSUSY1+1.AND.KFLA(I).LE.KSUSY1+8).OR. - & (KFLA(I).GE.KSUSY2+1.AND.KFLA(I).LE.KSUSY2+8)) THEN - ISCOL(IR)=1 - ELSEIF(KFLA(I).EQ.KSUSY1+21) THEN - ISCOL(IR)=1 - ENDIF - IF(ISCOL(IR).EQ.1.OR.ISCHG(IR).EQ.1) KSH(IR)=1 - PMTH(1,IR)=PMA(I) - IF(ISCOL(IR).EQ.1.AND.ISCHG(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PMQTH1**2) - PMTH(3,IR)=PMTH(2,IR)+PMQTH2 - PMTH(4,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2)+PMTH(2,21) - PMTH(5,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(83)**2)+PMTH(2,22) - ELSEIF(ISCOL(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(82)**2) - PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(82) - PMTH(4,IR)=PMTH(3,IR) - PMTH(5,IR)=PMTH(3,IR) - ELSEIF(ISCHG(IR).EQ.1) THEN - PMTH(2,IR)=SQRT(PMTH(1,IR)**2+0.25D0*PARJ(90)**2) - PMTH(3,IR)=PMTH(2,IR)+0.5D0*PARJ(90) - PMTH(4,IR)=PMTH(3,IR) - PMTH(5,IR)=PMTH(3,IR) - ENDIF - IF(KSH(IR).EQ.1) PMA(I)=PMTH(3,IR) - PM=PM+PMA(I) - IF(KSH(IR).EQ.0.OR.PMA(I).GT.10D0*QMAX) IREJ=IREJ+1 - DO 150 J=1,4 - PS(J)=PS(J)+P(IPA(I),J) - 150 CONTINUE - 160 CONTINUE - IF(IREJ.EQ.NPA.AND.IP2.GE.-7) RETURN - PS(5)=SQRT(MAX(0D0,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+PMQT1E) RETURN - -C...Identify source: q(1), ~q(2), V(3), S(4), chi(5), ~g(6), unknown(0). - KFSRCE=0 - IF(IP2.LE.0) THEN - ELSEIF(K(IP1,3).EQ.K(IP2,3).AND.K(IP1,3).GT.0) THEN - KFSRCE=IABS(K(K(IP1,3),2)) - ELSE - IPAR1=MAX(1,K(IP1,3)) - IPAR2=MAX(1,K(IP2,3)) - IF(K(IPAR1,3).EQ.K(IPAR2,3).AND.K(IPAR1,3).GT.0) - & KFSRCE=IABS(K(K(IPAR1,3),2)) - ENDIF - ITYPES=0 - IF(KFSRCE.GE.1.AND.KFSRCE.LE.8) ITYPES=1 - IF(KFSRCE.GE.KSUSY1+1.AND.KFSRCE.LE.KSUSY1+8) ITYPES=2 - IF(KFSRCE.GE.KSUSY2+1.AND.KFSRCE.LE.KSUSY2+8) ITYPES=2 - IF(KFSRCE.GE.21.AND.KFSRCE.LE.24) ITYPES=3 - IF(KFSRCE.GE.32.AND.KFSRCE.LE.34) ITYPES=3 - IF(KFSRCE.EQ.25.OR.(KFSRCE.GE.35.AND.KFSRCE.LE.37)) ITYPES=4 - IF(KFSRCE.GE.KSUSY1+22.AND.KFSRCE.LE.KSUSY1+37) ITYPES=5 - IF(KFSRCE.EQ.KSUSY1+21) ITYPES=6 - -C...Identify two primary showerers. - ITYPE1=0 - IF(KFLA(1).GE.1.AND.KFLA(1).LE.8) ITYPE1=1 - IF(KFLA(1).GE.KSUSY1+1.AND.KFLA(1).LE.KSUSY1+8) ITYPE1=2 - IF(KFLA(1).GE.KSUSY2+1.AND.KFLA(1).LE.KSUSY2+8) ITYPE1=2 - IF(KFLA(1).GE.21.AND.KFLA(1).LE.24) ITYPE1=3 - IF(KFLA(1).GE.32.AND.KFLA(1).LE.34) ITYPE1=3 - IF(KFLA(1).EQ.25.OR.(KFLA(1).GE.35.AND.KFLA(1).LE.37)) ITYPE1=4 - IF(KFLA(1).GE.KSUSY1+22.AND.KFLA(1).LE.KSUSY1+37) ITYPE1=5 - IF(KFLA(1).EQ.KSUSY1+21) ITYPE1=6 - ITYPE2=0 - IF(KFLA(2).GE.1.AND.KFLA(2).LE.8) ITYPE2=1 - IF(KFLA(2).GE.KSUSY1+1.AND.KFLA(2).LE.KSUSY1+8) ITYPE2=2 - IF(KFLA(2).GE.KSUSY2+1.AND.KFLA(2).LE.KSUSY2+8) ITYPE2=2 - IF(KFLA(2).GE.21.AND.KFLA(2).LE.24) ITYPE2=3 - IF(KFLA(2).GE.32.AND.KFLA(2).LE.34) ITYPE2=3 - IF(KFLA(2).EQ.25.OR.(KFLA(2).GE.35.AND.KFLA(2).LE.37)) ITYPE2=4 - IF(KFLA(2).GE.KSUSY1+22.AND.KFLA(2).LE.KSUSY1+37) ITYPE2=5 - IF(KFLA(2).EQ.KSUSY1+21) ITYPE2=6 - -C...Order of showerers. Presence of gluino. - ITYPMN=MIN(ITYPE1,ITYPE2) - ITYPMX=MAX(ITYPE1,ITYPE2) - IORD=1 - IF(ITYPE1.GT.ITYPE2) IORD=2 - IGLUI=0 - IF(ITYPE1.EQ.6.OR.ITYPE2.EQ.6) IGLUI=1 - -C...Check if 3-jet matrix elements to be used. - M3JC=0 - ALPHA=0.5D0 - IF(NPA.EQ.2.AND.MSTJ(47).GE.1.AND.MPSPD.EQ.0) THEN - IF(MSTJ(38).NE.0) THEN - M3JC=MSTJ(38) - ALPHA=PARJ(80) - MSTJ(38)=0 - ELSEIF(MSTJ(47).GE.6) THEN - M3JC=MSTJ(47) - ELSE - ICLASS=1 - ICOMBI=4 - -C...Vector/axial vector -> q + qbar; q -> q + V. - IF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.3)) THEN - ICLASS=2 - IF(KFSRCE.EQ.21.OR.KFSRCE.EQ.22) THEN - ICOMBI=1 - ELSEIF(KFSRCE.EQ.23.OR.(KFSRCE.EQ.0.AND. - & K(IP1,2)+K(IP2,2).EQ.0)) THEN -C...gamma*/Z0: assume e+e- initial state if unknown. - EI=-1D0 - IF(KFSRCE.EQ.23) THEN - IANNFL=K(K(IP1,3),3) - IF(IANNFL.NE.0) THEN - KANNFL=IABS(K(IANNFL,2)) - IF(KANNFL.GE.1.AND.KANNFL.LE.18) EI=KCHG(KANNFL,1)/3D0 - ENDIF - ENDIF - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*PARU(102) - EF=KCHG(KFLA(1),1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*PARU(102) - XWC=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SH=PS(5)**2 - SQMZ=PMAS(23,1)**2 - SQWZ=PS(5)*PMAS(23,2) - SBWZ=1D0/((SH-SQMZ)**2+SQWZ**2) - VECT=EI**2*EF**2+2D0*EI*VI*EF*VF*XWC*SH*(SH-SQMZ)*SBWZ+ - & (VI**2+AI**2)*VF**2*XWC**2*SH**2*SBWZ - AXIV=(VI**2+AI**2)*AF**2*XWC**2*SH**2*SBWZ - ICOMBI=3 - ALPHA=VECT/(VECT+AXIV) - ELSEIF(KFSRCE.EQ.24.OR.KFSRCE.EQ.0) THEN - ICOMBI=4 - ENDIF -C...For chi -> chi q qbar, use V/A -> q qbar as first approximation. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.5) THEN - ICLASS=2 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=3 - -C...Scalar/pseudoscalar -> q + qbar; q -> q + S. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.1.AND.ITYPES.EQ.4) THEN - ICLASS=4 - IF(KFSRCE.EQ.25.OR.KFSRCE.EQ.35.OR.KFSRCE.EQ.37) THEN - ICOMBI=1 - ELSEIF(KFSRCE.EQ.36) THEN - ICOMBI=2 - ENDIF - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=5 - -C...V -> ~q + ~qbar; ~q -> ~q + V; S -> ~q + ~qbar; ~q -> ~q + S. - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.3)) THEN - ICLASS=6 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.3.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=7 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.4) THEN - ICLASS=8 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.4.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=9 - -C...chi -> q + ~qbar; ~q -> q + chi; q -> ~q + chi. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.5)) THEN - ICLASS=10 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=11 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.5.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=12 - -C...~g -> q + ~qbar; ~q -> q + ~g; q -> ~q + ~g. - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.2.AND.ITYPES.EQ.6) THEN - ICLASS=13 - ELSEIF(ITYPMN.EQ.1.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.2)) THEN - ICLASS=14 - ELSEIF(ITYPMN.EQ.2.AND.ITYPMX.EQ.6.AND.(ITYPES.EQ.0.OR. - & ITYPES.EQ.1)) THEN - ICLASS=15 - -C...g -> ~g + ~g (eikonal approximation). - ELSEIF(ITYPMN.EQ.6.AND.ITYPMX.EQ.6.AND.ITYPES.EQ.0) THEN - ICLASS=16 - ENDIF - M3JC=5*ICLASS+ICOMBI - 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.AND.KFSRCE.EQ.0 - &.AND.MPSPD.EQ.0) MIIS=MSTJ(50) - IF(MSTJ(50).GE.4.AND.MSTJ(50).LE.6.AND.NPA.EQ.2.AND.MPSPD.EQ.0) - &MIIS=MSTJ(50)-3 - IF(MIIS.NE.0) THEN - DO 180 I=1,2 - KCII(I)=0 - KCA=PYCOMP(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)=0D0 - 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)=0D0 - 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)=0D0 - 230 CONTINUE - 240 CONTINUE - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,0D0,-PS(1)/PS(4), - & -PS(2)/PS(4),-PS(3)/PS(4)) - PHI=PYANGL(P(N+1,1),P(N+1,2)) - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(N+1,3),P(N+1,1)) - CALL PYROBO(N+1,N+2+NIIS(1)+NIIS(2),-THE,0D0,0D0,0D0,0D0) - DO 250 I=3,2+NIIS(1) - THEIIS(1,I-2)=PYANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(1,I-2)=PYANGL(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)-PYANGL(P(N+I,3), - & SQRT(P(N+I,1)**2+P(N+I,2)**2)) - PHIIIS(2,I-2-NIIS(1))=PYANGL(P(N+I,1),P(N+I,2)) - 260 CONTINUE - ENDIF - -C...Boost 3 or more partons to their rest frame. - IF(NPA.GE.3) CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,-PS(1)/PS(4), - &-PS(2)/PS(4),-PS(3)/PS(4)) - -C...Define imagined single initiator of shower for parton system. - NS=N - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - 270 N=NS - 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)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=0D0 - P(N+1,4)=PS(5) - P(N+1,5)=PS(5) - V(N+1,5)=PS(5)**2 - N=N+1 - IREF(1)=21 - ENDIF - -C...Loop over partons that may branch. - NEP=NPA - IM=NS - IF(NPA.EQ.1) IM=NS-1 - 280 IM=IM+1 - IF(N.GT.NS) THEN - IF(IM.GT.N) GOTO 590 - KFLM=IABS(K(IM,2)) - IR=IREF(IM-NS) - IF(KSH(IR).EQ.0) GOTO 280 - IF(P(IM,5).LT.PMTH(2,IR)) GOTO 280 - IGM=K(IM,3) - ELSE - IGM=-1 - ENDIF - IF(N+NEP.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - 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 290 I=1,NEP - K(N+I,3)=IM - 290 CONTINUE - ELSE - K(N+1,3)=IPA(1) - ENDIF - IF(IGM.LE.0) THEN - DO 300 I=1,NEP - K(N+I,2)=K(IPA(I),2) - 300 CONTINUE - ELSEIF(KFLM.NE.21) THEN - K(N+1,2)=K(IM,2) - K(N+2,2)=K(IM,5) - IREF(N+1-NS)=IREF(IM-NS) - IREF(N+2-NS)=IABS(K(N+2,2)) - ELSEIF(K(IM,5).EQ.21) THEN - K(N+1,2)=21 - K(N+2,2)=21 - IREF(N+1-NS)=21 - IREF(N+2-NS)=21 - ELSE - K(N+1,2)=K(IM,5) - K(N+2,2)=-K(IM,5) - IREF(N+1-NS)=IABS(K(N+1,2)) - IREF(N+2-NS)=IABS(K(N+2,2)) - ENDIF - -C...Reset flags on daughters and tries made. - DO 310 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(PYCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 - ITRY(IP)=0 - ISL(IP)=0 - ISI(IP)=0 - IF(KSH(IREF(N+IP-NS)).EQ.1) ISI(IP)=1 - 310 CONTINUE - ISLM=0 - -C...Maximum virtuality of daughters. - IF(IGM.LE.0) THEN - DO 320 I=1,NPA - IF(NPA.GE.3) P(N+I,4)=P(IPA(I),4) - P(N+I,5)=MIN(QMAX,PS(5)) - IR=IREF(N+I-NS) - IF(IP2.LE.-8) P(N+I,5)=MAX(P(N+I,5),2D0*PMTH(3,IR)) - IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) - 320 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),(1D0-V(IM,1))*PEM) - IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) - ENDIF - DO 330 I=1,NEP - PMSD(I)=P(N+I,5) - IF(ISI(I).EQ.1) THEN - IR=IREF(N+I-NS) - IF(P(N+I,5).LE.PMTH(3,IR)) P(N+I,5)=PMTH(1,IR) - ENDIF - V(N+I,5)=P(N+I,5)**2 - 330 CONTINUE - -C...Choose one of the daughters for evolution. - 340 INUM=0 - IF(NEP.EQ.1) INUM=1 - DO 350 I=1,NEP - IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I - 350 CONTINUE - DO 360 I=1,NEP - IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN - IR=IREF(N+I-NS) - IF(P(N+I,5).GE.PMTH(2,IR)) INUM=I - ENDIF - 360 CONTINUE - IF(INUM.EQ.0) THEN - RMAX=0D0 - DO 370 I=1,NEP - IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQT2E) THEN - RPM=P(N+I,5)/PMSD(I) - IR=IREF(N+I-NS) - IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IR)) THEN - RMAX=RPM - INUM=I - ENDIF - ENDIF - 370 CONTINUE - ENDIF - -C...Cancel choice of predetermined daughter already treated. - INUM=MAX(1,INUM) - INUMT=INUM - IF(MPSPD.EQ.1.AND.IGM.EQ.0.AND.ITRY(INUMT).GE.1) THEN - IF(K(IP1-1+INUM,4).GT.0) INUM=3-INUM - ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2.AND.ITRY(INUMT).GE.1) THEN - IF(KFLD(INUMT).NE.21.AND.K(IP1+2,4).GT.0) INUM=3-INUM - IF(KFLD(INUMT).EQ.21.AND.K(IP1+3,4).GT.0) INUM=3-INUM - ENDIF - -C...Store information on choice of evolving daughter. - IEP(1)=N+INUM - DO 380 I=2,NEP - IEP(I)=IEP(I-1)+1 - IF(IEP(I).GT.N+NEP) IEP(I)=N+1 - 380 CONTINUE - DO 390 I=1,NEP - KFL(I)=IABS(K(IEP(I),2)) - 390 CONTINUE - ITRY(INUM)=ITRY(INUM)+1 - IF(ITRY(INUM).GT.200) THEN - CALL PYERRM(14,'(PYSHOW:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - Z=0.5D0 - IR=IREF(IEP(1)-NS) - IF(KSH(IR).EQ.0) GOTO 440 - IF(P(IEP(1),5).LT.PMTH(2,IR)) GOTO 440 - -C...Check if evolution already predetermined for daughter. - IPSPD=0 - IF(MPSPD.EQ.1.AND.IGM.EQ.0) THEN - IF(K(IP1-1+INUM,4).GT.0) IPSPD=IP1-1+INUM - ELSEIF(MPSPD.EQ.1.AND.IM.EQ.NS+2) THEN - IF(KFL(1).NE.21.AND.K(IP1+2,4).GT.0) IPSPD=IP1+2 - IF(KFL(1).EQ.21.AND.K(IP1+3,4).GT.0) IPSPD=IP1+3 - ENDIF - IF(INUM.EQ.1.OR.INUM.EQ.2) THEN - ISSET(INUM)=0 - IF(IPSPD.NE.0) ISSET(INUM)=1 - ENDIF - -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(PYR(0).GT.0.5D0) ISII(III)=1 - ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN - ISII(III)=1 - IF(PYR(0).GT.0.5D0) 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=(1D0-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - ZC=PMTH(2,21)/PMED - ZCE=PMTH(2,22)/PMED - IF(ISCOL(IR).EQ.0) ZCE=0.5D0*PARJ(90)/PMED - ELSE - ZC=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTH(2,21)/PMED)**2))) - IF(ZC.LT.1D-6) ZC=(PMTH(2,21)/PMED)**2 - PMTMPE=PMTH(2,22) - IF(ISCOL(IR).EQ.0) PMTMPE=0.5D0*PARJ(90) - ZCE=0.5D0*(1D0-SQRT(MAX(0D0,1D0-(2D0*PMTMPE/PMED)**2))) - IF(ZCE.LT.1D-6) ZCE=(PMTMPE/PMED)**2 - ENDIF - ZC=MIN(ZC,0.491D0) - ZCE=MIN(ZCE,0.49991D0) - IF(((MSTJ(41).EQ.1.AND.ZC.GT.0.49D0).OR.(MSTJ(41).GE.2.AND. - &MIN(ZC,ZCE).GT.0.4999D0)).AND.IPSPD.EQ.0) THEN - P(IEP(1),5)=PMTH(1,IR) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 440 - ENDIF - -C...Integral of Altarelli-Parisi z kernel for QCD. -C...(Includes squark and gluino; with factor N_C/C_F extra for latter). - IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN - FBR=6D0*LOG((1D0-ZC)/ZC)+MSTJ(45)*0.5D0 - ELSEIF(MSTJ(49).EQ.0) THEN - FBR=(8D0/3D0)*LOG((1D0-ZC)/ZC) - IF(IGLUI.EQ.1.AND.IR.GE.31) FBR=FBR*(9D0/4D0) - -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))*(1D0-2D0*ZC) - ELSEIF(MSTJ(49).EQ.1) THEN - FBR=(1D0-2D0*ZC)/3D0 - IF(IGM.EQ.0.AND.M3JC.GE.1) FBR=4D0*FBR - -C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. - ELSEIF(KFL(1).EQ.21) THEN - FBR=6D0*MSTJ(45)*(0.5D0-ZC) - ELSE - FBR=2D0*LOG((1D0-ZC)/ZC) - ENDIF - -C...Reset QCD probability for colourless. - IF(ISCOL(IR).EQ.0) FBR=0D0 - -C...Integral of Altarelli-Parisi kernel for photon emission. - FBRE=0D0 - IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1) THEN - IF(KFL(1).LE.18) THEN - FBRE=(KCHG(KFL(1),1)/3D0)**2*2D0*LOG((1D0-ZCE)/ZCE) - ENDIF - IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE - ENDIF - -C...Inner veto algorithm starts. Find maximum mass for evolution. - 400 PMS=V(IEP(1),5) - IF(IGM.GE.0) THEN - PM2=0D0 - DO 410 I=2,NEP - PM=P(IEP(I),5) - IRI=IREF(IEP(I)-NS) - IF(KSH(IRI).EQ.1) PM=PMTH(2,IRI) - PM2=PM2+PM - 410 CONTINUE - PMS=MIN(PMS,(P(IM,5)-PM2)**2) - ENDIF - -C...Select mass for daughter in QCD evolution. - B0=27D0/6D0 - DO 420 IFF=4,MSTJ(45) - IF(PMS.GT.4D0*PMTH(2,IFF)**2) B0=(33D0-2D0*IFF)/6D0 - 420 CONTINUE -C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. - PMSC=MAX(0.5D0*PARJ(82),PMS-PMTH(1,IR)**2) -C...Already predetermined choice. - IF(IPSPD.NE.0) THEN - PMSQCD=P(IPSPD,5)**2 - ELSEIF(FBR.LT.1D-3) THEN - PMSQCD=0D0 - ELSEIF(MSTJ(44).LE.0) THEN - PMSQCD=PMSC*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/(PARU(111)*FBR))) - ELSEIF(MSTJ(44).EQ.1) THEN - PMSQCD=4D0*ALAMS*(0.25D0*PMSC/ALAMS)**(PYR(0)**(B0/FBR)) - ELSE - PMSQCD=PMSC*EXP(MAX(-50D0,ALFM*B0*LOG(PYR(0))/FBR)) - ENDIF -C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. - IF(IPSPD.EQ.0) PMSQCD=PMSQCD+PMTH(1,IR)**2 - IF(ZC.GT.0.49D0.OR.PMSQCD.LE.PMTH(4,IR)**2) PMSQCD=PMTH(2,IR)**2 - V(IEP(1),5)=PMSQCD - MCE=1 - -C...Select mass for daughter in QED evolution. - IF(MSTJ(41).GE.2.AND.ISCHG(IR).EQ.1.AND.IPSPD.EQ.0) THEN -C...Shift m^2 for evolution in Q^2 = m^2 - m(onshell)^2. - PMSE=MAX(0.5D0*PARJ(83),PMS-PMTH(1,IR)**2) - IF(FBRE.LT.1D-3) THEN - PMSQED=0D0 - ELSE - PMSQED=PMSE*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ - & (PARU(101)*FBRE))) - ENDIF -C...Shift back m^2 from evolution in Q^2 = m^2 - m(onshell)^2. - PMSQED=PMSQED+PMTH(1,IR)**2 - IF(ZCE.GT.0.4999D0.OR.PMSQED.LE.PMTH(5,IR)**2) PMSQED= - & PMTH(2,IR)**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,IR)) THEN - P(IEP(1),5)=PMTH(1,IR) - V(IEP(1),5)=P(IEP(1),5)**2 - GOTO 440 - ENDIF - -C...Already predetermined choice of z, and flavour in g -> qqbar. - IF(IPSPD.NE.0) THEN - IPSGD1=K(IPSPD,4) - IPSGD2=K(IPSPD,5) - PMSGD1=P(IPSGD1,5)**2 - PMSGD2=P(IPSGD2,5)**2 - ALAMPS=SQRT(MAX(1D-10,(PMSQCD-PMSGD1-PMSGD2)**2- - & 4D0*PMSGD1*PMSGD2)) - Z=0.5D0*(PMSQCD*(2D0*P(IPSGD1,4)/P(IPSPD,4)-1D0)+ALAMPS- - & PMSGD1+PMSGD2)/ALAMPS - Z=MAX(0.00001D0,MIN(0.99999D0,Z)) - IF(KFL(1).NE.21) THEN - K(IEP(1),5)=21 - ELSE - K(IEP(1),5)=IABS(K(IPSGD1,2)) - ENDIF - -C...Select z value of branching: q -> qgamma. - ELSEIF(MCE.EQ.2) THEN - Z=1D0-(1D0-ZCE)*(ZCE/(1D0-ZCE))**PYR(0) - IF(1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 - 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=1D0-(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) -C...Only do z weighting when no ME correction afterwards. - IF(M3JC.EQ.0.AND.1D0+Z**2.LT.2D0*PYR(0)) GOTO 400 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*0.5D0.LT.PYR(0)*FBR) THEN - Z=(1D0-ZC)*(ZC/(1D0-ZC))**PYR(0) - IF(PYR(0).GT.0.5D0) Z=1D0-Z - IF((1D0-Z*(1D0-Z))**2.LT.PYR(0)) GOTO 400 - K(IEP(1),5)=21 - ELSEIF(MSTJ(49).NE.1) THEN - Z=PYR(0) - IF(Z**2+(1D0-Z)**2.LT.PYR(0)) GOTO 400 - KFLB=1+INT(MSTJ(45)*PYR(0)) - PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1D0) GOTO 400 - IF(MSTJ(44).LE.2.OR.MSTJ(44).EQ.4) THEN - IF(Z.LT.ZC.OR.Z.GT.1D0-ZC) GOTO 400 - PMQ0=4D0*PMTH(2,21)**2/V(IEP(1),5) - IF(MOD(MSTJ(43),2).EQ.0.AND.(1D0+0.5D0*PMQ)*SQRT(1D0-PMQ) - & .LT.PYR(0)*(1D0+0.5D0*PMQ0)*SQRT(1D0-PMQ0)) GOTO 400 - ELSE - IF((1D0+0.5D0*PMQ)*SQRT(1D0-PMQ).LT.PYR(0)) GOTO 400 - ENDIF - K(IEP(1),5)=KFLB - -C...Ditto for scalar gluon model. - ELSEIF(KFL(1).NE.21) THEN - Z=1D0-SQRT(ZC**2+PYR(0)*(1D0-2D0*ZC)) - K(IEP(1),5)=21 - ELSEIF(PYR(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN - Z=ZC+(1D0-2D0*ZC)*PYR(0) - K(IEP(1),5)=21 - ELSE - Z=ZC+(1D0-2D0*ZC)*PYR(0) - KFLB=1+INT(MSTJ(45)*PYR(0)) - PMQ=4D0*PMTH(2,KFLB)**2/V(IEP(1),5) - IF(PMQ.GE.1D0) GOTO 400 - K(IEP(1),5)=KFLB - ENDIF - -C...Correct to alpha_s(pT^2) (optionally m^2/4 for g -> q qbar). - IF(MCE.EQ.1.AND.MSTJ(44).GE.2.AND.IPSPD.EQ.0) THEN - IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - IF(ALFM/LOG(V(IEP(1),5)*0.25D0/ALAMS).LT.PYR(0)) GOTO 400 - ELSE - PT2APP=Z*(1D0-Z)*V(IEP(1),5) - IF(MSTJ(44).GE.4) PT2APP=PT2APP* - & (1D0-PMTH(1,IR)**2/V(IEP(1),5))**2 - IF(PT2APP.LT.PT2MIN) GOTO 400 - IF(ALFM/LOG(PT2APP/ALAMS).LT.PYR(0)) GOTO 400 - ENDIF - ENDIF - -C...Check if z consistent with chosen m. - IF(KFL(1).EQ.21) THEN - IRGD1=IABS(K(IEP(1),5)) - IRGD2=IRGD1 - ELSE - IRGD1=IR - IRGD2=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.5D0*(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=(1D0-V(IM,1))*PEM - ENDIF - IF(MOD(MSTJ(43),2).EQ.1) THEN - PMQTH3=0.5D0*PARJ(82) - IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) - IF(IRGD2.EQ.22.AND.ISCOL(IR).EQ.0) PMQTH3=0.5D0*PARJ(90) - PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(IEP(1),5) - PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(IEP(1),5) - ZD=SQRT(MAX(0D0,(1D0-V(IEP(1),5)/PED**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0D0,1D0-V(IEP(1),5)/PED**2)) - ZH=1D0 - ENDIF - IF(KFL(1).EQ.21.AND.K(IEP(1),5).LT.10.AND. - &(MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - ELSEIF(IPSPD.NE.0) THEN - ELSE - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 400 - ENDIF - IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1D0-ZL)/MAX(1D-20,ZL* - &(1D0-ZU))) - IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) - -C...Width suppression for q -> q + g. - IF(MSTJ(40).NE.0.AND.KFL(1).NE.21.AND.IPSPD.EQ.0) THEN - IF(IGM.EQ.0) THEN - EGLU=0.5D0*PS(5)*(1D0-Z)*(1D0+V(IEP(1),5)/V(NS+1,5)) - ELSE - EGLU=PMED*(1D0-Z) - ENDIF - CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2) - IF(MSTJ(40).EQ.1) THEN - IF(CHI.LT.PYR(0)) GOTO 400 - ELSEIF(MSTJ(40).EQ.2) THEN - IF(1D0-CHI.LT.PYR(0)) GOTO 400 - ENDIF - ENDIF - -C...Three-jet matrix element correction. - IF(M3JC.GE.1) THEN - WME=1D0 - WSHOW=1D0 - -C...QED matrix elements: only for massless case so far. - IF(MCE.EQ.2.AND.IGM.EQ.0) THEN - X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) - X2=1D0-V(IEP(1),5)/V(NS+1,5) - X3=(1D0-X1)+(1D0-X2) - KI1=K(IPA(INUM),2) - KI2=K(IPA(3-INUM),2) - QF1=KCHG(PYCOMP(KI1),1)*ISIGN(1,KI1)/3D0 - QF2=KCHG(PYCOMP(KI2),1)*ISIGN(1,KI2)/3D0 - WSHOW=QF1**2*(1D0-X1)/X3*(1D0+(X1/(2D0-X2))**2)+ - & QF2**2*(1D0-X2)/X3*(1D0+(X2/(2D0-X1))**2) - WME=(QF1*(1D0-X1)/X3-QF2*(1D0-X2)/X3)**2*(X1**2+X2**2) - ELSEIF(MCE.EQ.2) THEN - -C...QCD matrix elements, including mass effects. - ELSEIF(MSTJ(49).NE.1.AND.K(IEP(1),2).NE.21) THEN - PS1ME=V(IEP(1),5) - PM1ME=PMTH(1,IR) - M3JCC=M3JC - IF(IR.GE.31.AND.IGM.EQ.0) THEN -C...QCD ME: original parton, first branching. - PM2ME=PMTH(1,63-IR) - ECMME=PS(5) - ELSEIF(IR.GE.31) THEN -C...QCD ME: original parton, subsequent branchings. - PM2ME=PMTH(1,63-IR) - PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - ELSEIF(K(IM,2).EQ.21) THEN -C...QCD ME: secondary partons, first branching. - PM2ME=PM1ME - ZMME=V(IM,1) - IF(IEP(1).GT.IEP(2)) ZMME=1D0-ZMME - PMLME=SQRT(MAX(0D0,(V(IM,5)-PS1ME-PM2ME**2)**2- - & 4D0*PS1ME*PM2ME**2)) - PEDME=PEM*(0.5D0*(V(IM,5)-PMLME+PS1ME-PM2ME**2)+PMLME*ZMME)/ - & V(IM,5) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - M3JCC=66 - ELSE -C...QCD ME: secondary partons, subsequent branchings. - PM2ME=PM1ME - PEDME=PEM*(V(IM,1)+(1D0-V(IM,1))*PS1ME/V(IM,5)) - ECMME=PEDME+SQRT(MAX(0D0,PEDME**2-PS1ME+PM2ME**2)) - M3JCC=66 - ENDIF -C...Construct ME variables. - R1ME=PM1ME/ECMME - R2ME=PM2ME/ECMME - X1=(1D0+PS1ME/ECMME**2-R2ME**2)*(Z+(1D0-Z)*PM1ME**2/PS1ME) - X2=1D0+R2ME**2-PS1ME/ECMME**2 -C...Call ME, with right order important for two inequivalent showerers. - IF(IR.EQ.IORD+30) THEN - WME=PYMAEL(M3JCC,X1,X2,R1ME,R2ME,ALPHA) - ELSE - WME=PYMAEL(M3JCC,X2,X1,R2ME,R1ME,ALPHA) - ENDIF -C...Split up total ME when two radiating partons. - ISPRAD=1 - IF((M3JCC.GE.16.AND.M3JCC.LE.19).OR. - & (M3JCC.GE.26.AND.M3JCC.LE.29).OR. - & (M3JCC.GE.36.AND.M3JCC.LE.39).OR. - & (M3JCC.GE.46.AND.M3JCC.LE.49).OR. - & (M3JCC.GE.56.AND.M3JCC.LE.64)) ISPRAD=0 - IF(ISPRAD.EQ.1) WME=WME*MAX(1D-10,1D0+R1ME**2-R2ME**2-X1)/ - & MAX(1D-10,2D0-X1-X2) -C...Evaluate shower rate to be compared with. - WSHOW=2D0/(MAX(1D-10,2D0-X1-X2)* - & MAX(1D-10,1D0+R2ME**2-R1ME**2-X2)) - IF(IGLUI.EQ.1.AND.IR.GE.31) WSHOW=(9D0/4D0)*WSHOW - ELSEIF(MSTJ(49).NE.1) THEN - -C...Toy model scalar theory matrix elements; no mass effects. - ELSE - X1=Z*(1D0+V(IEP(1),5)/V(NS+1,5)) - X2=1D0-V(IEP(1),5)/V(NS+1,5) - X3=(1D0-X1)+(1D0-X2) - WSHOW=4D0*X3*((1D0-X1)/(2D0-X2)**2+(1D0-X2)/(2D0-X1)**2) - WME=X3**2 - IF(MSTJ(102).GE.2) WME=X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)* - & PARJ(171) - ENDIF - - IF(WME.LT.PYR(0)*WSHOW) GOTO 400 - ENDIF - -C...Impose angular ordering by rejection of nonordered emission. - IF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2.AND.IPSPD.EQ.0) THEN - PEMAO=V(IM,1)*P(IM,4) - IF(IEP(1).EQ.N+2) PEMAO=(1D0-V(IM,1))*P(IM,4) - IF(IR.GE.31.AND.MSTJ(42).GE.5) THEN - MAOD=0 - ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.4 - & .OR.MSTJ(42).EQ.7)) THEN - MAOD=0 - ELSEIF(KFL(1).EQ.21.AND.K(IEP(1),5).LE.10.AND.(MSTJ(42).EQ.3 - & .OR.MSTJ(42).EQ.6)) THEN - MAOD=1 - PMDAO=PMTH(2,K(IEP(1),5)) - THE2ID=Z*(1D0-Z)*PEMAO**2/(V(IEP(1),5)-4D0*PMDAO**2) - ELSE - MAOD=1 - THE2ID=Z*(1D0-Z)*PEMAO**2/V(IEP(1),5) - IF(MSTJ(42).GE.3.AND.MSTJ(42).NE.5) THE2ID=THE2ID* - & (1D0+PMTH(1,IR)**2*(1D0-Z)/(V(IEP(1),5)*Z))**2 - ENDIF - MAOM=1 - IAOM=IM - 430 IF(K(IAOM,5).EQ.22) THEN - IAOM=K(IAOM,3) - IF(K(IAOM,3).LE.NS) MAOM=0 - IF(MAOM.EQ.1) GOTO 430 - ENDIF - IF(MAOM.EQ.1.AND.MAOD.EQ.1) THEN - THE2IM=V(IAOM,1)*(1D0-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) - IF(THE2ID.LT.THE2IM) GOTO 400 - ENDIF - ENDIF - -C...Impose user-defined maximum angle at first branching. - IF(MSTJ(48).EQ.1.AND.IPSPD.EQ.0) THEN - IF(NEP.EQ.1.AND.IM.EQ.NS) THEN - THE2ID=Z*(1D0-Z)*PS(4)**2/V(IEP(1),5) - IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN - THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) - IF(PARJ(85)**2*THE2ID.LT.1D0) GOTO 400 - ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN - THE2ID=Z*(1D0-Z)*(0.5D0*P(IM,4))**2/V(IEP(1),5) - IF(PARJ(86)**2*THE2ID.LT.1D0) GOTO 400 - 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((1D0-Z)/Z,Z/(1D0-Z))*V(IEP(1),5)/(0.5D0*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 400 - ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN - IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 400 - ENDIF - ENDIF - -C...End of inner veto algorithm. Check if only one leg evolved so far. - 440 V(IEP(1),1)=Z - ISL(1)=0 - ISL(2)=0 - IF(NEP.EQ.1) GOTO 480 - IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 340 - DO 450 I=1,NEP - IR=IREF(N+I-NS) - IF(ITRY(I).EQ.0.AND.KSH(IR).EQ.1) THEN - IF(P(N+I,5).GE.PMTH(2,IR)) GOTO 340 - ENDIF - 450 CONTINUE - -C...Check if chosen multiplet m1,m2,z1,z2 is physical. - IF(NEP.GE.3) THEN - PMSUM=0D0 - DO 460 I=1,NEP - PMSUM=PMSUM+P(N+I,5) - 460 CONTINUE - IF(PMSUM.GE.PS(5)) GOTO 340 - ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN - DO 470 I1=N+1,N+2 - IRDA=IREF(I1-NS) - IF(KSH(IRDA).EQ.0) GOTO 470 - IF(P(I1,5).LT.PMTH(2,IRDA)) GOTO 470 - IF(IRDA.EQ.21) THEN - IRGD1=IABS(K(I1,5)) - IRGD2=IRGD1 - ELSE - IRGD1=IRDA - IRGD2=IABS(K(I1,5)) - ENDIF - I2=2*N+3-I1 - IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN - PED=0.5D0*(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=1D0-V(IM,1) - PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- - & 4D0*V(N+1,5)*V(N+2,5)) - PED=PEM*(0.5D0*(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.5D0*PARJ(82) - IF(IRGD2.EQ.22) PMQTH3=0.5D0*PARJ(83) - IF(IRGD2.EQ.22.AND.ISCOL(IRDA).EQ.0) PMQTH3=0.5D0*PARJ(90) - PMQ1=(PMTH(1,IRGD1)**2+PMQTH3**2)/V(I1,5) - PMQ2=(PMTH(1,IRGD2)**2+PMQTH3**2)/V(I1,5) - ZD=SQRT(MAX(0D0,(1D0-V(I1,5)/PED**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ELSE - ZD=SQRT(MAX(0D0,1D0-V(I1,5)/PED**2)) - ZH=1D0 - ENDIF - IF(IRDA.EQ.21.AND.IRGD1.LT.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - ELSE - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. - & ISSET(1).EQ.0) THEN - ISL(1)=1 - ELSEIF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU).AND. - & ISSET(2).EQ.0) THEN - ISL(2)=1 - ENDIF - ENDIF - IF(IRDA.EQ.21) V(I1,4)=LOG(ZU*(1D0-ZL)/MAX(1D-20, - & ZL*(1D0-ZU))) - IF(IRDA.NE.21) V(I1,4)=LOG((1D0-ZL)/MAX(1D-10,1D0-ZU)) - 470 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(0D0,V(N+1,3)/MAX(1D-6,V(N+1,4))-1D0) - ZDR2=MAX(0D0,V(N+2,3)/MAX(1D-6,V(N+2,4))-1D0) - IF(ZDR2.GT.PYR(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 340 - ENDIF - IRD1=IREF(N+1-NS) - IRD2=IREF(N+2-NS) - IF(IGM.GT.0) THEN - IF(MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. - & PMTH(2,IRD1).OR.P(N+2,5).GE.PMTH(2,IRD2))) THEN - PMQ1=V(N+1,5)/V(IM,5) - PMQ2=V(N+2,5)/V(IM,5) - ZD=SQRT(MAX(0D0,(1D0-V(IM,5)/PEM**2)*((1D0-PMQ1-PMQ2)**2- - & 4D0*PMQ1*PMQ2))) - ZH=1D0+PMQ1-PMQ2 - ZL=0.5D0*(ZH-ZD) - ZU=0.5D0*(ZH+ZD) - IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 340 - ENDIF - ENDIF - -C...Accepted branch. Construct four-momentum for initial partons. - 480 MAZIP=0 - MAZIC=0 - IF(NEP.EQ.1) THEN - P(N+1,1)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=SQRT(MAX(0D0,(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.5D0*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) - P(N+1,1)=0D0 - P(N+1,2)=0D0 - P(N+1,3)=SQRT(MAX(0D0,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) - P(N+1,4)=PED1 - P(N+2,1)=0D0 - P(N+2,2)=0D0 - 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.GE.3) THEN -C...Rescale all momenta for energy conservation. - LOOP=0 - PES=0D0 - PQS=0D0 - DO 500 I=1,NEP - DO 490 J=1,4 - P(N+I,J)=P(IPA(I),J) - 490 CONTINUE - PES=PES+P(N+I,4) - PQS=PQS+P(N+I,5)**2/P(N+I,4) - 500 CONTINUE - 510 LOOP=LOOP+1 - FAC=(PS(5)-PQS)/(PES-PQS) - PES=0D0 - PQS=0D0 - DO 530 I=1,NEP - DO 520 J=1,3 - P(N+I,J)=FAC*P(N+I,J) - 520 CONTINUE - P(N+I,4)=SQRT(P(N+I,5)**2+P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) - V(N+I,2)=P(N+I,4) - PES=PES+P(N+I,4) - PQS=PQS+P(N+I,5)**2/P(N+I,4) - 530 CONTINUE - IF(LOOP.LT.10.AND.ABS(PES-PS(5)).GT.1D-12*PS(5)) GOTO 510 - -C...Construct transverse momentum for ordinary branching in shower. - ELSE - ZM=V(IM,1) - LOOPPT=0 - 540 LOOPPT=LOOPPT+1 - PZM=SQRT(MAX(0D0,(PEM+P(IM,5))*(PEM-P(IM,5)))) - PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4D0*V(N+1,5)*V(N+2,5) - IF(PZM.LE.0D0) THEN - PTS=0D0 - ELSEIF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - PTS=PMLS*ZM*(1D0-ZM)/V(IM,5) - ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN - PTS=(PEM**2*(ZM*(1D0-ZM)*V(IM,5)-(1D0-ZM)*V(N+1,5)- - & ZM*V(N+2,5))-0.25D0*PMLS)/PZM**2 - ELSE - PTS=PMLS*(ZM*(1D0-ZM)*PEM**2/V(IM,5)-0.25D0)/PZM**2 - ENDIF - IF(PTS.LT.0D0.AND.LOOPPT.LT.10) THEN - ZM=0.05D0+0.9D0*ZM - GOTO 540 - ELSEIF(PTS.LT.0D0) THEN - GOTO 270 - ENDIF - PT=SQRT(MAX(0D0,PTS)) - -C...Find coefficient of azimuthal asymmetry due to gluon polarization. - HAZIP=0D0 - 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=1D0-V(IGM,1) - IF(MAZIP.EQ.0) ZAU=0D0 - IF(K(IGM,2).NE.21) THEN - HAZIP=2D0*ZAU/(1D0+ZAU**2) - ELSE - HAZIP=(ZAU/(1D0-ZAU*(1D0-ZAU)))**2 - ENDIF - IF(K(N+1,2).NE.21) THEN - HAZIP=HAZIP*(-2D0*ZM*(1D0-ZM))/(1D0-2D0*ZM*(1D0-ZM)) - ELSE - HAZIP=HAZIP*(ZM*(1D0-ZM)/(1D0-ZM*(1D0-ZM)))**2 - ENDIF - ENDIF - -C...Find coefficient of azimuthal asymmetry due to soft gluon -C...interference. - HAZIC=0D0 - 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.5D0) MAZIC=N+2 - IF(K(IAU,2).EQ.22) MAZIC=0 - ZS=ZM - IF(MAZIC.EQ.N+2) ZS=1D0-ZM - ZGM=V(IGM,1) - IF(IAU.EQ.IM-1) ZGM=1D0-V(IGM,1) - IF(MAZIC.EQ.0) ZGM=1D0 - IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))* - & SQRT((1D0-ZS)*(1D0-ZGM)/(ZS*ZGM)) - HAZIC=MIN(0.95D0,HAZIC) - ENDIF - ENDIF - -C...Construct energies for ordinary branching in shower. - 550 IF(NEP.EQ.2.AND.IGM.GT.0) THEN - IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - P(N+1,4)=0.5D0*(PEM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ - & PZM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) - ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN - P(N+1,4)=PEM*V(IM,1) - ELSE - P(N+1,4)=PEM*(0.5D0*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ - & SQRT(PMLS)*ZM)/V(IM,5) - ENDIF - -C...Already predetermined choice of phi angle or not - PHI=PARU(2)*PYR(0) - IF(MPSPD.EQ.1.AND.IGM.EQ.NS+1) THEN - IPSPD=IP1+IM-NS-2 - IF(K(IPSPD,4).GT.0) THEN - IPSGD1=K(IPSPD,4) - IF(IM.EQ.NS+2) THEN - PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) - ELSE - PHI=PYANGL(-P(IPSGD1,1),P(IPSGD1,2)) - ENDIF - ENDIF - ELSEIF(MPSPD.EQ.1.AND.IGM.EQ.NS+2) THEN - IPSPD=IP1+IM-NS-2 - IF(K(IPSPD,4).GT.0) THEN - IPSGD1=K(IPSPD,4) - PHIPSM=PYANGL(P(IPSPD,1),P(IPSPD,2)) - THEPSM=PYANGL(P(IPSPD,3),SQRT(P(IPSPD,1)**2+P(IPSPD,2)**2)) - CALL PYROBO(IPSGD1,IPSGD1,0D0,-PHIPSM,0D0,0D0,0D0) - CALL PYROBO(IPSGD1,IPSGD1,-THEPSM,0D0,0D0,0D0,0D0) - PHI=PYANGL(P(IPSGD1,1),P(IPSGD1,2)) - CALL PYROBO(IPSGD1,IPSGD1,THEPSM,PHIPSM,0D0,0D0,0D0) - ENDIF - ENDIF - -C...Construct momenta for ordinary branching in shower. - P(N+1,1)=PT*COS(PHI) - P(N+1,2)=PT*SIN(PHI) - IF(K(IM,2).EQ.21.AND.IABS(K(N+1,2)).LE.10.AND. - & (MSTJ(44).EQ.3.OR.MSTJ(44).EQ.5)) THEN - P(N+1,3)=0.5D0*(PZM*(V(IM,5)+V(N+1,5)-V(N+2,5))+ - & PEM*SQRT(MAX(0D0,PMLS))*(2D0*ZM-1D0))/V(IM,5) - ELSEIF(PZM.GT.0D0) THEN - P(N+1,3)=0.5D0*(V(N+2,5)-V(N+1,5)-V(IM,5)+ - & 2D0*PEM*P(N+1,4))/PZM - ELSE - P(N+1,3)=0D0 - 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))/(1D0+GA)- - & P(IM,4)) - ELSE - BEX=0D0 - BEY=0D0 - BEZ=0D0 - GA=1D0 - GABEP=0D0 - ENDIF - PTIMB=SQRT((P(IM,1)+GABEP*BEX)**2+(P(IM,2)+GABEP*BEY)**2) - THE=PYANGL(P(IM,3)+GABEP*BEZ,PTIMB) - IF(PTIMB.GT.1D-4) THEN - PHI=PYANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) - ELSE - PHI=0D0 - ENDIF - DO 560 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) - 560 CONTINUE - ENDIF - -C...Weight with azimuthal distribution, if required. - IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN - DO 570 J=1,3 - DPT(1,J)=P(IM,J) - DPT(2,J)=P(IAU,J) - DPT(3,J)=P(N+1,J) - 570 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 580 J=1,3 - DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/MAX(1D-10,DPMM) - DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/MAX(1D-10,DPMM) - 580 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.1D0*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(1D0+HAZIP*(2D0*CAD**2-1D0).LT.PYR(0)*(1D0+ABS(HAZIP))) - & GOTO 550 - ENDIF - IF(MAZIC.NE.0) THEN - IF(MAZIC.EQ.N+2) CAD=-CAD - IF((1D0-HAZIC)*(1D0-HAZIC*CAD)/(1D0+HAZIC**2-2D0*HAZIC*CAD) - & .LT.PYR(0)) GOTO 550 - 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=PYANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) - IF(III.EQ.2) THEIID=PARU(1)-THEIID - PHIIID=PYANGL(P(IAZIID,1),P(IAZIID,2)) - HAZII=MIN(0.95D0,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((1D0-HAZII)*(1D0-HAZII*CAD)/(1D0+HAZII**2-2D0*HAZII*CAD) - & .LT.PYR(0)) GOTO 550 - 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)-10) THEN - CALL PYERRM(11,'(PYSHOW:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) N=NS - IF(MSTU(21).GE.1) RETURN - ENDIF - GOTO 280 - -C...Set information on imagined shower initiator. - 590 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 600 I=NS+1+IIM,N - KQ=KCHG(PYCOMP(K(I,2)),2) - 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(KQ.EQ.1.AND.K(I,2).GT.0) ID1=MOD(K(I,4),MSTU(5))+1 - IF(KQ.EQ.2.AND.(K(ID1,2).EQ.21.OR.K(ID1+1,2).EQ.21).AND. - & PYR(0).GT.0.5D0) 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(KQ.EQ.1.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 - 600 CONTINUE - -C...Transformation from CM frame. - IF(NPA.EQ.1) THEN - THE=PYANGL(P(IPA(1),3),SQRT(P(IPA(1),1)**2+P(IPA(1),2)**2)) - PHI=PYANGL(P(IPA(1),1),P(IPA(1),2)) - MSTU(33)=1 - CALL PYROBO(NS+1,N,THE,PHI,0D0,0D0,0D0) - ELSEIF(NPA.EQ.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)) - & /(1D0+GA)-P(IPA(1),4)) - THE=PYANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) - & +GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) - PHI=PYANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) - MSTU(33)=1 - CALL PYROBO(NS+1,N,THE,PHI,BEX,BEY,BEZ) - ELSE - CALL PYROBO(IPA(1),IPA(NPA),0D0,0D0,PS(1)/PS(4),PS(2)/PS(4), - & PS(3)/PS(4)) - MSTU(33)=1 - CALL PYROBO(NS+1,N,0D0,0D0,PS(1)/PS(4),PS(2)/PS(4),PS(3)/PS(4)) - ENDIF - -C...Decay vertex of shower. - DO 620 I=NS+1,N - DO 610 J=1,5 - V(I,J)=V(IP1,J) - 610 CONTINUE - 620 CONTINUE - -C...Delete trivial shower, else connect initiators. - IF(N.LE.NS+NPA+IIM) THEN - N=NS - ELSE - DO 630 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 - 630 CONTINUE - ENDIF - - RETURN - END - -C*********************************************************************** - -C...PYSIGH -C...Differential matrix elements for all included subprocesses -C...Note that what is coded is (disregarding the COMFAC factor) -C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where, -C...when d(sigma-hat) is given in the zero-width limit, the delta -C...function in tau is replaced by a (modified) Breit-Wigner: -C...1/pi*s*H_res/((s*tau-m_res^2)^2+H_res^2), -C...where H_res = s-hat/m_res*Gamma_res(s-hat); -C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat); -C...i.e., dimensionless quantities -C...3) for 2 -> 3 processes: abs(M)^2, where the total cross-section is -C...Integral abs(M)^2/(2shat') * (prod_(i=1)^3 d^3p_i/((2pi)^3*2E_i)) * -C...(2pi)^4 delta^4(P - sum p_i) -C...COMFAC contains the factor pi/s (or equivalent) and -C...the conversion factor from GeV^-2 to mb - - SUBROUTINE PYSIGH(NCHN,SIGS) - -C...Double precision and integer declarations - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/, - &/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,/PYINT5/,/PYINT7/, - &/PYMSSM/,/PYSSMT/,/PYTCSM/,/PYSGCM/ -C...Local arrays and complex variables - DIMENSION X(2),XPQ(-25:25) - -C...Map of processes onto which routine to call -C...in order to evaluate cross section: -C...0 = not implemented; -C...1 = standard QCD (including photons); -C...2 = heavy flavours; -C...3 = W/Z; -C...4 = Higgs (2 doublets; including longitudinal W/Z scattering); -C...5 = SUSY; -C...6 = Technicolor; -C...7 = exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). - DIMENSION MAPPR(500) - DATA (MAPPR(I),I=1,180)/ - & 3, 3, 4, 0, 4, 0, 0, 4, 0, 1, - 1 1, 1, 1, 1, 3, 3, 0, 1, 3, 3, - 2 0, 3, 3, 4, 3, 4, 0, 1, 1, 3, - 3 3, 4, 1, 1, 3, 3, 0, 0, 0, 0, - 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 5 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, - 6 0, 0, 0, 0, 0, 0, 0, 1, 3, 3, - 7 4, 4, 4, 0, 0, 4, 4, 0, 0, 1, - 8 2, 2, 2, 2, 2, 2, 2, 2, 2, 0, - 9 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, - & 0, 4, 4, 2, 2, 2, 2, 2, 0, 4, - 1 4, 4, 4, 1, 1, 0, 0, 0, 0, 0, - 2 4, 4, 4, 4, 0, 0, 0, 0, 0, 0, - 3 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - 4 7, 7, 4, 7, 7, 7, 7, 7, 6, 0, - 5 4, 4, 4, 0, 0, 4, 4, 4, 0, 0, - 6 4, 7, 7, 7, 6, 6, 7, 7, 7, 0, - 7 4, 4, 4, 4, 0, 4, 4, 4, 4, 0/ - DATA (MAPPR(I),I=181,500)/ - 8 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, - 9 6, 6, 6, 6, 6, 0, 0, 0, 0, 0, - & 100*5, - & 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 1 30*0, - 4 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, - 5 7, 7, 7, 7, 0, 0, 0, 0, 0, 0, - 6 6, 6, 6, 6, 6, 6, 6, 6, 0, 6, - 7 6, 6, 6, 6, 6, 6, 6, 0, 0, 0, - 8 6, 6, 6, 6, 6, 6, 6, 6, 0, 0, - 9 7, 7, 7, 7, 7, 0, 0, 0, 0, 0, - & 4, 4, 98*0/ - -C...Reset number of channels and cross-section - NCHN=0 - SIGS=0D0 - -C...Read process to consider. - ISUB=MINT(1) - ISUBSV=ISUB - MAP=MAPPR(ISUB) - -C...Read kinematical variables and limits - ISTSB=ISET(ISUBSV) - TAUMIN=VINT(11) - YSTMIN=VINT(12) - CTNMIN=VINT(13) - CTPMIN=VINT(14) - TAUPMN=VINT(16) - TAU=VINT(21) - YST=VINT(22) - CTH=VINT(23) - XT2=VINT(25) - TAUP=VINT(26) - TAUMAX=VINT(31) - YSTMAX=VINT(32) - CTNMAX=VINT(33) - CTPMAX=VINT(34) - TAUPMX=VINT(36) - -C...Derive kinematical quantities - TAUE=TAU - IF(ISTSB.GE.3.AND.ISTSB.LE.5) TAUE=TAUP - X(1)=SQRT(TAUE)*EXP(YST) - X(2)=SQRT(TAUE)*EXP(-YST) - IF(MINT(45).EQ.2.AND.ISTSB.GE.1) THEN - IF(X(1).GT.1D0-1D-7) RETURN - ELSEIF(MINT(45).EQ.3) THEN - X(1)=MIN(1D0-1.1D-10,X(1)) - ENDIF - IF(MINT(46).EQ.2.AND.ISTSB.GE.1) THEN - IF(X(2).GT.1D0-1D-7) RETURN - ELSEIF(MINT(46).EQ.3) THEN - X(2)=MIN(1D0-1.1D-10,X(2)) - ENDIF - SH=MAX(1D0,TAU*VINT(2)) - SQM3=VINT(63) - SQM4=VINT(64) - RM3=SQM3/SH - RM4=SQM4/SH - BE34=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4)) - RPTS=4D0*VINT(71)**2/SH - BE34L=SQRT(MAX(0D0,(1D0-RM3-RM4)**2-4D0*RM3*RM4-RPTS)) - RM34=MAX(1D-20,2D0*RM3*RM4) - RSQM=1D0+RM34 - IF(2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2)).LT.0.0001D0) - &RM34=MAX(RM34,2D0*VINT(71)**2/MAX(1D0,VINT(21)*VINT(2))) - RTHM=(4D0*RM3*RM4+RPTS)/(1D0-RM3-RM4+BE34L) - IF(ISTSB.EQ.0) THEN - TH=VINT(45) - UH=-0.5D0*SH*MAX(RTHM,1D0-RM3-RM4+BE34*CTH) - SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*VINT(59)**2) - ELSE -C...Kinematics with incoming masses tricky: now depends on how -C...subprocess has been set up w.r.t. order of incoming partons. - RM1=0D0 - IF(MINT(15).EQ.22.AND.VINT(3).LT.0D0) RM1=-VINT(3)**2/SH - RM2=0D0 - IF(MINT(16).EQ.22.AND.VINT(4).LT.0D0) RM2=-VINT(4)**2/SH - IF(ISUB.EQ.35) THEN - RM2=MIN(RM1,RM2) - RM1=0D0 - ENDIF - BE12=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - TUCOM=(1D0-RM1-RM2)*(1D0-RM3-RM4) - TH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM4-2D0*RM2*RM3- - & BE12*BE34*CTH) - UH=-0.5D0*SH*MAX(RTHM,TUCOM-2D0*RM1*RM3-2D0*RM2*RM4+ - & BE12*BE34*CTH) - SQPTH=MAX(VINT(71)**2,0.25D0*SH*BE34**2*(1D0-CTH**2)) - ENDIF - SHR=SQRT(SH) - SH2=SH**2 - TH2=TH**2 - UH2=UH**2 - -C...Choice of Q2 scale: hard, parton distributions, parton showers - IF(ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5) THEN - Q2=SH - ELSEIF(ISTSB.EQ.8) THEN - IF(MINT(107).EQ.4) Q2=VINT(307) - IF(MINT(108).EQ.4) Q2=VINT(308) - ELSEIF(MOD(ISTSB,2).EQ.0.OR.ISTSB.EQ.9) THEN - Q2IN1=0D0 - IF(MINT(11).EQ.22.AND.VINT(3).LT.0D0) Q2IN1=VINT(3)**2 - Q2IN2=0D0 - IF(MINT(12).EQ.22.AND.VINT(4).LT.0D0) Q2IN2=VINT(4)**2 - IF(MSTP(32).EQ.1) THEN - Q2=2D0*SH*TH*UH/(SH**2+TH**2+UH**2) - ELSEIF(MSTP(32).EQ.2) THEN - Q2=SQPTH+0.5D0*(SQM3+SQM4) - ELSEIF(MSTP(32).EQ.3) THEN - Q2=MIN(-TH,-UH) - ELSEIF(MSTP(32).EQ.4) THEN - Q2=SH - ELSEIF(MSTP(32).EQ.5) THEN - Q2=-TH - ELSEIF(MSTP(32).EQ.6) THEN - XSF1=X(1) - IF(ISTSB.EQ.9) XSF1=X(1)/VINT(143) - XSF2=X(2) - IF(ISTSB.EQ.9) XSF2=X(2)/VINT(144) - Q2=(1D0+XSF1*Q2IN1/SH+XSF2*Q2IN2/SH)* - & (SQPTH+0.5D0*(SQM3+SQM4)) - ELSEIF(MSTP(32).EQ.7) THEN - Q2=(1D0+Q2IN1/SH+Q2IN2/SH)*(SQPTH+0.5D0*(SQM3+SQM4)) - ELSEIF(MSTP(32).EQ.8) THEN - Q2=SQPTH+0.5D0*(Q2IN1+Q2IN2+SQM3+SQM4) - ELSEIF(MSTP(32).EQ.9) THEN - Q2=SQPTH+Q2IN1+Q2IN2+SQM3+SQM4 - ELSEIF(MSTP(32).EQ.10) THEN - Q2=VINT(2) - ENDIF - IF((ISTSB.EQ.9).AND.(MSTP(81).NE.0)) THEN - Q2=SQPTH - ENDIF - IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2=Q2+ - & (PARP(82)*(VINT(1)/PARP(89))**PARP(90))**2 - ENDIF - Q2SF=Q2 - IF(ISTSB.GE.3.AND.ISTSB.LE.5) THEN - Q2SF=PMAS(23,1)**2 - IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77.OR.ISUB.EQ.124.OR. - & ISUB.EQ.351) Q2SF=PMAS(24,1)**2 - IF(ISUB.EQ.352) Q2SF=PMAS(PYCOMP(9900024),1)**2 - IF(ISUB.EQ.121.OR.ISUB.EQ.122.OR.ISUB.EQ.181.OR.ISUB.EQ.182.OR. - & ISUB.EQ.186.OR.ISUB.EQ.187.OR.ISUB.EQ.401.OR.ISUB.EQ.402) THEN - Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,2)),1)**2 - IF(MSTP(39).EQ.2) Q2SF= - & MAX(VINT(201)**2+VINT(202),VINT(206)**2+VINT(207)) - IF(MSTP(39).EQ.3) Q2SF=SH - IF(MSTP(39).EQ.4) Q2SF=VINT(26)*VINT(2) - IF(MSTP(39).EQ.5) Q2SF=PMAS(PYCOMP(KFPR(ISUBSV,1)),1)**2 - ENDIF - ENDIF - Q2PS=Q2SF - Q2SF=Q2SF*PARP(34) - IF(MSTP(69).GE.1.AND.MINT(47).EQ.5) Q2SF=VINT(2) - IF(MSTP(69).GE.2) Q2SF=VINT(2) - IF(MSTP(22).GE.1.AND.(ISUB.EQ.10.OR.ISUB.EQ.83).AND. - &(MINT(43).EQ.2.OR.MINT(43).EQ.3)) THEN - XBJ=X(2) - IF(MINT(43).EQ.3) XBJ=X(1) - IF(MSTP(22).EQ.1) THEN - Q2PS=-TH - ELSEIF(MSTP(22).EQ.2) THEN - Q2PS=((1D0-XBJ)/XBJ)*(-TH) - ELSEIF(MSTP(22).EQ.3) THEN - Q2PS=SQRT((1D0-XBJ)/XBJ)*(-TH) - ELSE - Q2PS=(1D0-XBJ)*MAX(1D0,-LOG(XBJ))*(-TH) - ENDIF - ENDIF - IF(MSTP(68).EQ.1.AND.(ISUBSV.EQ.1.OR.ISUBSV.EQ.2.OR. - &ISUBSV.EQ.102.OR.ISUBSV.EQ.141.OR.ISUBSV.EQ.142.OR. - &ISUBSV.EQ.144.OR.ISUBSV.EQ.152.OR.ISUBSV.EQ.157)) THEN - Q2PS=VINT(2) - ELSEIF(MSTP(68).GE.2.AND.(ISUBSV.NE.11.AND.ISUBSV.NE.12.AND. - &ISUBSV.NE.13.AND.ISUBSV.NE.28.AND.ISUBSV.NE.53.AND. - &ISUBSV.NE.68)) THEN - Q2PS=VINT(2) - ENDIF - -C...Store derived kinematical quantities - VINT(41)=X(1) - VINT(42)=X(2) - VINT(44)=SH - VINT(43)=SQRT(SH) - VINT(45)=TH - VINT(46)=UH - IF(ISTSB.NE.8) VINT(48)=SQPTH - IF(ISTSB.NE.8) VINT(47)=SQRT(SQPTH) - VINT(50)=TAUP*VINT(2) - VINT(49)=SQRT(MAX(0D0,VINT(50))) - VINT(52)=Q2 - VINT(51)=SQRT(Q2) - VINT(54)=Q2SF - VINT(53)=SQRT(Q2SF) - VINT(56)=Q2PS - VINT(55)=SQRT(Q2PS) - -C...Calculate parton distributions - IF(ISTSB.LE.0) GOTO 160 - IF(MINT(47).GE.2) THEN - DO 110 I=3-MIN(2,MINT(45)),MIN(2,MINT(46)) - XSF=X(I) - IF(ISTSB.EQ.9) XSF=X(I)/VINT(142+I) - IF(ISUB.EQ.99) THEN - IF(MINT(140+I).EQ.0) THEN - XSF=VINT(309-I)/(VINT(2)+VINT(309-I)-VINT(I+2)**2) - ELSE - XSF=VINT(309-I)/(VINT(2)+VINT(307)+VINT(308)) - ENDIF - VINT(40+I)=XSF - Q2SF=VINT(309-I) - ENDIF - MINT(105)=MINT(102+I) - MINT(109)=MINT(106+I) - VINT(120)=VINT(2+I) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(MINT(10+I),XSF,Q2SF,XPQ) - ELSE - CALL PYPDFL(MINT(10+I),XSF,Q2SF,XPQ) - ENDIF - DO 100 KFL=-25,25 - XSFX(I,KFL)=XPQ(KFL) - 100 CONTINUE - 110 CONTINUE - ENDIF - -C...Calculate alpha_em, alpha_strong and K-factor - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2.OR.(ISUB.GE.71.AND.ISUB.LE.77)) XW= - &1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - XWC=1D0/(16D0*XW*XW1) - AEM=PYALEM(Q2) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - IF(MSTP(33).NE.3) AS=PYALPS(PARP(34)*Q2) - FACK=1D0 - FACA=1D0 - IF(MSTP(33).EQ.1) THEN - FACK=PARP(31) - ELSEIF(MSTP(33).EQ.2) THEN - FACK=PARP(31) - FACA=PARP(32)/PARP(31) - ELSEIF(MSTP(33).EQ.3) THEN - Q2AS=PARP(33)*Q2 - IF(ISTSB.EQ.9.AND.MSTP(82).GE.2) Q2AS=Q2AS+ - & PARU(112)*PARP(82)*(VINT(1)/PARP(89))**PARP(90) - AS=PYALPS(Q2AS) - ENDIF - VINT(138)=1D0 - VINT(57)=AEM - VINT(58)=AS - -C...Set flags for allowed reacting partons/leptons - DO 140 I=1,2 - DO 120 J=-25,25 - KFAC(I,J)=0 - 120 CONTINUE - IF(MINT(44+I).EQ.1) THEN - KFAC(I,MINT(10+I))=1 - ELSEIF(MINT(40+I).EQ.1.AND.MSTP(12).EQ.0) THEN - KFAC(I,MINT(10+I))=1 - KFAC(I,22)=1 - KFAC(I,24)=1 - KFAC(I,-24)=1 - ELSE - DO 130 J=-25,25 - KFAC(I,J)=KFIN(I,J) - IF(IABS(J).GT.MSTP(58).AND.IABS(J).LE.10) KFAC(I,J)=0 - IF(XSFX(I,J).LT.1D-10) KFAC(I,J)=0 - 130 CONTINUE - ENDIF - 140 CONTINUE - -C...Lower and upper limit for fermion flavour loops - MMIN1=0 - MMAX1=0 - MMIN2=0 - MMAX2=0 - DO 150 J=-20,20 - IF(KFAC(1,-J).EQ.1) MMIN1=-J - IF(KFAC(1,J).EQ.1) MMAX1=J - IF(KFAC(2,-J).EQ.1) MMIN2=-J - IF(KFAC(2,J).EQ.1) MMAX2=J - 150 CONTINUE - MMINA=MIN(MMIN1,MMIN2) - MMAXA=MAX(MMAX1,MMAX2) - -C...Common resonance mass and width combinations - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - GMMW=PMAS(24,1)*PMAS(24,2) - -C...Polarization factors...implemented so far for W+W-(25) - POLR=(1D0+PARJ(132))*(1D0-PARJ(131)) - POLL=(1D0-PARJ(132))*(1D0+PARJ(131)) - POLRR=(1D0+PARJ(132))*(1D0+PARJ(131)) - POLLL=(1D0-PARJ(132))*(1D0-PARJ(131)) - -C...Phase space integral in tau - COMFAC=PARU(1)*PARU(5)/VINT(2) - IF(MINT(41).EQ.2.AND.MINT(42).EQ.2) COMFAC=COMFAC*FACK - IF((MINT(47).GE.2.OR.(ISTSB.GE.3.AND.ISTSB.LE.5)).AND. - &ISTSB.NE.8.AND.ISTSB.NE.9) THEN - ATAU1=LOG(TAUMAX/TAUMIN) - ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) - H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/TAU - IF(MINT(72).GE.1) THEN - TAUR1=VINT(73) - GAMR1=VINT(74) - ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1)) - ATAU3=ATAUD/TAUR1 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU3)*COEF(ISUBSV,3)/(TAU+TAUR1) - ATAUD=ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1) - ATAU4=ATAUD/GAMR1 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU4)*COEF(ISUBSV,4)*TAU/((TAU-TAUR1)**2+GAMR1**2) - ENDIF - IF(MINT(72).EQ.2) THEN - TAUR2=VINT(75) - GAMR2=VINT(76) - ATAUD=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2)) - ATAU5=ATAUD/TAUR2 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU5)*COEF(ISUBSV,5)/(TAU+TAUR2) - ATAUD=ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2) - ATAU6=ATAUD/GAMR2 - IF(ATAUD.GT.1D-10) H1=H1+ - & (ATAU1/ATAU6)*COEF(ISUBSV,6)*TAU/((TAU-TAUR2)**2+GAMR2**2) - ENDIF - IF(MINT(47).EQ.5.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN - ATAU7=LOG(MAX(2D-10,1D0-TAUMIN)/MAX(2D-10,1D0-TAUMAX)) - IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ - & MAX(2D-10,1D0-TAU) - ELSEIF(MINT(47).GE.6.AND.(ISTSB.LE.2.OR.ISTSB.GE.5)) THEN - ATAU7=LOG(MAX(1D-10,1D0-TAUMIN)/MAX(1D-10,1D0-TAUMAX)) - IF(ATAU7.GT.1D-10) H1=H1+(ATAU1/ATAU7)*COEF(ISUBSV,7)*TAU/ - & MAX(1D-10,1D0-TAU) - ENDIF - COMFAC=COMFAC*ATAU1/(TAU*H1) - ENDIF - -C...Phase space integral in y* - IF((MINT(47).EQ.4.OR.MINT(47).EQ.5).AND.ISTSB.NE.8.AND.ISTSB.NE.9) - &THEN - AYST0=YSTMAX-YSTMIN - IF(AYST0.LT.1D-10) THEN - COMFAC=0D0 - ELSE - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST2=AYST1 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ - & (AYST0/AYST2)*COEF(ISUBSV,9)*(YSTMAX-YST)+ - & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) - IF(MINT(45).EQ.3) THEN - YST0=-0.5D0*LOG(TAUE) - AYST4=LOG(MAX(1D-10,EXP(YST0-YSTMIN)-1D0)/ - & MAX(1D-10,EXP(YST0-YSTMAX)-1D0)) - IF(AYST4.GT.1D-10) H2=H2+(AYST0/AYST4)*COEF(ISUBSV,11)/ - & MAX(1D-10,1D0-EXP(YST-YST0)) - ENDIF - IF(MINT(46).EQ.3) THEN - YST0=-0.5D0*LOG(TAUE) - AYST5=LOG(MAX(1D-10,EXP(YST0+YSTMAX)-1D0)/ - & MAX(1D-10,EXP(YST0+YSTMIN)-1D0)) - IF(AYST5.GT.1D-10) H2=H2+(AYST0/AYST5)*COEF(ISUBSV,12)/ - & MAX(1D-10,1D0-EXP(-YST-YST0)) - ENDIF - COMFAC=COMFAC*AYST0/H2 - ENDIF - ENDIF - -C...2 -> 1 processes: reduction in angular part of phase space integral -C...for case of decaying resonance - ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN - IF((ISTSB.EQ.1.OR.ISTSB.EQ.3.OR.ISTSB.EQ.5)) THEN - IF(MDCY(PYCOMP(KFPR(ISUBSV,1)),1).EQ.1) THEN - IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37.OR. - & KFPR(ISUB,1).EQ.39) THEN - COMFAC=COMFAC*0.5D0*ACTH0 - ELSE - COMFAC=COMFAC*0.125D0*(3D0*ACTH0+CTNMAX**3-CTNMIN**3+ - & CTPMAX**3-CTPMIN**3) - ENDIF - ENDIF - -C...2 -> 2 processes: angular part of phase space integral - ELSEIF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN - ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/ - & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX))) - ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/ - & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN))) - ACTH3=1D0/MAX(RM34,RSQM-CTNMAX)-1D0/MAX(RM34,RSQM-CTNMIN)+ - & 1D0/MAX(RM34,RSQM-CTPMAX)-1D0/MAX(RM34,RSQM-CTPMIN) - ACTH4=1D0/MAX(RM34,RSQM+CTNMIN)-1D0/MAX(RM34,RSQM+CTNMAX)+ - & 1D0/MAX(RM34,RSQM+CTPMIN)-1D0/MAX(RM34,RSQM+CTPMAX) - H3=COEF(ISUBSV,13)+ - & (ACTH0/ACTH1)*COEF(ISUBSV,14)/MAX(RM34,RSQM-CTH)+ - & (ACTH0/ACTH2)*COEF(ISUBSV,15)/MAX(RM34,RSQM+CTH)+ - & (ACTH0/ACTH3)*COEF(ISUBSV,16)/MAX(RM34,RSQM-CTH)**2+ - & (ACTH0/ACTH4)*COEF(ISUBSV,17)/MAX(RM34,RSQM+CTH)**2 - COMFAC=COMFAC*ACTH0*0.5D0*BE34/H3 - -C...2 -> 2 processes: take into account final state Breit-Wigners - COMFAC=COMFAC*VINT(80) - ENDIF - -C...2 -> 3, 4 processes: phace space integral in tau' - IF(MINT(47).GE.2.AND.ISTSB.GE.3.AND.ISTSB.LE.5) THEN - ATAUP1=LOG(TAUPMX/TAUPMN) - ATAUP2=((1D0-TAU/TAUPMX)**4-(1D0-TAU/TAUPMN)**4)/(4D0*TAU) - H4=COEF(ISUBSV,18)+ - & (ATAUP1/ATAUP2)*COEF(ISUBSV,19)*(1D0-TAU/TAUP)**3/TAUP - IF(MINT(47).EQ.5) THEN - ATAUP3=LOG(MAX(2D-10,1D0-TAUPMN)/MAX(2D-10,1D0-TAUPMX)) - H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(2D-10,1D0-TAUP) - ELSEIF(MINT(47).GE.6) THEN - ATAUP3=LOG(MAX(1D-10,1D0-TAUPMN)/MAX(1D-10,1D0-TAUPMX)) - H4=H4+(ATAUP1/ATAUP3)*COEF(ISUBSV,20)*TAUP/MAX(1D-10,1D0-TAUP) - ENDIF - COMFAC=COMFAC*ATAUP1/H4 - ENDIF - -C...2 -> 3, 4 processes: effective W/Z parton distributions - IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) THEN - IF(1D0-TAU/TAUP.GT.1D-4) THEN - FZW=(1D0+TAU/TAUP)*LOG(TAUP/TAU)-2D0*(1D0-TAU/TAUP) - ELSE - FZW=1D0/6D0*(1D0-TAU/TAUP)**3*TAU/TAUP - ENDIF - COMFAC=COMFAC*FZW - ENDIF - -C...2 -> 3 processes: phase space integrals for pT1, pT2, y3, mirror - IF(ISTSB.EQ.5) THEN - COMFAC=COMFAC*VINT(205)*VINT(210)*VINT(212)*VINT(214)/ - & (128D0*PARU(1)**4*VINT(220))*(TAU**2/TAUP) - ENDIF - -C...Phase space integral for low-pT and multiple interactions - IF(ISTSB.EQ.9) THEN - COMFAC=PARU(1)*PARU(5)*FACK*0.5D0*VINT(2)/SH2 - ATAU1=LOG(2D0*(1D0+SQRT(1D0-XT2))/XT2-1D0) - ATAU2=2D0*ATAN(1D0/XT2-1D0)/SQRT(XT2) - H1=COEF(ISUBSV,1)+(ATAU1/ATAU2)*COEF(ISUBSV,2)/SQRT(TAU) - COMFAC=COMFAC*ATAU1/H1 - AYST0=YSTMAX-YSTMIN - AYST1=0.5D0*(YSTMAX-YSTMIN)**2 - AYST3=2D0*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) - H2=(AYST0/AYST1)*COEF(ISUBSV,8)*(YST-YSTMIN)+ - & (AYST0/AYST1)*COEF(ISUBSV,9)*(YSTMAX-YST)+ - & (AYST0/AYST3)*COEF(ISUBSV,10)/COSH(YST) - COMFAC=COMFAC*AYST0/H2 - IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1D0/VINT(149)-1D0) -C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is -C...introduced to make cross-section finite for xT2 -> 0 - IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)* - & (1D0+VINT(149))) - ENDIF - -C...Real gamma + gamma: include factor 2 when different nature - 160 IF(MINT(11).EQ.22.AND.MINT(12).EQ.22.AND.MINT(123).GE.4.AND. - &MSTP(14).LE.10) COMFAC=2D0*COMFAC - -C...Extra factors to include the effects of -C...longitudinal resolved photons (but not direct or DIS ones). - DO 170 ISDE=1,2 - IF(MINT(10+ISDE).EQ.22.AND.MINT(106+ISDE).GE.1.AND. - & MINT(106+ISDE).LE.3) THEN - VINT(314+ISDE)=1D0 - XY=PARP(166+ISDE) - IF(MSTP(16).EQ.0) THEN - IF(VINT(304+ISDE).GT.0D0.AND.VINT(304+ISDE).LT.1D0) - & XY=VINT(304+ISDE) - ELSE - IF(VINT(308+ISDE).GT.0D0.AND.VINT(308+ISDE).LT.1D0) - & XY=VINT(308+ISDE) - ENDIF - Q2GA=VINT(306+ISDE) - IF(MSTP(17).GT.0.AND.XY.GT.0D0.AND.XY.LT.1D0.AND. - & Q2GA.GT.0D0) THEN - REDUCE=0D0 - IF(MSTP(17).EQ.1) THEN - REDUCE=4D0*Q2*Q2GA/(Q2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.2) THEN - REDUCE=4D0*Q2GA/(Q2+Q2GA) - ELSEIF(MSTP(17).EQ.3) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.1) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.2) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*PMVIRT**2*Q2GA/(PMVIRT**2+Q2GA)**2 - ELSEIF(MSTP(17).EQ.4.AND.MINT(106+ISDE).EQ.3) THEN - PMVSMN=4D0*PARP(15)**2 - PMVSMX=4D0*VINT(154)**2 - REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) - REDLON=(3D0*PMVSMN+Q2GA)/(PMVSMN+Q2GA)**3- - & (3D0*PMVSMX+Q2GA)/(PMVSMX+Q2GA)**3 - REDUCE=4D0*(Q2GA/6D0)*REDLON/REDTRA - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.1) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.2) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=4D0*Q2GA/(PMVIRT**2+Q2GA) - ELSEIF(MSTP(17).EQ.5.AND.MINT(106+ISDE).EQ.3) THEN - PMVSMN=4D0*PARP(15)**2 - PMVSMX=4D0*VINT(154)**2 - REDTRA=1D0/(PMVSMN+Q2GA)-1D0/(PMVSMX+Q2GA) - REDLON=1D0/(PMVSMN+Q2GA)**2-1D0/(PMVSMX+Q2GA)**2 - REDUCE=4D0*(Q2GA/2D0)*REDLON/REDTRA -C ........Hermes version of R_VMD - ELSEIF(MSTP(17).EQ.6) THEN - PMVIRT=PMAS(PYCOMP(113),1) - REDUCE=(Q2GA/PMVIRT**2)**PARP(166) - ENDIF - BEAMAS=PYMASS(11) - IF(VINT(302+ISDE).GT.0D0) BEAMAS=VINT(302+ISDE) - IF((MINT(11).EQ.22).and. - & (MINT(12).EQ.2212.or.MINT(12).EQ.2112)) THEN - FRACLT=1D0/(1D0+(XY**2*(1D0-2D0*BEAMAS**2/Q2GA))/ - & (2D0/(1D0+Q2GA/XY**2/VINT(290)**2)*(1D0-XY- - & (Q2GA/4D0/VINT(290)**2)))) - ELSE - FRACLT=1D0/(1D0+XY**2/2D0/(1D0-XY)* - & (1D0-2D0*BEAMAS**2/Q2GA)) - ENDIF - VINT(314+ISDE)=1D0+PARP(165)*REDUCE*FRACLT - ENDIF - ELSE - VINT(314+ISDE)=1D0 - ENDIF - COMFAC=COMFAC*VINT(314+ISDE) - 170 CONTINUE - -C...Evaluate cross sections - done in separate routines by kind -C...of physics, to keep PYSIGH of sensible size. - IF(MAP.EQ.1) THEN -C...Standard QCD (including photons). - CALL PYSGQC(NCHN,SIGS) - ELSEIF(MAP.EQ.2) THEN -C...Heavy flavours. - CALL PYSGHF(NCHN,SIGS) - ELSEIF(MAP.EQ.3) THEN -C...W/Z. - CALL PYSGWZ(NCHN,SIGS) - ELSEIF(MAP.EQ.4) THEN -C...Higgs (2 doublets; including longitudinal W/Z scattering). - CALL PYSGHG(NCHN,SIGS) - ELSEIF(MAP.EQ.5) THEN -C...SUSY. - CALL PYSGSU(NCHN,SIGS) - ELSEIF(MAP.EQ.6) THEN -C...Technicolor. - CALL PYSGTC(NCHN,SIGS) - ELSEIF(MAP.EQ.7) THEN -C...Exotics (Z'/W'/LQ/R/f*/H++/Z_R/W_R/G*). - CALL PYSGEX(NCHN,SIGS) - ENDIF - -C...Multiply with parton distributions - IF(ISUB.LE.90.OR.ISUB.GE.96) THEN - DO 180 ICHN=1,NCHN - IF(MINT(45).GE.2) THEN - KFL1=ISIG(ICHN,1) - SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1) - ENDIF - IF(MINT(46).GE.2) THEN - KFL2=ISIG(ICHN,2) - SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2) - ENDIF - SIGS=SIGS+SIGH(ICHN) - 180 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYSIMP -C...Simpson formula for an integral. - - FUNCTION PYSIMP(Y,X0,X1,N) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION Y,X0,X1,H,S - DIMENSION Y(0:N) - - S=0D0 - H=(X1-X0)/N - DO 100 I=0,N-2,2 - S=S+Y(I)+4D0*Y(I+1)+Y(I+2) - 100 CONTINUE - PYSIMP=S*H/3D0 - - RETURN - END - -C*********************************************************************** - -C...PYSPEN -C...Calculates real and imaginary part of Spence function; see -C...G. 't Hooft and M. Veltman, Nucl. Phys. B153 (1979) 365. - - FUNCTION PYSPEN(XREIN,XIMIN,IREIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array and data. - DIMENSION B(0:14) - DATA B/ - &1.000000D+00, -5.000000D-01, 1.666667D-01, - &0.000000D+00, -3.333333D-02, 0.000000D+00, - &2.380952D-02, 0.000000D+00, -3.333333D-02, - &0.000000D+00, 7.575757D-02, 0.000000D+00, - &-2.531135D-01, 0.000000D+00, 1.166667D+00/ - - XRE=XREIN - XIM=XIMIN - IF(ABS(1D0-XRE).LT.1D-6.AND.ABS(XIM).LT.1D-6) THEN - IF(IREIM.EQ.1) PYSPEN=PARU(1)**2/6D0 - IF(IREIM.EQ.2) PYSPEN=0D0 - RETURN - ENDIF - - XMOD=SQRT(XRE**2+XIM**2) - IF(XMOD.LT.1D-6) THEN - IF(IREIM.EQ.1) PYSPEN=0D0 - IF(IREIM.EQ.2) PYSPEN=0D0 - RETURN - ENDIF - - XARG=SIGN(ACOS(XRE/XMOD),XIM) - SP0RE=0D0 - SP0IM=0D0 - SGN=1D0 - IF(XMOD.GT.1D0) THEN - ALGXRE=LOG(XMOD) - ALGXIM=XARG-SIGN(PARU(1),XARG) - SP0RE=-PARU(1)**2/6D0-(ALGXRE**2-ALGXIM**2)/2D0 - SP0IM=-ALGXRE*ALGXIM - SGN=-1D0 - XMOD=1D0/XMOD - XARG=-XARG - XRE=XMOD*COS(XARG) - XIM=XMOD*SIN(XARG) - ENDIF - IF(XRE.GT.0.5D0) THEN - ALGXRE=LOG(XMOD) - ALGXIM=XARG - XRE=1D0-XRE - XIM=-XIM - XMOD=SQRT(XRE**2+XIM**2) - XARG=SIGN(ACOS(XRE/XMOD),XIM) - ALGYRE=LOG(XMOD) - ALGYIM=XARG - SP0RE=SP0RE+SGN*(PARU(1)**2/6D0-(ALGXRE*ALGYRE-ALGXIM*ALGYIM)) - SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE) - SGN=-SGN - ENDIF - - XRE=1D0-XRE - XIM=-XIM - XMOD=SQRT(XRE**2+XIM**2) - XARG=SIGN(ACOS(XRE/XMOD),XIM) - ZRE=-LOG(XMOD) - ZIM=-XARG - - SPRE=0D0 - SPIM=0D0 - SAVERE=1D0 - SAVEIM=0D0 - DO 100 I=0,14 - IF(MAX(ABS(SAVERE),ABS(SAVEIM)).LT.1D-30) GOTO 110 - TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/DBLE(I+1) - TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/DBLE(I+1) - SAVERE=TERMRE - SAVEIM=TERMIM - SPRE=SPRE+B(I)*TERMRE - SPIM=SPIM+B(I)*TERMIM - 100 CONTINUE - - 110 IF(IREIM.EQ.1) PYSPEN=SP0RE+SGN*SPRE - IF(IREIM.EQ.2) PYSPEN=SP0IM+SGN*SPIM - - RETURN - END - -C********************************************************************* - -C...PYSPHE -C...Performs sphericity tensor analysis to give sphericity, -C...aplanarity and the related event axes. - - SUBROUTINE PYSPHE(SPH,APL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - 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)=0D0 - 100 CONTINUE - 110 CONTINUE - PS=0D0 - 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=PYCOMP(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.PYCHGE(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=1D0 - IF(ABS(PARU(41)-2D0).GT.0.001D0) PWT= - & MAX(1D-10,PA)**(PARU(41)-2D0) - 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 PYERRM(8,'(PYSPHE:) too few particles for analysis') - SPH=-1D0 - APL=-1D0 - 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)/3D0-1D0/9D0 - SR=-0.5D0*(SQ+1D0/9D0+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)+1D0/27D0 - SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1D0),-1D0))/3D0) - P(N+1,4)=1D0/3D0+SQRT(-SQ)*MAX(2D0*SP,SQRT(3D0*(1D0-SP**2))-SP) - P(N+3,4)=1D0/3D0+SQRT(-SQ)*MIN(2D0*SP,-SQRT(3D0*(1D0-SP**2))-SP) - P(N+2,4)=1D0-P(N+1,4)-P(N+3,4) - IF(P(N+2,4).LT.1D-5) THEN - CALL PYERRM(8,'(PYSPHE:) all particles back-to-back') - SPH=-1D0 - APL=-1D0 - 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=0D0 - 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=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - DO 250 J=1,5 - V(I,J)=0D0 - 250 CONTINUE - 260 CONTINUE - -C...Calculate sphericity and aplanarity. Select storing option. - SPH=1.5D0*(P(N+2,4)+P(N+3,4)) - APL=1.5D0*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********************************************************************* - -C...PYSPLI -C...Splits a hadron remnant into two (partons or hadron + parton) -C...in case it is more complicated than just a quark or a diquark. - - SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. PYDAT1 temporary - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYPARS/,/PYINT1/,/PYDAT1/ -C...Local array. - DIMENSION KFL(3) - -C...Preliminaries. Parton composition. - KFA=IABS(KF) - KFS=ISIGN(1,KF) - KFL(1)=MOD(KFA/1000,10) - KFL(2)=MOD(KFA/100,10) - KFL(3)=MOD(KFA/10,10) - IF(KFA.EQ.22.AND.MINT(109).EQ.2) THEN - KFL(2)=INT(1.5D0+PYR(0)) - IF(MINT(105).EQ.333) KFL(2)=3 - IF(MINT(105).EQ.443) KFL(2)=4 - KFL(3)=KFL(2) - ELSEIF((KFA.EQ.111.OR.KFA.EQ.113).AND.PYR(0).GT.0.5D0) THEN - KFL(2)=2 - KFL(3)=2 - ELSEIF(KFA.EQ.223.AND.PYR(0).GT.0.5D0) THEN - KFL(2)=1 - KFL(3)=1 - ELSEIF((KFA.EQ.130.OR.KFA.EQ.310).AND.PYR(0).GT.0.5D0) THEN - KFL(2)=MOD(KFA/10,10) - KFL(3)=MOD(KFA/100,10) - ENDIF - IF(KFLIN.NE.21.AND.KFLIN.NE.22.AND.KFLIN.NE.23) THEN - KFLR=KFLIN*KFS - ELSE - KFLR=KFLIN - ENDIF - KFLCH=0 - -C...Subdivide lepton. - IF(KFA.GE.11.AND.KFA.LE.18) THEN - IF(KFLR.EQ.KFA) THEN - KFLSP=KFS*22 - ELSEIF(KFLR.EQ.22) THEN - KFLSP=KFA - ELSEIF(KFLR.EQ.-24.AND.MOD(KFA,2).EQ.1) THEN - KFLSP=KFA+1 - ELSEIF(KFLR.EQ.24.AND.MOD(KFA,2).EQ.0) THEN - KFLSP=KFA-1 - ELSEIF(KFLR.EQ.21) THEN - KFLSP=KFA - KFLCH=KFS*21 - ELSE - KFLSP=KFA - KFLCH=-KFLR - ENDIF - -C...Subdivide photon. - ELSEIF(KFA.EQ.22.AND.MINT(109).NE.2) THEN - IF(KFLR.NE.21) THEN - KFLSP=-KFLR - ELSE - RAGR=0.75D0*PYR(0) - KFLSP=1 - IF(RAGR.GT.0.125D0) KFLSP=2 - IF(RAGR.GT.0.625D0) KFLSP=3 - IF(PYR(0).GT.0.5D0) KFLSP=-KFLSP - KFLCH=-KFLSP - ENDIF - -C...Subdivide Reggeon or Pomeron. - ELSEIF(KFA.EQ.110.OR.KFA.EQ.990) THEN - IF(KFLIN.EQ.21) THEN - KFLSP=KFS*21 - ELSE - KFLSP=-KFLIN - ENDIF - -C...Subdivide meson. - ELSEIF(KFL(1).EQ.0) THEN - KFL(2)=KFL(2)*(-1)**KFL(2) - KFL(3)=-KFL(3)*(-1)**IABS(KFL(2)) - IF(KFLR.EQ.KFL(2)) THEN - KFLSP=KFL(3) - ELSEIF(KFLR.EQ.KFL(3)) THEN - KFLSP=KFL(2) - ELSEIF(KFLR.EQ.21.AND.PYR(0).GT.0.5D0) THEN - KFLSP=KFL(2) - KFLCH=KFL(3) - ELSEIF(KFLR.EQ.21) THEN - KFLSP=KFL(3) - KFLCH=KFL(2) - ELSEIF(KFLR*KFL(2).GT.0) THEN - NTRY=0 - 100 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(2),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 100 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(3) - ELSE - NTRY=0 - 110 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(3),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 110 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(2) - ENDIF - -C...Subdivide baryon. - ELSE - NAGR=0 - DO 120 J=1,3 - IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1 - 120 CONTINUE - IF(NAGR.GE.1) THEN - RAGR=0.00001D0+(NAGR-0.00002D0)*PYR(0) - IAGR=0 - DO 130 J=1,3 - IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1D0 - IF(IAGR.EQ.0.AND.RAGR.LE.0D0) IAGR=J - 130 CONTINUE - ELSE - IAGR=1.00001D0+2.99998D0*PYR(0) - ENDIF - ID1=1 - IF(IAGR.EQ.1) ID1=2 - IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3 - ID2=6-IAGR-ID1 - KSP=3 - IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN - IF(IAGR.NE.3.AND.PYR(0).GT.0.25D0) KSP=1 - ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN - IF(IAGR.NE.1.AND.PYR(0).GT.0.25D0) KSP=1 - ELSEIF(MOD(KFA,10).EQ.2) THEN - IF(IAGR.EQ.1) KSP=1 - IF(IAGR.NE.1.AND.PYR(0).GT.0.75D0) KSP=1 - ENDIF - KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP - IF(KFLR.EQ.21) THEN - KFLCH=KFL(IAGR) - ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN - NTRY=0 - 140 NTRY=NTRY+1 - CALL PYKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 140 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - ELSEIF(NAGR.EQ.0) THEN - NTRY=0 - 150 NTRY=NTRY+1 - CALL PYKFDI(10000*KFL(ID1)+KFLSP,-KFLR,KFDUMP,KFLCH) - IF(KFLCH.EQ.0.AND.NTRY.LT.100) THEN - GOTO 150 - ELSEIF(KFLCH.EQ.0) THEN - CALL PYERRM(14,'(PYSPLI:) caught in infinite loop') - MINT(51)=1 - RETURN - ENDIF - KFLSP=KFL(IAGR) - ENDIF - ENDIF - -C...Add on correct sign for result. - KFLCH=KFLCH*KFS - KFLSP=KFLSP*KFS - - RETURN - END - -C********************************************************************* - -C...PYSSPA -C...Generates spacelike parton showers. - - SUBROUTINE PYSSPA(IPU1,IPU2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT3/ -C...Local arrays and data. - DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVCSV(2),TEVESV(2), - &XFS(2,-25:25),XFA(-25:25),XFB(-25:25),XFN(-25:25),WTAPC(-25:25), - &WTAPE(-25:25),WTSF(-25:25),THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4), - &DPB(4),ROBO(5),MORE(2),KFBEAM(2),Q2MNCS(2),KCFI(2),NFIS(2), - &THEFIS(2,2),ISFI(2),DPHI(2),MCESV(2) - DATA IS/2*0/ - -C...Read out basic information; set global Q^2 scale. - IPUS1=IPU1 - IPUS2=IPU2 - ISUB=MINT(1) - Q2MX=VINT(56) - IF(ISET(ISUB).EQ.2) Q2MX=MIN(VINT(2),PARP(67)*VINT(56)) - FCQ2MX=1D0 - -C...Define which processes ME corrections have been implemented for. - MECOR=0 - IF(MSTP(68).EQ.1) THEN - IF(ISUB.EQ.1.OR.ISUB.EQ.2.OR.ISUB.EQ.141.OR.ISUB.EQ.142.OR. - & ISUB.EQ.144) MECOR=1 - IF(ISUB.EQ.102.OR.ISUB.EQ.152.OR.ISUB.EQ.157) MECOR=2 - ENDIF - -C...Initialize QCD evolution and check phase space. - Q2MNC=PARP(62)**2 - Q2MNCS(1)=Q2MNC - Q2MNCS(2)=Q2MNC - IF(MINT(107).EQ.2.AND.MSTP(66).EQ.2) THEN - Q0S=PARP(15)**2 - PS=VINT(3)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - Q2MNCS(1)=MAX(Q2MNC,Q2INT) - ELSEIF(MINT(107).EQ.3.AND.MSTP(66).GE.1) THEN - Q2MNCS(1)=MAX(Q2MNC,VINT(283)) - ENDIF - IF(MINT(108).EQ.2.AND.MSTP(66).EQ.2) THEN - Q0S=PARP(15)**2 - PS=VINT(4)**2 - Q2EFF=VINT(54)*((Q0S+PS)/(VINT(54)+PS))* - & EXP(PS*(VINT(54)-Q0S)/((VINT(54)+PS)*(Q0S+PS))) - Q2INT=SQRT(Q0S*Q2EFF) - Q2MNCS(2)=MAX(Q2MNC,Q2INT) - ELSEIF(MINT(108).EQ.3.AND.MSTP(66).GE.1) THEN - Q2MNCS(2)=MAX(Q2MNC,VINT(284)) - ENDIF - MCEV=0 - ALAMS=PARU(112) - PARU(112)=PARP(61) - FQ2C=1D0 - TCMX=0D0 - IF(MINT(47).GE.2.AND.(MINT(47).LT.5.OR.MSTP(12).GE.1)) THEN - MCEV=1 - IF(MSTP(64).EQ.1) FQ2C=PARP(63) - IF(MSTP(64).EQ.2) FQ2C=PARP(64) - TCMX=LOG(FQ2C*Q2MX/PARP(61)**2) - IF(Q2MX.LT.MAX(Q2MNC,2D0*PARP(61)**2).OR.TCMX.LT.0.2D0) - & MCEV=0 - ENDIF - -C...Initialize QED evolution and check phase space. - MEEV=0 - XEE=1D-10 - SPME=PMAS(11,1)**2 - IF(IABS(MINT(11)).EQ.13.OR.IABS(MINT(12)).EQ.13) - &SPME=PMAS(13,1)**2 - IF(IABS(MINT(11)).EQ.15.OR.IABS(MINT(12)).EQ.15) - &SPME=PMAS(15,1)**2 - Q2MNE=MAX(PARP(68)**2,2D0*SPME) - TEMX=0D0 - FWTE=10D0 - IF(MINT(45).EQ.3.OR.MINT(46).EQ.3) THEN - MEEV=1 - TEMX=LOG(Q2MX/SPME) - IF(Q2MX.LE.Q2MNE.OR.TEMX.LT.0.2D0) MEEV=0 - ENDIF - IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0) THEN - MEEV=2 - TEMX=TCMX - FWTE=1D0 - ENDIF - IF(MCEV.EQ.0.AND.MEEV.EQ.0) RETURN - -C...Loopback point in case of failure to reconstruct kinematics. - NS=N - LOOP=0 - 100 LOOP=LOOP+1 - IF(LOOP.GT.100) THEN - MINT(51)=1 - RETURN - ENDIF - N=NS - -C...Initial values: flavours, momenta, virtualities. - DO 120 JT=1,2 - MORE(JT)=1 - KFBEAM(JT)=MINT(10+JT) - IF(MINT(18+JT).EQ.1)KFBEAM(JT)=22 - KFLS(JT)=MINT(14+JT) - KFLS(JT+2)=KFLS(JT) - XS(JT)=VINT(40+JT) - IF(MINT(18+JT).EQ.1) XS(JT)=VINT(40+JT)/VINT(154+JT) - ZS(JT)=1D0 - Q2S(JT)=FCQ2MX*Q2MX - DQ2(JT)=0D0 - TEVCSV(JT)=TCMX - ALAM(JT)=PARP(61) - THE2(JT)=1D0 - TEVESV(JT)=TEMX - MCESV(JT)=0 -C...Calculate initial parton distribution weights. - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(XS(JT).LT.1D0-XEE) THEN - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XS(JT),Q2S(JT),XFB) - ELSE - CALL PYPDFL(KFBEAM(JT),XS(JT),Q2S(JT),XFB) - ENDIF - ENDIF - DO 110 KFL=-25,25 - XFS(JT,KFL)=XFB(KFL) - 110 CONTINUE -C...Special kinematics check for c/b quarks (that g -> c cbar or -C...b bbar kinematically possible). - KFLCB=IABS(KFLS(JT)) - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5)) THEN - IF(XS(JT).GT.0.9D0*Q2S(JT)/(PMAS(KFLCB,1)**2+Q2S(JT))) THEN - MINT(51)=1 - RETURN - ENDIF - ENDIF - 120 CONTINUE - DSH=VINT(44) - IF(ISET(ISUB).GE.3.AND.ISET(ISUB).LE.5) DSH=VINT(26)*VINT(2) - -C...Find if interference with final state partons. - MFIS=0 - IF(MSTP(67).GE.1.AND.MSTP(67).LE.3) MFIS=MSTP(67) - IF(MFIS.NE.0) THEN - DO 140 I=1,2 - KCFI(I)=0 - KCA=PYCOMP(IABS(KFLS(I))) - IF(KCA.NE.0) KCFI(I)=KCHG(KCA,2)*ISIGN(1,KFLS(I)) - NFIS(I)=0 - IF(KCFI(I).NE.0) THEN - IF(I.EQ.1) IPFS=IPUS1 - IF(I.EQ.2) IPFS=IPUS2 - DO 130 J=1,2 - ICSI=MOD(K(IPFS,3+J),MSTU(5)) - IF(ICSI.GT.0.AND.ICSI.NE.IPUS1.AND.ICSI.NE.IPUS2.AND. - & (KCFI(I).EQ.(-1)**(J+1).OR.KCFI(I).EQ.2)) THEN - NFIS(I)=NFIS(I)+1 - THEFIS(I,NFIS(I))=PYANGL(P(ICSI,3),SQRT(P(ICSI,1)**2+ - & P(ICSI,2)**2)) - IF(I.EQ.2) THEFIS(I,NFIS(I))=PARU(1)-THEFIS(I,NFIS(I)) - ENDIF - 130 CONTINUE - ENDIF - 140 CONTINUE - IF(NFIS(1)+NFIS(2).EQ.0) MFIS=0 - ENDIF - -C...Pick up leg with highest virtuality. - JTOLD=1 - 150 N=N+1 - JT=1 - IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 - IF(N.EQ.NS+2.AND.JT.EQ.JTOLD) JT=3-JT - IF(MORE(JT).EQ.0) JT=3-JT - JTOLD=JT - KFLB=KFLS(JT) - XB=XS(JT) - DO 160 KFL=-25,25 - XFB(KFL)=XFS(JT,KFL) - 160 CONTINUE - DSHR=2D0*SQRT(DSH) - DSHZ=DSH/ZS(JT) - -C...Check if allowed to branch. - MCEV=0 - IF(IABS(KFLB).LE.10.OR.KFLB.EQ.21) THEN - MCEV=1 - XEC=MAX(PARP(65)*DSHR/VINT(2),XB*(1D0/(1D0-PARP(66))-1D0)) - IF(XB.GE.1D0-2D0*XEC) MCEV=0 - ENDIF - MEEV=0 - IF(MINT(44+JT).EQ.3) THEN - MEEV=1 - IF(XB.GE.1D0-2D0*XEE) MEEV=0 - IF((IABS(KFLB).LE.10.OR.KFLB.EQ.21).AND.XB.GE.1D0-2D0*XEC) - & MEEV=0 -C***Currently kill QED shower for resolved photoproduction. - IF(MINT(18+JT).EQ.1) MEEV=0 -C***Currently kill shower for W inside electron. - IF(IABS(KFLB).EQ.24) THEN - MCEV=0 - MEEV=0 - ENDIF - ENDIF - IF(MSTP(61).GE.2.AND.MCEV.EQ.1.AND.MEEV.EQ.0.AND.IABS(KFLB).LE.10) - &MEEV=2 - IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN - Q2B=0D0 - GOTO 260 - ENDIF - -C...Maximum Q2 with or without Q2 ordering. Effective Lambda and n_f. - Q2B=Q2S(JT) - TEVCB=TEVCSV(JT) - TEVEB=TEVESV(JT) - IF(MSTP(62).LE.1) THEN - IF(ZS(JT).GT.0.99999D0) THEN - Q2B=Q2S(JT) - ELSE - Q2B=0.5D0*(1D0/ZS(JT)+1D0)*Q2S(JT)+0.5D0*(1D0/ZS(JT)-1D0)* - & (Q2S(3-JT)-DSH+SQRT((DSH+Q2S(1)+Q2S(2))**2+ - & 8D0*Q2S(1)*Q2S(2)*ZS(JT)/(1D0-ZS(JT)))) - ENDIF - IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) - ENDIF - IF(MCEV.EQ.1) THEN - ALSDUM=PYALPS(FQ2C*Q2B) - TEVCB=TEVCB+2D0*LOG(ALAM(JT)/PARU(117)) - ALAM(JT)=PARU(117) - B0=(33D0-2D0*MSTU(118))/6D0 - ENDIF - IF(MEEV.EQ.2) TEVEB=TEVCB - TEVCBS=TEVCB - TEVEBS=TEVEB - -C...Select side for interference with final state partons. - IF(MFIS.GE.1.AND.N.LE.NS+2) THEN - IFI=N-NS - ISFI(IFI)=0 - IF(IABS(KCFI(IFI)).EQ.1.AND.NFIS(IFI).EQ.1) THEN - ISFI(IFI)=1 - ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.1) THEN - IF(PYR(0).GT.0.5D0) ISFI(IFI)=1 - ELSEIF(KCFI(IFI).EQ.2.AND.NFIS(IFI).EQ.2) THEN - ISFI(IFI)=1 - IF(PYR(0).GT.0.5D0) ISFI(IFI)=2 - ENDIF - ENDIF - -C...Calculate preweighting factor for ME-corrected processes. - IF(MECOR.GE.1) CALL PYMEMX(MECOR,WTFF,WTGF,WTFG,WTGG) - -C...Calculate Altarelli-Parisi weights. - DO 170 KFL=-25,25 - WTAPC(KFL)=0D0 - WTAPE(KFL)=0D0 - WTSF(KFL)=0D0 - 170 CONTINUE -C...q -> q (g or gamma emission), g -> q. - IF(IABS(KFLB).LE.10) THEN - WTAPC(KFLB)=(8D0/3D0)*LOG((1D0-XEC-XB)*(XB+XEC)/(XEC*(1D0-XEC))) - WTAPC(21)=0.5D0*(XB/(XB+XEC)-XB/(1D0-XEC)) - EQ2=1D0/9D0 - IF(MOD(IABS(KFLB),2).EQ.0) EQ2=4D0*EQ2 - IF(MEEV.EQ.2) WTAPE(KFLB)=2.*EQ2*LOG((1D0-XEC-XB)*(XB+XEC)/ - & (XEC*(1D0-XEC))) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPC(KFLB)=WTFF*WTAPC(KFLB) - WTAPC(21)=WTGF*WTAPC(21) - WTAPE(KFLB)=WTFF*WTAPE(KFLB) - ENDIF -C...f -> f, gamma -> f. - ELSEIF(IABS(KFLB).LE.20) THEN - WTAPF1=LOG((1D0-XEE-XB)*(XB+XEE)/(XEE*(1D0-XEE))) - WTAPF2=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE))) - WTAPE(KFLB)=2D0*(WTAPF1+WTAPF2) - IF(MSTP(12).GE.1) WTAPE(22)=XB/(XB+XEE)-XB/(1D0-XEE) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPE(KFLB)=WTFF*WTAPE(KFLB) - WTAPE(22)=WTGF*WTAPE(22) - ENDIF -C...f -> g, g -> g. - ELSEIF(KFLB.EQ.21) THEN - WTAPQ=(16D0/3D0)*(SQRT((1D0-XEC)/XB)-SQRT((XB+XEC)/XB)) - DO 180 KFL=1,MSTP(58) - WTAPC(KFL)=WTAPQ - WTAPC(-KFL)=WTAPQ - 180 CONTINUE - WTAPC(21)=6D0*LOG((1D0-XEC-XB)/XEC) - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - DO 190 KFL=1,MSTP(58) - WTAPC(KFL)=WTFG*WTAPC(KFL) - WTAPC(-KFL)=WTFG*WTAPC(-KFL) - 190 CONTINUE - WTAPC(21)=WTGG*WTAPC(21) - ENDIF -C...f -> gamma, W+, W-. - ELSEIF(KFLB.EQ.22) THEN - WTAPF=LOG((1D0-XEE-XB)*(1D0-XEE)/(XEE*(XB+XEE)))/XB - WTAPE(11)=WTAPF - WTAPE(-11)=WTAPF - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - WTAPE(11)=WTFG*WTAPE(11) - WTAPE(-11)=WTFG*WTAPE(-11) - ENDIF - ELSEIF(KFLB.EQ.24) THEN - WTAPE(-11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ - & (XEE*(XB+XEE)))/XB - ELSEIF(KFLB.EQ.-24) THEN - WTAPE(11)=1D0/(4D0*PARU(102))*LOG((1D0-XEE-XB)*(1D0-XEE)/ - & (XEE*(XB+XEE)))/XB - ENDIF - -C...Calculate parton distribution weights and sum. - NTRY=0 - 200 NTRY=NTRY+1 - IF(NTRY.GT.500) THEN - MINT(51)=1 - RETURN - ENDIF - WTSUMC=0D0 - WTSUME=0D0 - XFBO=MAX(1D-10,XFB(KFLB)) - DO 210 KFL=-25,25 - WTSF(KFL)=XFB(KFL)/XFBO - WTSUMC=WTSUMC+WTAPC(KFL)*WTSF(KFL) - WTSUME=WTSUME+WTAPE(KFL)*WTSF(KFL) - 210 CONTINUE - WTSUMC=MAX(0.0001D0,WTSUMC) - WTSUME=MAX(0.0001D0/FWTE,WTSUME) - -C...Choose new t: fix alpha_s, alpha_s(Q^2), alpha_s(k_T^2). - NTRY2=0 - 220 NTRY2=NTRY2+1 - IF(NTRY2.GT.500) THEN - MINT(51)=1 - RETURN - ENDIF - IF(MCEV.EQ.1) THEN - IF(MSTP(64).LE.0) THEN - TEVCB=TEVCB+LOG(PYR(0))*PARU(2)/(PARU(111)*WTSUMC) - ELSEIF(MSTP(64).EQ.1) THEN - TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/WTSUMC)) - ELSE - TEVCB=TEVCB*EXP(MAX(-50D0,LOG(PYR(0))*B0/(5D0*WTSUMC))) - ENDIF - ENDIF - IF(MEEV.EQ.1) THEN - TEVEB=TEVEB*EXP(MAX(-50D0,LOG(PYR(0))*PARU(2)/ - & (PARU(101)*FWTE*WTSUME*TEMX))) - ELSEIF(MEEV.EQ.2) THEN - TEVEB=TEVEB+LOG(PYR(0))*PARU(2)/(PARU(101)*WTSUME) - ENDIF - -C...Translate t into Q2 scale; choose between QCD and QED evolution. - 230 IF(MCEV.EQ.1) Q2CB=ALAM(JT)**2*EXP(MAX(-50D0,TEVCB))/FQ2C - IF(MEEV.EQ.1) Q2EB=SPME*EXP(MAX(-50D0,TEVEB)) - IF(MEEV.EQ.2) Q2EB=ALAM(JT)**2*EXP(MAX(-50D0,TEVEB))/FQ2C -C...Ensure that Q2 is above threshold for charm/bottom. - KFLCB=IABS(KFLB) - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. - &MCEV.EQ.1) THEN - IF(Q2CB.LT.PMAS(KFLCB,1)**2) THEN - Q2CB=1.1D0*PMAS(KFLCB,1)**2 - TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - FCQ2MX=MIN(2D0,1.05D0*FCQ2MX) - ENDIF - ENDIF - IF(KFBEAM(JT).NE.22.AND.(KFLCB.EQ.4.OR.KFLCB.EQ.5).AND. - &MEEV.EQ.2) THEN - IF(Q2EB.LT.PMAS(KFLCB,1)**2) MEEV=0 - ENDIF - MCE=0 - IF(MCEV.EQ.0.AND.MEEV.EQ.0) THEN - ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.0) THEN - IF(Q2CB.GT.Q2MNCS(JT)) MCE=1 - ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.1) THEN - IF(Q2EB.GT.Q2MNE) MCE=2 - ELSEIF(MCEV.EQ.0.AND.MEEV.EQ.2) THEN - IF(Q2EB.GT.Q2MNCS(JT)) MCE=2 - ELSEIF(MCEV.EQ.1.AND.MEEV.EQ.2) THEN - IF(Q2CB.GT.Q2EB.AND.Q2CB.GT.Q2MNCS(JT)) MCE=1 - IF(Q2EB.GT.Q2CB.AND.Q2EB.GT.Q2MNCS(JT)) MCE=2 - ELSEIF(Q2MNCS(JT).GT.Q2MNE) THEN - MCE=1 - IF(Q2EB.GT.Q2CB.OR.Q2CB.LE.Q2MNCS(JT)) MCE=2 - IF(MCE.EQ.2.AND.Q2EB.LE.Q2MNE) MCE=0 - ELSE - MCE=2 - IF(Q2CB.GT.Q2EB.OR.Q2EB.LE.Q2MNE) MCE=1 - IF(MCE.EQ.1.AND.Q2CB.LE.Q2MNCS(JT)) MCE=0 - ENDIF - -C...Evolution possibly ended. Update t values. - IF(MCE.EQ.0) THEN - Q2B=0D0 - GOTO 260 - ELSEIF(MCE.EQ.1) THEN - Q2B=Q2CB - Q2REF=FQ2C*Q2B - IF(MEEV.EQ.1) TEVEB=LOG(Q2B/SPME) - IF(MEEV.EQ.2) TEVEB=LOG(FQ2C*Q2B/ALAM(JT)**2) - ELSE - Q2B=Q2EB - Q2REF=Q2B - IF(MCEV.EQ.1) TEVCB=LOG(FQ2C*Q2B/ALAM(JT)**2) - ENDIF - -C...Select flavour for branching parton. - IF(MCE.EQ.1) WTRAN=PYR(0)*WTSUMC - IF(MCE.EQ.2) WTRAN=PYR(0)*WTSUME - KFLA=-25 - 240 KFLA=KFLA+1 - IF(MCE.EQ.1) WTRAN=WTRAN-WTAPC(KFLA)*WTSF(KFLA) - IF(MCE.EQ.2) WTRAN=WTRAN-WTAPE(KFLA)*WTSF(KFLA) - IF(KFLA.LE.24.AND.WTRAN.GT.0D0) GOTO 240 - IF(KFLA.EQ.25) THEN - Q2B=0D0 - GOTO 260 - ENDIF - -C...Choose z value and corrective weight. - WTZ=0D0 -C...q -> q + g or q -> q + gamma. - IF(IABS(KFLA).LE.10.AND.IABS(KFLB).LE.10) THEN - Z=1D0-((1D0-XB-XEC)/(1D0-XEC))* - & (XEC*(1D0-XEC)/((XB+XEC)*(1D0-XB-XEC)))**PYR(0) - WTZ=0.5D0*(1D0+Z**2) -C...q -> g + q. - ELSEIF(IABS(KFLA).LE.10.AND.KFLB.EQ.21) THEN - Z=XB/(SQRT(XB+XEC)+PYR(0)*(SQRT(1D0-XEC)-SQRT(XB+XEC)))**2 - WTZ=0.5D0*(1D0+(1D0-Z)**2)*SQRT(Z) -C...f -> f + gamma. - ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN - IF(WTAPF1.GT.PYR(0)*(WTAPF1+WTAPF2)) THEN - Z=1D0-((1D0-XB-XEE)/(1D0-XEE))* - & (XEE*(1D0-XEE)/((XB+XEE)*(1D0-XB-XEE)))**PYR(0) - ELSE - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - ENDIF - WTZ=0.5D0*(1D0+Z**2)*(Z-XB)/(1D0-XB) -C...f -> gamma + f. - ELSEIF(IABS(KFLA).LE.20.AND.KFLB.EQ.22) THEN - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - WTZ=0.5D0*(1D0+(1D0-Z)**2)*XB*(Z-XB)/Z -C...f -> W+- + f. - ELSEIF(IABS(KFLA).LE.20.AND.IABS(KFLB).EQ.24) THEN - Z=XB+XB*(XEE/(1D0-XEE))* - & ((1D0-XB-XEE)*(1D0-XEE)/(XEE*(XB+XEE)))**PYR(0) - WTZ=0.5D0*(1D0+(1D0-Z)**2)*(XB*(Z-XB)/Z)* - & (Q2B/(Q2B+PMAS(24,1)**2)) -C...g -> q + qbar. - ELSEIF(KFLA.EQ.21.AND.IABS(KFLB).LE.10) THEN - Z=XB/(1D0-XEC)+PYR(0)*(XB/(XB+XEC)-XB/(1D0-XEC)) - WTZ=1D0-2D0*Z*(1D0-Z) -C...g -> g + g. - ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN - Z=1D0/(1D0+((1D0-XEC-XB)/XB)*(XEC/(1D0-XEC-XB))**PYR(0)) - WTZ=(1D0-Z*(1D0-Z))**2 -C...gamma -> f + fbar. - ELSEIF(KFLA.EQ.22.AND.IABS(KFLB).LE.20) THEN - Z=XB/(1D0-XEE)+PYR(0)*(XB/(XB+XEE)-XB/(1D0-XEE)) - WTZ=1D0-2D0*Z*(1D0-Z) - ENDIF - IF(MCE.EQ.2.AND.MEEV.EQ.1) WTZ=(WTZ/FWTE)*(TEVEB/TEMX) - -C...Option with resummation of soft gluon emission as effective z shift. - IF(MCE.EQ.1) THEN - IF(MSTP(65).GE.1) THEN - RSOFT=6D0 - IF(KFLB.NE.21) RSOFT=8D0/3D0 - Z=Z*(TEVCB/TEVCSV(JT))**(RSOFT*XEC/((XB+XEC)*B0)) - IF(Z.LE.XB) GOTO 220 - ENDIF - -C...Option with alpha_s(k_T^2): demand k_T^2 > cutoff, reweight. - IF(MSTP(64).GE.2) THEN - IF((1D0-Z)*Q2B.LT.Q2MNCS(JT)) GOTO 220 - ALPRAT=TEVCB/(TEVCB+LOG(1D0-Z)) - IF(ALPRAT.LT.5D0*PYR(0)) GOTO 220 - IF(ALPRAT.GT.5D0) WTZ=WTZ*ALPRAT/5D0 - ENDIF - ENDIF - -C...Remove kinematically impossible branchings. - UHAT=Q2B-DSH*(1D0-Z)/Z - IF(MSTP(68).GE.0.AND.UHAT.GT.0D0) GOTO 220 - -C...Select phi angle of branching at random. - PHIBR=PARU(2)*PYR(0) - -C...Matrix-element corrections for some processes. - IF(MECOR.GE.1.AND.(N.EQ.NS+1.OR.N.EQ.NS+2)) THEN - IF(IABS(KFLA).LE.20.AND.IABS(KFLB).LE.20) THEN - CALL PYMEWT(MECOR,1,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTFF - ELSEIF((KFLA.EQ.21.OR.KFLA.EQ.22).AND.IABS(KFLB).LE.20) THEN - CALL PYMEWT(MECOR,2,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTGF - ELSEIF(IABS(KFLA).LE.20.AND.(KFLB.EQ.21.OR.KFLB.EQ.22)) THEN - CALL PYMEWT(MECOR,3,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTFG - ELSEIF(KFLA.EQ.21.AND.KFLB.EQ.21) THEN - CALL PYMEWT(MECOR,4,Q2B,Z,PHIBR,WTME) - WTZ=WTZ*WTME/WTGG - ENDIF - ENDIF - -C...Impose angular constraint in first branching from interference -C...with final state partons. - IF(MCE.EQ.1) THEN - IF(MFIS.GE.1.AND.N.LE.NS+2.AND.NTRY2.LT.200) THEN - THE2D=(4D0*Q2B)/(DSH*(1D0-Z)) - IF(N.EQ.NS+1.AND.ISFI(1).GE.1) THEN - IF(THE2D.GT.THEFIS(1,ISFI(1))**2) GOTO 220 - ELSEIF(N.EQ.NS+2.AND.ISFI(2).GE.1) THEN - IF(THE2D.GT.THEFIS(2,ISFI(2))**2) GOTO 220 - ENDIF - ENDIF - -C...Option with angular ordering requirement. - IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THEN - THE2T=(4D0*Z**2*Q2B)/(4D0*Z**2*Q2B+(1D0-Z)*XB**2*VINT(2)) - IF(THE2T.GT.THE2(JT)) GOTO 220 - ENDIF - ENDIF - -C...Weighting with new parton distributions. - MINT(105)=MINT(102+JT) - MINT(109)=MINT(106+JT) - VINT(120)=VINT(2+JT) - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XB,Q2REF,XFN) - ELSE - CALL PYPDFL(KFBEAM(JT),XB,Q2REF,XFN) - ENDIF - XFBN=XFN(KFLB) - IF(XFBN.LT.1D-20) THEN - IF(KFLA.EQ.KFLB) THEN - TEVCB=TEVCBS - TEVEB=TEVEBS - WTAPC(KFLB)=0D0 - WTAPE(KFLB)=0D0 - GOTO 200 - ELSEIF(MCE.EQ.1.AND.TEVCBS-TEVCB.GT.0.2D0) THEN - TEVCB=0.5D0*(TEVCBS+TEVCB) - GOTO 230 - ELSEIF(MCE.EQ.2.AND.TEVEBS-TEVEB.GT.0.2D0) THEN - TEVEB=0.5D0*(TEVEBS+TEVEB) - GOTO 230 - ELSE - XFBN=1D-10 - XFN(KFLB)=XFBN - ENDIF - ENDIF - DO 250 KFL=-25,25 - XFB(KFL)=XFN(KFL) - 250 CONTINUE - XA=XB/Z - IF(MSTP(57).LE.1) THEN - CALL PYPDFU(KFBEAM(JT),XA,Q2REF,XFA) - ELSE - CALL PYPDFL(KFBEAM(JT),XA,Q2REF,XFA) - ENDIF - XFAN=XFA(KFLA) - IF(XFAN.LT.1D-20) GOTO 200 - WTSFA=WTSF(KFLA) - IF(WTZ*XFAN/XFBN.LT.PYR(0)*WTSFA) GOTO 200 - -C...Define two hard scatterers in their CM-frame. - 260 IF(N.EQ.NS+2) THEN - DQ2(JT)=Q2B - DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR - DO 280 JR=1,2 - I=NS+JR - IF(JR.EQ.1) IPO=IPUS1 - IF(JR.EQ.2) IPO=IPUS2 - DO 270 J=1,5 - K(I,J)=0 - P(I,J)=0D0 - V(I,J)=0D0 - 270 CONTINUE - K(I,1)=14 - K(I,2)=KFLS(JR+2) - K(I,4)=IPO - K(I,5)=IPO - P(I,3)=DPLCM*(-1)**(JR+1) - P(I,4)=(DSH+DQ2(3-JR)-DQ2(JR))/DSHR - P(I,5)=-SQRT(DQ2(JR)) - K(IPO,1)=14 - K(IPO,3)=I - K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I - K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I - 280 CONTINUE - -C...Find maximum allowed mass of timelike parton. - ELSEIF(N.GT.NS+2) THEN - JR=3-JT - DQ2(3)=Q2B - DPC(1)=P(IS(1),4) - DPC(2)=P(IS(2),4) - DPC(3)=0.5D0*(ABS(P(IS(1),3))+ABS(P(IS(2),3))) - DPD(1)=DSH+DQ2(JR)+DQ2(JT) - DPD(2)=DSHZ+DQ2(JR)+DQ2(3) - DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT)) - DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3)) - IKIN=0 - IF(Q2S(JR).GE.0.25D0*Q2MNC.AND.DPD(1)-DPD(3).GE. - & 1D-10*DPD(1)) IKIN=1 - IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/ZS(JT)-DQ2(3))* - & (DSH/(DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3))) - IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/ - & (2D0*DQ2(JR))-DQ2(JT)-DQ2(3) - -C...Generate timelike parton shower (if required). - IT=N - DO 290 J=1,5 - K(IT,J)=0 - P(IT,J)=0D0 - V(IT,J)=0D0 - 290 CONTINUE -C...f -> f + g (gamma). - IF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).LE.20) THEN - K(IT,2)=21 - IF(MCESV(JT).EQ.2.OR.IABS(KFLB).GE.11) K(IT,2)=22 -C...f -> g (gamma, W+-) + f. - ELSEIF(IABS(KFLB).LE.20.AND.IABS(KFLS(JT+2)).GT.20) THEN - K(IT,2)=KFLB - IF(KFLS(JT+2).EQ.24) THEN - K(IT,2)=-12 - ELSEIF(KFLS(JT+2).EQ.-24) THEN - K(IT,2)=12 - ENDIF -C...g (gamma) -> f + fbar, g + g. - ELSE - K(IT,2)=-KFLS(JT+2) - IF(KFLS(JT+2).GT.20) K(IT,2)=KFLS(JT+2) - ENDIF - K(IT,1)=3 - IF((IABS(K(IT,2)).GE.11.AND.IABS(K(IT,2)).LE.18).OR. - & IABS(K(IT,2)).EQ.22) K(IT,1)=1 - P(IT,5)=PYMASS(K(IT,2)) - IF(DMSMA.LE.P(IT,5)**2) GOTO 100 - IF(MSTP(63).GE.1.AND.MCESV(JT).EQ.1) THEN - MSTJ48=MSTJ(48) - PARJ85=PARJ(85) - P(IT,4)=(DSHZ-DSH-P(IT,5)**2)/DSHR - P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2) - IF(MSTP(63).EQ.1) THEN - Q2TIM=DMSMA - ELSEIF(MSTP(63).EQ.2) THEN - Q2TIM=MIN(DMSMA,PARP(71)*Q2S(JT)) - ELSE - Q2TIM=DMSMA - MSTJ(48)=1 - IF(IKIN.EQ.0) DPT2=DMSMA*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) - IF(IKIN.EQ.1) DPT2=DMSMA*(0.5D0*DPD(1)*DPD(2)+0.5D0*DPD(3)* - & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)))/(4D0*DSH*DPC(3)**2) - PARJ(85)=SQRT(MAX(0D0,DPT2))* - & (1D0/P(IT,4)+1D0/P(IS(JT),4)) - ENDIF - CALL PYSHOW(IT,0,SQRT(Q2TIM)) - MSTJ(48)=MSTJ48 - PARJ(85)=PARJ85 - IF(N.GE.IT+1) P(IT,5)=P(IT+1,5) - ENDIF - -C...Reconstruct kinematics of branching: timelike parton shower. - DMS=P(IT,5)**2 - IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) - IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5D0*DPD(1)*DPD(2)+ - & 0.5D0*DPD(3)*DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/ - & (4D0*DSH*DPC(3)**2) - IF(DPT2.LT.0D0) GOTO 100 - DPB(1)=(0.5D0*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/ - & DSHR)/DPC(3)-DPC(3) - P(IT,1)=SQRT(DPT2) - P(IT,3)=DPB(1)*(-1)**(JT+1) - P(IT,4)=SQRT(DPT2+DPB(1)**2+DMS) - IF(N.GE.IT+1) THEN - DPB(1)=SQRT(DPB(1)**2+DPT2) - DPB(2)=SQRT(DPB(1)**2+DMS) - DPB(3)=P(IT+1,3) - DPB(4)=SQRT(DPB(3)**2+DMS) - DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)* - & DPB(1)) - CALL PYROBO(IT+1,N,0D0,0D0,0D0,0D0,DBEZ) - THE=PYANGL(P(IT,3),P(IT,1)) - CALL PYROBO(IT+1,N,THE,0D0,0D0,0D0,0D0) - ENDIF - -C...Reconstruct kinematics of branching: spacelike parton. - DO 300 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 300 CONTINUE - K(N+1,1)=14 - K(N+1,2)=KFLB - P(N+1,1)=P(IT,1) - P(N+1,3)=P(IT,3)+P(IS(JT),3) - P(N+1,4)=P(IT,4)+P(IS(JT),4) - P(N+1,5)=-SQRT(DQ2(3)) - -C...Define colour flow of branching. - K(IS(JT),3)=N+1 - K(IT,3)=N+1 - IM1=N+1 - IM2=N+1 -C...f -> f + gamma (Z, W). - IF(IABS(K(IT,2)).GE.22) THEN - K(IT,1)=1 - ID1=IS(JT) - ID2=IS(JT) -C...f -> gamma (Z, W) + f. - ELSEIF(IABS(K(IS(JT),2)).GE.22) THEN - ID1=IT - ID2=IT -C...gamma -> q + qbar, g + g. - ELSEIF(K(N+1,2).EQ.22) THEN - ID1=IS(JT) - ID2=IT - IM1=ID2 - IM2=ID1 -C...q -> q + g. - ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(IT,2).EQ.21) THEN - ID1=IT - ID2=IS(JT) -C...q -> g + q. - ELSEIF(K(N+1,2).GT.0.AND.K(N+1,2).NE.21) THEN - ID1=IS(JT) - ID2=IT -C...qbar -> qbar + g. - ELSEIF(K(N+1,2).LT.0.AND.K(IT,2).EQ.21) THEN - ID1=IS(JT) - ID2=IT -C...qbar -> g + qbar. - ELSEIF(K(N+1,2).LT.0) THEN - ID1=IT - ID2=IS(JT) -C...g -> g + g; g -> q + qbar. - ELSEIF((K(IT,2).EQ.21.AND.PYR(0).GT.0.5D0).OR.K(IT,2).LT.0) THEN - ID1=IS(JT) - ID2=IT - ELSE - ID1=IT - ID2=IS(JT) - ENDIF - IF(IM1.EQ.N+1) K(IM1,4)=K(IM1,4)+ID1 - IF(IM2.EQ.N+1) K(IM2,5)=K(IM2,5)+ID2 - K(ID1,4)=K(ID1,4)+MSTU(5)*IM1 - K(ID2,5)=K(ID2,5)+MSTU(5)*IM2 - IF(ID1.NE.ID2) THEN - K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 - K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 - ENDIF - N=N+1 - IF(K(IT,1).EQ.1) THEN - K(IT,4)=0 - K(IT,5)=0 - ENDIF - -C...Boost to new CM-frame. - DBSVX=(P(N,1)+P(IS(JR),1))/(P(N,4)+P(IS(JR),4)) - DBSVZ=(P(N,3)+P(IS(JR),3))/(P(N,4)+P(IS(JR),4)) - IF(DBSVX**2+DBSVZ**2.GE.1D0) GOTO 100 - CALL PYROBO(NS+1,N,0D0,0D0,-DBSVX,0D0,-DBSVZ) - IR=N+(JT-1)*(IS(1)-N) - CALL PYROBO(NS+1,N,-PYANGL(P(IR,3),P(IR,1)),DPHI(JT), - & 0D0,0D0,0D0) - ENDIF - -C...Update kinematics variables. - IS(JT)=N - DQ2(JT)=Q2B - IF(MSTP(62).GE.3.AND.NTRY2.LT.200) THE2(JT)=THE2T - DSH=DSHZ - -C...Save quantities; loop back. - Q2S(JT)=Q2B - DPHI(JT)=PHIBR - MCESV(JT)=MCE - IF((MCEV.EQ.1.AND.Q2B.GE.0.25D0*Q2MNC).OR. - &(MEEV.EQ.1.AND.Q2B.GE.Q2MNE)) THEN - KFLS(JT+2)=KFLS(JT) - KFLS(JT)=KFLA - XS(JT)=XA - ZS(JT)=Z - DO 310 KFL=-25,25 - XFS(JT,KFL)=XFA(KFL) - 310 CONTINUE - TEVCSV(JT)=TEVCB - TEVESV(JT)=TEVEB - ELSE - MORE(JT)=0 - IF(JT.EQ.1) IPU1=N - IF(JT.EQ.2) IPU2=N - ENDIF - IF(N.GT.MSTU(4)-MSTU(32)-10) THEN - CALL PYERRM(11,'(PYSSPA:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) N=NS - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MORE(1).EQ.1.OR.MORE(2).EQ.1) GOTO 150 - -C...Boost hard scattering partons to frame of shower initiators. - DO 320 J=1,3 - ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) - 320 CONTINUE - K(N+2,1)=1 - DO 330 J=1,5 - P(N+2,J)=P(NS+1,J) - 330 CONTINUE - CALL PYROBO(N+2,N+2,0D0,0D0,-ROBO(3),-ROBO(4),-ROBO(5)) - ROBO(2)=PYANGL(P(N+2,1),P(N+2,2)) - ROBO(1)=PYANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) - CALL PYROBO(MINT(83)+5,NS,0D0,-ROBO(2),0D0,0D0,0D0) - CALL PYROBO(MINT(83)+5,NS,ROBO(1),ROBO(2),ROBO(3),ROBO(4), - &ROBO(5)) - -C...Store user information. Reset Lambda value. - K(IPU1,3)=MINT(83)+3 - K(IPU2,3)=MINT(83)+4 - DO 340 JT=1,2 - MINT(12+JT)=KFLS(JT) - VINT(140+JT)=XS(JT) - IF(MINT(18+JT).EQ.1) VINT(140+JT)=VINT(154+JT)*XS(JT) - 340 CONTINUE - PARU(112)=ALAMS - - RETURN - END - -C*********************************************************************** - -C...PYSTAT -C...Prints out information about cross-sections, decay widths, branching -C...ratios, kinematical limits, status codes and parameter values. - - SUBROUTINE PYSTAT(MSTAT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - PARAMETER (EPS=1D-3) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT6/PROC(0:500) - CHARACTER PROC*28, CHTMP*16 - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT2/,/PYINT4/,/PYINT5/,/PYINT6/,/PYMSSM/,/PYMSRV/ -C...Local arrays, character variables and data. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),NMODES(0:20),PBRAT(10) - CHARACTER PROGA(6)*28,CHAU*16,CHKF*16,CHD1*16,CHD2*16,CHD3*16, - &CHIN(2)*12,STATE(-1:5)*4,CHKIN(21)*18,DISGA(2)*28, - &PROGG9(13)*28,PROGG4(4)*28,PROGG2(2)*28,PROGP4(4)*28 - CHARACTER*24 CHD0, CHDC(10) - CHARACTER*6 DNAME(3) - DATA PROGA/ - &'VMD/hadron * VMD ','VMD/hadron * direct ', - &'VMD/hadron * anomalous ','direct * direct ', - &'direct * anomalous ','anomalous * anomalous '/ - DATA DISGA/'e * VMD','e * anomalous'/ - DATA PROGG9/ - &'direct * direct ','direct * VMD ', - &'direct * anomalous ','VMD * direct ', - &'VMD * VMD ','VMD * anomalous ', - &'anomalous * direct ','anomalous * VMD ', - &'anomalous * anomalous ','DIS * VMD ', - &'DIS * anomalous ','VMD * DIS ', - &'anomalous * DIS '/ - DATA PROGG4/ - &'direct * direct ','direct * resolved ', - &'resolved * direct ','resolved * resolved '/ - DATA PROGG2/ - &'direct * hadron ','resolved * hadron '/ - DATA PROGP4/ - &'VMD * hadron ','direct * hadron ', - &'anomalous * hadron ','DIS * hadron '/ - DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/, - &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ', - &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ', - &' y*_small ',' eta*_large ',' eta*_small ', - &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ', - &' x_2 ',' x_F ',' cos(theta_hard) ', - &'m''_hard (GeV/c^2) ',' tau ',' y* ', - &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ', - &' tau'' '/ - DATA DNAME /'q ','lepton','nu '/ - -C...Cross-sections. - IF(MSTAT.LE.1) THEN - IF(MINT(121).GT.1) CALL PYSAVE(5,0) - WRITE(MSTU(11),5000) - WRITE(MSTU(11),5100) - WRITE(MSTU(11),5200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3) - DO 100 I=1,500 - IF(MSUB(I).NE.1) GOTO 100 - WRITE(MSTU(11),5200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3) - 100 CONTINUE - IF(MINT(121).GT.1) THEN - WRITE(MSTU(11),5300) - DO 110 IGA=1,MINT(121) - CALL PYSAVE(3,IGA) - IF(MINT(121).EQ.2.AND.MSTP(14).EQ.10) THEN - WRITE(MSTU(11),5200) IGA,DISGA(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.9.OR.MINT(121).EQ.13) THEN - WRITE(MSTU(11),5200) IGA,PROGG9(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.4.AND.MSTP(14).EQ.30) THEN - WRITE(MSTU(11),5200) IGA,PROGP4(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.4) THEN - WRITE(MSTU(11),5200) IGA,PROGG4(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSEIF(MINT(121).EQ.2) THEN - WRITE(MSTU(11),5200) IGA,PROGG2(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ELSE - WRITE(MSTU(11),5200) IGA,PROGA(IGA),NGEN(0,3),NGEN(0,1), - & XSEC(0,3) - ENDIF - 110 CONTINUE - CALL PYSAVE(5,0) - ENDIF - WRITE(MSTU(11),5400) 1D0-DBLE(NGEN(0,3))/ - & MAX(1D0,DBLE(NGEN(0,2))) - -C...Decay widths and branching ratios. - ELSEIF(MSTAT.EQ.2) THEN - WRITE(MSTU(11),5500) - WRITE(MSTU(11),5600) - DO 140 KC=1,500 - KF=KCHG(KC,4) - CALL PYNAME(KF,CHKF) - IOFF=0 - IF(KC.LE.22) THEN - IF(KC.GT.2*MSTP(1).AND.KC.LE.10) GOTO 140 - IF(KC.GT.10+2*MSTP(1).AND.KC.LE.20) GOTO 140 - IF(KC.LE.5.OR.(KC.GE.11.AND.KC.LE.16)) IOFF=1 - IF(KC.EQ.18.AND.PMAS(18,1).LT.1D0) IOFF=1 - IF(KC.EQ.21.OR.KC.EQ.22) IOFF=1 - ELSE - IF(MWID(KC).LE.0) GOTO 140 - IF(IMSS(1).LE.0.AND.(KF/KSUSY1.EQ.1.OR. - & KF/KSUSY1.EQ.2)) GOTO 140 - ENDIF -C...Off-shell branchings. - IF(IOFF.EQ.1) THEN - NGP=0 - IF(KC.LE.20) NGP=(MOD(KC,10)+1)/2 - IF(NGP.LE.MSTP(1)) WRITE(MSTU(11),5700) KF,CHKF(1:10), - & PMAS(KC,1),0D0,0D0,STATE(MDCY(KC,1)),0D0 - DO 120 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - NGP1=0 - IF(IABS(KFDP(IDC,1)).LE.20) NGP1= - & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 - NGP2=0 - IF(IABS(KFDP(IDC,2)).LE.20) NGP2= - & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 - CALL PYNAME(KFDP(IDC,1),CHD1) - CALL PYNAME(KFDP(IDC,2),CHD2) - IF(KFDP(IDC,3).EQ.0) THEN - IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. - & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5800) IDC,CHD1(1:10), - & CHD2(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 - ELSE - CALL PYNAME(KFDP(IDC,3),CHD3) - IF(MDME(IDC,2).EQ.102.AND.NGP1.LE.MSTP(1).AND. - & NGP2.LE.MSTP(1)) WRITE(MSTU(11),5900) IDC,CHD1(1:10), - & CHD2(1:10),CHD3(1:10),0D0,0D0,STATE(MDME(IDC,1)),0D0 - ENDIF - 120 CONTINUE -C...On-shell decays. - ELSE - CALL PYWIDT(KF,PMAS(KC,1)**2,WDTP,WDTE) - BRFIN=1D0 - IF(WDTE(0,0).LE.0D0) BRFIN=0D0 - WRITE(MSTU(11),5700) KF,CHKF(1:10),PMAS(KC,1),WDTP(0),1D0, - & STATE(MDCY(KC,1)),BRFIN - DO 130 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - NGP1=0 - IF(IABS(KFDP(IDC,1)).LE.20) NGP1= - & (MOD(IABS(KFDP(IDC,1)),10)+1)/2 - NGP2=0 - IF(IABS(KFDP(IDC,2)).LE.20) NGP2= - & (MOD(IABS(KFDP(IDC,2)),10)+1)/2 - BRPRI=0D0 - IF(WDTP(0).GT.0D0) BRPRI=WDTP(J)/WDTP(0) - BRFIN=0D0 - IF(WDTE(0,0).GT.0D0) BRFIN=WDTE(J,0)/WDTE(0,0) - CALL PYNAME(KFDP(IDC,1),CHD1) - CALL PYNAME(KFDP(IDC,2),CHD2) - IF(KFDP(IDC,3).EQ.0) THEN - IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) - & WRITE(MSTU(11),5800) IDC,CHD1(1:10), - & CHD2(1:10),WDTP(J),BRPRI, - & STATE(MDME(IDC,1)),BRFIN - ELSE - CALL PYNAME(KFDP(IDC,3),CHD3) - IF(NGP1.LE.MSTP(1).AND.NGP2.LE.MSTP(1)) - & WRITE(MSTU(11),5900) IDC,CHD1(1:10), - & CHD2(1:10),CHD3(1:10),WDTP(J),BRPRI, - & STATE(MDME(IDC,1)),BRFIN - ENDIF - 130 CONTINUE - ENDIF - 140 CONTINUE - WRITE(MSTU(11),6000) - -C...Allowed incoming partons/particles at hard interaction. - ELSEIF(MSTAT.EQ.3) THEN - WRITE(MSTU(11),6100) - CALL PYNAME(MINT(11),CHAU) - CHIN(1)=CHAU(1:12) - CALL PYNAME(MINT(12),CHAU) - CHIN(2)=CHAU(1:12) - WRITE(MSTU(11),6200) CHIN(1),CHIN(2) - DO 150 I=-20,22 - IF(I.EQ.0) GOTO 150 - IA=IABS(I) - IF(IA.GT.MSTP(58).AND.IA.LE.10) GOTO 150 - IF(IA.GT.10+2*MSTP(1).AND.IA.LE.20) GOTO 150 - CALL PYNAME(I,CHAU) - WRITE(MSTU(11),6300) CHAU,STATE(KFIN(1,I)),CHAU, - & STATE(KFIN(2,I)) - 150 CONTINUE - WRITE(MSTU(11),6400) - -C...User-defined limits on kinematical variables. - ELSEIF(MSTAT.EQ.4) THEN - WRITE(MSTU(11),6500) - WRITE(MSTU(11),6600) - SHRMAX=CKIN(2) - IF(SHRMAX.LT.0D0) SHRMAX=VINT(1) - WRITE(MSTU(11),6700) CKIN(1),CHKIN(1),SHRMAX - PTHMIN=MAX(CKIN(3),CKIN(5)) - PTHMAX=CKIN(4) - IF(PTHMAX.LT.0D0) PTHMAX=0.5D0*SHRMAX - WRITE(MSTU(11),6800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX - WRITE(MSTU(11),6900) CHKIN(3),CKIN(6) - DO 160 I=4,14 - WRITE(MSTU(11),6700) CKIN(2*I-1),CHKIN(I),CKIN(2*I) - 160 CONTINUE - SPRMAX=CKIN(32) - IF(SPRMAX.LT.0D0) SPRMAX=VINT(1) - WRITE(MSTU(11),6700) CKIN(31),CHKIN(15),SPRMAX - WRITE(MSTU(11),7000) - -C...Status codes and parameter values. - ELSEIF(MSTAT.EQ.5) THEN - WRITE(MSTU(11),7100) - WRITE(MSTU(11),7200) - DO 170 I=1,100 - WRITE(MSTU(11),7300) I,MSTP(I),PARP(I),100+I,MSTP(100+I), - & PARP(100+I) - 170 CONTINUE - -C...List of all processes implemented in the program. - ELSEIF(MSTAT.EQ.6) THEN - WRITE(MSTU(11),7400) - WRITE(MSTU(11),7500) - DO 180 I=1,500 - IF(ISET(I).LT.0) GOTO 180 - WRITE(MSTU(11),7600) I,PROC(I),ISET(I),KFPR(I,1),KFPR(I,2) - 180 CONTINUE - WRITE(MSTU(11),7700) - - ELSEIF(MSTAT.EQ.7) THEN - WRITE (MSTU(11),8000) - NMODES(0)=0 - NMODES(10)=0 - NMODES(9)=0 - DO 290 ILR=1,2 - DO 280 KFSM=1,16 - KFSUSY=ILR*KSUSY1+KFSM - NRVDC=0 -C...SDOWN DECAYS - IF (KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5) THEN - NRVDC=3 - DO 190 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 190 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(1) - CHDC(2)=DNAME(2) // ' + ' // DNAME(1) - CHDC(3)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 200 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 200 CONTINUE - ENDIF -C...SUP DECAYS - IF (KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6) THEN - NRVDC=2 - DO 210 I=1,NRVDC - NMODES(I)=0 - PBRAT(I)=0D0 - 210 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(2) // ' + ' // DNAME(1) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 220 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 220 CONTINUE - ENDIF -C...SLEPTON DECAYS - IF (KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15) THEN - NRVDC=2 - DO 230 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 230 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(2) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 240 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 240 CONTINUE - ENDIF -C...SNEUTRINO DECAYS - IF ((KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16).AND.ILR.EQ.1) - & THEN - NRVDC=2 - DO 250 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 250 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(2) // ' + ' // DNAME(2) - CHDC(2)=DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 260 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - IF (KFDP(IDC,3).EQ.0) THEN - IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5)) THEN - NMODES(2)=NMODES(2)+1 - PBRAT(2)=PBRAT(2)+BRAT(IDC) - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - ENDIF - 260 CONTINUE - ENDIF - IF (NRVDC.NE.0) THEN - DO 270 I=1,NRVDC - WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) - NMODES(0)=NMODES(0)+NMODES(I) - 270 CONTINUE - ENDIF - 280 CONTINUE - 290 CONTINUE - DO 370 KFSM=21,37 - KFSUSY=KSUSY1+KFSM - NRVDC=0 -C...NEUTRALINO DECAYS - IF (KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN - NRVDC=4 - DO 300 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 300 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(2) // ' + ' // DNAME(2) - CHDC(2)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(3)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(4)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 310 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.11.OR - & .ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 310 CONTINUE - ENDIF -C...CHARGINO DECAYS - IF (KFSM.EQ.24.OR.KFSM.EQ.37) THEN - NRVDC=5 - DO 320 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 320 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(3) // ' + ' // DNAME(2) - CHDC(2)=DNAME(2) // ' + ' // DNAME(2) // ' + ' // DNAME(2) - CHDC(3)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(4)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(5)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 330 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ.12.OR - & .ID3.EQ.14.OR.ID3.EQ.16)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.12.OR.ID2.EQ.14.OR.ID2.EQ.16).AND.(ID3.EQ - & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.11.OR.ID2.EQ.13.OR.ID2.EQ.15).AND.(ID3.EQ - & .11.OR.ID3.EQ.13.OR.ID3.EQ.15)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .2.OR.ID3.EQ.4.OR.ID3.EQ.6)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(4)=PBRAT(4)+BRAT(IDC) - NMODES(4)=NMODES(4)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(5)=PBRAT(5)+BRAT(IDC) - NMODES(5)=NMODES(5)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.1.OR.ID1.EQ.3.OR.ID1.EQ.5).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ - & .1.OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(5)=PBRAT(5)+BRAT(IDC) - NMODES(5)=NMODES(5)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 330 CONTINUE - ENDIF -C...GLUINO DECAYS - IF (KFSM.EQ.21) THEN - NRVDC=3 - DO 340 I=1,NRVDC - PBRAT(I)=0D0 - NMODES(I)=0 - 340 CONTINUE - CALL PYNAME(KFSUSY,CHTMP) - CHD0=CHTMP//' ' - CHDC(1)=DNAME(3) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(2)=DNAME(2) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - CHDC(3)=DNAME(1) // ' + ' // DNAME(1) // ' + ' // DNAME(1) - KC=PYCOMP(KFSUSY) - DO 350 J=1,MDCY(KC,3) - IDC=J+MDCY(KC,2)-1 - ID1=IABS(KFDP(IDC,1)) - ID2=IABS(KFDP(IDC,2)) - ID3=IABS(KFDP(IDC,3)) - IF ((ID1.EQ.12.OR.ID1.EQ.14.OR.ID1.EQ.16).AND.(ID2 - & .EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1.OR - & .ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(1)=PBRAT(1)+BRAT(IDC) - NMODES(1)=NMODES(1)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.11.OR.ID1.EQ.13.OR.ID1.EQ.15).AND - & .(ID2.EQ.2.OR.ID2.EQ.4.OR.ID2.EQ.6).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(2)=PBRAT(2)+BRAT(IDC) - NMODES(2)=NMODES(2)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ELSE IF ((ID1.EQ.2.OR.ID1.EQ.4.OR.ID1.EQ.6).AND - & .(ID2.EQ.1.OR.ID2.EQ.3.OR.ID2.EQ.5).AND.(ID3.EQ.1 - & .OR.ID3.EQ.3.OR.ID3.EQ.5)) THEN - PBRAT(3)=PBRAT(3)+BRAT(IDC) - NMODES(3)=NMODES(3)+1 - IF (BRAT(IDC).GT.0D0) NMODES(10)=NMODES(10)+1 - IF (BRAT(IDC).GT.EPS) NMODES(9)=NMODES(9)+1 - ENDIF - 350 CONTINUE - ENDIF - - IF (NRVDC.NE.0) THEN - DO 360 I=1,NRVDC - WRITE (MSTU(11),8200) CHD0, CHDC(I), PBRAT(I), NMODES(I) - NMODES(0)=NMODES(0)+NMODES(I) - 360 CONTINUE - ENDIF - 370 CONTINUE - WRITE (MSTU(11),8100) NMODES(0), NMODES(10), NMODES(9) - - IF (IMSS(51).GE.1.OR.IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN - WRITE (MSTU(11),8500) - DO 400 IRV=1,3 - DO 390 JRV=1,3 - DO 380 KRV=1,3 - WRITE (MSTU(11),8700) IRV,JRV,KRV,RVLAM(IRV,JRV,KRV) - & ,RVLAMP(IRV,JRV,KRV),RVLAMB(IRV,JRV,KRV) - 380 CONTINUE - 390 CONTINUE - 400 CONTINUE - WRITE (MSTU(11),8600) - ENDIF - ENDIF - -C...Formats for printouts. - 5000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ', - &'Events and Cross-sections',1X,9('*')) - 5100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X, - &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X, - &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'), - &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X, - &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X, - &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X, - &'I',12X,'I') - 5200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P, - &D10.3,1X,'I') - 5300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/ - &1X,'I',34X,'I',28X,'I',12X,'I') - 5400 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')// - &1X,'********* Fraction of events that fail fragmentation ', - &'cuts =',1X,F8.5,' *********'/) - 5500 FORMAT('1',27('*'),1X,'PYSTAT: Decay Widths and Branching ', - &'Ratios',1X,27('*')) - 5600 FORMAT(/1X,98('=')/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ - &1X,'I',5X,'Mother --> Branching/Decay Channel',8X,'I',1X, - &'Width (GeV)',1X,'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X, - &'Eff. B.R.',1X,'I'/1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/ - &1X,98('=')) - 5700 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X, - &I8,2X,A10,3X,'(m =',F10.3,')',2X,'-->',5X,'I',2X,1P,D10.3,0P,1X, - &'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,D10.3,0P,1X,'I') - 5800 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,15X,'I',2X, - &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, - &1P,D10.3,0P,1X,'I') - 5900 FORMAT(1X,'I',1X,I8,2X,A10,1X,'+',1X,A10,1X,'+',1X,A10,2X,'I',2X, - &1P,D10.3,0P,1X,'I',1X,1P,D10.3,0P,1X,'I',1X,A4,1X,'I',1X, - &1P,D10.3,0P,1X,'I') - 6000 FORMAT(1X,'I',49X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,98('=')) - 6100 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/', - &'Particles at Hard Interaction',1X,7('*')) - 6200 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X, - &'Beam particle:',1X,A12,10X,'I',1X,'Target particle:',1X,A12,7X, - &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',6X,'State',19X, - &'I',1X,'Content',6X,'State',18X,'I'/1X,'I',38X,'I',37X,'I'/1X, - &78('=')/1X,'I',38X,'I',37X,'I') - 6300 FORMAT(1X,'I',1X,A9,5X,A4,19X,'I',1X,A9,5X,A4,18X,'I') - 6400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('=')) - 6500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ', - &'Kinematical Variables',1X,12('*')) - 6600 FORMAT(/1X,78('=')/1X,'I',76X,'I') - 6700 FORMAT(1X,'I',16X,1P,D10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,D10.3,0P, - &16X,'I') - 6800 FORMAT(1X,'I',3X,1P,D10.3,0P,1X,'(',1P,D10.3,0P,')',1X,'<',1X,A, - &1X,'<',1X,1P,D10.3,0P,16X,'I') - 6900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,D10.3,0P,16X,'I') - 7000 FORMAT(1X,'I',76X,'I'/1X,78('=')) - 7100 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ', - &'Parameter Values',1X,12('*')) - 7200 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X, - &'PARP(I)'/) - 7300 FORMAT(1X,I3,5X,I6,6X,1P,D10.3,0P,18X,I3,5X,I6,6X,1P,D10.3) - 7400 FORMAT('1',13('*'),1X,'PYSTAT: List of implemented processes', - &1X,13('*')) - 7500 FORMAT(/1X,65('=')/1X,'I',34X,'I',28X,'I'/1X,'I',12X, - &'Subprocess',12X,'I',1X,'ISET',2X,'KFPR(I,1)',2X,'KFPR(I,2)',1X, - &'I'/1X,'I',34X,'I',28X,'I'/1X,65('=')/1X,'I',34X,'I',28X,'I') - 7600 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I4,1X,I10,1X,I10,1X,'I') - 7700 FORMAT(1X,'I',34X,'I',28X,'I'/1X,65('=')) - 8000 FORMAT(1X/ 1X/ - & 17X,'Sums over R-Violating branching ratios',1X/ 1X - & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I'/1X,'I',4X - & ,'Mother --> Sum over final state flavours',4X,'I',2X - & ,'BR(sum)',2X,'I',2X,'N',2X,'I'/1X,'I',50X,'I',11X,'I',5X,'I' - & /1X,70('=')/1X,'I',50X,'I',11X,'I',5X,'I') - 8100 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I'/1X,70('=')/1X,'I',1X - & ,'Total number of R-Violating modes :',3X,I5,24X,'I'/ - & 1X,'I',1X,'Total number with non-vanishing BR :',2X,I5,24X - & ,'I'/1X,'I',1X,'Total number with BR > 0.001 :',8X,I5,24X,'I' - & /1X,70('=')) - 8200 FORMAT(1X,'I',1X,A9,1X,'-->',1X,A24,11X, - & 'I',2X,1P,D8.2,0P,1X,'I',2X,I2,1X,'I') - 8300 FORMAT(1X,'I',50X,'I',11X,'I',5X,'I') - 8500 FORMAT(1X/ 1X/ - & 1X,'R-Violating couplings',1X/ 1X / - & 1X,55('=')/ - & 1X,'I',1X,'IJK',1X,'I',2X,'LAMBDA(IJK)',2X,'I',2X - & ,'LAMBDA''(IJK)',1X,'I',1X,"LAMBDA''(IJK)",1X,'I'/1X,'I',5X - & ,'I',15X,'I',15X,'I',15X,'I') - 8600 FORMAT(1X,55('=')) - 8700 FORMAT(1X,'I',1X,I1,I1,I1,1X,'I',1X,1P,D13.3,0P,1X,'I',1X,1P - & ,D13.3,0P,1X,'I',1X,1P,D13.3,0P,1X,'I') - - RETURN - END - -C********************************************************************* - -C...PYSTBH (and auxiliaries) -C.. Evaluates the matrix elements for t + b + H production. - - SUBROUTINE PYSTBH(WTTBH) - -C...DOUBLE PRECISION AND INTEGER DECLARATIONS - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...COMMONBLOCKS - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) - COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSGCM/ISUB,ISUBSV,MMIN1,MMAX1,MMIN2,MMAX2,MMINA,MMAXA, - &KFAC(2,-40:40),COMFAC,FACK,FACA,SH,TH,UH,SH2,TH2,UH2,SQM3,SQM4, - &SHR,SQPTH,TAUP,BE34,CTH,SQMZ,SQMW,GMMZ,GMMW, - &AEM,AS,XW,XW1,XWC,XWV,POLL,POLR,POLLL,POLRR - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - DOUBLE PRECISION MW2 - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/, - &/PYINT4/,/PYSUBS/,/PYMSSM/,/PYSGCM/,/PYCTBH/ - -C...LOCAL ARRAYS AND COMPLEX VARIABLES - DIMENSION QQ(4,2),PP(4,3) - DATA QQ/8*0D0/ - -C...MASS PARAMETERS. - WTQQBH=0D0 - ISUB=MINT(1) - SHPR=SQRT(VINT(26))*VINT(1) - PH=SQRT(VINT(21))*VINT(1) - SPH=PH**2 - RMB=PYMRUN(5,VINT(44)) - -C...SET UP OUTGOING KINEMATICS: 1=T, 2=TBAR, 3=H. - DO 100 I=1,2 - PT=SQRT(MAX(0D0,VINT(197+5*I))) - PP(1,I)=PT*COS(VINT(198+5*I)) - PP(2,I)=PT*SIN(VINT(198+5*I)) - 100 CONTINUE - PP(1,3)=-PP(1,1)-PP(1,2) - PP(2,3)=-PP(2,1)-PP(2,2) - PMS1=VINT(201)**2+PP(1,1)**2+PP(2,1)**2 - PMS2=VINT(206)**2+PP(1,2)**2+PP(2,2)**2 - PMS3=SPH+PP(1,3)**2+PP(2,3)**2 - PMT3=SQRT(PMS3) - PP(3,3)=PMT3*SINH(VINT(211)) - PP(4,3)=PMT3*COSH(VINT(211)) - PMS12=(SHPR-PP(4,3))**2-PP(3,3)**2 - PP(3,1)=(-PP(3,3)*(PMS12+PMS1-PMS2)+ - &VINT(213)*(SHPR-PP(4,3))*VINT(220))/(2D0*PMS12) - PP(3,2)=-PP(3,1)-PP(3,3) - PP(4,1)=SQRT(PMS1+PP(3,1)**2) - PP(4,2)=SQRT(PMS2+PP(3,2)**2) - -C...CM SYSTEM, INGOING QUARKS - QQ(3,1) = SHPR/2.D0 - QQ(4,1) = QQ(3,1) - QQ(3,2) = -QQ(3,1) - QQ(4,2) = QQ(4,1) - -C...PARAMETERS FOR AMPLITUDE METHOD - ALPHA = PYALEM(VINT(54)) - ALPHAS = PYALPS(VINT(54)) - - SW2 = PARU(102) - MW2 = PMAS(24,1)**2 - TANB = PARU(141) - VTB = VCKM(3,3) - - IF (ISUB.EQ.401) THEN - CALL PYTBHG(QQ(1,1),QQ(1,2),PP(1,1),PP(1,2),PP(1,3), - & VINT(201),VINT(206),RMB,VINT(43),WTTBH) - ELSE IF (ISUB.EQ.402) THEN - CALL PYTBHQ(QQ(1,1),QQ(1,2),PP(1,1),PP(1,2),PP(1,3), - & VINT(201),VINT(206),RMB,VINT(43),WTTBH) - END IF - - RETURN - END - -C********************************************************************* - -C...PYSTRF -C...Handles the fragmentation of an arbitrary colour singlet -C...jet system according to the Lund string fragmentation model. - - SUBROUTINE PYSTRF(IP) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. All MOPS variables ends with MO - 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(6),PJU(5,5), - &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8), - &INMO(9),PM2QMO(2),XTMO(2),EJSTR(2),IJUORI(2),IBARRK(2), - &PBST(3,5),TJUOLD(5) - -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. - 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 - NTRYFN=0 - IJUORI(1)=0 - IJUORI(2)=0 - -C...Identify parton system. - I=IP-1 - 110 I=I+1 - IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN - CALL PYERRM(12,'(PYSTRF:) 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=PYCOMP(K(I,2)) - IF(KC.EQ.0) GOTO 110 - KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) - IF(KQ.EQ.0.AND.K(I,1).NE.41) GOTO 110 - IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - 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(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) - K(N+NP,3)=I - IF(KQ.NE.2) KQSUM=KQSUM+KQ - IF(K(I,1).EQ.41) THEN - IF(MOD(KQSUM,2).EQ.0.AND.MJU(1).EQ.0) THEN - MJU(1)=N+NP - IJUORI(1)=I - ELSE - MJU(2)=N+NP - IJUORI(2)=I - ENDIF - ENDIF - IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 - IF(MOD(KQSUM,3).NE.0) THEN - CALL PYERRM(12,'(PYSTRF:) unphysical flavour combination') - IF(MSTU(21).GE.1) RETURN - ENDIF - IF(MJU(1).GT.0.OR.MJU(2).GT.0) MSTU(29)=1 - -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 PYROBO(N+1,N+NP,0D0,0D0,-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.0D0) THEN - HHPEZ=MAX(1D-10,(P(I,4)+P(I,3))/HHBZ) - P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=MAX(1D-10,(P(I,4)-P(I,3))*HHBZ) - P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 130 CONTINUE - ENDIF - -C...Search for very nearby partons that may be recombined. - NTRYR=0 - NTRYWR=0 - PARU12=PARU(12) - PARU13=PARU(13) - MJU(3)=MJU(1) - MJU(4)=MJU(2) - NR=NP - 140 IF(NR.GE.3) THEN - PDRMIN=2D0*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=4D0*(PAP-PVP)**2/MAX(1D-6,PARU13**2*PAP+2D0*(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(0D0,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(0D0,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- - & P(IR,3)**2)) - IF(MJU(2).NE.0.AND.IR.GT.MJU(2)) K(IR,2)=K(IR+1,2) - DO 190 I=IR+1,N+NR-1 - K(I,1)=K(I+1,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.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) 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 640 - IF(MSTJ(12).GE.4) CALL PYERRM(29,'(PYSTRF:) sorry,'// - & ' junction strings not handled by MSTJ(12)>3 options') - DO 630 JT=1,2 - NJS(JT)=0 - IF(MJU(JT).EQ.0) GOTO 630 - JS=3-2*JT - -C++SKANDS -C...Find and sum up momentum on three sides of junction. -C...Begin with previous boost = zero. - IJRFIT=0 - DO 210 IX=1,3 - TJUOLD(IX)=0D0 - 210 CONTINUE - TJUOLD(4)=1D0 - 220 IU=0 -C...Beginning and end of string system in event record. - I1BEG=N+1+(JT-1)*(NR-1) - I1END=N+NR+(JT-1)*(1-NR) -C...Look for junction string piece end points - DO 230 I1=I1BEG,I1END,JS - IF(K(I1,2).NE.21.AND.IU.LE.5.AND.IJRFIT.EQ.0) THEN -C...Store junction string piece end points. -C 1-junction systems 2-junction systems -C IU : 1 2 3 4 1 2 3 4 5 6 -C IJU(IU): q-g-g-q-g-g-j-g-q q-g-g-q-g-j-g-g-j-g-q-g-g-q - IU=IU+1 - IJU(IU)=I1 - ENDIF -C...Sum over momenta, from junction outwards. - 230 CONTINUE - DO 280 IU=1,3 - PWT=0D0 -C...Initialize junction drag and string piece 4-vectors. - DO 240 J=1,5 - PBST(IU,J)=0D0 - PJU(IU,J)=0D0 - 240 CONTINUE -C...First two branches. Inwards out means opposite direction to JS. -C...(JS is 1 for JT=1, -1 for JT=2) - IF (IU.LT.3) THEN - I1A=IJU(IU+1)-JS - I1B=IJU(IU) - IDIR=-JS -C...Last branch (gq or gjgqgq). Direction now reversed. - ELSE - I1A=IJU(IU)+JS - I1B=I1END - IDIR=JS - ENDIF - DO 270 I1=I1A,I1B,IDIR -C...Sum up momentum directions with exponential suppression -C...for use in finding junction rest frame below. - IF (K(I1,2).EQ.88) THEN -C...gjgqgq type system encountered. Use current PWT as start -C...for both strings. - PWTOLD=PWT - ELSE - IF (I1.EQ.IJU(5)+IDIR) PWT=PWTOLD -C...Sum up string piece (boosted) 4-momenta. - DO 250 J=1,4 - PJU(IU,J)=PJU(IU,J)+P(I1,J) - 250 CONTINUE -C...Compute "junction drag" vectors from (boosted) 4-momenta (initial -C...boost is zero, see above). Skip parton if suppression factor large. - IF (PWT.GT.10D0) GOTO 270 -C...Compute momentum in current frame: - TDP=TJUOLD(1)*P(I1,1)+TJUOLD(2)*P(I1,2)+TJUOLD(3)*P(I1,3) - BFC=TDP/(1D0+TJUOLD(4))+P(I1,4) - DO 260 J=1,3 - PTMP=P(I1,J)+TJUOLD(J)*BFC - PBST(IU,J)=PBST(IU,J)+PTMP*EXP(-PWT) - 260 CONTINUE -C...Boosted energy - PTMP=TJUOLD(4)*P(I1,4)+TDP - PBST(IU,4)=PBST(IU,J)+PTMP*EXP(-PWT) - PWT=PWT+PTMP/PARJ(48) - ENDIF - 270 CONTINUE -C...Put |p| rather than m in 5th slot. - PBST(IU,5)=SQRT(PBST(IU,1)**2+PBST(IU,2)**2+PBST(IU,3)**2) - PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) - 280 CONTINUE - -C...Calculate boost from present frame to next JRF candidate. - IJRFIT=IJRFIT+1 - CALL PYJURF(PBST,TJU) - -C...Combine new boost (TJU) with old boost (TJUOLD) - TMP=TJU(1)*TJUOLD(1)+TJU(2)*TJUOLD(2)+TJU(3)*TJUOLD(3) - DO 290 IX=1,3 - TJUOLD(IX)=TJU(IX)+TJUOLD(IX)*(TMP/(1D0+TJUOLD(4))+TJU(4)) - 290 CONTINUE - TJUOLD(4)=SQRT(1D0+TJUOLD(1)**2+TJUOLD(2)**2+TJUOLD(3)**2) - -C...If last boost small, accept JRF, else iterate. -C...Also prevent possibility of infinite loop. - IF (ABS((TJU(4)-1D0)/TJUOLD(4)).GT.0.01D0.AND. - & IJRFIT.LT.MSTJ(18)) THEN - GOTO 220 - ELSEIF (IJRFIT.GE.MSTJ(18)) THEN - CALL PYERRM(1,'(PYSTRF:) failed to converge on JRF') - ENDIF - -C...Now store total boost in TJU and change perception. -C...TJUOLD = boost vector from CM of string syst -> JRF. Henceforth, -C...TJU = junction motion vector in string CM, so the sign changes. - DO 300 J=1,3 - TJU(J)=-TJUOLD(J) - 300 CONTINUE - TJU(4)=SQRT(1D0+TJU(1)**2+TJU(2)**2+TJU(3)**2) - -C--SKANDS - -C...Calculate string piece energies in junction rest frame. - DO 310 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) - PBST(IU,5)=TJU(4)*PBST(IU,4)-TJU(1)*PBST(IU,1)- - & TJU(2)*PBST(IU,2)-TJU(3)*PBST(IU,3) - 310 CONTINUE - -C...Start preparing for fragmentation of two strings from junction. - ISTA=I - NTRYER=0 - 320 NTRYER=NTRYER+1 - I=ISTA - DO 610 IU=1,2 - NS=IABS(IJU(IU+1)-IJU(IU)) - -C...Junction strings: find longitudinal string directions. - DO 350 IS=1,NS - IS1=IJU(IU)+JS*(IS-1) - IS2=IJU(IU)+JS*IS - DO 330 J=1,5 - DP(1,J)=0.5D0*P(IS1,J) - IF(IS.EQ.1) DP(1,J)=P(IS1,J) - DP(2,J)=0.5D0*P(IS2,J) - IF(IS.EQ.NS) DP(2,J)=(-PBST(IU,J)+2D0*PBST(IU,5)*TJU(J))* - & (PJU(IU,5)/PBST(IU,5)) - 330 CONTINUE - IF(IS.EQ.NS) DP(2,5)=SQRT(MAX(0D0,PJU(IU,4)**2- - & PJU(IU,1)**2-PJU(IU,2)**2-PJU(IU,3)**2)) - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) 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.5D0*((DP(4,5)+DHKC)/DHKS-1D0) - DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) - DO 340 J=1,4 - P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) - 340 CONTINUE - 350 CONTINUE - -C...Junction strings: initialize flavour, momentum and starting pos. - ISAV=I - MSTU91=MSTU(90) - 360 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) 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 380 JQ=1,2 - DO 370 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)=1D0 - 370 CONTINUE - 380 CONTINUE - KFL(1)=K(IJU(IU),2) - PX(1)=0D0 - PY(1)=0D0 - GAM(1)=0D0 - DO 390 J=1,5 - PJU(IU+3,J)=0D0 - 390 CONTINUE - -C...Junction strings: find initial transverse directions. - DO 400 J=1,4 - DP(1,J)=P(IN(4),J) - DP(2,J)=P(IN(4)+1,J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 400 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 410 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)) - 410 CONTINUE - -C...Junction strings: produce new particle, origin. - 420 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - 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. - 430 CALL PYKFDI(KFL(1),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 360 - IF(IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. - & IABS(KFL(3)).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 430 - ENDIF - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(KFL(1),PX(3),PY(3)) - PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 - CALL PYZDIS(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)=(1D0-Z)*(GAM(1)+PR(1)/Z) - DO 440 J=1,3 - IN(J)=IN(3+J) - 440 CONTINUE - -C...Junction strings: stepping within 'low' string region. - 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 450 J=1,4 - P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) - 450 CONTINUE - GOTO 550 -C...Has used up energy of junction string, i.e. no more hadrons in it. - ELSEIF(IN(1)+1.EQ.IN(2).AND.IN(1).EQ.N+NR+4*NS-3) THEN - DO 460 J=1,5 - P(I,J)=0D0 - 460 CONTINUE - GOTO 590 -C...Stepping from 'low' string region - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(2)+2,4)=P(IN(2)+2,3) - P(IN(2)+2,1)=1D0 - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 360 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - ENDIF - ENDIF - -C...Junction strings: find new transverse directions. - 470 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. - & IN(1).GT.IN(2)) GOTO 360 - IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN - DO 480 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 480 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.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - GOTO 470 - 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 490 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)) - 490 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.01D0) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Junction strings: sum up known four-momentum, coefficients for m2. - DO 520 J=1,4 - DHG(J)=0D0 - 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 500 IN1=IN(4),IN(1)-4,4 - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 500 CONTINUE - DO 510 IN2=IN(5),IN(2)-4,4 - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 510 CONTINUE - 520 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2D0*FOUR(I,IN(1)) - DHM(3)=2D0*FOUR(I,IN(2)) - DHM(4)=2D0*FOUR(IN(1),IN(2)) - -C...Junction strings: find coefficients for Gamma expression. - DO 540 IN2=IN(1)+1,IN(2),4 - DO 530 IN1=IN(1),IN2-1,4 - DHC=2D0*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 - 530 CONTINUE - 540 CONTINUE - -C...Junction strings: solve (m2, Gamma) equation system for energies. - DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) - IF(ABS(DHS1).LT.1D-4) GOTO 360 - 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.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ - & ABS(DHS1)-DHS2/DHS1) - IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0D0) GOTO 360 - 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)=1D0 - IN(2)=IN(2)+4 - IF(IN(2).GT.N+NR+4*NS) GOTO 360 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(1)+2,4)=P(IN(1)+2,3) - P(IN(1)+2,1)=0D0 - IN(1)=IN(1)+4 - ENDIF - GOTO 470 - 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)=0D0 - IN(1)=IN(1)+4 - GOTO 470 - ENDIF - -C...Junction strings: particle four-momentum, remainder, loop back. - 550 DO 560 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) - 560 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 360 - 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 570 J=1,4 - P(IN(6),J)=P(IN(3),J) - P(IN(6)+1,J)=P(IN(3)+1,J) - 570 CONTINUE - ENDIF - DO 580 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) - 580 CONTINUE - GOTO 420 - ENDIF - -C...Junction strings: save quantities left after each string. - IF(IABS(KFL(1)).GT.10) GOTO 360 - 590 I=I-1 - KFJH(IU)=KFL(1) - DO 600 J=1,4 - PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) - 600 CONTINUE - -C...Junction strings: loopback if much unused energy in both strings. - 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) - EJSTR(IU)=PJU(IU,5)-PJU(IU+3,5) - 610 CONTINUE - IF((MIN(EJSTR(1),EJSTR(2)).GT.PARJ(49).OR. - & EJSTR(1).GT.PARJ(49)+PYR(0)*PARJ(50).OR. - & EJSTR(2).GT.PARJ(49)+PYR(0)*PARJ(50)) - & .AND.NTRYER.LT.10) GOTO 320 - -C...Junction strings: put together to new effective string endpoint. - NJS(JT)=I-ISTA - KFLS=2*INT(PYR(0)+3D0*PARJ(4)/(1D0+3D0*PARJ(4)))+1 - IF(KFJH(1).EQ.KFJH(2)) KFLS=3 - KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),IABS(KFJH(2)))+ - & 100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+KFLS,KFJH(1)) - DO 620 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) - 620 CONTINUE - PJS(JT,5)=SQRT(MAX(0D0,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- - & PJS(JT,3)**2)) - PJS(JT+2,5)=0D0 - 630 CONTINUE - -C...Open versus closed strings. Choose breakup region for latter. - 640 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=0D0 - DO 650 IS=1,NR - P(N+NR+IS,1)=0.5D0*FOUR(N+IS,N+IS+1-NR*(IS/NR)) - W2SUM=W2SUM+P(N+NR+IS,1) - 650 CONTINUE - W2RAN=PYR(0)*W2SUM - NB=0 - 660 NB=NB+1 - W2SUM=W2SUM-P(N+NR+NB,1) - IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 660 - ENDIF - -C...Find longitudinal string directions (i.e. lightlike four-vectors). - DO 690 IS=1,NS - IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) - IS2=N+IS+NB-NR*((IS+NB-1)/NR) - DO 670 J=1,5 - DP(1,J)=P(IS1,J) - IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5D0*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.5D0*DP(2,J) - IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) - 670 CONTINUE - IF(IS1.EQ.MJU(1)) DP(1,5)=SQRT(MAX(0D0,DP(1,4)**2-DP(1,1)**2- - & DP(1,2)**2-DP(1,3)**2)) - IF(IS2.EQ.MJU(2)) DP(2,5)=SQRT(MAX(0D0,DP(2,4)**2-DP(2,1)**2- - & DP(2,2)**2-DP(2,3)**2)) - DP(3,5)=DFOUR(1,1) - DP(4,5)=DFOUR(2,2) - DHKC=DFOUR(1,2) - IF(DP(3,5)+2D0*DHKC+DP(4,5).LE.0D0) GOTO 200 - DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) - DHK1=0.5D0*((DP(4,5)+DHKC)/DHKS-1D0) - DHK2=0.5D0*((DP(3,5)+DHKC)/DHKS-1D0) - IN1=N+NR+4*IS-3 - P(IN1,5)=SQRT(DP(3,5)+2D0*DHKC+DP(4,5)) - DO 680 J=1,4 - P(IN1,J)=(1D0+DHK1)*DP(1,J)-DHK2*DP(2,J) - P(IN1+1,J)=(1D0+DHK2)*DP(2,J)-DHK1*DP(1,J) - 680 CONTINUE - 690 CONTINUE - -C...Begin initialization: sum up energy, set starting position. - ISAV=I - MSTU91=MSTU(90) - 700 NTRY=NTRY+1 - IF(NTRY.GT.100.AND.NTRYR.LE.8) THEN - PARU12=4D0*PARU12 - PARU13=2D0*PARU13 - GOTO 140 - ELSEIF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYSTRF:) caught in infinite loop') - IF(MSTU(21).GE.1) RETURN - ENDIF - I=ISAV - MSTU(90)=MSTU91 - DO 720 J=1,4 - P(N+NRS,J)=0D0 - DO 710 IS=1,NR - P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) - 710 CONTINUE - 720 CONTINUE - DO 740 JT=1,2 - IRANK(JT)=0 - IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) - IF(NS.GT.NR) IRANK(JT)=1 - IBARRK(JT)=0 - 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 730 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)=1D0 - 730 CONTINUE - 740 CONTINUE - -C.. MOPS variables and switches - NRVMO=0 - XBMO=1D0 - MSTU(121)=0 - MSTU(122)=0 - -C...Initialize flavour and pT variables for open string. - IF(NS.LT.NR) THEN - PX(1)=0D0 - PY(1)=0D0 - IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL PYPTDI(0,PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - DO 750 JT=1,2 - KFL(JT)=K(IE(JT),2) - IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) - IF(MJU(JT).NE.0.AND.IABS(KFL(JT)).GT.1000) IBARRK(JT)=1 - MSTJ(93)=1 - PMQ(JT)=PYMASS(KFL(JT)) - GAM(JT)=0D0 - 750 CONTINUE - -C...Closed string: random initial breakup flavour, pT and vertex. - ELSE - KFL(3)=INT(1D0+(2D0+PARJ(2))*PYR(0))*(-1)**INT(PYR(0)+0.5D0) - IBMO=0 - 760 CALL PYKFDI(KFL(3),0,KFL(1),KDUMP) -C.. Closed string: first vertex diq attempt => enforced second -C.. vertex diq - IF(IABS(KFL(1)).GT.10)THEN - IBMO=1 - MSTU(121)=0 - GOTO 760 - ENDIF - IF(IBMO.EQ.1) MSTU(121)=-1 - KFL(2)=-KFL(1) - CALL PYPTDI(KFL(1),PX(1),PY(1)) - PX(2)=-PX(1) - PY(2)=-PY(1) - PR3=MIN(25D0,0.1D0*P(N+NR+1,5)**2) - 770 CALL PYZDIS(KFL(1),KFL(2),PR3,Z) - ZR=PR3/(Z*P(N+NR+1,5)**2) - IF(ZR.GE.1D0) GOTO 770 - DO 780 JT=1,2 - MSTJ(93)=1 - PMQ(JT)=PYMASS(KFL(JT)) - GAM(JT)=PR3*(1D0-Z)/Z - IN1=N+NR+3+4*(JT/2)*(NS-1) - P(IN1,JT)=1D0-Z - P(IN1,3-JT)=JT-1 - P(IN1,3)=(2-JT)*(1D0-Z)+(JT-1)*Z - P(IN1+1,JT)=ZR - P(IN1+1,3-JT)=2-JT - P(IN1+1,3)=(2-JT)*(1D0-ZR)+(JT-1)*ZR - 780 CONTINUE - ENDIF -C.. MOPS variables - DO 790 JT=1,2 - XTMO(JT)=1D0 - PM2QMO(JT)=PMQ(JT)**2 - IF(IABS(KFL(JT)).GT.10) PM2QMO(JT)=0D0 - 790 CONTINUE - -C...Find initial transverse directions (i.e. spacelike four-vectors). - DO 830 JT=1,2 - IF(JT.EQ.1.OR.NS.EQ.NR-1.OR.MJU(1)+MJU(2).NE.0) THEN - IN1=IN(3*JT+1) - IN3=IN(3*JT+3) - DO 800 J=1,4 - DP(1,J)=P(IN1,J) - DP(2,J)=P(IN1+1,J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 800 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 810 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)) - 810 CONTINUE - ELSE - DO 820 J=1,4 - P(IN3+2,J)=P(IN3,J) - P(IN3+3,J)=P(IN3+1,J) - 820 CONTINUE - ENDIF - 830 CONTINUE - -C...Remove energy used up in junction string fragmentation. - IF(MJU(1)+MJU(2).GT.0) THEN - DO 850 JT=1,2 - IF(NJS(JT).EQ.0) GOTO 850 - DO 840 J=1,4 - P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) - 840 CONTINUE - 850 CONTINUE - PARJST=PARJ(33) - IF(MSTJ(11).EQ.2) PARJST=PARJ(34) - WMIN=PARJST+PMQ(1)+PMQ(2) - WREM2=FOUR(N+NRS,N+NRS) - IF(P(N+NRS,4).LT.0D0.OR.WREM2.LT.WMIN**2) THEN - NTRYWR=NTRYWR+1 - IF(MOD(NTRYWR,20).NE.0) NTRYR=NTRYR-1 - GOTO 140 - ENDIF - ENDIF - -C...Produce new particle: side, origin. - 860 I=I+1 - IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYSTRF:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF -C.. New side priority for popcorn systems - IF(MSTU(121).LE.0)THEN - JT=1.5D0+PYR(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 - ENDIF - JR=3-JT - JS=3-2*JT - IRANK(JT)=IRANK(JT)+1 - K(I,1)=1 - K(I,4)=0 - K(I,5)=0 - -C...Generate flavour, hadron and pT. - 870 K(I,3)=IE(JT) - CALL PYKFDI(KFL(JT),0,KFL(3),K(I,2)) - IF(K(I,2).EQ.0) GOTO 700 - MU90MO=MSTU(90) - IF(MSTU(121).EQ.-1) GOTO 900 - IF(IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. - &IABS(KFL(3)).GT.10) THEN - IF(PYR(0).GT.PARJ(19)) GOTO 870 - ENDIF - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JT) - P(I,5)=PYMASS(K(I,2)) - CALL PYPTDI(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)=PYMASS(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.5D0*PARJ(36)*PMQ(3) - WREM2=FOUR(N+NRS,N+NRS) - IF(WREM2.LT.0.10D0) GOTO 700 - IF(WREM2.LT.MAX(WMIN*(1D0+(2D0*PYR(0)-1D0)*PARJ(37)), - &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 1070 - -C...Choose z, which gives Gamma. Shift z for heavy flavours. - CALL PYZDIS(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(0D0,(WREM2-PR(1)-PR(2))**2-4D0*PR(1)*PR(2))) - Z=(WREM2+PR(JT)-PR(JR)+PW12*(2D0*Z-1D0))/(2D0*WREM2) - PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 - IF((1D0-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 1070 - ENDIF - GAM(3)=(1D0-Z)*(GAM(JT)+PR(JT)/Z) - -C.. MOPS baryon model modification - XTMO3=(1D0-Z)*XTMO(JT) - IF(IABS(KFL(3)).LE.10) NRVMO=0 - IF(IABS(KFL(3)).GT.10.AND.MSTJ(12).GE.4) THEN - GTSTMO=1D0 - PTSTMO=1D0 - RTSTMO=PYR(0) - IF(IABS(KFL(JT)).LE.10)THEN - XBMO=MIN(XTMO3,1D0-(2D-10)) - GBMO=GAM(3) - PMMO=0D0 - PGMO=GBMO+LOG(1D0-XBMO)*PM2QMO(JT) - GTSTMO=1D0-PARF(192)**PGMO - ELSE - IF(IRANK(JT).EQ.1) THEN - GBMO=GAM(JT) - PMMO=0D0 - XBMO=1D0 - ENDIF - IF(XBMO.LT.1D0-(1D-10))THEN - PGNMO=GBMO*XTMO3/XBMO+PM2QMO(JT)*LOG(1D0-XTMO3) - GTSTMO=(1D0-PARF(192)**PGNMO)/(1D0-PARF(192)**PGMO) - PGMO=PGNMO - ENDIF - IF(MSTJ(12).GE.5)THEN - PMNMO=SQRT((XBMO-XTMO3)*(GAM(3)/XTMO3-GBMO/XBMO)) - PMMO=PMMO+PMAS(PYCOMP(K(I,2)),1)-PMAS(PYCOMP(K(I,2)),3) - PTSTMO=EXP((PMMO-PMNMO)*PARF(193)) - PMMO=PMNMO - ENDIF - ENDIF - -C.. MOPS Accepting popcorn system hadron. - IF(PTSTMO*GTSTMO.GT.RTSTMO) THEN - IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) THEN - NRVMO=I-N-NR - IF(I+NRVMO.GT.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11, - & '(PYSTRF:) no more memory left in PYJETS') - IF(MSTU(21).GE.1) RETURN - ENDIF - IMO=I - KFLMO=KFL(JT) - PMQMO=PMQ(JT) - PXMO=PX(JT) - PYMO=PY(JT) - GAMMO=GAM(JT) - IRMO=IRANK(JT) - XMO=XTMO(JT) - DO 890 J=1,9 - IF(J.LE.5) THEN - DO 880 LINE=1,I-N-NR - P(MSTU(4)-MSTU(32)-LINE,J)=P(N+NR+LINE,J) - K(MSTU(4)-MSTU(32)-LINE,J)=K(N+NR+LINE,J) - 880 CONTINUE - ENDIF - INMO(J)=IN(J) - 890 CONTINUE - ENDIF - ELSE -C..Reject popcorn system, flag=-1 if enforcing new one - MSTU(121)=-1 - IF(PTSTMO.GT.RTSTMO) MSTU(121)=-2 - ENDIF - ENDIF - - -C..Lift restoring string outside MOPS block - 900 IF(MSTU(121).LT.0) THEN - IF(MSTU(121).EQ.-2) MSTU(121)=0 - MSTU(90)=MU90MO - NRVMO=0 - IF(IRANK(JT).EQ.1.OR.IABS(KFL(JT)).LE.10) GOTO 870 - I=IMO - KFL(JT)=KFLMO - PMQ(JT)=PMQMO - PX(JT)=PXMO - PY(JT)=PYMO - GAM(JT)=GAMMO - IRANK(JT)=IRMO - XTMO(JT)=XMO - DO 920 J=1,9 - IF(J.LE.5) THEN - DO 910 LINE=1,I-N-NR - P(N+NR+LINE,J)=P(MSTU(4)-MSTU(32)-LINE,J) - K(N+NR+LINE,J)=K(MSTU(4)-MSTU(32)-LINE,J) - 910 CONTINUE - ENDIF - IN(J)=INMO(J) - 920 CONTINUE - GOTO 870 - ENDIF - XTMO(JT)=XTMO3 -C.. MOPS end of modification - - DO 930 J=1,3 - IN(J)=IN(3*JT+J) - 930 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 940 J=1,4 - P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) - 940 CONTINUE - GOTO 1030 - ELSEIF(IN(1)+1.EQ.IN(2)) THEN - P(IN(JR)+2,4)=P(IN(JR)+2,3) - P(IN(JR)+2,JT)=1D0 - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - ENDIF - ENDIF - -C...Find new transverse directions (i.e. spacelike string vectors). - 950 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 700 - IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN - DO 960 J=1,4 - DP(1,J)=P(IN(1),J) - DP(2,J)=P(IN(2),J) - DP(3,J)=0D0 - DP(4,J)=0D0 - 960 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.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - GOTO 950 - 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)=1D0 - IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1D0 - IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1D0 - IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1D0 - 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 970 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)) - 970 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.01D0) THEN - PX(3)=PXP - PY(3)=PYP - ENDIF - ENDIF - -C...Sum up known four-momentum. Gives coefficients for m2 expression. - DO 1000 J=1,4 - DHG(J)=0D0 - 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 980 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) - 980 CONTINUE - DO 990 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS - P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) - 990 CONTINUE - 1000 CONTINUE - DHM(1)=FOUR(I,I) - DHM(2)=2D0*FOUR(I,IN(1)) - DHM(3)=2D0*FOUR(I,IN(2)) - DHM(4)=2D0*FOUR(IN(1),IN(2)) - -C...Find coefficients for Gamma expression. - DO 1020 IN2=IN(1)+1,IN(2),4 - DO 1010 IN1=IN(1),IN2-1,4 - DHC=2D0*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 - 1010 CONTINUE - 1020 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.1D-4) GOTO 700 - 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.5D0*(SQRT(MAX(0D0,DHS2**2-4D0*DHS1*DHS3))/ - &ABS(DHS1)-DHS2/DHS1) - IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0D0) GOTO 700 - 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)=1D0 - IN(JR)=IN(JR)+4*JS - IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 700 - IF(FOUR(IN(1),IN(2)).LE.1D-2) THEN - P(IN(JT)+2,4)=P(IN(JT)+2,3) - P(IN(JT)+2,JT)=0D0 - IN(JT)=IN(JT)+4*JS - ENDIF - GOTO 950 - 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)=0D0 - IN(JT)=IN(JT)+4*JS - GOTO 950 - ENDIF - -C...Four-momentum of particle. Remaining quantities. Loop back. - 1030 DO 1040 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) - 1040 CONTINUE - IF(P(I,4).LT.P(I,5)) GOTO 700 - 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 1050 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) - 1050 CONTINUE - ENDIF - DO 1060 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) - 1060 CONTINUE - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &IBARRK(JT)=0 - GOTO 860 - -C...Final hadron: side, flavour, hadron, mass. - 1070 I=I+1 - K(I,1)=1 - K(I,3)=IE(JR) - K(I,4)=0 - K(I,5)=0 - CALL PYKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) - IF(K(I,2).EQ.0) GOTO 700 - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I-1,2)),10000).GT.1000) - &IBARRK(JT)=0 - IF(IBARRK(JT).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JT) - IF(IBARRK(JR).EQ.1.AND.MOD(IABS(K(I,2)),10000).GT.1000) - &K(I,3)=IJUORI(JR) - P(I,5)=PYMASS(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)+2,3)*P(IN(8)+2,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=2D0*DHR1*DHR2*DHC12 - FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) - IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1D0) GOTO 200 - IF(FD.GE.1D0) GOTO 700 - FA=WREM2+PR(JT)-PR(JR) - FB=SQRT(MAX(0D0,FA**2-4D0*WREM2*PR(JT))) - PREVCF=PARJ(42) - IF(MSTJ(11).EQ.2) PREVCF=PARJ(39) - PREV=1D0/(1D0+EXP(MIN(50D0,PREVCF*FB*PARJ(40)))) - FB=SIGN(FB,JS*(PYR(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(0D0,FA**2- - &4D0*WREM2*PR(JT))),DBLE(JS)) - DO 1080 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.5D0*(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) - 1080 CONTINUE - IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 700 - DM2F1=P(I-1,4)**2-P(I-1,1)**2-P(I-1,2)**2-P(I-1,3)**2-P(I-1,5)**2 - DM2F2=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 - IF(DM2F1.GT.1D-10*P(I-1,4)**2.OR.DM2F2.GT.1D-10*P(I,4)**2) THEN - NTRYFN=NTRYFN+1 - IF(NTRYFN.LT.100) GOTO 140 - CALL PYERRM(13,'(PYSTRF:) bad energies for final two hadrons') - ENDIF - -C...Mark jets as fragmented and give daughter pointers. - N=I-NRS+1 - DO 1090 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 - 1090 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 1100 J=1,4 - P(NSAV,J)=DPS(J) - V(NSAV,J)=V(IP,J) - 1100 CONTINUE - P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) - V(NSAV,5)=0D0 - DO 1120 I=NSAV+1,N - DO 1110 J=1,5 - K(I,J)=K(I+NRS-1,J) - P(I,J)=P(I+NRS-1,J) - V(I,J)=0D0 - 1110 CONTINUE - 1120 CONTINUE - MSTU91=MSTU(90) - DO 1130 IZ=MSTU90+1,MSTU91 - MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N - PARU9T(IZ)=PARU(90+IZ) - 1130 CONTINUE - MSTU(90)=MSTU90 - -C...Order particles in rank along the chain. Update mother pointer. - DO 1150 I=NSAV+1,N - DO 1140 J=1,5 - K(I-NSAV+N,J)=K(I,J) - P(I-NSAV+N,J)=P(I,J) - 1140 CONTINUE - 1150 CONTINUE - I1=NSAV - DO 1180 I=N+1,2*N-NSAV - IF(K(I,3).NE.IE(1).AND.K(I,3).NE.IJUORI(1)) GOTO 1180 - I1=I1+1 - DO 1160 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1160 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1170 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 - 1170 CONTINUE - 1180 CONTINUE - DO 1210 I=2*N-NSAV,N+1,-1 - IF(K(I,3).EQ.IE(1).OR.K(I,3).EQ.IJUORI(1)) GOTO 1210 - I1=I1+1 - DO 1190 J=1,5 - K(I1,J)=K(I,J) - P(I1,J)=P(I,J) - 1190 CONTINUE - IF(MSTU(16).NE.2) K(I1,3)=NSAV - DO 1200 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 - 1200 CONTINUE - 1210 CONTINUE - -C...Boost back particle system. Set production vertices. - IF(MBST.EQ.0) THEN - MSTU(33)=1 - CALL PYROBO(NSAV+1,N,0D0,0D0,DPS(1)/DPS(4),DPS(2)/DPS(4), - & DPS(3)/DPS(4)) - ELSE - DO 1220 I=NSAV+1,N - HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 - IF(P(I,3).GT.0D0) THEN - HHPEZ=(P(I,4)+P(I,3))*HHBZ - P(I,3)=0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ELSE - HHPEZ=(P(I,4)-P(I,3))/HHBZ - P(I,3)=-0.5D0*(HHPEZ-HHPMT/HHPEZ) - P(I,4)=0.5D0*(HHPEZ+HHPMT/HHPEZ) - ENDIF - 1220 CONTINUE - ENDIF - DO 1240 I=NSAV+1,N - DO 1230 J=1,4 - V(I,J)=V(IP,J) - 1230 CONTINUE - 1240 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYSUBH -C...This routine computes the renormalization group improved -C...values of Higgs masses and couplings in the MSSM. - -C...Program based on the work by M. Carena, J.R. Espinosa, -c...M. Quiros and C.E.M. Wagner, CERN-preprint CERN-TH/95-45 - -C...Input: MA,TANB = TAN(BETA),MQ,MUR,MTOP,AU,AD,MU -C...All masses in GeV units. MA is the CP-odd Higgs mass, -C...MTOP is the physical top mass, MQ and MUR are the soft -C...supersymmetry breaking mass parameters of left handed -C...and right handed stops respectively, AU and AD are the -C...stop and sbottom trilinear soft breaking terms, -C...respectively, and MU is the supersymmetric -C...Higgs mass parameter. We use the conventions from -C...the physics report of Haber and Kane: left right -C...stop mixing term proportional to (AU - MU/TANB) -C...We use as input TANB defined at the scale MTOP - -C...Output: MH,HM,MHCH, SA = SIN(ALPHA), CA= COS(ALPHA), TANBA -C...where MH and HM are the lightest and heaviest CP-even -C...Higgs masses, MHCH is the charged Higgs mass and -C...ALPHA is the Higgs mixing angle -C...TANBA is the angle TANB at the CP-odd Higgs mass scale - -C...Range of validity: -C...(STOP1**2 - STOP2**2)/(STOP2**2 + STOP1**2) < 0.5 -C...(SBOT1**2 - SBOT2**2)/(SBOT2**2 + SBOT2**2) < 0.5 -C...where STOP1, STOP2, SBOT1 and SBOT2 are the stop and -C...are the sbottom mass eigenvalues, respectively. This -C...range automatically excludes the existence of tachyons. -C...For the charged Higgs mass computation, the method is -C...valid if -C...2 * |MB * AD* TANB| < M_SUSY**2, 2 * |MTOP * AU| < M_SUSY**2 -C...2 * |MB * MU * TANB| < M_SUSY**2, 2 * |MTOP * MU| < M_SUSY**2 -C...where M_SUSY**2 is the average of the squared stop mass -C...eigenvalues, M_SUSY**2 = (STOP1**2 + STOP2**2)/2. The sbottom -C...masses have been assumed to be of order of the stop ones -C...M_SUSY**2 = (MQ**2 + MUR**2)*0.5 + MTOP**2 - - SUBROUTINE PYSUBH (XMA,TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM, - &XMHCH,SA,CA,TANBA) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYHTRI/HHH(7) - SAVE /PYDAT1/,/PYDAT2/ - -C...Local variables. - DOUBLE PRECISION PYALEM,PYALPS - DOUBLE PRECISION TANB,XMQ,XMUR,XMTOP,AU,AD,XMU,XMH,XHM - DOUBLE PRECISION XMHCH,SA,CA - DOUBLE PRECISION XMA,AEM,ALP1,ALP2,ALPH3Z,V,PI - DOUBLE PRECISION Q02 - DOUBLE PRECISION TANBA,TANBT,XMB,ALP3 - DOUBLE PRECISION RMTOP,XMS,T,SINB,COSB - DOUBLE PRECISION XLAM1,XLAM2,XLAM3,XLAM4,XLAM5,XLAM6 - DOUBLE PRECISION XLAM7,XAU,XAD,G1,G2,G3,HU,HD,HU2 - DOUBLE PRECISION HD2,HU4,HD4,SINBT,COSBT - DOUBLE PRECISION TRM2,DETM2,XMH2,XHM2,XMHCH2 - DOUBLE PRECISION SINALP,COSALP,AUD,PI2,XMS2,XMS4,AD2 - DOUBLE PRECISION AU2,XMU2,XMZ,XMS3 - - XMZ = PMAS(23,1) - Q02=XMZ**2 - AEM=PYALEM(Q02) - ALP1=AEM/(1D0-PARU(102)) - ALP2=AEM/PARU(102) - ALPH3Z=PYALPS(Q02) - - ALP1 = 0.0101D0 - ALP2 = 0.0337D0 - ALPH3Z = 0.12D0 - - V = 174.1D0 - PI = PARU(1) - TANBA = TANB - TANBT = TANB - -C...MBOTTOM(MTOP) = 3. GEV - XMB = PYMRUN(5,XMTOP**2) - ALP3 = ALPH3Z/(1D0 +(11D0 - 10D0/3D0)/4D0/PI*ALPH3Z* - &LOG(XMTOP**2/XMZ**2)) - -C...RMTOP= RUNNING TOP QUARK MASS - RMTOP = XMTOP/(1D0+4D0*ALP3/3D0/PI) - XMS = ((XMQ**2 + XMUR**2)/2D0 + XMTOP**2)**0.5D0 - T = LOG(XMS**2/XMTOP**2) - SINB = TANB/((1D0 + TANB**2)**0.5D0) - COSB = SINB/TANB -C...IF(MA.LE.XMTOP) TANBA = TANBT - IF(XMA.GT.XMTOP) - &TANBA = TANBT*(1D0-3D0/32D0/PI**2* - &(RMTOP**2/V**2/SINB**2-XMB**2/V**2/COSB**2)* - &LOG(XMA**2/XMTOP**2)) - - SINBT = TANBT/SQRT(1D0 + TANBT**2) - COSBT = 1D0/SQRT(1D0 + TANBT**2) -C COS2BT = (TANBT**2 - 1D0)/(TANBT**2 + 1D0) - G1 = SQRT(ALP1*4D0*PI) - G2 = SQRT(ALP2*4D0*PI) - G3 = SQRT(ALP3*4D0*PI) - HU = RMTOP/V/SINBT - HD = XMB/V/COSBT - HU2=HU*HU - HD2=HD*HD - HU4=HU2*HU2 - HD4=HD2*HD2 - AU2=AU**2 - AD2=AD**2 - XMS2=XMS**2 - XMS3=XMS**3 - XMS4=XMS2*XMS2 - XMU2=XMU*XMU - PI2=PI*PI - - XAU = (2D0*AU2/XMS2)*(1D0 - AU2/12D0/XMS2) - XAD = (2D0*AD2/XMS2)*(1D0 - AD2/12D0/XMS2) - AUD = (-6D0*XMU2/XMS2 - ( XMU2- AD*AU)**2/XMS4 - &+ 3D0*(AU + AD)**2/XMS2)/6D0 - XLAM1 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HD2*T/8D0/PI2) - &+(3D0*HD4/8D0/PI2) * (T + XAD/2D0 + (3D0*HD2/2D0 + HU2/2D0 - &- 8D0*G3**2) * (XAD*T + T**2)/16D0/PI2) - &-(3D0*HU4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HU2 -5D0* HD2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM2 = ((G1**2 + G2**2)/4D0)*(1D0-3D0*HU2*T/8D0/PI2) - &+(3D0*HU4/8D0/PI2) * (T + XAU/2D0 + (3D0*HU2/2D0 + HD2/2D0 - &- 8D0*G3**2) * (XAU*T + T**2)/16D0/PI2) - &-(3D0*HD4* XMU**4/96D0/PI2/XMS4) * (1+ (9D0*HD2 -5D0* HU2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM3 = ((G2**2 - G1**2)/4D0)*(1D0-3D0* - &(HU2 + HD2)*T/16D0/PI2) - &+(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 - &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) - &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ - &XMS4)* (1D0+ (6D0*HU2 -2D0* HD2/2D0 - &- 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ - &XMS4)*(1D0+ (6D0*HD2 -2D0* HU2 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM4 = (- G2**2/2D0)*(1D0-3D0*(HU2 + HD2)*T/16D0/PI2) - &-(6D0*HU2*HD2/16D0/PI2) * (T + AUD/2D0 + (HU2 + HD2 - &- 8D0*G3**2) * (AUD*T + T**2)/16D0/PI2) - &+(3D0*HU4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AU2/ - &XMS4)* - &(1+ (6D0*HU2 -2D0* HD2 - &- 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4/96D0/PI2) * (3D0*XMU2/XMS2 - XMU2*AD2/ - &XMS4)* - &(1+ (6D0*HD2 -2D0* HU2/2D0 - &- 16D0*G3**2) *T/16D0/PI2) - XLAM5 = -(3D0*HU4* XMU2*AU2/96D0/PI2/XMS4) * - &(1- (2D0*HD2 -6D0* HU2 + 16D0*G3**2) *T/16D0/PI2) - &-(3D0*HD4* XMU2*AD2/96D0/PI2/XMS4) * - &(1- (2D0*HU2 -6D0* HD2 + 16D0*G3**2) *T/16D0/PI2) - XLAM6 = (3D0*HU4* XMU**3*AU/96D0/PI2/XMS4) * - &(1- (7D0*HD2/2D0 -15D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HD4* XMU *(AD**3/XMS3 - 6D0*AD/XMS )/96D0/PI2/XMS) * - &(1- (HU2/2D0 -9D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) - XLAM7 = (3D0*HD4* XMU**3*AD/96D0/PI2/XMS4) * - &(1- (7D0*HU2/2D0 -15D0* HD2/2D0 + 16D0*G3**2) *T/16D0/PI2) - &+(3D0*HU4* XMU *(AU**3/XMS3 - 6D0*AU/XMS )/96D0/PI2/XMS) * - &(1- (HD2/2D0 -9D0* HU2/2D0 + 16D0*G3**2) *T/16D0/PI2) - HHH(1)=XLAM1 - HHH(2)=XLAM2 - HHH(3)=XLAM3 - HHH(4)=XLAM4 - HHH(5)=XLAM5 - HHH(6)=XLAM6 - HHH(7)=XLAM7 - TRM2 = XMA**2 + 2D0*V**2* (XLAM1* COSBT**2 + - &2D0* XLAM6*SINBT*COSBT - &+ XLAM5*SINBT**2 + XLAM2* SINBT**2 + 2D0* XLAM7*SINBT*COSBT - &+ XLAM5*COSBT**2) - DETM2 = 4D0*V**4*(-(SINBT*COSBT*(XLAM3 + XLAM4) + - &XLAM6*COSBT**2 - &+ XLAM7* SINBT**2)**2 + (XLAM1* COSBT**2 + - &2D0* XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2)*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2)) + XMA**2*2D0*V**2 * - &((XLAM1* COSBT**2 +2D0* - &XLAM6* COSBT*SINBT + XLAM5*SINBT**2)*COSBT**2 + - &(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT + XLAM5*COSBT**2) - &*SINBT**2 - &+2D0*SINBT*COSBT* (SINBT*COSBT*(XLAM3 - &+ XLAM4) + XLAM6*COSBT**2 - &+ XLAM7* SINBT**2)) - - XMH2 = (TRM2 - SQRT(TRM2**2 - 4D0* DETM2))/2D0 - XHM2 = (TRM2 + SQRT(TRM2**2 - 4D0* DETM2))/2D0 - XHM = SQRT(XHM2) - XMH = SQRT(XMH2) - XMHCH2 = XMA**2 + (XLAM5 - XLAM4)* V**2 - XMHCH = SQRT(XMHCH2) - - SINALP = SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0) - - &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* - &XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) - &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))/ - &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0))/2D0**0.5D0 - - COSALP = (2D0*(2D0*V**2*(SINBT*COSBT*(XLAM3 + XLAM4) + - &XLAM6*COSBT**2 + XLAM7* SINBT**2) - - &XMA**2*SINBT*COSBT))/2D0**0.5D0/ - &SQRT(((TRM2**2 - 4D0* DETM2)**0.5D0)* - &(((TRM2**2 - 4D0* DETM2)**0.5D0) - - &((2D0*V**2*(XLAM1* COSBT**2 + 2D0* - &XLAM6* COSBT*SINBT - &+ XLAM5*SINBT**2) + XMA**2*SINBT**2) - &- (2D0*V**2*(XLAM2* SINBT**2 +2D0* XLAM7* COSBT*SINBT - &+ XLAM5*COSBT**2) + XMA**2*COSBT**2)))) - - SA = -SINALP - CA = -COSALP - - 100 CONTINUE - - RETURN - END - -C********************************************************************* - -C...PYSUGI -C...Interface to ISASUSY version 7.69. -C...Warning: this interface should not be used with earlier versions -C...of ISASUSY, since common block incompatibilities may then arise. -C...Calls SUGRA (in ISAJET) to perform RGE evolution. -C...Then converts to Gunion-Haber conventions. - - SUBROUTINE PYSUGI - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - - INTEGER PYK,PYCHGE,PYCOMP - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) - -C...Date of Change - CHARACTER DOC*11 - PARAMETER (DOC='08 Oct 2003') - -C...ISASUGRA Input: - REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP -C...ISASUGRA Output - CHARACTER*40 ISAVER,VISAJE - REAL SUPER - COMMON /SSPAR/ SUPER(72) - COMMON /SUGMG/ MSS(32),GSS(31),MGUTSS,GGUTSS,AGUTSS,FTGUT, - $FBGUT,FTAGUT,FNGUT - REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS,FTGUT,FBGUT,FTAGUT,FNGUT - COMMON /SUGPAS/ XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, - $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, - $FNMZ,AMNRMJ,NOGOOD,IAL3UN,ITACHY,MHPNEG,ASM3, - $VUMT,VDMT,ASMTP,ASMSS,M3Q - REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, - $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, - $FNMZ,AMNRMJ,ASM3,VUMT,VDMT,ASMTP,ASMSS,M3Q - INTEGER NOGOOD,IAL3UN,ITACHY,MHPNEG -C SUPER: Filled by ISASUGRA. -C SUPER(1) = mass of ~g -C SUPER(2:17) = mass of ~u_L,~u_R,~d_L,~d_R,~s_L,~s_R,~c_L,~c_R,~b_L -C ,~b_R,~b_1,~b_2,~t_L,~t_R,~t_1,~t_2 -C SUPER(18:25) = mass of ~e_L,~e_R,~mu_L,~mu_R,~tau_L,~tau_R,~tau_1 -C ,~tau_2 -C SUPER(26:28) = mass of ~nu_e,~nu_mu,~nu_tau -C SUPER(29) = Higgsino mass = - mu -C SUPER(30) = ratio v2/v1 of vev's -C SUPER(31:34) = Signed neutralino masses -C SUPER(35:50) = Neutralino mixing matrix -C SUPER(51:52) = Signed chargino masses -C SUPER(53:54) = Chargino left, right mixing angles -C SUPER(55:58) = mass of h0, H0, A0, H+ -C SUPER(59) = Higgs mixing angle alpha -C SUPER(60:65) = A_t, theta_t, A_b, theta_b, A_tau, theta_tau -C SUPER(66) = Gravitino mass -C SUPER(67:69) = Top,Bottom, and Tau masses at MSUSY (not used) -C SUPER(70) = b-Yukawa at mA scale (not used) -C SUPER(71:72) = H_u, H_d vev's at MSUSY (not used) -C GSS: Filled by ISASUGRA -C GSS( 1) = g_1 GSS( 2) = g_2 GSS( 3) = g_3 -C GSS( 4) = y_tau GSS( 5) = y_b GSS( 6) = y_t -C GSS( 7) = M_1 GSS( 8) = M_2 GSS( 9) = M_3 -C GSS(10) = A_tau GSS(11) = A_b GSS(12) = A_t -C GSS(13) = M_h1^2 GSS(14) = M_h2^2 GSS(15) = M_er^2 -C GSS(16) = M_el^2 GSS(17) = M_dnr^2 GSS(18) = M_upr^2 -C GSS(19) = M_upl^2 GSS(20) = M_taur^2 GSS(21) = M_taul^2 -C GSS(22) = M_btr^2 GSS(23) = M_tpr^2 GSS(24) = M_tpl^2 -C GSS(25) = mu GSS(26) = B GSS(27) = Y_N -C GSS(28) = M_nr GSS(29) = A_n GSS(30) = log(vdq) -C GSS(31) = log(vuq) -C MSS: Filled by ISASUGRA -C MSS( 1) = glss MSS( 2) = upl MSS( 3) = upr -C MSS( 4) = dnl MSS( 5) = dnr MSS( 6) = stl -C MSS( 7) = str MSS( 8) = chl MSS( 9) = chr -C MSS(10) = b1 MSS(11) = b2 MSS(12) = t1 -C MSS(13) = t2 MSS(14) = nuel MSS(15) = numl -C MSS(16) = nutl MSS(17) = el- MSS(18) = er- -C MSS(19) = mul- MSS(20) = mur- MSS(21) = tau1 -C MSS(22) = tau2 MSS(23) = z1ss MSS(24) = z2ss -C MSS(25) = z3ss MSS(26) = z4ss MSS(27) = w1ss -C MSS(28) = w2ss MSS(29) = hl0 MSS(30) = hh0 -C MSS(31) = ha0 MSS(32) = h+ -C Unification, filled by ISASUGRA if applicable. -C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUTC -C...SPYTHIA Input/Output: - INTEGER IMSS - DOUBLE PRECISION RMSS - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /SUGMG/,/SSPAR/ -C -C...PYTHIA common blocks -C...Parameters. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) -C...Particle properties + some flavour parameters. - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT2/,/PYSSMT/ - -C...Start by checking for incompatibilities/inconsistencies: - DO 100 ICHK=2,9 - IF (ICHK.NE.8.AND.ICHK.NE.4.AND.IMSS(ICHK).NE.0) THEN - WRITE (MSTU(11),*) '(PYSUGI:) IMSS(',ICHK,')=',IMSS(ICHK) - & ,' option not used by PYSUGI' - ENDIF - 100 CONTINUE -C...ISAJET works with REAL numbers. - MZERO=REAL(RMSS(8)) - MHLF=REAL(RMSS(1)) - AZERO=REAL(RMSS(16)) - TANB=REAL(RMSS(5)) - SGNMU=REAL(RMSS(4)) - MTOP=REAL(PMAS(6,1)) -C...Initialize MSSM parameter array - DO 110 IPAR=1,72 - SUPER(IPAR)=0.0 - 110 CONTINUE -C...Call ISASUGRA - CALL SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,1) -C...Check whether ISASUSY thought the model was OK. - IF (NOGOOD.NE.0) THEN - IF (NOGOOD.EQ.1) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give tachyonic particles.') - IF (NOGOOD.EQ.2) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give no EWSB.') - IF (NOGOOD.EQ.3) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give m(A0) < 0.') - IF (NOGOOD.EQ.4) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give Yukawa > 100.') - IF (NOGOOD.EQ.7) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give x_T EWSB bad.') - IF (NOGOOD.EQ.8) CALL PYERRM(26 - & ,'(PYSUGI:) SUSY parameters give m(h0)^2 < 0.') -C...Give warning, but don't stop, if LSP not ~chi_10. - IF (NOGOOD.EQ.5) CALL PYERRM(16 - & ,'(PYSUGI:) SUSY parameters give ~chi_10 not LSP.') - ENDIF -C...Warn about possible GUT scale tachyons. - IF (ITACHY.NE.0) CALL PYERRM(16, - & '(PYSUGI:) Tachyonic sleptons at GUT scale.') - -C...M1 and M2. - RMSS(1)=GSS(7) - RMSS(2)=GSS(8) -C...Gluino Mass. - RMSS(3)=SUPER(1) -C...Mu = - Higgsino mass. - RMSS(4)=-SUPER(29) - RMSS(5)=TANB -C...Slepton and squark masses. 2 first generations. - RMSS(6)=0.5*(SUPER(18)+SUPER(20)) - RMSS(7)=0.5*(SUPER(19)+SUPER(21)) - RMSS(8)=0.25*(SUPER(2)+SUPER(4)+SUPER(6)+SUPER(8)) - RMSS(9)=0.25*(SUPER(3)+SUPER(5)+SUPER(7)+SUPER(9)) -C...Third generation. - RMSS(10)=0.5*(SUPER(14)+SUPER(10)) - RMSS(11)=SUPER(11) - RMSS(12)=SUPER(15) - RMSS(13)=SUPER(22) - RMSS(14)=SUPER(23) -C...~b, ~t, and ~tau trilinear couplings and mixing angles. - RMSS(15)=SUPER(62) - RMSS(16)=SUPER(60) - RMSS(17)=SUPER(64) - RMSS(26)=SUPER(63) - RMSS(27)=SUPER(61) - RMSS(28)=SUPER(65) -C...Higgs mixing angle alpha (Gunion-Haber convention). - RMSS(18)=-SUPER(59) -C...A0 mass. - RMSS(19)=SUPER(57) -C...GUT scale coupling - RMSS(20)=AGUTSS -C...Gravitino mass (for future compatibility) - RMSS(21)=SUPER(66) - -C...Now we're done with RMSS. Time to fill PMAS (m > 0 required). -C...Higgs sector. - PMAS(PYCOMP(25),1)=ABS(SUPER(55)) - PMAS(PYCOMP(35),1)=ABS(SUPER(56)) - PMAS(PYCOMP(36),1)=ABS(SUPER(57)) - PMAS(PYCOMP(37),1)=ABS(SUPER(58)) -C...Gluino. - PMAS(PYCOMP(KSUSY1+21),1)=ABS(SUPER(1)) -C...Squarks and Sleptons. - DO 120 ILR=1,2 - ILRM=ILR-1 - PMAS(PYCOMP(ILR*KSUSY1+1),1)=ABS(SUPER(4+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+2),1)=ABS(SUPER(2+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+3),1)=ABS(SUPER(6+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+4),1)=ABS(SUPER(8+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+5),1)=ABS(SUPER(12+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+6),1)=ABS(SUPER(16+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+11),1)=ABS(SUPER(18+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+13),1)=ABS(SUPER(20+ILRM)) - PMAS(PYCOMP(ILR*KSUSY1+15),1)=ABS(SUPER(24+ILRM)) - 120 CONTINUE - PMAS(PYCOMP(KSUSY1+12),1)=ABS(SUPER(26)) - PMAS(PYCOMP(KSUSY1+14),1)=ABS(SUPER(27)) - PMAS(PYCOMP(KSUSY1+16),1)=ABS(SUPER(28)) -C...Neutralinos. - PMAS(PYCOMP(KSUSY1+22),1)=ABS(SUPER(31)) - PMAS(PYCOMP(KSUSY1+23),1)=ABS(SUPER(32)) - PMAS(PYCOMP(KSUSY1+25),1)=ABS(SUPER(33)) - PMAS(PYCOMP(KSUSY1+35),1)=ABS(SUPER(34)) -C...Signed masses (extra minus from going to G-H convention). - SMZ(1)=-SUPER(31) - SMZ(2)=-SUPER(32) - SMZ(3)=-SUPER(33) - SMZ(4)=-SUPER(34) -C...Charginos - PMAS(PYCOMP(KSUSY1+24),1)=ABS(SUPER(51)) - PMAS(PYCOMP(KSUSY1+37),1)=ABS(SUPER(52)) -C...Signed masses (extra minus from going to G-H convention). - SMW(1)=-SUPER(51) - SMW(2)=-SUPER(52) - -C... Neutralino Mixing. - DO 130 IN=1,4 - ZMIX(IN,1)= SUPER(38+4*(IN-1)) - ZMIX(IN,2)= SUPER(37+4*(IN-1)) - ZMIX(IN,3)=-SUPER(36+4*(IN-1)) - ZMIX(IN,4)=-SUPER(35+4*(IN-1)) - 130 CONTINUE -C...Chargino Mixing (PYTHIA same angle as HERWIG). - THX=1D0 - THY=1D0 - IF (SUPER(53).GT.0) THX=-1D0 - IF (SUPER(54).GT.0) THY=-1D0 - UMIX(1,1) = -SIN(SUPER(53)) - UMIX(1,2) = -COS(SUPER(53)) - UMIX(2,1) = -THX*COS(SUPER(53)) - UMIX(2,2) = THX*SIN(SUPER(53)) - VMIX(1,1) = -SIN(SUPER(54)) - VMIX(1,2) = -COS(SUPER(54)) - VMIX(2,1) = -THY*COS(SUPER(54)) - VMIX(2,2) = THY*SIN(SUPER(54)) -C...Sfermion mixing (PYTHIA same angle as ISAJET) - SFMIX(5,1)=COS(SUPER(63)) - SFMIX(5,2)=SIN(SUPER(63)) - SFMIX(5,3)=-SIN(SUPER(63)) - SFMIX(5,4)=COS(SUPER(63)) - SFMIX(6,1)=COS(SUPER(61)) - SFMIX(6,2)=SIN(SUPER(61)) - SFMIX(6,3)=-SIN(SUPER(61)) - SFMIX(6,4)=COS(SUPER(61)) - SFMIX(15,1)=COS(SUPER(65)) - SFMIX(15,2)=SIN(SUPER(65)) - SFMIX(15,3)=-SIN(SUPER(65)) - SFMIX(15,4)=COS(SUPER(65)) - - IF (MSTP(122).NE.0) THEN -C...Print a few lines to make the user know what's happening - ISAVER=VISAJE() - WRITE(MSTU(11),5000) DOC, ISAVER - WRITE(MSTU(11),5100) - WRITE(MSTU(11),5200) MZERO, MHLF, AZERO, TANB, NINT(SGNMU), MTOP - WRITE(MSTU(11),5300) - WRITE(MSTU(11),5500) 'EW scale masses' - WRITE(MSTU(11),5700) (SUPER(IP),IP=2,16,2),(SUPER(IP),IP=3,17,2) - WRITE(MSTU(11),5800) (SUPER(IP),IP=18,24,2),(SUPER(IP),IP=26,28) - & ,(SUPER(IP),IP=19,25,2) - WRITE(MSTU(11),5900) SUPER(1),(SMZ(IP),IP=1,4), (SMW(IP) - & ,IP=1,2) - WRITE(MSTU(11),6000) (SUPER(IP),IP=55,58) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),5500) 'Mixing structure' - WRITE(MSTU(11),6100) ((ZMIX(I,J), J=1,4),I=1,4) - WRITE(MSTU(11),6200) (UMIX(1,J), J=1,2),(VMIX(1,J),J=1,2) - & ,(UMIX(2,J), J=1,2),(VMIX(2,J),J=1,2) - WRITE(MSTU(11),6300) (SFMIX(5,J), J=1,2),(SFMIX(6,J),J=1,2) - & ,(SFMIX(15,J), J=1,2),(SFMIX(5,J),J=3,4),(SFMIX(6,J), J=3,4 - & ),(SFMIX(15,J),J=3,4) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),5500) 'Couplings' - WRITE(MSTU(11),6400) RMSS(15),RMSS(16),RMSS(17),RMSS(20) - WRITE(MSTU(11),5400) - WRITE(MSTU(11),6500) - ENDIF - -C...Fix the higgs sector (in PYMSIN) using the masses and mixing angle -C...output by ISASUGRA. - IMSS(4)=2 - - 5000 FORMAT(1x,19('*'),1x,'PYSUGI v1.3: PYTHIA/ISASUGRA ' - & ,'INTERFACE',1x,19('*')/1x,'*',3x,'PYSUGI: Last Change',1x,A - & ,1x,'-',1x,'P.Z. Skands'/1x,'*',2x,A/1x,'*') - 5100 FORMAT(1x,'*',1x,'ISASUGRA Input:'/1x,'*',1x,'----------------') - 5200 FORMAT(1x,'*',1x,3x,'M_0',6x,'M_1/2',5x,'A_0',3x,'Tan(beta)', - & 3x,'Sgn(mu)',3x,'M_t'/1x,'*',1x,4(F8.2,1x),I8,2x,F8.2) - 5300 FORMAT(1x,'*'/1x,'*',1x,'ISASUGRA Output:'/1x,'*',1x - & ,'----------------') - 5400 FORMAT(1x,'*',1x,A) - 5500 FORMAT(1x,'*',1x,A,':') - 5600 FORMAT(1x,'*',2x,2x,'M_GUT',2x,2x,'g_GUT',2x,1x,'alpha_GUT'/ - & 1x,'*',2x,1P,2(1x,E8.2),2x,E8.2) - 5700 FORMAT(1x,'*',4x,4x,'~u',2x,1x,4x,'~d',2x,1x,4x,'~s',2x,1x, - & 4x,'~c',2x,1x,4x,'~b',2x,1x,2x,'~b(12)',1x,4x,'~t',2x,1x, 2x, - & '~t(12)'/1x,'*',2x,'L',1x,8(F8.2,1x)/1x,'*',2x,'R',1x,8(F8.2 - & ,1x)) - 5800 FORMAT(1x,'*'/1x,'*',4x,4x,'~e',2x,1x,3x,'~mu',2x,1x,3x,'~tau',1x - & ,1x,'~tau(12)',1x,2x,'~nu_e',1x,1x,1x,'~nu_mu',1x,1x,1x - & ,'~nu_tau'/1x,'*',2x,'L',1x,7(F8.2,1x)/1x,'*',2x,'R',1x,4(F8 - & .2,1x)) - 5900 FORMAT(1x,'*'/1x,'*',4x,4x,'~g',2x,1x,1x,'~chi_10',1x,1x,'~chi_20' - & ,1x,1x,'~chi_30',1x,1x,'~chi_40',1x,1x,'~chi_1+',1x - & ,1x,'~chi_2+'/1x,'*',3x,1x,7(F8.2,1x)) - 6000 FORMAT(1x,'*'/1x,'*',4x,4x,'h0',2x,1x,4x,'H0',2x,1x,4x,'A0',2x - & ,1x,4x,'H+'/1x,'*',3x,1x,5(F8.2,1x)) - 6100 FORMAT(1x,'*',11x,'|',3x,'~B',3x,'|',2x,'~W_3',2x,'|',2x - & ,'~H_1',2x,'|',2x,'~H_2',2x,'|'/1x,'*',3x,'~chi_10',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_20',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_30',1x,4('|' - & ,1x,F6.3,1x),'|'/1x,'*',3x,'~chi_40',1x,4('|' - & ,1x,F6.3,1x),'|') - 6200 FORMAT(1x,'*'/1x,'*',6x,'L',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|' - & ,12x,'R',4x,'|',3x,'~W',3x,'|',3x,'~H',3x,'|'/1x,'*',3x - & ,'~chi_1+',1x,2('|',1x,F6.3,1x),'|',9x,'~chi_1+',1x,2('|',1x - & ,F6.3,1x),'|'/1x,'*',3x,'~chi_2+',1x,2('|',1x,F6.3,1x),'|',9x - & ,'~chi_2+',1x,2('|',1x,F6.3,1x),'|') - 6300 FORMAT(1x,'*'/1x,'*',8x,'|',2x,'~b_L',2x,'|',2x,'~b_R',2x,'|',8x - & ,'|',2x,'~t_L',2x,'|',2x,'~t_R',2x,'|',10x - & ,'|',1x,'~tau_L',1x,'|',1x,'~tau_R',1x,'|'/ - & 1x,'*',3x,'~b_1',1x,2('|',1x,F6.3,1x),'|',3x,'~t_1',1x,2('|' - & ,1x,F6.3,1x),'|',3x,'~tau_1',1x,2('|',1x,F6.3,1x),'|'/ - & 1x,'*',3x,'~b_2',1x,2('|',1x,F6.3,1x),'|',3x,'~t_2',1x,2('|' - & ,1x,F6.3,1x),'|',3x,'~tau_2',1x,2('|',1x,F6.3,1x),'|') - 6400 FORMAT(1x,'*',3x,'A_b = ',F8.2,4x,'A_t = ',F8.2,4x,'A_tau = ',F8.2 - & ,4x,'Alpha_GUT = ',F8.2) - 6500 FORMAT(1x,32('*'),1x,'END OF PYSUGI',1x,31('*')) - - END - -C********************************************************************* - -C...PYTABU -C...Evaluates various properties of an event, with statistics -C...accumulated during the course of the run and -C...printed at the end. - - SUBROUTINE PYTABU(MTABU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/ -C...Local arrays, character variables, saved variables and data. - 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*0D0/,FM2FM/120*0D0/, - &NEVEE/0/,FE1EC/50*0D0/,FE2EC/50*0D0/,FE1EA/25*0D0/,FE2EA/25*0D0/, - &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=1D0/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 PYNAME(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 PYNAME(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)/DBLE(NPIS(I,0)),J=1,10) - 170 CONTINUE - -C...Copy statistics on initial parton state into /PYJETS/. - ELSEIF(MTABU.EQ.13) THEN - FAC=1D0/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)=0D0 - V(N+1,J)=0D0 - 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=PYCOMP(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=PYCOMP(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(PYCHGE(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=1D0/MAX(1,NEVFS) - WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS - DO 270 I=1,NKFFS - CALL PYNAME(KFFS(I),CHAU) - KC=PYCOMP(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 /PYJETS/. - ELSEIF(MTABU.EQ.23) THEN - FAC=1D0/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)=0D0 - 280 CONTINUE - P(I,5)=FAC*K(I,5) - V(I,5)=0D0 - 290 CONTINUE - N=NKFFS - DO 300 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 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)=0D0 - FM2FM(IM,IB,IP)=0D0 - 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=PYCOMP(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. - & PYCHGE(K(I,2)).EQ.0) GOTO 410 - ENDIF - PMR=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - PR=MAX(1D-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), - & 1D20)),P(I,3)) - IF(ABS(YETA).GT.PARU(57)) GOTO 410 - PHI=PYANGL(P(I,1),P(I,2)) - IYETA=512D0*(YETA+PARU(57))/(2D0*PARU(57)) - IYETA=MAX(0,MIN(511,IYETA)) - IPHI=512D0*(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 PYERRM(11,'(PYTABU:) no more memory left in PYJETS') - 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)=0D0 - 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)+2D0 - ELSEIF(NAGR.EQ.3) THEN - FEVFM(IB,1)=FEVFM(IB,1)+6D0 - FEVFM(IB,2)=FEVFM(IB,2)+6D0 - ELSEIF(NAGR.EQ.4) THEN - FEVFM(IB,1)=FEVFM(IB,1)+12D0 - FEVFM(IB,2)=FEVFM(IB,2)+24D0 - FEVFM(IB,3)=FEVFM(IB,3)+24D0 - ELSE - FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1D0) - FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1D0)*(NAGR-2D0) - FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1D0)*(NAGR-2D0)* - & (NAGR-3D0) - FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1D0)*(NAGR-2D0)* - & (NAGR-3D0)*(NAGR-4D0) - 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.5D0) THEN - FEVFM(IB,IP)=0D0 - ELSEIF(IM.LE.2) THEN - FEVFM(IB,IP)=2D0**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) - ELSE - FEVFM(IB,IP)=4D0**((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=1D0/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=2D0*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/DBLE(2**(IB-1)) - IF(IM.EQ.3) BNAVE=FAC*NMUFM/DBLE(4**(IB-1)) - DO 490 IP=1,4 - FMOMA(IP)=FAC*FM1FM(IM,IB,IP) - FMOMS(IP)=SQRT(MAX(0D0,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 /PYJETS/. - ELSEIF(MTABU.EQ.33) THEN - FAC=1D0/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)=2D0*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(0D0,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)=0D0 - V(N+1,J)=0D0 - 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)=0D0 - FE2EC(J)=0D0 - FE1EC(51-J)=0D0 - FE2EC(51-J)=0D0 - FE1EA(J)=0D0 - FE2EA(J)=0D0 - 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=0D0 - 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=PYCOMP(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. - & PYCHGE(K(I,2)).EQ.0) GOTO 570 - ENDIF - PMR=0D0 - IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=PYMASS(211) - IF(MSTU(42).GE.2) PMR=P(I,5) - IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN - CALL PYERRM(11,'(PYTABU:) no more memory left in PYJETS') - 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(1D-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=(2D0/ECM**2)*50D0/PARU(1) - DO 580 J=1,50 - FEVEE(J)=0D0 - 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(-1D0,MIN(1D0,CTHE))) - ITHE=MAX(1,MIN(50,1+INT(50D0*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=1D0/MAX(1,NEVEE) - WRITE(MSTU(11),5700) NEVEE - DO 620 J=1,25 - FEEC1=FAC*FE1EC(J) - FEES1=SQRT(MAX(0D0,FAC*(FAC*FE2EC(J)-FEEC1**2))) - FEEC2=FAC*FE1EC(51-J) - FEES2=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) - FEECA=FAC*FE1EA(J) - FEESA=SQRT(MAX(0D0,FAC*(FAC*FE2EA(J)-FEECA**2))) - WRITE(MSTU(11),5800) 3.6D0*(J-1),3.6D0*J,FEEC1,FEES1, - & FEEC2,FEES2,FEECA,FEESA - 620 CONTINUE - -C...Copy statistics on Energy-Energy Correlation into /PYJETS/. - ELSEIF(MTABU.EQ.43) THEN - FAC=1D0/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(0D0,FAC*(FAC*FE2EC(I)-P(I,1)**2))) - P(I,2)=FAC*FE1EC(51-I) - V(I,2)=SQRT(MAX(0D0,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) - P(I,3)=FAC*FE1EA(I) - V(I,3)=SQRT(MAX(0D0,FAC*(FAC*FE2EA(I)-P(I,3)**2))) - P(I,4)=PARU(1)*(I-1)/50D0 - P(I,5)=PARU(1)*I/50D0 - V(I,4)=3.6D0*(I-1) - V(I,5)=3.6D0*I - 630 CONTINUE - N=25 - DO 640 J=1,5 - K(N+1,J)=0 - P(N+1,J)=0D0 - V(N+1,J)=0D0 - 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=1D0/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 PYNAME(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 /PYJETS/. - ELSEIF(MTABU.EQ.53) THEN - FAC=1D0/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)=0D0 - V(IDC,J)=0D0 - 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)=0D0 - V(N+1,J)=0D0 - 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)'/ - &8X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', - &8X,'Total'/35X,'prim seco prim seco'/) - 5300 FORMAT(1X,I9,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********************************************************************* - -C...PYTAUD -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 /PYJETS/. -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 /PYJETS/ 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. - - SUBROUTINE PYTAUD(ITAU,IORIG,KFORIG,NDECAY) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYJETS/,/PYDAT1/ - -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(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link your PYTAUD routine ', - &'correctly.'/1X,'Dummy routine in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...PYTBBC -C...Calculates the three-body decay of gluinos into -C...charginos and third generation fermions. - - SUBROUTINE PYTBBC(I,NN,XMGLU,GAM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - EXTERNAL PYSIMP,PYLAMF - DOUBLE PRECISION PYSIMP,PYLAMF - INTEGER I,NN,LIN - DOUBLE PRECISION XMG,XMG2,XMB,XMB2,XMR,XMR2 - DOUBLE PRECISION XMT,XMT2,XMST(4),XMSB(4) - DOUBLE PRECISION ULR(2),VLR(2),XMQ2,XMQ4,AM,W,SBAR,SMIN,SMAX - DOUBLE PRECISION SUMME(0:100),A(4,8) - DOUBLE PRECISION COS2A,SIN2A,COS2C,SIN2C - DOUBLE PRECISION GRS,XMQ3,XMGBTR,XMGTBR,ANT1,ANT2,ANB1,ANB2 - DOUBLE PRECISION XMGLU,GAM - DOUBLE PRECISION XX1(2),XX2(2),AAA(2),BBB(2),CCC(2), - &DDD(2),EEE(2),FFF(2) - SAVE XX1,XX2,AAA,BBB,CCC,DDD,EEE,FFF - DOUBLE PRECISION ALPHAW,ALPHAS - DOUBLE PRECISION AMC(2) - SAVE AMC - DOUBLE PRECISION AMBOT,AMSB(2),SINC,COSC - DOUBLE PRECISION AMTOP,AMST(2),SINA,COSA - SAVE AMSB,AMST - LOGICAL IFIRST - SAVE IFIRST - DATA IFIRST/.TRUE./ - - TANB=RMSS(5) - SINB=TANB/SQRT(1D0+TANB**2) - COSB=SINB/TANB - XW=PARU(102) - AMW=PMAS(24,1) - COSC=SFMIX(5,1) - SINC=SFMIX(5,3) - COSA=SFMIX(6,1) - SINA=SFMIX(6,3) - AMBOT=PYMRUN(5,XMGLU**2) - AMTOP=PYMRUN(6,XMGLU**2) - W2=SQRT(2D0) - AMW=PMAS(24,1) - FAKT1=AMBOT/W2/AMW/COSB - FAKT2=AMTOP/W2/AMW/SINB - IF(IFIRST) THEN - AMC(1)=SMW(1) - AMC(2)=SMW(2) - DO 100 JJ=1,2 - CCC(JJ)=FAKT1*UMIX(JJ,2)*SINC-UMIX(JJ,1)*COSC - EEE(JJ)=FAKT2*VMIX(JJ,2)*COSC - DDD(JJ)=FAKT1*UMIX(JJ,2)*COSC+UMIX(JJ,1)*SINC - FFF(JJ)=FAKT2*VMIX(JJ,2)*SINC - XX1(JJ)=FAKT2*VMIX(JJ,2)*SINA-VMIX(JJ,1)*COSA - AAA(JJ)=FAKT1*UMIX(JJ,2)*COSA - XX2(JJ)=FAKT2*VMIX(JJ,2)*COSA+VMIX(JJ,1)*SINA - BBB(JJ)=FAKT1*UMIX(JJ,2)*SINA - 100 CONTINUE - AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) - AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) - AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) - AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) - IFIRST=.FALSE. - ENDIF - - ULR(1)=XX1(I)*XX1(I)+AAA(I)*AAA(I) - ULR(2)=XX2(I)*XX2(I)+BBB(I)*BBB(I) - VLR(1)=CCC(I)*CCC(I)+EEE(I)*EEE(I) - VLR(2)=DDD(I)*DDD(I)+FFF(I)*FFF(I) - - COS2A=COSA**2-SINA**2 - SIN2A=SINA*COSA*2D0 - COS2C=COSC**2-SINC**2 - SIN2C=SINC*COSC*2D0 - - XMG=XMGLU - XMT=PMAS(6,1) - XMB=PMAS(5,1) - XMR=AMC(I) - XMG2=XMG*XMG - ALPHAW=PYALEM(XMG2) - ALPHAS=PYALPS(XMG2) - XMT2=XMT*XMT - XMB2=XMB*XMB - XMR2=XMR*XMR - XMQ2=XMG2+XMT2+XMB2+XMR2 - XMQ4=XMG*XMT*XMB*XMR - XMQ3=XMG2*XMR2+XMT2*XMB2 - XMGBTR=(XMG2+XMB2)*(XMT2+XMR2) - XMGTBR=(XMG2+XMT2)*(XMB2+XMR2) - - XMST(1)=AMST(1)*AMST(1) - XMST(2)=AMST(1)*AMST(1) - XMST(3)=AMST(2)*AMST(2) - XMST(4)=AMST(2)*AMST(2) - XMSB(1)=AMSB(1)*AMSB(1) - XMSB(2)=AMSB(2)*AMSB(2) - XMSB(3)=AMSB(1)*AMSB(1) - XMSB(4)=AMSB(2)*AMSB(2) - - A(1,1)=-COSA*SINC*CCC(I)*AAA(I)-SINA*COSC*EEE(I)*XX1(I) - A(1,2)=XMG*XMB*(COSA*COSC*CCC(I)*AAA(I)+SINA*SINC*EEE(I)*XX1(I)) - A(1,3)=-XMG*XMR*(COSA*COSC*CCC(I)*XX1(I)+SINA*SINC*EEE(I)*AAA(I)) - A(1,4)=XMB*XMR*(COSA*SINC*CCC(I)*XX1(I)+SINA*COSC*EEE(I)*AAA(I)) - A(1,5)=XMG*XMT*(COSA*COSC*EEE(I)*XX1(I)+SINA*SINC*CCC(I)*AAA(I)) - A(1,6)=-XMT*XMB*(COSA*SINC*EEE(I)*XX1(I)+SINA*COSC*CCC(I)*AAA(I)) - A(1,7)=XMT*XMR*(COSA*SINC*EEE(I)*AAA(I)+SINA*COSC*CCC(I)*XX1(I)) - A(1,8)=-XMQ4*(COSA*COSC*EEE(I)*AAA(I)+SINA*SINC*CCC(I)*XX1(I)) - - A(2,1)=-COSA*COSC*DDD(I)*AAA(I)-SINA*SINC*FFF(I)*XX1(I) - A(2,2)=-XMG*XMB*(COSA*SINC*DDD(I)*AAA(I)+SINA*COSC*FFF(I)*XX1(I)) - A(2,3)=XMG*XMR*(COSA*SINC*DDD(I)*XX1(I)+SINA*COSC*FFF(I)*AAA(I)) - A(2,4)=XMB*XMR*(COSA*COSC*DDD(I)*XX1(I)+SINA*SINC*FFF(I)*AAA(I)) - A(2,5)=XMG*XMT*(COSA*SINC*FFF(I)*XX1(I)+SINA*COSC*DDD(I)*AAA(I)) - A(2,6)=XMT*XMB*(COSA*COSC*FFF(I)*XX1(I)+SINA*SINC*DDD(I)*AAA(I)) - A(2,7)=-XMT*XMR*(COSA*COSC*FFF(I)*AAA(I)+SINA*SINC*DDD(I)*XX1(I)) - A(2,8)=-XMQ4*(COSA*SINC*FFF(I)*AAA(I)+SINA*COSC*DDD(I)*XX1(I)) - - A(3,1)=-COSA*COSC*EEE(I)*XX2(I)-SINA*SINC*CCC(I)*BBB(I) - A(3,2)=XMG*XMB*(COSA*SINC*EEE(I)*XX2(I)+SINA*COSC*CCC(I)*BBB(I)) - A(3,3)=XMG*XMR*(COSA*SINC*EEE(I)*BBB(I)+SINA*COSC*CCC(I)*XX2(I)) - A(3,4)=-XMB*XMR*(COSA*COSC*EEE(I)*BBB(I)+SINA*SINC*CCC(I)*XX2(I)) - A(3,5)=-XMG*XMT*(COSA*SINC*CCC(I)*BBB(I)+SINA*COSC*EEE(I)*XX2(I)) - A(3,6)=XMT*XMB*(COSA*COSC*CCC(I)*BBB(I)+SINA*SINC*EEE(I)*XX2(I)) - A(3,7)=XMT*XMR*(COSA*COSC*CCC(I)*XX2(I)+SINA*SINC*EEE(I)*BBB(I)) - A(3,8)=-XMQ4*(COSA*SINC*CCC(I)*XX2(I)+SINA*COSC*EEE(I)*BBB(I)) - - A(4,1)=-COSA*SINC*FFF(I)*XX2(I)-SINA*COSC*DDD(I)*BBB(I) - A(4,2)=-XMG*XMB*(COSA*COSC*FFF(I)*XX2(I)+SINA*SINC*DDD(I)*BBB(I)) - A(4,3)=-XMG*XMR*(COSA*COSC*FFF(I)*BBB(I)+SINA*SINC*DDD(I)*XX2(I)) - A(4,4)=-XMB*XMR*(COSA*SINC*FFF(I)*BBB(I)+SINA*COSC*DDD(I)*XX2(I)) - A(4,5)=-XMG*XMT*(COSA*COSC*DDD(I)*BBB(I)+SINA*SINC*FFF(I)*XX2(I)) - A(4,6)=-XMT*XMB*(COSA*SINC*DDD(I)*BBB(I)+SINA*COSC*FFF(I)*XX2(I)) - A(4,7)=-XMT*XMR*(COSA*SINC*DDD(I)*XX2(I)+SINA*COSC*FFF(I)*BBB(I)) - A(4,8)=-XMQ4*(COSA*COSC*DDD(I)*XX2(I)+SINA*SINC*FFF(I)*BBB(I)) - - SMAX=(XMG-ABS(XMR))**2 - SMIN=(XMB+XMT)**2+0.1D0 - - DO 120 LIN=0,NN-1 - SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) - AM=(XMG2-XMR2)*(XMT2-XMB2)/2D0/SBAR - GRS=SBAR-XMQ2 - W=PYLAMF(SBAR,XMB2,XMT2)*PYLAMF(SBAR,XMG2,XMR2) - W=DSQRT(W)/2D0/SBAR - ANT1=LOG(ABS((GRS/2D0+AM+XMST(1)-W)/(GRS/2D0+AM+XMST(1)+W))) - ANT2=LOG(ABS((GRS/2D0+AM+XMST(3)-W)/(GRS/2D0+AM+XMST(3)+W))) - ANB1=LOG(ABS((GRS/2D0-AM+XMSB(1)-W)/(GRS/2D0-AM+XMSB(1)+W))) - ANB2=LOG(ABS((GRS/2D0-AM+XMSB(2)-W)/(GRS/2D0-AM+XMSB(2)+W))) - SUMME(LIN)=-ULR(1)*W+(ULR(1)*(XMQ2/2D0-XMST(1)-XMG*XMT*SIN2A) - & +2D0*XX1(I)*AAA(I)*XMR*XMB)*ANT1 - & +(ULR(1)/2D0*(XMST(1)*(XMQ2-XMST(1))-XMGTBR - & -2D0*XMG*XMT*SIN2A*(XMST(1)-XMB2-XMR2)) - & +2D0*XX1(I)*AAA(I)*XMR*XMB*(XMST(1)-XMG2-XMT2) - & +4D0*SIN2A*XX1(I)*AAA(I)*XMQ4) - & *(1D0/(GRS/2D0+AM+XMST(1)-W)-1D0/(GRS/2D0+AM+XMST(1)+W)) - SUMME(LIN)=SUMME(LIN)-ULR(2)*W - & +(ULR(2)*(XMQ2/2D0-XMST(3)+XMG*XMT*SIN2A) - & -2D0*XX2(I)*BBB(I)*XMR*XMB)*ANT2 - & +(ULR(2)/2D0*(XMST(3)*(XMQ2-XMST(3))-XMGTBR - & +2D0*XMG*XMT*SIN2A*(XMST(3)-XMB2-XMR2)) - & -2D0*XX2(I)*BBB(I)*XMR*XMB*(XMST(3)-XMG2-XMT2) - & +4D0*SIN2A*XX2(I)*BBB(I)*XMQ4) - & *(1D0/(GRS/2D0+AM+XMST(3)-W)-1D0/(GRS/2D0+AM+XMST(3)+W)) - SUMME(LIN)=SUMME(LIN)-VLR(1)*W - & +(VLR(1)*(XMQ2/2D0-XMSB(1)-XMG*XMB*SIN2C) - & +2D0*CCC(I)*EEE(I)*XMR*XMT)*ANB1 - & +(VLR(1)/2D0*(XMSB(1)*(XMQ2-XMSB(1))-XMGBTR - & -2D0*XMG*XMB*SIN2C*(XMSB(1)-XMT2-XMR2)) - & +2D0*CCC(I)*EEE(I)*XMR*XMT*(XMSB(1)-XMG2-XMB2) - & +4D0*SIN2C*CCC(I)*EEE(I)*XMQ4) - & *(1D0/(GRS/2D0-AM+XMSB(1)-W)-1D0/(GRS/2D0-AM+XMSB(1)+W)) - SUMME(LIN)=SUMME(LIN)-VLR(2)*W - & +(VLR(2)*(XMQ2/2D0-XMSB(2)+XMG*XMB*SIN2C) - & -2D0*DDD(I)*FFF(I)*XMR*XMT)*ANB2 - & +(VLR(2)/2D0*(XMSB(2)*(XMQ2-XMSB(2))-XMGBTR - & +2D0*XMG*XMB*SIN2C*(XMSB(2)-XMT2-XMR2)) - & -2D0*DDD(I)*FFF(I)*XMR*XMT*(XMSB(2)-XMG2-XMB2) - & +4D0*SIN2C*DDD(I)*FFF(I)*XMQ4) - & *(1D0/(GRS/2D0-AM+XMSB(2)-W)-1D0/(GRS/2D0-AM+XMSB(2)+W)) - SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMT*COS2A/(XMST(3)-XMST(1)) - & *((AAA(I)*BBB(I)-XX1(I)*XX2(I)) - & *((XMST(3)-XMB2-XMR2)*ANT2-(XMST(1)-XMB2-XMR2)*ANT1) - & +2D0*(AAA(I)*XX2(I)-XX1(I)*BBB(I))*XMB*XMR*(ANT2-ANT1)) - SUMME(LIN)=SUMME(LIN)+2D0*XMG*XMB*COS2C/(XMSB(2)-XMSB(1)) - & *((EEE(I)*FFF(I)-CCC(I)*DDD(I)) - & *((XMSB(2)-XMT2-XMR2)*ANB2-(XMSB(1)-XMT2-XMR2)*ANB1) - & +2D0*(EEE(I)*DDD(I)-CCC(I)*FFF(I))*XMT*XMR*(ANB2-ANB1)) - DO 110 J=1,4 - SUMME(LIN)=SUMME(LIN)-2D0*A(J,1)*W - & +((-A(J,1)*(XMSB(J)*(GRS+XMSB(J))+XMQ3) - & +A(J,2)*(XMSB(J)-XMT2-XMR2)+A(J,3)*(SBAR-XMB2-XMT2) - & +A(J,4)*(XMSB(J)+SBAR-XMB2-XMR2) - & -A(J,5)*(XMSB(J)+SBAR-XMG2-XMT2)+A(J,6)*(XMG2+XMR2-SBAR) - & -A(J,7)*(XMSB(J)-XMG2-XMB2)+2D0*A(J,8)) - & *LOG(ABS((GRS/2D0+XMSB(J)-AM-W)/(GRS/2D0+XMSB(J)-AM+W))) - & -(A(J,1)*(XMST(J)*(GRS+XMST(J))+XMQ3) - & +A(J,2)*(XMST(J)+SBAR-XMG2-XMB2)-A(J,3)*(SBAR-XMB2-XMT2) - & +A(J,4)*(XMST(J)-XMG2-XMT2)-A(J,5)*(XMST(J)-XMR2-XMB2) - & -A(J,6)*(XMG2+XMR2-SBAR) - & -A(J,7)*(XMST(J)+SBAR-XMT2-XMR2)-2D0*A(J,8)) - & *LOG(ABS((GRS/2D0+XMST(J)+AM-W)/(GRS/2D0+XMST(J)+AM+W)))) - & /(GRS+XMSB(J)+XMST(J)) - 110 CONTINUE - 120 CONTINUE - SUMME(NN)=0D0 - GAM= ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) - &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) - - RETURN - END - - -C********************************************************************* - -C...PYTBBN -C...Calculates the three-body decay of gluinos into -C...neutralinos and third generation fermions. - - SUBROUTINE PYTBBN(I,NN,E,XMGLU,GAM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - EXTERNAL PYSIMP,PYLAMF - DOUBLE PRECISION PYSIMP,PYLAMF - INTEGER LIN,NN - DOUBLE PRECISION COSD,SIND,COSD2,SIND2,COS2D,SIN2D - DOUBLE PRECISION HL,HR,FL,FR,HL2,HR2,FL2,FR2 - DOUBLE PRECISION XMS2(2),XM,XM2,XMG,XMG2,XMR,XMR2 - DOUBLE PRECISION SBAR,SMIN,SMAX,XMQA,W,GRS,G(0:6),SUMME(0:100) - DOUBLE PRECISION FF,HH,HFL,HFR,HRFL,HLFR,XMQ4,XM24 - DOUBLE PRECISION XLN1,XLN2,B1,B2 - DOUBLE PRECISION E,XMGLU,GAM - DOUBLE PRECISION HRB(4),HLB(4),FLB(4),FRB(4) - SAVE HRB,HLB,FLB,FRB - DOUBLE PRECISION ALPHAW,ALPHAS - DOUBLE PRECISION HLT(4),HRT(4),FLT(4),FRT(4) - SAVE HLT,HRT,FLT,FRT - DOUBLE PRECISION AMN(4),AN(4,4),ZN(3) - SAVE AMN,AN,ZN - DOUBLE PRECISION AMBOT,SINC,COSC - DOUBLE PRECISION AMTOP,SINA,COSA - DOUBLE PRECISION SINW,COSW,TANW - DOUBLE PRECISION ROT1(4,4) - LOGICAL IFIRST - SAVE IFIRST - DATA IFIRST/.TRUE./ - - TANB=RMSS(5) - SINB=TANB/SQRT(1D0+TANB**2) - COSB=SINB/TANB - XW=PARU(102) - SINW=SQRT(XW) - COSW=SQRT(1D0-XW) - TANW=SINW/COSW - AMW=PMAS(24,1) - COSC=SFMIX(5,1) - SINC=SFMIX(5,3) - COSA=SFMIX(6,1) - SINA=SFMIX(6,3) - AMBOT=PYMRUN(5,XMGLU**2) - AMTOP=PYMRUN(6,XMGLU**2) - W2=SQRT(2D0) - FAKT1=AMBOT/W2/AMW/COSB - FAKT2=AMTOP/W2/AMW/SINB - IF(IFIRST) THEN - DO 110 II=1,4 - AMN(II)=SMZ(II) - DO 100 J=1,4 - ROT1(II,J)=0D0 - AN(II,J)=0D0 - 100 CONTINUE - 110 CONTINUE - ROT1(1,1)=COSW - ROT1(1,2)=-SINW - ROT1(2,1)=-ROT1(1,2) - ROT1(2,2)=ROT1(1,1) - ROT1(3,3)=COSB - ROT1(3,4)=SINB - ROT1(4,3)=-ROT1(3,4) - ROT1(4,4)=ROT1(3,3) - DO 140 II=1,4 - DO 130 J=1,4 - DO 120 JJ=1,4 - AN(II,J)=AN(II,J)+ZMIX(II,JJ)*ROT1(JJ,J) - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - DO 150 J=1,4 - ZN(1)=-FAKT2*(-SINB*AN(J,3)+COSB*AN(J,4)) - ZN(2)=-2D0*W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) - ZN(3)=-2*W2/3D0*SINW*AN(J,1)-W2*(0.5D0-2D0/3D0* - & XW)*AN(J,2)/COSW - HRT(J)=ZN(1)*COSA-ZN(3)*SINA - HLT(J)=ZN(1)*COSA+ZN(2)*SINA - FLT(J)=ZN(3)*COSA+ZN(1)*SINA - FRT(J)=ZN(2)*COSA-ZN(1)*SINA -C FLU(J)=ZN(3) -C FRU(J)=ZN(2) - ZN(1)=-FAKT1*(COSB*AN(J,3)+SINB*AN(J,4)) - ZN(2)=W2/3D0*SINW*(TANW*AN(J,2)-AN(J,1)) - ZN(3)=W2/3D0*SINW*AN(J,1)+W2*(0.5D0-XW/3D0)*AN(J,2)/COSW - HRB(J)=ZN(1)*COSC-ZN(3)*SINC - HLB(J)=ZN(1)*COSC+ZN(2)*SINC - FLB(J)=ZN(3)*COSC+ZN(1)*SINC - FRB(J)=ZN(2)*COSC-ZN(1)*SINC -C FLD(J)=ZN(3) -C FRD(J)=ZN(2) - 150 CONTINUE -C AMST(1)=PMAS(PYCOMP(KSUSY1+6),1) -C AMST(2)=PMAS(PYCOMP(KSUSY2+6),1) -C AMSB(1)=PMAS(PYCOMP(KSUSY1+5),1) -C AMSB(2)=PMAS(PYCOMP(KSUSY2+5),1) - IFIRST=.FALSE. - ENDIF - - IF(NINT(3D0*E).EQ.2) THEN - HL=HLT(I) - HR=HRT(I) - FL=FLT(I) - FR=FRT(I) - COSD=SFMIX(6,1) - SIND=SFMIX(6,3) - XMS2(1)=PMAS(PYCOMP(KSUSY1+6),1)**2 - XMS2(2)=PMAS(PYCOMP(KSUSY2+6),1)**2 - XM=PMAS(6,1) - ELSE - HL=HLB(I) - HR=HRB(I) - FL=FLB(I) - FR=FRB(I) - COSD=SFMIX(5,1) - SIND=SFMIX(5,3) - XMS2(1)=PMAS(PYCOMP(KSUSY1+5),1)**2 - XMS2(2)=PMAS(PYCOMP(KSUSY2+5),1)**2 - XM=PMAS(5,1) - ENDIF - COSD2=COSD*COSD - SIND2=SIND*SIND - COS2D=COSD2-SIND2 - SIN2D=SIND*COSD*2D0 - HL2=HL*HL - HR2=HR*HR - FL2=FL*FL - FR2=FR*FR - FF=FL*FR - HH=HL*HR - HFL=HL*FL - HFR=HR*FR - HRFL=HR*FL - HLFR=HL*FR - XM2=XM*XM - XMG=XMGLU - XMG2=XMG*XMG - ALPHAW=PYALEM(XMG2) - ALPHAS=PYALPS(XMG2) - XMR=AMN(I) - XMR2=XMR*XMR - XMQ4=XMG*XM2*XMR - XM24=(XMG2+XM2)*(XM2+XMR2) - SMIN=4D0*XM2 - SMAX=(XMG-ABS(XMR))**2 - XMQA=XMG2+2D0*XM2+XMR2 - DO 170 LIN=1,NN-1 - SBAR=SMIN+DBLE(LIN)*(SMAX-SMIN)/DBLE(NN) - GRS=SBAR-XMQA - W=PYLAMF(XMG2,XMR2,SBAR)*(0.25D0-XM2/SBAR) - W=DSQRT(W) - XLN1=LOG(ABS((GRS/2D0+XMS2(1)-W)/(GRS/2D0+XMS2(1)+W))) - XLN2=LOG(ABS((GRS/2D0+XMS2(2)-W)/(GRS/2D0+XMS2(2)+W))) - B1=1D0/(GRS/2D0+XMS2(1)-W)-1D0/(GRS/2D0+XMS2(1)+W) - B2=1D0/(GRS/2D0+XMS2(2)-W)-1D0/(GRS/2D0+XMS2(2)+W) - G(0)=-2D0*(HL2+FL2+HR2+FR2+(HFR-HFL)*SIN2D - & +2D0*(FF*SIND2-HH*COSD2))*W - G(1)=((HL2+FL2)*(XMQA-2D0*XMS2(1)-2D0*XM*XMG*SIN2D) - & +4D0*HFL*XM*XMR)*XLN1 - & +((HL2+FL2)*((XMQA-XMS2(1))*XMS2(1)-XM24 - & +2D0*XM*XMG*(XM2+XMR2-XMS2(1))*SIN2D) - & -4D0*HFL*XMR*XM*(XMG2+XM2-XMS2(1)) - & +8D0*HFL*XMQ4*SIN2D)*B1 - G(2)=((HR2+FR2)*(XMQA-2D0*XMS2(2)+2D0*XM*XMG*SIN2D) - & +4D0*HFR*XMR*XM)*XLN2 - & +((HR2+FR2)*((XMQA-XMS2(2))*XMS2(2)-XM24 - & +2D0*XMG*XM*SIN2D*(XMS2(2)-XM2-XMR2)) - & +4D0*HFR*XM*XMR*(XMS2(2)-XMG2-XM2) - & -8D0*HFR*XMQ4*SIN2D)*B2 - G(3)=(2D0*HFL*SIN2D*(XMS2(1)*(GRS+XMS2(1))+XM2*(SBAR-XMG2-XMR2) - & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HL2*SIND2+FL2*COSD2)*SBAR - & -2D0*XMG*XM*HFL*(SBAR+XMR2-XMG2) - & +XMR*XM*(HL2+FL2)*SIN2D*(SBAR+XMG2-XMR2) - & -4D0*XMQ4*(HL2-FL2)*COS2D)/(GRS+2D0*XMS2(1))*XLN1 - G(4)=4D0*COS2D*XM*XMG/(XMS2(1)-XMS2(2))* - & (((HLFR+HRFL)*(XM2+XMR2)+2D0*XM*XMR*(HH+FF))*(XLN1-XLN2) - & +(HLFR+HRFL)*(XMS2(2)*XLN2-XMS2(1)*XLN1)) - G(5)=(2D0*(HH*COSD2-FF*SIND2) - & *((XMS2(2)*(XMS2(2)+GRS)+XM2*XM2+XMG2*XMR2)*XLN2 - & +(XMS2(1)*(XMS2(1)+GRS)+XM2*XM2+XMG2*XMR2)*XLN1) - & +XM*((HH-FF)*SIN2D*XMG-(HRFL-HLFR)*XMR) - & *((GRS+XMS2(1)*2D0)*XLN1-(GRS+XMS2(2)*2D0)*XLN2) - & +((HRFL-HLFR)*XMR*(SIN2D*XMG*(SBAR-4D0*XM2) - & +COS2D*XM*(SBAR+XMG2-XMR2)) - & +2D0*(FF*COSD2-HH*SIND2)*XM2*(SBAR-XMG2-XMR2)) - & *(XLN1+XLN2))/(GRS+XMS2(1)+XMS2(2)) - G(6)=(-2D0*HFR*SIN2D*(XMS2(2)*(GRS+XMS2(2))+XM2*(SBAR-XMG2-XMR2) - & +XMG2*XMR2+XM2*XM2)-2D0*XMR*XMG*(HR2*SIND2+FR2*COSD2)*SBAR - & -2D0*XMG*XM*HFR*(SBAR+XMR2-XMG2) - & -XMR*XM*(HR2+FR2)*SIN2D*(SBAR+XMG2-XMR2) - & -4D0*XMQ4*(HR2-FR2)*COS2D)/(GRS+2D0*XMS2(2))*XLN2 - SUMME(LIN)=0D0 - DO 160 J=0,6 - SUMME(LIN)=SUMME(LIN)+G(J) - 160 CONTINUE - 170 CONTINUE - SUMME(0)=0D0 - SUMME(NN)=0D0 - GAM = ALPHAW * ALPHAS * PYSIMP(SUMME,SMIN,SMAX,NN) - &/ (16D0 * PARU(1) * PARU(102) * XMGLU**3) - - RETURN - END - -C********************************************************************* - -C...PYTBDY -C...Generates 3-body decays of gauginos. - - SUBROUTINE PYTBDY(IDIN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) -C COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) -C COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) -C SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYPARS/,/PYSSMT/ - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION XM(5) - COMPLEX*16 OLPP,ORPP,QLL,QLR,QRR,QRL,GLIJ,GRIJ,PROPZ - COMPLEX*16 QLLS,QRRS,QLRS,QRLS,QLLU,QRRU,QLRT,QRLT - COMPLEX*16 ZMIXC(4,4),UMIXC(2,2),VMIXC(2,2) - DOUBLE PRECISION S12MIN,S12MAX,YJACO1,S23AVE,S23DF1,S23DF2 - DOUBLE PRECISION D1,D2,D3,P1,P2,P3,CTHE1,STHE1,CTHE3,STHE3 - DOUBLE PRECISION CPHI1,SPHI1 - DOUBLE PRECISION S23DEL,EPS - DOUBLE PRECISION GOLDEN,AX,BX,CX,TOL,XMIN,R,C - PARAMETER (R=0.61803399D0,C=1D0-R,TOL=1D-3) - DOUBLE PRECISION F1,F2,X0,X1,X2,X3 - INTEGER INOID(4) - DATA INOID/22,23,25,35/ - DATA EPS/1D-6/ - - ID=IDIN - ISKIP=1 - XM(1)=P(N+1,5) - XM(2)=P(N+2,5) - XM(3)=P(N+3,5) - XM(5)=P(ID,5) - -C...GENERATE S12 - S12MIN=(XM(1)+XM(2))**2 - S12MAX=(XM(5)-XM(3))**2 - YJACO1=S12MAX-S12MIN - -C...Initialize some parameters - XW=PARU(102) - XW1=1D0-XW - TANW=SQRT(XW/XW1) - IZID1=0 - IWID1=0 - IZID2=0 - IWID2=0 - DO 100 I1=1,4 - IF(MOD(K(N+1,2),KSUSY1).EQ.INOID(I1)) IZID1=I1 - IF(MOD(K(ID,2),KSUSY1).EQ.INOID(I1)) IZID2=I1 - 100 CONTINUE - IF(MOD(K(N+1,2),KSUSY1).EQ.24) IWID1=1 - IF(MOD(K(N+1,2),KSUSY1).EQ.37) IWID1=2 - IF(MOD(K(ID,2),KSUSY1).EQ.24) IWID2=1 - IF(MOD(K(ID,2),KSUSY1).EQ.37) IWID2=2 - IA=K(N+2,2) - JA=K(N+3,2) - ZM12=XM(5)**2 - ZM22=XM(1)**2 - EI=KCHG(IABS(IA),1)/3D0 - T3I=SIGN(1D0,EI+1D-6)/2D0 - IF(MAX(ABS(IA),ABS(JA)).EQ.6) THEN - ISKIP=0 - ELSEIF(IZID1*IZID2.NE.0) THEN - SQMZ=PMAS(23,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - DO 110 I=1,4 - ZMIXC(IZID1,I)=DCMPLX(ZMIX(IZID1,I),ZMIXI(IZID1,I)) - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 110 CONTINUE - OLPP=(ZMIXC(IZID1,3)*DCONJG(ZMIXC(IZID2,3))- - & ZMIXC(IZID1,4)*DCONJG(ZMIXC(IZID2,4)))/2D0 - ORPP=DCONJG(OLPP) - XLL2=PMAS(PYCOMP(KSUSY1+IABS(IA)),1)**2 - XLR2=XLL2 - XRR2=PMAS(PYCOMP(KSUSY2+IABS(IA)),1)**2 - XRL2=XRR2 - GLIJ=(T3I*ZMIXC(IZID1,2)-TANW*(T3I-EI)*ZMIXC(IZID1,1))* - & DCONJG(T3I*ZMIXC(IZID2,2)-TANW*(T3I-EI)*ZMIXC(IZID2,1)) - GRIJ=ZMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1))*(EI*TANW)**2 - XM1M2=SMZ(IZID1)*SMZ(IZID2) - QLLS=DCMPLX((T3I-EI*XW)/XW1)*OLPP - QLLU=-GLIJ - QLRS=-DCMPLX((T3I-EI*XW)/XW1)*ORPP - QLRT=DCONJG(GLIJ) - QRLS=-DCMPLX((EI*XW)/XW1)*OLPP - QRLT=GRIJ - QRRS=DCMPLX((EI*XW)/XW1)*ORPP - QRRU=-DCONJG(GRIJ) - ELSEIF(IZID1*IWID2.NE.0.OR.IZID2*IWID1.NE.0) THEN - IF(IZID1.NE.0) THEN - XM1M2=SMZ(IZID1)*SMW(IWID2) - IZID1=IWID2 - IZID2=IZID1 - ELSE - XM1M2=SMZ(IZID2)*SMW(IWID1) - IZID1=IWID1 - ENDIF - RT2I = 1D0/SQRT(2D0) - SQMZ=PMAS(24,1)**2 - GMMZ=PMAS(24,1)*PMAS(24,2) - DO 120 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - 120 CONTINUE - DO 130 I=1,4 - ZMIXC(IZID2,I)=DCMPLX(ZMIX(IZID2,I),ZMIXI(IZID2,I)) - 130 CONTINUE - QLLS=(DCONJG(ZMIXC(IZID2,2))*VMIXC(IZID1,1)- - & DCONJG(ZMIXC(IZID2,4))*VMIXC(IZID1,2)*RT2I) - QLRS=(ZMIXC(IZID2,2)*DCONJG(UMIXC(IZID1,1))+ - & ZMIXC(IZID2,3)*DCONJG(UMIXC(IZID1,2))*RT2I) - EJ=KCHG(JA,1)/3D0 - T3J=SIGN(1D0,EJ+1D-6)/2D0 - QRLS=DCMPLX(0D0,0D0) - QRLT=QRLS - QRRS=QRLS - QRRU=QRLS - XRR2=1D6**2 - XRL2=XRR2 - XLR2 = PMAS(PYCOMP(KSUSY1+JA),1)**2 - XLL2 = PMAS(PYCOMP(KSUSY1+IA),1)**2 - IF(MOD(IA,2).EQ.0) THEN - QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EI-T3I)* - & TANW+ZMIXC(IZID2,2)*T3I) - QLRT=-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EJ-T3J)*TANW+ZMIXC(IZID2,2)*T3J) - ELSE - QLLU=VMIXC(IZID1,1)*DCONJG(ZMIXC(IZID2,1)*(EJ-T3J)* - & TANW+ZMIXC(IZID2,2)*T3J) - QLRT=-DCONJG(UMIXC(IZID1,1))*( - & ZMIXC(IZID2,1)*(EI-T3I)*TANW+ZMIXC(IZID2,2)*T3I) - ENDIF - ELSEIF(IWID1*IWID2.NE.0) THEN - IZID1=IWID1 - IZID2=IWID2 - XM1M2=SMW(IWID1)*SMW(IWID2) - SQMZ=PMAS(23,1)**2 - GMMZ=PMAS(23,1)*PMAS(23,2) - DO 140 I=1,2 - VMIXC(IZID1,I)=DCMPLX(VMIX(IZID1,I),VMIXI(IZID1,I)) - UMIXC(IZID1,I)=DCMPLX(UMIX(IZID1,I),UMIXI(IZID1,I)) - VMIXC(IZID2,I)=DCMPLX(VMIX(IZID2,I),VMIXI(IZID2,I)) - UMIXC(IZID2,I)=DCMPLX(UMIX(IZID2,I),UMIXI(IZID2,I)) - 140 CONTINUE - OLPP=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))- - & VMIXC(IZID2,2)*DCONJG(VMIXC(IZID1,2))/2D0 - ORPP=-UMIXC(IZID1,1)*DCONJG(UMIXC(IZID2,1))- - & UMIXC(IZID1,2)*DCONJG(UMIXC(IZID2,2))/2D0 - QRLS=-DCMPLX(EI/XW1)*ORPP - QLLS=DCMPLX((T3I-XW*EI)/XW/XW1)*ORPP - QRRS=-DCMPLX(EI/XW1)*OLPP - QLRS=DCMPLX((T3I-XW*EI)/XW/XW1)*OLPP - IF(MOD(IA,2).EQ.0) THEN - XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)-1),1)**2 - QLRT=-UMIXC(IZID2,1)*DCONJG(UMIXC(IZID1,1))*DCMPLX(T3I/XW) - ELSE - XLR2=PMAS(PYCOMP(KSUSY1+IABS(IA)+1),1)**2 - QLRT=-VMIXC(IZID2,1)*DCONJG(VMIXC(IZID1,1))*DCMPLX(T3I/XW) - ENDIF - ELSEIF(MOD(K(N+1,2),KSUSY1).EQ.21.OR.MOD(K(ID,2),KSUSY1).EQ.21) - &THEN - ISKIP=0 - ELSE - ISKIP=0 - ENDIF - - IF(ISKIP.NE.0) THEN - WTMAX=0D0 - DO 160 KT=1,100 - S12=S12MIN+YJACO1*(KT-1)/99 - S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) - & *(S12+XM(3)**2-XM(5)**2)/(2D0*S12) - S23DF1=(S12-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(S12-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) - S23DEL=S23DEL/EPS - S23MIN=S23AVE-S23DEL - S23MAX=S23AVE+S23DEL - YJACO2=S23MAX-S23MIN - TH=S12 - DO 150 KS=1,100 - S23=S23MIN+YJACO2*(KS-1)/99 - SH=S23 - UH=ZM12+ZM22-SH-TH - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = XM1M2*SH - PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 - PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) - QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) - QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) - QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) - QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) - WT0=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ - & (ABS(QRL)**2+ABS(QLR)**2)*WT2+ - & 2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) - IF(WT0.GT.WTMAX) WTMAX=WT0 - 150 CONTINUE - 160 CONTINUE - - WTMAX=WTMAX*1.05D0 - ENDIF - -C...FIND S12* - AX=S12MIN - CX=S12MAX - BX=S12MIN+0.5D0*YJACO1 - X0=AX - X3=CX - IF(ABS(CX-BX).GT.ABS(BX-AX))THEN - X1=BX - X2=BX+C*(CX-BX) - ELSE - X2=BX - X1=BX-C*(BX-AX) - ENDIF - -C...SOLVE FOR F1 AND F2 - S23DF1=(X1-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(X1-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) - F1=-2D0*S23DEL/EPS - S23DF1=(X2-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(X2-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) - F2=-2D0*S23DEL/EPS - - 170 IF(ABS(X3-X0).GT.TOL*(ABS(X1)+ABS(X2)))THEN -C...Possibility of infinite loop with .LT.; changed to .LE. (SKANDS) - IF(F2.LE.F1)THEN - X0=X1 - X1=X2 - X2=R*X1+C*X3 - F1=F2 - S23DF1=(X2-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(X2-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X2) - F2=-2D0*S23DEL/EPS - ELSE - X3=X2 - X2=X1 - X1=R*X2+C*X0 - F2=F1 - S23DF1=(X1-XM(2)**2-XM(1)**2)**2 - & -(2D0*XM(1)*XM(2))**2 - S23DF2=(X1-XM(3)**2-XM(5)**2)**2 - & -(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*X1) - F1=-2D0*S23DEL/EPS - ENDIF - GOTO 170 - ENDIF -C...WE WANT THE MAXIMUM, NOT THE MINIMUM - IF(F1.LT.F2)THEN - GOLDEN=-F1 - XMIN=X1 - ELSE - GOLDEN=-F2 - XMIN=X2 - ENDIF - - IKNT=0 - 180 S12=S12MIN+PYR(0)*YJACO1 - IKNT=IKNT+1 -C...GENERATE S23 - S23AVE=XM(2)**2+XM(3)**2-(S12+XM(2)**2-XM(1)**2) - &*(S12+XM(3)**2-XM(5)**2)/(2D0*S12) - S23DF1=(S12-XM(2)**2-XM(1)**2)**2 - &-(2D0*XM(1)*XM(2))**2 - S23DF2=(S12-XM(3)**2-XM(5)**2)**2 - &-(2D0*XM(3)*XM(5))**2 - S23DF1=S23DF1*EPS - S23DF2=S23DF2*EPS - S23DEL=SQRT(MAX(0D0,S23DF1*S23DF2))/(2D0*S12) - S23DEL=S23DEL/EPS - S23MIN=S23AVE-S23DEL - S23MAX=S23AVE+S23DEL - YJACO2=S23MAX-S23MIN - S23=S23MIN+PYR(0)*YJACO2 - -C...CHECK THE SAMPLING - IF(IKNT.GT.100) THEN - WRITE(MSTU(11),*) ' IKNT > 100 IN PYTBDY ' - GOTO 190 - ENDIF - IF(YJACO2.LT.PYR(0)*GOLDEN) GOTO 180 - - IF(ISKIP.EQ.0) GOTO 190 - - SH=S23 - TH=S12 - UH=ZM12+ZM22-SH-TH - - WU2 = (UH-ZM12)*(UH-ZM22) - WT2 = (TH-ZM12)*(TH-ZM22) - WS2 = XM1M2*SH - PROPZ2 = (SH-SQMZ)**2 + GMMZ**2 - PROPZ=DCMPLX(SH-SQMZ,-GMMZ)/DCMPLX(PROPZ2) - - QLL=QLLS*PROPZ+QLLU/DCMPLX(UH-XLL2) - QLR=QLRS*PROPZ+QLRT/DCMPLX(TH-XLR2) - QRL=QRLS*PROPZ+QRLT/DCMPLX(TH-XRL2) - QRR=QRRS*PROPZ+QRRU/DCMPLX(UH-XRR2) -c QLL=DCMPLX((T3I-EI*XW)/XW1)*OLPP*PROPZ-GLIJ/DCMPLX(UH-XML2) -c QLR=-DCMPLX((T3I-EI*XW)/XW1)*ORPP*PROPZ+DCONJG(GLIJ) -c &/DCMPLX(TH-XML2) -c QRL=-DCMPLX((EI*XW)/XW1)*OLPP*PROPZ+GRIJ/DCMPLX(TH-XMR2) -c QRR=DCMPLX((EI*XW)/XW1)*ORPP*PROPZ -c &-DCONJG(GRIJ)/DCMPLX(UH-XMR2) - WT=-((ABS(QLL)**2+ABS(QRR)**2)*WU2+ - &(ABS(QRL)**2+ABS(QLR)**2)*WT2+ - &2D0*DBLE(QLR*DCONJG(QLL)+QRL*DCONJG(QRR))*WS2) - - IF(WT.LT.PYR(0)*WTMAX) GOTO 180 - IF(WT.GT.WTMAX) PRINT*,' WT > WTMAX ',WT,WTMAX - - 190 D3=(XM(5)**2+XM(3)**2-S12)/(2D0*XM(5)) - D1=(XM(5)**2+XM(1)**2-S23)/(2D0*XM(5)) - D2=XM(5)-D1-D3 - P1=SQRT(D1*D1-XM(1)**2) - P2=SQRT(D2*D2-XM(2)**2) - P3=SQRT(D3*D3-XM(3)**2) - CTHE1=2D0*PYR(0)-1D0 - ANG1=2D0*PYR(0)*PARU(1) - CPHI1=COS(ANG1) - SPHI1=SIN(ANG1) - ARG=1D0-CTHE1**2 - IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 - STHE1=SQRT(ARG) - P(N+1,1)=P1*STHE1*CPHI1 - P(N+1,2)=P1*STHE1*SPHI1 - P(N+1,3)=P1*CTHE1 - P(N+1,4)=D1 - -C...GET CPHI3 - ANG3=2D0*PYR(0)*PARU(1) - CPHI3=COS(ANG3) - SPHI3=SIN(ANG3) - CTHE3=(P2**2-P1**2-P3**2)/2D0/P1/P3 - ARG=1D0-CTHE3**2 - IF(ARG.LT.0D0.AND.ARG.GT.-1D-3) ARG=0D0 - STHE3=SQRT(ARG) - P(N+3,1)=-P3*STHE3*CPHI3*CTHE1*CPHI1 - &+P3*STHE3*SPHI3*SPHI1 - &+P3*CTHE3*STHE1*CPHI1 - P(N+3,2)=-P3*STHE3*CPHI3*CTHE1*SPHI1 - &-P3*STHE3*SPHI3*CPHI1 - &+P3*CTHE3*STHE1*SPHI1 - P(N+3,3)=P3*STHE3*CPHI3*STHE1 - &+P3*CTHE3*CTHE1 - P(N+3,4)=D3 - - DO 200 I=1,3 - P(N+2,I)=-P(N+1,I)-P(N+3,I) - 200 CONTINUE - P(N+2,4)=D2 - - RETURN - END -C------------------------------------------------------------------ - SUBROUTINE PYTBHB(MT,MB,MHP,BR,GAMT) -C WIDTH AND BRANCHING RATIO FOR (ON-SHELL) T-> B W+, T->B H+ - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW,KFUN - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYCTBH/ - -C TOP WIDTH CALCULATION -C VTB = 0.99 - MW=DSQRT(MW2) - XB=(MB/MT)**2 - XW=(MW/MT)**2 - XH =(MHP/MT)**2 - GAMTBH = 0D0 - IF (MT .LT. (MHP+MB)) THEN -C T ->B W ONLY - BETW = DSQRT(1.D0-2*(XB+XW)+(XW-XB)**2) - GAMTBW = VTB**2*ALPHA/(16*SW2)*MT/XW*BETW* - & (2*(1.D0-XB-XW)-(1.D0+XB-XW)*(1.D0-XB -2*XW) ) - GAMT = GAMTBW - ELSE -C T ->BW +T ->B H^+ - BETW = DSQRT(1.D0-2*(XB+XW)+(XW-XB)**2) - GAMTBW = VTB**2*ALPHA/(16*SW2)*MT/XW*BETW* - & (2*(1.D0-XB-XW)-(1.D0+XB-XW)*(1.D0-XB -2*XW) ) -C - KFUN = DSQRT( (1.D0-(MHP/MT)**2-(MB/MT)**2)**2 - & -4.D0*(MHP*MB/MT**2)**2 ) - GAMTBH= ALPHA/SW2/8.D0*VTB**2*KFUN/MT * - & (V**2*((MT+MB)**2-MHP**2)+A**2*((MT-MB)**2-MHP**2)) - GAMT = GAMTBW+GAMTBH - ENDIF -C THUS BR IS - BR=GAMTBH/GAMT - RETURN - END - -C AMPLITUDE SQUARED (MATRIX ELEMENTS) FOR THE PROCESSES: -C GG->TBH^+, QQBAR->TBH^+ -C AS A FUNCTION OF 4-MOMENTA FOR SUITABLE INTERFACE -C (FOR INSTANCE WITH PYTHIA) -C------------------------------------------------------------ -C BASED ON F. BORZUMATI, J.-L. KNEUR, N. POLONSKY HEP-PH/9905443, -C PHYS REV. D 60 (1999) 115011 -C (THESE FILES PREPARED BY J.-L. KNEUR) -C------------------------------------------------------------ -C 1) GG->TBH^+ - SUBROUTINE PYTBHG(Q1,Q2,P1,P2,P3,MT,MB,RMB,MHP,AMP2) -C -C CONVENTIONS AND INPUT/OUTPUT DEFINITIONS: -C -C INPUT: Q1,Q2 ARE ENTERING 4-MOMENTA OF INITIAL GLUONS OR QUARKS; -C P1, P2 ARE THE TOP AND BOTTOM OUTGOING 4-MOMENTA; -C P3 IS OUTGOING CHARGED HIGGS 4-MOMENTA. -C (NB FOR ALL 4-MOMENTA P(4) IS TIME-COMPONENT) -C "PHYSICAL PARAMETERS" INPUT: -C MT,MB TOP AND BOTTOM MASSES; -C MHP CHARGED HIGGS MASS -C FURTHER PARAMETERS INPUT IS NEEDED FROM COMMON/PARAM/ (SEE BELOW) -C -C OUTPUT: AMP2 IS MATRIX ELEMENT (AMPLITUDE**2) FOR GG->TB H^+ -C (NB AMP2 IS TRULY AMPLITUDE SQUARRED, I.E. WITHOUT ANY -C PHASE SPACE FACTORS INCLUDED. IT INCLUDES COLOUR AND COUPLING -C FACTORS, AS EXPLICIT BELOW. ACCORDINGLY, FOR EXAMPLE THE TOTAL -C CROSS-SECTION SHOULD BE (SYMBOLICALLY): -C SIGMA = INTEGRATE [PARTON DENSITY FUNCTIONS * 3-PARTICLE FINAL -C STATE PHASE-SPACE (STANDARDLY NORMALIZED) * AMP2 ] -C - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW - DIMENSION Q1(4),Q2(4),P1(4),P2(4),P3(4) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYCTBH/ -C !THE RELEVANT INPUT PARAMETERS ABOVE ARE NEEDED FOR CALCULATION -C BUT ARE NOT DEFINED HERE SO THAT ONE MAY CHOOSE/VARY THEIR VALUES: -C ACCORDINGLY, WHEN CALLING THESE SUBROUTINES, PLEASE SUPPLY VIA -C THIS COMMON/PARAM/ YOUR PREFERRED ALPHA, ALPHAS,..AND TANB (TAN BETA) VALUES -C -C THE NORMALIZED V,A COUPLINGS ARE DEFINED BELOW AND USED BOTH -C IN THIS ROUTINE AND IN THE TOP WIDTH CALCULATION PYTBHB(..). - - PI = 4*DATAN(1.D0) - MW = DSQRT(MW2) -C -C COLLECTING THE RELEVANT OVERALL FACTORS: -C 8X8 INITIAL GLUON COLOR AVERAGE, 2X2 GLUON SPIN AVERAGE - PS=1.D0/(8.D0*8.D0 *2.D0*2.D0) -C COUPLING CONSTANT (OVERALL NORMALIZATION) - FACT=(4.D0*PI*ALPHA)*(4.D0*PI*ALPHAS)**2/SW2/2.D0 -C NB ALPHA IS E^2/4/PI, BUT BETTER DEFINED IN TERMS OF G_FERMI: -C ALPHA= DSQRT(2.D0)*GF*SW2*MW**2/PI -C ALPHAS IS ALPHA_STRONG; -C SW2 IS SIN(THETA_W)**2. -C -C VTB=.998D0 -C VTB IS TOP-BOTTOM CKM MATRIX ELEMENT (APPROXIMATE VALUE HERE) -C - V = ( MT/MW/TANB +RMB/MW*TANB)/2.D0 - A = (-MT/MW/TANB +RMB/MW*TANB)/2.D0 -C V AND A ARE (NORMALIZED) VECTOR AND AXIAL TBH^+ COUPLINGS -C -C REDEFINING P2 INGOING FROM OVERALL MOMENTUM CONSERVATION -C (BECAUSE P2 INGOING WAS USED IN OUR GRAPH CALCULATION CONVENTIONS) - DO KK=1,4 - P2(KK)=P3(KK)-Q1(KK)-Q2(KK)+P1(KK) - ENDDO -C DEFINING VARIOUS RELEVANT 4-SCALAR PRODUCTS: - S = 2*PYTBHS(Q1,Q2) - P1Q1=PYTBHS(Q1,P1) - P1Q2=PYTBHS(P1,Q2) - P2Q1=PYTBHS(P2,Q1) - P2Q2=PYTBHS(P2,Q2) - P1P2=PYTBHS(P1,P2) -C -C TOP WIDTH CALCULATION - CALL PYTBHB(MT,MB,MHP,BR,GAMT) -C GAMT IS THE TOP WIDTH: T->BH^+ AND/OR T->B W^+ -C THEN DEFINE TOP (RESONANT) PROPAGATOR: - A1INV= S -2*P1Q1 -2*P1Q2 - A1 =A1INV/(A1INV**2+ (GAMT*MT)**2) -C (I.E. INTRODUCE THE TOP WIDTH IN A1 TO REGULARISE THE POLE) -C NB: A12 = A1*A1 BUT CORRECT EXPRESSION BELOW BECAUSE OF -C THE TOP WIDTH - A12 = 1.D0/(A1INV**2+ (GAMT*MT)**2) - A2 =1.D0/(S +2*P2Q1 +2*P2Q2) -C NOTE A2 IS B PROPAGATOR, DOES NOT NEED A WIDTH -C NOW COMES THE AMP**2: -C NB COLOR FACTOR (COMING FROM GRAPHS) ALREADY INCLUDED IN -C THE EXPRESSIONS BELOW - V18=0.D0 - A18=0.D0 - V18= 640*A1/3+640*A2/3+32*A1*A2*MB**2-368*A12*MB*MT- - &512*A1*A2*MB*MT/3- - &368*A2**2*MB*MT+32*A1*A2*MT**2+496*A12*P1P2/3+ - &320*A1*A2*P1P2+496*A2**2*P1P2/3+128*A1*MB*MT**3/(3*P1Q1**2)+ - &128*A1*MT**4/(3*P1Q1**2)-256*A12*MB*MT**5/(3*P1Q1**2)+ - &256*A1*MT**2*P1P2/(3*P1Q1**2)-256*A12*MT**4*P1P2/(3*P1Q1**2)+ - &8/(3*P1Q1)-32*A1*MB*MT/P1Q1-56*A2*MB*MT/(3*P1Q1)+ - &88*A1*MT**2/(3*P1Q1)+72*A2*MT**2/P1Q1+ - &704*A12*MB*MT**3/(3*P1Q1)-224*A1*A2*MB*MT**3/(3*P1Q1)+ - &104*A1*P1P2/(3*P1Q1)+48*A2*P1P2/P1Q1+ - &128*A1*A2*MB*MT*P1P2/(3*P1Q1)+512*A12*MT**2*P1P2/(3*P1Q1)- - &448*A1*A2*MT**2*P1P2/(3*P1Q1)-32*A1*A2*P1P2**2/P1Q1- - &656*A1*A2*P1Q1/3-224*A2**2*P1Q1+128*A1*MB*MT**3/(3*P1Q2**2)+ - &128*A1*MT**4/(3*P1Q2**2)-256*A12*MB*MT**5/(3*P1Q2**2)+ - &256*A1*MT**2*P1P2/(3*P1Q2**2)-256*A12*MT**4*P1P2/(3*P1Q2**2)+ - &256*A1*MT**2*P1Q1/(3*P1Q2**2)+256*A12*MB*MT**3*P1Q1/(3*P1Q2**2)+ - &8/(3*P1Q2)-32*A1*MB*MT/P1Q2-56*A2*MB*MT/(3*P1Q2) - V18=V18+88*A1*MT**2/(3*P1Q2)+72*A2*MT**2/P1Q2+ - &704*A12*MB*MT**3/(3*P1Q2)-224*A1*A2*MB*MT**3/(3*P1Q2)+ - &104*A1*P1P2/(3*P1Q2)+48*A2*P1P2/P1Q2+ - &128*A1*A2*MB*MT*P1P2/(3*P1Q2)+512*A12*MT**2*P1P2/(3*P1Q2)- - &448*A1*A2*MT**2*P1P2/(3*P1Q2)-32*A1*A2*P1P2**2/P1Q2- - &32*A1*MB*MT**3/(3*P1Q1*P1Q2)-32*A1*MT**4/(3*P1Q1*P1Q2)+ - &64*A12*MB*MT**5/(3*P1Q1*P1Q2)+16*P1P2/(3*P1Q1*P1Q2)- - &64*A1*MT**2*P1P2/(3*P1Q1*P1Q2)+64*A12*MT**4*P1P2/(3*P1Q1*P1Q2)+ - &112*A1*P1Q1/P1Q2+272*A2*P1Q1/(3*P1Q2)- - &272*A1*A2*MB**2*P1Q1/(3*P1Q2)+208*A12*MB*MT*P1Q1/(3*P1Q2)- - &400*A1*A2*MB*MT*P1Q1/(3*P1Q2)-80*A1*A2*MT**2*P1Q1/P1Q2+ - &96*A12*P1P2*P1Q1/P1Q2-320*A1*A2*P1P2*P1Q1/P1Q2- - &544*A1*A2*P1Q1**2/(3*P1Q2)-656*A1*A2*P1Q2/3-224*A2**2*P1Q2+ - &256*A1*MT**2*P1Q2/(3*P1Q1**2)+256*A12*MB*MT**3*P1Q2/(3*P1Q1**2)+ - &112*A1*P1Q2/P1Q1+272*A2*P1Q2/(3*P1Q1)- - &272*A1*A2*MB**2*P1Q2/(3*P1Q1)+208*A12*MB*MT*P1Q2/(3*P1Q1)- - &400*A1*A2*MB*MT*P1Q2/(3*P1Q1)-80*A1*A2*MT**2*P1Q2/P1Q1 - V18=V18+96*A12*P1P2*P1Q2/P1Q1-320*A1*A2*P1P2*P1Q2/P1Q1- - &544*A1*A2*P1Q2**2/(3*P1Q1)+128*A2*MB**4/(3*P2Q1**2)+ - &128*A2*MB**3*MT/(3*P2Q1**2)-256*A2**2*MB**5*MT/(3*P2Q1**2)+ - &256*A2*MB**2*P1P2/(3*P2Q1**2)-256*A2**2*MB**4*P1P2/(3*P2Q1**2)+ - &256*A2*MB**2*P1Q1/(3*P2Q1**2)-256*A2**2*MB**4*P1Q1/(3*P2Q1**2)- - &64*MB**3*MT**3/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1**2)+ - &64*MB**3*MT/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**3*MT*P1Q1/(3*P1Q2*P2Q1**2)+ - &512*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q1**2)-8/(3*P2Q1)-72*A1*MB**2/P2Q1- - &88*A2*MB**2/(3*P2Q1)+56*A1*MB*MT/(3*P2Q1)+32*A2*MB*MT/P2Q1+ - &224*A1*A2*MB**3*MT/(3*P2Q1)-704*A2**2*MB**3*MT/(3*P2Q1) - V18=V18-48*A1*P1P2/P2Q1-104*A2*P1P2/(3*P2Q1)+ - &448*A1*A2*MB**2*P1P2/(3*P2Q1)-512*A2**2*MB**2*P1P2/(3*P2Q1)- - &128*A1*A2*MB*MT*P1P2/(3*P2Q1)+32*A1*A2*P1P2**2/P2Q1- - &16*P1P2/(3*P1Q1*P2Q1)-32*A1*MB*MT*P1P2/(3*P1Q1*P2Q1)- - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q1)- - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**3/(3*P1Q1*P2Q1)-256*A2*P1Q1/(3*P2Q1)+ - &448*A1*A2*MB**2*P1Q1/(3*P2Q1)-368*A2**2*MB**2*P1Q1/(3*P2Q1)+ - &224*A1*A2*MB*MT*P1Q1/(3*P2Q1)+304*A1*A2*P1P2*P1Q1/(3*P2Q1)- - &64*MB*MT**3/(3*P1Q2**2*P2Q1)- - &256*A1*MB*MT**3*P1P2/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2**2/(3*P1Q2**2*P2Q1)+ - &64*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB*MT**3*P1Q1/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2*P1Q1/(3*P1Q2**2*P2Q1)-4*MB**2/(3*P1Q2*P2Q1)+ - &64*MB*MT/(3*P1Q2*P2Q1)-128*A2*MB**3*MT/(3*P1Q2*P2Q1) - V18=V18-4*MT**2/(3*P1Q2*P2Q1)-128*A1*MB**2*MT**2/(3*P1Q2*P2Q1)- - &128*A2*MB**2*MT**2/(3*P1Q2*P2Q1)-128*A1*MB*MT**3/(3*P1Q2*P2Q1)- - &112*A2*MB**2*P1P2/(3*P1Q2*P2Q1)-32*A1*MB*MT*P1P2/(3*P1Q2*P2Q1)- - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q1)-112*A1*MT**2*P1P2/(3*P1Q2*P2Q1)- - &48*A1*P1P2**2/(P1Q2*P2Q1)-48*A2*P1P2**2/(P1Q2*P2Q1)+ - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2**3/(3*P1Q2*P2Q1)-8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+8*P1Q1/(3*P1Q2*P2Q1)- - &160*A1*MB**2*P1Q1/(3*P1Q2*P2Q1)-272*A2*MB**2*P1Q1/(3*P1Q2*P2Q1)+ - &56*A1*MB*MT*P1Q1/(3*P1Q2*P2Q1)+200*A2*MB*MT*P1Q1/(3*P1Q2*P2Q1)- - &48*A1*P1P2*P1Q1/(P1Q2*P2Q1)-256*A2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1)+ - &1024*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q1) - V18=V18-272*A2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1Q1**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P1Q1**2/(3*P1Q2*P2Q1)+16*A2*P1Q2/(3*P2Q1)+ - &64*A1*A2*MB**2*P1Q2/P2Q1+32*A2**2*MB**2*P1Q2/(3*P2Q1)+ - &112*A1*A2*MB*MT*P1Q2/(3*P2Q1)+368*A1*A2*P1P2*P1Q2/(3*P2Q1)+ - &32*A2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB*MT*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q1)+224*A12*P2Q1+ - &656*A1*A2*P2Q1/3-256*A1*MT**2*P2Q1/(3*P1Q1**2)+ - &256*A12*MT**4*P2Q1/(3*P1Q1**2)-256*A1*P2Q1/(3*P1Q1)+ - &224*A1*A2*MB*MT*P2Q1/(3*P1Q1)-368*A12*MT**2*P2Q1/(3*P1Q1)+ - &448*A1*A2*MT**2*P2Q1/(3*P1Q1)+304*A1*A2*P1P2*P2Q1/(3*P1Q1)+ - &256*A12*MT**4*P2Q1/(3*P1Q2**2)+ - &256*A12*MT**2*P1Q1*P2Q1/(3*P1Q2**2)+16*A1*P2Q1/(3*P1Q2)+ - &112*A1*A2*MB*MT*P2Q1/(3*P1Q2)+32*A12*MT**2*P2Q1/(3*P1Q2) - V18=V18+64*A1*A2*MT**2*P2Q1/P1Q2+368*A1*A2*P1P2*P2Q1/(3*P1Q2)+ - &16*A1*MT**2*P2Q1/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q1/(3*P1Q1*P1Q2)+ - &640*A12*P1Q1*P2Q1/(3*P1Q2)+544*A1*A2*P1Q1*P2Q1/(3*P1Q2)+ - &32*A12*P1Q2*P2Q1/P1Q1+944*A1*A2*P1Q2*P2Q1/(3*P1Q1)+ - &128*A2*MB**4/(3*P2Q2**2)+128*A2*MB**3*MT/(3*P2Q2**2)- - &256*A2**2*MB**5*MT/(3*P2Q2**2)+256*A2*MB**2*P1P2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1P2/(3*P2Q2**2)- - &64*MB**3*MT**3/(3*P1Q1**2*P2Q2**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q1**2*P2Q2**2)+ - &64*MB**3*MT/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q1*P2Q2**2)- - &256*A2**2*MB**4*P1Q1/(3*P2Q2**2)+256*A2*MB**2*P1Q2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q2**2)- - &64*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2**2)+ - &256*A2*MB**3*MT*P1Q2/(3*P1Q1*P2Q2**2)+ - &512*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2**2) - V18=V18+256*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P2Q1/(3*P2Q2**2)-256*A2**2*MB**3*MT*P2Q1/(3*P2Q2**2)+ - &64*MB**2*MT**2*P2Q1/(3*P1Q1**2*P2Q2**2)+ - &64*MB**2*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**3*MT*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*MT**2*P2Q1/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P1P2*P2Q1/(3*P1Q1*P2Q2**2)+ - &256*A2**2*MB**2*P1Q1*P2Q1/(3*P2Q2**2)- - &256*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2**2)-8/(3*P2Q2)- - &72*A1*MB**2/P2Q2-88*A2*MB**2/(3*P2Q2)+56*A1*MB*MT/(3*P2Q2)+ - &32*A2*MB*MT/P2Q2+224*A1*A2*MB**3*MT/(3*P2Q2)- - &704*A2**2*MB**3*MT/(3*P2Q2)-48*A1*P1P2/P2Q2- - &104*A2*P1P2/(3*P2Q2)+448*A1*A2*MB**2*P1P2/(3*P2Q2)- - &512*A2**2*MB**2*P1P2/(3*P2Q2)-128*A1*A2*MB*MT*P1P2/(3*P2Q2)+ - &32*A1*A2*P1P2**2/P2Q2-64*MB*MT**3/(3*P1Q1**2*P2Q2)- - &256*A1*MB*MT**3*P1P2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2**2/(3*P1Q1**2*P2Q2)-4*MB**2/(3*P1Q1*P2Q2) - V18=V18+64*MB*MT/(3*P1Q1*P2Q2)-128*A2*MB**3*MT/(3*P1Q1*P2Q2)- - &4*MT**2/(3*P1Q1*P2Q2)-128*A1*MB**2*MT**2/(3*P1Q1*P2Q2)- - &128*A2*MB**2*MT**2/(3*P1Q1*P2Q2)-128*A1*MB*MT**3/(3*P1Q1*P2Q2)- - &112*A2*MB**2*P1P2/(3*P1Q1*P2Q2)-32*A1*MB*MT*P1P2/(3*P1Q1*P2Q2)- - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q2)-112*A1*MT**2*P1P2/(3*P1Q1*P2Q2)- - &48*A1*P1P2**2/(P1Q1*P2Q2)-48*A2*P1P2**2/(P1Q1*P2Q2)+ - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2**3/(3*P1Q1*P2Q2)+16*A2*P1Q1/(3*P2Q2)+ - &64*A1*A2*MB**2*P1Q1/P2Q2+32*A2**2*MB**2*P1Q1/(3*P2Q2)+ - &112*A1*A2*MB*MT*P1Q1/(3*P2Q2)+368*A1*A2*P1P2*P1Q1/(3*P2Q2)- - &16*P1P2/(3*P1Q2*P2Q2)-32*A1*MB*MT*P1P2/(3*P1Q2*P2Q2)- - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q2)- - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**3/(3*P1Q2*P2Q2)-8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q2) - V18=V18+32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB*MT*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q2)-256*A2*P1Q2/(3*P2Q2)+ - &448*A1*A2*MB**2*P1Q2/(3*P2Q2)-368*A2**2*MB**2*P1Q2/(3*P2Q2)+ - &224*A1*A2*MB*MT*P1Q2/(3*P2Q2)+304*A1*A2*P1P2*P1Q2/(3*P2Q2)+ - &64*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB*MT**3*P1Q2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2*P1Q2/(3*P1Q1**2*P2Q2)+8*P1Q2/(3*P1Q1*P2Q2)- - &160*A1*MB**2*P1Q2/(3*P1Q1*P2Q2)-272*A2*MB**2*P1Q2/(3*P1Q1*P2Q2)+ - &56*A1*MB*MT*P1Q2/(3*P1Q1*P2Q2)+200*A2*MB*MT*P1Q2/(3*P1Q1*P2Q2)- - &48*A1*P1P2*P1Q2/(P1Q1*P2Q2)-256*A2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2)+ - &1024*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q2) - V18=V18-272*A2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1Q2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2*P1Q2**2/(3*P1Q1*P2Q2)-32*A2*MB**4/(3*P2Q1*P2Q2)- - &32*A2*MB**3*MT/(3*P2Q1*P2Q2)+64*A2**2*MB**5*MT/(3*P2Q1*P2Q2)+ - &16*P1P2/(3*P2Q1*P2Q2)-64*A2*MB**2*P1P2/(3*P2Q1*P2Q2)+ - &64*A2**2*MB**4*P1P2/(3*P2Q1*P2Q2)+8*MB**2*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &8*MB*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q1/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q1/(3*P2Q1*P2Q2)+ - &8*MB**2*P1P2/(3*P1Q2*P2Q1*P2Q2)+8*MB*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1*P2Q2)+ - &16*MB*MT*P1P2**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) - V18=V18+16*P1P2**3/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q2/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q2/(3*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1*P2Q2)+272*A1*P2Q1/(3*P2Q2)+ - &112*A2*P2Q1/P2Q2-80*A1*A2*MB**2*P2Q1/P2Q2- - &400*A1*A2*MB*MT*P2Q1/(3*P2Q2)+208*A2**2*MB*MT*P2Q1/(3*P2Q2)- - &272*A1*A2*MT**2*P2Q1/(3*P2Q2)-320*A1*A2*P1P2*P2Q1/P2Q2+ - &96*A2**2*P1P2*P2Q1/P2Q2+256*A1*MB*MT**3*P2Q1/(3*P1Q1**2*P2Q2)+ - &512*A1*MT**2*P1P2*P2Q1/(3*P1Q1**2*P2Q2)-8*P2Q1/(3*P1Q1*P2Q2)- - &200*A1*MB*MT*P2Q1/(3*P1Q1*P2Q2)-56*A2*MB*MT*P2Q1/(3*P1Q1*P2Q2)+ - &272*A1*MT**2*P2Q1/(3*P1Q1*P2Q2)+160*A2*MT**2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*P1P2*P2Q1/(3*P1Q1*P2Q2)+48*A2*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q1*P2Q2)- - &1024*A1*A2*P1P2**2*P2Q1/(3*P1Q1*P2Q2)- - &544*A1*A2*P1Q1*P2Q1/(3*P2Q2)-640*A2**2*P1Q1*P2Q1/(3*P2Q2)- - &32*A1*P1P2*P2Q1/(3*P1Q2*P2Q2) - V18=V18+32*A1*A2*MB*MT*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &64*A1*A2*P1P2**2*P2Q1/(3*P1Q2*P2Q2)- - &32*A1*MT**2*P1P2*P2Q1/(3*P1Q1*P1Q2*P2Q2)+ - &64*A1*A2*P1P2*P1Q1*P2Q1/(3*P1Q2*P2Q2)- - &944*A1*A2*P1Q2*P2Q1/(3*P2Q2)-32*A2**2*P1Q2*P2Q1/P2Q2+ - &256*A1*MT**2*P1Q2*P2Q1/(3*P1Q1**2*P2Q2)+ - &96*A1*P1Q2*P2Q1/(P1Q1*P2Q2)+96*A2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MT**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &512*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &512*A1*A2*P1Q2**2*P2Q1/(3*P1Q1*P2Q2)+544*A1*A2*P2Q1**2/(3*P2Q2)- - &256*A1*MT**2*P2Q1**2/(3*P1Q1**2*P2Q2)- - &272*A1*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MT**2*P2Q1**2/(3*P1Q1*P2Q2) - V18=V18+512*A1*A2*P1P2*P2Q1**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1Q2*P2Q1**2/(3*P1Q1*P2Q2)+224*A12*P2Q2+ - &656*A1*A2*P2Q2/3+256*A12*MT**4*P2Q2/(3*P1Q1**2)+ - &16*A1*P2Q2/(3*P1Q1)+112*A1*A2*MB*MT*P2Q2/(3*P1Q1)+ - &32*A12*MT**2*P2Q2/(3*P1Q1)+64*A1*A2*MT**2*P2Q2/P1Q1+ - &368*A1*A2*P1P2*P2Q2/(3*P1Q1)-256*A1*MT**2*P2Q2/(3*P1Q2**2)+ - &256*A12*MT**4*P2Q2/(3*P1Q2**2)-256*A1*P2Q2/(3*P1Q2)+ - &224*A1*A2*MB*MT*P2Q2/(3*P1Q2)-368*A12*MT**2*P2Q2/(3*P1Q2)+ - &448*A1*A2*MT**2*P2Q2/(3*P1Q2)+304*A1*A2*P1P2*P2Q2/(3*P1Q2)+ - &16*A1*MT**2*P2Q2/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q2/(3*P1Q1*P1Q2)+ - &32*A12*P1Q1*P2Q2/P1Q2+944*A1*A2*P1Q1*P2Q2/(3*P1Q2)+ - &256*A12*MT**2*P1Q2*P2Q2/(3*P1Q1**2)+ - &640*A12*P1Q2*P2Q2/(3*P1Q1)+544*A1*A2*P1Q2*P2Q2/(3*P1Q1)- - &256*A2*MB**2*P2Q2/(3*P2Q1**2)-256*A2**2*MB**3*MT*P2Q2/(3*P2Q1**2)+ - &64*MB**2*MT**2*P2Q2/(3*P1Q2**2*P2Q1**2)+ - &64*MB**2*P2Q2/(3*P1Q2*P2Q1**2)- - &128*A2*MB**3*MT*P2Q2/(3*P1Q2*P2Q1**2) - V18=V18-128*A2*MB**2*MT**2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1P2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1**2)+ - &256*A2**2*MB**2*P1Q2*P2Q2/(3*P2Q1**2)+272*A1*P2Q2/(3*P2Q1)+ - &112*A2*P2Q2/P2Q1-80*A1*A2*MB**2*P2Q2/P2Q1- - &400*A1*A2*MB*MT*P2Q2/(3*P2Q1)+208*A2**2*MB*MT*P2Q2/(3*P2Q1)- - &272*A1*A2*MT**2*P2Q2/(3*P2Q1)-320*A1*A2*P1P2*P2Q2/P2Q1+ - &96*A2**2*P1P2*P2Q2/P2Q1-32*A1*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MB*MT*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &64*A1*A2*P1P2**2*P2Q2/(3*P1Q1*P2Q1)-944*A1*A2*P1Q1*P2Q2/(3*P2Q1)- - &32*A2**2*P1Q1*P2Q2/P2Q1+256*A1*MB*MT**3*P2Q2/(3*P1Q2**2*P2Q1)+ - &512*A1*MT**2*P1P2*P2Q2/(3*P1Q2**2*P2Q1)+ - &256*A1*MT**2*P1Q1*P2Q2/(3*P1Q2**2*P2Q1)-8*P2Q2/(3*P1Q2*P2Q1)- - &200*A1*MB*MT*P2Q2/(3*P1Q2*P2Q1)-56*A2*MB*MT*P2Q2/(3*P1Q2*P2Q1)+ - &272*A1*MT**2*P2Q2/(3*P1Q2*P2Q1)+160*A2*MT**2*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*P1P2*P2Q2/(3*P1Q2*P2Q1)+48*A2*P1P2*P2Q2/(P1Q2*P2Q1) - V18=V18-256*A1*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1)- - &256*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q2*P2Q1)- - &1024*A1*A2*P1P2**2*P2Q2/(3*P1Q2*P2Q1)- - &32*A1*MT**2*P1P2*P2Q2/(3*P1Q1*P1Q2*P2Q1)+ - &96*A1*P1Q1*P2Q2/(P1Q2*P2Q1)+96*A2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MT**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &512*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &512*A1*A2*P1Q1**2*P2Q2/(3*P1Q2*P2Q1)-544*A1*A2*P1Q2*P2Q2/(3*P2Q1)- - &640*A2**2*P1Q2*P2Q2/(3*P2Q1)+ - &64*A1*A2*P1P2*P1Q2*P2Q2/(3*P1Q1*P2Q1)+544*A1*A2*P2Q2**2/(3*P2Q1)- - &256*A1*MT**2*P2Q2**2/(3*P1Q2**2*P2Q1)- - &272*A1*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MT**2*P2Q2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P2Q2**2/(3*P1Q2*P2Q1) - V18=V18+512*A1*A2*P1Q1*P2Q2**2/(3*P1Q2*P2Q1)+ - &384*A12*MB*MT*P1Q1**2/S**2+ - &384*A12*P1P2*P1Q1**2/S**2+2688*A12*MB*MT*P1Q1*P1Q2/S**2+ - &2688*A12*P1P2*P1Q1*P1Q2/S**2+384*A12*MB*MT*P1Q2**2/S**2+ - &384*A12*P1P2*P1Q2**2/S**2+768*A1*A2*MB*MT*P1Q1*P2Q1/S**2+ - &768*A1*A2*P1P2*P1Q1*P2Q1/S**2+2688*A1*A2*MB*MT*P1Q2*P2Q1/S**2+ - &2688*A1*A2*P1P2*P1Q2*P2Q1/S**2-960*A12*P1Q1*P1Q2*P2Q1/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q1/S**2+960*A12*P1Q2**2*P2Q1/S**2+ - &960*A1*A2*P1Q2**2*P2Q1/S**2+384*A2**2*MB*MT*P2Q1**2/S**2+ - &384*A2**2*P1P2*P2Q1**2/S**2-960*A1*A2*P1Q2*P2Q1**2/S**2- - &960*A2**2*P1Q2*P2Q1**2/S**2+2688*A1*A2*MB*MT*P1Q1*P2Q2/S**2+ - &2688*A1*A2*P1P2*P1Q1*P2Q2/S**2+960*A12*P1Q1**2*P2Q2/S**2+ - &960*A1*A2*P1Q1**2*P2Q2/S**2+768*A1*A2*MB*MT*P1Q2*P2Q2/S**2+ - &768*A1*A2*P1P2*P1Q2*P2Q2/S**2-960*A12*P1Q1*P1Q2*P2Q2/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q2/S**2+2688*A2**2*MB*MT*P2Q1*P2Q2/S**2+ - &2688*A2**2*P1P2*P2Q1*P2Q2/S**2+960*A1*A2*P1Q1*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q1*P2Q1*P2Q2/S**2+960*A1*A2*P1Q2*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q2*P2Q1*P2Q2/S**2+384*A2**2*MB*MT*P2Q2**2/S**2 - V18=V18+384*A2**2*P1P2*P2Q2**2/S**2-960*A1*A2*P1Q1*P2Q2**2/S**2- - &960*A2**2*P1Q1*P2Q2**2/S**2+96*A1*MB*MT/S+96*A2*MB*MT/S- - &768*A2**2*MB**3*MT/S-768*A12*MB*MT**3/S-192*A1*P1P2/S- - &192*A2*P1P2/S-768*A2**2*MB**2*P1P2/S-2304*A1*A2*MB*MT*P1P2/S- - &768*A12*MT**2*P1P2/S-2304*A1*A2*P1P2**2/S- - &96*A1*MB*MT**3/(P1Q1*S)-192*A2*MB*MT*P1P2/(P1Q1*S)- - &96*A1*MT**2*P1P2/(P1Q1*S)-192*A2*P1P2**2/(P1Q1*S)-192*A1*P1Q1/S- - &144*A2*P1Q1/S-384*A1*A2*MB**2*P1Q1/S-480*A2**2*MB**2*P1Q1/S- - &480*A12*MB*MT*P1Q1/S+96*A1*A2*MB*MT*P1Q1/S- - &864*A12*P1P2*P1Q1/S-672*A1*A2*P1P2*P1Q1/S-96*A1*A2*P1Q1**2/S- - &96*A1*MB*MT**3/(P1Q2*S)-192*A2*MB*MT*P1P2/(P1Q2*S)- - &96*A1*MT**2*P1P2/(P1Q2*S)-192*A2*P1P2**2/(P1Q2*S)- - &48*A1*MB*MT*P1Q1/(P1Q2*S)+96*A2*MB*MT*P1Q1/(P1Q2*S)- - &48*A1*MT**2*P1Q1/(P1Q2*S)-192*A1*P1P2*P1Q1/(P1Q2*S)- - &192*A2*P1P2*P1Q1/(P1Q2*S)+192*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*S)+ - &192*A1*A2*P1P2**2*P1Q1/(P1Q2*S)-192*A1*P1Q1**2/(P1Q2*S)- - &192*A2*P1Q1**2/(P1Q2*S)+192*A1*A2*MB**2*P1Q1**2/(P1Q2*S) - V18=V18-192*A12*MB*MT*P1Q1**2/(P1Q2*S)+ - &96*A1*A2*MB*MT*P1Q1**2/(P1Q2*S)+ - &192*A1*A2*P1P2*P1Q1**2/(P1Q2*S)-192*A1*P1Q2/S-144*A2*P1Q2/S- - &384*A1*A2*MB**2*P1Q2/S-480*A2**2*MB**2*P1Q2/S- - &480*A12*MB*MT*P1Q2/S+96*A1*A2*MB*MT*P1Q2/S- - &864*A12*P1P2*P1Q2/S-672*A1*A2*P1P2*P1Q2/S- - &48*A1*MB*MT*P1Q2/(P1Q1*S)+96*A2*MB*MT*P1Q2/(P1Q1*S)- - &48*A1*MT**2*P1Q2/(P1Q1*S)-192*A1*P1P2*P1Q2/(P1Q1*S)- - &192*A2*P1P2*P1Q2/(P1Q1*S)+192*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*S)+ - &192*A1*A2*P1P2**2*P1Q2/(P1Q1*S)-576*A1*A2*P1Q1*P1Q2/S- - &96*A1*A2*P1Q2**2/S-192*A1*P1Q2**2/(P1Q1*S)- - &192*A2*P1Q2**2/(P1Q1*S)+192*A1*A2*MB**2*P1Q2**2/(P1Q1*S)- - &192*A12*MB*MT*P1Q2**2/(P1Q1*S)+96*A1*A2*MB*MT*P1Q2**2/(P1Q1*S)+ - &192*A1*A2*P1P2*P1Q2**2/(P1Q1*S)+96*A2*MB**3*MT/(P2Q1*S)+ - &96*A2*MB**2*P1P2/(P2Q1*S)+192*A1*MB*MT*P1P2/(P2Q1*S)+ - &192*A1*P1P2**2/(P2Q1*S)+96*A1*MB**2*P1Q1/(P2Q1*S)+ - &192*A2*MB**2*P1Q1/(P2Q1*S)+96*A1*MB*MT*P1Q1/(P2Q1*S)+ - &192*A1*A2*MB**3*MT*P1Q1/(P2Q1*S)+192*A1*P1P2*P1Q1/(P2Q1*S) - V18=V18+192*A1*A2*MB**2*P1P2*P1Q1/(P2Q1*S)+ - &96*A1*A2*MB**2*P1Q1**2/(P2Q1*S)+ - &192*A2*MB**3*MT*P1Q1/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*P1P2**2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &48*A1*MB*MT*P1Q1**2/(P1Q2*P2Q1*S)+ - &96*A1*P1P2*P1Q1**2/(P1Q2*P2Q1*S)+96*A1*MB**2*P1Q2/(P2Q1*S)+ - &48*A2*MB**2*P1Q2/(P2Q1*S)-192*A1*A2*MB**3*MT*P1Q2/(P2Q1*S)- - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q1*S)- - &96*A1*A2*MB**2*P1Q2**2/(P2Q1*S)+144*A1*P2Q1/S+192*A2*P2Q1/S- - &96*A1*A2*MB*MT*P2Q1/S+480*A2**2*MB*MT*P2Q1/S+ - &480*A12*MT**2*P2Q1/S+384*A1*A2*MT**2*P2Q1/S+ - &672*A1*A2*P1P2*P2Q1/S+864*A2**2*P1P2*P2Q1/S+ - &96*A2*MB*MT*P2Q1/(P1Q1*S)+192*A1*MT**2*P2Q1/(P1Q1*S) - V18=V18+96*A2*MT**2*P2Q1/(P1Q1*S)+ - &192*A1*A2*MB*MT**3*P2Q1/(P1Q1*S)+ - &192*A2*P1P2*P2Q1/(P1Q1*S)+192*A1*A2*MT**2*P1P2*P2Q1/(P1Q1*S)- - &192*A12*P1Q1*P2Q1/S-192*A2**2*P1Q1*P2Q1/S+ - &48*A1*MT**2*P2Q1/(P1Q2*S)+96*A2*MT**2*P2Q1/(P1Q2*S)- - &192*A1*A2*MB*MT**3*P2Q1/(P1Q2*S)- - &192*A1*A2*MT**2*P1P2*P2Q1/(P1Q2*S)- - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P1Q2*S)- - &192*A12*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &96*A1*A2*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &384*A1*A2*P1P2*P1Q1*P2Q1/(P1Q2*S)-384*A12*P1Q1**2*P2Q1/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q1/(P1Q2*S)-480*A12*P1Q2*P2Q1/S- - &960*A1*A2*P1Q2*P2Q1/S-480*A2**2*P1Q2*P2Q1/S+ - &144*A1*P1Q2*P2Q1/(P1Q1*S)+96*A2*P1Q2*P2Q1/(P1Q1*S)- - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*S)- - &96*A12*MT**2*P1Q2*P2Q1/(P1Q1*S)+ - &96*A1*A2*MT**2*P1Q2*P2Q1/(P1Q1*S)- - &576*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*S)-192*A12*P1Q2**2*P2Q1/(P1Q1*S) - V18=V18-384*A1*A2*P1Q2**2*P2Q1/(P1Q1*S)-96*A1*A2*P2Q1**2/S- - &96*A1*A2*MT**2*P2Q1**2/(P1Q1*S)+96*A1*A2*MT**2*P2Q1**2/(P1Q2*S)+ - &288*A1*A2*P1Q2*P2Q1**2/(P1Q1*S)+96*A2*MB**3*MT/(P2Q2*S)+ - &96*A2*MB**2*P1P2/(P2Q2*S)+192*A1*MB*MT*P1P2/(P2Q2*S)+ - &192*A1*P1P2**2/(P2Q2*S)+96*A1*MB**2*P1Q1/(P2Q2*S)+ - &48*A2*MB**2*P1Q1/(P2Q2*S)-192*A1*A2*MB**3*MT*P1Q1/(P2Q2*S)- - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q2*S)- - &96*A1*A2*MB**2*P1Q1**2/(P2Q2*S)+96*A1*MB**2*P1Q2/(P2Q2*S)+ - &192*A2*MB**2*P1Q2/(P2Q2*S)+96*A1*MB*MT*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**3*MT*P1Q2/(P2Q2*S)+192*A1*P1P2*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q2*S)+ - &192*A2*MB**3*MT*P1Q2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2**2*P1Q2/(P1Q1*P2Q2*S)+96*A1*A2*MB**2*P1Q2**2/(P2Q2*S)+ - &96*A1*MB**2*P1Q2**2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1Q2**2/(P1Q1*P2Q2*S) - V18=V18+48*A1*MB*MT*P1Q2**2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2*P1Q2**2/(P1Q1*P2Q2*S)-48*A2*MB**2*P2Q1/(P2Q2*S)+ - &96*A1*MB*MT*P2Q1/(P2Q2*S)-48*A2*MB*MT*P2Q1/(P2Q2*S)- - &192*A1*P1P2*P2Q1/(P2Q2*S)-192*A2*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*MB*MT*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*P1P2**2*P2Q1/(P2Q2*S)- - &192*A1*MB*MT**3*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &192*A1*MT**2*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2**2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &192*A2**2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P2Q2*S)+ - &384*A1*A2*P1P2*P1Q1*P2Q1/(P2Q2*S)-96*A1*P1Q2*P2Q1/(P2Q2*S)- - &144*A2*P1Q2*P2Q1/(P2Q2*S)-96*A1*A2*MB**2*P1Q2*P2Q1/(P2Q2*S)+ - &96*A2**2*MB**2*P1Q2*P2Q1/(P2Q2*S)+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P2Q2*S) - V18=V18+576*A1*A2*P1P2*P1Q2*P2Q1/(P2Q2*S)- - &96*A2*MB**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &48*A1*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &48*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*MT**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q1/(P2Q2*S)+288*A1*A2*P1Q2**2*P2Q1/(P2Q2*S)- - &96*A1*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)-96*A2*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)+ - &192*A1*P2Q1**2/(P2Q2*S)+192*A2*P2Q1**2/(P2Q2*S)- - &96*A1*A2*MB*MT*P2Q1**2/(P2Q2*S)+192*A2**2*MB*MT*P2Q1**2/(P2Q2*S)- - &192*A1*A2*MT**2*P2Q1**2/(P2Q2*S)-192*A1*A2*P1P2*P2Q1**2/(P2Q2*S)+ - &48*A2*MB*MT*P2Q1**2/(P1Q1*P2Q2*S)+ - &192*A1*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1P2*P2Q1**2/(P1Q1*P2Q2*S)-384*A1*A2*P1Q1*P2Q1**2/(P2Q2*S)- - &384*A2**2*P1Q1*P2Q1**2/(P2Q2*S)-384*A1*A2*P1Q2*P2Q1**2/(P2Q2*S) - V18=V18-192*A2**2*P1Q2*P2Q1**2/(P2Q2*S)+ - &96*A1*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+144*A1*P2Q2/S+192*A2*P2Q2/S- - &96*A1*A2*MB*MT*P2Q2/S+480*A2**2*MB*MT*P2Q2/S+ - &480*A12*MT**2*P2Q2/S+384*A1*A2*MT**2*P2Q2/S+ - &672*A1*A2*P1P2*P2Q2/S+864*A2**2*P1P2*P2Q2/S+ - &48*A1*MT**2*P2Q2/(P1Q1*S)+96*A2*MT**2*P2Q2/(P1Q1*S)- - &192*A1*A2*MB*MT**3*P2Q2/(P1Q1*S)- - &192*A1*A2*MT**2*P1P2*P2Q2/(P1Q1*S)-480*A12*P1Q1*P2Q2/S- - &960*A1*A2*P1Q1*P2Q2/S-480*A2**2*P1Q1*P2Q2/S+ - &96*A2*MB*MT*P2Q2/(P1Q2*S)+192*A1*MT**2*P2Q2/(P1Q2*S)+ - &96*A2*MT**2*P2Q2/(P1Q2*S)+192*A1*A2*MB*MT**3*P2Q2/(P1Q2*S)+ - &192*A2*P1P2*P2Q2/(P1Q2*S)+192*A1*A2*MT**2*P1P2*P2Q2/(P1Q2*S)+ - &144*A1*P1Q1*P2Q2/(P1Q2*S)+96*A2*P1Q1*P2Q2/(P1Q2*S)- - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*S)- - &96*A12*MT**2*P1Q1*P2Q2/(P1Q2*S)+ - &96*A1*A2*MT**2*P1Q1*P2Q2/(P1Q2*S) - V18=V18-576*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*S)- - &192*A12*P1Q1**2*P2Q2/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q2/(P1Q2*S)-192*A12*P1Q2*P2Q2/S- - &192*A2**2*P1Q2*P2Q2/S-96*A1*A2*MB*MT*P1Q2*P2Q2/(P1Q1*S)- - &192*A12*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &96*A1*A2*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1P2*P1Q2*P2Q2/(P1Q1*S)-384*A12*P1Q2**2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q2/(P1Q1*S)-48*A2*MB**2*P2Q2/(P2Q1*S)+ - &96*A1*MB*MT*P2Q2/(P2Q1*S)-48*A2*MB*MT*P2Q2/(P2Q1*S)- - &192*A1*P1P2*P2Q2/(P2Q1*S)-192*A2*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*MB*MT*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*P1P2**2*P2Q2/(P2Q1*S)-96*A1*P1Q1*P2Q2/(P2Q1*S)- - &144*A2*P1Q1*P2Q2/(P2Q1*S)-96*A1*A2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &96*A2**2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P2Q1*S)+ - &576*A1*A2*P1P2*P1Q1*P2Q2/(P2Q1*S)+288*A1*A2*P1Q1**2*P2Q2/(P2Q1*S)- - &192*A1*MB*MT**3*P2Q2/(P1Q2*P2Q1*S) - V18=V18-96*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &192*A1*MT**2*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2**2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*MB**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)+ - &48*A1*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S) - - V18BIS= - &48*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*MT**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)-96*A2*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)+ - &96*A1*A2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &192*A2**2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*MB*MT*P1Q2*P2Q2/(P2Q1*S)+ - &384*A1*A2*P1P2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q2/(P2Q1*S)-576*A1*A2*P2Q1*P2Q2/S+ - &96*A1*A2*P1Q1*P2Q1*P2Q2/(P1Q2*S)+96*A1*A2*P1Q2*P2Q1*P2Q2/(P1Q1*S)- - &96*A1*A2*P2Q2**2/S+96*A1*A2*MT**2*P2Q2**2/(P1Q1*S)- - &96*A1*A2*MT**2*P2Q2**2/(P1Q2*S)+288*A1*A2*P1Q1*P2Q2**2/(P1Q2*S)+ - &192*A1*P2Q2**2/(P2Q1*S)+192*A2*P2Q2**2/(P2Q1*S)- - &96*A1*A2*MB*MT*P2Q2**2/(P2Q1*S)+192*A2**2*MB*MT*P2Q2**2/(P2Q1*S)- - &192*A1*A2*MT**2*P2Q2**2/(P2Q1*S)-192*A1*A2*P1P2*P2Q2**2/(P2Q1*S) - V18BIS=V18BIS-384*A1*A2*P1Q1*P2Q2**2/(P2Q1*S)- - &192*A2**2*P1Q1*P2Q2**2/(P2Q1*S)+ - &48*A2*MB*MT*P2Q2**2/(P1Q2*P2Q1*S)+ - &192*A1*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1P2*P2Q2**2/(P1Q2*P2Q1*S)+96*A1*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)-384*A1*A2*P1Q2*P2Q2**2/(P2Q1*S)- - &384*A2**2*P1Q2*P2Q2**2/(P2Q1*S)+512*A1*A2*S/3- - &128*A1*MT**2*S/(3*P1Q1**2)-128*A12*MB*MT**3*S/(3*P1Q1**2)- - &152*A1*S/(3*P1Q1)+152*A12*MB*MT*S/(3*P1Q1)+ - &128*A1*A2*MB*MT*S/(3*P1Q1)+112*A1*A2*MT**2*S/(3*P1Q1)- - &16*A12*P1P2*S/P1Q1+152*A1*A2*P1P2*S/(3*P1Q1)- - &128*A1*MT**2*S/(3*P1Q2**2)-128*A12*MB*MT**3*S/(3*P1Q2**2)- - &152*A1*S/(3*P1Q2)+152*A12*MB*MT*S/(3*P1Q2)+ - &128*A1*A2*MB*MT*S/(3*P1Q2)+112*A1*A2*MT**2*S/(3*P1Q2)- - &16*A12*P1P2*S/P1Q2+152*A1*A2*P1P2*S/(3*P1Q2)- - &16*A1*MB*MT*S/(3*P1Q1*P1Q2)+32*A12*MB*MT**3*S/(3*P1Q1*P1Q2) - V18BIS=V18BIS-16*A1*P1P2*S/(3*P1Q1*P1Q2)+ - &272*A1*A2*P1Q1*S/(3*P1Q2)+ - &272*A1*A2*P1Q2*S/(3*P1Q1)-128*A2*MB**2*S/(3*P2Q1**2)- - &128*A2**2*MB**3*MT*S/(3*P2Q1**2)+ - &32*MB**2*MT**2*S/(3*P1Q2**2*P2Q1**2)+32*MB**2*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**3*MT*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1**2)+ - &128*A2**2*MB**2*P1Q2*S/(3*P2Q1**2)+152*A2*S/(3*P2Q1)- - &112*A1*A2*MB**2*S/(3*P2Q1)-128*A1*A2*MB*MT*S/(3*P2Q1)- - &152*A2**2*MB*MT*S/(3*P2Q1)-152*A1*A2*P1P2*S/(3*P2Q1)+ - &16*A2**2*P1P2*S/P2Q1+8*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q1)+ - &8*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q1)-8*A1*P1P2*S/(3*P1Q1*P2Q1)- - &8*A2*P1P2*S/(3*P1Q1*P2Q1)+8*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1) - V18BIS=V18BIS+8*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q1)+ - &32*A1*A2*P1P2**2*S/(3*P1Q1*P2Q1)-32*A2**2*P1Q1*S/(3*P2Q1)- - &32*MT**2*S/(3*P1Q2**2*P2Q1)+64*A1*MB**2*MT**2*S/(3*P1Q2**2*P2Q1)+ - &64*A1*MB*MT**3*S/(3*P1Q2**2*P2Q1)+ - &128*A1*MT**2*P1P2*S/(3*P1Q2**2*P2Q1)-12*S/(P1Q2*P2Q1)+ - &24*A1*MB**2*S/(P1Q2*P2Q1)-64*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q1)+ - &24*A2*MT**2*S/(P1Q2*P2Q1)-128*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q1)+56*A1*P1P2*S/(3*P1Q2*P2Q1)+ - &56*A2*P1P2*S/(3*P1Q2*P2Q1)-64*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2**2*S/(3*P1Q2*P2Q1)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+ - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+136*A2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P1Q1*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1)-160*A2**2*P1Q2*S/(3*P2Q1) - V18BIS=V18BIS+16*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1)- - &32*A12*P2Q1*S/(3*P1Q1)- - &128*A12*MT**2*P2Q1*S/(3*P1Q2**2)-160*A12*P2Q1*S/(3*P1Q2)- - &128*A2*MB**2*S/(3*P2Q2**2)-128*A2**2*MB**3*MT*S/(3*P2Q2**2)+ - &32*MB**2*MT**2*S/(3*P1Q1**2*P2Q2**2)+32*MB**2*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**3*MT*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2**2)+ - &128*A2**2*MB**2*P1Q1*S/(3*P2Q2**2)- - &128*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2**2)+152*A2*S/(3*P2Q2)- - &112*A1*A2*MB**2*S/(3*P2Q2)-128*A1*A2*MB*MT*S/(3*P2Q2)- - &152*A2**2*MB*MT*S/(3*P2Q2)-152*A1*A2*P1P2*S/(3*P2Q2)+ - &16*A2**2*P1P2*S/P2Q2-32*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB**2*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB*MT**3*S/(3*P1Q1**2*P2Q2)+ - &128*A1*MT**2*P1P2*S/(3*P1Q1**2*P2Q2)-12*S/(P1Q1*P2Q2)+ - &24*A1*MB**2*S/(P1Q1*P2Q2)-64*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q2) - V18BIS=V18BIS+24*A2*MT**2*S/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q2)+56*A1*P1P2*S/(3*P1Q1*P2Q2)+ - &56*A2*P1P2*S/(3*P1Q1*P2Q2)-64*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2**2*S/(3*P1Q1*P2Q2)-160*A2**2*P1Q1*S/(3*P2Q2)+ - &8*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q2)-8*A1*P1P2*S/(3*P1Q2*P2Q2)- - &8*A2*P1P2*S/(3*P1Q2*P2Q2)+8*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q2)+ - &32*A1*A2*P1P2**2*S/(3*P1Q2*P2Q2)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &16*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q2)-32*A2**2*P1Q2*S/(3*P2Q2) - V18BIS=V18BIS+136*A2*P1Q2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P1Q2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q2)-16*A2*MB*MT*S/(3*P2Q1*P2Q2)+ - &32*A2**2*MB**3*MT*S/(3*P2Q1*P2Q2)-16*A2*P1P2*S/(3*P2Q1*P2Q2)- - &4*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+8*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1*P2Q2)- - &8*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1*P2Q2)-4*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1*P2Q2)- - &8*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &2*MB**3*MT*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB**2*MT**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &2*MB*MT**3*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &4*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &8*P1P2**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1*P2Q2) - V18BIS=V18BIS+8*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1*P2Q2)+ - &272*A1*A2*P2Q1*S/(3*P2Q2)- - &128*A1*MT**2*P2Q1*S/(3*P1Q1**2*P2Q2)-136*A1*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MB*MT*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MT**2*P2Q1*S/(3*P1Q1*P2Q2)+ - &256*A1*A2*P1P2*P2Q1*S/(3*P1Q1*P2Q2)- - &16*A1*A2*P1P2*P2Q1*S/(3*P1Q2*P2Q2)+ - &8*A1*P1P2*P2Q1*S/(3*P1Q1*P1Q2*P2Q2)+ - &256*A1*A2*P1Q2*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A12*MT**2*P2Q2*S/(3*P1Q1**2)-160*A12*P2Q2*S/(3*P1Q1)- - &32*A12*P2Q2*S/(3*P1Q2)+272*A1*A2*P2Q2*S/(3*P2Q1)- - &16*A1*A2*P1P2*P2Q2*S/(3*P1Q1*P2Q1)- - &128*A1*MT**2*P2Q2*S/(3*P1Q2**2*P2Q1)-136*A1*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MT**2*P2Q2*S/(3*P1Q2*P2Q1)+ - &256*A1*A2*P1P2*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A1*P1P2*P2Q2*S/(3*P1Q1*P1Q2*P2Q1) - V18BIS=V18BIS+256*A1*A2*P1Q1*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A12*MB*MT*S**2/(3*P1Q1*P1Q2)+16*A12*P1P2*S**2/(3*P1Q1*P1Q2)- - &8*A1*A2*P1P2*S**2/(3*P1Q1*P2Q1)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*A2*P1P2*S**2/(3*P1Q2*P2Q2)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q2)+ - &8*A2**2*MB*MT*S**2/(3*P2Q1*P2Q2)+16*A2**2*P1P2*S**2/(3*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q1*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q2*P2Q1*P2Q2)+ - &2*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) -C - - A18 = 640*A1/3+640*A2/3+32*A1*A2*MB**2+368*A12*MB*MT+ - &512*A1*A2*MB*MT/3+ - &368*A2**2*MB*MT+32*A1*A2*MT**2+496*A12*P1P2/3+ - &320*A1*A2*P1P2+496*A2**2*P1P2/3-128*A1*MB*MT**3/(3*P1Q1**2)+ - &128*A1*MT**4/(3*P1Q1**2)+256*A12*MB*MT**5/(3*P1Q1**2)+ - &256*A1*MT**2*P1P2/(3*P1Q1**2)-256*A12*MT**4*P1P2/(3*P1Q1**2)+ - &8/(3*P1Q1)+32*A1*MB*MT/P1Q1+56*A2*MB*MT/(3*P1Q1)+ - &88*A1*MT**2/(3*P1Q1)+72*A2*MT**2/P1Q1- - &704*A12*MB*MT**3/(3*P1Q1)+224*A1*A2*MB*MT**3/(3*P1Q1)+ - &104*A1*P1P2/(3*P1Q1)+48*A2*P1P2/P1Q1- - &128*A1*A2*MB*MT*P1P2/(3*P1Q1)+512*A12*MT**2*P1P2/(3*P1Q1)- - &448*A1*A2*MT**2*P1P2/(3*P1Q1)-32*A1*A2*P1P2**2/P1Q1- - &656*A1*A2*P1Q1/3-224*A2**2*P1Q1-128*A1*MB*MT**3/(3*P1Q2**2)+ - &128*A1*MT**4/(3*P1Q2**2)+256*A12*MB*MT**5/(3*P1Q2**2)+ - &256*A1*MT**2*P1P2/(3*P1Q2**2)-256*A12*MT**4*P1P2/(3*P1Q2**2)+ - &256*A1*MT**2*P1Q1/(3*P1Q2**2)-256*A12*MB*MT**3*P1Q1/(3*P1Q2**2)+ - &8/(3*P1Q2)+32*A1*MB*MT/P1Q2+56*A2*MB*MT/(3*P1Q2) - A18=A18+88*A1*MT**2/(3*P1Q2)+72*A2*MT**2/P1Q2- - &704*A12*MB*MT**3/(3*P1Q2)+224*A1*A2*MB*MT**3/(3*P1Q2)+ - &104*A1*P1P2/(3*P1Q2)+48*A2*P1P2/P1Q2- - &128*A1*A2*MB*MT*P1P2/(3*P1Q2)+512*A12*MT**2*P1P2/(3*P1Q2)- - &448*A1*A2*MT**2*P1P2/(3*P1Q2)-32*A1*A2*P1P2**2/P1Q2+ - &32*A1*MB*MT**3/(3*P1Q1*P1Q2)-32*A1*MT**4/(3*P1Q1*P1Q2)- - &64*A12*MB*MT**5/(3*P1Q1*P1Q2)+16*P1P2/(3*P1Q1*P1Q2)- - &64*A1*MT**2*P1P2/(3*P1Q1*P1Q2)+64*A12*MT**4*P1P2/(3*P1Q1*P1Q2)+ - &112*A1*P1Q1/P1Q2+272*A2*P1Q1/(3*P1Q2)- - &272*A1*A2*MB**2*P1Q1/(3*P1Q2)-208*A12*MB*MT*P1Q1/(3*P1Q2)+ - &400*A1*A2*MB*MT*P1Q1/(3*P1Q2)-80*A1*A2*MT**2*P1Q1/P1Q2+ - &96*A12*P1P2*P1Q1/P1Q2-320*A1*A2*P1P2*P1Q1/P1Q2- - &544*A1*A2*P1Q1**2/(3*P1Q2)-656*A1*A2*P1Q2/3-224*A2**2*P1Q2+ - &256*A1*MT**2*P1Q2/(3*P1Q1**2)-256*A12*MB*MT**3*P1Q2/(3*P1Q1**2)+ - &112*A1*P1Q2/P1Q1+272*A2*P1Q2/(3*P1Q1)- - &272*A1*A2*MB**2*P1Q2/(3*P1Q1)-208*A12*MB*MT*P1Q2/(3*P1Q1)+ - &400*A1*A2*MB*MT*P1Q2/(3*P1Q1)-80*A1*A2*MT**2*P1Q2/P1Q1 - A18=A18+96*A12*P1P2*P1Q2/P1Q1-320*A1*A2*P1P2*P1Q2/P1Q1- - &544*A1*A2*P1Q2**2/(3*P1Q1)+128*A2*MB**4/(3*P2Q1**2)- - &128*A2*MB**3*MT/(3*P2Q1**2)+256*A2**2*MB**5*MT/(3*P2Q1**2)+ - &256*A2*MB**2*P1P2/(3*P2Q1**2)-256*A2**2*MB**4*P1P2/(3*P2Q1**2)+ - &256*A2*MB**2*P1Q1/(3*P2Q1**2)-256*A2**2*MB**4*P1Q1/(3*P2Q1**2)+ - &64*MB**3*MT**3/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q2**2*P2Q1**2)- - &64*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1**2)- - &64*MB**3*MT/(3*P1Q2*P2Q1**2)- - &256*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**3*MT*P1Q1/(3*P1Q2*P2Q1**2)+ - &512*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1**2)+ - &256*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q1**2)-8/(3*P2Q1)-72*A1*MB**2/P2Q1- - &88*A2*MB**2/(3*P2Q1)-56*A1*MB*MT/(3*P2Q1)-32*A2*MB*MT/P2Q1- - &224*A1*A2*MB**3*MT/(3*P2Q1)+704*A2**2*MB**3*MT/(3*P2Q1) - A18=A18-48*A1*P1P2/P2Q1-104*A2*P1P2/(3*P2Q1)+ - &448*A1*A2*MB**2*P1P2/(3*P2Q1)-512*A2**2*MB**2*P1P2/(3*P2Q1)+ - &128*A1*A2*MB*MT*P1P2/(3*P2Q1)+32*A1*A2*P1P2**2/P2Q1- - &16*P1P2/(3*P1Q1*P2Q1)+32*A1*MB*MT*P1P2/(3*P1Q1*P2Q1)+ - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q1)+ - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**3/(3*P1Q1*P2Q1)-256*A2*P1Q1/(3*P2Q1)+ - &448*A1*A2*MB**2*P1Q1/(3*P2Q1)-368*A2**2*MB**2*P1Q1/(3*P2Q1)- - &224*A1*A2*MB*MT*P1Q1/(3*P2Q1)+304*A1*A2*P1P2*P1Q1/(3*P2Q1)+ - &64*MB*MT**3/(3*P1Q2**2*P2Q1)+ - &256*A1*MB*MT**3*P1P2/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2**2/(3*P1Q2**2*P2Q1)+ - &64*MT**2*P1Q1/(3*P1Q2**2*P2Q1)- - &128*A1*MB**2*MT**2*P1Q1/(3*P1Q2**2*P2Q1)+ - &128*A1*MB*MT**3*P1Q1/(3*P1Q2**2*P2Q1)- - &256*A1*MT**2*P1P2*P1Q1/(3*P1Q2**2*P2Q1)-4*MB**2/(3*P1Q2*P2Q1)- - &64*MB*MT/(3*P1Q2*P2Q1)+128*A2*MB**3*MT/(3*P1Q2*P2Q1) - A18=A18-4*MT**2/(3*P1Q2*P2Q1)-128*A1*MB**2*MT**2/(3*P1Q2*P2Q1)- - &128*A2*MB**2*MT**2/(3*P1Q2*P2Q1)+128*A1*MB*MT**3/(3*P1Q2*P2Q1)- - &112*A2*MB**2*P1P2/(3*P1Q2*P2Q1)+32*A1*MB*MT*P1P2/(3*P1Q2*P2Q1)+ - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q1)-112*A1*MT**2*P1P2/(3*P1Q2*P2Q1)- - &48*A1*P1P2**2/(P1Q2*P2Q1)-48*A2*P1P2**2/(P1Q2*P2Q1)- - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2**3/(3*P1Q2*P2Q1)+8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q1)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+ - &32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q1)+8*P1Q1/(3*P1Q2*P2Q1)- - &160*A1*MB**2*P1Q1/(3*P1Q2*P2Q1)-272*A2*MB**2*P1Q1/(3*P1Q2*P2Q1)- - &56*A1*MB*MT*P1Q1/(3*P1Q2*P2Q1)-200*A2*MB*MT*P1Q1/(3*P1Q2*P2Q1)- - &48*A1*P1P2*P1Q1/(P1Q2*P2Q1)-256*A2*P1P2*P1Q1/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1)+ - &1024*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q1) - A18=A18-272*A2*P1Q1**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB**2*P1Q1**2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P1Q1**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P1Q1**2/(3*P1Q2*P2Q1)+16*A2*P1Q2/(3*P2Q1)+ - &64*A1*A2*MB**2*P1Q2/P2Q1+32*A2**2*MB**2*P1Q2/(3*P2Q1)- - &112*A1*A2*MB*MT*P1Q2/(3*P2Q1)+368*A1*A2*P1P2*P1Q2/(3*P2Q1)+ - &32*A2*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MB*MT*P1P2*P1Q2/(3*P1Q1*P2Q1)- - &64*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q1)+224*A12*P2Q1+ - &656*A1*A2*P2Q1/3-256*A1*MT**2*P2Q1/(3*P1Q1**2)+ - &256*A12*MT**4*P2Q1/(3*P1Q1**2)-256*A1*P2Q1/(3*P1Q1)- - &224*A1*A2*MB*MT*P2Q1/(3*P1Q1)-368*A12*MT**2*P2Q1/(3*P1Q1)+ - &448*A1*A2*MT**2*P2Q1/(3*P1Q1)+304*A1*A2*P1P2*P2Q1/(3*P1Q1)+ - &256*A12*MT**4*P2Q1/(3*P1Q2**2)+ - &256*A12*MT**2*P1Q1*P2Q1/(3*P1Q2**2)+16*A1*P2Q1/(3*P1Q2)- - &112*A1*A2*MB*MT*P2Q1/(3*P1Q2)+32*A12*MT**2*P2Q1/(3*P1Q2) - A18=A18+64*A1*A2*MT**2*P2Q1/P1Q2+368*A1*A2*P1P2*P2Q1/(3*P1Q2)+ - &16*A1*MT**2*P2Q1/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q1/(3*P1Q1*P1Q2)+ - &640*A12*P1Q1*P2Q1/(3*P1Q2)+544*A1*A2*P1Q1*P2Q1/(3*P1Q2)+ - &32*A12*P1Q2*P2Q1/P1Q1+944*A1*A2*P1Q2*P2Q1/(3*P1Q1)+ - &128*A2*MB**4/(3*P2Q2**2)-128*A2*MB**3*MT/(3*P2Q2**2)+ - &256*A2**2*MB**5*MT/(3*P2Q2**2)+256*A2*MB**2*P1P2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1P2/(3*P2Q2**2)+ - &64*MB**3*MT**3/(3*P1Q1**2*P2Q2**2)- - &64*MB**2*MT**2*P1P2/(3*P1Q1**2*P2Q2**2)- - &64*MB**3*MT/(3*P1Q1*P2Q2**2)- - &256*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q2**2)+ - &256*A2*MB**2*P1P2**2/(3*P1Q1*P2Q2**2)- - &256*A2**2*MB**4*P1Q1/(3*P2Q2**2)+256*A2*MB**2*P1Q2/(3*P2Q2**2)- - &256*A2**2*MB**4*P1Q2/(3*P2Q2**2)- - &64*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2**2)- - &256*A2*MB**3*MT*P1Q2/(3*P1Q1*P2Q2**2)+ - &512*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2**2) - A18=A18+256*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P2Q1/(3*P2Q2**2)+256*A2**2*MB**3*MT*P2Q1/(3*P2Q2**2)+ - &64*MB**2*MT**2*P2Q1/(3*P1Q1**2*P2Q2**2)+ - &64*MB**2*P2Q1/(3*P1Q1*P2Q2**2)+ - &128*A2*MB**3*MT*P2Q1/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*MT**2*P2Q1/(3*P1Q1*P2Q2**2)- - &256*A2*MB**2*P1P2*P2Q1/(3*P1Q1*P2Q2**2)+ - &256*A2**2*MB**2*P1Q1*P2Q1/(3*P2Q2**2)- - &256*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2**2)-8/(3*P2Q2)- - &72*A1*MB**2/P2Q2-88*A2*MB**2/(3*P2Q2)-56*A1*MB*MT/(3*P2Q2)- - &32*A2*MB*MT/P2Q2-224*A1*A2*MB**3*MT/(3*P2Q2)+ - &704*A2**2*MB**3*MT/(3*P2Q2)-48*A1*P1P2/P2Q2- - &104*A2*P1P2/(3*P2Q2)+448*A1*A2*MB**2*P1P2/(3*P2Q2)- - &512*A2**2*MB**2*P1P2/(3*P2Q2)+128*A1*A2*MB*MT*P1P2/(3*P2Q2)+ - &32*A1*A2*P1P2**2/P2Q2+64*MB*MT**3/(3*P1Q1**2*P2Q2)+ - &256*A1*MB*MT**3*P1P2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2**2/(3*P1Q1**2*P2Q2)-4*MB**2/(3*P1Q1*P2Q2) - A18=A18-64*MB*MT/(3*P1Q1*P2Q2)+128*A2*MB**3*MT/(3*P1Q1*P2Q2)- - &4*MT**2/(3*P1Q1*P2Q2)-128*A1*MB**2*MT**2/(3*P1Q1*P2Q2)- - &128*A2*MB**2*MT**2/(3*P1Q1*P2Q2)+128*A1*MB*MT**3/(3*P1Q1*P2Q2)- - &112*A2*MB**2*P1P2/(3*P1Q1*P2Q2)+32*A1*MB*MT*P1P2/(3*P1Q1*P2Q2)+ - &32*A2*MB*MT*P1P2/(3*P1Q1*P2Q2)-112*A1*MT**2*P1P2/(3*P1Q1*P2Q2)- - &48*A1*P1P2**2/(P1Q1*P2Q2)-48*A2*P1P2**2/(P1Q1*P2Q2)- - &512*A1*A2*MB*MT*P1P2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2**3/(3*P1Q1*P2Q2)+16*A2*P1Q1/(3*P2Q2)+ - &64*A1*A2*MB**2*P1Q1/P2Q2+32*A2**2*MB**2*P1Q1/(3*P2Q2)- - &112*A1*A2*MB*MT*P1Q1/(3*P2Q2)+368*A1*A2*P1P2*P1Q1/(3*P2Q2)- - &16*P1P2/(3*P1Q2*P2Q2)+32*A1*MB*MT*P1P2/(3*P1Q2*P2Q2)+ - &32*A2*MB*MT*P1P2/(3*P1Q2*P2Q2)+ - &64*A1*A2*MB*MT*P1P2**2/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**3/(3*P1Q2*P2Q2)+8*MB*MT*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &8*MT**2*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &32*A1*MB*MT**3*P1P2/(3*P1Q1*P1Q2*P2Q2)- - &16*P1P2**2/(3*P1Q1*P1Q2*P2Q2) - A18=A18+32*A1*MT**2*P1P2**2/(3*P1Q1*P1Q2*P2Q2)+ - &32*A2*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &32*A1*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MB*MT*P1P2*P1Q1/(3*P1Q2*P2Q2)- - &64*A1*A2*P1P2**2*P1Q1/(3*P1Q2*P2Q2)-256*A2*P1Q2/(3*P2Q2)+ - &448*A1*A2*MB**2*P1Q2/(3*P2Q2)-368*A2**2*MB**2*P1Q2/(3*P2Q2)- - &224*A1*A2*MB*MT*P1Q2/(3*P2Q2)+304*A1*A2*P1P2*P1Q2/(3*P2Q2)+ - &64*MT**2*P1Q2/(3*P1Q1**2*P2Q2)- - &128*A1*MB**2*MT**2*P1Q2/(3*P1Q1**2*P2Q2)+ - &128*A1*MB*MT**3*P1Q2/(3*P1Q1**2*P2Q2)- - &256*A1*MT**2*P1P2*P1Q2/(3*P1Q1**2*P2Q2)+8*P1Q2/(3*P1Q1*P2Q2)- - &160*A1*MB**2*P1Q2/(3*P1Q1*P2Q2)-272*A2*MB**2*P1Q2/(3*P1Q1*P2Q2)- - &56*A1*MB*MT*P1Q2/(3*P1Q1*P2Q2)-200*A2*MB*MT*P1Q2/(3*P1Q1*P2Q2)- - &48*A1*P1P2*P1Q2/(P1Q1*P2Q2)-256*A2*P1P2*P1Q2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2)+ - &1024*A1*A2*P1P2**2*P1Q2/(3*P1Q1*P2Q2) - A18=A18-272*A2*P1Q2**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB**2*P1Q2**2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P1Q2**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1P2*P1Q2**2/(3*P1Q1*P2Q2)-32*A2*MB**4/(3*P2Q1*P2Q2)+ - &32*A2*MB**3*MT/(3*P2Q1*P2Q2)-64*A2**2*MB**5*MT/(3*P2Q1*P2Q2)+ - &16*P1P2/(3*P2Q1*P2Q2)-64*A2*MB**2*P1P2/(3*P2Q1*P2Q2)+ - &64*A2**2*MB**4*P1P2/(3*P2Q1*P2Q2)+8*MB**2*P1P2/(3*P1Q1*P2Q1*P2Q2)- - &8*MB*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &32*A2*MB**3*MT*P1P2/(3*P1Q1*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q1*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q1/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q1/(3*P2Q1*P2Q2)+ - &8*MB**2*P1P2/(3*P1Q2*P2Q1*P2Q2)-8*MB*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &32*A2*MB**3*MT*P1P2/(3*P1Q2*P2Q1*P2Q2)+ - &16*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2**2/(3*P1Q2*P2Q1*P2Q2)- - &16*MB*MT*P1P2**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) - A18=A18+16*P1P2**3/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q1/(3*P1Q2*P2Q1*P2Q2)- - &16*A2*MB**2*P1Q2/(3*P2Q1*P2Q2)+64*A2**2*MB**4*P1Q2/(3*P2Q1*P2Q2)- - &32*A2*MB**2*P1P2*P1Q2/(3*P1Q1*P2Q1*P2Q2)+272*A1*P2Q1/(3*P2Q2)+ - &112*A2*P2Q1/P2Q2-80*A1*A2*MB**2*P2Q1/P2Q2+ - &400*A1*A2*MB*MT*P2Q1/(3*P2Q2)-208*A2**2*MB*MT*P2Q1/(3*P2Q2)- - &272*A1*A2*MT**2*P2Q1/(3*P2Q2)-320*A1*A2*P1P2*P2Q1/P2Q2+ - &96*A2**2*P1P2*P2Q1/P2Q2-256*A1*MB*MT**3*P2Q1/(3*P1Q1**2*P2Q2)+ - &512*A1*MT**2*P1P2*P2Q1/(3*P1Q1**2*P2Q2)-8*P2Q1/(3*P1Q1*P2Q2)+ - &200*A1*MB*MT*P2Q1/(3*P1Q1*P2Q2)+56*A2*MB*MT*P2Q1/(3*P1Q1*P2Q2)+ - &272*A1*MT**2*P2Q1/(3*P1Q1*P2Q2)+160*A2*MT**2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*P1P2*P2Q1/(3*P1Q1*P2Q2)+48*A2*P1P2*P2Q1/(P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2)- - &256*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q1*P2Q2)- - &1024*A1*A2*P1P2**2*P2Q1/(3*P1Q1*P2Q2)- - &544*A1*A2*P1Q1*P2Q1/(3*P2Q2)-640*A2**2*P1Q1*P2Q1/(3*P2Q2)- - &32*A1*P1P2*P2Q1/(3*P1Q2*P2Q2) - A18=A18-32*A1*A2*MB*MT*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &32*A1*A2*MT**2*P1P2*P2Q1/(3*P1Q2*P2Q2)+ - &64*A1*A2*P1P2**2*P2Q1/(3*P1Q2*P2Q2)- - &32*A1*MT**2*P1P2*P2Q1/(3*P1Q1*P1Q2*P2Q2)+ - &64*A1*A2*P1P2*P1Q1*P2Q1/(3*P1Q2*P2Q2)- - &944*A1*A2*P1Q2*P2Q1/(3*P2Q2)-32*A2**2*P1Q2*P2Q1/P2Q2+ - &256*A1*MT**2*P1Q2*P2Q1/(3*P1Q1**2*P2Q2)+ - &96*A1*P1Q2*P2Q1/(P1Q1*P2Q2)+96*A2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MB**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)+ - &256*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2)- - &128*A1*A2*MT**2*P1Q2*P2Q1/(3*P1Q1*P2Q2)- - &512*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2)- - &512*A1*A2*P1Q2**2*P2Q1/(3*P1Q1*P2Q2)+544*A1*A2*P2Q1**2/(3*P2Q2)- - &256*A1*MT**2*P2Q1**2/(3*P1Q1**2*P2Q2)- - &272*A1*P2Q1**2/(3*P1Q1*P2Q2)- - &256*A1*A2*MB*MT*P2Q1**2/(3*P1Q1*P2Q2)+ - &256*A1*A2*MT**2*P2Q1**2/(3*P1Q1*P2Q2) - A18=A18+512*A1*A2*P1P2*P2Q1**2/(3*P1Q1*P2Q2)+ - &512*A1*A2*P1Q2*P2Q1**2/(3*P1Q1*P2Q2)+224*A12*P2Q2+ - &656*A1*A2*P2Q2/3+256*A12*MT**4*P2Q2/(3*P1Q1**2)+ - &16*A1*P2Q2/(3*P1Q1)-112*A1*A2*MB*MT*P2Q2/(3*P1Q1)+ - &32*A12*MT**2*P2Q2/(3*P1Q1)+64*A1*A2*MT**2*P2Q2/P1Q1+ - &368*A1*A2*P1P2*P2Q2/(3*P1Q1)-256*A1*MT**2*P2Q2/(3*P1Q2**2)+ - &256*A12*MT**4*P2Q2/(3*P1Q2**2)-256*A1*P2Q2/(3*P1Q2)- - &224*A1*A2*MB*MT*P2Q2/(3*P1Q2)-368*A12*MT**2*P2Q2/(3*P1Q2)+ - &448*A1*A2*MT**2*P2Q2/(3*P1Q2)+304*A1*A2*P1P2*P2Q2/(3*P1Q2)+ - &16*A1*MT**2*P2Q2/(3*P1Q1*P1Q2)-64*A12*MT**4*P2Q2/(3*P1Q1*P1Q2)+ - &32*A12*P1Q1*P2Q2/P1Q2+944*A1*A2*P1Q1*P2Q2/(3*P1Q2)+ - &256*A12*MT**2*P1Q2*P2Q2/(3*P1Q1**2)+ - &640*A12*P1Q2*P2Q2/(3*P1Q1)+544*A1*A2*P1Q2*P2Q2/(3*P1Q1)- - &256*A2*MB**2*P2Q2/(3*P2Q1**2)+256*A2**2*MB**3*MT*P2Q2/(3*P2Q1**2)+ - &64*MB**2*MT**2*P2Q2/(3*P1Q2**2*P2Q1**2)+ - &64*MB**2*P2Q2/(3*P1Q2*P2Q1**2)+ - &128*A2*MB**3*MT*P2Q2/(3*P1Q2*P2Q1**2) - A18=A18-128*A2*MB**2*MT**2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1P2*P2Q2/(3*P1Q2*P2Q1**2)- - &256*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1**2)+ - &256*A2**2*MB**2*P1Q2*P2Q2/(3*P2Q1**2)+272*A1*P2Q2/(3*P2Q1)+ - &112*A2*P2Q2/P2Q1-80*A1*A2*MB**2*P2Q2/P2Q1+ - &400*A1*A2*MB*MT*P2Q2/(3*P2Q1)-208*A2**2*MB*MT*P2Q2/(3*P2Q1)- - &272*A1*A2*MT**2*P2Q2/(3*P2Q1)-320*A1*A2*P1P2*P2Q2/P2Q1+ - &96*A2**2*P1P2*P2Q2/P2Q1-32*A1*P1P2*P2Q2/(3*P1Q1*P2Q1)- - &32*A1*A2*MB*MT*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &32*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q1*P2Q1)+ - &64*A1*A2*P1P2**2*P2Q2/(3*P1Q1*P2Q1)-944*A1*A2*P1Q1*P2Q2/(3*P2Q1)- - &32*A2**2*P1Q1*P2Q2/P2Q1-256*A1*MB*MT**3*P2Q2/(3*P1Q2**2*P2Q1)+ - &512*A1*MT**2*P1P2*P2Q2/(3*P1Q2**2*P2Q1)+ - &256*A1*MT**2*P1Q1*P2Q2/(3*P1Q2**2*P2Q1)-8*P2Q2/(3*P1Q2*P2Q1)+ - &200*A1*MB*MT*P2Q2/(3*P1Q2*P2Q1)+56*A2*MB*MT*P2Q2/(3*P1Q2*P2Q1)+ - &272*A1*MT**2*P2Q2/(3*P1Q2*P2Q1)+160*A2*MT**2*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*P1P2*P2Q2/(3*P1Q2*P2Q1)+48*A2*P1P2*P2Q2/(P1Q2*P2Q1) - A18=A18+256*A1*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1)- - &256*A1*A2*MT**2*P1P2*P2Q2/(3*P1Q2*P2Q1)- - &1024*A1*A2*P1P2**2*P2Q2/(3*P1Q2*P2Q1)- - &32*A1*MT**2*P1P2*P2Q2/(3*P1Q1*P1Q2*P2Q1)+ - &96*A1*P1Q1*P2Q2/(P1Q2*P2Q1)+96*A2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1)- - &128*A1*A2*MT**2*P1Q1*P2Q2/(3*P1Q2*P2Q1)- - &512*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1)- - &512*A1*A2*P1Q1**2*P2Q2/(3*P1Q2*P2Q1)-544*A1*A2*P1Q2*P2Q2/(3*P2Q1)- - &640*A2**2*P1Q2*P2Q2/(3*P2Q1)+ - &64*A1*A2*P1P2*P1Q2*P2Q2/(3*P1Q1*P2Q1)+544*A1*A2*P2Q2**2/(3*P2Q1)- - &256*A1*MT**2*P2Q2**2/(3*P1Q2**2*P2Q1)- - &272*A1*P2Q2**2/(3*P1Q2*P2Q1)- - &256*A1*A2*MB*MT*P2Q2**2/(3*P1Q2*P2Q1)+ - &256*A1*A2*MT**2*P2Q2**2/(3*P1Q2*P2Q1)+ - &512*A1*A2*P1P2*P2Q2**2/(3*P1Q2*P2Q1) - A18=A18+512*A1*A2*P1Q1*P2Q2**2/(3*P1Q2*P2Q1)- - &384*A12*MB*MT*P1Q1**2/S**2+ - &384*A12*P1P2*P1Q1**2/S**2-2688*A12*MB*MT*P1Q1*P1Q2/S**2+ - &2688*A12*P1P2*P1Q1*P1Q2/S**2-384*A12*MB*MT*P1Q2**2/S**2+ - &384*A12*P1P2*P1Q2**2/S**2-768*A1*A2*MB*MT*P1Q1*P2Q1/S**2+ - &768*A1*A2*P1P2*P1Q1*P2Q1/S**2-2688*A1*A2*MB*MT*P1Q2*P2Q1/S**2+ - &2688*A1*A2*P1P2*P1Q2*P2Q1/S**2-960*A12*P1Q1*P1Q2*P2Q1/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q1/S**2+960*A12*P1Q2**2*P2Q1/S**2+ - &960*A1*A2*P1Q2**2*P2Q1/S**2-384*A2**2*MB*MT*P2Q1**2/S**2+ - &384*A2**2*P1P2*P2Q1**2/S**2-960*A1*A2*P1Q2*P2Q1**2/S**2- - &960*A2**2*P1Q2*P2Q1**2/S**2-2688*A1*A2*MB*MT*P1Q1*P2Q2/S**2+ - &2688*A1*A2*P1P2*P1Q1*P2Q2/S**2+960*A12*P1Q1**2*P2Q2/S**2+ - &960*A1*A2*P1Q1**2*P2Q2/S**2-768*A1*A2*MB*MT*P1Q2*P2Q2/S**2+ - &768*A1*A2*P1P2*P1Q2*P2Q2/S**2-960*A12*P1Q1*P1Q2*P2Q2/S**2- - &960*A1*A2*P1Q1*P1Q2*P2Q2/S**2-2688*A2**2*MB*MT*P2Q1*P2Q2/S**2+ - &2688*A2**2*P1P2*P2Q1*P2Q2/S**2+960*A1*A2*P1Q1*P2Q1*P2Q2/S**2+ - &960*A2**2*P1Q1*P2Q1*P2Q2/S**2+960*A1*A2*P1Q2*P2Q1*P2Q2/S**2 - A18=A18+960*A2**2*P1Q2*P2Q1*P2Q2/S**2- - &384*A2**2*MB*MT*P2Q2**2/S**2+ - &384*A2**2*P1P2*P2Q2**2/S**2-960*A1*A2*P1Q1*P2Q2**2/S**2- - &960*A2**2*P1Q1*P2Q2**2/S**2-96*A1*MB*MT/S-96*A2*MB*MT/S+ - &768*A2**2*MB**3*MT/S+768*A12*MB*MT**3/S-192*A1*P1P2/S- - &192*A2*P1P2/S-768*A2**2*MB**2*P1P2/S+2304*A1*A2*MB*MT*P1P2/S- - &768*A12*MT**2*P1P2/S-2304*A1*A2*P1P2**2/S+ - &96*A1*MB*MT**3/(P1Q1*S)+192*A2*MB*MT*P1P2/(P1Q1*S)- - &96*A1*MT**2*P1P2/(P1Q1*S)-192*A2*P1P2**2/(P1Q1*S)-192*A1*P1Q1/S- - &144*A2*P1Q1/S-384*A1*A2*MB**2*P1Q1/S-480*A2**2*MB**2*P1Q1/S+ - &480*A12*MB*MT*P1Q1/S-96*A1*A2*MB*MT*P1Q1/S- - &864*A12*P1P2*P1Q1/S-672*A1*A2*P1P2*P1Q1/S-96*A1*A2*P1Q1**2/S+ - &96*A1*MB*MT**3/(P1Q2*S)+192*A2*MB*MT*P1P2/(P1Q2*S)- - &96*A1*MT**2*P1P2/(P1Q2*S)-192*A2*P1P2**2/(P1Q2*S)+ - &48*A1*MB*MT*P1Q1/(P1Q2*S)-96*A2*MB*MT*P1Q1/(P1Q2*S)- - &48*A1*MT**2*P1Q1/(P1Q2*S)-192*A1*P1P2*P1Q1/(P1Q2*S)- - &192*A2*P1P2*P1Q1/(P1Q2*S)-192*A1*A2*MB*MT*P1P2*P1Q1/(P1Q2*S) - A18=A18+192*A1*A2*P1P2**2*P1Q1/(P1Q2*S)-192*A1*P1Q1**2/(P1Q2*S)- - &192*A2*P1Q1**2/(P1Q2*S)+192*A1*A2*MB**2*P1Q1**2/(P1Q2*S)+ - &192*A12*MB*MT*P1Q1**2/(P1Q2*S)-96*A1*A2*MB*MT*P1Q1**2/(P1Q2*S)+ - &192*A1*A2*P1P2*P1Q1**2/(P1Q2*S)-192*A1*P1Q2/S-144*A2*P1Q2/S- - &384*A1*A2*MB**2*P1Q2/S-480*A2**2*MB**2*P1Q2/S+ - &480*A12*MB*MT*P1Q2/S-96*A1*A2*MB*MT*P1Q2/S- - &864*A12*P1P2*P1Q2/S-672*A1*A2*P1P2*P1Q2/S+ - &48*A1*MB*MT*P1Q2/(P1Q1*S)-96*A2*MB*MT*P1Q2/(P1Q1*S)- - &48*A1*MT**2*P1Q2/(P1Q1*S)-192*A1*P1P2*P1Q2/(P1Q1*S)- - &192*A2*P1P2*P1Q2/(P1Q1*S)-192*A1*A2*MB*MT*P1P2*P1Q2/(P1Q1*S)+ - &192*A1*A2*P1P2**2*P1Q2/(P1Q1*S)-576*A1*A2*P1Q1*P1Q2/S- - &96*A1*A2*P1Q2**2/S-192*A1*P1Q2**2/(P1Q1*S)- - &192*A2*P1Q2**2/(P1Q1*S)+192*A1*A2*MB**2*P1Q2**2/(P1Q1*S)+ - &192*A12*MB*MT*P1Q2**2/(P1Q1*S)-96*A1*A2*MB*MT*P1Q2**2/(P1Q1*S)+ - &192*A1*A2*P1P2*P1Q2**2/(P1Q1*S)-96*A2*MB**3*MT/(P2Q1*S)+ - &96*A2*MB**2*P1P2/(P2Q1*S)-192*A1*MB*MT*P1P2/(P2Q1*S)+ - &192*A1*P1P2**2/(P2Q1*S)+96*A1*MB**2*P1Q1/(P2Q1*S) - A18=A18+192*A2*MB**2*P1Q1/(P2Q1*S)-96*A1*MB*MT*P1Q1/(P2Q1*S)- - &192*A1*A2*MB**3*MT*P1Q1/(P2Q1*S)+192*A1*P1P2*P1Q1/(P2Q1*S)+ - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q1*S)+ - &96*A1*A2*MB**2*P1Q1**2/(P2Q1*S)- - &192*A2*MB**3*MT*P1Q1/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1P2*P1Q1/(P1Q2*P2Q1*S)- - &96*A1*MB*MT*P1P2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*P1P2**2*P1Q1/(P1Q2*P2Q1*S)+ - &96*A1*MB**2*P1Q1**2/(P1Q2*P2Q1*S)+ - &192*A2*MB**2*P1Q1**2/(P1Q2*P2Q1*S)- - &48*A1*MB*MT*P1Q1**2/(P1Q2*P2Q1*S)+ - &96*A1*P1P2*P1Q1**2/(P1Q2*P2Q1*S)+96*A1*MB**2*P1Q2/(P2Q1*S)+ - &48*A2*MB**2*P1Q2/(P2Q1*S)+192*A1*A2*MB**3*MT*P1Q2/(P2Q1*S)- - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q1*S)- - &96*A1*A2*MB**2*P1Q2**2/(P2Q1*S)+144*A1*P2Q1/S+192*A2*P2Q1/S+ - &96*A1*A2*MB*MT*P2Q1/S-480*A2**2*MB*MT*P2Q1/S+ - &480*A12*MT**2*P2Q1/S+384*A1*A2*MT**2*P2Q1/S - A18=A18+672*A1*A2*P1P2*P2Q1/S+864*A2**2*P1P2*P2Q1/S- - &96*A2*MB*MT*P2Q1/(P1Q1*S)+192*A1*MT**2*P2Q1/(P1Q1*S)+ - &96*A2*MT**2*P2Q1/(P1Q1*S)-192*A1*A2*MB*MT**3*P2Q1/(P1Q1*S)+ - &192*A2*P1P2*P2Q1/(P1Q1*S)+192*A1*A2*MT**2*P1P2*P2Q1/(P1Q1*S)- - &192*A12*P1Q1*P2Q1/S-192*A2**2*P1Q1*P2Q1/S+ - &48*A1*MT**2*P2Q1/(P1Q2*S)+96*A2*MT**2*P2Q1/(P1Q2*S)+ - &192*A1*A2*MB*MT**3*P2Q1/(P1Q2*S)- - &192*A1*A2*MT**2*P1P2*P2Q1/(P1Q2*S)+ - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P1Q2*S)- - &192*A12*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &96*A1*A2*MT**2*P1Q1*P2Q1/(P1Q2*S)- - &384*A1*A2*P1P2*P1Q1*P2Q1/(P1Q2*S)-384*A12*P1Q1**2*P2Q1/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q1/(P1Q2*S)-480*A12*P1Q2*P2Q1/S- - &960*A1*A2*P1Q2*P2Q1/S-480*A2**2*P1Q2*P2Q1/S+ - &144*A1*P1Q2*P2Q1/(P1Q1*S)+96*A2*P1Q2*P2Q1/(P1Q1*S)+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P1Q1*S)- - &96*A12*MT**2*P1Q2*P2Q1/(P1Q1*S) - A18=A18+96*A1*A2*MT**2*P1Q2*P2Q1/(P1Q1*S)- - &576*A1*A2*P1P2*P1Q2*P2Q1/(P1Q1*S)-192*A12*P1Q2**2*P2Q1/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q1/(P1Q1*S)-96*A1*A2*P2Q1**2/S- - &96*A1*A2*MT**2*P2Q1**2/(P1Q1*S)+96*A1*A2*MT**2*P2Q1**2/(P1Q2*S)+ - &288*A1*A2*P1Q2*P2Q1**2/(P1Q1*S)-96*A2*MB**3*MT/(P2Q2*S)+ - &96*A2*MB**2*P1P2/(P2Q2*S)-192*A1*MB*MT*P1P2/(P2Q2*S)+ - &192*A1*P1P2**2/(P2Q2*S)+96*A1*MB**2*P1Q1/(P2Q2*S)+ - &48*A2*MB**2*P1Q1/(P2Q2*S)+192*A1*A2*MB**3*MT*P1Q1/(P2Q2*S)- - &192*A1*A2*MB**2*P1P2*P1Q1/(P2Q2*S)- - &96*A1*A2*MB**2*P1Q1**2/(P2Q2*S)+96*A1*MB**2*P1Q2/(P2Q2*S)+ - &192*A2*MB**2*P1Q2/(P2Q2*S)-96*A1*MB*MT*P1Q2/(P2Q2*S)- - &192*A1*A2*MB**3*MT*P1Q2/(P2Q2*S)+192*A1*P1P2*P1Q2/(P2Q2*S)+ - &192*A1*A2*MB**2*P1P2*P1Q2/(P2Q2*S)- - &192*A2*MB**3*MT*P1Q2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1P2*P1Q2/(P1Q1*P2Q2*S)- - &96*A1*MB*MT*P1P2*P1Q2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2**2*P1Q2/(P1Q1*P2Q2*S)+96*A1*A2*MB**2*P1Q2**2/(P2Q2*S) - A18=A18+96*A1*MB**2*P1Q2**2/(P1Q1*P2Q2*S)+ - &192*A2*MB**2*P1Q2**2/(P1Q1*P2Q2*S)- - &48*A1*MB*MT*P1Q2**2/(P1Q1*P2Q2*S)+ - &96*A1*P1P2*P1Q2**2/(P1Q1*P2Q2*S)-48*A2*MB**2*P2Q1/(P2Q2*S)- - &96*A1*MB*MT*P2Q1/(P2Q2*S)+48*A2*MB*MT*P2Q1/(P2Q2*S)- - &192*A1*P1P2*P2Q1/(P2Q2*S)-192*A2*P1P2*P2Q1/(P2Q2*S)- - &192*A1*A2*MB*MT*P1P2*P2Q1/(P2Q2*S)+ - &192*A1*A2*P1P2**2*P2Q1/(P2Q2*S)+ - &192*A1*MB*MT**3*P2Q1/(P1Q1*P2Q2*S)+ - &96*A2*MB*MT*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &192*A1*MT**2*P1P2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2**2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*MB**2*P1Q1*P2Q1/(P2Q2*S)+ - &192*A2**2*MB**2*P1Q1*P2Q1/(P2Q2*S)- - &96*A1*A2*MB*MT*P1Q1*P2Q1/(P2Q2*S)+ - &384*A1*A2*P1P2*P1Q1*P2Q1/(P2Q2*S)-96*A1*P1Q2*P2Q1/(P2Q2*S)- - &144*A2*P1Q2*P2Q1/(P2Q2*S)-96*A1*A2*MB**2*P1Q2*P2Q1/(P2Q2*S) - A18=A18+96*A2**2*MB**2*P1Q2*P2Q1/(P2Q2*S)- - &384*A1*A2*MB*MT*P1Q2*P2Q1/(P2Q2*S)+ - &576*A1*A2*P1P2*P1Q2*P2Q1/(P2Q2*S)- - &96*A2*MB**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &48*A1*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &48*A2*MB*MT*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*MT**2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A1*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)- - &96*A2*P1P2*P1Q2*P2Q1/(P1Q1*P2Q2*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q1/(P2Q2*S)+288*A1*A2*P1Q2**2*P2Q1/(P2Q2*S)- - &96*A1*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)-96*A2*P1Q2**2*P2Q1/(P1Q1*P2Q2*S)+ - &192*A1*P2Q1**2/(P2Q2*S)+192*A2*P2Q1**2/(P2Q2*S)+ - &96*A1*A2*MB*MT*P2Q1**2/(P2Q2*S)-192*A2**2*MB*MT*P2Q1**2/(P2Q2*S)- - &192*A1*A2*MT**2*P2Q1**2/(P2Q2*S)-192*A1*A2*P1P2*P2Q1**2/(P2Q2*S)- - &48*A2*MB*MT*P2Q1**2/(P1Q1*P2Q2*S)+ - &192*A1*MT**2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*MT**2*P2Q1**2/(P1Q1*P2Q2*S) - A18=A18+96*A2*P1P2*P2Q1**2/(P1Q1*P2Q2*S)- - &384*A1*A2*P1Q1*P2Q1**2/(P2Q2*S)- - &384*A2**2*P1Q1*P2Q1**2/(P2Q2*S)-384*A1*A2*P1Q2*P2Q1**2/(P2Q2*S)- - &192*A2**2*P1Q2*P2Q1**2/(P2Q2*S)+96*A1*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+ - &96*A2*P1Q2*P2Q1**2/(P1Q1*P2Q2*S)+144*A1*P2Q2/S+192*A2*P2Q2/S+ - &96*A1*A2*MB*MT*P2Q2/S-480*A2**2*MB*MT*P2Q2/S+ - &480*A12*MT**2*P2Q2/S+384*A1*A2*MT**2*P2Q2/S+ - &672*A1*A2*P1P2*P2Q2/S+864*A2**2*P1P2*P2Q2/S+ - &48*A1*MT**2*P2Q2/(P1Q1*S)+96*A2*MT**2*P2Q2/(P1Q1*S)+ - &192*A1*A2*MB*MT**3*P2Q2/(P1Q1*S)- - &192*A1*A2*MT**2*P1P2*P2Q2/(P1Q1*S)-480*A12*P1Q1*P2Q2/S- - &960*A1*A2*P1Q1*P2Q2/S-480*A2**2*P1Q1*P2Q2/S- - &96*A2*MB*MT*P2Q2/(P1Q2*S)+192*A1*MT**2*P2Q2/(P1Q2*S)+ - &96*A2*MT**2*P2Q2/(P1Q2*S)-192*A1*A2*MB*MT**3*P2Q2/(P1Q2*S)+ - &192*A2*P1P2*P2Q2/(P1Q2*S)+192*A1*A2*MT**2*P1P2*P2Q2/(P1Q2*S)+ - &144*A1*P1Q1*P2Q2/(P1Q2*S)+96*A2*P1Q1*P2Q2/(P1Q2*S)+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P1Q2*S) - A18=A18-96*A12*MT**2*P1Q1*P2Q2/(P1Q2*S)+ - &96*A1*A2*MT**2*P1Q1*P2Q2/(P1Q2*S)- - &576*A1*A2*P1P2*P1Q1*P2Q2/(P1Q2*S)-192*A12*P1Q1**2*P2Q2/(P1Q2*S)- - &384*A1*A2*P1Q1**2*P2Q2/(P1Q2*S)-192*A12*P1Q2*P2Q2/S- - &192*A2**2*P1Q2*P2Q2/S+96*A1*A2*MB*MT*P1Q2*P2Q2/(P1Q1*S)- - &192*A12*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &96*A1*A2*MT**2*P1Q2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1P2*P1Q2*P2Q2/(P1Q1*S)-384*A12*P1Q2**2*P2Q2/(P1Q1*S)- - &384*A1*A2*P1Q2**2*P2Q2/(P1Q1*S)-48*A2*MB**2*P2Q2/(P2Q1*S)- - &96*A1*MB*MT*P2Q2/(P2Q1*S)+48*A2*MB*MT*P2Q2/(P2Q1*S)- - &192*A1*P1P2*P2Q2/(P2Q1*S)-192*A2*P1P2*P2Q2/(P2Q1*S)- - &192*A1*A2*MB*MT*P1P2*P2Q2/(P2Q1*S)+ - &192*A1*A2*P1P2**2*P2Q2/(P2Q1*S)-96*A1*P1Q1*P2Q2/(P2Q1*S)- - &144*A2*P1Q1*P2Q2/(P2Q1*S)-96*A1*A2*MB**2*P1Q1*P2Q2/(P2Q1*S)+ - &96*A2**2*MB**2*P1Q1*P2Q2/(P2Q1*S)- - &384*A1*A2*MB*MT*P1Q1*P2Q2/(P2Q1*S)+ - &576*A1*A2*P1P2*P1Q1*P2Q2/(P2Q1*S)+288*A1*A2*P1Q1**2*P2Q2/(P2Q1*S) - A18=A18+192*A1*MB*MT**3*P2Q2/(P1Q2*P2Q1*S)+ - &96*A2*MB*MT*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &192*A1*MT**2*P1P2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2**2*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*MB**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &48*A1*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &48*A2*MB*MT*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*MT**2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A2*P1P2*P1Q1*P2Q2/(P1Q2*P2Q1*S)- - &96*A1*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)-96*A2*P1Q1**2*P2Q2/(P1Q2*P2Q1*S)+ - &96*A1*A2*MB**2*P1Q2*P2Q2/(P2Q1*S)+ - &192*A2**2*MB**2*P1Q2*P2Q2/(P2Q1*S)- - &96*A1*A2*MB*MT*P1Q2*P2Q2/(P2Q1*S)+ - &384*A1*A2*P1P2*P1Q2*P2Q2/(P2Q1*S)+ - &96*A1*A2*P1Q1*P1Q2*P2Q2/(P2Q1*S)-576*A1*A2*P2Q1*P2Q2/S+ - &96*A1*A2*P1Q1*P2Q1*P2Q2/(P1Q2*S)+96*A1*A2*P1Q2*P2Q1*P2Q2/(P1Q1*S) - A18=A18-96*A1*A2*P2Q2**2/S+96*A1*A2*MT**2*P2Q2**2/(P1Q1*S)- - &96*A1*A2*MT**2*P2Q2**2/(P1Q2*S)+288*A1*A2*P1Q1*P2Q2**2/(P1Q2*S)+ - &192*A1*P2Q2**2/(P2Q1*S)+192*A2*P2Q2**2/(P2Q1*S)+ - &96*A1*A2*MB*MT*P2Q2**2/(P2Q1*S)-192*A2**2*MB*MT*P2Q2**2/(P2Q1*S)- - &192*A1*A2*MT**2*P2Q2**2/(P2Q1*S)-192*A1*A2*P1P2*P2Q2**2/(P2Q1*S)- - &384*A1*A2*P1Q1*P2Q2**2/(P2Q1*S)-192*A2**2*P1Q1*P2Q2**2/(P2Q1*S)- - &48*A2*MB*MT*P2Q2**2/(P1Q2*P2Q1*S)+ - &192*A1*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*MT**2*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1P2*P2Q2**2/(P1Q2*P2Q1*S)+96*A1*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)+ - &96*A2*P1Q1*P2Q2**2/(P1Q2*P2Q1*S)-384*A1*A2*P1Q2*P2Q2**2/(P2Q1*S)- - &384*A2**2*P1Q2*P2Q2**2/(P2Q1*S)+512*A1*A2*S/3- - &128*A1*MT**2*S/(3*P1Q1**2)+128*A12*MB*MT**3*S/(3*P1Q1**2)- - &152*A1*S/(3*P1Q1)-152*A12*MB*MT*S/(3*P1Q1)- - &128*A1*A2*MB*MT*S/(3*P1Q1)+112*A1*A2*MT**2*S/(3*P1Q1)- - &16*A12*P1P2*S/P1Q1+152*A1*A2*P1P2*S/(3*P1Q1)- - &128*A1*MT**2*S/(3*P1Q2**2)+128*A12*MB*MT**3*S/(3*P1Q2**2) - A18=A18-152*A1*S/(3*P1Q2)-152*A12*MB*MT*S/(3*P1Q2)- - &128*A1*A2*MB*MT*S/(3*P1Q2)+112*A1*A2*MT**2*S/(3*P1Q2)- - &16*A12*P1P2*S/P1Q2+152*A1*A2*P1P2*S/(3*P1Q2)+ - &16*A1*MB*MT*S/(3*P1Q1*P1Q2)-32*A12*MB*MT**3*S/(3*P1Q1*P1Q2)- - &16*A1*P1P2*S/(3*P1Q1*P1Q2)+272*A1*A2*P1Q1*S/(3*P1Q2)+ - &272*A1*A2*P1Q2*S/(3*P1Q1)-128*A2*MB**2*S/(3*P2Q1**2)+ - &128*A2**2*MB**3*MT*S/(3*P2Q1**2)+ - &32*MB**2*MT**2*S/(3*P1Q2**2*P2Q1**2)+32*MB**2*S/(3*P1Q2*P2Q1**2) - - A18BIS= - &64*A2*MB**3*MT*S/(3*P1Q2*P2Q1**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1**2)- - &128*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1**2)+ - &128*A2**2*MB**2*P1Q2*S/(3*P2Q1**2)+152*A2*S/(3*P2Q1)- - &112*A1*A2*MB**2*S/(3*P2Q1)+128*A1*A2*MB*MT*S/(3*P2Q1)+ - &152*A2**2*MB*MT*S/(3*P2Q1)-152*A1*A2*P1P2*S/(3*P2Q1)+ - &16*A2**2*P1P2*S/P2Q1-8*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q1)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q1)- - &8*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q1)-8*A1*P1P2*S/(3*P1Q1*P2Q1)- - &8*A2*P1P2*S/(3*P1Q1*P2Q1)+8*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1)- - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q1)+ - &32*A1*A2*P1P2**2*S/(3*P1Q1*P2Q1)-32*A2**2*P1Q1*S/(3*P2Q1)- - &32*MT**2*S/(3*P1Q2**2*P2Q1)+64*A1*MB**2*MT**2*S/(3*P1Q2**2*P2Q1)- - &64*A1*MB*MT**3*S/(3*P1Q2**2*P2Q1) - A18BIS=A18BIS+128*A1*MT**2*P1P2*S/(3*P1Q2**2*P2Q1)- - &12*S/(P1Q2*P2Q1)+ - &24*A1*MB**2*S/(P1Q2*P2Q1)+64*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q1)+ - &24*A2*MT**2*S/(P1Q2*P2Q1)-128*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q1)+ - &64*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q1)+56*A1*P1P2*S/(3*P1Q2*P2Q1)+ - &56*A2*P1P2*S/(3*P1Q2*P2Q1)-64*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2**2*S/(3*P1Q2*P2Q1)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1)+136*A2*P1Q1*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB**2*P1Q1*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MB*MT*P1Q1*S/(3*P1Q2*P2Q1)- - &256*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1)-160*A2**2*P1Q2*S/(3*P2Q1)+ - &16*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1)-32*A12*P2Q1*S/(3*P1Q1)- - &128*A12*MT**2*P2Q1*S/(3*P1Q2**2)-160*A12*P2Q1*S/(3*P1Q2)- - &128*A2*MB**2*S/(3*P2Q2**2)+128*A2**2*MB**3*MT*S/(3*P2Q2**2) - A18BIS=A18BIS+32*MB**2*MT**2*S/(3*P1Q1**2*P2Q2**2)+ - &32*MB**2*S/(3*P1Q1*P2Q2**2)+ - &64*A2*MB**3*MT*S/(3*P1Q1*P2Q2**2)- - &64*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2**2)- - &128*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2**2)+ - &128*A2**2*MB**2*P1Q1*S/(3*P2Q2**2)- - &128*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2**2)+152*A2*S/(3*P2Q2)- - &112*A1*A2*MB**2*S/(3*P2Q2)+128*A1*A2*MB*MT*S/(3*P2Q2)+ - &152*A2**2*MB*MT*S/(3*P2Q2)-152*A1*A2*P1P2*S/(3*P2Q2)+ - &16*A2**2*P1P2*S/P2Q2-32*MT**2*S/(3*P1Q1**2*P2Q2)+ - &64*A1*MB**2*MT**2*S/(3*P1Q1**2*P2Q2)- - &64*A1*MB*MT**3*S/(3*P1Q1**2*P2Q2)+ - &128*A1*MT**2*P1P2*S/(3*P1Q1**2*P2Q2)-12*S/(P1Q1*P2Q2)+ - &24*A1*MB**2*S/(P1Q1*P2Q2)+64*A1*A2*MB**3*MT*S/(3*P1Q1*P2Q2)+ - &24*A2*MT**2*S/(P1Q1*P2Q2)-128*A1*A2*MB**2*MT**2*S/(3*P1Q1*P2Q2)+ - &64*A1*A2*MB*MT**3*S/(3*P1Q1*P2Q2)+56*A1*P1P2*S/(3*P1Q1*P2Q2)+ - &56*A2*P1P2*S/(3*P1Q1*P2Q2)-64*A1*A2*MB**2*P1P2*S/(3*P1Q1*P2Q2) - A18BIS=A18BIS+128*A1*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q2)- - &64*A1*A2*MT**2*P1P2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2**2*S/(3*P1Q1*P2Q2)-160*A2**2*P1Q1*S/(3*P2Q2)- - &8*A1*A2*MB**3*MT*S/(3*P1Q2*P2Q2)+ - &16*A1*A2*MB**2*MT**2*S/(3*P1Q2*P2Q2)- - &8*A1*A2*MB*MT**3*S/(3*P1Q2*P2Q2)-8*A1*P1P2*S/(3*P1Q2*P2Q2)- - &8*A2*P1P2*S/(3*P1Q2*P2Q2)+8*A1*A2*MB**2*P1P2*S/(3*P1Q2*P2Q2)- - &16*A1*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q2)+ - &8*A1*A2*MT**2*P1P2*S/(3*P1Q2*P2Q2)+ - &32*A1*A2*P1P2**2*S/(3*P1Q2*P2Q2)+4*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q2)- - &8*A1*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q2)+ - &16*A1*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q2)-32*A2**2*P1Q2*S/(3*P2Q2)+ - &136*A2*P1Q2*S/(3*P1Q1*P2Q2)-128*A1*A2*MB**2*P1Q2*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MB*MT*P1Q2*S/(3*P1Q1*P2Q2)- - &256*A1*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q2)+16*A2*MB*MT*S/(3*P2Q1*P2Q2)- - &32*A2**2*MB**3*MT*S/(3*P2Q1*P2Q2)-16*A2*P1P2*S/(3*P2Q1*P2Q2) - A18BIS=A18BIS-4*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q1*P2Q1*P2Q2)+ - &8*A2*MB*MT*P1P2*S/(3*P1Q1*P2Q1*P2Q2)-4*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB**2*P1P2*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*MB*MT*P1P2*S/(3*P1Q2*P2Q1*P2Q2)- - &2*MB**3*MT*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB**2*MT**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB*MT**3*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MB**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &4*MB*MT*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &2*MT**2*P1P2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)- - &8*P1P2**2*S/(3*P1Q1*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q1*S/(3*P1Q2*P2Q1*P2Q2)+ - &8*A2*P1P2*P1Q2*S/(3*P1Q1*P2Q1*P2Q2)+272*A1*A2*P2Q1*S/(3*P2Q2)- - &128*A1*MT**2*P2Q1*S/(3*P1Q1**2*P2Q2)-136*A1*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A1*A2*MB*MT*P2Q1*S/(3*P1Q1*P2Q2)+ - &128*A1*A2*MT**2*P2Q1*S/(3*P1Q1*P2Q2) - A18BIS=A18BIS+256*A1*A2*P1P2*P2Q1*S/(3*P1Q1*P2Q2)- - &16*A1*A2*P1P2*P2Q1*S/(3*P1Q2*P2Q2)+ - &8*A1*P1P2*P2Q1*S/(3*P1Q1*P1Q2*P2Q2)+ - &256*A1*A2*P1Q2*P2Q1*S/(3*P1Q1*P2Q2)- - &128*A12*MT**2*P2Q2*S/(3*P1Q1**2)-160*A12*P2Q2*S/(3*P1Q1)- - &32*A12*P2Q2*S/(3*P1Q2)+272*A1*A2*P2Q2*S/(3*P2Q1)- - &16*A1*A2*P1P2*P2Q2*S/(3*P1Q1*P2Q1)- - &128*A1*MT**2*P2Q2*S/(3*P1Q2**2*P2Q1)-136*A1*P2Q2*S/(3*P1Q2*P2Q1)- - &128*A1*A2*MB*MT*P2Q2*S/(3*P1Q2*P2Q1)+ - &128*A1*A2*MT**2*P2Q2*S/(3*P1Q2*P2Q1)+ - &256*A1*A2*P1P2*P2Q2*S/(3*P1Q2*P2Q1)+ - &8*A1*P1P2*P2Q2*S/(3*P1Q1*P1Q2*P2Q1)+ - &256*A1*A2*P1Q1*P2Q2*S/(3*P1Q2*P2Q1)- - &8*A12*MB*MT*S**2/(3*P1Q1*P1Q2)+16*A12*P1P2*S**2/(3*P1Q1*P1Q2)- - &8*A1*A2*P1P2*S**2/(3*P1Q1*P2Q1)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1)- - &8*A1*A2*P1P2*S**2/(3*P1Q2*P2Q2)+4*A1*P1P2*S**2/(3*P1Q1*P1Q2*P2Q2)- - &8*A2**2*MB*MT*S**2/(3*P2Q1*P2Q2)+16*A2**2*P1P2*S**2/(3*P2Q1*P2Q2) - A18BIS=A18BIS-4*A2*P1P2*S**2/(3*P1Q1*P2Q1*P2Q2)- - &4*A2*P1P2*S**2/(3*P1Q2*P2Q1*P2Q2)+ - &2*P1P2*S**2/(3*P1Q1*P1Q2*P2Q1*P2Q2) -C - V18=V18+V18BIS - A18=A18+A18BIS - V910 =-48*A12*MB*MT-48*A2**2*MB*MT-48*A12*P1P2-48*A2**2*P1P2- - &384*A12*MB*MT*P1Q1*P1Q2/S**2-384*A12*P1P2*P1Q1*P1Q2/S**2- - &384*A1*A2*MB*MT*P1Q2*P2Q1/S**2-384*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &192*A12*P1Q1*P1Q2*P2Q1/S**2+192*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &192*A12*P1Q2**2*P2Q1/S**2-192*A1*A2*P1Q2**2*P2Q1/S**2+ - &192*A1*A2*P1Q2*P2Q1**2/S**2+192*A2**2*P1Q2*P2Q1**2/S**2- - &384*A1*A2*MB*MT*P1Q1*P2Q2/S**2-384*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &192*A12*P1Q1**2*P2Q2/S**2-192*A1*A2*P1Q1**2*P2Q2/S**2+ - &192*A12*P1Q1*P1Q2*P2Q2/S**2+192*A1*A2*P1Q1*P1Q2*P2Q2/S**2- - &384*A2**2*MB*MT*P2Q1*P2Q2/S**2-384*A2**2*P1P2*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q1*P2Q1*P2Q2/S**2-192*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q2*P2Q1*P2Q2/S**2-192*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &192*A1*A2*P1Q1*P2Q2**2/S**2+192*A2**2*P1Q1*P2Q2**2/S**2+ - &96*A12*MB*MT*P1Q1/S-96*A1*A2*MB*MT*P1Q1/S+ - &96*A12*P1P2*P1Q1/S-96*A1*A2*P1P2*P1Q1/S+96*A12*MB*MT*P1Q2/S- - &96*A1*A2*MB*MT*P1Q2/S+96*A12*P1P2*P1Q2/S-96*A1*A2*P1P2*P1Q2/S+ - &96*A1*A2*MB*MT*P2Q1/S-96*A2**2*MB*MT*P2Q1/S - V910=V910+96*A1*A2*P1P2*P2Q1/S- - &96*A2**2*P1P2*P2Q1/S+96*A12*P1Q2*P2Q1/S+ - &192*A1*A2*P1Q2*P2Q1/S+96*A2**2*P1Q2*P2Q1/S+ - &96*A1*A2*MB*MT*P2Q2/S-96*A2**2*MB*MT*P2Q2/S+ - &96*A1*A2*P1P2*P2Q2/S-96*A2**2*P1P2*P2Q2/S+96*A12*P1Q1*P2Q2/S+ - &192*A1*A2*P1Q1*P2Q2/S+96*A2**2*P1Q1*P2Q2/S -C - A910 = 48*A12*MB*MT+48*A2**2*MB*MT-48*A12*P1P2-48*A2**2*P1P2+ - &384*A12*MB*MT*P1Q1*P1Q2/S**2-384*A12*P1P2*P1Q1*P1Q2/S**2+ - &384*A1*A2*MB*MT*P1Q2*P2Q1/S**2-384*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &192*A12*P1Q1*P1Q2*P2Q1/S**2+192*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &192*A12*P1Q2**2*P2Q1/S**2-192*A1*A2*P1Q2**2*P2Q1/S**2+ - &192*A1*A2*P1Q2*P2Q1**2/S**2+192*A2**2*P1Q2*P2Q1**2/S**2+ - &384*A1*A2*MB*MT*P1Q1*P2Q2/S**2-384*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &192*A12*P1Q1**2*P2Q2/S**2-192*A1*A2*P1Q1**2*P2Q2/S**2+ - &192*A12*P1Q1*P1Q2*P2Q2/S**2+192*A1*A2*P1Q1*P1Q2*P2Q2/S**2+ - &384*A2**2*MB*MT*P2Q1*P2Q2/S**2-384*A2**2*P1P2*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q1*P2Q1*P2Q2/S**2-192*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &192*A1*A2*P1Q2*P2Q1*P2Q2/S**2-192*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &192*A1*A2*P1Q1*P2Q2**2/S**2+192*A2**2*P1Q1*P2Q2**2/S**2- - &96*A12*MB*MT*P1Q1/S+96*A1*A2*MB*MT*P1Q1/S+ - &96*A12*P1P2*P1Q1/S-96*A1*A2*P1P2*P1Q1/S-96*A12*MB*MT*P1Q2/S+ - &96*A1*A2*MB*MT*P1Q2/S+96*A12*P1P2*P1Q2/S-96*A1*A2*P1P2*P1Q2/S- - &96*A1*A2*MB*MT*P2Q1/S+96*A2**2*MB*MT*P2Q1/S - A910=A910+96*A1*A2*P1P2*P2Q1/S- - &96*A2**2*P1P2*P2Q1/S+96*A12*P1Q2*P2Q1/S+ - &192*A1*A2*P1Q2*P2Q1/S+96*A2**2*P1Q2*P2Q1/S- - &96*A1*A2*MB*MT*P2Q2/S+96*A2**2*MB*MT*P2Q2/S+ - &96*A1*A2*P1P2*P2Q2/S-96*A2**2*P1P2*P2Q2/S+96*A12*P1Q1*P2Q2/S+ - &192*A1*A2*P1Q1*P2Q2/S+96*A2**2*P1Q1*P2Q2/S -C -C FINAL RESULT; -C - AMP2= FACT*PS*VTB**2*(V**2 *(V18 +V910)+A**2 *(A18+A910) ) - - END -C--------------------------------------------------------- -C 2) Q QBAR ->TBH^+ - SUBROUTINE PYTBHQ(Q1,Q2,P1,P2,P3,MT,MB,RMB,MHP,AMP2) -C -C AMP2(OUTPUT) =MATRIX ELEMENT (AMPLITUDE**2) FOR Q QBAR->TB H^+ -C (NB SAME STRUCTURE AS FOR PYTBHG ROUTINE ABOVE) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DOUBLE PRECISION MW2,MT,MB,MHP,MW - DIMENSION Q1(4),Q2(4),P1(4),P2(4),P3(4) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYCTBH/ ALPHA,ALPHAS,SW2,MW2,TANB,VTB,V,A - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYCTBH/ -C !THE RELEVANT INPUT PARAMETERS ABOVE ARE NEEDED FOR CALCULATION -C BUT ARE NOT DEFINED HERE SO THAT ONE MAY CHOOSE/VARY THEIR VALUES: -C ACCORDINGLY, WHEN CALLING THESE SUBROUTINES, PLEASE SUPPLY VIA -C THIS COMMON/PARAM/ YOUR PREFERRED ALPHA, ALPHAS,..AND TANB VALUES -C -C THE NORMALIZED V,A COUPLINGS ARE DEFINED BELOW AND USED BOTH -C IN THIS ROUTINE AND IN THE TOP WIDTH CALCULATION PYTBHB(..). -C - DIMENSION YY(2,2) - - PI = 4*DATAN(1.D0) - MW = DSQRT(MW2) - -C COLLECTING THE RELEVANT OVERALL FACTORS: -C 3X3 INITIAL QUARK COLOR AVERAGE, 2X2 QUARK SPIN AVERAGE - PS=1.D0/(3.D0*3.D0 *2.D0*2.D0) -C COUPLING CONSTANT (OVERALL NORMALIZATION) - FACT=(4.D0*PI*ALPHA)*(4.D0*PI*ALPHAS)**2/SW2/2.D0 -C NB ALPHA IS E^2/4/PI, BUT BETTER DEFINED IN TERMS OF G_FERMI: -C ALPHA= DSQRT(2.D0)*GF*SW2*MW**2/PI -C ALPHAS IS ALPHA_STRONG; -C SW2 IS SIN(THETA_W)**2. -C -C VTB=.998D0 -C VTB IS TOP-BOTTOM CKM MATRIX ELEMENT (APPROXIMATE VALUE HERE) -C - V = ( MT/MW/TANB +RMB/MW*TANB)/2.D0 - A = (-MT/MW/TANB +RMB/MW*TANB)/2.D0 -C V AND A ARE (NORMALIZED) VECTOR AND AXIAL TBH^+ COUPLINGS -C -C REDEFINING P2 INGOING FROM OVERALL MOMENTUM CONSERVATION -C (BECAUSE P2 INGOING WAS USED IN OUR GRAPH CALCULATION CONVENTIONS) - DO KK=1,4 - P2(KK)=P3(KK)-Q1(KK)-Q2(KK)+P1(KK) - ENDDO -C DEFINING VARIOUS RELEVANT 4-SCALAR PRODUCTS: - S = 2*PYTBHS(Q1,Q2) - P1Q1=PYTBHS(Q1,P1) - P1Q2=PYTBHS(P1,Q2) - P2Q1=PYTBHS(P2,Q1) - P2Q2=PYTBHS(P2,Q2) - P1P2=PYTBHS(P1,P2) -C -C TOP WIDTH CALCULATION - CALL PYTBHB(MT,MB,MHP,BR,GAMT) -C GAMT IS THE TOP WIDTH: T->BH^+ AND/OR T->B W^+ -C THEN DEFINE TOP (RESONANT) PROPAGATOR: - A1INV= S -2*P1Q1 -2*P1Q2 - A1 =A1INV/(A1INV**2+ (GAMT*MT)**2) -C (I.E. INTRODUCE THE TOP WIDTH IN A1 TO REGULARISE THE POLE) -C NB A12 = A1*A1 BUT WITH CORRECT WIDTH TREATMENT - A12 = 1.D0/(A1INV**2+ (GAMT*MT)**2) - A2 =1.D0/(S +2*P2Q1 +2*P2Q2) -C NOTE A2 IS B PROPAGATOR, DOES NOT NEED A WIDTH -C NOW COMES THE AMP**2: -C NB COLOR FACTOR (COMING FORM GRAPHS) ALREADY INCLUDED IN -C THE EXPRESSIONS BELOW - YY(1, 1) = -16*A**2*A2**2*MB*MT+ - &64*A**2*A2**2*P1Q2*P2Q1**2/S**2+ - &128*A**2*A2**2*MB*MT*P2Q1*P2Q2/S**2- - &128*A**2*A2**2*P1P2*P2Q1*P2Q2/S**2- - &64*A**2*A2**2*P1Q1*P2Q1*P2Q2/S**2- - &64*A**2*A2**2*P1Q2*P2Q1*P2Q2/S**2+ - &64*A**2*A2**2*P1Q1*P2Q2**2/S**2- - &32*A**2*A2**2*MB**3*MT/S+32*A**2*A2**2*MB**2*P1P2/S+ - &32*A**2*A2**2*MB**2*P1Q1/S+32*A**2*A2**2*MB**2*P1Q2/S- - &32*A**2*A2**2*P1P2*P2Q1/S-32*A**2*A2**2*P1Q1*P2Q1/S- - &32*A**2*A2**2*P1P2*P2Q2/S-32*A**2*A2**2*P1Q2*P2Q2/S+ - &16*A2**2*MB*MT*V**2+64*A2**2*P1Q2*P2Q1**2*V**2/S**2- - &128*A2**2*MB*MT*P2Q1*P2Q2*V**2/S**2- - &128*A2**2*P1P2*P2Q1*P2Q2*V**2/S**2- - &64*A2**2*P1Q1*P2Q1*P2Q2*V**2/S**2- - &64*A2**2*P1Q2*P2Q1*P2Q2*V**2/S**2+ - &64*A2**2*P1Q1*P2Q2**2*V**2/S**2 - YY(1, 1)=YY(1, 1)+32*A2**2*MB**3*MT*V**2/S+ - &32*A2**2*MB**2*P1P2*V**2/S+ - &32*A2**2*MB**2*P1Q1*V**2/S+32*A2**2*MB**2*P1Q2*V**2/S- - &32*A2**2*P1P2*P2Q1*V**2/S-32*A2**2*P1Q1*P2Q1*V**2/S- - &32*A2**2*P1P2*P2Q2*V**2/S-32*A2**2*P1Q2*P2Q2*V**2/S - YY(1, 1)=2*YY(1, 1) - - YY(1, 2) = -32*A**2*A1*A2*MB*MT+ - &128*A**2*A1*A2*MB*MT*P1Q2*P2Q1/S**2- - &128*A**2*A1*A2*P1P2*P1Q2*P2Q1/S**2+ - &64*A**2*A1*A2*P1Q1*P1Q2*P2Q1/S**2- - &64*A**2*A1*A2*P1Q2**2*P2Q1/S**2+ - &64*A**2*A1*A2*P1Q2*P2Q1**2/S**2+ - &128*A**2*A1*A2*MB*MT*P1Q1*P2Q2/S**2- - &128*A**2*A1*A2*P1P2*P1Q1*P2Q2/S**2- - &64*A**2*A1*A2*P1Q1**2*P2Q2/S**2+ - &64*A**2*A1*A2*P1Q1*P1Q2*P2Q2/S**2- - &64*A**2*A1*A2*P1Q1*P2Q1*P2Q2/S**2- - &64*A**2*A1*A2*P1Q2*P2Q1*P2Q2/S**2+ - &64*A**2*A1*A2*P1Q1*P2Q2**2/S**2- - &64*A**2*A1*A2*MB*MT*P1P2/S+ - &64*A**2*A1*A2*P1P2**2/S+32*A**2*A1*A2*MB**2*P1Q1/S+ - &32*A**2*A1*A2*P1P2*P1Q1/S+32*A**2*A1*A2*MB**2*P1Q2/S+ - &32*A**2*A1*A2*P1P2*P1Q2/S-32*A**2*A1*A2*MT**2*P2Q1/S - YY(1, 2)=YY(1, 2)-32*A**2*A1*A2*P1P2*P2Q1/S- - &64*A**2*A1*A2*P1Q1*P2Q1/S- - &32*A**2*A1*A2*MT**2*P2Q2/S-32*A**2*A1*A2*P1P2*P2Q2/S- - &64*A**2*A1*A2*P1Q2*P2Q2/S+32*A1*A2*MB*MT*V**2- - &128*A1*A2*MB*MT*P1Q2*P2Q1*V**2/S**2 - - &128*A1*A2*P1P2*P1Q2*P2Q1*V**2/S**2+ - &64*A1*A2*P1Q1*P1Q2*P2Q1*V**2/S**2- - &64*A1*A2*P1Q2**2*P2Q1*V**2/S**2+ - &64*A1*A2*P1Q2*P2Q1**2*V**2/S**2- - &128*A1*A2*MB*MT*P1Q1*P2Q2*V**2/S**2- - &128*A1*A2*P1P2*P1Q1*P2Q2*V**2/S**2- - &64*A1*A2*P1Q1**2*P2Q2*V**2/S**2+ - &64*A1*A2*P1Q1*P1Q2*P2Q2*V**2/S**2- - &64*A1*A2*P1Q1*P2Q1*P2Q2*V**2/S**2- - &64*A1*A2*P1Q2*P2Q1*P2Q2*V**2/S**2+ - &64*A1*A2*P1Q1*P2Q2**2*V**2/S**2+ - &64*A1*A2*MB*MT*P1P2*V**2/S+64*A1*A2*P1P2**2*V**2/S - YY(1, 2)=YY(1, 2)+32*A1*A2*MB**2*P1Q1*V**2/S+ - &32*A1*A2*P1P2*P1Q1*V**2/S+ - &32*A1*A2*MB**2*P1Q2*V**2/S+32*A1*A2*P1P2*P1Q2*V**2/S- - &32*A1*A2*MT**2*P2Q1*V**2/S-32*A1*A2*P1P2*P2Q1*V**2/S- - &64*A1*A2*P1Q1*P2Q1*V**2/S-32*A1*A2*MT**2*P2Q2*V**2/S- - &32*A1*A2*P1P2*P2Q2*V**2/S-64*A1*A2*P1Q2*P2Q2*V**2/S - - - YY(2, 2) =-16*A**2*A12*MB*MT+ - &128*A**2*A12*MB*MT*P1Q1*P1Q2/S**2- - &128*A**2*A12*P1P2*P1Q1*P1Q2/S**2+ - &64*A**2*A12*P1Q1*P1Q2*P2Q1/S**2- - &64*A**2*A12*P1Q2**2*P2Q1/S**2-64*A**2*A12*P1Q1**2*P2Q2/S**2+ - &64*A**2*A12*P1Q1*P1Q2*P2Q2/S**2-32*A**2*A12*MB*MT**3/S+ - &32*A**2*A12*MT**2*P1P2/S+32*A**2*A12*P1P2*P1Q1/S+ - &32*A**2*A12*P1P2*P1Q2/S-32*A**2*A12*MT**2*P2Q1/S- - &32*A**2*A12*P1Q1*P2Q1/S-32*A**2*A12*MT**2*P2Q2/S- - &32*A**2*A12*P1Q2*P2Q2/S+16*A12*MB*MT*V**2- - &128*A12*MB*MT*P1Q1*P1Q2*V**2/S**2- - &128*A12*P1P2*P1Q1*P1Q2*V**2/S**2+ - &64*A12*P1Q1*P1Q2*P2Q1*V**2/S**2- - &64*A12*P1Q2**2*P2Q1*V**2/S**2-64*A12*P1Q1**2*P2Q2*V**2/S**2+ - &64*A12*P1Q1*P1Q2*P2Q2*V**2/S**2+32*A12*MB*MT**3*V**2/S+ - &32*A12*MT**2*P1P2*V**2/S+32*A12*P1P2*P1Q1*V**2/S+ - &32*A12*P1P2*P1Q2*V**2/S-32*A12*MT**2*P2Q1*V**2/S - YY(2, 2)=YY(2, 2)-32*A12*P1Q1*P2Q1*V**2/S- - &32*A12*MT**2*P2Q2*V**2/S- - &32*A12*P1Q2*P2Q2*V**2/S - YY(2, 2)=2*YY(2, 2) - - RES=YY(1,1)+2*YY(1,2)+YY(2,2) - AMP2= FACT*PS*VTB**2*RES - - END -C===================================================================== -C ************* FUNCTION SCALAR PRODUCTS ************************* - DOUBLE PRECISION FUNCTION PYTBHS(A,B) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - DIMENSION A(4),B(4) - DUM=A(4)*B(4) - DO 77 ID=1,3 - DUM=DUM-A(ID)*B(ID) - 77 CONTINUE - PYTBHS=DUM - RETURN - END - -C********************************************************************* - -C...PYTECM -C...Finds the s-hat dependent eigenvalues of the inverse propagator -C...matrix for gamma, Z, techni-rho, and techni-omega to optimize the -C...phase space generation. - - SUBROUTINE PYTECM(S1,S2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYTCSM/ - -C...Local variables. - DOUBLE PRECISION AR(4,4),WR(4),ZR(4,4),ZI(4,4),WORK(12,12), - &AT(4,4),WI(4),FV1(4),FV2(4),FV3(4),sh,aem,tanw,ct2w,qupd,alprht, - &far,fao,fzr,fzo,shr,R1,R2,S1,S2,WDTP(0:400),WDTE(0:400,0:5) - INTEGER i,j,ierr - - SH=PMAS(PYCOMP(KTECHN+113),1)**2 - AEM=PYALEM(SH) - - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - CT2W=(1D0-2D0*PARU(102))/(2D0*PARU(102)/TANW) - QUPD=2D0*RTCM(2)-1D0 - - ALPRHT=2.91D0*(3D0/DBLE(ITCM(1))) - FAR=SQRT(AEM/ALPRHT) - FAO=FAR*QUPD - FZR=FAR*CT2W - FZO=-FAO*TANW - - AR(1,1) = SH - AR(2,2) = SH-PMAS(23,1)**2 - AR(3,3) = SH-PMAS(PYCOMP(KTECHN+113),1)**2 - AR(4,4) = SH-PMAS(PYCOMP(KTECHN+223),1)**2 - AR(1,2) = 0D0 - AR(2,1) = 0D0 - AR(1,3) = -SH*FAR - AR(3,1) = AR(1,3) - AR(1,4) = -SH*FAO - AR(4,1) = AR(1,4) - AR(2,3) = -SH*FZR - AR(3,2) = AR(2,3) - AR(2,4) = -SH*FZO - AR(4,2) = AR(2,4) - AR(3,4) = 0D0 - AR(4,3) = 0D0 -CCCCCCCC - DO 110 I=1,4 - DO 100 J=1,4 - AT(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - SHR=SQRT(SH) - CALL PYWIDT(23,SH,WDTP,WDTE) - AT(2,2) = WDTP(0)*SHR - CALL PYWIDT(KTECHN+113,SH,WDTP,WDTE) - AT(3,3) = WDTP(0)*SHR - CALL PYWIDT(KTECHN+223,SH,WDTP,WDTE) - AT(4,4) = WDTP(0)*SHR -CCCC - CALL PYEICG(4,4,AR,AT,WR,WI,0,ZR,ZI,FV1,FV2,FV3,IERR) - DO 120 I=1,4 - WI(I)=SQRT(ABS(SH-WR(I))) - WR(I)=ABS(WR(I)) - 120 CONTINUE - R1=MIN(WR(1),WR(2),WR(3),WR(4)) - R2=1D20 - S1=0D0 - S2=0D0 - DO 130 I=1,4 - IF(ABS(WR(I)-R1).LT.1D-6) THEN - S1=WI(I) - GOTO 130 - ENDIF - IF(WR(I).LE.R2) THEN - R2=WR(I) - S2=WI(I) - ENDIF - 130 CONTINUE - S1=S1**2 - S2=S2**2 - RETURN - END - -C********************************************************************* - -C...PYTEST -C...A simple program (disguised as subroutine) to run at installation -C...as a check that the program works as intended. - - SUBROUTINE PYTEST(MTEST) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/ -C...Local arrays. - DIMENSION PSUM(5),PINI(6),PFIN(6) - -C...Save defaults for values that are changed. - MSTJ1=MSTJ(1) - MSTJ3=MSTJ(3) - MSTJ11=MSTJ(11) - MSTJ42=MSTJ(42) - MSTJ43=MSTJ(43) - MSTJ44=MSTJ(44) - PARJ17=PARJ(17) - PARJ22=PARJ(22) - PARJ43=PARJ(43) - PARJ54=PARJ(54) - MST101=MSTJ(101) - MST104=MSTJ(104) - MST105=MSTJ(105) - MST107=MSTJ(107) - MST116=MSTJ(116) - -C...First part: loop over simple events to be generated. - IF(MTEST.GE.1) CALL PYTABU(20) - NERR=0 - DO 180 IEV=1,500 - -C...Reset parameter values. Switch on some nonstandard features. - MSTJ(1)=1 - MSTJ(3)=0 - MSTJ(11)=1 - MSTJ(42)=2 - MSTJ(43)=4 - MSTJ(44)=2 - PARJ(17)=0.1D0 - PARJ(22)=1.5D0 - PARJ(43)=1D0 - PARJ(54)=-0.05D0 - MSTJ(101)=5 - MSTJ(104)=5 - MSTJ(105)=0 - MSTJ(107)=1 - IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 - -C...Ten events each for some single jets configurations. - IF(IEV.LE.50) THEN - ITY=(IEV+9)/10 - MSTJ(3)=-1 - IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 - IF(ITY.EQ.1) CALL PY1ENT(1,1,15D0,0D0,0D0) - IF(ITY.EQ.2) CALL PY1ENT(1,3101,15D0,0D0,0D0) - IF(ITY.EQ.3) CALL PY1ENT(1,-2203,15D0,0D0,0D0) - IF(ITY.EQ.4) CALL PY1ENT(1,-4,30D0,0D0,0D0) - IF(ITY.EQ.5) CALL PY1ENT(1,21,15D0,0D0,0D0) - -C...Ten events each for some simple jet systems; string fragmentation. - ELSEIF(IEV.LE.130) THEN - ITY=(IEV-41)/10 - IF(ITY.EQ.1) CALL PY2ENT(1,1,-1,40D0) - IF(ITY.EQ.2) CALL PY2ENT(1,4,-4,30D0) - IF(ITY.EQ.3) CALL PY2ENT(1,2,2103,100D0) - IF(ITY.EQ.4) CALL PY2ENT(1,21,21,40D0) - IF(ITY.EQ.5) CALL PY3ENT(1,2101,21,-3203,30D0,0.6D0,0.8D0) - IF(ITY.EQ.6) CALL PY3ENT(1,5,21,-5,40D0,0.9D0,0.8D0) - IF(ITY.EQ.7) CALL PY3ENT(1,21,21,21,60D0,0.7D0,0.5D0) - IF(ITY.EQ.8) CALL PY4ENT(1,2,21,21,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - -C...Seventy events with independent fragmentation and momentum cons. - ELSEIF(IEV.LE.200) THEN - ITY=1+(IEV-131)/16 - MSTJ(2)=1+MOD(IEV-131,4) - MSTJ(3)=1+MOD((IEV-131)/4,4) - IF(ITY.EQ.1) CALL PY2ENT(1,4,-5,40D0) - IF(ITY.EQ.2) CALL PY3ENT(1,3,21,-3,40D0,0.9D0,0.4D0) - IF(ITY.EQ.3) CALL PY4ENT(1,2,21,21,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - IF(ITY.GE.4) CALL PY4ENT(1,2,-3,3,-2,40D0, - & 0.4D0,0.64D0,0.6D0,0.12D0,0.2D0) - -C...A hundred events with random jets (check invariant mass). - ELSEIF(IEV.LE.300) THEN - 100 DO 110 J=1,5 - PSUM(J)=0D0 - 110 CONTINUE - NJET=2D0+6D0*PYR(0) - DO 130 I=1,NJET - KFL=21 - IF(I.EQ.1) KFL=INT(1D0+4D0*PYR(0)) - IF(I.EQ.NJET) KFL=-INT(1D0+4D0*PYR(0)) - EJET=5D0+20D0*PYR(0) - THETA=ACOS(2D0*PYR(0)-1D0) - PHI=6.2832D0*PYR(0) - IF(I.LT.NJET) CALL PY1ENT(-I,KFL,EJET,THETA,PHI) - IF(I.EQ.NJET) CALL PY1ENT(I,KFL,EJET,THETA,PHI) - IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 - IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+PYMASS(KFL) - DO 120 J=1,4 - PSUM(J)=PSUM(J)+P(I,J) - 120 CONTINUE - 130 CONTINUE - IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. - & (PSUM(5)+PARJ(32))**2) GOTO 100 - -C...Fifty e+e- continuum events with matrix elements. - ELSEIF(IEV.LE.350) THEN - MSTJ(101)=2 - CALL PYEEVT(0,40D0) - -C...Fifty e+e- continuum event with varying shower options. - ELSEIF(IEV.LE.400) THEN - MSTJ(42)=1+MOD(IEV,2) - MSTJ(43)=1+MOD(IEV/2,4) - MSTJ(44)=MOD(IEV/8,3) - CALL PYEEVT(0,90D0) - -C...Fifty e+e- continuum events with coherent shower. - ELSEIF(IEV.LE.450) THEN - CALL PYEEVT(0,500D0) - -C...Fifty Upsilon decays to ggg or gammagg with coherent shower. - ELSE - CALL PYONIA(5,9.46D0) - ENDIF - -C...Generate event. Find total momentum, energy and charge. - DO 140 J=1,4 - PINI(J)=PYP(0,J) - 140 CONTINUE - PINI(6)=PYP(0,6) - CALL PYEXEC - DO 150 J=1,4 - PFIN(J)=PYP(0,J) - 150 CONTINUE - PFIN(6)=PYP(0,6) - -C...Check conservation of energy, momentum and charge; -C...usually exact, but only approximate for single jets. - MERR=0 - IF(IEV.LE.50) THEN - IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.10D0) - & MERR=MERR+1 - EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) - IF(EPZREM.LT.0D0.OR.EPZREM.GT.2D0*PARJ(31)) MERR=MERR+1 - IF(ABS(PFIN(6)-PINI(6)).GT.2.1D0) MERR=MERR+1 - ELSE - DO 160 J=1,4 - IF(ABS(PFIN(J)-PINI(J)).GT.0.0001D0*PINI(4)) MERR=MERR+1 - 160 CONTINUE - IF(ABS(PFIN(6)-PINI(6)).GT.0.1D0) MERR=MERR+1 - ENDIF - IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), - & (PFIN(J),J=1,4),PFIN(6) - -C...Check that all KF codes are known ones, and that partons/particles -C...satisfy energy-momentum-mass relation. Store particle statistics. - DO 170 I=1,N - IF(K(I,1).GT.20) GOTO 170 - IF(PYCOMP(K(I,2)).EQ.0) THEN - WRITE(MSTU(11),5100) I - MERR=MERR+1 - ENDIF - PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 - IF(ABS(PD).GT.MAX(0.1D0,0.001D0*P(I,4)**2).OR.P(I,4).LT.0D0) - & THEN - WRITE(MSTU(11),5200) I - MERR=MERR+1 - ENDIF - 170 CONTINUE - IF(MTEST.GE.1) CALL PYTABU(21) - -C...List all erroneous events and some normal ones. - IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN - IF(MERR.GE.1) WRITE(MSTU(11),6400) - CALL PYLIST(2) - ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN - CALL PYLIST(1) - ENDIF - -C...Stop execution if too many errors. - IF(MERR.NE.0) NERR=NERR+1 - IF(NERR.GE.10) THEN - WRITE(MSTU(11),6300) - CALL PYLIST(1) - STOP - ENDIF - 180 CONTINUE - -C...Summarize result of run. - IF(MTEST.GE.1) CALL PYTABU(22) - -C...Reset commonblock variables changed during run. - MSTJ(1)=MSTJ1 - MSTJ(3)=MSTJ3 - MSTJ(11)=MSTJ11 - MSTJ(42)=MSTJ42 - MSTJ(43)=MSTJ43 - MSTJ(44)=MSTJ44 - PARJ(17)=PARJ17 - PARJ(22)=PARJ22 - PARJ(43)=PARJ43 - PARJ(54)=PARJ54 - MSTJ(101)=MST101 - MSTJ(104)=MST104 - MSTJ(105)=MST105 - MSTJ(107)=MST107 - MSTJ(116)=MST116 - -C...Second part: complete events of various kinds. -C...Common initial values. Loop over initiating conditions. - MSTP(122)=MAX(0,MIN(2,MTEST)) - MDCY(PYCOMP(111),1)=0 - DO 230 IPROC=1,8 - -C...Reset process type, kinematics cuts, and the flags used. - MSEL=0 - DO 190 ISUB=1,500 - MSUB(ISUB)=0 - 190 CONTINUE - CKIN(1)=2D0 - CKIN(3)=0D0 - MSTP(2)=1 - MSTP(11)=0 - MSTP(33)=0 - MSTP(81)=1 - MSTP(82)=1 - MSTP(111)=1 - MSTP(131)=0 - MSTP(133)=0 - PARP(131)=0.01D0 - -C...Prompt photon production at fixed target. - IF(IPROC.EQ.1) THEN - PZSUM=300D0 - PESUM=SQRT(PZSUM**2+PYMASS(211)**2)+PYMASS(2212) - PQSUM=2D0 - MSEL=10 - CKIN(3)=5D0 - CALL PYINIT('FIXT','pi+','p',PZSUM) - -C...QCD processes at ISR energies. - ELSEIF(IPROC.EQ.2) THEN - PESUM=63D0 - PZSUM=0D0 - PQSUM=2D0 - MSEL=1 - CKIN(3)=5D0 - CALL PYINIT('CMS','p','p',PESUM) - -C...W production + multiple interactions at CERN Collider. - ELSEIF(IPROC.EQ.3) THEN - PESUM=630D0 - PZSUM=0D0 - PQSUM=0D0 - MSEL=12 - CKIN(1)=20D0 - MSTP(82)=4 - MSTP(2)=2 - MSTP(33)=3 - CALL PYINIT('CMS','p','pbar',PESUM) - -C...W/Z gauge boson pairs + pileup events at the Tevatron. - ELSEIF(IPROC.EQ.4) THEN - PESUM=1800D0 - PZSUM=0D0 - PQSUM=0D0 - MSUB(22)=1 - MSUB(23)=1 - MSUB(25)=1 - CKIN(1)=200D0 - MSTP(111)=0 - MSTP(131)=1 - MSTP(133)=2 - PARP(131)=0.04D0 - CALL PYINIT('CMS','p','pbar',PESUM) - -C...Higgs production at LHC. - ELSEIF(IPROC.EQ.5) THEN - PESUM=15400D0 - PZSUM=0D0 - PQSUM=2D0 - MSUB(3)=1 - MSUB(102)=1 - MSUB(123)=1 - MSUB(124)=1 - PMAS(25,1)=300D0 - CKIN(1)=200D0 - MSTP(81)=0 - MSTP(111)=0 - CALL PYINIT('CMS','p','p',PESUM) - -C...Z' production at SSC. - ELSEIF(IPROC.EQ.6) THEN - PESUM=40000D0 - PZSUM=0D0 - PQSUM=2D0 - MSEL=21 - PMAS(32,1)=600D0 - CKIN(1)=400D0 - MSTP(81)=0 - MSTP(111)=0 - CALL PYINIT('CMS','p','p',PESUM) - -C...W pair production at 1 TeV e+e- collider. - ELSEIF(IPROC.EQ.7) THEN - PESUM=1000D0 - PZSUM=0D0 - PQSUM=0D0 - MSUB(25)=1 - MSUB(69)=1 - MSTP(11)=1 - CALL PYINIT('CMS','e+','e-',PESUM) - -C...Deep inelastic scattering at a LEP+LHC ep collider. - ELSEIF(IPROC.EQ.8) THEN - P(1,1)=0D0 - P(1,2)=0D0 - P(1,3)=8000D0 - P(2,1)=0D0 - P(2,2)=0D0 - P(2,3)=-80D0 - PESUM=8080D0 - PZSUM=7920D0 - PQSUM=0D0 - MSUB(10)=1 - CKIN(3)=50D0 - MSTP(111)=0 - CALL PYINIT('3MOM','p','e-',PESUM) - ENDIF - -C...Generate 20 events of each required type. - DO 220 IEV=1,20 - CALL PYEVNT - PESUMM=PESUM - IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM - -C...Check conservation of energy/momentum/flavour. - PINI(1)=0D0 - PINI(2)=0D0 - PINI(3)=PZSUM - PINI(4)=PESUMM - PINI(6)=PQSUM - DO 200 J=1,4 - PFIN(J)=PYP(0,J) - 200 CONTINUE - PFIN(6)=PYP(0,6) - MERR=0 - DEVE=ABS(PFIN(4)-PINI(4))+ABS(PFIN(3)-PINI(3)) - DEVT=ABS(PFIN(1)-PINI(1))+ABS(PFIN(2)-PINI(2)) - DEVQ=ABS(PFIN(6)-PINI(6)) - IF(DEVE.GT.2D-3*PESUM.OR.DEVT.GT.MAX(0.01D0,1D-4*PESUM).OR. - & DEVQ.GT.0.1D0) MERR=1 - IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), - & (PFIN(J),J=1,4),PFIN(6) - -C...Check that all KF codes are known ones, and that partons/particles -C...satisfy energy-momentum-mass relation. - DO 210 I=1,N - IF(K(I,1).GT.20) GOTO 210 - IF(PYCOMP(K(I,2)).EQ.0) THEN - WRITE(MSTU(11),5100) I - MERR=MERR+1 - ENDIF - PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2* - & SIGN(1D0,P(I,5)) - IF(ABS(PD).GT.MAX(0.1D0,0.002D0*P(I,4)**2,0.002D0*P(I,5)**2) - & .OR.(P(I,5).GE.0D0.AND.P(I,4).LT.0D0)) THEN - WRITE(MSTU(11),5200) I - MERR=MERR+1 - ENDIF - 210 CONTINUE - -C...Listing of erroneous events, and first event of each type. - IF(MERR.GE.1) NERR=NERR+1 - IF(NERR.GE.10) THEN - WRITE(MSTU(11),6300) - CALL PYLIST(1) - STOP - ENDIF - IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN - IF(MERR.GE.1) WRITE(MSTU(11),6400) - CALL PYLIST(1) - ENDIF - 220 CONTINUE - -C...List statistics for each process type. - IF(MTEST.GE.1) CALL PYSTAT(1) - 230 CONTINUE - -C...Summarize result of run. - IF(NERR.EQ.0) WRITE(MSTU(11),6500) - IF(NERR.GT.0) WRITE(MSTU(11),6600) NERR - -C...Format statements for output. - 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', - &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, - &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, - &4(1X,F12.5),1X,F8.2) - 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') - 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', - &'kinematics') - 6300 FORMAT(/5X,'This is the tenth error experienced! Something is ', - &'wrong.'/5X,'Execution will be stopped after listing of event.') - 6400 FORMAT(5X,'Faulty event follows:') - 6500 FORMAT(//5X,'End result of PYTEST: no errors detected.') - 6600 FORMAT(//5X,'End result of PYTEST:',I2,' errors detected.'/ - &5X,'This should not have happened!') - - RETURN - END - - DOUBLE PRECISION FUNCTION PYTHAG(A,B) - DOUBLE PRECISION A,B -C -C FINDS DSQRT(A**2+B**2) WITHOUT OVERFLOW OR DESTRUCTIVE UNDERFLOW -C - DOUBLE PRECISION P,R,S,T,U - P = DMAX1(DABS(A),DABS(B)) - IF (P .EQ. 0.0D0) GOTO 110 - R = (DMIN1(DABS(A),DABS(B))/P)**2 - 100 CONTINUE - T = 4.0D0 + R - IF (T .EQ. 4.0D0) GOTO 110 - S = R/T - U = 1.0D0 + 2.0D0*S - P = U*P - R = (S/U)**2 * R - GOTO 100 - 110 PYTHAG = P - RETURN - END - -C********************************************************************* - -C...PYTHRG -C...Calculates the mass eigenstates of the third generation sfermions. -C...Created: 5-31-96 - - SUBROUTINE PYTHRG - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/ - -C...Local variables. - DOUBLE PRECISION BETA - DOUBLE PRECISION AM2(2,2),RT(2,2),DI(2,2) - DOUBLE PRECISION XMZ2,XMW2,TANB,XMU,COS2B,XMQL2,XMQR2 - DOUBLE PRECISION XMF,XMF2,DIFF,SAME,XMF12,XMF22,SMALL - DOUBLE PRECISION ATR,AMQR,AMQL - INTEGER ID1(3),ID2(3),ID3(3),ID4(3) - INTEGER IF,I,J,II,JJ,IT,L - LOGICAL DTERM - DATA SMALL/1D-3/ - DATA ID1/10,10,13/ - DATA ID2/5,6,15/ - DATA ID3/15,16,17/ - DATA ID4/11,12,14/ - DATA DTERM/.TRUE./ - - XMZ2=PMAS(23,1)**2 - XMW2=PMAS(24,1)**2 - TANB=RMSS(5) - XMU=-RMSS(4) - BETA=ATAN(TANB) - COS2B=COS(2D0*BETA) - -C...OPTION TO FIX T1, T2, B1 MASSES AND MIXINGS - - IOPT=IMSS(5) - IF(IOPT.EQ.1) THEN - CTT=DCOS(RMSS(27)) - CTT2=CTT**2 - STT=DSIN(RMSS(27)) - STT2=STT**2 - XM12=RMSS(10)**2 - XM22=RMSS(12)**2 - XMQL2=CTT2*XM12+STT2*XM22 - XMQR2=STT2*XM12+CTT2*XM22 - XMF2=PYMRUN(6,PMAS(6,1)**2)**2 - ATOP=-XMU/TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - RMSS(16)=ATOP -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQL2=XMQL2-XMF2-(4D0*XMW2-XMZ2)*COS2B/6D0 - XMQR2=XMQR2-XMF2+(XMW2-XMZ2)*COS2B*2D0/3D0 - IF(XMQL2.GE.0D0) THEN - RMSS(10)=SQRT(XMQL2) - ELSE - RMSS(10)=-SQRT(-XMQL2) - ENDIF - IF(XMQR2.GE.0D0) THEN - RMSS(12)=SQRT(XMQR2) - ELSE - RMSS(12)=-SQRT(-XMQR2) - ENDIF - -C SAME FOR BOTTOM SQUARK - CTT=DCOS(RMSS(26)) - CTT2=CTT**2 - STT=DSIN(RMSS(26)) - STT2=STT**2 - XM22=RMSS(11)**2 - XMF2=PYMRUN(5,PMAS(6,1)**2)**2 - XMQL2=SIGN(RMSS(10)**2,RMSS(10))-(2D0*XMW2+XMZ2)*COS2B/6D0+XMF2 - IF(ABS(CTT).GE..9999D0) THEN - ABOT=-XMU*TANB - XMQR2=RMSS(11)**2 - ELSEIF(ABS(CTT).LE.1D-4) THEN - ABOT=-XMU*TANB - XMQR2=RMSS(11)**2 - ELSE - XM12=(XMQL2-STT2*XM22)/CTT2 - XMQR2=STT2*XM12+CTT2*XM22 - ABOT=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - ENDIF - RMSS(15)=ABOT -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQR2=XMQR2-(XMW2-XMZ2)*COS2B/3D0-XMF2 - IF(XMQR2.GE.0D0) THEN - RMSS(11)=SQRT(XMQR2) - ELSE - RMSS(11)=-SQRT(-XMQR2) - ENDIF -C SAME FOR TAU SLEPTON - CTT=DCOS(RMSS(28)) - CTT2=CTT**2 - STT=DSIN(RMSS(28)) - STT2=STT**2 - XM12=RMSS(13)**2 - XM22=RMSS(14)**2 - XMQL2=CTT2*XM12+STT2*XM22 - XMQR2=STT2*XM12+CTT2*XM22 - XMFR=PMAS(15,1) - XMF2=XMFR**2 - ATAU=-XMU*TANB+CTT*STT*(XM12-XM22)/SQRT(XMF2) - RMSS(17)=ATAU -C......SUBTRACT OUT D-TERM AND FERMION MASS - XMQL2=XMQL2-XMF2+(-.5D0*XMZ2+XMW2)*COS2B - XMQR2=XMQR2-XMF2+(XMZ2-XMW2)*COS2B - IF(XMQL2.GE.0D0) THEN - RMSS(13)=SQRT(XMQL2) - ELSE - RMSS(13)=-SQRT(-XMQL2) - ENDIF - IF(XMQR2.GE.0D0) THEN - RMSS(14)=SQRT(XMQR2) - ELSE - RMSS(14)=-SQRT(-XMQR2) - ENDIF - ENDIF - DO 170 L=1,3 - AMQL=RMSS(ID1(L)) - IF(AMQL.LT.0D0) THEN - XMQL2=-AMQL**2 - ELSE - XMQL2=AMQL**2 - ENDIF - ATR=RMSS(ID3(L)) - AMQR=RMSS(ID4(L)) - IF(AMQR.LT.0D0) THEN - XMQR2=-AMQR**2 - ELSE - XMQR2=AMQR**2 - ENDIF - IF=ID2(L) - XMF=PYMRUN(IF,PMAS(6,1)**2) - XMF2=XMF**2 - AM2(1,1)=XMQL2+XMF2 - AM2(2,2)=XMQR2+XMF2 - IF(AM2(1,1).EQ.AM2(2,2)) AM2(2,2)=AM2(2,2)*1.00001D0 - IF(DTERM) THEN - IF(L.EQ.1) THEN - AM2(1,1)=AM2(1,1)-(2D0*XMW2+XMZ2)*COS2B/6D0 - AM2(2,2)=AM2(2,2)+(XMW2-XMZ2)*COS2B/3D0 - AM2(1,2)=XMF*(ATR+XMU*TANB) - ELSEIF(L.EQ.2) THEN - AM2(1,1)=AM2(1,1)+(4D0*XMW2-XMZ2)*COS2B/6D0 - AM2(2,2)=AM2(2,2)-(XMW2-XMZ2)*COS2B*2D0/3D0 - AM2(1,2)=XMF*(ATR+XMU/TANB) - ELSEIF(L.EQ.3) THEN - IF(IMSS(8).EQ.1) THEN - AM2(1,1)=RMSS(6)**2 - AM2(2,2)=RMSS(7)**2 - AM2(1,2)=0D0 - RMSS(13)=RMSS(6) - RMSS(14)=RMSS(7) - ELSE - AM2(1,1)=AM2(1,1)-(-.5D0*XMZ2+XMW2)*COS2B - AM2(2,2)=AM2(2,2)-(XMZ2-XMW2)*COS2B - AM2(1,2)=XMF*(ATR+XMU*TANB) - ENDIF - ENDIF - ENDIF - AM2(2,1)=AM2(1,2) - DETM=AM2(1,1)*AM2(2,2)-AM2(2,1)**2 - IF(DETM.LT.0D0) THEN - WRITE(MSTU(11),*) ID2(L),DETM,AM2 - CALL PYERRM(30,' NEGATIVE**2 MASS FOR SFERMION IN PYTHRG ') - ENDIF - SAME=0.5D0*(AM2(1,1)+AM2(2,2)) - DIFF=0.5D0*SQRT((AM2(1,1)-AM2(2,2))**2+4D0*AM2(1,2)*AM2(2,1)) - XMF12=SAME-DIFF - XMF22=SAME+DIFF - IT=0 - IF(XMF22-XMF12.GT.0D0) THEN - RT(1,1) = SQRT(MAX(0D0,(XMF22-AM2(1,1))/(XMF22-XMF12))) - RT(2,2) = RT(1,1) - RT(1,2) = -SIGN(SQRT(MAX(0D0,1D0-RT(1,1)**2)), - & AM2(1,2)/(XMF22-XMF12)) - RT(2,1) = -RT(1,2) - ELSE - RT(1,1) = 1D0 - RT(2,2) = RT(1,1) - RT(1,2) = 0D0 - RT(2,1) = -RT(1,2) - ENDIF - 100 CONTINUE - IT=IT+1 - - DO 140 I=1,2 - DO 130 JJ=1,2 - DI(I,JJ)=0D0 - DO 120 II=1,2 - DO 110 J=1,2 - DI(I,JJ)=DI(I,JJ)+RT(I,J)*AM2(J,II)*RT(JJ,II) - 110 CONTINUE - 120 CONTINUE - 130 CONTINUE - 140 CONTINUE - - IF(DI(1,1).GT.DI(2,2)) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION ' - WRITE(MSTU(11),*) L,SQRT(XMF12),SQRT(XMF22) - WRITE(MSTU(11),*) AM2 - WRITE(MSTU(11),*) DI - WRITE(MSTU(11),*) RT - DI(1,1)=-RT(2,1) - DI(2,2)=RT(1,2) - DI(1,2)=-RT(2,2) - DI(2,1)=RT(1,1) - DO 160 I=1,2 - DO 150 J=1,2 - RT(I,J)=DI(I,J) - 150 CONTINUE - 160 CONTINUE - GOTO 100 - ELSEIF(ABS(DI(1,2)*DI(2,1)/DI(1,1)/DI(2,2)).GT.SMALL) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// - & ' OFF DIAGONAL ELEMENTS ' - WRITE(MSTU(11),*) 'MASSES = ',L,SQRT(XMF12),SQRT(XMF22) - WRITE(MSTU(11),*) DI - WRITE(MSTU(11),*) ' ROTATION = ',RT -C...STOP - ELSEIF(DI(1,1).LT.0D0.OR.DI(2,2).LT.0D0) THEN - WRITE(MSTU(11),*) ' ERROR IN DIAGONALIZATION,'// - & ' NEGATIVE MASSES ' - STOP - ENDIF - PMAS(PYCOMP(KSUSY1+IF),1)=SQRT(XMF12) - PMAS(PYCOMP(KSUSY2+IF),1)=SQRT(XMF22) - SFMIX(IF,1)=RT(1,1) - SFMIX(IF,2)=RT(1,2) - SFMIX(IF,3)=RT(2,1) - SFMIX(IF,4)=RT(2,2) - 170 CONTINUE - -C.....TAU SNEUTRINO MASS...L=3 - - XARG=AM2(1,1)+XMW2*COS2B - IF(XARG.LT.0D0) THEN - WRITE(MSTU(11),*) ' PYTHRG:: TAU SNEUTRINO MASS IS NEGATIVE'// - & ' FROM THE SUM RULE. ' - WRITE(MSTU(11),*) ' TRY A SMALLER VALUE OF TAN(BETA). ' - RETURN - ELSE - PMAS(PYCOMP(KSUSY1+16),1)=SQRT(XARG) - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYTHRU -C...Performs thrust analysis to give thrust, oblateness -C...and the related event axes. - - SUBROUTINE PYTHRU(THR,OBL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ -C...Local arrays. - DIMENSION TDI(3),TPR(3) - -C...Take copy of particles that are to be considered in thrust analysis. - NP=0 - PS=0D0 - 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=PYCOMP(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.PYCHGE(K(I,2)).EQ.0) - & GOTO 100 - ENDIF - IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN - CALL PYERRM(11,'(PYTHRU:) no more memory left in PYJETS') - THR=-2D0 - OBL=-2D0 - 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)=1D0 - IF(ABS(PARU(42)-1D0).GT.0.001D0) P(N+NP,5)= - & P(N+NP,4)**(PARU(42)-1D0) - 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 PYERRM(8,'(PYTHRU:) too few particles for analysis') - THR=-1D0 - OBL=-1D0 - 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=PYANGL(P(N+NP+1,1),P(N+NP+1,2)) - MSTU(33)=1 - CALL PYROBO(N+1,N+NP+1,0D0,-PHI,0D0,0D0,0D0) - THE=PYANGL(P(N+NP+1,3),P(N+NP+1,1)) - CALL PYROBO(N+1,N+NP+1,-THE,0D0,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)=0D0 - 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)=0D0 - 170 CONTINUE - NC=2**(MIN(MSTU(44),NP)-1) - DO 250 ILC=1,NC - DO 180 J=1,3 - TDI(J)=0D0 - 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)=0D0 - ILG=0 - 260 ILG=ILG+1 - THP=0D0 - 270 THPS=THP - DO 280 J=1,3 - IF(THP.LE.1D-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) - IF(THP.GT.1D-10) TDI(J)=TPR(J) - TPR(J)=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - 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=(-1D0)**INT(PYR(0)+0.5D0) - 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)=0D0 - THP=0D0 - 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)=0D0 - -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)=0D0 - 340 CONTINUE - 350 CONTINUE - CALL PYROBO(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********************************************************************* - -C...PYTIME -C...Finds current date and time. -C...Since this task is not standardized in Fortran 77, the routine -C...is dummy, to be replaced by the user. Examples are given for -C...the Fortran 90 routine and DEC Fortran 77, and what to do if -C...you do not have access to suitable routines. - - SUBROUTINE PYTIME(IDATI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - CHARACTER*8 ATIME -C...Local array. - INTEGER IDATI(6),IDTEMP(3) - -C...Example 0: if you do not have suitable routines. - DO 100 J=1,6 - IDATI(J)=0 - 100 CONTINUE - -C...Example 1: Fortran 90 routine. -C INTEGER IVAL(8) -C CALL DATE_AND_TIME(VALUES=IVAL) -C IDATI(1)=IVAL(1) -C IDATI(2)=IVAL(2) -C IDATI(3)=IVAL(3) -C IDATI(4)=IVAL(5) -C IDATI(5)=IVAL(6) -C IDATI(6)=IVAL(7) - -C...Example 2: DEC Fortran 77. AIX. -C CALL IDATE(IMON,IDAY,IYEAR) -C IDATI(1)=IYEAR -C IDATI(2)=IMON -C IDATI(3)=IDAY -C CALL ITIME(IHOUR,IMIN,ISEC) -C IDATI(4)=IHOUR -C IDATI(5)=IMIN -C IDATI(6)=ISEC - -C...Example 3: DEC Fortran, IRIX, IRIX64. -C CALL IDATE(IMON,IDAY,IYEAR) -C IDATI(1)=IYEAR -C IDATI(2)=IMON -C IDATI(3)=IDAY -C CALL TIME(ATIME) -C IHOUR=0 -C IMIN=0 -C ISEC=0 -C READ(ATIME(1:2),'(I2)') IHOUR -C READ(ATIME(4:5),'(I2)') IMIN -C READ(ATIME(7:8),'(I2)') ISEC -C IDATI(4)=IHOUR -C IDATI(5)=IMIN -C IDATI(6)=ISEC - -C...Example 4: GNU LINUX libU77, SunOS. - CALL IDATE(IDTEMP) - IDATI(1)=IDTEMP(3) - IDATI(2)=IDTEMP(2) - IDATI(3)=IDTEMP(1) - CALL ITIME(IDTEMP) - IDATI(4)=IDTEMP(1) - IDATI(5)=IDTEMP(2) - IDATI(6)=IDTEMP(3) - -C...Common code to ensure right century. - IDATI(1)=2000+MOD(IDATI(1),100) - - RETURN - END - -C********************************************************************* - -C...PYUPDA -C...Facilitates the updating of particle and decay data -C...by allowing it to be done in an external file. - - SUBROUTINE PYUPDA(MUPDA,LFN) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYDAT4/CHAF(500,2) - CHARACTER CHAF*16 - COMMON/PYINT4/MWID(500),WIDS(500,5) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYDAT4/,/PYINT4/ -C...Local arrays, character variables and data. - CHARACTER CHINL*120,CHKF*9,CHVAR(22)*9,CHLIN*72, - &CHBLK(20)*72,CHOLD*16,CHTMP*16,CHNEW*16,CHCOM*24 - DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','KCHG(I,4)', - &'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,1)','CHAF(I,2)','MWID(I) '/ - -C...Write header if not yet done. - IF(MSTU(12).GE.1) CALL PYLIST(0) - -C...Write information on file for editing. - IF(MUPDA.EQ.1) THEN - DO 110 KC=1,500 - WRITE(LFN,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), - & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), - & MWID(KC),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...Read complete set of information from edited file or -C...read partial set of new or updated information from edited file. - ELSEIF(MUPDA.EQ.2.OR.MUPDA.EQ.3) THEN - -C...Reset counters. - KCC=100 - NDC=0 - CHKF=' ' - IF(MUPDA.EQ.2) THEN - DO 120 I=1,MSTU(6) - KCHG(I,4)=0 - 120 CONTINUE - ELSE - DO 130 KC=1,MSTU(6) - IF(KC.GT.100.AND.KCHG(KC,4).GT.100) KCC=KC - NDC=MAX(NDC,MDCY(KC,2)+MDCY(KC,3)-1) - 130 CONTINUE - ENDIF - -C...Begin of loop: read new line; unknown whether particle or -C...decay data. - 140 READ(LFN,5200,END=190) CHINL - -C...Identify particle code and whether already defined (for MUPDA=3). - IF(CHINL(2:10).NE.' ') THEN - CHKF=CHINL(2:10) - READ(CHKF,5300) KF - IF(MUPDA.EQ.2) THEN - IF(KF.LE.100) THEN - KC=KF - ELSE - KCC=KCC+1 - KC=KCC - ENDIF - ELSE - KCREP=0 - IF(KF.LE.100) THEN - KCREP=KF - ELSE - DO 150 KCR=101,KCC - IF(KCHG(KCR,4).EQ.KF) KCREP=KCR - 150 CONTINUE - ENDIF -C...Remove duplicate old decay data. - IF(KCREP.NE.0.AND.MDCY(KCREP,3).GT.0) THEN - IDCREP=MDCY(KCREP,2) - NDCREP=MDCY(KCREP,3) - DO 160 I=1,KCC - IF(MDCY(I,2).GT.IDCREP) MDCY(I,2)=MDCY(I,2)-NDCREP - 160 CONTINUE - DO 180 I=IDCREP,NDC-NDCREP - MDME(I,1)=MDME(I+NDCREP,1) - MDME(I,2)=MDME(I+NDCREP,2) - BRAT(I)=BRAT(I+NDCREP) - DO 170 J=1,5 - KFDP(I,J)=KFDP(I+NDCREP,J) - 170 CONTINUE - 180 CONTINUE - NDC=NDC-NDCREP - KC=KCREP - ELSEIF(KCREP.NE.0) THEN - KC=KCREP - ELSE - KCC=KCC+1 - KC=KCC - ENDIF - ENDIF - -C...Study line with particle data. - IF(KC.GT.MSTU(6)) CALL PYERRM(27, - & '(PYUPDA:) Particle arrays full by KF ='//CHKF) - READ(CHINL,5000) KCHG(KC,4),(CHAF(KC,J1),J1=1,2), - & (KCHG(KC,J2),J2=1,3),(PMAS(KC,J3),J3=1,4), - & MWID(KC),MDCY(KC,1) - MDCY(KC,2)=0 - MDCY(KC,3)=0 - -C...Study line with decay data. - ELSE - NDC=NDC+1 - IF(NDC.GT.MSTU(7)) CALL PYERRM(27, - & '(PYUPDA:) Decay data arrays full by KF ='//CHKF) - IF(MDCY(KC,2).EQ.0) MDCY(KC,2)=NDC - MDCY(KC,3)=MDCY(KC,3)+1 - READ(CHINL,5100) MDME(NDC,1),MDME(NDC,2),BRAT(NDC), - & (KFDP(NDC,J),J=1,5) - ENDIF - -C...End of loop; ensure that PYCOMP tables are updated. - GOTO 140 - 190 CONTINUE - MSTU(20)=0 - -C...Perform possible tests that new information is consistent. - DO 220 KC=1,MSTU(6) - KF=KCHG(KC,4) - IF(KF.EQ.0) GOTO 220 - WRITE(CHKF,5300) KF - IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), - & PMAS(KC,4)).LT.0D0.OR.MDCY(KC,3).LT.0) CALL PYERRM(17, - & '(PYUPDA:) Mass/width/life/(# channels) wrong for KF ='//CHKF) - BRSUM=0D0 - DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 - IF(MDME(IDC,2).GT.80) GOTO 210 - KQ=KCHG(KC,1) - PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) - MERR=0 - DO 200 J=1,5 - KP=KFDP(IDC,J) - IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN - IF(KP.EQ.81) KQ=0 - ELSEIF(PYCOMP(KP).EQ.0) THEN - MERR=3 - ELSE - KQ=KQ-PYCHGE(KP) - KPC=PYCOMP(KP) - PMS=PMS-PMAS(KPC,1) - IF(MSTJ(24).GT.0) PMS=PMS+0.5D0*MIN(PMAS(KPC,2), - & PMAS(KPC,3)) - ENDIF - 200 CONTINUE - IF(KQ.NE.0) MERR=MAX(2,MERR) - IF(MWID(KC).EQ.0.AND.KF.NE.311.AND.PMS.LT.0D0) - & MERR=MAX(1,MERR) - IF(MERR.EQ.3) CALL PYERRM(17, - & '(PYUPDA:) Unknown particle code in decay of KF ='//CHKF) - IF(MERR.EQ.2) CALL PYERRM(17, - & '(PYUPDA:) Charge not conserved in decay of KF ='//CHKF) - IF(MERR.EQ.1) CALL PYERRM(7, - & '(PYUPDA:) Kinematically unallowed decay of KF ='//CHKF) - BRSUM=BRSUM+BRAT(IDC) - 210 CONTINUE - WRITE(CHTMP,5500) BRSUM - IF(ABS(BRSUM).GT.0.0005D0.AND.ABS(BRSUM-1D0).GT.0.0005D0) - & CALL PYERRM(7,'(PYUPDA:) Sum of branching ratios is '// - & CHTMP(9:16)//' for KF ='//CHKF) - 220 CONTINUE - -C...Write DATA statements for inclusion in program. - ELSEIF(MUPDA.EQ.4) THEN - -C...Find out how many codes and decay channels are actually used. - KCC=0 - NDC=0 - DO 230 I=1,MSTU(6) - IF(KCHG(I,4).NE.0) THEN - KCC=I - NDC=MAX(NDC,MDCY(I,2)+MDCY(I,3)-1) - ENDIF - 230 CONTINUE - -C...Initialize writing of DATA statements for inclusion in program. - DO 300 IVAR=1,22 - NDIM=MSTU(6) - IF(IVAR.GE.12.AND.IVAR.LE.19) 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 280 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,5400) KCHG(IDIM,4) - IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,1) - IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,2) - IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,3) - IF(IVAR.EQ.8) WRITE(CHTMP,5500) PMAS(IDIM,4) - IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,1) - IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,2) - IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDCY(IDIM,3) - IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,1) - IF(IVAR.EQ.13) WRITE(CHTMP,5400) MDME(IDIM,2) - IF(IVAR.EQ.14) WRITE(CHTMP,5600) BRAT(IDIM) - IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,1) - IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,2) - IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,3) - IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,4) - IF(IVAR.EQ.19) WRITE(CHTMP,5400) KFDP(IDIM,5) - IF(IVAR.EQ.20) CHTMP=CHAF(IDIM,1) - IF(IVAR.EQ.21) CHTMP=CHAF(IDIM,2) - IF(IVAR.EQ.22) WRITE(CHTMP,5400) MWID(IDIM) - -C...Replace variables beyond what is properly defined. - IF(IVAR.LE.4) THEN - IF(IDIM.GT.KCC) CHTMP=' 0' - ELSEIF(IVAR.LE.8) THEN - IF(IDIM.GT.KCC) CHTMP=' 0.0' - ELSEIF(IVAR.LE.11) THEN - IF(IDIM.GT.KCC) CHTMP=' 0' - ELSEIF(IVAR.LE.13) THEN - IF(IDIM.GT.NDC) CHTMP=' 0' - ELSEIF(IVAR.LE.14) THEN - IF(IDIM.GT.NDC) CHTMP=' 0.0' - ELSEIF(IVAR.LE.19) THEN - IF(IDIM.GT.NDC) CHTMP=' 0' - ELSEIF(IVAR.LE.21) THEN - IF(IDIM.GT.KCC) CHTMP=' ' - ELSE - IF(IDIM.GT.KCC) CHTMP=' 0' - ENDIF - -C...Length of variable, trailing decimal zeros, quotation marks. - LLOW=1 - LHIG=1 - DO 240 LL=1,16 - IF(CHTMP(17-LL:17-LL).NE.' ') LLOW=17-LL - IF(CHTMP(LL:LL).NE.' ') LHIG=LL - 240 CONTINUE - CHNEW=CHTMP(LLOW:LHIG)//' ' - LNEW=1+LHIG-LLOW - IF((IVAR.GE.5.AND.IVAR.LE.8).OR.IVAR.EQ.14) THEN - LNEW=LNEW+1 - 250 LNEW=LNEW-1 - IF(LNEW.GE.2.AND.CHNEW(LNEW:LNEW).EQ.'0') GOTO 250 - IF(CHNEW(LNEW:LNEW).EQ.'.') LNEW=LNEW-1 - IF(LNEW.EQ.0) THEN - CHNEW(1:3)='0D0' - LNEW=3 - ELSE - CHNEW(LNEW+1:LNEW+2)='D0' - LNEW=LNEW+2 - ENDIF - ELSEIF(IVAR.EQ.20.OR.IVAR.EQ.21) THEN - DO 260 LL=LNEW,1,-1 - IF(CHNEW(LL:LL).EQ.'''') THEN - CHTMP=CHNEW - CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) - LNEW=LNEW+1 - ENDIF - 260 CONTINUE - LNEW=MIN(14,LNEW) - 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(17-LRPT:16)//'*'//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(13:16) - DO 270 ILIN=1,NLIN - WRITE(LFN,5700) CHBLK(ILIN) - 270 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(13:16) - LLIN=35+LCOM+1 - ENDIF - 280 CONTINUE - -C...Write final block of lines. - CHLIN(LLIN:72)='/'//' ' - CHBLK(NLIN)=CHLIN - WRITE(CHTMP,5400) NDIM - CHBLK(1)(30:33)=CHTMP(13:16) - DO 290 ILIN=1,NLIN - WRITE(LFN,5700) CHBLK(ILIN) - 290 CONTINUE - 300 CONTINUE - ENDIF - -C...Formats for reading and writing particle data. - 5000 FORMAT(1X,I9,2X,A16,2X,A16,3I3,3F12.5,1P,E13.5,2I3) - 5100 FORMAT(10X,2I5,F12.6,5I10) - 5200 FORMAT(A120) - 5300 FORMAT(I9) - 5400 FORMAT(I16) - 5500 FORMAT(F16.5) - 5600 FORMAT(F16.6) - 5700 FORMAT(A72) - - RETURN - END - -C********************************************************************* - -C...PYUPRE -C...Rearranges contents of the HEPEUP commonblock so that -C...mothers precede daughters and daughters of a decay are -C...listed consecutively. - - SUBROUTINE PYUPRE - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - -C...Local arrays. - DIMENSION NEWPOS(0:MAXNUP),IDUPT(MAXNUP),ISTUPT(MAXNUP), - &MOTUPT(2,MAXNUP),ICOUPT(2,MAXNUP),PUPT(5,MAXNUP), - &VTIUPT(MAXNUP),SPIUPT(MAXNUP) - -C...Check whether a rearrangement is required. - NEED=0 - DO 100 IUP=1,NUP - IF(MOTHUP(1,IUP).GT.IUP) NEED=NEED+1 - 100 CONTINUE - DO 110 IUP=2,NUP - IF(MOTHUP(1,IUP).LT.MOTHUP(1,IUP-1)) NEED=NEED+1 - 110 CONTINUE - - IF(NEED.NE.0) THEN -C...Find the new order that particles should have. - NEWPOS(0)=0 - NNEW=0 - INEW=-1 - 120 INEW=INEW+1 - DO 130 IUP=1,NUP - IF(MOTHUP(1,IUP).EQ.NEWPOS(INEW)) THEN - NNEW=NNEW+1 - NEWPOS(NNEW)=IUP - ENDIF - 130 CONTINUE - IF(INEW.LT.NNEW.AND.INEW.LT.NUP) GOTO 120 - IF(NNEW.NE.NUP) THEN - CALL PYERRM(2, - & '(PYUPRE:) failed to make sense of mother pointers in HEPEUP') - RETURN - ENDIF - -C...Copy old info into temporary storage. - DO 150 I=1,NUP - IDUPT(I)=IDUP(I) - ISTUPT(I)=ISTUP(I) - MOTUPT(1,I)=MOTHUP(1,I) - MOTUPT(2,I)=MOTHUP(2,I) - ICOUPT(1,I)=ICOLUP(1,I) - ICOUPT(2,I)=ICOLUP(2,I) - DO 140 J=1,5 - PUPT(J,I)=PUP(J,I) - 140 CONTINUE - VTIUPT(I)=VTIMUP(I) - SPIUPT(I)=SPINUP(I) - 150 CONTINUE - -C...Copy info back into HEPEUP in right order. - DO 180 I=1,NUP - IOLD=NEWPOS(I) - IDUP(I)=IDUPT(IOLD) - ISTUP(I)=ISTUPT(IOLD) - MOTHUP(1,I)=0 - MOTHUP(2,I)=0 - DO 160 IMOT=1,I-1 - IF(MOTUPT(1,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(1,I)=IMOT - IF(MOTUPT(2,IOLD).EQ.NEWPOS(IMOT)) MOTHUP(2,I)=IMOT - 160 CONTINUE - IF(MOTHUP(2,I).GT.0.AND.MOTHUP(2,I).LT.MOTHUP(1,I)) THEN - MOTHSW=MOTHUP(1,I) - MOTHUP(1,I)=MOTHUP(2,I) - MOTHUP(2,I)=MOTHSW - ENDIF - ICOLUP(1,I)=ICOUPT(1,IOLD) - ICOLUP(2,I)=ICOUPT(2,IOLD) - DO 170 J=1,5 - PUP(J,I)=PUPT(J,IOLD) - 170 CONTINUE - VTIMUP(I)=VTIUPT(IOLD) - SPINUP(I)=SPIUPT(IOLD) - 180 CONTINUE - ENDIF - -c...If incoming particles are massive recalculate to put them massless. - IF(PUP(5,1).NE.0D0.OR.PUP(5,2).NE.0D0) THEN - PPLUS=(PUP(4,1)+PUP(3,1))+(PUP(4,2)+PUP(3,2)) - PMINUS=(PUP(4,1)-PUP(3,1))+(PUP(4,2)-PUP(3,2)) - PUP(4,1)=0.5D0*PPLUS - PUP(3,1)=PUP(4,1) - PUP(5,1)=0D0 - PUP(4,2)=0.5D0*PMINUS - PUP(3,2)=-PUP(4,2) - PUP(5,2)=0D0 - ENDIF - - RETURN - END - -C*********************************************************************** - -C...PYWAUX -C...Calculates real and imaginary parts of the auxiliary functions W1 -C...and W2; see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van -C...der Bij, Nucl. Phys. B297 (1988) 221. - - SUBROUTINE PYWAUX(IAUX,EPS,WRE,WIM) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - - ASINH(X)=LOG(X+SQRT(X**2+1D0)) - ACOSH(X)=LOG(X+SQRT(X**2-1D0)) - - IF(EPS.LT.0D0) THEN - IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ASINH(SQRT(-1D0/EPS)) - IF(IAUX.EQ.2) WRE=4D0*(ASINH(SQRT(-1D0/EPS)))**2 - WIM=0D0 - ELSEIF(EPS.LT.1D0) THEN - IF(IAUX.EQ.1) WRE=2D0*SQRT(1D0-EPS)*ACOSH(SQRT(1D0/EPS)) - IF(IAUX.EQ.2) WRE=4D0*(ACOSH(SQRT(1D0/EPS)))**2-PARU(1)**2 - IF(IAUX.EQ.1) WIM=-PARU(1)*SQRT(1D0-EPS) - IF(IAUX.EQ.2) WIM=-4D0*PARU(1)*ACOSH(SQRT(1D0/EPS)) - ELSE - IF(IAUX.EQ.1) WRE=2D0*SQRT(EPS-1D0)*ASIN(SQRT(1D0/EPS)) - IF(IAUX.EQ.2) WRE=-4D0*(ASIN(SQRT(1D0/EPS)))**2 - WIM=0D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYWIDT -C...Calculates full and partial widths of resonances. - - SUBROUTINE PYWIDT(KFLR,SH,WDTP,WDTE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2), - &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT4/,/PYMSSM/,/PYSSMT/,/PYTCSM/ -C...Local arrays and saved variables. - COMPLEX*16 ZMIXC(4,4),AL,BL,AR,BR,FL,FR - DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), - &WID2SV(3,2),WDTPP(0:400),WDTEP(0:400,0:5) - SAVE MOFSV,WIDWSV,WID2SV - DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ - -C...Compressed code and sign; mass. - KFLA=IABS(KFLR) - KFLS=ISIGN(1,KFLR) - KC=PYCOMP(KFLA) - SHR=SQRT(SH) - PMR=PMAS(KC,1) - -C...Reset width information. - DO 110 I=0,MDCY(KC,3) - WDTP(I)=0D0 - DO 100 J=0,5 - WDTE(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - -C...Allow for fudge factor to rescale resonance width. - FUDGE=1D0 - IF(MSTP(110).NE.0.AND.(MWID(KC).EQ.1.OR.MWID(KC).EQ.2.OR. - &(MWID(KC).EQ.3.AND.MINT(63).EQ.1))) THEN - IF(MSTP(110).EQ.KFLA) THEN - FUDGE=PARP(110) - ELSEIF(MSTP(110).EQ.-1) THEN - IF(KFLA.NE.6.AND.KFLA.NE.23.AND.KFLA.NE.24) FUDGE=PARP(110) - ELSEIF(MSTP(110).EQ.-2) THEN - FUDGE=PARP(110) - ENDIF - ENDIF - -C...Not to be treated as a resonance: return. - IF((MWID(KC).LE.0.OR.MWID(KC).GE.4).AND.KFLA.NE.21.AND. - &KFLA.NE.22) THEN - WDTP(0)=1D0 - WDTE(0,0)=1D0 - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - -C...Treatment as a resonance based on tabulated branching ratios. - ELSEIF(MWID(KC).EQ.2.OR.(MWID(KC).EQ.3.AND.MINT(63).EQ.0)) THEN -C...Loop over possible decay channels; skip irrelevant ones. - DO 120 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 120 - -C...Read out decay products and nominal masses. - KFD1=KFDP(IDC,1) - KFC1=PYCOMP(KFD1) - IF(KCHG(KFC1,3).EQ.1) KFD1=KFLS*KFD1 - PM1=PMAS(KFC1,1) - KFD2=KFDP(IDC,2) - KFC2=PYCOMP(KFD2) - IF(KCHG(KFC2,3).EQ.1) KFD2=KFLS*KFD2 - PM2=PMAS(KFC2,1) - KFD3=KFDP(IDC,3) - PM3=0D0 - IF(KFD3.NE.0) THEN - KFC3=PYCOMP(KFD3) - IF(KCHG(KFC3,3).EQ.1) KFD3=KFLS*KFD3 - PM3=PMAS(KFC3,1) - ENDIF - -C...Naive partial width and alternative threshold factors. - WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR) - IF(MDME(IDC,2).GE.51.AND.MDME(IDC,2).LE.53.AND. - & PM1+PM2+PM3.GE.SHR) THEN - WDTP(I)=0D0 - ELSEIF(MDME(IDC,2).EQ.52.AND.KFD3.EQ.0) THEN - WDTP(I)=WDTP(I)*SQRT(MAX(0D0,(SH-PM1**2-PM2**2)**2- - & 4D0*PM1**2*PM2**2))/SH - ELSEIF(MDME(IDC,2).EQ.52) THEN - PMA=MAX(PM1,PM2,PM3) - PMC=MIN(PM1,PM2,PM3) - PMB=PM1+PM2+PM3-PMA-PMC - PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMC-PMC) - PMAN=PMA**2/SH - PMBN=PMB**2/SH - PMCN=PMC**2/SH - PMBCN=PMBC**2/SH - WDTP(I)=WDTP(I)*SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((SHR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ - & ((1D0-PMBCN)*PMBCN*SH) - ELSEIF(MDME(IDC,2).EQ.53.AND.KFD3.EQ.0) THEN - WDTP(I)=WDTP(I)*SQRT( - & MAX(0D0,(SH-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)/ - & MAX(1D-4,(PMR**2-PM1**2-PM2**2)**2-4D0*PM1**2*PM2**2)) - ELSEIF(MDME(IDC,2).EQ.53) THEN - PMA=MAX(PM1,PM2,PM3) - PMC=MIN(PM1,PM2,PM3) - PMB=PM1+PM2+PM3-PMA-PMC - PMBC=PMB+PMC+0.5D0*(SHR-PMA-PMB-PMC) - PMAN=PMA**2/SH - PMBN=PMB**2/SH - PMCN=PMC**2/SH - PMBCN=PMBC**2/SH - FACACT=SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((SHR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/SHR)/ - & ((1D0-PMBCN)*PMBCN*SH) - PMBC=PMB+PMC+0.5D0*(PMR-PMA-PMB-PMC) - PMAN=PMA**2/PMR**2 - PMBN=PMB**2/PMR**2 - PMCN=PMC**2/PMR**2 - PMBCN=PMBC**2/PMR**2 - FACNOM=SQRT(MAX(0D0, - & ((1D0-PMAN-PMBCN)**2-4D0*PMAN*PMBCN)* - & ((PMBCN-PMBN-PMCN)**2-4D0*PMBN*PMCN)))* - & ((PMR-PMA)**2-(PMB+PMC)**2)* - & (1D0+0.25D0*(PMA+PMB+PMC)/PMR)/ - & ((1D0-PMBCN)*PMBCN*PMR**2) - WDTP(I)=WDTP(I)*FACACT/MAX(1D-6,FACNOM) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - -C...Calculate secondary width (at most two identical/opposite). - WID2=1D0 - IF(MDME(IDC,1).GT.0) THEN - IF(KFD2.EQ.KFD1) THEN - IF(KCHG(KFC1,3).EQ.0) THEN - WID2=WIDS(KFC1,1) - ELSEIF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,4) - ELSE - WID2=WIDS(KFC1,5) - ENDIF - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ELSEIF(KFD2.EQ.-KFD1) THEN - WID2=WIDS(KFC1,1) - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ELSEIF(KFD3.EQ.KFD1) THEN - IF(KCHG(KFC1,3).EQ.0) THEN - WID2=WIDS(KFC1,1) - ELSEIF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,4) - ELSE - WID2=WIDS(KFC1,5) - ENDIF - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSEIF(KFD2.LT.0) THEN - WID2=WID2*WIDS(KFC2,3) - ENDIF - ELSEIF(KFD3.EQ.-KFD1) THEN - WID2=WIDS(KFC1,1) - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSEIF(KFD2.LT.0) THEN - WID2=WID2*WIDS(KFC2,3) - ENDIF - ELSEIF(KFD3.EQ.KFD2) THEN - IF(KCHG(KFC2,3).EQ.0) THEN - WID2=WIDS(KFC2,1) - ELSEIF(KFD2.GT.0) THEN - WID2=WIDS(KFC2,4) - ELSE - WID2=WIDS(KFC2,5) - ENDIF - IF(KFD1.GT.0) THEN - WID2=WID2*WIDS(KFC1,2) - ELSEIF(KFD1.LT.0) THEN - WID2=WID2*WIDS(KFC1,3) - ENDIF - ELSEIF(KFD3.EQ.-KFD2) THEN - WID2=WIDS(KFC2,1) - IF(KFD1.GT.0) THEN - WID2=WID2*WIDS(KFC1,2) - ELSEIF(KFD1.LT.0) THEN - WID2=WID2*WIDS(KFC1,3) - ENDIF - ELSE - IF(KFD1.GT.0) THEN - WID2=WIDS(KFC1,2) - ELSE - WID2=WIDS(KFC1,3) - ENDIF - IF(KFD2.GT.0) THEN - WID2=WID2*WIDS(KFC2,2) - ELSE - WID2=WID2*WIDS(KFC2,3) - ENDIF - IF(KFD3.GT.0) THEN - WID2=WID2*WIDS(KFC3,2) - ELSEIF(KFD3.LT.0) THEN - WID2=WID2*WIDS(KFC3,3) - ENDIF - ENDIF - -C...Store effective widths according to case. - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 120 CONTINUE -C...Return. - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - ENDIF - -C...Here begins detailed dynamical calculation of resonance widths. -C...Shared treatment of Higgs states. - KFHIGG=25 - IHIGG=1 - IF(KFLA.EQ.35.OR.KFLA.EQ.36) THEN - KFHIGG=KFLA - IHIGG=KFLA-33 - ENDIF - -C...Common electroweak and strong constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - AEM=PYALEM(SH) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - AS=PYALPS(SH) - RADC=1D0+AS/PARU(1) - - IF(KFLA.EQ.6) THEN -C...t quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - RADCT=1D0-2.5D0*AS/PARU(1) - DO 140 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 140 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...t -> W + q; including approximate QCD correction factor. - WDTP(I)=FAC*VCKM(3,I-3)*RADCT* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - IF(I.EQ.7) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(24,3) - IF(I.EQ.7) WID2=WID2*WIDS(7,3) - ENDIF - ELSEIF(I.EQ.9) THEN -C...t -> H + b. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - WID2=WIDS(37,2) - IF(KFLR.LT.0) WID2=WIDS(37,3) -CMRENNA++ - ELSEIF(I.GE.10.AND.I.LE.13.AND.IMSS(1).NE.0) THEN -C...t -> ~t + ~chi_i0, i = 1, 2, 3 or 4. - BETA=ATAN(RMSS(5)) - SINB=SIN(BETA) - TANW=SQRT(PARU(102)/(1D0-PARU(102))) - ET=KCHG(6,1)/3D0 - T3L=SIGN(0.5D0,ET) - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - PMNCHI=PMAS(KFC1,1) - PMSTOP=PMAS(KFC2,1) - IF(SHR.GT.PMNCHI+PMSTOP) THEN - IZ=I-9 - DO 130 IK=1,4 - ZMIXC(IZ,IK)=DCMPLX(ZMIX(IZ,IK),ZMIXI(IZ,IK)) - 130 CONTINUE - AL=SHR*DCONJG(ZMIXC(IZ,4))/(2.0D0*PMAS(24,1)*SINB) - AR=-ET*ZMIXC(IZ,1)*TANW - BL=T3L*(ZMIXC(IZ,2)-ZMIXC(IZ,1)*TANW)-AR - BR=AL - FL=SFMIX(6,1)*AL+SFMIX(6,2)*AR - FR=SFMIX(6,1)*BL+SFMIX(6,2)*BR - PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* - & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) - WDTP(I)=(0.5D0*PYALEM(SH)/PARU(102))*PCM* - & ((ABS(FL)**2+ABS(FR)**2)*(SH+PMNCHI**2-PMSTOP**2)+ - & SMZ(IZ)*4D0*SHR*DBLE(FL*DCONJG(FR)))/SH - IF(KFLR.GT.0) THEN - WID2=WIDS(KFC1,2)*WIDS(KFC2,2) - ELSE - WID2=WIDS(KFC1,2)*WIDS(KFC2,3) - ENDIF - ENDIF - ELSEIF(I.EQ.14.AND.IMSS(1).NE.0) THEN -C...t -> ~g + ~t - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - PMNCHI=PMAS(KFC1,1) - PMSTOP=PMAS(KFC2,1) - IF(SHR.GT.PMNCHI+PMSTOP) THEN - RL=SFMIX(6,1) - RR=-SFMIX(6,2) - PCM=SQRT((SH-(PMNCHI+PMSTOP)**2)* - & (SH-(PMNCHI-PMSTOP)**2))/(2D0*SHR) - WDTP(I)=4D0/3D0*0.5D0*PYALPS(SH)*PCM*((RL**2+RR**2)* - & (SH+PMNCHI**2-PMSTOP**2)+PMNCHI*4D0*SHR*RL*RR)/SH - IF(KFLR.GT.0) THEN - WID2=WIDS(KFC1,2)*WIDS(KFC2,2) - ELSE - WID2=WIDS(KFC1,2)*WIDS(KFC2,3) - ENDIF - ENDIF - ELSEIF(I.EQ.15.AND.IMSS(1).NE.0) THEN -C...t -> ~gravitino + ~t - XMP2=RMSS(29)**2 - KFC1=PYCOMP(KFDP(IDC,1)) - XMGR2=PMAS(KFC1,1)**2 - WDTP(I)=SH**2*SHR/(96D0*PARU(1)*XMP2*XMGR2)*(1D0-RM2)**4 - KFC2=PYCOMP(KFDP(IDC,2)) - WID2=WIDS(KFC2,2) - IF(KFLR.LT.0) WID2=WIDS(KFC2,3) -CMRENNA-- - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 140 CONTINUE - - ELSEIF(KFLA.EQ.7) THEN -C...b' quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 150 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 150 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 150 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...b' -> W + q. - WDTP(I)=FAC*VCKM(I-3,4)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,3) - IF(I.EQ.6) WID2=WID2*WIDS(6,2) - IF(I.EQ.7) WID2=WID2*WIDS(8,2) - ELSE - WID2=WIDS(24,2) - IF(I.EQ.6) WID2=WID2*WIDS(6,3) - IF(I.EQ.7) WID2=WID2*WIDS(8,3) - ENDIF - WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ELSEIF(I.EQ.9.OR.I.EQ.10) THEN -C...b' -> H + q. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,3) - IF(I.EQ.10) WID2=WID2*WIDS(6,2) - ELSE - WID2=WIDS(37,2) - IF(I.EQ.10) WID2=WID2*WIDS(6,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 150 CONTINUE - - ELSEIF(KFLA.EQ.8) THEN -C...t' quark. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 160 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 160 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 160 - WID2=1D0 - IF(I.GE.4.AND.I.LE.7) THEN -C...t' -> W + q. - WDTP(I)=FAC*VCKM(4,I-3)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - IF(I.EQ.7) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(24,3) - IF(I.EQ.7) WID2=WID2*WIDS(7,3) - ENDIF - ELSEIF(I.EQ.9.OR.I.EQ.10) THEN -C...t' -> H + q. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,2) - IF(I.EQ.10) WID2=WID2*WIDS(7,2) - ELSE - WID2=WIDS(37,3) - IF(I.EQ.10) WID2=WID2*WIDS(7,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 160 CONTINUE - - ELSEIF(KFLA.EQ.17) THEN -C...tau' lepton. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 170 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 170 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 170 - WID2=1D0 - IF(I.EQ.3) THEN -C...tau' -> W + nu'_tau. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,3) - WID2=WID2*WIDS(18,2) - ELSE - WID2=WIDS(24,2) - WID2=WID2*WIDS(18,3) - ENDIF - ELSEIF(I.EQ.5) THEN -C...tau' -> H + nu'_tau. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(PARU(141)**2+RM2/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,3) - WID2=WID2*WIDS(18,2) - ELSE - WID2=WIDS(37,2) - WID2=WID2*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 170 CONTINUE - - ELSEIF(KFLA.EQ.18) THEN -C...nu'_tau neutrino. - FAC=(AEM/(16D0*XW))*(SH/PMAS(24,1)**2)*SHR - DO 180 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 180 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 180 - WID2=1D0 - IF(I.EQ.2) THEN -C...nu'_tau -> W + tau'. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM2)**2+(1D0+RM2)*RM1-2D0*RM1**2) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - WID2=WID2*WIDS(17,2) - ELSE - WID2=WIDS(24,3) - WID2=WID2*WIDS(17,3) - ENDIF - ELSEIF(I.EQ.3) THEN -C...nu'_tau -> H + tau'. - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0+RM2-RM1)*(RM2*PARU(141)**2+1D0/PARU(141)**2)+4D0*RM2) - IF(KFLR.GT.0) THEN - WID2=WIDS(37,2) - WID2=WID2*WIDS(17,2) - ELSE - WID2=WIDS(37,3) - WID2=WID2*WIDS(17,3) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 180 CONTINUE - - ELSEIF(KFLA.EQ.21) THEN -C...QCD: -C***Note that widths are not given in dimensional quantities here. - DO 190 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 190 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 190 - WID2=1D0 - IF(I.LE.8) THEN -C...QCD -> q + qbar - WDTP(I)=(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 190 CONTINUE - - ELSEIF(KFLA.EQ.22) THEN -C...QED photon. -C***Note that widths are not given in dimensional quantities here. - DO 200 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 200 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 200 - WID2=1D0 - IF(I.LE.8) THEN -C...QED -> q + qbar. - EF=KCHG(I,1)/3D0 - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - WDTP(I)=FCOF*EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.12) THEN -C...QED -> l+ + l-. - EF=KCHG(9+2*(I-8),1)/3D0 - WDTP(I)=EF**2*(1D0+2D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(I.EQ.12) WID2=WIDS(17,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 200 CONTINUE - - ELSEIF(KFLA.EQ.23) THEN -C...Z0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - 210 CONTINUE - IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN - VINT(111)=0D0 - VINT(112)=0D0 - VINT(114)=0D0 - ENDIF - IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - KFI=IABS(MINT(15)) - IF(KFI.GT.20) KFI=IABS(MINT(16)) - EI=KCHG(KFI,1)/3D0 - AI=SIGN(1D0,EI) - VI=AI-4D0*EI*XWV - SQMZ=PMAS(23,1)**2 - HZ=SHR*WDTP(0) - IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)=1D0 - IF(MSTP(43).EQ.3) VINT(112)= - & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) - IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= - & XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) - ENDIF - DO 220 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 220 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 220 - WID2=1D0 - IF(I.LE.8) THEN -C...Z0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & BE34 - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* - & EF*VF+(VI**2+AI**2)*VINT(114)*VF**2)*(1D0+2D0*RM1)+ - & (VI**2+AI**2)*VINT(114)*AF**2*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 - FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - ENDIF - IF(ICASE.EQ.1) WDTP(I)=FUDGE*WDTP(I) - IF(ICASE.EQ.1) WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. - & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - IF(MSTP(43).EQ.1.OR.MSTP(43).EQ.3) VINT(111)= - & VINT(111)+FGGF*WID2 - IF(MSTP(43).EQ.3) VINT(112)=VINT(112)+FGZF*WID2 - IF(MSTP(43).EQ.2.OR.MSTP(43).EQ.3) VINT(114)= - & VINT(114)+FZZF*WID2 - ENDIF - ENDIF - 220 CONTINUE - IF(MINT(61).GE.1) ICASE=3-ICASE - IF(ICASE.EQ.2) GOTO 210 - - ELSEIF(KFLA.EQ.24) THEN -C...W+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 230 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 230 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 230 - WID2=1D0 - IF(I.LE.16) THEN -C...W+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W+/- -> l+/- + nu - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 230 CONTINUE - - ELSEIF(KFLA.EQ.25.OR.KFLA.EQ.35.OR.KFLA.EQ.36) THEN -C...h0 (or H0, or A0): - SHFS=SH - FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR - DO 270 I=1,MDCY(KFHIGG,3) - IDC=I+MDCY(KFHIGG,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 270 - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - RM1=PMAS(KFC1,1)**2/SH - RM2=PMAS(KFC2,1)**2/SH - IF(I.NE.16.AND.I.NE.17.AND.SQRT(RM1)+SQRT(RM2).GT.1D0) - & GOTO 270 - WID2=1D0 - - IF(I.LE.8) THEN -C...h0 -> q + qbar - WDTP(I)=FAC*3D0*(PYMRUN(KFDP(IDC,1),SH)**2/SHFS)* - & SQRT(MAX(0D0,1D0-4D0*RM1))*RADC -C...A0 behaves like beta, ho and H0 like beta**3. - IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IF(MOD(I,2).EQ.1) WDTP(I)=WDTP(I)*PARU(151+10*IHIGG)**2 - IF(MOD(I,2).EQ.0) WDTP(I)=WDTP(I)*PARU(152+10*IHIGG)**2 - IF(IMSS(1).NE.0.AND.KFC1.EQ.5) THEN - WDTP(I)=WDTP(I)/(1D0+RMSS(41))**2 - IF(IHIGG.NE.3) THEN - WDTP(I)=WDTP(I)*(1D0+RMSS(41)*PARU(152+10*IHIGG)/ - & PARU(151+10*IHIGG))**2 - ENDIF - ENDIF - ENDIF - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.12) THEN -C...h0 -> l+ + l- - WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))*(SH/SHFS) -C...A0 behaves like beta, ho and H0 like beta**3. - IF(IHIGG.NE.3) WDTP(I)=WDTP(I)*(1D0-4D0*RM1) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* - & PARU(153+10*IHIGG)**2 - IF(I.EQ.12) WID2=WIDS(17,1) - - ELSEIF(I.EQ.13) THEN -C...h0 -> g + g; quark loop contribution only - ETARE=0D0 - ETAIM=0D0 - DO 240 J=1,2*MSTP(1) - EPS=(2D0*PMAS(J,1))**2/SH -C...Loop integral; function of eps=4m^2/shat; different for A0. - IF(EPS.LE.1D0) THEN - IF(EPS.GT.1D-4) THEN - ROOT=SQRT(1D0-EPS) - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - ENDIF - IF(IHIGG.LE.2) THEN - ETAREJ=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) - ETAIMJ=-0.5D0*EPS*(1D0-EPS)*PHIIM - ELSE - ETAREJ=-0.5D0*EPS*PHIRE - ETAIMJ=-0.5D0*EPS*PHIIM - ENDIF -C...Couplings (=1 for standard model Higgs). - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - IF(MOD(J,2).EQ.1) THEN - ETAREJ=ETAREJ*PARU(151+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(151+10*IHIGG) - ELSE - ETAREJ=ETAREJ*PARU(152+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(152+10*IHIGG) - ENDIF - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 240 CONTINUE - ETA2=ETARE**2+ETAIM**2 - WDTP(I)=FAC*(AS/PARU(1))**2*ETA2 - - ELSEIF(I.EQ.14) THEN -C...h0 -> gamma + gamma; quark, lepton, W+- and H+- loop contributions - ETARE=0D0 - ETAIM=0D0 - JMAX=3*MSTP(1)+1 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 - DO 250 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - EJ=KCHG(J,1)/3D0 - EPS=(2D0*PMAS(J,1))**2/SH - ELSEIF(J.LE.3*MSTP(1)) THEN - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - EPS=(2D0*PMAS(10+JL,1))**2/SH - ELSEIF(J.EQ.3*MSTP(1)+1) THEN - EPS=(2D0*PMAS(24,1))**2/SH - ELSE - EPS=(2D0*PMAS(37,1))**2/SH - ENDIF -C...Loop integral; function of eps=4m^2/shat. - IF(EPS.LE.1D0) THEN - IF(EPS.GT.1D-4) THEN - ROOT=SQRT(1D0-EPS) - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - ENDIF - IF(J.LE.3*MSTP(1)) THEN -C...Fermion loops: loop integral different for A0; charges. - IF(IHIGG.LE.2) THEN - PHIPRE=-0.5D0*EPS*(1D0+(1D0-EPS)*PHIRE) - PHIPIM=-0.5D0*EPS*(1D0-EPS)*PHIIM - ELSE - PHIPRE=-0.5D0*EPS*PHIRE - PHIPIM=-0.5D0*EPS*PHIIM - ENDIF - IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN - EJC=3D0*EJ**2 - EJH=PARU(151+10*IHIGG) - ELSEIF(J.LE.2*MSTP(1)) THEN - EJC=3D0*EJ**2 - EJH=PARU(152+10*IHIGG) - ELSE - EJC=EJ**2 - EJH=PARU(153+10*IHIGG) - ENDIF - IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 - ETAREJ=EJC*EJH*PHIPRE - ETAIMJ=EJC*EJH*PHIPIM - ELSEIF(J.EQ.3*MSTP(1)+1) THEN -C...W loops: loop integral and charges. - ETAREJ=0.5D0+0.75D0*EPS*(1D0+(2D0-EPS)*PHIRE) - ETAIMJ=0.75D0*EPS*(2D0-EPS)*PHIIM - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - ETAREJ=ETAREJ*PARU(155+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) - ENDIF - ELSE -C...Charged H loops: loop integral and charges. - FACHHH=(PMAS(24,1)/PMAS(37,1))**2* - & PARU(158+10*IHIGG+2*(IHIGG/3)) - ETAREJ=EPS*(1D0-EPS*PHIRE)*FACHHH - ETAIMJ=-EPS**2*PHIIM*FACHHH - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 250 CONTINUE - ETA2=ETARE**2+ETAIM**2 - WDTP(I)=FAC*(AEM/PARU(1))**2*0.5D0*ETA2 - - ELSEIF(I.EQ.15) THEN -C...h0 -> gamma + Z0; quark, lepton, W and H+- loop contributions - ETARE=0D0 - ETAIM=0D0 - JMAX=3*MSTP(1)+1 - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) JMAX=JMAX+1 - DO 260 J=1,JMAX - IF(J.LE.2*MSTP(1)) THEN - EJ=KCHG(J,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - EPS=(2D0*PMAS(J,1))**2/SH - EPSP=(2D0*PMAS(J,1)/PMAS(23,1))**2 - ELSEIF(J.LE.3*MSTP(1)) THEN - JL=2*(J-2*MSTP(1))-1 - EJ=KCHG(10+JL,1)/3D0 - AJ=SIGN(1D0,EJ+0.1D0) - VJ=AJ-4D0*EJ*XWV - EPS=(2D0*PMAS(10+JL,1))**2/SH - EPSP=(2D0*PMAS(10+JL,1)/PMAS(23,1))**2 - ELSE - EPS=(2D0*PMAS(24,1))**2/SH - EPSP=(2D0*PMAS(24,1)/PMAS(23,1))**2 - ENDIF -C...Loop integrals; functions of eps=4m^2/shat and eps'=4m^2/m_Z^2. - IF(EPS.LE.1D0) THEN - ROOT=SQRT(1D0-EPS) - IF(EPS.GT.1D-4) THEN - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPS-2D0) - ENDIF - PHIRE=-0.25D0*(RLN**2-PARU(1)**2) - PHIIM=0.5D0*PARU(1)*RLN - PSIRE=0.5D0*ROOT*RLN - PSIIM=-0.5D0*ROOT*PARU(1) - ELSE - PHIRE=(ASIN(1D0/SQRT(EPS)))**2 - PHIIM=0D0 - PSIRE=SQRT(EPS-1D0)*ASIN(1D0/SQRT(EPS)) - PSIIM=0D0 - ENDIF - IF(EPSP.LE.1D0) THEN - ROOT=SQRT(1D0-EPSP) - IF(EPSP.GT.1D-4) THEN - RLN=LOG((1D0+ROOT)/(1D0-ROOT)) - ELSE - RLN=LOG(4D0/EPSP-2D0) - ENDIF - PHIREP=-0.25D0*(RLN**2-PARU(1)**2) - PHIIMP=0.5D0*PARU(1)*RLN - PSIREP=0.5D0*ROOT*RLN - PSIIMP=-0.5D0*ROOT*PARU(1) - ELSE - PHIREP=(ASIN(1D0/SQRT(EPSP)))**2 - PHIIMP=0D0 - PSIREP=SQRT(EPSP-1D0)*ASIN(1D0/SQRT(EPSP)) - PSIIMP=0D0 - ENDIF - FXYRE=EPS*EPSP/(8D0*(EPS-EPSP))*(1D0+EPS*EPSP/(EPS-EPSP)* - & (PHIRE-PHIREP)+2D0*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) - FXYIM=EPS**2*EPSP/(8D0*(EPS-EPSP)**2)* - & (EPSP*(PHIIM-PHIIMP)+2D0*(PSIIM-PSIIMP)) - F1RE=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIRE-PHIREP) - F1IM=-EPS*EPSP/(2D0*(EPS-EPSP))*(PHIIM-PHIIMP) - IF(J.LE.3*MSTP(1)) THEN -C...Fermion loops: loop integral different for A0; charges. - IF(IHIGG.EQ.3) FXYRE=0D0 - IF(IHIGG.EQ.3) FXYIM=0D0 - IF(J.LE.2*MSTP(1).AND.MOD(J,2).EQ.1) THEN - EJC=-3D0*EJ*VJ - EJH=PARU(151+10*IHIGG) - ELSEIF(J.LE.2*MSTP(1)) THEN - EJC=-3D0*EJ*VJ - EJH=PARU(152+10*IHIGG) - ELSE - EJC=-EJ*VJ - EJH=PARU(153+10*IHIGG) - ENDIF - IF(MSTP(4).EQ.0.AND.IHIGG.EQ.1) EJH=1D0 - ETAREJ=EJC*EJH*(FXYRE-0.25D0*F1RE) - ETAIMJ=EJC*EJH*(FXYIM-0.25D0*F1IM) - ELSEIF(J.EQ.3*MSTP(1)+1) THEN -C...W loops: loop integral and charges. - HEPS=(1D0+2D0/EPS)*XW/XW1-(5D0+2D0/EPS) - ETAREJ=-XW1*((3D0-XW/XW1)*F1RE+HEPS*FXYRE) - ETAIMJ=-XW1*((3D0-XW/XW1)*F1IM+HEPS*FXYIM) - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) THEN - ETAREJ=ETAREJ*PARU(155+10*IHIGG) - ETAIMJ=ETAIMJ*PARU(155+10*IHIGG) - ENDIF - ELSE -C...Charged H loops: loop integral and charges. - FACHHH=(PMAS(24,1)/PMAS(37,1))**2*(1D0-2D0*XW)* - & PARU(158+10*IHIGG+2*(IHIGG/3)) - ETAREJ=FACHHH*FXYRE - ETAIMJ=FACHHH*FXYIM - ENDIF - ETARE=ETARE+ETAREJ - ETAIM=ETAIM+ETAIMJ - 260 CONTINUE - ETA2=(ETARE**2+ETAIM**2)/(XW*XW1) - WDTP(I)=FAC*(AEM/PARU(1))**2*(1D0-PMAS(23,1)**2/SH)**3*ETA2 - WID2=WIDS(23,2) - - ELSEIF(I.LE.17) THEN -C...h0 -> Z0 + Z0, W+ + W- - PM1=PMAS(IABS(KFDP(IDC,1)),1) - PG1=PMAS(IABS(KFDP(IDC,1)),2) - IF(MINT(62).GE.1) THEN - IF(MSTP(42).EQ.0.OR.(4D0*(PM1+10D0*PG1)**2.LT.SH.AND. - & CKIN(46).LT.CKIN(45).AND.CKIN(48).LT.CKIN(47).AND. - & MAX(CKIN(45),CKIN(47)).LT.PM1-10D0*PG1)) THEN - MOFSV(IHIGG,I-15)=0 - WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, - & 1D0-4D0*RM1)) - WID2=1D0 - ELSE - MOFSV(IHIGG,I-15)=1 - RMAS=SQRT(MAX(0D0,SH)) - CALL PYOFSH(1,KFLA,KFDP(IDC,1),KFDP(IDC,2),RMAS,WIDW, - & WID2) - WIDWSV(IHIGG,I-15)=WIDW - WID2SV(IHIGG,I-15)=WID2 - ENDIF - ELSE - IF(MOFSV(IHIGG,I-15).EQ.0) THEN - WIDW=(1D0-4D0*RM1+12D0*RM1**2)*SQRT(MAX(0D0, - & 1D0-4D0*RM1)) - WID2=1D0 - ELSE - WIDW=WIDWSV(IHIGG,I-15) - WID2=WID2SV(IHIGG,I-15) - ENDIF - ENDIF - WDTP(I)=FAC*WIDW/(2D0*(18-I)) - IF(MSTP(49).NE.0) WDTP(I)=WDTP(I)*PMAS(KFHIGG,1)**2/SHFS - IF(MSTP(4).GE.1.OR.IHIGG.GE.2) WDTP(I)=WDTP(I)* - & PARU(138+I+10*IHIGG)**2 - WID2=WID2*WIDS(7+I,1) - - ELSEIF(I.EQ.18.AND.IHIGG.GE.2) THEN -C...H0 -> Z0 + h0, A0-> Z0 + h0 - WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(IHIGG.EQ.2) THEN - WDTP(I)=WDTP(I)*PARU(179)**2 - ELSEIF(IHIGG.EQ.3) THEN - WDTP(I)=WDTP(I)*PARU(186)**2 - ENDIF - WID2=WIDS(23,2)*WIDS(25,2) - - ELSEIF(I.EQ.19.AND.IHIGG.GE.2) THEN -C...H0 -> h0 + h0, A0-> h0 + h0 - WDTP(I)=FAC*0.25D0* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(IHIGG.EQ.2) THEN - WDTP(I)=WDTP(I)*PARU(176)**2 - ELSEIF(IHIGG.EQ.3) THEN - WDTP(I)=WDTP(I)*PARU(169)**2 - ENDIF - WID2=WIDS(25,1) - ELSEIF((I.EQ.20.OR.I.EQ.21).AND.IHIGG.GE.2) THEN -C...H0 -> W+/- + H-/+, A0 -> W+/- + H-/+ - WDTP(I)=FAC*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - & *PARU(195+IHIGG)**2 - IF(I.EQ.20) THEN - WID2=WIDS(24,2)*WIDS(37,3) - ELSEIF(I.EQ.21) THEN - WID2=WIDS(24,3)*WIDS(37,2) - ENDIF - - ELSEIF(I.EQ.22.AND.IHIGG.EQ.2) THEN -C...H0 -> Z0 + A0. - WDTP(I)=FAC*0.5D0*PARU(187)**2*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*0.0D0 - WID2=WIDS(36,2)*WIDS(23,2) - - ELSEIF(I.EQ.23.AND.IHIGG.EQ.2) THEN -C...H0 -> h0 + A0. - WDTP(I)=FAC*0.5D0*PARU(180)**2* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - WID2=WIDS(25,2)*WIDS(36,2) - - ELSEIF(I.EQ.24.AND.IHIGG.EQ.2) THEN -C...H0 -> A0 + A0 - WDTP(I)=FAC*0.25D0*PARU(177)**2* - & PMAS(23,1)**4/SH**2*SQRT(MAX(0D0,1D0-4D0*RM1)) - WID2=WIDS(36,1) - -CMRENNA++ - ELSE -C...Add in SUSY decays (two-body) by rescaling by phase space factor. - RM10=RM1*SH/PMR**2 - RM20=RM2*SH/PMR**2 - WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) - WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) - IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN - WFAC=0D0 - ELSE - WFAC=WFAC/WFAC0 - ENDIF - WDTP(I)=PMAS(KFLA,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) -CMRENNA-- - IF(KFC2.EQ.KFC1) THEN - WID2=WIDS(KFC1,1) - ELSE - KSGN1=2 - IF(KFDP(IDC,1).LT.0) KSGN1=3 - KSGN2=2 - IF(KFDP(IDC,2).LT.0) KSGN2=3 - WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 270 CONTINUE - - ELSEIF(KFLA.EQ.32) THEN -C...Z'0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - VINT(117)=0D0 - 280 CONTINUE - IF(MINT(61).GE.1.AND.ICASE.EQ.2) THEN - VINT(111)=0D0 - VINT(112)=0D0 - VINT(113)=0D0 - VINT(114)=0D0 - VINT(115)=0D0 - VINT(116)=0D0 - ENDIF - IF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - KFAI=IABS(MINT(15)) - EI=KCHG(KFAI,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - KFAIC=1 - IF(KFAI.LE.10.AND.MOD(KFAI,2).EQ.0) KFAIC=2 - IF(KFAI.GT.10.AND.MOD(KFAI,2).NE.0) KFAIC=3 - IF(KFAI.GT.10.AND.MOD(KFAI,2).EQ.0) KFAIC=4 - IF(KFAI.LE.2.OR.KFAI.EQ.11.OR.KFAI.EQ.12) THEN - VPI=PARU(119+2*KFAIC) - API=PARU(120+2*KFAIC) - ELSEIF(KFAI.LE.4.OR.KFAI.EQ.13.OR.KFAI.EQ.14) THEN - VPI=PARJ(178+2*KFAIC) - API=PARJ(179+2*KFAIC) - ELSE - VPI=PARJ(186+2*KFAIC) - API=PARJ(187+2*KFAIC) - ENDIF - SQMZ=PMAS(23,1)**2 - HZ=SHR*VINT(117) - SQMZP=PMAS(32,1)**2 - HZP=SHR*WDTP(0) - IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. - & MSTP(44).EQ.7) VINT(111)=1D0 - IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)= - & 2D0*XWC*SH*(SH-SQMZ)/((SH-SQMZ)**2+HZ**2) - IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)= - & 2D0*XWC*SH*(SH-SQMZP)/((SH-SQMZP)**2+HZP**2) - IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(114)=XWC**2*SH**2/((SH-SQMZ)**2+HZ**2) - IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)= - & 2D0*XWC**2*SH**2*((SH-SQMZ)*(SH-SQMZP)+HZ*HZP)/ - & (((SH-SQMZ)**2+HZ**2)*((SH-SQMZP)**2+HZP**2)) - IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(116)=XWC**2*SH**2/((SH-SQMZP)**2+HZP**2) - ENDIF - DO 290 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 290 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0.OR.MDME(IDC,1).LT.0) GOTO 290 - WID2=1D0 - IF(I.LE.16) THEN - IF(I.LE.8) THEN -C...Z'0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - IF(I.LE.2) THEN - VPF=PARU(123-2*MOD(I,2)) - APF=PARU(124-2*MOD(I,2)) - ELSEIF(I.LE.4) THEN - VPF=PARJ(182-2*MOD(I,2)) - APF=PARJ(183-2*MOD(I,2)) - ELSE - VPF=PARJ(190-2*MOD(I,2)) - APF=PARJ(191-2*MOD(I,2)) - ENDIF - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* - & PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z'0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - IF(I.LE.10) THEN - VPF=PARU(127-2*MOD(I,2)) - APF=PARU(128-2*MOD(I,2)) - ELSEIF(I.LE.12) THEN - VPF=PARJ(186-2*MOD(I,2)) - APF=PARJ(187-2*MOD(I,2)) - ELSE - VPF=PARJ(194-2*MOD(I,2)) - APF=PARJ(195-2*MOD(I,2)) - ENDIF - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTPZ=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - WDTP(I)=FAC*FCOF*(VPF**2*(1D0+2D0*RM1)+ - & APF**2*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*FCOF*((EI**2*VINT(111)*EF**2+EI*VI*VINT(112)* - & EF*VF+EI*VPI*VINT(113)*EF*VPF+(VI**2+AI**2)*VINT(114)* - & VF**2+(VI*VPI+AI*API)*VINT(115)*VF*VPF+(VPI**2+API**2)* - & VINT(116)*VPF**2)*(1D0+2D0*RM1)+((VI**2+AI**2)*VINT(114)* - & AF**2+(VI*VPI+AI*API)*VINT(115)*AF*APF+(VPI**2+API**2)* - & VINT(116)*APF**2)*(1D0-4D0*RM1))*BE34 - ELSEIF(MINT(61).EQ.2) THEN - FGGF=FCOF*EF**2*(1D0+2D0*RM1)*BE34 - FGZF=FCOF*EF*VF*(1D0+2D0*RM1)*BE34 - FGZPF=FCOF*EF*VPF*(1D0+2D0*RM1)*BE34 - FZZF=FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*BE34 - FZZPF=FCOF*(VF*VPF*(1D0+2D0*RM1)+AF*APF*(1D0-4D0*RM1))* - & BE34 - FZPZPF=FCOF*(VPF**2*(1D0+2D0*RM1)+APF**2*(1D0-4D0*RM1))* - & BE34 - ENDIF - ELSEIF(I.EQ.17) THEN -C...Z'0 -> W+ + W- - WDTPZP=PARU(129)**2*XW1**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - IF(ICASE.EQ.1) THEN - WDTPZ=0D0 - WDTP(I)=FAC*WDTPZP - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=0D0 - FZZPF=0D0 - FZPZPF=WDTPZP - ENDIF - WID2=WIDS(24,1) - ELSEIF(I.EQ.18) THEN -C...Z'0 -> H+ + H- - CZC=2D0*(1D0-2D0*XW) - BE34C=(1D0-4D0*RM1)*SQRT(MAX(0D0,1D0-4D0*RM1)) - IF(ICASE.EQ.1) THEN - WDTPZ=0.25D0*PARU(142)**2*CZC**2*BE34C - WDTP(I)=FAC*0.25D0*PARU(143)**2*CZC**2*BE34C - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*0.25D0*(EI**2*VINT(111)+PARU(142)*EI*VI* - & VINT(112)*CZC+PARU(143)*EI*VPI*VINT(113)*CZC+PARU(142)**2* - & (VI**2+AI**2)*VINT(114)*CZC**2+PARU(142)*PARU(143)* - & (VI*VPI+AI*API)*VINT(115)*CZC**2+PARU(143)**2* - & (VPI**2+API**2)*VINT(116)*CZC**2)*BE34C - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0.25D0*BE34C - FGZF=0.25D0*PARU(142)*CZC*BE34C - FGZPF=0.25D0*PARU(143)*CZC*BE34C - FZZF=0.25D0*PARU(142)**2*CZC**2*BE34C - FZZPF=0.25D0*PARU(142)*PARU(143)*CZC**2*BE34C - FZPZPF=0.25D0*PARU(143)**2*CZC**2*BE34C - ENDIF - WID2=WIDS(37,1) - ELSEIF(I.EQ.19) THEN -C...Z'0 -> Z0 + gamma. - ELSEIF(I.EQ.20) THEN -C...Z'0 -> Z0 + h0 - FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTPZP=PARU(145)**2*4D0*ABS(1D0-2D0*XW)* - & (3D0*RM1+0.25D0*FLAM**2)*FLAM - IF(ICASE.EQ.1) THEN - WDTPZ=0D0 - WDTP(I)=FAC*WDTPZP - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(VPI**2+API**2)*VINT(116)*WDTPZP - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=0D0 - FZZPF=0D0 - FZPZPF=WDTPZP - ENDIF - WID2=WIDS(23,2)*WIDS(25,2) - ELSEIF(I.EQ.21.OR.I.EQ.22) THEN -C...Z' -> h0 + A0 or H0 + A0. - BE34C=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(I.EQ.21) THEN - CZAH=PARU(186) - CZPAH=PARU(188) - ELSE - CZAH=PARU(187) - CZPAH=PARU(189) - ENDIF - IF(ICASE.EQ.1) THEN - WDTPZ=CZAH**2*BE34C - WDTP(I)=FAC*CZPAH**2*BE34C - ELSEIF(MINT(61).EQ.1.AND.ICASE.EQ.2) THEN - WDTP(I)=FAC*(CZAH**2*(VI**2+AI**2)*VINT(114)+CZAH*CZPAH* - & (VI*VPI+AI*API)*VINT(115)+CZPAH**2*(VPI**2+API**2)* - & VINT(116))*BE34C - ELSEIF(MINT(61).EQ.2) THEN - FGGF=0D0 - FGZF=0D0 - FGZPF=0D0 - FZZF=CZAH**2*BE34C - FZZPF=CZAH*CZPAH*BE34C - FZPZPF=CZPAH**2*BE34C - ENDIF - IF(I.EQ.21) WID2=WIDS(25,2)*WIDS(36,2) - IF(I.EQ.22) WID2=WIDS(35,2)*WIDS(36,2) - ENDIF - IF(ICASE.EQ.1) THEN - VINT(117)=VINT(117)+FAC*WDTPZ - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - ENDIF - IF(MDME(IDC,1).GT.0) THEN - IF((ICASE.EQ.1.AND.MINT(61).NE.1).OR. - & (ICASE.EQ.2.AND.MINT(61).EQ.1)) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - IF(MINT(61).EQ.2.AND.ICASE.EQ.2) THEN - IF(MSTP(44).EQ.1.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.5.OR. - & MSTP(44).EQ.7) VINT(111)=VINT(111)+FGGF*WID2 - IF(MSTP(44).EQ.4.OR.MSTP(44).EQ.7) VINT(112)=VINT(112)+ - & FGZF*WID2 - IF(MSTP(44).EQ.5.OR.MSTP(44).EQ.7) VINT(113)=VINT(113)+ - & FGZPF*WID2 - IF(MSTP(44).EQ.2.OR.MSTP(44).EQ.4.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(114)=VINT(114)+FZZF*WID2 - IF(MSTP(44).EQ.6.OR.MSTP(44).EQ.7) VINT(115)=VINT(115)+ - & FZZPF*WID2 - IF(MSTP(44).EQ.3.OR.MSTP(44).EQ.5.OR.MSTP(44).EQ.6.OR. - & MSTP(44).EQ.7) VINT(116)=VINT(116)+FZPZPF*WID2 - ENDIF - ENDIF - 290 CONTINUE - IF(MINT(61).GE.1) ICASE=3-ICASE - IF(ICASE.EQ.2) GOTO 280 - - ELSEIF(KFLA.EQ.34) THEN -C...W'+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 300 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 300 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 300 - WID2=1D0 - IF(I.LE.20) THEN - IF(I.LE.16) THEN -C...W'+/- -> q + qbar' - FCOF=3D0*RADC*(PARU(131)**2+PARU(132)**2)* - & VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W'+/- -> l+/- + nu - FCOF=PARU(133)**2+PARU(134)**2 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*0.5D0*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ELSEIF(I.EQ.21) THEN -C...W'+/- -> W+/- + Z0 - WDTP(I)=FAC*PARU(135)**2*0.5D0*XW1*(RM1/RM2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0+10D0*RM1+10D0*RM2+RM1**2+RM2**2+10D0*RM1*RM2) - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(23,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(23,2) - ELSEIF(I.EQ.23) THEN -C...W'+/- -> W+/- + h0 - FLAM=SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FAC*PARU(146)**2*2D0*(3D0*RM1+0.25D0*FLAM**2)*FLAM - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 300 CONTINUE - - ELSEIF(KFLA.EQ.37) THEN -C...H+/-: -C IF(MSTP(49).EQ.0) THEN - SHFS=SH -C ELSE -C SHFS=PMAS(37,1)**2 -C ENDIF - FAC=(AEM/(8D0*XW))*(SHFS/PMAS(24,1)**2)*SHR - DO 310 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 310 - KFC1=PYCOMP(KFDP(IDC,1)) - KFC2=PYCOMP(KFDP(IDC,2)) - RM1=PMAS(KFC1,1)**2/SH - RM2=PMAS(KFC2,1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 310 - WID2=1D0 - IF(I.LE.4) THEN -C...H+/- -> q + qbar' - RM1R=PYMRUN(KFDP(IDC,1),SH)**2/SH - RM2R=PYMRUN(KFDP(IDC,2),SH)**2/SH - WDTP(I)=FAC*3D0*RADC*MAX(0D0,(RM1R*PARU(141)**2+ - & RM2R/PARU(141)**2)*(1D0-RM1R-RM2R)-4D0*RM1R*RM2R)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) - IF(KFLR.GT.0) THEN - IF(I.EQ.3) WID2=WIDS(6,2) - IF(I.EQ.4) WID2=WIDS(7,3)*WIDS(8,2) - ELSE - IF(I.EQ.3) WID2=WIDS(6,3) - IF(I.EQ.4) WID2=WIDS(7,2)*WIDS(8,3) - ENDIF - ELSEIF(I.LE.8) THEN -C...H+/- -> l+/- + nu - WDTP(I)=FAC*((RM1*PARU(141)**2+RM2/PARU(141)**2)* - & (1D0-RM1-RM2)-4D0*RM1*RM2)*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))*(SH/SHFS) - IF(KFLR.GT.0) THEN - IF(I.EQ.8) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.8) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ELSEIF(I.EQ.9) THEN -C...H+/- -> W+/- + h0. - WDTP(I)=FAC*PARU(195)**2*0.5D0*SQRT(MAX(0D0, - & (1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) WID2=WIDS(24,2)*WIDS(25,2) - IF(KFLR.LT.0) WID2=WIDS(24,3)*WIDS(25,2) - -CMRENNA++ - ELSE -C...Add in SUSY decays (two-body) by rescaling by phase space factor. - RM10=RM1*SH/PMR**2 - RM20=RM2*SH/PMR**2 - WFAC0=1D0+RM10**2+RM20**2-2D0*(RM10+RM20+RM10*RM20) - WFAC=1D0+RM1**2+RM2**2-2D0*(RM1+RM2+RM1*RM2) - IF(WFAC.LE.0D0 .OR. WFAC0.LE.0D0) THEN - WFAC=0D0 - ELSE - WFAC=WFAC/WFAC0 - ENDIF - WDTP(I)=PMAS(KC,2)*BRAT(IDC)*(SHR/PMR)*SQRT(WFAC) -CMRENNA-- - KSGN1=2 - IF(KFLS*KFDP(IDC,1).LT.0.AND.KCHG(KFC1,3).EQ.1) KSGN1=3 - KSGN2=2 - IF(KFLS*KFDP(IDC,2).LT.0.AND.KCHG(KFC2,3).EQ.1) KSGN2=3 - WID2=WIDS(KFC1,KSGN1)*WIDS(KFC2,KSGN2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 310 CONTINUE - - ELSEIF(KFLA.EQ.41) THEN -C...R: - FAC=(AEM/(12D0*XW))*SHR - DO 320 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 320 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 320 - WID2=1D0 - IF(I.LE.6) THEN -C...R -> q + qbar' - FCOF=3D0*RADC - ELSEIF(I.LE.9) THEN -C...R -> l+ + l'- - FCOF=1D0 - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - IF(KFLR.GT.0) THEN - IF(I.EQ.4) WID2=WIDS(6,3) - IF(I.EQ.5) WID2=WIDS(7,3) - IF(I.EQ.6) WID2=WIDS(6,2)*WIDS(8,3) - IF(I.EQ.9) WID2=WIDS(17,3) - ELSE - IF(I.EQ.4) WID2=WIDS(6,2) - IF(I.EQ.5) WID2=WIDS(7,2) - IF(I.EQ.6) WID2=WIDS(6,3)*WIDS(8,2) - IF(I.EQ.9) WID2=WIDS(17,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 320 CONTINUE - - ELSEIF(KFLA.EQ.42) THEN -C...LQ (leptoquark). - FAC=(AEM/4D0)*PARU(151)*SHR - DO 330 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 330 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 330 - WDTP(I)=FAC*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=1D0 - ILQQ=KFDP(IDC,1)*ISIGN(1,KFLR) - IF(ILQQ.GE.6) WID2=WIDS(ILQQ,2) - IF(ILQQ.LE.-6) WID2=WIDS(-ILQQ,3) - ILQL=KFDP(IDC,2)*ISIGN(1,KFLR) - IF(ILQL.GE.17) WID2=WID2*WIDS(ILQL,2) - IF(ILQL.LE.-17) WID2=WID2*WIDS(-ILQL,3) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 330 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+111.OR.KFLA.EQ.KTECHN+221) THEN -C...Techni-pi0 and techni-pi0': - FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR - DO 340 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 340 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - RM1=PM1**2/SH - RM2=PM2**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 340 - WID2=1D0 -C...pi_tc -> g + g - IF(I.EQ.8) THEN - FACP=(AS/(4D0*PARU(1))*ITCM(1)/RTCM(1))**2 - & /(8D0*PARU(1))*SH*SHR - IF(KFLA.EQ.KTECHN+111) THEN - FACP=FACP*RTCM(9) - ELSE - FACP=FACP*RTCM(10) - ENDIF - WDTP(I)=FACP - ELSE -C...pi_tc -> f + fbar. - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PM1 - HM2=PM2 - IF(IKA.GE.4.AND.IKA.LE.6) THEN - FCOF=FCOF*RTCM(1+IKA)**2 - HM1=PYMRUN(KFDP(IDC,1),SH) - HM2=PYMRUN(KFDP(IDC,2),SH) - ELSEIF(IKA.EQ.15) THEN - FCOF=FCOF*RTCM(8)**2 - ENDIF - WDTP(I)=FAC*FCOF*(HM1+HM2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 340 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+211) THEN -C...pi+_tc - FAC=(1D0/(32D0*PARU(1)*RTCM(1)**2))*SHR - DO 350 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 350 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - PM3=0D0 - IF(I.EQ.5) PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) - RM1=PM1**2/SH - RM2=PM2**2/SH - RM3=PM3**2/SH - IF(SQRT(RM1)+SQRT(RM2)+SQRT(RM3).GT.1D0) GOTO 350 - WID2=1D0 -C...pi_tc -> f + f'. - FCOF=1D0 - IF(IABS(KFDP(IDC,1)).LT.10) FCOF=3D0*RADC -C...pi_tc+ -> W b b~ - IF(I.EQ.5.AND.SHR.LT.PMAS(6,1)+PMAS(5,1)) THEN - FCOF=3D0*RADC - XMT2=PMAS(6,1)**2/SH - FACP=FAC/(4D0*PARU(1))*FCOF*XMT2*RTCM(7)**2 - KFC3=PYCOMP(KFDP(IDC,3)) - CHECK = SQRT(RM1)+SQRT(RM2)+SQRT(RM3) - CHECK = SQRT(RM1) - T0 = (1D0-CHECK**2)* - & (XMT2*(6D0*XMT2**2+3D0*XMT2*RM1-4D0*RM1**2)- - & (5D0*XMT2**2+2D0*XMT2*RM1-8D0*RM1**2))/(4D0*XMT2**2) - T1 = (1D0-XMT2)*(RM1-XMT2)*((XMT2**2+XMT2*RM1+4D0*RM1**2) - & -3D0*XMT2**2*(XMT2+RM1))/(2D0*XMT2**3) - T3 = RM1**2/XMT2**3*(3D0*XMT2-4D0*RM1+4D0*XMT2*RM1) - WDTP(I)=FACP*(T0 + T1*LOG((XMT2-CHECK**2)/(XMT2-1D0)) - & +T3*LOG(CHECK)) - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2) - ELSE - WID2=WIDS(24,3) - ENDIF - ELSE - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PM1 - HM2=PM2 - IF(I.GE.1.AND.I.LE.5) THEN - IF(I.LE.2) THEN - FCOF=FCOF*RTCM(5)**2 - ELSEIF(I.LE.4) THEN - FCOF=FCOF*RTCM(6)**2 - ELSEIF(I.EQ.5) THEN - FCOF=FCOF*RTCM(7)**2 - ENDIF - HM1=PYMRUN(KFDP(IDC,1),SH) - HM2=PYMRUN(KFDP(IDC,2),SH) - ELSEIF(I.EQ.8) THEN - FCOF=FCOF*RTCM(8)**2 - ENDIF - WDTP(I)=FAC*FCOF*(HM1+HM2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 350 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+331) THEN -C...Techni-eta. - FAC=(SH/PARP(46)**2)*SHR - DO 360 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 360 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 360 - WID2=1D0 - IF(I.LE.2) THEN - WDTP(I)=FAC*RM1*SQRT(MAX(0D0,1D0-4D0*RM1))/(4D0*PARU(1)) - IF(I.EQ.2) WID2=WIDS(6,1) - ELSE - WDTP(I)=FAC*5D0*AS**2/(96D0*PARU(1)**3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 360 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+113) THEN -C...Techni-rho0: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SHP=SH - CALL PYWIDX(23,SHP,WDTPP,WDTEP) - GMMZ=SHR*WDTPP(0) - XWRHT=(1D0-2D0*XW)/(4D0*XW*(1D0-XW)) - BWZR=XWRHT*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=XWRHT*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 370 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 370 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 370 - WID2=1D0 - IF(I.EQ.1) THEN -C...rho_tc0 -> W+ + W-. - WDTP(I)=FAC*RTCM(3)**4* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,1) - ELSEIF(I.EQ.2) THEN -C...rho_tc0 -> W+ + pi_tc-. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) - ELSEIF(I.EQ.3) THEN -C...rho_tc0 -> pi_tc+ + W-. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(24,3) - ELSEIF(I.EQ.4) THEN -C...rho_tc0 -> pi_tc+ + pi_tc-. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(PYCOMP(KTECHN+211),1) - ELSEIF(I.EQ.5) THEN -C...rho_tc0 -> gamma + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3 - WID2=WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.6) THEN -C...rho_tc0 -> gamma + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.7) THEN -C...rho_tc0 -> Z0 + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.8) THEN -C...rho_tc0 -> Z0 + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSE -C...rho_tc0 -> f + fbar. - WID2=1D0 - IF(I.LE.16) THEN - IA=I-8 - FCOF=3D0*RADC - IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) - ELSE - IA=I-6 - FCOF=1D0 - IF(IA.GE.17) WID2=WIDS(IA,1) - ENDIF - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=0.5D0*(VI+AI) - VARI=0.5D0*(VI-AI) - WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* - & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( - & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 370 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+213) THEN -C...Techni-rho+/-: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - SQMZ=PMAS(23,1)**2 - SQMW=PMAS(24,1)**2 - SHP=SH - CALL PYWIDX(24,SHP,WDTPP,WDTEP) - GMMW=SHR*WDTPP(0) - FACF=(1D0/12D0)*(AEM**2/ALPRHT)*SHR* - & (0.125D0/XW**2)*SH**2/((SH-SQMW)**2+GMMW**2) - DO 380 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 380 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 380 - WID2=1D0 - IF(I.EQ.1) THEN -C...rho_tc+ -> W+ + Z0. - WDTP(I)=FAC*RTCM(3)**4* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(23,2) - ELSE - WID2=WIDS(24,3)*WIDS(23,2) - ENDIF - ELSEIF(I.EQ.2) THEN -C...rho_tc+ -> W+ + pi_tc0. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMW/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(13)**2*SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSE - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+111),2) - ENDIF - ELSEIF(I.EQ.3) THEN -C...rho_tc+ -> pi_tc+ + Z0. - WDTP(I)=FAC*RTCM(3)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))* - & ((1D0-RM1-RM2)**2-4D0*RM1*RM2 + 6D0*SQMZ/SH)* - & (1D0-RTCM(3)**2)/4D0/XW/XW1/24D0/RTCM(13)**2*SHR**3+ - & AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3*XW/XW1 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(23,2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(23,2) - ENDIF - ELSEIF(I.EQ.4) THEN -C...rho_tc+ -> pi_tc+ + pi_tc0. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2)*WIDS(PYCOMP(KTECHN+111),2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3)*WIDS(PYCOMP(KTECHN+111),2) - ENDIF - ELSEIF(I.EQ.5) THEN -C...rho_tc+ -> pi_tc+ + gamma - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(3)**2)/24D0/RTCM(12)**2* - & SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(PYCOMP(KTECHN+211),2) - ELSE - WID2=WIDS(PYCOMP(KTECHN+211),3) - ENDIF - ELSEIF(I.EQ.6) THEN -C...rho_tc+ -> W+ + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(4)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3 - IF(KFLR.GT.0) THEN - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSE - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+221),2) - ENDIF - ELSE -C...rho_tc+ -> f + fbar'. - IA=I-6 - WID2=1D0 - IF(IA.LE.16) THEN - FCOF=3D0*RADC*VCKM((IA-1)/4+1,MOD(IA-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(IA,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(IA,4).EQ.0) WID2=WIDS(8,2) - IF(IA.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(IA,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(IA,4).EQ.0) WID2=WIDS(8,3) - IF(IA.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSE - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(IA.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(IA.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FACF*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 380 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+223) THEN -C...Techni-omega: - ALPRHT=2.91D0*(3D0/ITCM(1)) - FAC=(ALPRHT/12D0)*SHR - FACF=(1D0/6D0)*(AEM**2/ALPRHT)*SHR*(2D0*RTCM(2)-1D0)**2 - SQMZ=PMAS(23,1)**2 - SHP=SH - CALL PYWIDX(23,SHP,WDTPP,WDTEP) - GMMZ=SHR*WDTPP(0) - BWZR=(0.5D0/(1D0-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2) - BWZI=-(0.5D0/(1D0-XW))*SH*GMMZ/((SH-SQMZ)**2+GMMZ**2) - DO 390 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 390 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 390 - WID2=1D0 - IF(I.EQ.1) THEN -C...omega_tc0 -> gamma + pi_tc0. - WDTP(I)=AEM/24D0/RTCM(12)**2*(1D0-RTCM(3)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3*SHR**3 - WID2=WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.2) THEN -C...omega_tc0 -> Z0 + pi_tc0 - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/24D0/RTCM(12)**2*(1D0-2D0*XW)**2/4D0/ - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+111),2) - ELSEIF(I.EQ.3) THEN -C...omega_tc0 -> gamma + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* - & SHR**3 - WID2=WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.4) THEN -C...omega_tc0 -> Z0 + pi_tc0' - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (2D0*RTCM(2)-1D0)**2*(1D0-RTCM(4)**2)/24D0/RTCM(12)**2* - & XW/XW1*SHR**3 - WID2=WIDS(23,2)*WIDS(PYCOMP(KTECHN+221),2) - ELSEIF(I.EQ.5) THEN -C...omega_tc0 -> W+ + pi_tc- - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ - & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,2)*WIDS(PYCOMP(KTECHN+211),3) - ELSEIF(I.EQ.6) THEN -C...omega_tc0 -> pi_tc+ + W- - WDTP(I)=AEM*SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3* - & (1D0-RTCM(3)**2)/4D0/XW/24D0/RTCM(12)**2*SHR**3+ - & FAC*RTCM(3)**2*(1D0-RTCM(3)**2)*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,3)*WIDS(PYCOMP(KTECHN+211),2) - ELSEIF(I.EQ.7) THEN -C...omega_tc0 -> W+ + W-. - WDTP(I)=FAC*RTCM(3)**4*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(24,1) - ELSEIF(I.EQ.8) THEN -C...omega_tc0 -> pi_tc+ + pi_tc-. - WDTP(I)=FAC*(1D0-RTCM(3)**2)**2*RTCM(11)**2* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))**3 - WID2=WIDS(PYCOMP(KTECHN+211),1) - ELSE -C...omega_tc0 -> f + fbar. - WID2=1D0 - IF(I.LE.14) THEN - IA=I-8 - FCOF=3D0*RADC - IF(IA.GE.6.AND.IA.LE.8) WID2=WIDS(IA,1) - ELSE - IA=I-6 - FCOF=1D0 - IF(IA.GE.17) WID2=WIDS(IA,1) - ENDIF - EI=KCHG(IA,1)/3D0 - AI=SIGN(1D0,EI+0.1D0) - VI=AI-4D0*EI*XWV - VALI=-0.5D0*(VI+AI) - VARI=-0.5D0*(VI-AI) - WDTP(I)=FACF*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))*((1D0-RM1)* - & ((EI+VALI*BWZR)**2+(VALI*BWZI)**2+ - & (EI+VARI*BWZR)**2+(VARI*BWZI)**2)+6D0*RM1*( - & (EI+VALI*BWZR)*(EI+VARI*BWZR)+VALI*VARI*BWZI**2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 390 CONTINUE - -C.....V8 -> quark anti-quark - ELSEIF(KFLA.EQ.KTECHN+100021) THEN - FAC=AS/6D0*SHR - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSEIF(ITCM(2).EQ.1) THEN - IMDL=2 - ENDIF - DO 400 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 400 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - RM1=PM1**2/SH - IF(RM1.GT.0.25D0) GOTO 400 - WID2=1D0 - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3**2 - ELSE - FMIX=TANT3**2 - ENDIF - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX - IF(I.EQ.6) WID2=WIDS(6,1) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 400 CONTINUE - - ELSEIF(KFLA.EQ.KTECHN+100111.OR.KFLA.EQ.KTECHN+200111) THEN - FAC=(1D0/(4D0*PARU(1)*RTCM(1)**2))*SHR - CLEBF=0D0 - DO 410 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 410 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 410 - WID2=1D0 -C...pi_tc -> g + g - IF(I.EQ.7) THEN - IF(KFLA.EQ.KTECHN+100111) THEN - CLEBG=4D0/3D0 - ELSE - CLEBG=5D0/3D0 - ENDIF - FACP=(AS/(8D0*PARU(1))*ITCM(1)/RTCM(1))**2 - & /(2D0*PARU(1))*SH*SHR*CLEBG - WDTP(I)=FACP - ELSE -C...pi_tc -> f + fbar. - IF(I.EQ.6) WID2=WIDS(6,1) - FCOF=1D0 - IKA=IABS(KFDP(IDC,1)) - IF(IKA.LT.10) FCOF=3D0*RADC - HM1=PYMRUN(KFDP(IDC,1),SH) - WDTP(I)=FAC*FCOF*HM1**2*CLEBF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 410 CONTINUE - - ELSEIF(KFLA.GE.KTECHN+100113.AND.KFLA.LE.KTECHN+400113) THEN - FAC=AS/6D0*SHR - ALPRHT=2.91D0*(3D0/ITCM(1)) - TANT3=RTCM(21) - SIN2T=2D0*TANT3/(TANT3**2+1D0) - SINT3=TANT3/SQRT(TANT3**2+1D0) - CSXPP=RTCM(22) - RM82=RTCM(27)**2 - X12=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*COS(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*COS(RTCM(32)))/SQRT(2D0) - X21=(RTCM(29)*SQRT(1D0-RTCM(29)**2)*SIN(RTCM(30))+ - & RTCM(31)*SQRT(1D0-RTCM(31)**2)*SIN(RTCM(32)))/SQRT(2D0) - X11=(.25D0*(RTCM(29)**2+RTCM(31)**2+2D0)- - & SINT3**2)*2D0 - X22=(.25D0*(2D0-RTCM(29)**2-RTCM(31)**2)- - & SINT3**2)*2D0 - CALL PYWIDX(KTECHN+100021,SH,WDTPP,WDTEP) - - IF(WDTPP(0).GT.RTCM(33)*SHR) WDTPP(0)=RTCM(33)*SHR - GMV8=SHR*WDTPP(0) - RMV8=PMAS(PYCOMP(KTECHN+100021),1) - FV8RE=SH*(SH-RMV8**2)/((SH-RMV8**2)**2+GMV8**2) - FV8IM=SH*GMV8/((SH-RMV8**2)**2+GMV8**2) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSE - IMDL=2 - ENDIF - DO 420 I=1,MDCY(KC,3) - IF(I.EQ.7.AND.(KFLA.EQ.KTECHN+200113.OR. - & KFLA.EQ.KTECHN+300113)) GOTO 420 - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 420 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 420 - WID2=1D0 - IF(I.LE.6) THEN - IF(I.EQ.6) WID2=WIDS(6,1) - XIG=1D0 - IF(KFLA.EQ.KTECHN+200113) THEN - XIG=0D0 - XIJ=X12 - ELSEIF(KFLA.EQ.KTECHN+300113) THEN - XIG=0D0 - XIJ=X21 - ELSEIF(KFLA.EQ.KTECHN+100113) THEN - XIJ=X11 - ELSE - XIJ=X22 - ENDIF - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3/SIN2T - ELSE - FMIX=-TANT3/SIN2T - ENDIF - XFAC=(XIG+FMIX*XIJ*FV8RE)**2+(FMIX*XIJ*FV8IM)**2 - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*AS/ALPRHT*XFAC - ELSEIF(I.EQ.7) THEN - WDTP(I)=SHR*AS**2/(4D0*ALPRHT) - ELSEIF(KFLA.EQ.KTECHN+400113.AND.I.LE.9) THEN - PSH=SHR*(1D0-RM1)/2D0 - WDTP(I)=AS/9D0*PSH**3/RM82 - IF(I.EQ.8) THEN - WDTP(I)=2D0*WDTP(I)*CSXPP**2 - WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) - ELSE - WDTP(I)=5D0*WDTP(I) - WID2=WIDS(PYCOMP(KFDP(IDC,1)),2) - ENDIF - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 420 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+1) THEN -C...d* excited quark. - FAC=(SH/RTCM(41)**2)*SHR - DO 430 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 430 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 430 - WID2=1D0 - IF(I.EQ.1) THEN -C...d* -> g + d. - WDTP(I)=FAC*AS*RTCM(45)**2/3D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...d* -> gamma + d. - QF=-RTCM(43)/2D0+RTCM(44)/6D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.3) THEN -C...d* -> Z0 + d. - QF=-RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.4) THEN -C...d* -> W- + u. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 430 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+2) THEN -C...u* excited quark. - FAC=(SH/RTCM(41)**2)*SHR - DO 440 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 440 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 440 - WID2=1D0 - IF(I.EQ.1) THEN -C...u* -> g + u. - WDTP(I)=FAC*AS*RTCM(45)**2/3D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...u* -> gamma + u. - QF=RTCM(43)/2D0+RTCM(44)/6D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.3) THEN -C...u* -> Z0 + u. - QF=RTCM(43)*XW1/2D0-RTCM(44)*XW/6D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.4) THEN -C...u* -> W+ + d. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,2) - IF(KFLR.LT.0) WID2=WIDS(24,3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 440 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+11) THEN -C...e* excited lepton. - FAC=(SH/RTCM(41)**2)*SHR - DO 450 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 450 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 450 - WID2=1D0 - IF(I.EQ.1) THEN -C...e* -> gamma + e. - QF=-RTCM(43)/2D0-RTCM(44)/2D0 - WDTP(I)=FAC*AEM*QF**2/4D0 - WID2=1D0 - ELSEIF(I.EQ.2) THEN -C...e* -> Z0 + e. - QF=-RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.3) THEN -C...e* -> W- + nu. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,3) - IF(KFLR.LT.0) WID2=WIDS(24,2) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 450 CONTINUE - - ELSEIF(KFLA.EQ.KEXCIT+12) THEN -C...nu*_e excited neutrino. - FAC=(SH/RTCM(41)**2)*SHR - DO 460 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 460 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 460 - WID2=1D0 - IF(I.EQ.1) THEN -C...nu*_e -> Z0 + nu*_e. - QF=RTCM(43)*XW1/2D0+RTCM(44)*XW/2D0 - WDTP(I)=FAC*AEM*QF**2/(8D0*XW*XW1)* - & (1D0-RM1)**2*(2D0+RM1) - WID2=WIDS(23,2) - ELSEIF(I.EQ.2) THEN -C...nu*_e -> W+ + e. - WDTP(I)=FAC*AEM*RTCM(43)**2/(16D0*XW)* - & (1D0-RM1)**2*(2D0+RM1) - IF(KFLR.GT.0) WID2=WIDS(24,2) - IF(KFLR.LT.0) WID2=WIDS(24,3) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 460 CONTINUE - - ELSEIF(KFLA.EQ.KDIMEN+39) THEN -C...G* (graviton resonance): - FAC=(PARP(50)**2/PARU(1))*SHR - DO 470 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 470 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 470 - WID2=1D0 - IF(I.LE.8) THEN -C...G* -> q + qbar - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF* - & PYHFTH(SH,SH*RM1,1D0) - WDTP(I)=FAC*FCOF*SQRT(MAX(0D0,1D0-4D0*RM1))**3* - & (1D0+8D0*RM1/3D0)/320D0 - IF(I.EQ.6) WID2=WIDS(6,1) - IF(I.EQ.7.OR.I.EQ.8) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...G* -> l+ + l-, nu + nubar - FCOF=1D0 - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))**3* - & (1D0+8D0*RM1/3D0)/320D0 - IF(I.EQ.15.OR.I.EQ.16) WID2=WIDS(2+I,1) - ELSEIF(I.EQ.17) THEN -C...G* -> g + g. - WDTP(I)=FAC/20D0 - ELSEIF(I.EQ.18) THEN -C...G* -> gamma + gamma. - WDTP(I)=FAC/160D0 - ELSEIF(I.EQ.19) THEN -C...G* -> Z0 + Z0. - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ - & 14D0*RM1/3D0+4D0*RM1**2)/160D0 - WID2=WIDS(23,1) - ELSEIF(I.EQ.20) THEN -C...G* -> W+ + W-. - WDTP(I)=FAC*SQRT(MAX(0D0,1D0-4D0*RM1))*(13D0/12D0+ - & 14D0*RM1/3D0+4D0*RM1**2)/80D0 - WID2=WIDS(24,1) - ENDIF - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 470 CONTINUE - - ELSEIF(KFLA.EQ.9900012.OR.KFLA.EQ.9900014.OR.KFLA.EQ.9900016) THEN -C...nu_eR, nu_muR, nu_tauR: righthanded Majorana neutrinos. - PMWR=MAX(1.001D0*SHR,PMAS(PYCOMP(9900024),1)) - FAC=(AEM**2/(768D0*PARU(1)*XW**2))*SHR**5/PMWR**4 - DO 480 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 480 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - PM2=PMAS(PYCOMP(KFDP(IDC,2)),1) - PM3=PMAS(PYCOMP(KFDP(IDC,3)),1) - IF(PM1+PM2+PM3.GE.SHR) GOTO 480 - WID2=1D0 - IF(I.LE.9) THEN -C...nu_lR -> l- qbar q' - FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) - IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) - ELSEIF(I.LE.18) THEN -C...nu_lR -> l+ q qbar' - FCOF=3D0*RADC*VCKM((I-10)/3+1,MOD(I-10,3)+1) - IF(MOD(I-9,3).EQ.0) WID2=WIDS(6,3) - ELSE -C...nu_lR -> l- l'+ nu_lR' + charge conjugate. - FCOF=1D0 - WID2=WIDS(PYCOMP(KFDP(IDC,3)),2) - ENDIF - X=(PM1+PM2+PM3)/SHR - FX=1D0-8D0*X**2+8D0*X**6-X**8-24D0*X**4*LOG(X) - Y=(SHR/PMWR)**2 - FY=(12D0*(1D0-Y)*LOG(1D0-Y)+12D0*Y-6D0*Y**2-2D0*Y**3)/Y**4 - WDTP(I)=FAC*FCOF*FX*FY - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 480 CONTINUE - - ELSEIF(KFLA.EQ.9900023) THEN -C...Z_R0: - FAC=(AEM/(48D0*XW*XW1*(1D0-2D0*XW)))*SHR - DO 490 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 490 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 490 - WID2=1D0 - SYMMET=1D0 - IF(I.LE.6) THEN -C...Z_R0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0)*(1D0-2D0*XW) - VF=SIGN(1D0,EF+0.1D0)-4D0*EF*XW - FCOF=3D0*RADC - IF(I.EQ.6) WID2=WIDS(6,1) - ELSEIF(I.EQ.7.OR.I.EQ.10.OR.I.EQ.13) THEN -C...Z_R0 -> l+ + l- - AF=-(1D0-2D0*XW) - VF=-1D0+4D0*XW - FCOF=1D0 - ELSEIF(I.EQ.8.OR.I.EQ.11.OR.I.EQ.14) THEN -C...Z0 -> nu_L + nu_Lbar, assumed Majorana. - AF=-2D0*XW - VF=0D0 - FCOF=1D0 - SYMMET=0.5D0 - ELSEIF(I.LE.15) THEN -C...Z0 -> nu_R + nu_R, assumed Majorana. - AF=2D0*XW1 - VF=0D0 - FCOF=1D0 - WID2=WIDS(PYCOMP(KFDP(IDC,1)),1) - SYMMET=0.5D0 - ENDIF - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & SQRT(MAX(0D0,1D0-4D0*RM1))*SYMMET - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 490 CONTINUE - - ELSEIF(KFLA.EQ.9900024) THEN -C...W_R+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 500 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 500 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 500 - WID2=1D0 - IF(I.LE.9) THEN -C...W_R+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/3+1,MOD(I-1,3)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,3).EQ.0) WID2=WIDS(6,2) - ELSE - IF(MOD(I,3).EQ.0) WID2=WIDS(6,3) - ENDIF - ELSEIF(I.LE.12) THEN -C...W_R+/- -> l+/- + nu_R - FCOF=1D0 - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 500 CONTINUE - - ELSEIF(KFLA.EQ.9900041) THEN -C...H_L++/--: - FAC=(1D0/(8D0*PARU(1)))*SHR - DO 510 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 510 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 510 - WID2=1D0 - IF(I.LE.6) THEN -C...H_L++/-- -> l+/- + l'+/- - FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ - & (IABS(KFDP(IDC,2))-9)/2)**2 - IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF - ELSEIF(I.EQ.7) THEN -C...H_L++/-- -> W_L+/- + W_L+/- - FCOF=0.5D0*PARP(190)**4*PARP(192)**2/PMAS(24,1)**2* - & (3D0*RM1+0.25D0/RM1-1D0) - WID2=WIDS(24,4+(1-KFLS)/2) - ENDIF - WDTP(I)=FAC*FCOF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 510 CONTINUE - - ELSEIF(KFLA.EQ.9900042) THEN -C...H_R++/--: - FAC=(1D0/(8D0*PARU(1)))*SHR - DO 520 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 520 - RM1=PMAS(PYCOMP(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(PYCOMP(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 520 - WID2=1D0 - IF(I.LE.6) THEN -C...H_R++/-- -> l+/- + l'+/- - FCOF=PARP(180+3*((IABS(KFDP(IDC,1))-11)/2)+ - & (IABS(KFDP(IDC,2))-9)/2)**2 - IF(KFDP(IDC,1).NE.KFDP(IDC,2)) FCOF=2D0*FCOF - ELSEIF(I.EQ.7) THEN -C...H_R++/-- -> W_R+/- + W_R+/- - FCOF=PARP(191)**2*(3D0*RM1+0.25D0/RM1-1D0) - WID2=WIDS(PYCOMP(9900024),4+(1-KFLS)/2) - ENDIF - WDTP(I)=FAC*FCOF* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(I)=FUDGE*WDTP(I) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 520 CONTINUE - - ENDIF - MINT(61)=0 - MINT(62)=0 - MINT(63)=0 - RETURN - END - -C*********************************************************************** - -C...PYWIDX -C...Calculates full and partial widths of resonances. -C....copy of PYWIDT, used for techniparticle widths - - SUBROUTINE PYWIDX(KFLR,SH,WDTP,WDTE) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5) - COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT4/MWID(500),WIDS(500,5) - COMMON/PYMSSM/IMSS(0:99),RMSS(0:99) - COMMON/PYTCSM/ITCM(0:99),RTCM(0:99) - SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/, - &/PYINT4/,/PYMSSM/,/PYTCSM/ -C...Local arrays and saved variables. - DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2), - &WID2SV(3,2) - SAVE MOFSV,WIDWSV,WID2SV - DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/ - -C...Compressed code and sign; mass. - KFLA=IABS(KFLR) - KFLS=ISIGN(1,KFLR) - KC=PYCOMP(KFLA) - SHR=SQRT(SH) - PMR=PMAS(KC,1) - -C...Reset width information. - DO 110 I=0,200 - WDTP(I)=0D0 - DO 100 J=0,5 - WDTE(I,J)=0D0 - 100 CONTINUE - 110 CONTINUE - -C...Common electroweak and strong constants. - XW=PARU(102) - XWV=XW - IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2 - XW1=1D0-XW - AEM=PYALEM(SH) - IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1) - AS=PYALPS(SH) - RADC=1D0+AS/PARU(1) - - IF(KFLA.EQ.23) THEN -C...Z0: - ICASE=1 - XWC=1D0/(16D0*XW*XW1) - FAC=(AEM*XWC/3D0)*SHR - 120 CONTINUE - DO 130 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 130 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 130 - WID2=1D0 - IF(I.LE.8) THEN -C...Z0 -> q + qbar - EF=KCHG(I,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=3D0*RADC - IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0) - IF(I.EQ.6) WID2=WIDS(6,1) - IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1) - ELSEIF(I.LE.16) THEN -C...Z0 -> l+ + l-, nu + nubar - EF=KCHG(I+2,1)/3D0 - AF=SIGN(1D0,EF+0.1D0) - VF=AF-4D0*EF*XWV - FCOF=1D0 - IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1) - ENDIF - BE34=SQRT(MAX(0D0,1D0-4D0*RM1)) - WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))* - & BE34 - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+ - & WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 130 CONTINUE - - - ELSEIF(KFLA.EQ.24) THEN -C...W+/-: - FAC=(AEM/(24D0*XW))*SHR - DO 140 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 140 - RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH - RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH - IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140 - WID2=1D0 - IF(I.LE.16) THEN -C...W+/- -> q + qbar' - FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1) - IF(KFLR.GT.0) THEN - IF(MOD(I,4).EQ.3) WID2=WIDS(6,2) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,2) - IF(I.GE.13) WID2=WID2*WIDS(7,3) - ELSE - IF(MOD(I,4).EQ.3) WID2=WIDS(6,3) - IF(MOD(I,4).EQ.0) WID2=WIDS(8,3) - IF(I.GE.13) WID2=WID2*WIDS(7,2) - ENDIF - ELSEIF(I.LE.20) THEN -C...W+/- -> l+/- + nu - FCOF=1D0 - IF(KFLR.GT.0) THEN - IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2) - ELSE - IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3) - ENDIF - ENDIF - WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)* - & SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2)) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 140 CONTINUE - -C.....V8 -> quark anti-quark - ELSEIF(KFLA.EQ.KTECHN+100021) THEN - FAC=AS/6D0*SHR - TANT3=RTCM(21) - IF(ITCM(2).EQ.0) THEN - IMDL=1 - ELSEIF(ITCM(2).EQ.1) THEN - IMDL=2 - ENDIF - DO 150 I=1,MDCY(KC,3) - IDC=I+MDCY(KC,2)-1 - IF(MDME(IDC,1).LT.0) GOTO 150 - PM1=PMAS(PYCOMP(KFDP(IDC,1)),1) - RM1=PM1**2/SH - IF(RM1.GT.0.25D0) GOTO 150 - WID2=1D0 - IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN - FMIX=1D0/TANT3**2 - ELSE - FMIX=TANT3**2 - ENDIF - WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX - IF(I.EQ.6) WID2=WIDS(6,1) - WDTP(0)=WDTP(0)+WDTP(I) - IF(MDME(IDC,1).GT.0) THEN - WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 - WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) - WDTE(I,0)=WDTE(I,MDME(IDC,1)) - WDTE(0,0)=WDTE(0,0)+WDTE(I,0) - ENDIF - 150 CONTINUE - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYX2XG -C...Calculates the decay rate for ino -> ino + gauge boson. - - FUNCTION PYX2XG(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYX2XG,XM1,XM2,XM3,GX2,GLR - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMV2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMV2) - PYX2XG=C1/8D0/XMI3*SQRT(XL) - &*(GX2*(XL+3D0*XMV2*(XMI2+XMJ2-XMV2))- - &12D0*GLR*XM1*XM2*XMV2) - - RETURN - END - -C********************************************************************* - -C...PYX2XH -C...Calculates the decay rate for ino -> ino + H. - - FUNCTION PYX2XH(C1,XM1,XM2,XM3,GX2,GLR) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYX2XH,XM1,XM2,XM3 - DOUBLE PRECISION XL,PYLAMF,C1 - DOUBLE PRECISION XMI2,XMJ2,XMV2,XMI3 - - XMI2=XM1**2 - XMI3=ABS(XM1**3) - XMJ2=XM2**2 - XMV2=XM3**2 - XL=PYLAMF(XMI2,XMJ2,XMV2) - PYX2XH=C1/8D0/XMI3*SQRT(XL) - &*(GX2*(XMI2+XMJ2-XMV2)+ - &4D0*GLR*XM1*XM2) - - RETURN - END - -C********************************************************************* - -C...PYX3JT -C...Selects the kinematical variables of three-jet events. - - SUBROUTINE PYX3JT(NJET,CUT,KFL,ECM,X1,X2) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array. - DIMENSION ZHUP(5,12) - -C...Coefficients of Zhu second order parametrization. - DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ - &18.29D0, 89.56D0, 4.541D0, -52.09D0, -109.8D0, 24.90D0, - &11.63D0, 3.683D0, 17.50D0,0.002440D0, -1.362D0,-0.3537D0, - &11.42D0, 6.299D0, -22.55D0, -8.915D0, 59.25D0, -5.855D0, - &-32.85D0, -1.054D0, -16.90D0,0.006489D0,-0.8156D0,0.01095D0, - &7.847D0, -3.964D0, -35.83D0, 1.178D0, 29.39D0, 0.2806D0, - &47.82D0, -12.36D0, -56.72D0, 0.04054D0,-0.4365D0, 0.6062D0, - &5.441D0, -56.89D0, -50.27D0, 15.13D0, 114.3D0, -18.19D0, - &97.05D0, -1.890D0, -139.9D0, 0.08153D0,-0.4984D0, 0.9439D0, - &-17.65D0, 51.44D0, -58.32D0, 70.95D0, -255.7D0, -78.99D0, - &476.9D0, 29.65D0, -239.3D0, 0.4745D0, -1.174D0, 6.081D0/ - -C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). - DILOG(X)=X+X**2/4D0+X**3/9D0+X**4/16D0+X**5/25D0+X**6/36D0+ - &X**7/49D0 - -C...Event type. Mass effect factors and other common constants. - MSTJ(120)=2 - MSTJ(121)=0 - PMQ=PYMASS(KFL) - QME=(2D0*PMQ/ECM)**2 - IF(MSTJ(109).NE.1) THEN - CUTL=LOG(CUT) - CUTD=LOG(1D0/CUT-2D0) - IF(MSTJ(109).EQ.0) THEN - CF=4D0/3D0 - CN=3D0 - TR=2D0 - WTMX=MIN(20D0,37D0-6D0*CUTD) - IF(MSTJ(110).EQ.2) WTMX=2D0*(7.5D0+80D0*CUT) - ELSE - CF=1D0 - CN=0D0 - TR=12D0 - WTMX=0D0 - ENDIF - -C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. - ALS2PI=PARU(118)/PARU(2) - WTOPT=0D0 - IF(MSTJ(111).EQ.1) WTOPT=(33D0-2D0*MSTU(112))/6D0* - & LOG(PARJ(169))*ALS2PI - WTMAX=MAX(0D0,1D0+WTOPT+ALS2PI*WTMX) - -C...Choose three-jet events in allowed region. - 100 NJET=3 - 110 Y13L=CUTL+CUTD*PYR(0) - Y23L=CUTL+CUTD*PYR(0) - Y13=EXP(Y13L) - Y23=EXP(Y23L) - Y12=1D0-Y13-Y23 - IF(Y12.LE.CUT) GOTO 110 - IF(Y13**2+Y23**2+2D0*Y12.LE.2D0*PYR(0)) GOTO 110 - -C...Second order corrections. - IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN - Y12L=LOG(Y12) - Y13M=LOG(1D0-Y13) - Y23M=LOG(1D0-Y23) - Y12M=LOG(1D0-Y12) - IF(Y13.LE.0.5D0) Y13I=DILOG(Y13) - IF(Y13.GE.0.5D0) Y13I=1.644934D0-Y13L*Y13M-DILOG(1D0-Y13) - IF(Y23.LE.0.5D0) Y23I=DILOG(Y23) - IF(Y23.GE.0.5D0) Y23I=1.644934D0-Y23L*Y23M-DILOG(1D0-Y23) - IF(Y12.LE.0.5D0) Y12I=DILOG(Y12) - IF(Y12.GE.0.5D0) Y12I=1.644934D0-Y12L*Y12M-DILOG(1D0-Y12) - WT1=(Y13**2+Y23**2+2D0*Y12)/(Y13*Y23) - WT2=CF*(-2D0*(CUTL-Y12L)**2-3D0*CUTL-1D0+3.289868D0+ - & 2D0*(2D0*CUTL-Y12L)*CUT/Y12)+ - & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2- - & 11D0*CUTL/6D0+67D0/18D0+1.644934D0-(2D0*CUTL-Y12L)*CUT/Y12+ - & (2D0*CUTL-Y13L)*CUT/Y13+(2D0*CUTL-Y23L)*CUT/Y23)+ - & TR*(2D0*CUTL/3D0-10D0/9D0)+ - & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ - & Y13L*(4D0*Y12**2+2D0*Y12*Y13+4D0*Y12*Y23+Y13*Y23)/ - & (Y12+Y23)**2+Y23L*(4D0*Y12**2+2D0*Y12*Y23+4D0*Y12*Y13+ - & Y13*Y23)/(Y12+Y13)**2)/WT1+ - & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+(CN-2D0*CF)* - & ((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* - & Y23M+1.644934D0-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* - & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934D0-Y12I-Y13I)/ - & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- - & 2D0*Y12L*Y12**2/(Y13+Y23)**2-4D0*Y12L*Y12/(Y13+Y23))/WT1- - & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934D0-Y13I-Y23I) - IF(1D0+WTOPT+ALS2PI*WT2.LE.0D0) MSTJ(121)=1 - IF(1D0+WTOPT+ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 - PARJ(156)=(WTOPT+ALS2PI*WT2)/(1D0+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=1D0-Y12 - IZA=0 - DO 120 IY=1,5 - IF(ABS(CUT-0.01D0*IY).LT.0.0001D0) 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)/(1D0-ZY)+ZHUP(IZ,12)/ZY - ELSE - IZ=100D0*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)/(1D0-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)/(1D0-ZY)+ZHUP(IZ,12)/ZY - WT2=WTL+(WTU-WTL)*(100D0*CUT+1D0-IZ) - ENDIF - IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.0D0) MSTJ(121)=1 - IF(1D0+WTOPT+2D0*ALS2PI*WT2.LE.WTMAX*PYR(0)) GOTO 110 - PARJ(156)=(WTOPT+2D0*ALS2PI*WT2)/(1D0+WTOPT+2D0*ALS2PI*WT2) - ENDIF - -C...Impose mass cuts (gives two jets). For fixed jet number new try. - X1=1D0-Y23 - X2=1D0-Y13 - X3=1D0-Y12 - IF(4D0*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.5D0*QME**2+(0.5D0*QME+0.25D0*QME**2)*((1D0-X2)/(1D0-X1)+ - & (1D0-X1)/(1D0-X2)).GT.(X1**2+X2**2)*PYR(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(4D0*CUT**2+PYR(0)*((1D0-CUT)**2-4D0*CUT**2)) - IF(LOG((X3-CUT)/CUT).LE.PYR(0)*LOG((1D0-2D0*CUT)/CUT)) GOTO 140 - YD=SIGN(2D0*CUT*((X3-CUT)/CUT)**PYR(0)-X3,PYR(0)-0.5D0) - X1=1D0-0.5D0*(X3+YD) - X2=1D0-0.5D0*(X3-YD) - IF(4D0*(1D0-X1)*(1D0-X2)*(1D0-X3)/X3**2.LE.QME) NJET=2 - IF(MSTJ(102).GE.2) THEN - IF(X3**2-2D0*(1D0+X3)*(1D0-X1)*(1D0-X2)*PARJ(171).LT. - & X3**2*PYR(0)) NJET=2 - ENDIF - IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYX4JT -C...Selects the kinematical variables of four-jet events. - - SUBROUTINE PYX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local arrays. - DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) - -C...Common constants. Colour factors for QCD and Abelian gluon theory. - PMQ=PYMASS(KFL) - QME=(2D0*PMQ/ECM)**2 - CT=LOG(1D0/CUT-5D0) - IF(MSTJ(109).EQ.0) THEN - CF=4D0/3D0 - CN=3D0 - TR=2.5D0 - ELSE - CF=1D0 - CN=0D0 - TR=15D0 - ENDIF - -C...Choice of process (qqbargg or qqbarqqbar). - 100 NJET=4 - IT=1 - IF(PARJ(155).GT.PYR(0)) IT=2 - IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 - IF(IT.EQ.1) WTMX=0.7D0/CUT**2 - IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6D0/CUT**2 - IF(IT.EQ.2) WTMX=0.1125D0*CF*TR/CUT**2 - ID=1 - -C...Sample the five kinematical variables (for qqgg preweighted in y34). - 110 Y134=3D0*CUT+(1D0-6D0*CUT)*PYR(0) - Y234=3D0*CUT+(1D0-6D0*CUT)*PYR(0) - IF(IT.EQ.1) Y34=(1D0-5D0*CUT)*EXP(-CT*PYR(0)) - IF(IT.EQ.2) Y34=CUT+(1D0-6D0*CUT)*PYR(0) - IF(Y34.LE.Y134+Y234-1D0.OR.Y34.GE.Y134*Y234) GOTO 110 - VT=PYR(0) - CP=COS(PARU(1)*PYR(0)) - Y14=(Y134-Y34)*VT - Y13=Y134-Y14-Y34 - VB=Y34*(1D0-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) - Y24=0.5D0*(Y234-Y34)*(1D0-4D0*SQRT(MAX(0D0,VT*(1D0-VT)* - &VB*(1D0-VB)))*CP-(1D0-2D0*VT)*(1D0-2D0*VB)) - Y23=Y234-Y34-Y24 - Y12=1D0-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=0D0 - 120 IC=IC+1 - IF(IT.EQ.1) THEN - WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3D0*Y12*Y23*Y34+ - & 3D0*Y12*Y14*Y34+4D0*Y12**2*Y34-Y13*Y23*Y24+2D0*Y12*Y23*Y24- - & Y13*Y14*Y24-2D0*Y12*Y13*Y24+2D0*Y12**2*Y24+Y14*Y23**2+2D0*Y12* - & Y23**2+Y14**2*Y23+4D0*Y12*Y14*Y23+4D0*Y12**2*Y23+2D0*Y12*Y14**2+ - & 2D0*Y12*Y13*Y14+4D0*Y12**2*Y14+2D0*Y12**2*Y13+2D0*Y12**3)/ - & (2D0*Y13*Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24- - & Y14*Y23+Y12*Y13)/(Y13*Y134**2)+2D0*Y23*(1D0-Y13)/ - & (Y13*Y134*Y24)+Y34/(2D0*Y13*Y24) - WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2D0*Y12* - & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1D0+Y34)*Y124/(Y134*Y234*Y14* - & Y24)-(2D0*Y13*Y24+Y14**2+Y13*Y23+2D0*Y12*Y13)/(Y13*Y134*Y14)+ - & Y12*Y123*Y124/(2D0*Y13*Y14*Y23*Y24) - WTC(IC)=-(5D0*Y12*Y34**2+2D0*Y12*Y24*Y34+2D0*Y12*Y23*Y34+ - & 2D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+4D0*Y12**2*Y34-Y13*Y24**2+ - & Y14*Y23*Y24+Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24- - & 3D0*Y12*Y13*Y24-Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23- - & 3D0*Y12*Y14*Y23-Y12*Y13*Y23)/(4D0*Y134*Y234*Y34**2)+ - & (3D0*Y12*Y34**2-3D0*Y13*Y24*Y34+3D0*Y12*Y24*Y34+ - & 3D0*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6D0*Y12*Y14*Y34+ - & 2D0*Y12*Y13*Y34-2D0*Y12**2*Y34+Y14*Y23*Y24-3D0*Y13*Y23*Y24- - & 2D0*Y13*Y14*Y24+4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+ - & 3D0*Y14*Y23**2+2D0*Y14**2*Y23+2D0*Y14**2*Y12+ - & 2D0*Y12**2*Y14+6D0*Y12*Y14*Y23-2D0*Y12*Y13**2- - & 2D0*Y12**2*Y13)/(4D0*Y13*Y134*Y234*Y34) - WTC(IC)=WTC(IC)+(2D0*Y12*Y34**2-2D0*Y13*Y24*Y34+Y12*Y24*Y34+ - & 4D0*Y13*Y23*Y34+4D0*Y12*Y14*Y34+2D0*Y12*Y13*Y34+2D0*Y12**2*Y34- - & Y13*Y24**2+3D0*Y14*Y23*Y24+4D0*Y13*Y23*Y24-2D0*Y13*Y14*Y24+ - & 4D0*Y12*Y14*Y24+2D0*Y12*Y13*Y24+2D0*Y14*Y23**2+4D0*Y13*Y23**2+ - & 2D0*Y13*Y14*Y23+2D0*Y12*Y14*Y23+4D0*Y12*Y13*Y23+2D0*Y12*Y14**2+ - & 4D0*Y12**2*Y13+4D0*Y12*Y13*Y14+2D0*Y12**2*Y14)/ - & (4D0*Y13*Y134*Y24*Y34)-(Y12*Y34**2-2D0*Y14*Y24*Y34- - & 2D0*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*Y34+Y12*Y14*Y34+ - & 2D0*Y12*Y13*Y34-2D0*Y14**2*Y24-4D0*Y13*Y14*Y24- - & 4D0*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14- - & Y12*Y13**2)/(2D0*Y13*Y34*Y134**2)+(Y12*Y34**2- - & 4D0*Y14*Y24*Y34-2D0*Y13*Y24*Y34-2D0*Y14*Y23*Y34- - & 4D0*Y13*Y23*Y34-4D0*Y12*Y14*Y34-4D0*Y12*Y13*Y34- - & 2D0*Y13*Y14*Y24+2D0*Y13**2*Y24+2D0*Y14**2*Y23- - & 2D0*Y13*Y14*Y23-Y12*Y14**2-6D0*Y12*Y13*Y14- - & Y12*Y13**2)/(4D0*Y34**2*Y134**2) - WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5D0*CN)*WTB(IC)+ - & CN*WTC(IC))/8D0 - ELSE - WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2D0*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+2D0*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.5D0*CN)*WTE(IC))/16D0 - 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.PYR(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*(2D0*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4D0*(WTC(1)+ - & WTC(2)+WTC(3)+WTC(4)))/(9D0*WTTOT) - IF(WTA(2)+WTA(4)+2D0*(WTC(2)+WTC(4)).GT.PYR(0)*(WTA(1)+WTA(2)+ - & WTA(3)+WTA(4)+2D0*(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))/(8D0*WTTOT) - IF(WTA(2)+WTA(4).GT.PYR(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.5D0*Y34*(WTC(1)+WTC(2)+WTC(3)+ - & WTC(4)).GT.PYR(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.5D0*(1D0-SQRT(1D0-QME/Y12)) - X1=1D0-(1D0-Q12)*Y234-Q12*Y134 - X4=1D0-(1D0-Q12)*Y134-Q12*Y234 - X2=1D0-Y124 - X12=(1D0-Q12)*Y13+Q12*Y23 - X14=Y12-0.5D0*QME - IF(Y134*Y234/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 - -C...qqbarqqbar events: string configuration, choose new flavour. - ELSE - IF(ID.EQ.1) THEN - WTR=PYR(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))/(16D0*WTTOT) - 140 KFLN=1+INT(5D0*PYR(0)) - IF(KFLN.NE.KFL.AND.0.2D0*PARJ(156).LE.PYR(0)) GOTO 140 - IF(KFLN.EQ.KFL.AND.1D0-0.8D0*PARJ(156).LE.PYR(0)) GOTO 140 - IF(KFLN.GT.MSTJ(104)) NJET=2 - PMQN=PYMASS(KFLN) - QMEN=(2D0*PMQN/ECM)**2 - -C...Mass cuts. Kinematical variables out. - IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1D0*QMEN) NJET=2 - IF(NJET.EQ.2) GOTO 150 - Q24=0.5D0*(1D0-SQRT(1D0-QME/Y24)) - Q13=0.5D0*(1D0-SQRT(1D0-QMEN/Y13)) - X1=1D0-(1D0-Q24)*Y123-Q24*Y134 - X4=1D0-(1D0-Q24)*Y134-Q24*Y123 - X2=1D0-(1D0-Q13)*Y234-Q13*Y124 - X12=(1D0-Q24)*((1D0-Q13)*Y14+Q13*Y34)+Q24*((1D0-Q13)*Y12+ - & Q13*Y23) - X14=Y24-0.5D0*QME - X34=(1D0-Q24)*((1D0-Q13)*Y23+Q13*Y12)+Q24*((1D0-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/((1D0-X1)*(1D0-X4)).LE.PYR(0)) NJET=2 - ENDIF - 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 - - RETURN - END - -C********************************************************************* - -C...PYXDIF -C...Gives the angular orientation of events. - - SUBROUTINE PYXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5) - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYJETS/,/PYDAT1/,/PYDAT2/ - -C...Charge. Factors depending on polarization for QED case. - QF=KCHG(KFL,1)/3D0 - POLL=1D0-PARJ(131)*PARJ(132) - POLD=PARJ(132)-PARJ(131) - IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN - HF1=POLL - HF2=0D0 - HF3=PARJ(133)**2 - HF4=0D0 - -C...Factors depending on flavour, energy and polarization for QFD case. - ELSE - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECM)**2) - AE=-1D0 - VE=4D0*PARU(102)-1D0 - AF=SIGN(1D0,QF) - VF=AF-4D0*QF*PARU(102) - HF1=QF**2*POLL-2D0*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ - & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2D0*VE*AE*POLD) - HF2=-2D0*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2D0*VF*AF*SFW*SFF**2* - & (2D0*VE*AE*POLL-(VE**2+AE**2)*POLD) - HF3=PARJ(133)**2*(QF**2-2D0*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* - & SFW*SFF**2*(VE**2-AE**2)) - HF4=-PARJ(133)**2*2D0*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* - & SFF*AE - ENDIF - -C...Mass factor. Differential cross-sections for two-jet events. - SQ2=SQRT(2D0) - QME=0D0 - IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. - &MSTJ(109).NE.1) QME=(2D0*PYMASS(KFL)/ECM)**2 - IF(NJET.EQ.2) THEN - SIGU=4D0*SQRT(1D0-QME) - SIGL=2D0*QME*SQRT(1D0-QME) - SIGT=0D0 - SIGI=0D0 - SIGA=0D0 - SIGP=4D0 - -C...Kinematical variables. Reduce four-jet event to three-jet one. - ELSE - IF(NJET.EQ.3) THEN - X1=2D0*P(NC+1,4)/ECM - X2=2D0*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=2D0*P(NC+1,4)/ECMR - X2=2D0*P(NC+4,4)/ECMR - ENDIF - -C...Differential cross-sections for three-jet (or reduced four-jet). - XQ=(1D0-X1)/(1D0-X2) - CT12=(X1*X2-2D0*X1-2D0*X2+2D0+QME)/SQRT((X1**2-QME)*(X2**2-QME)) - ST12=SQRT(1D0-CT12**2) - IF(MSTJ(109).NE.1) THEN - SIGU=2D0*X1**2+X2**2*(1D0+CT12**2)-QME*(3D0+CT12**2-X1-X2)- - & QME*X1/XQ+0.5D0*QME*((X2**2-QME)*ST12**2-2D0*X2)*XQ - SIGL=(X2*ST12)**2-QME*(3D0-CT12**2-2.5D0*(X1+X2)+X1*X2+QME)+ - & 0.5D0*QME*(X1**2-X1-QME)/XQ+0.5D0*QME*((X2**2-QME)*CT12**2- - & X2)*XQ - SIGT=0.5D0*(X2**2-QME-0.5D0*QME*(X2**2-QME)/XQ)*ST12**2 - SIGI=((1D0-0.5D0*QME*XQ)*(X2**2-QME)*ST12*CT12+ - & QME*(1D0-X1-X2+0.5D0*X1*X2+0.5D0*QME)*ST12/CT12)/SQ2 - SIGA=X2**2*ST12/SQ2 - SIGP=2D0*(X1**2-X2**2*CT12) - -C...Differential cross-sect for scalar gluons (no mass effects). - ELSE - X3=2D0-X1-X2 - XT=X2*ST12 - CT13=SQRT(MAX(0D0,1D0-(XT/X3)**2)) - SIGU=(1D0-PARJ(171))*(X3**2-0.5D0*XT**2)+ - & PARJ(171)*(X3**2-0.5D0*XT**2-4D0*(1D0-X1)*(1D0-X2)**2/X1) - SIGL=(1D0-PARJ(171))*0.5D0*XT**2+ - & PARJ(171)*0.5D0*(1D0-X1)**2*XT**2 - SIGT=(1D0-PARJ(171))*0.25D0*XT**2+ - & PARJ(171)*0.25D0*XT**2*(1D0-2D0*X1) - SIGI=-(0.5D0/SQ2)*((1D0-PARJ(171))*XT*X3*CT13+ - & PARJ(171)*XT*((1D0-2D0*X1)*X3*CT13-X1*(X1-X2))) - SIGA=(0.25D0/SQ2)*XT*(2D0*(1D0-X1)-X1*X3) - SIGP=X3**2-2D0*(1D0-X1)*(1D0-X2)/X1 - ENDIF - ENDIF - -C...Upper bounds for differential cross-section. - HF1A=ABS(HF1) - HF2A=ABS(HF2) - HF3A=ABS(HF3) - HF4A=ABS(HF4) - SIGMAX=(2D0*HF1A+HF3A+HF4A)*ABS(SIGU)+2D0*(HF1A+HF3A+HF4A)* - &ABS(SIGL)+2D0*(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGT)+2D0*SQ2* - &(HF1A+2D0*HF3A+2D0*HF4A)*ABS(SIGI)+4D0*SQ2*HF2A*ABS(SIGA)+ - &2D0*HF2A*ABS(SIGP) - -C...Generate angular orientation according to differential cross-sect. - 100 CHI=PARU(2)*PYR(0) - CTHE=2D0*PYR(0)-1D0 - PHI=PARU(2)*PYR(0) - CCHI=COS(CHI) - SCHI=SIN(CHI) - C2CHI=COS(2D0*CHI) - S2CHI=SIN(2D0*CHI) - THE=ACOS(CTHE) - STHE=SIN(THE) - C2PHI=COS(2D0*(PHI-PARJ(134))) - S2PHI=SIN(2D0*(PHI-PARJ(134))) - SIG=((1D0+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ - &2D0*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ - &2D0*(STHE**2*C2CHI*HF1+((1D0+CTHE**2)*C2CHI*C2PHI-2D0*CTHE*S2CHI* - &S2PHI)*HF3-((1D0+CTHE**2)*C2CHI*S2PHI+2D0*CTHE*S2CHI*C2PHI)*HF4)* - &SIGT-2D0*SQ2*(2D0*STHE*CTHE*CCHI*HF1-2D0*STHE*(CTHE*CCHI*C2PHI- - &SCHI*S2PHI)*HF3+2D0*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ - &4D0*SQ2*STHE*CCHI*HF2*SIGA+2D0*CTHE*HF2*SIGP - IF(SIG.LT.SIGMAX*PYR(0)) GOTO 100 - - RETURN - END - -C********************************************************************* - -C...PYXJET -C...Selects number of jets in matrix element approach. - - SUBROUTINE PYXJET(ECM,NJET,CUT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local array and data. - DIMENSION ZHUT(5) - DATA ZHUT/3.0922D0, 6.2291D0, 7.4782D0, 7.8440D0, 8.2560D0/ - -C...Trivial result for two-jets only, including parton shower. - IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN - CUT=0D0 - -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=4D0/3D0 - IF(MSTJ(109).EQ.2) CF=1D0 - IF(MSTJ(111).EQ.0) THEN - Q2=ECM**2 - Q2R=ECM**2 - ELSEIF(MSTU(111).EQ.0) THEN - PARJ(169)=MIN(1D0,PARJ(129)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(169)=MIN(1D0,MAX(PARJ(129),(2D0*PARU(112)/ECM)**2)) - Q2=PARJ(169)*ECM**2 - PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, - & (2D0*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - -C...alpha_strong for R and R itself. - ALSPI=(3D0/4D0)*CF*PYALPS(Q2R)/PARU(1) - IF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1D0+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+ - & (33D0-2D0*MSTU(112))/12D0*LOG(PARJ(168))*ALSPI**2) - ELSE - RQCD=1D0+ALSPI-(3D0/32D0+0.519D0*MSTU(118))*(4D0*ALSPI/3D0)**2 - ENDIF - -C...alpha_strong for jet rate. Initial value for y cut. - ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) - CUT=MAX(0.001D0,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.75D0/ALSPI))/2D0) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) - -C...Parametrization of first order three-jet cross-section. - 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25D0) THEN - PARJ(152)=0D0 - ELSE - PARJ(152)=(2D0*ALSPI/3D0)*((3D0-6D0*CUT+2D0*LOG(CUT))* - & LOG(CUT/(1D0-2D0*CUT))+(2.5D0+1.5D0*CUT-6.571D0)* - & (1D0-3D0*CUT)+5.833D0*(1D0-3D0*CUT)**2-3.894D0* - & (1D0-3D0*CUT)**3+1.342D0*(1D0-3D0*CUT)**4)/RQCD - IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) - & PARJ(152)=0D0 - 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.25D0) THEN - PARJ(153)=0D0 - ELSEIF(MSTJ(110).LE.1) THEN - CT=LOG(1D0/CUT-2D0) - PARJ(153)=ALSPI**2*CT**2*(2.419D0+0.5989D0*CT+0.6782D0*CT**2- - & 0.2661D0*CT**3+0.01159D0*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.01D0*IY).LT.0.0001D0) IZA=IY - 110 CONTINUE - IF(IZA.NE.0) THEN - ZHURAT=ZHUT(IZA) - ELSE - IZ=100D0*CUT - ZHURAT=ZHUT(IZ)+(100D0*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.25D0) PARJ(153)=PARJ(153)+ - & (33D0-2D0*MSTU(112))/12D0*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.125D0) THEN - PARJ(154)=0D0 - ELSE - CT=LOG(1D0/CUT-5D0) - IF(CUT.LE.0.018D0) THEN - XQQGG=6.349D0-4.330D0*CT+0.8304D0*CT**2 - IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(3.035D0-2.091D0*CT+ - & 0.4059D0*CT**2) - XQQQQ=1.25D0*(-0.1080D0+0.01486D0*CT+0.009364D0*CT**2) - IF(MSTJ(109).EQ.2) XQQQQ=8D0*XQQQQ - ELSE - XQQGG=-0.09773D0+0.2959D0*CT-0.2764D0*CT**2+0.08832D0*CT**3 - IF(MSTJ(109).EQ.2) XQQGG=(4D0/3D0)**2*(-0.04079D0+ - & 0.1340D0*CT-0.1326D0*CT**2+0.04365D0*CT**3) - XQQQQ=1.25D0*(0.003661D0-0.004888D0*CT-0.001081D0*CT**2+ - & 0.002093D0*CT**3) - IF(MSTJ(109).EQ.2) XQQQQ=8D0*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.0D0.AND. - & PARJ(169).LT.0.99D0) THEN - PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3D0/4D0)*CF*PYALPS(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.0499D0.AND.MSTJ(111).EQ.1.AND. - & PARJ(169).LT.0.99D0) THEN - PARJ(169)=MIN(1D0,1.2D0*PARJ(169)) - Q2=PARJ(169)*ECM**2 - ALSPI=(3D0/4D0)*CF*PYALPS(Q2)/PARU(1) - GOTO 100 - ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499D0) THEN - CALL PYERRM(26, - & '(PYXJET:) no allowed y cut value for Zhu parametrization') - ENDIF - CUT=0.26D0*(4D0*CUT)**(PARJ(152)+PARJ(153)+ - & PARJ(154))**(-1D0/3D0) - IF(MSTJ(110).EQ.2) CUT=MAX(0.01D0,MIN(0.05D0,CUT)) - GOTO 100 - ENDIF - -C...Scalar gluon (first order only). - ELSE - ALSPI=PYALPS(ECM**2)/PARU(1) - CUT=MAX(0.001D0,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3D0/ALSPI)) - PARJ(152)=0D0 - IF(CUT.LT.0.25D0) PARJ(152)=(ALSPI/3D0)*((1D0-2D0*CUT)* - & LOG((1D0-2D0*CUT)/CUT)+0.5D0*(9D0*CUT**2-1D0)) - PARJ(153)=0D0 - PARJ(154)=0D0 - 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=PYR(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********************************************************************* - -C...PYXKFL -C...Selects flavour for produced qqbar pair. - - SUBROUTINE PYXKFL(KFL,ECM,ECMC,KFLC) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -C...Calculate maximum weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RFMAX=4D0/9D0 - ELSE - POLL=1D0-PARJ(131)*PARJ(132) - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECMC)**2) - VE=4D0*PARU(102)-1D0 - HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) - HF1W=SFW*SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) - RFMAX=MAX(4D0/9D0*POLL-4D0/3D0*(1D0-8D0*PARU(102)/3D0)*HF1I+ - & ((1D0-8D0*PARU(102)/3D0)**2+1D0)*HF1W,1D0/9D0*POLL+2D0/3D0* - & (-1D0+4D0*PARU(102)/3D0)*HF1I+((-1D0+4D0*PARU(102)/3D0)**2+ - & 1D0)*HF1W) - ENDIF - -C...Choose flavour. Gives charge and velocity. - NTRY=0 - 100 NTRY=NTRY+1 - IF(NTRY.GT.100) THEN - CALL PYERRM(14,'(PYXKFL:) caught in an infinite loop') - KFLC=0 - RETURN - ENDIF - KFLC=KFL - IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*PYR(0)) - MSTJ(93)=1 - PMQ=PYMASS(KFLC) - IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 100 - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0-(2D0*PMQ/ECMC)**2)) - -C...Calculate weight in QED or QFD case. - IF(MSTJ(102).LE.1) THEN - RF=QF**2 - RFV=0.5D0*VQ*(3D0-VQ**2)*QF**2 - ELSE - VF=SIGN(1D0,QF)-4D0*QF*PARU(102) - RF=QF**2*POLL-2D0*QF*VF*HF1I+(VF**2+1D0)*HF1W - RFV=0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL-2D0*QF*VF*HF1I+VF**2*HF1W)+ - & VQ**3*HF1W - IF(RFV.GT.0D0) PARJ(171)=MIN(1D0,VQ**3*HF1W/RFV) - ENDIF - -C...Weighting or new event (radiative photon). Cross-section update. - IF(KFL.LE.0.AND.RF.LT.PYR(0)*RFMAX) GOTO 100 - PARJ(158)=PARJ(158)+1D0 - IF(ECMC.LT.2D0*PMQ+PARJ(127).OR.RFV.LT.PYR(0)*RF) KFLC=0 - IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 - IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1D0 - PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) - PARJ(148)=PARJ(144)*86.8D0/ECM**2 - - RETURN - END - -C********************************************************************* - -C...PYXTEE -C...Calculates total cross-section, including initial state -C...radiation effects. - - SUBROUTINE PYXTEE(KFL,ECM,XTOT) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -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(1D0,MAX(PARJ(128),EXP(-12D0*PARU(1)/ - & ((33D0-2D0*MSTU(112))*PARU(111))))) - Q2R=PARJ(168)*ECM**2 - ELSE - PARJ(168)=MIN(1D0,MAX(PARJ(128),PARU(112)/ECM, - & (2D0*PARU(112)/ECM)**2)) - Q2R=PARJ(168)*ECM**2 - ENDIF - ALSPI=PYALPS(Q2R)/PARU(1) - -C...QCD corrections factor in R. - IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN - RQCD=1D0 - ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI - ELSEIF(MSTJ(109).EQ.0) THEN - RQCD=1D0+ALSPI+(1.986D0-0.115D0*MSTU(118))*ALSPI**2 - IF(MSTJ(111).EQ.1) RQCD=MAX(1D0,RQCD+(33D0-2D0*MSTU(112))/12D0* - & LOG(PARJ(168))*ALSPI**2) - ELSEIF(IABS(MSTJ(101)).EQ.1) THEN - RQCD=1D0+(3D0/4D0)*ALSPI - ELSE - RQCD=1D0+(3D0/4D0)*ALSPI-(3D0/32D0+0.519D0*MSTU(118))*ALSPI**2 - ENDIF - -C...Calculate Z0 width if default value not acceptable. - IF(MSTJ(102).GE.3) THEN - RVA=3D0*(3D0+(4D0*PARU(102)-1D0)**2)+6D0*RQCD*(2D0+ - & (1D0-8D0*PARU(102)/3D0)**2+(4D0*PARU(102)/3D0-1D0)**2) - DO 100 KFLC=5,6 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0D0,1D0- - & (2D0*PYMASS(KFLC)/ ECM)**2)) - IF(KFLC.EQ.5) VF=4D0*PARU(102)/3D0-1D0 - IF(KFLC.EQ.6) VF=1D0-8D0*PARU(102)/3D0 - RVA=RVA+3D0*RQCD*(0.5D0*VQ*(3D0-VQ**2)*VF**2+VQ**3) - 100 CONTINUE - PARJ(124)=PARU(101)*PARJ(123)*RVA/(48D0*PARU(102)* - & (1D0-PARU(102))) - ENDIF - -C...Calculate propagator and related constants for QFD case. - POLL=1D0-PARJ(131)*PARJ(132) - IF(MSTJ(102).GE.2) THEN - SFF=1D0/(16D0*PARU(102)*(1D0-PARU(102))) - SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) - SFI=SFW*(1D0-(PARJ(123)/ECM)**2) - VE=4D0*PARU(102)-1D0 - SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) - SF1W=SFF**2*((VE**2+1D0)*POLL+2D0*VE*(PARJ(132)-PARJ(131))) - HF1I=SFI*SF1I - HF1W=SFW*SF1W - ENDIF - -C...Loop over different flavours: charge, velocity. - RTOT=0D0 - RQQ=0D0 - RQV=0D0 - RVA=0D0 - DO 110 KFLC=1,MAX(MSTJ(104),KFL) - IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 - MSTJ(93)=1 - PMQ=PYMASS(KFLC) - IF(ECM.LT.2D0*PMQ+PARJ(127)) GOTO 110 - QF=KCHG(KFLC,1)/3D0 - VQ=1D0 - IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1D0-(2D0*PMQ/ECM)**2) - -C...Calculate R and sum of charges for QED or QFD case. - RQQ=RQQ+3D0*QF**2*POLL - IF(MSTJ(102).LE.1) THEN - RTOT=RTOT+3D0*0.5D0*VQ*(3D0-VQ**2)*QF**2*POLL - ELSE - VF=SIGN(1D0,QF)-4D0*QF*PARU(102) - RQV=RQV-6D0*QF*VF*SF1I - RVA=RVA+3D0*(VF**2+1D0)*SF1W - RTOT=RTOT+3D0*(0.5D0*VQ*(3D0-VQ**2)*(QF**2*POLL- - & 2D0*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.8D0/ECM**2 - PARJ(146)=PARJ(142)*86.8D0/ECM**2 - PARJ(147)=PARJ(143)*86.8D0/ECM**2 - PARJ(148)=PARJ(147) - PARJ(157)=RSUM*RQCD - PARJ(158)=0D0 - PARJ(159)=0D0 - XTOT=PARJ(147) - IF(MSTJ(107).LE.0) RETURN - -C...Virtual cross-section. - XKL=PARJ(135) - XKU=MIN(PARJ(136),1D0-(2D0*PARJ(127)/ECM)**2) - ALE=2D0*LOG(ECM/PYMASS(11))-1D0 - SIGV=ALE/3D0+2D0*LOG(ECM**2/(PYMASS(13)*PYMASS(15)))/3D0-4D0/3D0+ - &1.526D0*LOG(ECM**2/0.932D0) - -C...Soft and hard radiative cross-section in QED case. - IF(MSTJ(102).LE.1) THEN - SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+2D0*SIGV - SIGS=ALE*(2D0*LOG(XKL)-LOG(1D0-XKL)-XKL) - SIGH=ALE*(2D0*LOG(XKU/XKL)-LOG((1D0-XKU)/(1D0-XKL))-(XKU-XKL)) - -C...Soft and hard radiative cross-section in QFD case. - ELSE - SZM=1D0-(PARJ(123)/ECM)**2 - SZW=PARJ(123)*PARJ(124)/ECM**2 - PARJ(161)=-RQQ/RSUM - PARJ(162)=-(RQQ+RQV+RVA)/RSUM - PARJ(163)=(RQV*(1D0-0.5D0*SZM-SFI)+RVA*(1.5D0-SZM-SFW))/RSUM - PARJ(164)=(RQV*SZW**2*(1D0-2D0*SFW)+RVA*(2D0*SFI+SZW**2- - & 4D0+3D0*SZM-SZM**2))/(SZW*RSUM) - SIGV=1.5D0*ALE-0.5D0+PARU(1)**2/3D0+((2D0*RQQ+SFI*RQV)/ - & RSUM)*SIGV+(SZW*SFW*RQV/RSUM)*PARU(1)*20D0/9D0 - SIGS=ALE*(2D0*LOG(XKL)+PARJ(161)*LOG(1D0-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*(2D0*LOG(XKU/XKL)+PARJ(161)*LOG((1D0-XKU)/ - & (1D0-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*(1D0+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD - PARJ(144)=PARJ(157) - PARJ(148)=PARJ(144)*86.8D0/ECM**2 - XTOT=PARJ(148) - - RETURN - END - -C********************************************************************* - -C...PYXTOT -C...Parametrizes total, elastic and diffractive cross-sections -C...for different energies and beams. Donnachie-Landshoff for -C...total and Schuler-Sjostrand for elastic and diffractive. -C...Process code IPROC: -C...= 1 : p + p; -C...= 2 : pbar + p; -C...= 3 : pi+ + p; -C...= 4 : pi- + p; -C...= 5 : pi0 + p; -C...= 6 : phi + p; -C...= 7 : J/psi + p; -C...= 11 : rho + rho; -C...= 12 : rho + phi; -C...= 13 : rho + J/psi; -C...= 14 : phi + phi; -C...= 15 : phi + J/psi; -C...= 16 : J/psi + J/psi; -C...= 21 : gamma + p (DL); -C...= 22 : gamma + p (VDM). -C...= 23 : gamma + pi (DL); -C...= 24 : gamma + pi (VDM); -C...= 25 : gamma + gamma (DL); -C...= 26 : gamma + gamma (VDM). - - SUBROUTINE PYXTOT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) - COMMON/PYINT1/MINT(400),VINT(400) - COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) - COMMON/PYINT7/SIGT(0:6,0:6,0:5) - SAVE /PYDAT1/,/PYDAT2/,/PYPARS/,/PYINT1/,/PYINT5/,/PYINT7/ -C...Local arrays. - DIMENSION NPROC(30),XPAR(30),YPAR(30),IHADA(20),IHADB(20), - &PMHAD(4),BHAD(4),BETP(4),IFITSD(20),IFITDD(20),CEFFS(10,8), - &CEFFD(10,9),SIGTMP(6,0:5) - -C...Common constants. - DATA EPS/0.0808D0/, ETA/-0.4525D0/, ALP/0.25D0/, CRES/2D0/, - &PMRC/1.062D0/, SMP/0.880D0/, FACEL/0.0511D0/, FACSD/0.0336D0/, - &FACDD/0.0084D0/ - -C...Number of multiple processes to be evaluated (= 0 : undefined). - DATA NPROC/7*1,3*0,6*1,4*0,4*3,2*6,4*0/ -C...X and Y parameters of sigmatot = X * s**epsilon + Y * s**(-eta). - DATA XPAR/2*21.70D0,3*13.63D0,10.01D0,0.970D0,3*0D0, - &8.56D0,6.29D0,0.609D0,4.62D0,0.447D0,0.0434D0,4*0D0, - &0.0677D0,0.0534D0,0.0425D0,0.0335D0,2.11D-4,1.31D-4,4*0D0/ - DATA YPAR/ - &56.08D0,98.39D0,27.56D0,36.02D0,31.79D0,-1.51D0,-0.146D0,3*0D0, - &13.08D0,-0.62D0,-0.060D0,0.030D0,-0.0028D0,0.00028D0,4*0D0, - &0.129D0,0.115D0,0.081D0,0.072D0,2.15D-4,1.70D-4,4*0D0/ - -C...Beam and target hadron class: -C...= 1 : p/n ; = 2 : pi/rho/omega; = 3 : phi; = 4 : J/psi. - DATA IHADA/2*1,3*2,3,4,3*0,3*2,2*3,4,4*0/ - DATA IHADB/7*1,3*0,2,3,4,3,2*4,4*0/ -C...Characteristic class masses, slope parameters, beta = sqrt(X). - DATA PMHAD/0.938D0,0.770D0,1.020D0,3.097D0/ - DATA BHAD/2.3D0,1.4D0,1.4D0,0.23D0/ - DATA BETP/4.658D0,2.926D0,2.149D0,0.208D0/ - -C...Fitting constants used in parametrizations of diffractive results. - DATA IFITSD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ - DATA IFITDD/2*1,3*2,3,4,3*0,5,6,7,8,9,10,4*0/ - DATA ((CEFFS(J1,J2),J2=1,8),J1=1,10)/ - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.213D0, 0.0D0, -0.47D0, 150D0, - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.267D0, 0.0D0, -0.47D0, 100D0, - &0.213D0, 0.0D0, -0.47D0, 150D0, 0.232D0, 0.0D0, -0.47D0, 110D0, - &0.213D0, 7.0D0, -0.55D0, 800D0, 0.115D0, 0.0D0, -0.47D0, 110D0, - &0.267D0, 0.0D0, -0.46D0, 75D0, 0.267D0, 0.0D0, -0.46D0, 75D0, - &0.232D0, 0.0D0, -0.46D0, 85D0, 0.267D0, 0.0D0, -0.48D0, 100D0, - &0.115D0, 0.0D0, -0.50D0, 90D0, 0.267D0, 6.0D0, -0.56D0, 420D0, - &0.232D0, 0.0D0, -0.48D0, 110D0, 0.232D0, 0.0D0, -0.48D0, 110D0, - &0.115D0, 0.0D0, -0.52D0, 120D0, 0.232D0, 6.0D0, -0.56D0, 470D0, - &0.115D0, 5.5D0, -0.58D0, 570D0, 0.115D0, 5.5D0, -0.58D0, 570D0/ - DATA ((CEFFD(J1,J2),J2=1,9),J1=1,10)/ - &3.11D0, -7.34D0, 9.71D0, 0.068D0, -0.42D0, 1.31D0, - &-1.37D0, 35.0D0, 118D0, 3.11D0, -7.10D0, 10.6D0, - &0.073D0, -0.41D0, 1.17D0, -1.41D0, 31.6D0, 95D0, - &3.12D0, -7.43D0, 9.21D0, 0.067D0, -0.44D0, 1.41D0, - &-1.35D0, 36.5D0, 132D0, 3.13D0, -8.18D0, -4.20D0, - &0.056D0, -0.71D0, 3.12D0, -1.12D0, 55.2D0, 1298D0, - &3.11D0, -6.90D0, 11.4D0, 0.078D0, -0.40D0, 1.05D0, - &-1.40D0, 28.4D0, 78D0, 3.11D0, -7.13D0, 10.0D0, - &0.071D0, -0.41D0, 1.23D0, -1.34D0, 33.1D0, 105D0, - &3.12D0, -7.90D0, -1.49D0, 0.054D0, -0.64D0, 2.72D0, - &-1.13D0, 53.1D0, 995D0, 3.11D0, -7.39D0, 8.22D0, - &0.065D0, -0.44D0, 1.45D0, -1.36D0, 38.1D0, 148D0, - &3.18D0, -8.95D0, -3.37D0, 0.057D0, -0.76D0, 3.32D0, - &-1.12D0, 55.6D0, 1472D0, 4.18D0, -29.2D0, 56.2D0, - &0.074D0, -1.36D0, 6.67D0, -1.14D0, 116.2D0, 6532D0/ - -C...Parameters. Combinations of the energy. - AEM=PARU(101) - PMTH=PARP(102) - S=VINT(2) - SRT=VINT(1) - SEPS=S**EPS - SETA=S**ETA - SLOG=LOG(S) - -C...Ratio of gamma/pi (for rescaling in parton distributions). - VINT(281)=(XPAR(22)*SEPS+YPAR(22)*SETA)/ - &(XPAR(5)*SEPS+YPAR(5)*SETA) - VINT(317)=1D0 - IF(MINT(50).NE.1) RETURN - -C...Order flavours of incoming particles: KF1 < KF2. - IF(IABS(MINT(11)).LE.IABS(MINT(12))) THEN - KF1=IABS(MINT(11)) - KF2=IABS(MINT(12)) - IORD=1 - ELSE - KF1=IABS(MINT(12)) - KF2=IABS(MINT(11)) - IORD=2 - ENDIF - ISGN12=ISIGN(1,MINT(11)*MINT(12)) - -C...Find process number (for lookup tables). - IF(KF1.GT.1000) THEN - IPROC=1 - IF(ISGN12.LT.0) IPROC=2 - ELSEIF(KF1.GT.100.AND.KF2.GT.1000) THEN - IPROC=3 - IF(ISGN12.LT.0) IPROC=4 - IF(KF1.EQ.111) IPROC=5 - ELSEIF(KF1.GT.100) THEN - IPROC=11 - ELSEIF(KF2.GT.1000) THEN - IPROC=21 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=22 - ELSEIF(KF2.GT.100) THEN - IPROC=23 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3) IPROC=24 - ELSE - IPROC=25 - IF(MINT(123).EQ.2.OR.MINT(123).EQ.3.OR.MINT(123).EQ.7) IPROC=26 - ENDIF - -C... Number of multiple processes to be stored; beam/target side. - NPR=NPROC(IPROC) - MINT(101)=1 - MINT(102)=1 - IF(NPR.EQ.3) THEN - MINT(100+IORD)=4 - ELSEIF(NPR.EQ.6) THEN - MINT(101)=4 - MINT(102)=4 - ENDIF - N1=0 - IF(MINT(101).EQ.4) N1=4 - N2=0 - IF(MINT(102).EQ.4) N2=4 - -C...Do not do any more for user-set or undefined cross-sections. - IF(MSTP(31).LE.0) RETURN - IF(NPR.EQ.0) CALL PYERRM(26, - &'(PYXTOT:) cross section for this process not yet implemented') - -C...Parameters. Combinations of the energy. - AEM=PARU(101) - PMTH=PARP(102) - S=VINT(2) - SRT=VINT(1) - SEPS=S**EPS - SETA=S**ETA - SLOG=LOG(S) - -C...Loop over multiple processes (for VDM). - DO 110 I=1,NPR - IF(NPR.EQ.1) THEN - IPR=IPROC - ELSEIF(NPR.EQ.3) THEN - IPR=I+4 - IF(KF2.LT.1000) IPR=I+10 - ELSEIF(NPR.EQ.6) THEN - IPR=I+10 - ENDIF - -C...Evaluate hadron species, mass, slope contribution and fit number. - IHA=IHADA(IPR) - IHB=IHADB(IPR) - PMA=PMHAD(IHA) - PMB=PMHAD(IHB) - BHA=BHAD(IHA) - BHB=BHAD(IHB) - ISD=IFITSD(IPR) - IDD=IFITDD(IPR) - -C...Skip if energy too low relative to masses. - DO 100 J=0,5 - SIGTMP(I,J)=0D0 - 100 CONTINUE - IF(SRT.LT.PMA+PMB+PARP(104)) GOTO 110 - -C...Total cross-section. Elastic slope parameter and cross-section. - SIGTMP(I,0)=XPAR(IPR)*SEPS+YPAR(IPR)*SETA -C...P.L. elastic slope parameter different for rho and phi - IF(IHA.eq.2) then - PMVIRT=0.76849997 -C BEL=5.84/(1+(1/2.17)*(VINT(307)/(PMVIRT**2))**0.74)+4.5 -C To make things consistent with the calculation of R -C use PARP 165 / 166 - BEL=5.84/(1+(PARP(165))*(VINT(307)/(PMVIRT**2))**PARP(166))+4.5 -C ELSEIF(IHA.eq.3) then -C BEL=4.D0 - ELSE - BEL=2D0*BHA+2D0*BHB+4D0*SEPS-4.2D0 - ENDIF - SIGTMP(I,1)=FACEL*SIGTMP(I,0)**2/BEL -C...Diffractive scattering A + B -> X + B. - BSD=2D0*BHB - SQML=(PMA+PMTH)**2 - SQMU=S*CEFFS(ISD,1)+CEFFS(ISD,2) - SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ - & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) - BXB=CEFFS(ISD,3)+CEFFS(ISD,4)/S - SUM2=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)/ - & (BSD+2D0*ALP*LOG(S/((PMA+PMTH)*(PMA+PMRC)))+BXB) - SIGTMP(I,2)=FACSD*XPAR(IPR)*BETP(IHB)*MAX(0D0,SUM1+SUM2) - -C...Diffractive scattering A + B -> A + X. - BSD=2D0*BHA - SQML=(PMB+PMTH)**2 - SQMU=S*CEFFS(ISD,5)+CEFFS(ISD,6) - SUM1=LOG((BSD+2D0*ALP*LOG(S/SQML))/ - & (BSD+2D0*ALP*LOG(S/SQMU)))/(2D0*ALP) - BAX=CEFFS(ISD,7)+CEFFS(ISD,8)/S - SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/ - & (BSD+2D0*ALP*LOG(S/((PMB+PMTH)*(PMB+PMRC)))+BAX) - SIGTMP(I,3)=FACSD*XPAR(IPR)*BETP(IHA)*MAX(0D0,SUM1+SUM2) - -C...Order single diffractive correctly. - IF(IORD.EQ.2) THEN - SIGSAV=SIGTMP(I,2) - SIGTMP(I,2)=SIGTMP(I,3) - SIGTMP(I,3)=SIGSAV - ENDIF - -C...Double diffractive scattering A + B -> X1 + X2. - YEFF=LOG(S*SMP/((PMA+PMTH)*(PMB+PMTH))**2) - DEFF=CEFFD(IDD,1)+CEFFD(IDD,2)/SLOG+CEFFD(IDD,3)/SLOG**2 - SUM1=DEFF+YEFF*(LOG(MAX(1D-10,YEFF/DEFF))-1D0)/(2D0*ALP) - IF(YEFF.LE.0) SUM1=0D0 - SQMU=S*(CEFFD(IDD,4)+CEFFD(IDD,5)/SLOG+CEFFD(IDD,6)/SLOG**2) - SLUP=LOG(MAX(1.1D0,S/(ALP*(PMA+PMTH)**2*(PMB+PMTH)*(PMB+PMRC)))) - SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMB+PMTH)*(PMB+PMRC)))) - SUM2=CRES*LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)*LOG(SLUP/SLDN)/ - & (2D0*ALP) - SLUP=LOG(MAX(1.1D0,S/(ALP*(PMB+PMTH)**2*(PMA+PMTH)*(PMA+PMRC)))) - SLDN=LOG(MAX(1.1D0,S/(ALP*SQMU*(PMA+PMTH)*(PMA+PMRC)))) - SUM3=CRES*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)*LOG(SLUP/SLDN)/ - & (2D0*ALP) - BXX=CEFFD(IDD,7)+CEFFD(IDD,8)/SRT+CEFFD(IDD,9)/S - SLRR=LOG(S/(ALP*(PMA+PMTH)*(PMA+PMRC)*(PMB+PMTH)*(PMB*PMRC))) - SUM4=CRES**2*LOG(1D0+((PMA+PMRC)/(PMA+PMTH))**2)* - & LOG(1D0+((PMB+PMRC)/(PMB+PMTH))**2)/MAX(0.1D0,2D0*ALP*SLRR+BXX) - SIGTMP(I,4)=FACDD*XPAR(IPR)*MAX(0D0,SUM1+SUM2+SUM3+SUM4) - -C...Non-diffractive by unitarity. - SIGTMP(I,5)=SIGTMP(I,0)-SIGTMP(I,1)-SIGTMP(I,2)-SIGTMP(I,3)- - & SIGTMP(I,4) - 110 CONTINUE - -C...Put temporary results in output array: only one process. - IF(MINT(101).EQ.1.AND.MINT(102).EQ.1) THEN - DO 120 J=0,5 - SIGT(0,0,J)=SIGTMP(1,J) - 120 CONTINUE - -C...Beam multiple processes. - ELSEIF(MINT(101).EQ.4.AND.MINT(102).EQ.1) THEN - IF(MINT(107).EQ.2) THEN - IF(MSTP(20).EQ.0) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.575 - ENDIF - IF(MSTP(20).GT.0) THEN -C VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.0 - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2.575 - ENDIF - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)))**MSTP(20) - ENDIF - DO 140 I=1,4 - IF(MINT(107).EQ.2) THEN - CONV=(AEM/PARP(160+I))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - I1=MAX(1,I-1) - DO 130 J=0,5 - SIGT(I,0,J)=CONV*SIGTMP(I1,J) - 130 CONTINUE - 140 CONTINUE - DO 150 J=0,5 - SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) - 150 CONTINUE - -C...Target multiple processes. - ELSEIF(MINT(101).EQ.1.AND.MINT(102).EQ.4) THEN - IF(MINT(108).EQ.2) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(308)))**MSTP(20) - ENDIF - DO 170 I=1,4 - IF(MINT(108).EQ.2) THEN - CONV=(AEM/PARP(160+I))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - IV=MAX(1,I-1) - DO 160 J=0,5 - SIGT(0,I,J)=CONV*SIGTMP(IV,J) - 160 CONTINUE - 170 CONTINUE - DO 180 J=0,5 - SIGT(0,0,J)=SIGT(0,1,J)+SIGT(0,2,J)+SIGT(0,3,J)+SIGT(0,4,J) - 180 CONTINUE - -C...Both beam and target multiple processes. - ELSE - IF(MINT(107).EQ.2) THEN - VINT(317)=(PMHAD(2)**2/(PMHAD(2)**2+VINT(307)))**2 - ELSE - VINT(317)=16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(307))*(4D0*VINT(154)**2+VINT(307))) - ENDIF - IF(MINT(108).EQ.2) THEN - VINT(317)=VINT(317)*(PMHAD(2)**2/(PMHAD(2)**2+VINT(308)))**2 - ELSE - VINT(317)=VINT(317)*16D0*PARP(15)**2*VINT(154)**2/ - & ((4D0*PARP(15)**2+VINT(308))*(4D0*VINT(154)**2+VINT(308))) - ENDIF - IF(MSTP(20).GT.0) THEN - VINT(317)=VINT(317)*(VINT(2)/(VINT(2)+VINT(307)+ - & VINT(308)))**MSTP(20) - ENDIF - DO 210 I1=1,4 - DO 200 I2=1,4 - IF(MINT(107).EQ.2) THEN - CONV=(AEM/PARP(160+I1))*VINT(317) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=(AEM/PARU(1))*(KCHG(I1,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2)*VINT(317) - ELSE - CONV=0D0 - ENDIF - IF(MINT(108).EQ.2) THEN - CONV=CONV*(AEM/PARP(160+I2)) - ELSEIF(VINT(154).GT.PARP(15)) THEN - CONV=CONV*(AEM/PARU(1))*(KCHG(I2,1)/3D0)**2*PARP(18)**2* - & (1D0/PARP(15)**2-1D0/VINT(154)**2) - ELSE - CONV=0D0 - ENDIF - IF(I1.LE.2) THEN - IV=MAX(1,I2-1) - ELSEIF(I2.LE.2) THEN - IV=MAX(1,I1-1) - ELSEIF(I1.EQ.I2) THEN - IV=2*I1-2 - ELSE - IV=5 - ENDIF - DO 190 J=0,5 - JV=J - IF(I2.GT.I1.AND.(J.EQ.2.OR.J.EQ.3)) JV=5-J - SIGT(I1,I2,J)=CONV*SIGTMP(IV,JV) - 190 CONTINUE - 200 CONTINUE - 210 CONTINUE - DO 230 J=0,5 - DO 220 I=1,4 - SIGT(I,0,J)=SIGT(I,1,J)+SIGT(I,2,J)+SIGT(I,3,J)+SIGT(I,4,J) - SIGT(0,I,J)=SIGT(1,I,J)+SIGT(2,I,J)+SIGT(3,I,J)+SIGT(4,I,J) - 220 CONTINUE - SIGT(0,0,J)=SIGT(1,0,J)+SIGT(2,0,J)+SIGT(3,0,J)+SIGT(4,0,J) - 230 CONTINUE - ENDIF - -C...Scale up uniformly for Donnachie-Landshoff parametrization. - IF(IPROC.EQ.21.OR.IPROC.EQ.23.OR.IPROC.EQ.25) THEN - RFAC=(XPAR(IPROC)*SEPS+YPAR(IPROC)*SETA)/SIGT(0,0,0) - DO 260 I1=0,N1 - DO 250 I2=0,N2 - DO 240 J=0,5 - SIGT(I1,I2,J)=RFAC*SIGT(I1,I2,J) - 240 CONTINUE - 250 CONTINUE - 260 CONTINUE - ENDIF - - RETURN - END - - -C********************************************************************* - -C...PYXXGA -C...Calculates chi0_i -> chi0_j + gamma. - - FUNCTION PYXXGA(C0,XM1,XM2,XMTR,XMTL) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP - -C...Local variables. - DOUBLE PRECISION PYXXGA,C0,XM1,XM2,XMTR,XMTL - DOUBLE PRECISION F1,F2 - - F1=(1D0+XMTR/(1D0-XMTR)*LOG(XMTR))/(1D0-XMTR) - F2=(1D0+XMTL/(1D0-XMTL)*LOG(XMTL))/(1D0-XMTL) - PYXXGA=C0*((XM1**2-XM2**2)/XM1)**3 - PYXXGA=PYXXGA*(2D0/3D0*(F1+F2)-13D0/12D0)**2 - - RETURN - END - -C********************************************************************* - -C...PYXXZ6 -C...Used in the calculation of inoi -> inoj + f + ~f. - - FUNCTION PYXXZ6(X) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Parameter statement to help give large particle numbers. - PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000, - &KEXCIT=4000000,KDIMEN=5000000) -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) -C COMMON/PYINTS/XXM(20) - COMPLEX*16 CXC - COMMON/PYINTC/XXC(10),CXC(8) - SAVE /PYDAT1/,/PYINTC/ - -C...Local variables. - COMPLEX*16 QLLS,QRRS,QRLS,QLRS,QLLU,QRRU,QLRT,QRLT - DOUBLE PRECISION PYXXZ6,X - DOUBLE PRECISION XM12,XM22,XM32,S,S13,WPROP2 - DOUBLE PRECISION WW,WF1,WF2,WFL1,WFL2 - DOUBLE PRECISION SIJ - DOUBLE PRECISION XMV,XMG,XMSU1,XMSU2,XMSD1,XMSD2 - DOUBLE PRECISION OL2 - DOUBLE PRECISION S23MIN,S23MAX,S23AVE,S23DEL - INTEGER I - -C...Statement functions. -C...Integral from x to y of (t-a)(b-t) dt. - TINT(X,Y,A,B)=(X-Y)*(-(X**2+X*Y+Y**2)/3D0+(B+A)*(X+Y)/2D0-A*B) -C...Integral from x to y of (t-a)(b-t)/(t-c) dt. - TINT2(X,Y,A,B,C)=(X-Y)*(-0.5D0*(X+Y)+(B+A-C))- - &LOG(ABS((X-C)/(Y-C)))*(C-B)*(C-A) -C...Integral from x to y of (t-a)(b-t)/(t-c)**2 dt. - TINT3(X,Y,A,B,C)=-(X-Y)+(C-A)*(C-B)*(Y-X)/(X-C)/(Y-C)+ - &(B+A-2D0*C)*LOG(ABS((X-C)/(Y-C))) -C...Integral from x to y of (t-a)/(b-t) dt. - UTINT(X,Y,A,B)=LOG(ABS((X-A)/(B-X)*(B-Y)/(Y-A)))/(B-A) -C...Integral from x to y of 1/(t-a) dt. - TPROP(X,Y,A)=LOG(ABS((X-A)/(Y-A))) - - XM12=XXC(1)**2 - XM22=XXC(2)**2 - XM32=XXC(3)**2 - S=XXC(4)**2 - S13=X - - S23AVE=XM22+XM32-0.5D0/X*(X+XM32-XM12)*(X+XM22-S) - S23DEL=0.5D0/X*SQRT( ( (X-XM12-XM32)**2-4D0*XM12*XM32)* - &( (X-XM22-S)**2 -4D0*XM22*S ) ) - - S23MIN=(S23AVE-S23DEL) - S23MAX=(S23AVE+S23DEL) - - XMSD1=XXC(5)**2 - XMSD2=XXC(7)**2 - XMSU1=XXC(6)**2 - XMSU2=XXC(8)**2 - - XMV=XXC(9) - XMG=XXC(10) - QLLS=CXC(1) - QLLU=CXC(2) - QLRS=CXC(3) - QLRT=CXC(4) - QRLS=CXC(5) - QRLT=CXC(6) - QRRS=CXC(7) - QRRU=CXC(8) - WPROP2=(S13-XMV**2)**2+(XMV*XMG)**2 - SIJ=2D0*XXC(2)*XXC(4)*S13 - IF(XMV.LE.1000D0) THEN - OL2=ABS(QLLS)**2+ABS(QRRS)**2+ABS(QLRS)**2+ABS(QRLS)**2 - OLR=-2D0*DBLE(QLRS*DCONJG(QLLS)+QRLS*DCONJG(QRRS)) - WW=(OL2*2D0*TINT(S23MAX,S23MIN,XM22,S) - & +OLR*SIJ*(S23MAX-S23MIN))/WPROP2 - IF(XXC(5).LE.10000D0) THEN - WFL1=4D0*(DBLE(QLLS*DCONJG(QLLU))* - & TINT2(S23MAX,S23MIN,XM22,S,XMSD1)- - & .5D0*DBLE(QLLS*DCONJG(QLRT))*SIJ*TPROP(S23MAX,S23MIN,XMSD2)+ - & DBLE(QLRS*DCONJG(QLRT))*TINT2(S23MAX,S23MIN,XM22,S,XMSD2)- - & .5D0*DBLE(QLRS*DCONJG(QLLU))*SIJ*TPROP(S23MAX,S23MIN,XMSD1)) - & *(S13-XMV**2)/WPROP2 - ELSE - WFL1=0D0 - ENDIF - - IF(XXC(6).LE.10000D0) THEN - WFL2=4D0*(DBLE(QRRS*DCONJG(QRRU))* - & TINT2(S23MAX,S23MIN,XM22,S,XMSU1)- - & .5D0*DBLE(QRRS*DCONJG(QRLT))*SIJ*TPROP(S23MAX,S23MIN,XMSU2)+ - & DBLE(QRLS*DCONJG(QRLT))*TINT2(S23MAX,S23MIN,XM22,S,XMSU2)- - & .5D0*DBLE(QRLS*DCONJG(QRRU))*SIJ*TPROP(S23MAX,S23MIN,XMSU1)) - & *(S13-XMV**2)/WPROP2 - ELSE - WFL2=0D0 - ENDIF - ELSE - WW=0D0 - WFL1=0D0 - WFL2=0D0 - ENDIF - IF(XXC(5).LE.10000D0) THEN - WF1=2D0*ABS(QLLU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD1) - & +2D0*ABS(QLRT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSD2) - & - 2D0*DBLE(QLRT*DCONJG(QLLU))* - & SIJ*UTINT(S23MAX,S23MIN,XMSD1,XM22+S-S13-XMSD2) - ELSE - WF1=0D0 - ENDIF - IF(XXC(6).LE.10000D0) THEN - WF2=2D0*ABS(QRRU)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU1) - & +2D0*ABS(QRLT)**2*TINT3(S23MAX,S23MIN,XM22,S,XMSU2) - & - 2D0*DBLE(QRLT*DCONJG(QRRU))* - & SIJ*UTINT(S23MAX,S23MIN,XMSU1,XM22+S-S13-XMSU2) - ELSE - WF2=0D0 - ENDIF - - PYXXZ6=(WW+WF1+WF2+WFL1+WFL2) - - IF(PYXXZ6.LT.0D0) THEN - WRITE(MSTU(11),*) ' NEGATIVE WT IN PYXXZ6 ' - WRITE(MSTU(11),*) XXc(1),XXc(2),XXc(3),XXc(4) - WRITE(MSTU(11),*) (XXc(I),I=5,8) - WRITE(MSTU(11),*) (XXc(I),I=9,12) - WRITE(MSTU(11),*) (XXc(I),I=13,16) - WRITE(MSTU(11),*) WW,WF1,WF2,WFL1,WFL2 - WRITE(MSTU(11),*) S23MIN,S23MAX - PYXXZ6=0D0 - ENDIF - - RETURN - END - -C********************************************************************* - -C...PYZDIS -C...Generates the longitudinal splitting variable z. - - SUBROUTINE PYZDIS(KFL1,KFL2,PR,Z) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4) - SAVE /PYDAT1/,/PYDAT2/ - -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=1D0 - IF(KFLA.GE.10) FC=FC-PARJ(45) - IF(KFLB.GE.10) FC=FC+PARJ(45) - IF(MSTJ(11).GE.4.AND.(KFLH.EQ.4.OR.KFLH.EQ.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 - ENDIF - MC=1 - IF(ABS(FC-1D0).GT.0.01D0) MC=2 - -C...Determine position of maximum. Special cases for a = 0 or a = c. - IF(FA.LT.0.02D0) THEN - MA=1 - ZMAX=1D0 - IF(FC.GT.FB) ZMAX=FB/FC - ELSEIF(ABS(FC-FA).LT.0.01D0) THEN - MA=2 - ZMAX=FB/(FB+FC) - ELSE - MA=3 - ZMAX=0.5D0*(FB+FC-SQRT((FB-FC)**2+4D0*FA*FB))/(FC-FA) - IF(ZMAX.GT.0.9999D0.AND.FB.GT.100D0) ZMAX=MIN(ZMAX,1D0-FA/FB) - ENDIF - -C...Subdivide z range if distribution very peaked near endpoint. - MMAX=2 - IF(ZMAX.LT.0.1D0) THEN - MMAX=1 - ZDIV=2.75D0*ZMAX - IF(MC.EQ.1) THEN - FINT=1D0-LOG(ZDIV) - ELSE - ZDIVC=ZDIV**(1D0-FC) - FINT=1D0+(1D0-1D0/ZDIVC)/(FC-1D0) - ENDIF - ELSEIF(ZMAX.GT.0.85D0.AND.FB.GT.1D0) THEN - MMAX=3 - FSCB=SQRT(4D0+(FC/FB)**2) - ZDIV=FSCB-1D0/ZMAX-(FC/FB)*LOG(ZMAX*0.5D0*(FSCB+FC/FB)) - IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1D0-ZMAX) - ZDIV=MIN(ZMAX,MAX(0D0,ZDIV)) - FINT=1D0+FB*(1D0-ZDIV) - ENDIF - -C...Choice of z, preweighted for peaks at low or high z. - 100 Z=PYR(0) - FPRE=1D0 - IF(MMAX.EQ.1) THEN - IF(FINT*PYR(0).LE.1D0) THEN - Z=ZDIV*Z - ELSEIF(MC.EQ.1) THEN - Z=ZDIV**Z - FPRE=ZDIV/Z - ELSE - Z=(ZDIVC+Z*(1D0-ZDIVC))**(1D0/(1D0-FC)) - FPRE=(ZDIV/Z)**FC - ENDIF - ELSEIF(MMAX.EQ.3) THEN - IF(FINT*PYR(0).LE.1D0) THEN - Z=ZDIV+LOG(Z)/FB - FPRE=EXP(FB*(Z-ZDIV)) - ELSE - Z=ZDIV+Z*(1D0-ZDIV) - ENDIF - ENDIF - -C...Weighting according to correct formula. - IF(Z.LE.0D0.OR.Z.GE.1D0) GOTO 100 - FEXP=FC*LOG(ZMAX/Z)+FB*(1D0/ZMAX-1D0/Z) - IF(MA.GE.2) FEXP=FEXP+FA*LOG((1D0-Z)/(1D0-ZMAX)) - FVAL=EXP(MAX(-50D0,MIN(50D0,FEXP))) - IF(FVAL.LT.PYR(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=PYR(0) - IF(FC.GE.0D0.AND.FC.LE.1D0) THEN - IF(FC.GT.PYR(0)) Z=1D0-Z**(1D0/3D0) - ELSEIF(FC.GT.-1.AND.FC.LT.0D0) THEN - IF(-4D0*FC*Z*(1D0-Z)**2.LT.PYR(0)*((1D0-Z)**2-FC*Z)**2) - & GOTO 110 - ELSE - IF(FC.GT.0D0) Z=1D0-Z**(1D0/FC) - IF(FC.LT.0D0) Z=Z**(-1D0/FC) - ENDIF - ENDIF - - RETURN - END - -C********************************************************************* - -C...STRUCTM -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE STRUCTM(XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local variables - DOUBLE PRECISION XX,QQ,UPV,DNV,USEA,DSEA,STR,CHM,BOT,TOP,GLU - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - UPV=XX+QQ - DNV=XX+2D0*QQ - USEA=XX+3D0*QQ - DSEA=XX+4D0*QQ - STR=XX+5D0*QQ - CHM=XX+6D0*QQ - BOT=XX+7D0*QQ - TOP=XX+8D0*QQ - GLU=XX+9D0*QQ - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine STRUCTM in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...STRUCTP -C...Dummy routine, to be removed when PDFLIB is to be linked. - - SUBROUTINE STRUCTP(XX,QQ2,P2,IP2,UPV,DNV,USEA,DSEA,STR,CHM, - &BOT,TOP,GLU) - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - INTEGER PYK,PYCHGE,PYCOMP -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ -C...Local variables - DOUBLE PRECISION XX,QQ2,P2,UPV,DNV,USEA,DSEA,STR,CHM,BOT, - &TOP,GLU - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - UPV=XX+QQ2 - DNV=XX+2D0*QQ2 - USEA=XX+3D0*QQ2 - DSEA=XX+4D0*QQ2 - STR=XX+5D0*QQ2 - CHM=XX+6D0*QQ2 - BOT=XX+7D0*QQ2 - TOP=XX+8D0*QQ2 - GLU=XX+9D0*QQ2 - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link PDFLIB correctly.'/ - &1X,'Dummy routine STRUCTP in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...SUGRA -C...Dummy routine, to be removed when ISAJET (ISASUSY) is to be linked. - - SUBROUTINE SUGRA(MZERO,MHLF,AZERO,TANB,SGNMU,MTOP,IMODL) - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - REAL MZERO,MHLF,AZERO,TANB,SGNMU,MTOP - INTEGER IMODL -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ - &1X,'Dummy routine SUGRA in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - -C********************************************************************* - -C...UPEVNT -C...Dummy routine, to be replaced by a user implementing external -C...processes. Depending on cross section model chosen, it either has -C...to generate a process of the type IDPRUP requested, or pick a type -C...itself and generate this event. The event is to be stored in the -C...HEPEUP commonblock, including (often) an event weight. - - SUBROUTINE UPEVNT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process event common block. - INTEGER MAXNUP - PARAMETER (MAXNUP=500) - INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP - DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP - COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,IDUP(MAXNUP), - &ISTUP(MAXNUP),MOTHUP(2,MAXNUP),ICOLUP(2,MAXNUP),PUP(5,MAXNUP), - &VTIMUP(MAXNUP),SPINUP(MAXNUP) - SAVE /HEPEUP/ - - RETURN - END - -C********************************************************************* - -C...UPINIT -C...Dummy routine, to be replaced by a user implementing external -C...processes. Is supposed to fill the HEPRUP commonblock with info -C...on incoming beams and allowed processes. - - SUBROUTINE UPINIT - -C...Double precision and integer declarations. - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - -C...User process initialization commonblock. - INTEGER MAXPUP - PARAMETER (MAXPUP=100) - INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP - DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP - COMMON/HEPRUP/IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2), - &IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),XMAXUP(MAXPUP), - &LPRUP(MAXPUP) - SAVE /HEPRUP/ - - RETURN - END - -C********************************************************************* - -C...VISAJE -C...Dummy function, to be removed when ISAJET (ISASUSY) is to be linked. - - FUNCTION VISAJE() - IMPLICIT DOUBLE PRECISION(A-H, O-Z) - IMPLICIT INTEGER(I-N) - CHARACTER*40 VISAJE - -C...Commonblocks. - COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) - SAVE /PYDAT1/ - -C...Assign default value. - VISAJE='Undefined' - -C...Stop program if this routine is ever called. - WRITE(MSTU(11),5000) - IF(PYR(0).LT.10D0) STOP - -C...Format for error printout. - 5000 FORMAT(1X,'Error: you did not link ISAJET correctly.'/ - &1X,'Dummy function VISAJE in PYTHIA file called instead.'/ - &1X,'Execution stopped!') - - RETURN - END - SUBROUTINE RADGEN_EVENT - WRITE(6,*) ' %%% RADGEN_EVENT called' - RETURN - END -C - SUBROUTINE MKF2(DQ2,DX,A,Z,DF2,DF1) - DOUBLE PRECISION DX, DQ2, DF1, DF2 - INTEGER A, Z - WRITE(6,*) ' %%% MKF2 called' - RETURN - END -C - DOUBLE PRECISION FUNCTION pyth_xsec(dx, dQ2,dF1, dF2) - DOUBLE PRECISION DX, DQ2,DF1,DF2 - WRITE(6,*) ' %%% PYTH_XSEC called' - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/reac_eve.F b/src/programs/Simulation/bggen_jpsi/code/reac_eve.F deleted file mode 100644 index 5ef8ca6d18..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/reac_eve.F +++ /dev/null @@ -1,221 +0,0 @@ - SUBROUTINE REAC_EVE(IERR) -C -C--- Simulates 1 event - a single reaction -C Reaction: gamma+p --> A+B , A - recoil, B - meson -C ISIMUL=1 A=p (14), B=J/psi (83) -C - IMPLICIT NONE - INTEGER IERR -C - INCLUDE 'bg_ctrl.inc' - INCLUDE 'bg_partc.inc' - INCLUDE 'bg_evec.inc' - INCLUDE 'bg_reac.inc' -C - REAL RNDM,GBRWIGN -C - INTEGER i,j,ip,np,ityp,ntry,ires - + ,ityd,ntry1,ihel - REAL ebeam,ecm,ecm2,bet(4),qq,ct,st,phi - + ,twopi - + ,amtot ! sum of the masses - + ,ppf,epf1,ppi,tt,tmn,tmx,amdec,amd(6),pcms(4) - + ,wdm -C - INTEGER mxoutl - PARAMETER (mxoutl=6) - REAL ami(2),pcmi(4,2),plabi(4,2) - + ,am(mxoutl),pcm(4,mxoutl),plab(4,mxoutl) - INTEGER ity(mxoutl),ndec(mxoutl),kdec(3,mxoutl),kdectyp(mxoutl) - + ,it1dec(mxoutl),itorig(mxoutl) -C -C ------------------------------------------------------------------ -C - IERR=1 - NTRA=0 - IF(ISIMUL.LT.1.OR.ISIMUL.GT.1) GO TO 999 -C -C--- Beam energy -C - ebeam=PIN(3,1) -C -C--- Initial state (beam goes along Z - no rotation applied) -C - DO i=1,2 - ami(i)=AMIN(i) - DO j=1,3 - plabi(j,i)=PIN(j,i) - ENDDO - qq=plabi(1,i)**2+plabi(2,i)**2+plabi(3,i)**2 - plabi(4,i)=SQRT(qq+ami(i)**2) - ENDDO - DO j=1,4 - pcms(j)=plabi(j,1)+plabi(j,2) - ENDDO -C -C write(6,*) 'ami', ami,plab(4,1),plab(4,2) - ecm2=ami(1)**2+ami(2)**2+2.*plabi(4,1)*plabi(4,2) - ecm=SQRT(ecm2) -C - ntry=0 - 30 np=0 - ntry=ntry+1 - amtot=0. - ires=0 - DO ip=1,2 - ityp=IPREAC(ip) - IF(ityp.GT.0.AND.ityp.LE.MXPART) THEN - np=np+1 - ity(np)=ityp - am(np)=AM_PART(ityp) - amdec=0. - ndec(np)=0 - itorig(np)=0 - it1dec(np)=0 - DO i=1,3 - ityd=KD_PART(i,ityp) - IF(ityd.GT.0.AND.ityd.LE.MXPART) THEN - ndec(np)=ndec(np)+1 - kdec(ndec(np),np)=ityd - amdec=amdec+AM_PART(ityd) - ENDIF - ENDDO - kdectyp(np)=KD_PART(4,ityp) - IF(WG_PART(ityp).GT.0.) THEN - ires=1 - ntry1=0 - 35 ntry1=ntry1+1 - wdm=WG_PART(ityp)*GBRWIGN(am) -C write(6,*) am(np),wdm,amdec - IF(am(np)+wdm.LT.amdec+0.01) THEN - IF(ntry1.LT.1000) GO TO 35 - WRITE(6,*) ' *** BGGEN_EVE unsuff mass for decay ' - + ,ityp,am(np),wdm,am(np)+wdm,amdec - GO TO 999 - ENDIF - am(np)=am(np)+wdm - ENDIF - amtot=amtot+am(np) - ENDIF - ENDDO -C write(6,*) ' np..', np,amtot,ecm-0.01 - IF(np.LT.1) GO TO 999 - IF(amtot.GE.ecm-0.01) THEN - IF(ntry.LT.1000) GO TO 30 - GO TO 999 - ENDIF -C - DO i=1,3 - bet(i)=(plabi(i,1)+plabi(i,2))/(plabi(4,1)+plabi(4,2)) - ENDDO - bet(4)=(plabi(4,1)+plabi(4,2))/ecm - DO i=1,2 - CALL GLOREN(bet,plabi(1,i),pcmi(1,i)) - ENDDO - DO i=1,3 - bet(i)=-bet(i) - ENDDO -C -C--- Treat the kinematics as 2-body one, in CM -C - twopi=ACOS(0.)*4. - IF(np.EQ.2) THEN -C -C--- In CM: momentum and energies of the particles -C - epf1=(ecm2+am(1)**2-am(2)**2)/2./ecm - ppf =SQRT(epf1**2-am(1)**2) ! final momentum - ppi=SQRT(pcmi(4,2)**2-ami(2)**2) ! initial momentum - IF(ppf.LE.0.) GO TO 999 -C - qq=ami(2)**2+am(1)**2-2.*epf1*pcmi(4,2) - tmx=qq+2.*ppf*ppi - tmn=qq-2.*ppf*ppi - IF(TSLREAC.LT.0.001) THEN - tt=tmn+(tmx-tmn)*RNDM(qq) - ELSE - tt=1./TSLREAC*ALOG(EXP(TSLREAC*tmn) - + +RNDM(qq)*(EXP(TSLREAC*tmx)-EXP(TSLREAC*tmn))) - ENDIF - ct=(tt-qq)/2./ppf/ppi -C - st=SQRT(1.-ct**2) - phi=twopi*RNDM(st) -C -C--- 2-body -C -C - pcm(4,2)=ecm-epf1 -C - pcm(1,2)=ppf*st*COS(phi) - pcm(2,2)=ppf*st*SIN(phi) - pcm(3,2)=ppf*ct -C - DO i=1,3 - pcm(i,1)=-pcm(i,2) - ENDDO - pcm(4,1)=epf1 -C -C--- Boost to Lab -C - DO i=1,2 - CALL GLOREN(bet,pcm(1,i),plab(1,i)) - ENDDO -C -C--- Decays? -C - DO i=1,2 - IF(ndec(i).GT.0) THEN - it1dec(i)=np+1 - DO j=1,ndec(i) - amd(j)=AM_PART(kdec(j,i)) - am (np+j)=amd(j) - ity(np+j)=kdec(j,i) - ndec(np+j)=0 - itorig(np+j)=i - it1dec(np+j)=0 - ENDDO - IF(ndec(i).EQ.2) THEN ! 2-body decay - ihel=kdectyp(i) ! decay angle flag =0 - unoform, =1 - rho-like, =2 - j/psi-like - CALL OMDECA2(plab(1,i),amd(1),ihel,plab(1,np+1)) - ELSE IF(ndec(i).EQ.3) THEN - CALL OMDECA3(plab(1,i),amd(1),0.,plab(1,np+1)) - ENDIF - np=np+ndec(i) - ENDIF - ENDDO -C - ENDIF -C - DO i=1,np - DO j=1,3 - PTRA(j,i)=plab(j,i) - ENDDO - AMTRA(i)=am(i) - ITPTRA(1,i)=ity(i) - DO j=2,6 - ITPTRA(j,i)=0 - ENDDO -C write(6,*) i,ity(i),MXPGEANT,IPLUND(ity(i)),itorig(i),it1dec(i) - IF(ity(i).GT.0.AND.ity(i).LE.MXPGEANT) THEN - ITPTRA(3,i)=IPLUND(ity(i)) - ENDIF - ITPTRA(4,i)=itorig(i) - ITPTRA(5,i)=it1dec(i) - IF(it1dec(i).GT.0) ITPTRA(6,i)=it1dec(i)+ndec(i)-1 - ITPTRA(2,i)=1 - IF(it1dec(i).NE.0) ITPTRA(2,i)=10 ! indicates that this particle should not be used in GEANT - ENDDO - NTRA=np -C - IERR=0 - 999 CONTINUE -C write(6,*) ebeam,IEVPROC,ibin,xstot,xssum,NTRA -C -C SAVE SOME INFO -C - CALL HF1(9900,tt,1) -C - END -C - diff --git a/src/programs/Simulation/bggen_jpsi/code/rnd_ini.F b/src/programs/Simulation/bggen_jpsi/code/rnd_ini.F deleted file mode 100644 index 4e5a9fa1e3..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/rnd_ini.F +++ /dev/null @@ -1,14 +0,0 @@ - SUBROUTINE RND_INI(ISEQ) -C--- RANLUX initialization (random number) - IMPLICIT NONE - INTEGER ISEQ - INTEGER k1,k2,lux -C - k1=0 - k2=0 - lux=3 - CALL RLUXGO(lux,ISEQ,k1,k2) -C - RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/rndm.F b/src/programs/Simulation/bggen_jpsi/code/rndm.F deleted file mode 100644 index b5395f68c0..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/rndm.F +++ /dev/null @@ -1,11 +0,0 @@ -C - REAL FUNCTION RNDM(X) - IMPLICIT NONE - REAL X - REAL a -C - CALL RANLUX(a,1) - RNDM=a - RETURN - END - diff --git a/src/programs/Simulation/bggen_jpsi/code/saidcore.F b/src/programs/Simulation/bggen_jpsi/code/saidcore.F deleted file mode 100644 index 384564fc3f..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/saidcore.F +++ /dev/null @@ -1,2062 +0,0 @@ -C -C --- SAID gamma+p --> pi N cross section -C -C From I.Strakovsky, D.Arndt -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C -C Usage: -C ee=E*1000. -C it=1 -C s=PRFAMP(ee,COSTH,IPROC,fr,fi,dx3) -C res=OBSPRD(it) -C -C --- E - photons energy (E<2 GeV) -C --- COSTH - cos of pion angle in CM -C --- IPROC = 1 - pi0 p -C 2 - pi+ n -C 3 ... is at the moment unclear to me -C Returns cross section in microbarn/ster for pion in CM -C -C *************************************************** - REAL FUNCTION PRFAMP(EGX,Z,IR,FRV,FIV,S3) -C IMPLICIT NONE -C SUBROUTINE TO GET "F" AMPLITUDES FOR PION-PHOTOPRODUCTION 11/93 ARNDT - REAL EGX,Z,FRV(4),FIV(4),S3 - INTEGER IR - COMMON/PRFA/EMR(6,2,6),EMI(6,2,6),NTL1(18),NTL2(18),TTLPN(18) - INTEGER NTL1,NTL2 - REAL EMR,EMIT,TLPN - REAL F2(4),CIS(4,2),PP(8),PDP(8),EMPI(6,2,6) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C to add a calculation of observables 9/18/02 RAA - REAL ZM,EGM,C1,C3,SQ - INTEGER IRM,i,k,ii - DATA IRM,ZM,EGM,C1,C3,SQ/27,27.0,0.0,0,0,0/ -C SAVE IRM,ZM,EGM,C1,C3,SQ -C SAVE F2,CIS,PP,PDP,EMPI,II - SAVE -C write(6,*) 'EGX,Z,IR,II',EGX,Z,IR,II ! MYPRI - CS=Z - EG=ABS(EGX) - IF(IRM.NE.27) GO TO 1 - SQ=SQRT(2.0) - CIS(2,1)=SQ - CIS(2,2)=-SQ/3.0 - CIS(1,1)=1.0 - CIS(1,2)=2.0/3.0 - CIS(3,1)=SQ - CIS(3,2)=SQ/3.0 - CIS(4,1)=-1.0 - CIS(4,2)=2.0/3.0 - 1 IF(IR.NE.IRM) EGM=0.0 - IF(EGX.EQ.EGM) GO TO 2 -C write(6,*) 'EGX,EGM,IR,II',EGX,EGM,IR,II ! MYPRI - IRM=IR - C3=1.0 - C1=0.0 - IF(IR.GT.6) GO TO 12 - C1=1.0 - C3=0.0 - IF(IR.GT.4) GO TO 12 - I=IR - IF(I.LT.1) I=1 - C3=CIS(I,2) - C1=CIS(I,1) - 12 EGM=EGX - I=IR - IF(IR.LT.1) I=1 - IF(I.GT.4) I=4 - II=I - CALL PROPEC(EG,EMPI) - CALL PRSM02(EG,I,EMR,EMI,NTL1,TTLPN) - 2 IF(Z.EQ.ZM) GO TO 3 - ZM=Z - CALL PJDRV(Z,8,PP,PDP) - 3 CONTINUE -C write(6,*) FRV - DO k=1,4 -C write(6,*) 'k=',K - FRV(k)=0. - FIV(k)=0. - ENDDO -C write(6,*) 'EG,II,Z',EG,II,Z ! MYPRI - CALL FOPEC(EG,II,Z,FRV) - ME=3 - IF(IR.GT.2.AND.IR.LT.6) ME=5 - MM=ME+1 - LL=0 - 5 LL=LL+1 - IF(LL.GT.6) GO TO 98 - DO 9 M=1,6 - DO 9 J=1,2 - Z1=EMR(M,J,LL) - Z1P=EMPI(M,J,LL) - EMR(M,J,LL)=Z1-Z1P - EMPI(M,J,LL)=0.0 - 9 CONTINUE - ZL=LL-1 - EP=C3*EMR(1,2,LL)+C1*EMR(ME,2,LL) - EM=C3*EMR(1,1,LL)+C1*EMR(ME,1,LL) - BP=C3*EMR(2,2,LL)+C1*EMR(MM,2,LL) - BM=C3*EMR(2,1,LL)+C1*EMR(MM,1,LL) - EPI=C3*EMI(1,2,LL)+C1*EMI(ME,2,LL) - EMX=C3*EMI(1,1,LL)+C1*EMI(ME,1,LL) - BPI=C3*EMI(2,2,LL)+C1*EMI(MM,2,LL) - BMI=C3*EMI(2,1,LL)+C1*EMI(MM,1,LL) - FRV(1)=FRV(1)+PP(LL+1)*(ZL*BP+EP) - FIV(1)=FIV(1)+PP(LL+1)*(ZL*BPI+EPI) - IF(LL.EQ.1) GO TO 5 - IF(LL.LT.3) GO TO 6 - FRV(1)=FRV(1)+PP(LL-1)*((ZL+1.0)*BM+EM) - FIV(1)=FIV(1)+PP(LL-1)*((ZL+1.0)*BMI+EMX) - 6 FRV(2)=FRV(2)+PP(LL)*((ZL+1.0)*BP+ZL*BM) - FIV(2)=FIV(2)+PP(LL)*((ZL+1.0)*BPI+ZL*BMI) - FRV(3)=FRV(3)+PDP(LL+1)*(EP-BP) - FIV(3)=FIV(3)+PDP(LL+1)*(EPI-BPI) - IF(LL.LT.3) GO TO 7 - FRV(3)=FRV(3)+PDP(LL-1)*(EM+BM) - FIV(3)=FIV(3)+PDP(LL-1)*(EMX+BMI) - 7 FRV(4)=FRV(4)+PDP(LL)*(BP-EP-BM-EM) - FIV(4)=FIV(4)+PDP(LL)*(BPI-EPI-BMI-EMX) - GO TO 5 - 98 S=0.0 - DO 11 K=1,4 - F2(K)=FRV(K)**2+FIV(K)**2 - 11 S=S+F2(K) - CALL PRKIN(EG,IR,EPI,ZKCM,QCM) - S2=(1.0-Z**2) - S=F2(1)+F2(2)+S2*(F2(3)+F2(4))/2.0 - S=S-2.0*Z*(FRV(1)*FRV(2)+FIV(1)*FIV(2)) - S=S+S2*(FRV(1)*FRV(4)+FIV(1)*FIV(4)+FRV(2)*FRV(3)+FIV(2)*FIV(3)) - S=S+S2*Z*(FRV(3)*FRV(4)+FIV(3)*FIV(4)) - PRFAMP=S*QCM/ZKCM/100.0 - S3=F2(3)+F2(4)+2.0*Z*(FRV(3)*FRV(4)+FIV(3)*FIV(4)) - S3=S3*QCM/ZKCM/200.0*S2 -C convert F to H 9/18/02 - sh=sqrt((1.0-z)/2.0) - ch=sqrt(1.0-sh**2) - hrx(3)=sq*ch*sh**2*(FRV(3)-FRV(4)) - hrx(1)=-sq*sh*ch**2*(FRV(3)+FRV(4)) - hrx(2)=hrx(3)+sq*ch*(FRV(2)-FRV(1)) - hrx(4)=sq*sh*(FRV(2)+FRV(1))-hrx(1) - hix(3)=sq*ch*sh**2*(FIV(3)-FIV(4)) - hix(1)=-sq*sh*ch**2*(FIV(3)+FIV(4)) - hix(2)=hix(3)+sq*ch*(FIV(2)-FIV(1)) - hix(4)=sq*sh*(FIV(2)+FIV(1))-hix(1) - 99 RETURN - END -C **************************************************************** - SUBROUTINE PJDRV(Z,JMX,PP,PDP) - DIMENSION PP(20),PDP(20) -C GET LEGENDRE DERIVATIVE PP(1ST) AND PDP(2ND) - SAVE - JM=JMX - IF(JM.GT.20) JM=20 - J=0 - PJ=1.0 - PJM=0.0 - 1 J=J+1 - ZJ=J-1 - PP(J)=0.0 - PDP(J)=0.0 - IF(J.LT.2) GO TO 2 - PP(J)=ZJ*PJM+Z*PP(J-1) - IF(J.LT.3) GO TO 2 - PDP(J)=Z*PDP(J-1)+(ZJ+1.0)*PP(J-1) - 2 X=PJ - PJ=((2.0*ZJ+1.0)*Z*PJ-ZJ*PJM)/(ZJ+1.0) - PJM=X - IF(J.LT.JM) GO TO 1 - RETURN - END -C ************************************************ - SUBROUTINE FOPEC(EL,IR,Z,F) - DIMENSION F(4),EPX(4),E2X(4),GC(4),AA(4),BB(4),CC(4) - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ - DATA EPX,E2X/0.0,1.0,-1.0,0.0,1.0,0.0,1.0,0.0/ - DATA GC/-1.0,-1.0,-1.0,1.0/ -C SAVE EPX,E2X,GC,AA,BB,CC - SAVE - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - DT=-2.0*(ZT-Z) - DU=2.0*(ZU-Z) - GG=1000.0*GN/W - USCL=(W+WN)/2.0/Z1/Z2 - AA(1)=0.0 - AA(2)=0.0 - AA(3)=GG*Z2/Z1 - AA(4)=-GG*Z1*Q/Z2/ZK - BB(1)=-GG*W/Q/USCL/2.0 - BB(2)=GG*W/Z2**2/2.0/USCL - BB(3)=-AA(3) - BB(4)=-AA(4) - GG=GG*USCL - CC(1)=-GG*Z2**2/Q - CC(2)=GG - CC(3)=-GG*Z2**2/WN - CC(4)=-GG*Q/WN -C write(6,*) 'EL,IR,Z,F',EL,IR,Z,F ! MYPRI - E2=E2X(IR) - G=GC(IR) - IF(IR.EQ.2.OR.IR.EQ.3) G=G*SQ2 - EPI=EPX(IR) - U2=(UN+E2*(UP-UN)) - F(1)=G*(AA(1)*EPI/DT+(E2*BB(1)+U2*CC(1))/DU) - F(2)=G*(AA(2)*EPI/DT+(E2*BB(2)+U2*CC(2))/DU) - F(3)=G*(AA(3)*EPI/DT+(E2*BB(3)+U2*CC(3))/DU) - F(4)=G*(AA(4)*EPI/DT+(E2*BB(4)+U2*CC(4))/DU) - 99 RETURN - END -C ************************************************** - SUBROUTINE PRSM02(TLB,IR,EMR,EMI,NTL,TTLPN) -C get photo-production multipoles (from VPI analysis) -C Tlab=Photon LAB energy (MeV); IR=1(Pi0), 2(Pi+), 3(Pi-), 4(Pi0N) -C NTL(20) is a TITLE which is set on the 1st call to the subroutine -C EMR(6,2,6) is the REAL part (in mFm) and EMI is the IMAGINARY part -C of the multipole amplitudes. The INDEX (M,J,L) labels the state as fol -C M=1(pE3/2), 2(pM3/2), 3(pE1/2), 4(pM1/2), 5(nE1/2), 6(nM1/2) -C L=ORBITAL angular momentum, J=1(j=l-1/2) or 2(j=l+1/2). (actually L=l+ -C some examples: S11pE=(3,2,1) S31pE=(1,2,1) P33pM=(4,2,2) P33pE=(3,2, -C P11pM=(4,1,2) D15nM=(6,2,3) ..... - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - COMMON/PRKC/IPRK - DIMENSION PEM(15,6,2,6),EMR(6,2,6),EMI(6,2,6),NF(6,2,6),CCS(5) - C,EMPI(6,2,6),QL(10),NTL(13),NTC(13),PP(400),TPNR(4,8),TPNI(4,8) - DIMENSION TTLPN(15),PP1(70),PP2(70),PP3(70),PP4(70),PP5(66) - CHARACTER HTL*52 - EQUIVALENCE (PP,PP1),(PP(71),PP2),(PP(141),PP3) - C,(PP(211),PP4),(PP(281),PP5) - DATA CCS/ 22.500, 0.000, 13.750, 0.000, 0.000/ - DATA IPRKX/ 1/ - DATA HTL/'SM02K 2000 MEV P(148) CHI/DP=35297/17571 '/ - DATA IMX/346/ - DATA PP1/ 0.25121E+13, 0.14625E+02,-0.12639E+03, 0.75187E+02, - C 0.00000E+00,-0.18097E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.59426E+01, 0.00000E+00,-0.63967E+02, 0.10470E+03, 0.21321E+13, - C-0.86934E+01, 0.10773E+01,-0.11660E+00, 0.00000E+00, 0.64122E+02, - C-0.86162E+01, 0.17660E+00, 0.00000E+00,-0.16826E+02, 0.15135E+01, - C 0.10282E+02, 0.25521E+13,-0.96450E+00, 0.23707E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00,-0.44563E+02, 0.65940E+02, 0.21212E+13, - C 0.61205E+01,-0.10655E+01,-0.56700E-01, 0.00000E+00, 0.15401E+03, - C-0.92590E+01, 0.21412E+13, 0.16290E+01,-0.92310E+00, 0.60700E-01, - C 0.00000E+00, 0.24447E+02,-0.21964E+01, 0.25612E+13, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.13333E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.93731E+01, 0.24122E+13,-0.10673E+01, - C 0.49582E+01, 0.00000E+00, 0.00000E+00,-0.15440E+01, 0.24222E+13, - C-0.13886E+02/ - DATA PP2/ 0.11655E+03,-0.13603E+04, 0.17137E+04, 0.34104E+02, - C 0.53811E+02,-0.16301E+02, 0.49180E+00, 0.00000E+00, 0.00000E+00, - C-0.98292E+02, 0.23824E+02, 0.25322E+13, 0.22764E+02,-0.72372E+02, - C 0.53892E+02, 0.00000E+00, 0.59900E+02,-0.69650E+02, 0.25422E+13, - C-0.16052E+02, 0.57929E+02,-0.62187E+02, 0.00000E+00, 0.00000E+00, - C-0.28311E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.59717E+01, 0.25522E+13,-0.40780E+01, 0.94920E+01, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.46976E+01, 0.25622E+13, 0.17593E+01, 0.25113E+13, 0.21683E+01, - C-0.31918E+02, 0.00000E+00, 0.00000E+00,-0.16604E+03, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.21527E+02, 0.00000E+00,-0.75828E+02, - C 0.16466E+03, 0.25213E+13,-0.10177E+02, 0.51979E+02,-0.86352E+02, - C 0.00000E+00, 0.33052E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.36886E+01, 0.00000E+00,-0.27140E+01, 0.25313E+13, 0.34127E+02, - C-0.89989E+02/ - DATA PP3/ 0.00000E+00, 0.00000E+00, 0.10452E+03,-0.10911E+03, - C 0.00000E+00, 0.00000E+00,-0.53911E+02, 0.14084E+03,-0.28059E+02, - C 0.34639E+02, 0.25413E+13,-0.40309E+02, 0.88893E+02,-0.54692E+02, - C 0.00000E+00, 0.18067E+03,-0.55538E+03, 0.42138E+03, 0.25513E+13, - C 0.16695E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.10387E+03, - C 0.11062E+03, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.77412E+01, 0.25613E+13,-0.65508E+01, 0.20229E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.25953E+01, 0.25123E+13,-0.25835E+02, 0.85524E+02,-0.70269E+02, - C 0.00000E+00,-0.34619E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.65460E+01, 0.25223E+13,-0.22901E+01, - C 0.25323E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.13747E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.68360E+00, - C 0.25423E+13, 0.43825E+01,-0.97807E+01, 0.00000E+00, 0.00000E+00, - C 0.00000E+00/ - DATA PP4/ 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.16460E+01, - C 0.00000E+00, 0.14276E+01, 0.25523E+13,-0.68300E-01, 0.25623E+13, - C 0.31487E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.17942E+02, - C 0.25114E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.31147E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.49006E+01, - C 0.25214E+13,-0.13890E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.82595E+02, 0.16338E+03, 0.25314E+13,-0.11818E+02, 0.13203E+02, - C 0.00000E+00, 0.00000E+00, 0.36882E+02,-0.38961E+02, 0.25414E+13, - C 0.14468E+01,-0.58022E+01, 0.00000E+00, 0.00000E+00, 0.10382E+02, - C 0.25514E+13, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.46150E+01, 0.25614E+13, 0.21488E+01, 0.00000E+00, 0.00000E+00, - C 0.00000E+00,-0.56096E+01, 0.25124E+13,-0.32589E+01, 0.53944E+01, - C 0.25224E+13,-0.49784E+02, 0.19046E+03,-0.18472E+03, 0.00000E+00, - C 0.16002E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00/ - DATA PP5/ 0.22656E+01, 0.25324E+13, 0.13610E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.45565E+02,-0.65437E+02, - C 0.25424E+13,-0.42560E+00, 0.25524E+13, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.45573E+01, 0.25624E+13, 0.11595E+02, - C-0.21803E+02, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.30548E+02, 0.00000E+00,-0.84679E+01, - C 0.25115E+13, 0.62770E+00, 0.25215E+13,-0.42580E+00, 0.25415E+13, - C-0.72950E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.11346E+02, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.12784E+01, 0.25615E+13, 0.91120E+00, 0.25225E+13, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.32608E+02, 0.00000E+00, - C 0.00000E+00, 0.00000E+00,-0.55856E+01, 0.25425E+13,-0.34430E+00, - C 0.25625E+13, 0.12970E+00/ - DATA IRM,TLBX/-1,-27.0/ - DATA WN,WPIC,EPIMM,QB/938.256,139.65,0.0,0.0/ - DATA WPI,ZXM/135.04,0/ - SAVE - IF(TLBX.NE.-27.0) GO TO 10 - IPRK=IPRKX - GOM1=CCS(1) - GOM2=CCS(2) - GPI2=CCS(3) - GP1=CCS(4) - GP2=CCS(5) - DO 51 M=1,6 - DO 51 J=1,2 - DO 51 L=1,6 - NF(M,J,L)=0 - IF(L.GT.2) NF(M,J,L)=3 - EMR(M,J,L)=0.0 - EMI(M,J,L)=0.0 - EMPI(M,J,L)=0.0 - DO 51 K=1,15 - 51 PEM(K,M,J,L)=0.0 - DO 54 N=1,13 - 54 NTL(N)=NTC(N) - I=1 - 52 Z=PP(I)/1.E8 - NL=Z+0.1 - NFM=NL/1000 - NL=NL-1000*NFM - M=NL/100 - NL=NL-100*M - J=NL/10 - L=NL-10*J - NF(M,J,L)=NFM - K=0 - 53 I=I+1 - IF(I.GT.IMX) GO TO 10 - IF(PP(I).GT.1.E8) GO TO 52 - K=K+1 - PEM(K,M,J,L)=PP(I) - GO TO 53 -C 10 CONTINUE - 10 IF(TLB.EQ.TLBX.AND.IR.EQ.IRM) GO TO 97 - TLBX=TLB - IRM=IR - CALL PRKIN(TLB,IR,EPI,ZKCM,QCM) - EPX=EPI - IF(EPX.LT.0.0) EPX=0.0 - IF(EPX.EQ.EPIMM) GO TO 25 - EPIMM=EPX - S=(WN+WPIC)**2+2.0*WN*EPX - QB=WN*SQRT(EPX*(EPX+2.0*WPIC)/S) - CALL PRKIN(TLB,1,EPZ,ZKZ,Q0) - IF(IPRK.NE.1) EPZ=EPX - IF(EPZ.LT.0.5) EPZ=0.5 - CALL PNFIXD(EPX,0,TPNR,TPNI,TTLPN) - CALL PRBORN(TLB,EMPI,5) - 25 DO 11 MM=1,6 - DO 11 JJ=1,2 - DO 11 LL=1,6 - NNF=NF(MM,JJ,LL) - NROT=NNF/10 - NNF=NNF-10*NROT - DER=0. - DEI=0. - IF(QCM.LE.0.0) GO TO 12 - IF(NNF.LE.0) GO TO 12 - IF(NNF.GT.10) GO TO 12 - N=2 - IF(MM.GT.2) N=0 - N=N+JJ - IF(N.EQ.1.AND.LL.EQ.1) GO TO 12 - IF(N.EQ.3.AND.LL.EQ.1) GO TO 12 - TER=TPNR(N,LL) - TEI=TPNI(N,LL) -c mjl=100*mm+10*jj+ll-1 -C if(mjl.eq.320) write(*,224) tlb,ir,epx,epz -C 224 format(f8.2,i3,2f9.3) - 13 BRN=EMPI(MM,JJ,LL) - Z=EPX/WPI - IF(NNF.GT.4) Z=EPX/(EPX+800.0) - QK=QB/ZKCM - NEO=0 - IF(NNF.EQ.2) NEO=2 - IF(NNF.EQ.3) NEO=2 - IF(NNF.EQ.5) NEO=4 -C SUPPRESS ZR,ZB AT THRESHOLD BY QK**NEO - ZR=0.0 - IF(QB.LE.0.0) GO TO 24 - ZR=Z*(PEM(6,MM,JJ,LL)+Z*(PEM(7,MM,JJ,LL)+Z*PEM(8,MM,JJ,LL))) - ZR=(ZR+PEM(5,MM,JJ,LL))*WPI/QB - IF(LL.EQ.1) GO TO 24 - ZZ=1.0/QK - IF(IPRK.EQ.1) ZZ=QCM*ZKCM/QB**2 - ZR=ZR*ZZ**(LL-1) - 24 IF(NNF.GT.2) GO TO 1 - ZB=Z*(PEM(2,MM,JJ,LL)+Z*(PEM(3,MM,JJ,LL)+Z*PEM(4,MM,JJ,LL))) - ZB=ZB+PEM(1,MM,JJ,LL) - IF(LL.GT.1) ZB=ZB*QK**(LL-1) - GO TO 3 - 1 WX=2.0*WPI - ZX=SQRT(QCM**2+WX**2)/QCM - IF(ZX.NE.ZXM) CALL QJOFX(QL,ZX,8) - ZXM=ZX - ZB=PEM(1,MM,JJ,LL)*QL(LL)+PEM(2,MM,JJ,LL)*QL(LL+1) - ZB=ZX*(ZB+PEM(3,MM,JJ,LL)*QL(LL+2)+PEM(4,MM,JJ,LL)*QL(LL+3)) - 3 IF(NEO.GT.0) ZB=ZB*QK**NEO - IF(NEO.GT.0) ZR=ZR*QK**NEO - ZB=ZB+BRN - IF(LL.EQ.1) GO TO 32 - ZZ=1.0 - IF(IPRK.NE.1) GO TO 33 - ZZ=QCM/Q0 - 33 ZB=ZB*ZZ**(LL-1) - 32 DER=ZB*(1.0-TEI)+ZR*TER - DEI=ZB*TER+ZR*TEI - ZPR=PEM(9,MM,JJ,LL)+Z*PEM(10,MM,JJ,LL) - ZPI=PEM(11,MM,JJ,LL)+Z*PEM(12,MM,JJ,LL) - SGR=TEI-TER**2-TEI**2 - IF(SGR.LE.0.0001) GO TO 12 - IF(NROT.NE.2) GO TO 2 - DER=DER+ZPR*SGR - DEI=DEI+ZPI*SGR - GO TO 12 - 2 ZPR=ZPR*SGR*0.0174532 - Z=DEI - S=SIN(ZPR) - C=COS(ZPR) - DEI=C*Z+S*DER - DER=C*DER-S*Z - 12 EMR(MM,JJ,LL)=DER - EMI(MM,JJ,LL)=DEI -C if(mjl.ne.320) go to 11 -C write(*,223) tlb,epz,ir,iprk,ter,tei,zr,zb,brn,der,dei -C 223 format(2f7.2,2i3,/7f9.4) - 11 CONTINUE - 97 RETURN - END -C ****************************************************** - SUBROUTINE PNFIXD(EX,IRR,TRZ,TIZ,NTL) -C Get SAID partial waves. Parameters are in DATA statements -C E is Tlab(MeV), IR=0(PiN),1(Pi+P),2(Pi-P),3(Cxs) -C T(N,L) is PW for l=L-1, and N=1(I=1/2,J-), 2(I=1/2,J+),3(I=3/2,J-) -C and 4(I=3/2,J+) eg (N,L)=(2,1) for S11, (4,1) for S31, (4,2) for P33 -C (1,4) for F15 ....... -C NTL is set on 1st call and is a "title" for the SAID solution encoded - DIMENSION PP(309),NNTL(13),PP1(70),PP2(70),PP3(70),PP4(70) - C,PP5(29) - DIMENSION TR(4,8),TI(4,8),NFM(4,8),P(30,4,8),TRZ(4,8),TIZ(4,8) - DIMENSION NTL(13),W1(3),W2(3),DW2(3),V(8,3),VI(8,3),BPL(8) - CHARACTER HTL*52 - EQUIVALENCE (PP,PP1),(PP(71),PP2),(PP(141),PP3) - C,(PP(211),PP4),(PP(281),PP5) - DATA HTL/'FA01 606075 47250/23862 P+=22177/10447 P-=19250/ 955'/ - DATA IMX/309/ - DATA PP1/ 0.12100E+11, 0.41288E+00,-0.13924E+01, 0.13877E+01, - C 0.31046E+00, 0.17271E+04, 0.00000E+00, 0.17986E+01,-0.11787E+01, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.74568E+00, 0.00000E+00, 0.72014E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.17839E+02, 0.42738E+02, - C 0.00000E+00, 0.00000E+00, 0.29133E+00,-0.12634E+03,-0.17319E+04, - C-0.34065E+00, 0.43100E+11, 0.55000E+03, 0.14100E+11,-0.23745E+00, - C-0.40815E+01, 0.24988E+01, 0.45263E+01, 0.00000E+00,-0.69706E+01, - C 0.19502E+02,-0.32668E+02, 0.64469E+02, 0.20457E+01, 0.11200E+11, - C-0.14944E+01, 0.14949E+02,-0.20730E+02, 0.87321E+01, 0.00000E+00, - C 0.56328E+01,-0.41320E+01, 0.23247E+01, 0.13954E+00, 0.13365E+01, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.76876E+01, 0.73057E+01, - C 0.18855E+00, 0.12200E+11,-0.55000E+00, 0.71356E-01,-0.23340E+01, - C 0.77392E+01, 0.00000E+00,-0.54956E+01, 0.12286E+02,-0.40895E+01, - C 0.12199E+02/ - DATA PP2/ 0.13200E+11,-0.10257E+01, 0.14949E+01,-0.17620E+02, - C 0.21060E+02, 0.00000E+00,-0.73219E+01, 0.12156E+02, 0.00000E+00, - C 0.40128E+01, 0.14200E+11, 0.20881E+01,-0.35999E+01, 0.20928E+00, - C 0.00000E+00, 0.13799E+04, 0.26112E+01,-0.17167E+01, 0.41016E+01, - C-0.25959E+01, 0.84030E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C-0.18774E+01, 0.12122E+01, 0.11300E+11, 0.77035E+00, 0.40153E+00, - C-0.16197E+00, 0.00000E+00, 0.00000E+00, 0.82027E+01, 0.00000E+00, - C-0.84116E+02, 0.16688E+03, 0.64067E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00,-0.77289E+00, 0.00000E+00, - C 0.17007E+01, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.97351E+00, - C 0.12300E+11, 0.64725E+00,-0.10737E+01, 0.17166E+01,-0.24625E+00, - C 0.00000E+00, 0.55684E+00, 0.56053E+01,-0.43311E+02, 0.70823E+02, - C 0.11410E+01/ - DATA PP3/ 0.13300E+11, 0.31341E+00,-0.15511E+01, 0.12276E+01, - C 0.00000E+00, 0.00000E+00, 0.20157E+01, 0.34136E+00,-0.96421E+01, - C 0.16231E+02, 0.10519E+01, 0.14300E+11,-0.41618E+00, 0.55328E-01, - C 0.40027E+00, 0.00000E+00, 0.00000E+00,-0.11796E+01, 0.22979E+01, - C-0.12290E+02, 0.15086E+02, 0.00000E+00,-0.82172E+00, 0.11400E+11, - C 0.27747E+00, 0.12220E+01, 0.24501E+00,-0.47759E+00, 0.00000E+00, - C 0.88028E+01, 0.00000E+00,-0.11498E+03, 0.16499E+03, 0.91327E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.12633E+00,-0.92953E+02,-0.17944E+04, 0.12400E+11,-0.72357E-01, - C 0.12544E-02, 0.68633E-01, 0.00000E+00, 0.00000E+00, 0.81698E+00, - C 0.00000E+00, 0.15558E+02,-0.13594E+02, 0.13400E+11, 0.38952E-01, - C-0.92170E+00, 0.58149E+00, 0.00000E+00, 0.00000E+00, 0.17256E+01, - C 0.00000E+00/ - DATA PP4/-0.14663E+02, 0.19257E+02, 0.10322E+01, 0.14400E+11, - C 0.53698E+00,-0.58597E+00, 0.22586E+01, 0.00000E+00, 0.00000E+00, - C-0.17342E+01, 0.52315E+01,-0.19563E+02, 0.22496E+02, 0.11500E+11, - C 0.15721E+00, 0.89538E+00,-0.10520E+00, 0.00000E+00, 0.00000E+00, - C 0.14820E+01, 0.00000E+00,-0.79882E+01, 0.74380E+01, 0.12500E+11, - C 0.22720E+00,-0.62682E+00, 0.63407E+00, 0.00000E+00, 0.00000E+00, - C 0.10044E+01, 0.00000E+00,-0.51328E+01, 0.49378E+01, 0.13500E+11, - C 0.12831E+00,-0.83336E+00, 0.59115E+00, 0.00000E+00, 0.00000E+00, - C 0.83169E+00, 0.14500E+11,-0.68775E-01, 0.12994E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.78717E+00, 0.11600E+11, - C 0.17199E+00, 0.10118E+01,-0.18166E+01, 0.34438E+01, 0.00000E+00, - C 0.33512E+01, 0.00000E+00, 0.30161E+02,-0.22767E+02, 0.12600E+11, - C 0.87780E-01,-0.10616E+01, 0.20919E+01,-0.11497E+01, 0.13600E+11, - C 0.10591E+00,-0.33431E+00, 0.00000E+00, 0.00000E+00, 0.00000E+00, - C 0.67893E+00/ - DATA PP5/ 0.14600E+11, 0.23625E+00, 0.53320E+00,-0.16009E+01, - C 0.12428E+01, 0.00000E+00, 0.47710E+00, 0.11700E+11, 0.18644E+00, - C 0.19469E+00, 0.12700E+11, 0.18686E+00,-0.37530E+00, 0.00000E+00, - C 0.00000E+00, 0.00000E+00, 0.00000E+00, 0.54649E+00, 0.13700E+11, - C 0.14004E+00, 0.22806E+00,-0.47070E+00, 0.00000E+00, 0.00000E+00, - C 0.76494E+00, 0.14700E+11, 0.10472E+00, 0.48230E+00,-0.30032E+00/ - DATA W1/139.65,139.65,938.256/ - DATA W2/938.256,1212.0,547.3/ - DATA DW2/1.0,102.0,0.01/ - DATA NNL,NCH,WI,WT/8,3,139.65,938.256/ - DATA IRM,EM,S11L,NSTRT/-1,0.0,0.0,0/ - DATA WSUB,ETH/150.0,5.0/ - SAVE - IF(NSTRT.EQ.1) GO TO 1 - DO 51 L=1,8 - DO 51 N=1,4 - NFM(N,L)=0 - TR(N,L)=0.0 - TI(N,L)=0.0 - DO 51 J=1,30 - 51 P(J,N,L)=0.0 - NSTRT=1 - DO 54 N=1,13 - 54 NTL(N)=NNTL(N) - I=1 - 52 Z=PP(I)/1.E8 - NL=Z+0.1 - NF=NL/100 - NL=NL-100*NF - N=NL/10 - L=NL-10*N -C IF(N.EQ.3.AND.L.EQ.1) NF=0 - NFM(N,L)=NF - J=0 - 53 I=I+1 - IF(I.GT.IMX) GO TO 1 - IF(PP(I).GT.1.E8) GO TO 52 - J=J+1 - P(J,N,L)=PP(I) - IF(J.EQ.1.AND.N.EQ.3.AND.L.EQ.1) WSUB=PP(I) - GO TO 53 - 1 E=EX - IF(E.LT.ETH) E=ETH - IF(EM.NE.E) IRM=-27 - IF(TR(2,1).NE.S11L) IRM=-27 - IF(IRR.EQ.IRM) GO TO 98 - IRM=IRR - IR=IRR - IF(IR.GT.3) IR=IR-3 - EM=E - TLB=E - DO 55 L=1,8 - DO 55 N=1,4 - TR(N,L)=0.0 - 55 TI(N,L)=0.0 - IF(IR.LT.0.OR.IR.GT.3) GO TO 99 -C SMALLEST ENERGIES SEEM TO BREED TROUBLE -C IF(TLB.LT.0.2) GO TO 99 - W=SQRT((WI+WT)**2+2.*TLB*WT) - QPQ=(W**2-1074.7**2)*(W**2-804.6**2) - QPQ=SQRT(QPQ/(W**2-(WI+WT)**2)/(W**2-(WT-WI)**2)) - DO 7 N=1,NCH - WSU=W1(N)+W2(N) - WC=WI+WT+140.0 - IF(N.EQ.1) WC=WSU-WSUB - GU=-DW2(N)/2. - IF(N.EQ.1.) GU=0. - WIM=0.0 - 13 CALL CMFN(W,WIM,WC,WSU,GU,NNL,V(1,N),VI(1,N)) - IF(V(1,N).NE.0.0) GO TO 7 - WIM=WIM+1.0 - GO TO 13 - 7 CONTINUE - ETA=IR - IF(ETA.GT.1.0) ETA=-1.0 - XKMEV=SQRT(TLB*(TLB+2.0*WI)/((1.0+WI/WT)**2+2.0*TLB/WT)) - IF(IR.EQ.3) XKMEV=XKMEV*SQRT(QPQ) - XKM=197.32/XKMEV - PZR=SQRT(XKMEV**2+W2(1)**2) - QZR=SQRT(XKMEV**2+W1(1)**2) - ETA=ETA*.007297348*(QZR*PZR+XKMEV**2)/XKMEV/(PZR+QZR) -C PUT COULOMB BARRIER FACTORS INTO VI(L,5) 8/26/82 ARNDT - IF(ETA.GT.100.) ETA=100. - Z=2.*3.1415927*ETA - BL=1. - IF(ETA.NE.0.) BL=Z/(EXP(Z)-1.) - Z=0. - ZZ=SQRT(QPQ) - DO 8 L=1,NNL - BPL(L)=BL - Z=Z+1. - IF(IR.NE.3) GO TO 8 - BPL(L)=SQRT(BL)*ZZ - ZZ=ZZ*QPQ - 8 BL=BL*(1.+(ETA/Z)**2) - DO 9 LL=1,NNL - DO 9 NN=1,4 - NNF=NFM(NN,LL) - TRX=0. - TIX=0. - NL=10*NN+LL-1 - IF(NN.EQ.1.AND.LL.EQ.1) GO TO 9 - IF(NN.EQ.3.AND.LL.EQ.1) GO TO 9 - IF(NNF.EQ.1) CALL TMCM(TLB,NL,IRR,P(1,NN,LL),V,VI,TRX,TIX) -C ENCODE C-M K-MTX FIT FOR FORM 4 9/23/81 ARNDT - IF(NNF.EQ.1) GO TO 14 - IF(NNF.LT.3.OR.NNF.GT.6) GO TO 10 - BL=BPL(LL) - IF(BL.EQ.0.0) BL=1.0 - CER=V(LL,1) - CEI=VI(LL,1) - LI=LL - IF(NN.EQ.1.OR.NN.EQ.3) LI=LL-2 - IF(LI.LT.1) LI=LI+2 - IF(LL.EQ.1) LI=3 - NIL=2 - IF(NIL.GT.NCH) NIL=NCH - CIR=V(LI,NIL) - CII=VI(LI,NIL) - WTH=W1(1)+W2(1) - WPITH=WTH+140. - WCM=SQRT(WTH**2+2.*W2(1)*TLB) - Z=(WCM-WPITH)/1000. - ZZ=1. - ZE=0.0 - WKP=P(5,NN,LL) - DRL=1.0 -C MASS-SPLIT K-MTX POLE PIECE FOR P33 1/95 ARNDT - IF(WKP.EQ.0.0) GO TO 34 - DWK=P(18,NN,LL)/2.0 - IF(NL.NE.41) DWK=0.0 - IF(BL.GT.1.0001) WKP=WKP+DWK - IF(BL.LT.0.9999) WKP=WKP-DWK - ZZ=WKP-WTH - DRL=WKP-WCM - DGK=P(17,NN,LL)/2.0 - IF(DWK.EQ.0.0) DGK=0.0 - IF(DGK.EQ.0.0) GO TO 34 - IF(BL.GT.1.0001) ZE=DGK - IF(BL.LT.0.9999) ZE=-DGK - 34 CONTINUE - IF(NNF.GT.2) Z=(WCM-WTH)/1000.0 - LIP=LI+2 - IF(LIP.GT.8) LIP=LIP-2 - DO 12 J=1,4 - ZE=ZE+P(J,NN,LL)*ZZ - 12 ZZ=ZZ*Z - ZEI=0. - DIM=0. - DO 31 J=1,3 - IF(J.NE.3) GO TO 33 - CIR=V(LIP,2) - CII=VI(LIP,2) - IF(NNF.EQ.3.OR.NNF.EQ.5) GO TO 33 - CIR=V(LL,3) - CII=VI(LL,3) - 33 CONTINUE -C IF(CII.LT.0.0) CII=0.0 - K=2+4*J - Z0=Z*P(K,NN,LL)+Z**2*P(K+1,NN,LL) - IF(Z0.EQ.0.0) GO TO 31 - ZZ=P(K+2,NN,LL)+Z*P(K+3,NN,LL) - IF(NNF.GT.4) ZZ=ZZ*Z - DIR=1.0-CIR*ZZ - DII=-CII*ZZ - Z2R=Z0**2*CIR - Z2I=CII*Z0**2 - ZZ=Z2R - Z2R=ZZ*DRL-Z2I*DIM - Z2I=ZZ*DIM+Z2I*DRL - ZZ=ZE - ZE=ZE*DIR-ZEI*DII+Z2R - ZEI=ZZ*DII+ZEI*DIR+Z2I - ZZ=DRL - DRL=DRL*DIR-DIM*DII - DIM=ZZ*DII+DIM*DIR - 31 CONTINUE - DRL=DRL-CER*ZE+CEI*ZEI - DIM=DIM-CER*ZEI-CEI*ZE - D2=DRL**2+DIM**2 - Z=CEI/D2 - TRX=Z*(ZE*DRL+ZEI*DIM) - TIX=Z*(ZEI*DRL-ZE*DIM) - 14 IF(IRR.GT.3) BL=1.0 - IF(BL.EQ.1.0) GO TO 11 - IF(BL.GT.1.0.AND.NL.EQ.41) CALL ETA33(TLB,TRX,TIX) - CALL PWCC(TLB,TRX,TIX,NL,BL,NFM(3,1),IRR) - 11 IF(TIX.GE.1.0) TRX=0.0 - IF(TIX.GT.1.0) TIX=1.0 - IF(NNF.NE.1) CALL ADDRES(E,TRX,TIX,NL,P(19,NN,LL)) - IF(TIX.GE.TRX**2+TIX**2) GO TO 10 - D2=1.0+TRX**2+TIX**2-2.0*TIX - IF(D2.LT.1.E-20) WRITE(7,224) TLB,WCM,TRX,TIX - 224 FORMAT(' TLB, WCM=',2F8.2,' TR,TI=',2F9.5) - IF(D2.LT.1.E-20) GO TO 10 - Z=TRX/D2 - TRX=Z/(1.+Z**2) - TIX=Z*TRX - 10 TR(NN,LL)=TRX - 9 TI(NN,LL)=TIX - S11L=TR(2,1) - IF(WI.GT.150.0) GO TO 98 - IF(NFM(3,1).NE.4) GO TO 98 -C add in f13 corrections for S11, P13 ONLY for TROMBERG - L=1 - CALL TROMF13(TLB,L,IR,TR(2,L),TI(2,L),TR(4,L),TI(4,L)) - L=2 - CALL TROMF13(TLB,L,IR,TR(2,L),TI(2,L),TR(4,L),TI(4,L)) - S11L=TR(2,1) - 98 Z=1.0 - IF(EX.LT.ETH) Z=EX/ETH - ZZ=SQRT(Z) - DO 97 L=1,8 - IF(L.GT.1) ZZ=ZZ*Z - DO 97 N=1,4 - TRZ(N,L)=TR(N,L) - TIZ(N,L)=TI(N,L) - IF(Z.EQ.1.0) GO TO 97 - TRZ(N,L)=ZZ*TR(N,L) - TIZ(N,L)=TRZ(N,L)**2 - 97 CONTINUE - 99 RETURN - END -C ********************************************************* - SUBROUTINE TMCM(TLB,NL,IRR,P,V,VI,TRX,TIX) -C Coupled-Channel CM-K-mtx for FORM=1 9/3/01 RAA - DIMENSION V(8,3),VI(8,3),P(30) - DIMENSION TRL(10),TIM(10),ARC(10),AIC(10),RR(10),RI(10) - C,CCR(4),CCI(4),RH(4) - DATA WI,WT/139.65,938.256/ - SAVE - NN=NL/10 - LL=NL-10*NN+1 - IRX=IRR - IF(IRR.GT.3) IRX=IRR-3 -C ??? don't know WHAT this is - WSE=WI+WT - WRL=SQRT(WSE**2+2.0*WT*TLB) -C do 4x4 K-matrix to channels pipi, pid, pieta(or pid+) -C P= K11(4), WkP, K12(2), K22(2), K13(2), K23(2), K33(2) -C K14(2), K24(2), K34(2), K44(2), dWk, dGk, addres(4) - LI=LL - IF(NN.EQ.1.OR.NN.EQ.3) LI=LL-2 - IF(LI.LT.1) LI=LI+2 - IF(LL.EQ.1) LI=3 - LIP=LI+2 - ZZR=(WRL-WSE)/1000.0 - Z2R=ZZR**2 - WKP=P(5) - IF(IRX.EQ.2.OR.IRX.EQ.3) WKP=WKP+P(25) - WKPR=1.0 - IF(WKP.NE.0.0) WKPR=(WKP-WRL)/1000.0 - NCX=4 - IF(NN.GT.2) NCX=3 - JMX=NCX*(NCX+1) - JMX=JMX/2 - DO 2 J=2,JMX - K=2*J+2 - ZR=P(K)*ZZR+P(K+1)*Z2R - IF(J.LT.7.OR.J.GT.9) GO TO 2 - ZR=P(K)+(WRL/1000.0-1.4)*P(K+1) - 2 ARC(J)=ZR*WKPR - ZR=1.0 - GE=0.0 - IF(WKP.EQ.0.0) GO TO 9 - ZR=(WKP-WSE)/1000.0 - IF(IRX.EQ.2.OR.IRX.EQ.3) GE=P(24)/1000.0 - 9 DO 3 K=1,4 - GE=GE+P(K)*ZR - 3 ZR=ZR*ZZR - ARC(1)=GE - IF(ARC(7).EQ.0.0) NCX=3 - IF(ARC(4).EQ.0.0.AND.NCX.EQ.3) NCX=2 - IF(ARC(2).EQ.0.0.AND.NCX.EQ.2) NCX=1 - JD=1 - CRX=V(LL,1) - CIX=VI(LL,1) - DO 4 J=1,NCX - IF(J.EQ.2) CRX=V(LI,2) - IF(J.EQ.2) CIX=VI(LI,2) - IF(J.EQ.3) CRX=V(LIP,2) - IF(J.EQ.3) CIX=VI(LIP,2) - IF(J.EQ.4) CRX=V(LL,3) - IF(J.EQ.4) CIX=VI(LL,3) - CCR(J)=CRX - CCI(J)=CIX - DO 5 K=1,J - TRL(JD)=-ARC(JD) - TIM(JD)=0.0 - 5 JD=JD+1 - D2=CRX**2+CIX**2 - TRL(JD-1)=WKPR*CRX/D2-ARC(JD-1) - TIM(JD-1)=-WKPR*CIX/D2 - 4 CONTINUE - CALL CMSINV(TRL,TIM,RR,RI,NCX) - JK=1 - DO 6 J=1,NCX - JD=J*(J-1) - JD=JD/2 - RH(J)=CCI(J) - IF(RH(J).LT.0.0) RH(J)=0.0 - RH(J)=SQRT(RH(J)) - DO 6 K=1,J - KD=K*(K-1) - KD=KD/2 - ZR=0.0 - ZI=0.0 - DO 7 M=1,NCX - MD=M*(M-1) - MD=MD/2 - JM=JD+M - IF(M.GT.J) JM=MD+J - MK=KD+M - IF(M.GT.K) MK=MD+K - ZR=ZR+ARC(JM)*RR(MK) - ZI=ZI+ARC(JM)*RI(MK) - 7 CONTINUE - DCR=CCR(K) - DCI=CCI(K) - D2=DCR**2+DCI**2 - TRX=RH(J)*RH(K)*(DCR*ZR+DCI*ZI)/D2 - TIX=RH(J)*RH(K)*(DCR*ZI-DCI*ZR)/D2 - IF(IRX.LT.5) GO TO 8 - IF(JK.EQ.7) GO TO 99 - 6 JK=JK+1 - 8 KP1=26 - CALL ADDRES(TLB,TRX,TIX,NL,P(KP1)) - IF(IRX.GT.1.AND.NL.EQ.41) CALL ETA33(TLB,TRX,TIX) -C KILL BARRIER FACTOR IF HADRONIC IS NEEDED - if(nl.ne.41) go to 99 - 99 RETURN - END -C ********************************************************* - SUBROUTINE CMSINV(AR,AI,AIR,AII,N) - DIMENSION AR(10),AI(10),AIR(10),AII(10),WR(60),WI(60) - SAVE -C INVERT COMPLEX-SYMMETRIC MATRIX -C MATRICES ARE STORED A11,A12,A22,A13,... N=ORDER OF MATRIX -C G=INV OF DIAGONAL ELEMENT (M) M=SINGULAR ORDER W=WORKING SPACE - M=0 - JD=0 - GR=0.0 - GI=0.0 - 1 M=M+1 - JD=JD+M - GR=AR(JD) - GI=AI(JD) - IF(M.EQ.1) GO TO 2 - MM=M-1 - CALL MCMCV(AIR,AII,AR(JD-MM),AI(JD-MM),WR,WI,MM) - JJ=JD-M - DO 3 K=1,MM - JJ=JJ+1 - GR=GR-AR(JJ)*WR(K)+AI(JJ)*WI(K) - 3 GI=GI-AR(JJ)*WI(K)-AI(JJ)*WR(K) - 2 D2=GR**2+GI**2 - IF(D2.LT.1.E-9) D2=1.E-9 -C Note!! This is to take care of SINGULAR K-mtx 9/12/01 RAA - GR=GR/D2 - GI=-GI/D2 - AIR(JD)=GR - AII(JD)=GI - IF(M.EQ.1) GO TO 5 - J0=1 - DO 4 J=1,MM - ZR=GR*WR(J)-GI*WI(J) - ZI=GR*WI(J)+GI*WR(J) - KK=JD-M+J - AIR(KK)=-ZR - AII(KK)=-ZI - DO 4 K=1,J - ZZR=ZR*WR(K)-ZI*WI(K) - ZZI=ZR*WI(K)+ZI*WR(K) - AIR(J0)=AIR(J0)+ZZR - AII(J0)=AII(J0)+ZZI - 4 J0=J0+1 - 5 IF(M.LT.N) GO TO 1 - RETURN - END -C ********************************* - SUBROUTINE MCMCV(AR,AI,VR,VI,PR,PI,N) -C MULTIPLY COMPLEX MATRIX(A) ON COMPLEX VECTOR(V) TO GET PRODUCT(P) - DIMENSION AR(20),AI(20),VR(20),VI(20),PR(20),PI(20) - J0=0 - DO 1 J=1,N - ZR=0.0 - ZI=0.0 - DO 2 I=1,J - IJ=J0+I - ZR=ZR+AR(IJ)*VR(I)-AI(IJ)*VI(I) - 2 ZI=ZI+AR(IJ)*VI(I)+AI(IJ)*VR(I) - IF(J.GE.N) GO TO 3 - JP=J+1 - DO 4 I=JP,N - IJ=I*(I-1) - IJ=IJ/2+J - ZR=ZR+AR(IJ)*VR(I)-AI(IJ)*VI(I) - 4 ZI=ZI+AR(IJ)*VI(I)+AI(IJ)*VR(I) - 3 PR(J)=ZR - PI(J)=ZI - 1 J0=J0+J - RETURN - END -C ******************************************* - SUBROUTINE PWCC(TLB,TRX,TIX,NL,BL,NCC,IRZ) - DATA WI,PI/139.65,3.1415927/ -C NCC=5(NO CC), 4(Nordita S,P waves Tl<500), 6(Barrier+"h") -C otherwise use "Barrier" multiplication of K(Hadronic) - IF(TLB.LT.0.5) GO TO 99 - IF(BL.EQ.1.) GO TO 99 - IF(NCC.EQ.5) GO TO 99 - IF(NCC.LT.6) GO TO 2 -C Try adding "H" correction to Eff-Rng Charge-corrections 5/8/00 - T2=TRX**2+TIX**2 - D2=1.0+T2-2.0*TIX - ZHR=TRX/D2 - ZHI=(TIX-T2)/D2 - B=SQRT(TLB*(TLB+2.0*WI))/(TLB+WI) - E=1.0/B/137.06 - IF(BL.GT.1.0) E=-E - h=0.0 - XX=0.0 - Z=1.0 - DO 3 J=1,10 - XX=XX+1.0/Z/(1.0+(E/Z)**2) - 3 Z=Z+1.0 - Z=2.0*PI*E - IF(Z.GT.80.0) Z=80.0 - C2=Z/(EXP(Z)-1.0) - H=2.0*E*(E**2*XX-0.57721-ALOG(ABS(E)))*BL/C2 - IF(NCC.EQ.7) H=0.0 - ZHR=ZHR - ZHI=ZHI - DR=1.0-ZHR*H - DI=-ZHI*H - D2=DR**2+DI**2 - ZCR=BL*(ZHR*DR+ZHI*DI)/D2 - ZCI=BL*(ZHI*DR-ZHR*DI)/D2 - Z2=ZCR**2+ZCI**2 - D=1.0+Z2+2.0*ZCI - TRX=ZCR/D - TIX=(ZCI+Z2)/D - GO TO 99 - 2 CONTINUE - IF(NCC.NE.4.AND.NCC.NE.2) GO TO 1 -C Nordita corrections to S,P waves for Tl<550, otherwise Barrier - IF(TLB.GE.535.0) GO TO 1 - NN=NL/10 - LL=NL-10*NN+1 - IF(LL.GT.NCC/2) GO TO 1 -C Nordita for S-waves(NNC=2), or S+P-waves(NCC=4) -C Use Barrier factors for all but S-waves MP 5/16/00 Nuts!! - DD=0.0174532*DTROMB(NL,IRZ,TLB) - S=SIN(DD) - C=COS(DD) - TCR=S*C - TCI=S**2 - SR=1.0-2.0*TIX - SI=2.0*TRX - TRX=TRX+SR*TCR-SI*TCI - TIX=TIX+SR*TCI+SI*TCR - GO TO 99 - 1 DR=1.-TIX*(1.-BL) - DI=TRX*(1.-BL) - D2=(DR**2+DI**2)/BL - Z=TRX - TRX=(Z*DR+TIX*DI)/D2 - TIX=(TIX*DR-Z*DI)/D2 - 99 RETURN - END -C *************************************** - FUNCTION DTROMB(NL,IS,T) -C DO QUADRATIC TABLE LOOKUP OF TROMBERG PHASES -C K=1(S31),2(P31),3(P33) Pi+P -C 4(S11),5(S31),6(P31),7(P13),8(P33) Pi-P/CXS -C n.b.!! corrections adjusted so corr = del_nuc - del_had -C (Tromborg had -1/3, -2/3 factors for I=3,1 pi- corrections) -C TI = 10(25)535 MEV -C modified June 16/00 by M.M. Pavan -c Aug 21/01 by MMP include P31- (Helv.Phys.Acta51,584,1978) - DIMENSION F(176) - DATA F/0.110, 0.093, 0.091, 0.100, 0.100, 0.110, 0.121, 0.120 - + , 0.131, 0.130, 0.130, 0.130, 0.130, 0.132, 0.136, 0.139 - + , 0.141, 0.143, 0.143, 0.143, 0.142, 0.140 - + , 0.010, 0.012, 0.024, 0.040, 0.049, 0.068, 0.074, 0.090 - + , 0.092, 0.105, 0.116, 0.124, 0.129, 0.135, 0.141, 0.148 - + , 0.156, 0.164, 0.173, 0.182, 0.192, 0.202 - + ,-0.043,-0.120,-0.277,-0.517,-0.870,-1.287,-1.450,-1.117 - + ,-0.616,-0.229, 0.009, 0.153, 0.234, 0.289, 0.310, 0.317 - + , 0.327, 0.329, 0.324, 0.312, 0.292, 0.265 - + , 0.238, 0.177, 0.129, 0.096, 0.069, 0.042, 0.016, 0.000 - + ,-0.010,-0.024,-0.030,-0.041,-0.057,-0.070,-0.081,-0.091 - + ,-0.100,-0.109,-0.117,-0.123,-0.129,-0.134 - + ,-0.206,-0.145,-0.111,-0.098,-0.090,-0.084,-0.082,-0.080 - + ,-0.076,-0.073,-0.071,-0.069,-0.067,-0.065,-0.063,-0.061 - + ,-0.058,-0.055,-0.052,-0.049,-0.046,-0.043 - + ,-0.022,-0.051,-0.076,-0.096,-0.112,-0.126,-0.135,-0.144 - + ,-0.152,-0.160,-0.170,-0.179,-0.187,-0.195,-0.202,-0.208 - + ,-0.215,-0.220,-0.224,-0.229,-0.232,-0.235 - + ,-0.007,-0.021,-0.038,-0.057,-0.072,-0.092,-0.103,-0.114 - + ,-0.129,-0.139,-0.151,-0.161,-0.176,-0.194,-0.215,-0.236 - + ,-0.253,-0.268,-0.282,-0.295,-0.306,-0.315 - + , 0.154, 0.346, 0.543, 0.746, 0.945, 1.020, 0.737, 0.230 - + ,-0.154,-0.344,-0.405,-0.409,-0.386,-0.358,-0.322,-0.285 - + ,-0.253,-0.223,-0.195,-0.168,-0.143,-0.119/ - SAVE -C-----Initialize - DTROMB=0.0 - K=0 -C-----Ignore if PW not covered by Tromborg - IF(IS.LT.1.OR.IS.GT.3) GO TO 99 - IF(T.GT.550.0) GO TO 99 -C-----Select PW - IF(NL.EQ.40) K=1 - IF(NL.EQ.31.AND.IS.EQ.1) K=2 - IF(NL.EQ.41) K=3 - IF(NL.EQ.20) K=4 - IF(NL.EQ.40.AND.IS.GT.1) K=5 - IF(NL.EQ.31.AND.IS.GT.1) K=6 - IF(NL.EQ.21.AND.IS.GT.1) K=7 - IF(NL.EQ.41.AND.IS.GT.1) K=8 -C-----Ignore if PW not covered by Tromborg - IF(K.EQ.0) GO TO 99 -C-----Find PW and energy TI near energy T -C-----n.b. need 3 points for quadratic interp. - I=(T-10.0)/25.0 - I=I+2 - IF(I.GT.21) I=21 - TI=25*I-15 - I=22*(K-1)+I -c-----Interpolate to energy T using nearest 3 PWs - F0=F(I) - FM=F(I-1)-F0 - FP=F(I+1)-F0 -C WRITE(*,222) T,I,K,TI,F0,FM,FP -C 222 FORMAT(' T=',F5.1,' I,K,TI=',2I3,F6.1,' F0,FM,FP=',3F7.3) - ZM=-25.0 - ZP=25.0 - Z=T-TI - D=ZM*ZP*(ZP-ZM) - A=(ZP**2*FM-ZM**2*FP)/D - B=(ZM*FP-ZP*FM)/D - DTROMB=F0+Z*(A+Z*B) - 99 RETURN - END -C ************************************************************** - SUBROUTINE TROMF13(TL,L,MM,T1R,T1I,T3R,T3I) -C add corrections to S11 and P13 for Tromberg's f13 5/16/01 RAA - DIMENSION P(21),I1(6),NI(6) - DATA P/0.039,0.366,0.4165,0.0,5.112,-44.511,66.85,70.59 - C,-0.1514,-0.211,0.475,9.98,55.499,-54.3 - C,0.0,0.0,-16.82,13482.0,-55386.0,27.6,-36.73/ - DATA I1/1,4,9,12,15,20/ - DATA NI/3,5,3,3,5,2/ - SAVE - IF(TL.GT.550.0) GO TO 99 - IF(L.GT.2) GO TO 99 - IF(MM.LT.2) GO TO 99 - ID=1 - IF(L.GT.1) ID=2 - IF(L.GT.1.AND.TL.GT.250.0) ID=3 - NID=NI(ID) - ID=I1(ID) - IE=4 - IF(L.GT.1) IE=5 - IF(L.GT.1.AND.TL.GT.180.0) IE=6 - NIE=NI(IE) - IE=I1(IE) - Z=TL/1000.0 - ZZ=1.0 - D13=0.0 - DO 1 I=1,NID - D13=D13+P(ID+I-1)*ZZ - 1 ZZ=ZZ*Z - ZZ=1.0 - E13=0.0 - DO 2 I=1,NIE - E13=E13+P(IE+I-1)*ZZ - 2 ZZ=ZZ*Z - E13=E13/10000.0 - D13=0.0174532*D13 -C write(*,222) tl,l,mm,t1r,t1i,t3r,t3i,d13,e13 -C 222 format(f7.2,2i3,' t1=',2f7.4,' t3=',2f7.4,' d13,e13=',2e12.4) - FCT=-1.333333 - IF(MM.EQ.3) FCT=-FCT/2.0 - ZR=E13*FCT - ZI=D13*FCT - D1=ATAN(T1I/(T1R+1.0E-8)) - D3=ATAN(T3I/(T3R+1.0E-12)) - IF(D3.LT.0.0) D3=D3+3.1415927 - ZZR=COS(D1+D3) - ZZI=SIN(D1+D3) - T1R=T1R+ZR*ZZR-ZI*ZZI - T1I=T1I+ZR*ZZI+ZI*ZZR - 99 RETURN - END -C **************************************************** - SUBROUTINE ADDRES(E,TR,TI,NL,P) -C add resonance "bump" to partial-wave 8/94 Arndt - DIMENSION P(30) - DATA WPI,WN/139.65,938.256/ - SAVE - IF(P(2).GT.0.0) GO TO 10 - DRL=1.0 - DIM=0.0 - WR=SQRT((WPI+WN)**2+2.0*WN*E) - WI=0.0 - CALL ADDRES2(WR,WI,DRL,DIM,TR,TI,NL,P) - GO TO 99 - 10 GT=P(2) - GE=P(1)*GT - IF(GE.EQ.0.0) GO TO 99 - GI=GT-GE - IF(GI.LE.0.0) GI=0.0 - ER=P(3) - IF(ER.EQ.0.0) GO TO 99 -C Z=SQRT(2.0*E**2/(E**2+ER**2)) - Z=2.0*E/(ER+E) - RE=SQRT(Z) - N=NL/10 - LE=NL-10*N - IF(LE.LT.0.OR.LE.GT.8) LE=1 - IF(LE.GT.0) RE=RE*Z**LE - RI=(E-150.0)/(ER-150.0) - IF(RI.LT.0.0) RI=0.0 - RI=RE*RI**3 - GE=GE*RE - GI=GI*RI - GT=GE+GI - Z=ER-E - D=Z**2+GT**2 - ZR=GE*Z/D - ZI=GE*GT/D - IF(P(4).EQ.0.0) GO TO 1 - SR=1.0-2.0*ZI - SI=2.0*ZR - Z2=ZR**2+ZI**2 - ZE=P(4)*Z2 - D2=1.0+ZE**2 - ZR=ZR+(SR*ZE-SI*ZE**2)/D2 - ZI=ZI+(SR*ZE**2+SI*ZE)/D2 - 1 SR=1.0-2.0*TI - SI=2.0*TR - TR=TR+SR*ZR-SI*ZI - TI=TI+SR*ZI+SI*ZR - 99 RETURN - END -C ****************************************************** - SUBROUTINE ADDRES2(WR,WI,DRL,DIM,TR,TI,NL,P) -C ADD RESONANCE FOR COMPLEX(WR,WI) ENERGY 10/18/94 ARNDT - DIMENSION P(4) - DATA WE,WIN/1078.0,1218.0/ - SAVE - GT=-P(2) - IF(GT.LT.20.0) GO TO 99 - WRES=ABS(P(3)) - GE=P(1)*GT - GI=GT-GE - IF(GI.LT.0.0) GI=0.0 - GE=GT-GI - N=NL/10 - LE=NL-10*N - D=1.0/(WR**2+WI**2) - ZR=1.0-D*WE*WR - ZIR=1.0-D*WIN*WR - Z=1.0-WE/WRES - ZZ=1.0-WIN/WRES - ZR=ZR/Z - ZIR=ZIR/ZZ - IF(WR.LT.WIN) ZIR=0.0 - IF(WI.EQ.0.0) GO TO 1 - ZI=D*WE*WI/Z - ZII=D*WIN*WI/ZZ - RER=ZR - REI=ZI - CALL SQZ(RER,REI) - RIR=ZIR**2-ZII**2 - RII=ZIR*ZII*2.0 - IF(LE.LT.1) GO TO 2 - DO 3 L=1,LE - Z=RER - RER=Z*ZR-REI*ZI - 3 REI=Z*ZI+REI*ZR - GO TO 2 - 1 REI=0.0 - IF(ZR.LE.0.0) ZR=0.0 - RER=SQRT(ZR) - IF(LE.GT.0) RER=RER*ZR**LE - RIR=ZIR**2 - RII=0.0 - 2 GER=GE*RER - GEI=GE*REI - IF(P(3).GT.0.0) GO TO 8 - ZR=(WR-WE)/(WRES-WE) - ZI=WI/(WRES-WE) - Z=GER - GER=Z*ZR-GI*ZI - GEI=ZR*GEI+Z*ZI - 8 GIR=GI*RIR - GII=GI*RII - GTR=GER+GIR - GTI=GEI+GII - DR=WRES-WR+GTI - DI=-WI-GTR - Z=DRL - DRL=Z*DR-DI*DIM - DIM=Z*DI+DR*DIM - D2=DR**2+DI**2 - TRR=(GER*DR+GEI*DI)/D2 - TRI=(GEI*DR-GER*DI)/D2 - IF(P(4).EQ.0.0) GO TO 5 - SR=1.0-2.0*TRI - SI=2.0*TRR - ZB=P(4)*GER**2/((WRES-WR)**2+GTR**2) - TBR=ZB/(1.0+ZB**2) - TBI=TBR*ZB - TRR=TRR+SR*TBR-SI*TBI - TRI=TRI+SR*TBI+SI*TBR - 5 SR=1.0-2.0*TI - SI=2.0*TR - TR=TR+SR*TRR-SI*TRI - TI=TI+SR*TRI+SI*TRR - 99 RETURN - END -C **************************************************** - SUBROUTINE ETA33(X,TR,TI) - DIMENSION P(4) - DATA P/70.71,160.1,221.0,0.0307/ -C CORRECTS PI-P,CXS P33 FOR N-G CROSS SECTION X=TLAB 11/91 ARNDT - SAVE - BW=P(1)**2/((X-P(2))**2+P(1)**2) - Z=X**2/(X**2+P(3)**2) - YS=P(4)*BW*Z - ETA=1.0-YS - TR=ETA*TR - TI=ETA*TI+(1.0-ETA)/2.0 - RETURN - END -C ********************************************************* - SUBROUTINE PRKIN(E,IRR,EPI,ZKCM,QCM) -C GET PION-PHOTOPRODUCTION KINEMATIC PARAMETERS - COMMON/PRKC/IPRK - DATA WP,WN,WPI0,WPIC/938.256,939.65,135.04,139.65/ - DATA EPIT/10.0/ - SAVE - IR=IRR - IF(IR.EQ.5) IR=1 - WT=WP - IF(IR.GT.2) WT=WN - WX=WP - IF(IR.EQ.2.OR.IR.EQ.4) WX=WN - WPI=WPI0 - IF(IR.EQ.2.OR.IR.EQ.3) WPI=WPIC - ZKCM=E/SQRT(1.0+2.0*E/WT) - S=WT*(WT+2.0*E) - QCM=0.0 - EPI=0.0 - STH=(WPI+WX)**2 - IF(S.LE.STH) GO TO 99 - QCM=SQRT((S-STH)*(S-(WPI-WX)**2)/4.0/S) - EPI=(S-STH)/2.0/WX - IF(IPRK.EQ.1) GO TO 99 -C the following makes Epi dependent upon Wcm and independent of charge -C channel. Generally used for solutions before April 1996. RAA - EPI=(S-(WP+WPIC)**2)/2.0/WP - IF(EPI.GE.EPIT) GO TO 99 - ST=(WP+WPIC)**2+2.0*EPIT*WP - Z=(S-STH)/(ST-STH) -C "STRETCH OUT" THRESHOLD BELOW EPI=10 MEV - EPI=EPIT*Z**2 - 99 RETURN - END -C *********************************************************** - SUBROUTINE PRBORN(EPI,EM,NF) - DIMENSION EM(6,2,6) - SAVE - CALL PROPEC(EPI,EM) - CALL PRNPOL(EPI,EM) - IF(NF.LT.3) GO TO 99 - CALL PREPV(EPI,EM) - CALL PROMEGA(EPI,EM) - IF(NF.LT.5) GO TO 99 - CALL PRRHO(EPI,EM) - 99 RETURN - END -C *********************************************************** - SUBROUTINE PROPEC(EL,EM) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),AA(4),BB(4),CC(4),F(12,4),QT(12) - C,QU(12),EM(6,2,6) - REAL qtmp - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ -C GN=SQRT(ALFA*G2)*HBARC = SQRT(13.75/137)*197.32 - DATA B,GPI2M/0,13.75/ - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 EM(M,J,L)=0.0 - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - GG=1000.0*GN/W - USCL=(W+WN)/2.0/Z1/Z2 - AA(1)=0.0 - AA(2)=0.0 - AA(3)=GG*Z2/Z1 - AA(4)=-GG*Z1*Q/Z2/ZK - BB(1)=-GG*W/Q/USCL/2.0 - BB(2)=GG*W/Z2**2/2.0/USCL - BB(3)=-AA(3) - BB(4)=-AA(4) - GG=GG*USCL - CC(1)=-GG*Z2**2/Q - CC(2)=GG - CC(3)=-GG*Z2**2/WN - CC(4)=-GG*Q/WN - CALL QJOFX(QT,ZT,8) - CALL QJOFX(QU,-ZU,8) - S=-1.0 - DO 11 L=1,8 - QU(L)=S*QU(L) - 11 S=-S - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - A=AA(K) - IF(I.GT.1) A=2.0*A/3.0 - IF(I.NE.2) A=-A - IF(I.EQ.1) B=CC(K)*(UN-UP)-BB(K) - IF(I.EQ.2) B=-(CC(K)*(2.0*UN+UP)+BB(K))/3.0 - IF(I.EQ.3) B=-(CC(K)*(2.0*UP+UN)+2.0*BB(K))/3.0 - DO 3 L=1,8 - 3 F(L,K)=(A*QT(L)+B*QU(L))/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF(L.GT.6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - EM(M,1,L)=E/ZL - GO TO 4 - 5 L=0 - 6 L=L+1 - IF(L.GT.6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) -C in order to bypass the boundary violation (L-1=0 !), 0 is used -C (I have no better idea) 12 nov 2007 E.Ch. -C - qtmp=0. - IF(L.GT.1) qtmp=F(L-1,3) - EE=ZL/(2.0*ZL+1.0)*(qtmp-F(L+1,3)) - E=E+EE - EM(M,2,L)=E/(ZL+1.0) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF(L.GT.6) GO TO 9 - ZL=L-1 - EM(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - GO TO 8 - 9 L=1 - 10 L=L+1 - IF(L.GT.6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - EM(M,2,L)=E/(ZL+1.0) - GO TO 10 - 2 CONTINUE - 99 RETURN - END -C ************************************************************** - SUBROUTINE PRNPOL(EL,EM) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EM(6,2,6) - DATA SQ2,WP,WN,UP,UN,GN/1.41421,135.04,938.256,1.793,-1.913,62.51/ -C GN=SQRT(ALFA*G2)*HBARC = SQRT(13.75/137)*197.32 -C ADD NUCLEON POLE TERMS TO OPEC EMS - DATA GPI2M/13.75/ - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - S=WN*(WN+2.0*EL) - W=SQRT(S) - ZK=EL/SQRT(1.0+2.0*EL/WN) - Q=SQRT((S-(WN+WP)**2)*(S-(WN-WP)**2)/4.0/S) - IF(Q.LT.0.0) GO TO 99 - Z2=SQRT(Q**2+WN**2) - ZU=-Z2/Q - ZT=SQRT(Q**2+WP**2)/Q - Z2=SQRT(Z2+WN) - Z1=SQRT(SQRT(ZK**2+WN**2)+WN) - GG=1000.0*GN/W/4.0/WN - ZM=Z1*Z2 - ZD=Z1/Z2 - EM(1,2,1)=EM(1,2,1)+GG*ZM*(UP-UN) - EM(2,1,2)=EM(2,1,2)+GG*(UP-UN)*Q*ZK/ZM - UB=(2.0*UN+UP)/3.0 - EM(3,2,1)=EM(3,2,1)+GG*(2.0*ZM*WN/(W+WN)-UP*ZK/ZD+UB*ZM) - EM(4,1,2)=EM(4,1,2)-GG*(2.0*Q*ZD*WN/(W+WN)+UP*Q*ZD-UB*Q*ZK/ZM) - UB=(2.0*UP+UN)/3.0 - EM(5,2,1)=EM(5,2,1)+GG*(UB*ZM-UN*ZK/ZD) - EM(6,1,2)=EM(6,1,2)+GG*(UB*Q*ZK/ZM-UN*Q*ZD) - 99 RETURN - END -C ************************************************************ - SUBROUTINE PREPV(EL,EM) -C ADD EXTRA TERM FOR PV COUPLING - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - REAL MN,MPI,MUN,MUP,G - DATA MN,MPI,PI,GPI2M/938.256,135.04,3.1415927,13.75/ - DATA MUP,MUN,CE,GN/1.793,-1.913,315.65,62.51/ -C G=SQRT(4*PI*G**2) CE=1000*SQRT(ALFA*G**2)=1000*SQRT(13.65/137) - DIMENSION EM(6,2,6) - SAVE - IF(GPI2.EQ.GPI2M) GO TO 20 - IF(GPI2.EQ.0.0) GPI2=GPI2M - GN=197.32*SQRT(GPI2/137.0) - GPI2M=GPI2 - 20 CONTINUE - CE=1000.0*GN - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - EM(1,2,1)=EM(1,2,1)+CE*(MUP-MUN)*Z1*Z2*(WC-MN)/8.0/WC/MN**2 - EM(3,2,1)=EM(3,2,1) - & +CE*(2.0*MUP+MUN)*Z1*Z2*(WC-MN)/12.0/WC/MN**2 - EM(5,2,1)=EM(5,2,1) - & +CE*(MUP+2.0*MUN)*Z1*Z2*(WC-MN)/12.0/WC/MN**2 - EM(2,1,2)=EM(2,1,2) - & -CE*(MUP-MUN)*(WC-MN)*RQ*Z1/Z2/8.0/WC/MN**2 - EM(4,1,2)=EM(4,1,2) - & -CE*(2.0*MUP+MUN)*(WC-MN)*RQ*Z1/Z2/12.0/WC/MN**2 - EM(6,1,2)=EM(6,1,2) - & -CE*(MUP+2.0*MUN)*(WC-MN)*RQ*Z1/Z2/12.0/WC/MN**2 - RETURN - END -C ********************************************************** - SUBROUTINE PROMEGA(EL,EM) -C* -C* PROGRAM TO CALCULATE T-CHANEL OMEGA CHANGE TERM -C* THE CORRESPONDING EXEC FILE IS GOOS - IMPLICIT REAL (A-H,O-Z) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),ET(6,2,6),EM(6,2,6),F(12,4) - REAL QL(12),MN,MPI,C,BB(4),ZL,ZZ,MW - REAL EL,E1,E2,PI,LW,G1W,G2W,G1,G2,E - REAL qtmp - DATA PI/3.1415926/ - DATA MN,MPI,MW/938.256,135.04,782.6/ - DATA G1W,G2W/16.0,0.0/ - DATA B/0/ - SAVE -C IF(GOMS.NE.27) GO TO 20 -C GOMS=28.0 - G1W=GOM1 - G2W=GOM2 - 20 IF(G1W.EQ.0.0) GO TO 99 - LW=0.36 - LW=LW*SQRT(4.0*PI*1.0/137.0) - G1=197.3*LW*G1W/0.1395 - G2=197.3*LW*G2W/0.1395 - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - C=(WC-MN)/(8.0*PI*WC) - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - BW=(MW**2+2.0*RK*EPI-MPI**2)/(2.0*RK*RQ) - C1=C*G1 - C2=C*G2 - BB(1)=C1*Z1*Z2/RK/RQ*(WC-MN-RK*EPI/(WC-MN)+RK*RQ*BW/(WC-MN)) - BB(2)=C1*Z1/Z2/RK*(WC+MN-RK*EPI/(WC+MN)+RK*RQ*BW/(WC+MN)) - BB(3)=-C1*Z1*Z2/RK - BB(4)=-C1*Z1/Z2*RQ/RK - BB(1)=BB(1)-C2*Z1*Z2*MW**2/(2.0*RQ*RK*MN) - BB(2)=BB(2)+C2*(Z1/Z2)*MW**2/(2.0*RK*MN) - BB(3)=BB(3)+C2*Z1*Z2*(WC-MN)/(RK*2.0*MN) - BB(4)=BB(4)-C2*Z1/Z2*RQ*(WC+MN)/(2.0*MN*RK) - CALL QJOFX(QL,BW,8) - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 ET(M,J,L)=0.0 - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - IF (I .EQ. 1) B=BB(K) - IF (I .EQ. 2) B=BB(K)/3.0 - IF (I .EQ. 3) B=-BB(K)/3.0 - DO 3 L=1,8 - 3 F(L,K)=B*QL(L)/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF (L .GT. 6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - ET(M,1,L)=E/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 4 - 5 L=0 - 6 L=L+1 - IF (L .GT. 6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) -C in order to bypass the boundary violation (L-1=0 !), 0 is used -C (I have no better idea) 12 nov 2007 E.Ch. -C - qtmp=0. - IF(L.GT.1) qtmp=F(L-1,3) - EE=ZL/(2.0*ZL+1.0)*(qtmp-F(L+1,3)) - E=E+EE - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF (L .GT. 6) GO TO 9 - ZL=L-1 - ET(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 8 - 9 L=1 - 10 L=L+1 - IF (L .GT. 6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 10 - 2 CONTINUE - EM(1,2,1)=EM(1,2,1)-0.5*C1*Z1*Z2/(WC-MN) - EM(2,1,2)=EM(2,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN) - EM(3,2,1)=EM(3,2,1)-0.5*C1*Z1*Z2/(WC-MN)/3.0 - EM(4,1,2)=EM(4,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)/3.0 - EM(5,2,1)=EM(5,2,1)+0.5*C1*Z1*Z2/(WC-MN)/3.0 - EM(6,1,2)=EM(6,1,2)+0.5*C1*Z1/Z2*RQ/(WC+MN)/3.0 - 99 RETURN - END -C ***************************************** - SUBROUTINE PRRHO(EL,EM) - IMPLICIT REAL (A-H,O-Z) - COMMON/GOMEGA/GOM1,GOM2,GOMS,GPI2,GP1,GP2 - DIMENSION EPX(4),E2X(4),GC(4),ET(6,2,6),EM(6,2,6),F(12,4) - REAL QL(12),MN,MPI,C,BB(4),ZL,ZZ,MP - REAL EL,E1,E2,PI,LP,GP1,GP2,G1,G2,E - DATA MN,MPI,MP/938.256,135.04,770.0/ - DATA B/0/ - SAVE - IF(GP1.EQ.0.0) GO TO 99 - PI=4.0*ATAN(1.0) - LP=0.12 - LP=LP*SQRT(4.0*PI*1.0/137.0) - G1=197.3*LP*GP1/0.1395 - G2=197.3*LP*GP2/0.1395 - G2=G1*GP2 - CALL PRKIN(EL,1,EPIX,RK,RQ) - E1=SQRT(RK**2+MN**2) - WC=E1+RK - C=(WC-MN)/(8.0*PI*WC) - E2=SQRT(RQ**2+MN**2) - EPI=SQRT(RQ**2+MPI**2) - Z1=SQRT(E1+MN) - Z2=SQRT(E2+MN) - BW=(MP**2+2.0*RK*EPI-MPI**2)/(2.0*RK*RQ) - C1=C*G1 - C2=C*G2 - BB(1)=C1*Z1*Z2/RK/RQ*(WC-MN-RK*EPI/(WC-MN)+RK*RQ*BW/(WC-MN)) - BB(2)=C1*Z1/Z2/RK*(WC+MN-RK*EPI/(WC+MN)+RK*RQ*BW/(WC+MN)) - BB(3)=-C1*Z1*Z2/RK - BB(4)=-C1*Z1/Z2*RQ/RK - BB(1)=BB(1)+C2*Z1*Z2*MP**2/(2.0*RQ*RK*MN) - BB(2)=BB(2)-C2*(Z1/Z2)*MP**2/(2.0*RK*MN) - BB(3)=BB(3)+C2*Z1*Z2*(WC-MN)/(RK*2.0*MN) - BB(4)=BB(4)-C2*Z1/Z2*RQ*(WC+MN)/(2.0*MN*RK) - CALL QJOFX(QL,BW,8) - DO 1 M=1,6 - DO 1 J=1,2 - DO 1 L=1,6 - 1 ET(M,J,L)=0.0 - M=0 - DO 2 I=1,3 - DO 3 K=1,4 - IF (I .EQ. 1) B=0.0 - IF (I .EQ. 2) B=BB(K) - IF (I .EQ. 3) B=BB(K) - DO 3 L=1,8 - 3 F(L,K)=B*QL(L)/2.0 - M=M+1 - L=2 - 4 L=L+1 - IF (L .GT. 6) GO TO 5 - ZL=L-1 - Z=(ZL+1.0)/(2.0*ZL+1.0) - ZZ=ZL/(2.0*ZL-1.0) - E=F(L,1)-F(L-1,2)-Z*(F(L-1,3)-F(L+1,3))-ZZ*(F(L-2,4)-F(L,4)) - ET(M,1,L)=E/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 4 - 5 L=0 - 6 L=L+1 - IF (L .GT. 6) GO TO 7 - ZL=L-1 - ZZ=(ZL+1.0)/(2.0*ZL+3.0) - E=F(L,1)-F(L+1,2)+ZZ*(F(L,4)-F(L+2,4)) - EE=ZL/(2.0*ZL+1.0)*(F(L-1,3)-F(L+1,3)) - E=E+EE - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 6 - 7 M=M+1 - L=1 - 8 L=L+1 - IF (L .GT. 6) GO TO 9 - ZL=L-1 - ET(M,1,L)=(F(L-1,2)-F(L,1)+(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0))/ZL - EM(M,1,L)=EM(M,1,L)+ET(M,1,L) - GO TO 8 - 9 L=1 - 10 L=L+1 - IF (L .GT. 6) GO TO 2 - ZL=L-1 - E=F(L,1)-F(L+1,2)-(F(L-1,3)-F(L+1,3))/(2.0*ZL+1.0) - ET(M,2,L)=E/(ZL+1.0) - EM(M,2,L)=EM(M,2,L)+ET(M,2,L) - GO TO 10 - 2 CONTINUE - EM(3,2,1)=EM(3,2,1)-0.5*C1*Z1*Z2/(WC-MN)-0.5*C2*Z1*Z2/MN - EM(4,1,2)=EM(4,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)+0.5*C2*Z1/Z2*RQ/MN - EM(5,2,1)=EM(5,2,1)-0.5*C1*Z1*Z2/(WC-MN)-0.5*C2*Z1*Z2/MN - EM(6,1,2)=EM(6,1,2)-0.5*C1*Z1/Z2*RQ/(WC+MN)+0.5*C2*Z1/Z2*RQ/MN - 99 RETURN - END -C ****************************************************** - SUBROUTINE QJOFX(QS,Y,LMAX) -C VERWEST ALGORITHMS, MOD 6/86 FOR LARGE X ARNDT - IMPLICIT DOUBLE PRECISION(A-H,O-Z) - REAL QS,Y,CN,ZN,ZL - DIMENSION QL(12),QS(12) - X=Y - IWRIT=6 - IF(LMAX.LT.2) LMAX=1 - LL=LMAX+1 - DO 1 L=1,LL - 1 QS(L)=0. - IF(X.LT.2.) GO TO 5 -C POWER SERIES IN 1/X ARNDT 6/17/86 - Z=1./X - ZZ=Z - ZN=-1. - 20 ZN=ZN+2. - CN=ZZ/ZN - DO 21 L=1,LL - ZL=L - QS(L)=QS(L)+CN - CN=CN*Z*(ZN+ZL-1.)/(ZN+2.*ZL) - IF(CN.LT.1.E-30) GO TO 22 - 21 CONTINUE - 22 ZZ=ZZ*Z**2 - IF(ZZ.GT.1.E-30) GO TO 20 - GO TO 2 - 5 L=LMAX - DO 100 II=1,2 - IF (X.LT.1.030) GO TO 600 -C ** ENTERING LARGE X EXPANSION - Z=1./(X+DSQRT(X*X-1.)) - ALF=2.*Z - DO 3 I=1,L - 3 ALF=DBLE(I)/DBLE(2*I+1)*ALF*2.*Z - CTOT=1. - CNOW=1. - DO 4 I=1,100 - CNOW=DBLE((2*I-1)*(I+L))/DBLE(2*I*I+2*I*L+I)*CNOW*Z*Z - CTOT=CTOT+CNOW - IF (CNOW/CTOT.LT.1.E-7 ) GO TO 99 - 4 CONTINUE - WRITE(IWRIT,333) - 99 QLOFX=ALF*CTOT - GO TO 601 -C ** ENTERING SMALL X EXPANSION - 600 Z=1.-1./X/X - SUM=0. - CNOW=1. - FNOW=DLOG(4.D0)-DLOG(Z) - IF (L.EQ.0) GO TO 299 - DO 18 JJ=1,L - 18 FNOW=FNOW-2./DBLE(JJ) - 299 DO 48 I=01,100 - SUM=SUM+CNOW*FNOW - IF (DABS(CNOW*FNOW/SUM ).LT.1.E-7 ) GO TO 199 - CNOW=CNOW*DBLE((L+2*I)*(L+2*I-1))/4./DBLE(I*I)*Z - 48 FNOW=FNOW+2.*(1./DBLE(I)-1./DBLE(L+2*I-1)-1./DBLE(2*I+L)) - 199 QLOFX=.5/(X**(L+1))*SUM - 601 QL(II)=QLOFX - 100 L=L-1 - QJ1=QL(2) - QJ2=QL(1) - QS(LMAX+1)=QJ2 - QS(LMAX)=QJ1 - DO 999 IOP=2,LMAX - J=LMAX-IOP+1 - QJ=(DBLE(2*J+1)*QJ1*X-DBLE(J+1)*QJ2)/DBLE(J) - QS(J)=QJ - QJ2=QJ1 - 999 QJ1=QJ - 333 FORMAT (' WARNING **** QLS MAY NOT BE RIGHT *** SUM ENDED') - 2 RETURN - END -C ********************************************************* - SUBROUTINE CMFN(WR,WI,WZ,WTR,WTI,LMX,CR,CI) -C CHEW-MANDELSTAM FUNCTIONS 7/17/80 ARNDT -C INT(0,1) OF X**(L+1/2)/PI/(X-Z) -C Z=(W-WT)/(W-WZ) - DIMENSION CR(20),CI(20) - DATA PI/3.1415927/ - DATA ZC/2./ - SAVE - IF(LMX.GT.10) LMX=10 - DO 10 L=1,LMX - CR(L)=0. - 10 CI(L)=0. - DR=WR-ABS(WZ) - D2=DR**2+WI**2 - IF(D2.LT.1.) GO TO 99 - ZR=((WR-WTR)*DR+WI*(WI-WTI))/D2 - ZI=(DR*(WI-WTI)-WI*(WR-WTR))/D2 - AR=ZR - AI=ZI - CALL SQZ(AR,AI) - IF(WZ.LT.0..AND.ZI.LT.0.) AR=-AR - IF(WZ.LT.0..AND.ZI.LT.0.) AI=-AI - Z2=ZR**2+ZI**2 - IF(Z2.LT.ZC**2) GO TO 11 -C USE POWER SERIES FOR Z GTO INF - RR=ZR/Z2 - RI=-ZI/Z2 - L=0 - 12 TL=2*L - TL=(TL+3.)/2. - SR=-RR/PI/TL - SI=-RI/PI/TL - TR=SR - TI=SI - RT=SQRT(TR**2+TI**2) - DO 13 N=1,20 - R=TL/(TL+1.) - Z=TR - TR=R*(RR*Z-RI*TI) - TI=R*(RI*Z+RR*TI) - SR=SR+TR - SI=SI+TI - IF(R*RT.LT.1.E-6) GO TO 14 - 13 TL=TL+1. - 14 L=L+1 - CR(L)=SR - CI(L)=SI - IF(L.GE.LMX) GO TO 99 - GO TO 12 - 11 A2=AR**2+AI**2 - D=1.+A2+2.*AR - ZZR=(1.-A2)/D - ZZI=-2.*AI/D - CALL ALG(ZZR,ZZI) - BR=2./PI-AI+(AR*ZZR-AI*ZZI)/PI - BI=AR+(AR*ZZI+AI*ZZR)/PI - ZL=.5 - L=0 - 1 L=L+1 - CR(L)=BR - CI(L)=BI - IF(L.GE.LMX) GO TO 99 - ZL=ZL+1. - ZZ=BR - BR=ZR*BR-ZI*BI+1./PI/ZL - BI=ZI*ZZ+ZR*BI - GO TO 1 - 99 RETURN - END -C ********************************************************** - SUBROUTINE ALG(ZR,ZI) -C TAKE NATURAL LOG OF Z BRANCH CUT AT Z=0 TAKEN TO LEFT - DATA PI/3.1415927/ - SAVE - IF(ZR.EQ.0.) ZR=1.E-10 - ZM=ZR**2+ZI**2 - PHI=ATAN(ZI/ZR) - IF(ZR.GT.0.) GO TO 1 - IF(ZI.GE.0.) PHI=PHI+PI - IF(ZI.LT.0.) PHI=PHI-PI - 1 ZR=ALOG(ZM)/2. - ZI=PHI - RETURN - END -C ************************************************************** - SUBROUTINE SQZ(ZR,ZI) -C SQRT(Z) BRANCH CUT TAKEN TO LEFT OF Z=0 - DATA PI/3.1415927/ - SAVE - ZM=SQRT(SQRT(ZR**2+ZI**2)) - IF(ZR.EQ.0.) ZR=1.E-10 - PHI=ATAN(ZI/ZR) - IF(ZR.GT.0.) GO TO 1 - IF(ZI.LT.0.) PHI=PHI-PI - IF(ZI.GT.0.) PHI=PHI+PI - 1 PHI=PHI/2. - ZR=ZM*COS(PHI) - ZI=ZM*SIN(PHI) - RETURN - END -C *************************************************************** - FUNCTION OBSPRD(IT) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C OBSERV FOR PI-N PHOTOPRODUCTION HRX, HIX ARE AMPLITUDES IN UNITS -C of milli-Fermis -C IT=OBSERVABLE TYPE= 1(DSG), 2(P), 3(S), 4(T), 5(SGT) 6(G), 7(H) -C IT=8(EMRI), 9(E), 10(F), 11(OX), 12(OZ), 13(CX), 14(CZ), 15(TX) -C IT=16(TZ), 17(LX), 18(LZ), 19(ST3), 20(ST1), 21(ST31) -C IT=22(DX1), 23(DX3), 24(DX13) -C IT=25-32 Ox,Oz,Cx,Cz,Tx,Tz,Lx,Lz as measured -C in a RH lab system (z(u) along N and x(u) along y cross z) -C ROTATIONS to lab frame are from Yerevan group(Ox, Oz) -C COS(THR)=C*CN-G*S*SN ; C=cos(th(pi,cm)), CN=cos(th(N,lab)) -C G=(Eg+M)/W Lorentz factor from cm->lab -C CN=G(ALF-C)/SQRT(G**2*(ALF-C)**2+S**2) ALF=B*SQRT(1+M**2/Q**2) - DIMENSION H2(4) - data wpr,wpi/938.256,135.04/ - SAVE - IF(IT.GT.10.AND.IT.LT.19) OBSPRD=PROBSL(IT) - IF(IT.GT.24) OBSPRD=PROBSL(IT) - IF(IT.GT.10.AND.IT.LT.19) GO TO 99 - IF(IT.GT.24) GO TO 99 - QK=QCM/ZKCM - OBSPRD=0.0 - IF(IT.EQ.8) GO TO 99 - IF(IT.EQ.5.AND.THTA.LE.0.0) GO TO 99 - IF(IT.GT.18.AND.IT.LT.22) GO TO 99 - DSG=0.0 - DO 1 K=1,4 - H2(K)=HRX(K)**2+HIX(K)**2 - 1 DSG=DSG+H2(K) - IF(IT.EQ.5) GO TO 3 - IF(IT.EQ.22) DSG=H2(2)+H2(4) - IF(IT.EQ.23) DSG=H2(1)+H2(3) - IF(IT.EQ.24) DSG=H2(2)+H2(4)-H2(1)-H2(3) - IF(IT.GT.21) DSG=2.0*DSG - OBSPRD=QK*DSG/200.0 - IF(IT.GT.21) GO TO 99 - 30 GO TO (99,2,3,4,99,6,7,99,31,32),IT - 2 X=HIX(3)*HRX(1)-HIX(1)*HRX(3)+HIX(4)*HRX(2)-HIX(2)*HRX(4) - GO TO 8 - 3 X=HRX(1)*HRX(4)+HIX(1)*HIX(4)-HRX(2)*HRX(3)-HIX(2)*HIX(3) - GO TO 8 - 4 X=HRX(2)*HIX(1)-HRX(1)*HIX(2)-HRX(3)*HIX(4)+HIX(3)*HRX(4) - GO TO 8 - 6 X=HIX(4)*HRX(1)-HRX(4)*HIX(1)+HRX(2)*HIX(3)-HRX(3)*HIX(2) - GO TO 8 - 7 X=HIX(3)*HRX(1)-HRX(3)*HIX(1)+HIX(2)*HRX(4)-HRX(2)*HIX(4) - GO TO 8 - 31 X=(H2(4)-H2(1)-H2(3)+H2(2))/2.0 - GO TO 8 - 32 X=HRX(4)*HRX(3)+HIX(4)*HIX(3)+HRX(1)*HRX(2)+HIX(1)*HIX(2) - 8 OBSPRD=X/DSG*2.0 - IF(IT.EQ.5) OBSPRD=(1.0-OBSPRD)/(1.0+OBSPRD) - 99 RETURN - END -C ************************************* - FUNCTION PROBSL(IT) - COMMON/AMPLS/HRX(4),HIX(4),QCM,ZKCM,CS,EG -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C OBSERV FOR PI-N PHOTOPRODUCTION HRX, HIX ARE AMPLITUDES IN UNITS -C of milli-Fermis -C IT=OBSERVABLE TYPE= 1(DSG), 2(P), 3(S), 4(T), 5(SGT) 6(G), 7(H) -C IT=8(EMRI), 9(E), 10(F), 11(OX), 12(OZ), 13(CX), 14(CZ), 15(TX) -C IT=16(TZ), 17(LX), 18(LZ), 19(ST3), 20(ST1), 21(ST31) -C IT=22(DX1), 23(DX3), 24(DX13) -C IT=25-32 Ox,Oz,Cx,Cz,Tx,Tz,Lx,Lz as measured -C in a RH lab system (z(u) along N and x(u) along y cross z) -C ROTATIONS to lab frame are from Yerevan group(Ox, Oz) -C COS(THR)=C*CN-G*S*SN ; C=cos(th(pi,cm)), CN=cos(th(N,lab)) -C G=(Eg+M)/W Lorentz factor from cm->lab -C CN=G(ALF-C)/SQRT(G**2*(ALF-C)**2+S**2) ALF=B*SQRT(1+M**2/Q**2) - DIMENSION H2(4),GTH(10) - SAVE - PROBSL=0.0 - DSG=0.0 - DO 1 K=1,4 - H2(K)=HRX(K)**2+HIX(K)**2 - 1 DSG=DSG+H2(K) - IF(DSG.LE.0.0) GO TO 99 - ITT=IT-10 - IF(ITT.GT.10) ITT=ITT-14 - IUV=ITT/2 - IUV=ITT-2*IUV -C IUV=0(Cz), 1(Cx) .... - GO TO (33,33,35,35,37,37,39,39) ITT - 33 V=HRX(4)*HIX(3)-HIX(4)*HRX(3)+HRX(1)*HIX(2)-HIX(1)*HRX(2) -C Ox, Oz go here - U=HIX(1)*HRX(4)-HRX(1)*HIX(4)+HIX(3)*HRX(2)-HRX(3)*HIX(2) - GO TO 7 - 35 V=-HRX(4)*HRX(2)-HIX(4)*HIX(2)-HRX(1)*HRX(3)-HIX(1)*HIX(3) -C Cx, Cz go here - U=(H2(4)-H2(1)-H2(2)+H2(3))/2.0 - GO TO 7 - 37 V=HRX(1)*HRX(4)+HIX(1)*HIX(4)+HRX(2)*HRX(3)+HIX(2)*HIX(3) -C Tx, Tz go here - U=HRX(1)*HRX(2)+HIX(1)*HIX(2)-HRX(4)*HRX(3)-HIX(4)*HIX(3) - GO TO 7 - 39 V=HRX(4)*HRX(2)+HIX(4)*HIX(2)-HRX(1)*HRX(3)-HIX(1)*HIX(3) -C Lx, Lz go here - U=(H2(1)+H2(4)-H2(2)-H2(3))/2.0 - 7 CONTINUE - UP=U - VP=V - IF(IT.LT.20) GO TO 8 -C multiply by signs in table II of Knochlein... -C change signs of Cx, Cz - IF(ITT.EQ.3.OR.ITT.EQ.4) V=-V - IF(ITT.EQ.3.OR.ITT.EQ.4) U=-U -c nflag=pem(14,6,2,6)+0.1 -c ninv=nflag/10 -c nfg=nflag-10*ninv -c nflag=0(do cm quantities), 1(U,V), 2(U,-V), 3(-U,V), 4(-U,-V) -c nflag=5(UP=RUU, VP=RUV) -c nflag=10*ninv+nflag. ninv=0(R,A xform), 1(identity), 2(oz, ox) -c if(nfg.gt.2) U=-U -c if(nfg.eq.2.or.nfg.eq.4) v=-v -c nv=ninv - NV=0 -c nv=pem(19,6,2,6) - THTA=57.296*ACOS(CS) - CALL XFORM(EG,THTA,NV,U,V,UP,VP,D) - 8 X=UP - IF(IUV.EQ.1) X=VP - PROBSL=X/DSG*2.0 - 99 RETURN - END -C ************************************* - SUBROUTINE XFORM(EG,THT,NFRM,U,V,UP,VP,D) -C transform cm variables U,V (eg Cz,Cx) into UP,VP - dimension s4(3) - DATA WPR,WPI,EGM/938.256,135.04,0.0/ - SAVE - UP=U - VP=V -C No Xformation if NFRM = 1 -c IF(NFRM.EQ.1) GO TO 99 -C get kinematic factors - IF(EG.EQ.EGM) GO TO 1 - S=WPR**2+2.0*WPR*EG - Q2=(S-(WPR+WPI)**2)*(S-(WPR-WPI)**2)/4.0/S - B=EG/(EG+WPR) - BN=SQRT(Q2/(Q2+WPR**2)) - G=1.0/SQRT(1.0-B**2) - GN=1.0/SQRT(1.0-BN**2) - ALF=B/BN - 1 EGM=EG -c get angle factors C,S=COS(THT),SIN(THT) CN,SN=COS(thN),.. -c THT=PION cm angle, thN=NUCLEON lab angle - C=COS(0.0174532*THT) - S=SQRT(1.0-C**2) - CN=G*(ALF-C) - Z=CN**2+S**2 - CN=CN/SQRT(Z) - SN=SQRT(ABS(1.0-CN**2)) -C Yerevan(Ox, Oz) Xformation. This is a simple rotation so RVV -C is just COS(ROT) (they use a RH lab system) RAA 2/18/02 -C Consistent with Gilman if one starts with (-Cx, -Cz) in cm system -C as prescribed by Knochlein.., Photo and Electroproduction of eta -C Mesons Z.Phys(1992) - RVV=C*CN-G*S*SN -C P2=Q2*Z -C BL=SQRT(P2/(P2+WPR**2)) -C GL=1.0/SQRT(1.0-BL**2) -C Z=G*GN*(B*BN-C) -C RVV=C*CN-G*S*SN -C RVU=GN*S*CN-SN*Z -C ZKX=C*SN+G*S*CN -C ZKZ=-GN*S*SN-CN*Z -C ZKX0=G*B*S -C ZKZ0=G*GN*(B*C-BN) -C RUU=GL*(ZKZ-BL*ZKZ0) -C RUV=-GL*(ZKX-BL*ZKX0) -C This is a simple rotation so RUU=cos, Rvu=sin, Ruv=-sin, Ruu=Rvv - RUU=RVV - RVU=SQRT(ABS(1.0-RUU**2)) - if(nfrm.eq.1) rvu=-rvu - RUV=-RVU -c if(nfrm.ne.3) go to 3 -c rvv=-rvv -c rvu=-rvu -C use Gilman rotation (=180-th(Yerevan)) -c ruu=-ruu -c rvv=ruu -c rvu=sqrt(1.0-ruu**2) -c if(nfrm.eq.5) rvu=-rvu -c ruv=-ruv - 3 UP=RUU*U+RUV*V - VP=RVV*V+RVU*U - D=RUU*RVV-RUV*RVU - 99 RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/saide.F b/src/programs/Simulation/bggen_jpsi/code/saide.F deleted file mode 100644 index b6f9c6e58e..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/saide.F +++ /dev/null @@ -1,43 +0,0 @@ - REAL FUNCTION SAIDE(ENA,IREACA,ICUTA) -C -C--- Cross section (SAID) in mbarn -C - IMPLICIT NONE - REAL SAIDXSECA,ENA,STMP,SIMPSF - EXTERNAL STMP - INTEGER IREACA,ICUTA -C - COMMON/CSAID/ EN,COST,IREAC,ICUT - REAL EN,COST - INTEGER IREAC,ICUT -C - EN=ENA - IREAC=IREACA - ICUT=ICUTA - SAIDE=SIMPSF(STMP,-1.,1.,100)*2*3.1416 -C write(6,*) 'e,ireac,icut,saide=',en,ireac,icut,saide -C - SAIDE=SAIDE/1000. -C - END -C - REAL FUNCTION STMP(X) - REAL X -C - COMMON/CSAID/ EN,COST,IREAC,ICUT - REAL EN,COST - INTEGER IREAC,ICUT - REAL sum - INTEGER i -C - COST=X - sum=0. - DO i=1,2 - IF(IREAC.EQ.0.OR.i.EQ.IREAC) THEN - sum=sum+SAIDXSECA(EN,COST,i,ICUT) - ENDIF - ENDDO - STMP=sum -C write(6,*) STMP -C - END diff --git a/src/programs/Simulation/bggen_jpsi/code/saidxseca.F b/src/programs/Simulation/bggen_jpsi/code/saidxseca.F deleted file mode 100644 index ce0e8de382..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/saidxseca.F +++ /dev/null @@ -1,62 +0,0 @@ - REAL FUNCTION SAIDXSECA(E,COSTH,IPROC,ICUT) -C -C --- SAID gamma+p --> pi N cross section -C --- E - photons energy (E<2000 MeV) -C --- COSTH - cos of pion angle in CM -C --- IPROC = 1 - pi0 p -C 2 - pi+ n -C 3 ... is at the moment unclear to me -C Returns cross section in microbarn/ster for pion in CM -C -C--- SAID parametrization (the version I have) seems not to work above 2 GeV -C--- ELSA measurement gives 3.7 mub at 2 GeV and 1.25 nub at 3 GeV: -C For ICUT>0 (emx=2 GeV) I use exp(-1.*(E-emx))*SAID(emx) -C -C From I.Strakovsky, D.Arndt -C Follows Knochlein, Dreschel, Tiator, Z.Phys.A352(1995) 327-343 -C -C -C -C - IMPLICIT NONE - REAL E,COSTH - INTEGER IPROC,ICUT -C - REAL PRFAMP,OBSPRD - EXTERNAL PRFAMP,OBSPRD -C - REAL ee,fr(4),fi(4),dx3,res,fac,emx - INTEGER it -C - emx=2. - fac=1. - ee=E - IF(ICUT.GT.0.AND.ee.GT.emx) THEN - fac=EXP(-1.*(ee-emx)) - ee=emx - ENDIF -C - ee=ee*1000. - it=1 - res=0. - IF(ee.GT.155.) THEN - CALL SAIDGET(ee,COSTH,IPROC) - res=OBSPRD(it) -C res=10. - ELSE - res=0. - ENDIF - SAIDXSECA=res*fac -C - RETURN - END -C - SUBROUTINE SAIDGET(E,COSTH,IPROC) - IMPLICIT NONE - REAL E,COSTH,PRFAMP - INTEGER IPROC - REAL fr(4),fi(4),dx3,s -C - s=PRFAMP(E,COSTH,IPROC,fr(1),fi(1),dx3) - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/code/simpsf.F b/src/programs/Simulation/bggen_jpsi/code/simpsf.F deleted file mode 100644 index 9b02baf034..0000000000 --- a/src/programs/Simulation/bggen_jpsi/code/simpsf.F +++ /dev/null @@ -1,46 +0,0 @@ - REAL FUNCTION SIMPSF(FUN,X1,X2,N2) - IMPLICIT NONE -C -C === Integrate FUN between X1-X2 using Simpson method -C === N2 - number of intervals, even -C - REAL FUN,X1,X2 -C EXTERNAL FUN - INTEGER N2 -C - REAL step - DOUBLE PRECISION s1,s2,s - INTEGER i,n -C - SIMPSF=0. - IF(N2.LT.3) THEN - WRITE(6,*) ' *** SIMPSF error - N2=',N2 - GO TO 999 - ENDIF - IF(X1.GE.X2) THEN - WRITE(6,*) ' *** SIMPSF error - X1,X2=',X1,X2 - GO TO 999 - ENDIF -C - n=N2 - IF(MOD(N2,2).NE.0) n=n+1 - step=(X2-X1)/n -C - s1=0. - s2=0. -C - DO i=1,n-1,2 - s1=s1+DBLE(FUN(X1+step*i)) - ENDDO -C - DO i=2,n-2,2 - s2=s2+DBLE(FUN(X1+step*i)) - ENDDO -C - s=(DBLE(FUN(X1))+DBLE(FUN(X2))+s1*4.D0+s2*2.D0)*DBLE(step)/3.D0 - SIMPSF=s -C - 999 RETURN - END - - diff --git a/src/programs/Simulation/bggen_jpsi/fix_warnings.py b/src/programs/Simulation/bggen_jpsi/fix_warnings.py deleted file mode 100755 index 46afd23c29..0000000000 --- a/src/programs/Simulation/bggen_jpsi/fix_warnings.py +++ /dev/null @@ -1,153 +0,0 @@ -#!/usr/bin/python -# -# Dec. 18, 2013 David Lawrence -# -# This script is an attempt to automatically fix the -# over 500 warnings emitted when compiling bggen. These -# fill the nightly build messages and obscure any issues -# with our code. It was not completely successful in that -# numerous warnings still remain. Some of them are not -# easily fixed. I'm adding this script here in case it -# is useful as a starting point for someone else trying -# to fix the issues. -# -# To use this, first create a file with warning messages -# by running make or scons -u. I did this on ifarm1102 using -# gfortran 4.4.6 so other compilers might give differently -# formatted warnings which would cause this script to fail. -# -# scons -u > scons.out -# -# or -# -# make > scons.txt -# -# (I actually only tried it with the scons method) -# It's also worth nothing that I think I only ran this after -# having built everything once, then changed the pythia_h.F -# file so it was the only one contributing warnings. If -# all files are compiled, then one should modify this to -# only consider changes to the pythia_h.F file. -# -# Next, us this script to create a new pythia_h.F -# file. This should be run from the bggen directory -# (not bggen/code). -# -# ./fix_warnings.py -# -# This will use the scons.out and code/pythia_h.F files to -# generate a new pythia_h.F file in the current directory. -# (Therefore, you should probably not run this from the "code" -# directory. -# -# When it is done, move the new pythia_h.F file into the -# code directory, replcing the existing one: -# -# mv pythia_h.F code -# -# - -from collections import deque - -# Read in entire pythia_h.F file -f = open('code/pythia_h.F', 'r') -infile = f.read().split('\n') -f.close() - -# Replace any tabs with spaces -for i in range(1, len(infile)): - infile[i] = infile[i].replace('\t', ' ') - -f = open('scons.out', 'r') -prev= deque(['','','','','']) -for line in f: - prev.popleft() - prev.append(line) - - if 'Warning: Unused variable' in line: - first = line.find("'")+1 - last = line.find("'", first) - var = line[first:last].upper() - - first = prev[0].find('bggen/code/') + 11 - last = prev[0].find(':', first) - fname = prev[0][first:last] - - first = last + 1 - last = prev[0].find('.', first) - line_num = int(prev[0][first:last])-1 - - print "var=%s in %s at line %d" % (var, fname, line_num) - - - # Copy line of interest to working variable - s = infile[line_num] - - # Remember if the line ends with a comma - ends_with_comma = s.endswith(',') - - # if variable was array, we need to cut the "(XXX)" out too - first = s.find(var) - last = first + len(var) - if last0 - GEANT particle type -C P1,P2,TH1,TH2 - momentum and angle limits -C - IMPLICIT NONE - INTEGER IFL,KTYP - REAL P1,P2,TH1,TH2 -C - INCLUDE ? -C - INTEGER nm,im(4),i,j,k,ip,nn - REAL bm(4),pm(4,4),ef - REAL pp(4),pf,th,qq -C - EV_STAT=0. -C - DO j=1,4 - pp(j)=0. - ENDDO - nn=0 -C - DO ip=1,NP - IF(ITYP(1,ip).GT.0) THEN - IF(KTYP.EQ.0.OR.KTYP.EQ.ITYP(1,ip)) THEN - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip)**2 - ENDDO - pf=SQRT(qq) - th=ACOS(POUT(3,ip)/pf)*180./3.1416 - IF(pf.GE.P1 .AND.pf.LE.P2.AND. - + th.GE.TH1.AND.th.LE.TH2) THEN - DO j=1,3 - pp(j)=pp(j)+POUT(j,ip) - ENDDO - pp(4)=pp(4)+SQRT(qq+AM(ip)**2) - nn=nn+1 - ENDIF - ENDIF - ENDIF - ENDDO - -C - IF(IFL.EQ.0) THEN - EV_STAT=nn - ELSE IF(IFL.GE.1.AND.IFL.LE.4) THEN - EV_STAT=pp(IFL) - ENDIF -C - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/paw/example_1.kumac b/src/programs/Simulation/bggen_jpsi/paw/example_1.kumac deleted file mode 100644 index 288a410c27..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/example_1.kumac +++ /dev/null @@ -1,48 +0,0 @@ -MACRO example_1 -* -* --- example running on the bggen ntuple -* - idnt=9 - - clo 2 - h/fil 2 bggen.nt 0 -x - zone 2 2 - opt logy - 1dh 100 'energy' 700 0.1 12.1 - nt/pl //lun2/[idnt].pin(3,1) ! -100 - atit 'Photon energy, GeV' 'Events/bin' - 1dh 101 'energy' 150 0.1 3.1 - h/cop 101 102 - - nt/pl //lun2/[idnt].pin(3,1) ! -101 - atit 'Photon energy, GeV' 'Events/bin' - - col=0 - do i=1,10 - col=[col]+1 - if [col]=5 then - col=[col]+1 - endif - if [col]>7 then - col=1 - endif - set hcol [col] - nt/pl //lun2/[idnt].pin(3,1) iproc=[i] ! ! ! N 102 - h/pl 102 s - set hcol 1 - - enddo -exitm - opt logy - 1dh 110 'cos(theta)' 200 -1. 1. - nt/pl //lun2/[idnt].p_kin.f(1,3,2) iproc=5.and.np>3 - atit '-t' 'Events' - opt liny - nt/pl //lun2/[idnt].p_kin.f(2,5,4) iproc=4.and.np>3 -110 - atit 'cos(theta) decays, rho' 'Events' - - nt/pl //lun2/[idnt].efm.f(3,4,0,0)%efm.f(4,5,0,0) iproc=3.and.np>3.and.1.53.and.1.53.and.1.5Called by : GDECAY,GDECA3 * -C. * Author M.Hansroul ********* * -C. * * -C. ****************************************************************** -C. - DIMENSION BETA(4),PA(4),PB(4) -C. -C. ------------------------------------------------------------------ -C. - BETPA = BETA(1)*PA(1) + BETA(2)*PA(2) + BETA(3)*PA(3) - BPGAM = (BETPA * BETA(4)/(BETA(4) + 1.) - PA(4)) * BETA(4) - PB(1) = PA(1) + BPGAM * BETA(1) - PB(2) = PA(2) + BPGAM * BETA(2) - PB(3) = PA(3) + BPGAM * BETA(3) - PB(4) =(PA(4) - BETPA) * BETA(4) - END diff --git a/src/programs/Simulation/bggen_jpsi/paw/last.kumac b/src/programs/Simulation/bggen_jpsi/paw/last.kumac deleted file mode 100644 index 0592a4dc3d..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/last.kumac +++ /dev/null @@ -1,182 +0,0 @@ -*** Begin of history file: Tue Apr 28 10:44:23 2009 -shell cat last.kumac.old1 -h/fil 2 bggen.nt 0 -x -nt/lis //lun2 - nt/pl //lun2/9.ev_stat.f(0,8,0.1,12.,2.,110.) ! 1000 1 -zone 2 2 -h/cr/prof 101 ' ' 120 0.15 12.15 -1 100 -h/cr/prof 101 ' ' 120 0.15 12.15 -1 100 - nt/pl //lun2/9.ev_stat.f(0,8,0.1,12.,2.,110.) ! 1000 1 -nt/loop //lun2/9 bgg_pri.f(0)>-1 3 1 -nt/loop //lun2/9 bgg_pri.f(0)>-1 20 1 - nt/pl //lun2/9.pin(3,1) ! 1000 1 - nt/pl //lun2/9.pin(3,1) ! 1000 1 - nt/pl //lun2/9.pin(3,1) 8-1 1000 1 -nt/pri 9 - nt/pl //lun2/9.p_kin_auto.f(1,14) 8-1 1000 1 -nt/pl //lun2/9.p_kin_auto.f(1,14) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -opt liny - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -211 -loca -1dh 212 'efm' 200 0 1 - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -212 -1dh 212 'efm' 240 0 1.2 - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -212 -loca - nt/pl //lun2/9.sqrt(p_kin_auto.f(2,14)) 80 -211 - nt/scan //lun2/9 80 100 ! ! sqrt(p_kin_auto.f(2,14)) - nt/scan //lun2/9 80 1000 ! ! sqrt(p_kin_auto.f(2,14)) - nt/scan //lun2/9 10 1000 ! ! sqrt(p_kin_auto.f(2,14)) -mess $sigma(sqrt(0.938**2+2*8*0.938)) -mess $sigma(sqrt(0.938**2+2*9*0.938)) - nt/scan //lun2/9 80 1000 ! ! p_kin_auto.f(2,14) -mess $sigma(sqrt(0.938**2+2*8*0.938)) -mess $sigma(sqrt(0.938**2+2*9*0.938)) -1dh 213 'efm' 400 3.9 4.3 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -213 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -212 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -212 -h/pl 213 -loca - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 100 1 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 -nt/loop //lun2/9 82.5.and.bgg_pri.f(0)>-1 200 1 - nt/pl //lun2/9.p_kin_auto.f(2,14)%p_kin_auto.f(1,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -nt/loop //lun2/9 8-1 200 1 -nt/loop //lun2/9 8-1 2000 1 -nt/loop //lun2/9 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 20000 1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 100 1 -nt/pl //lun2/9.ityp(3,1) 8-1 100 1 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -h/pl 211 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 80 -211 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 - nt/pl //lun2/9.p_kin_auto.f(2,14) 80 -211 -opla -zone 2 2 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -211 -1dh 214 'efm' 400 0 4 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -214 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 60 -214 -clops -1dh 215 'efm' 400 0 4 - nt/pl //lun2/9.p_kin_auto.f(2,14) 60 -214 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 60 -215 -max 214 450 -max 215 450 -opla -zone 2 2 -h/pl 215 -h/pl 214 -clops -shell -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 -nt/pl //lun2/9.ityp(3,1) 8-1 -shell -h/cop 215 231 -h/cop 215 232 -h/cop 215 233 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 30 -231 -h/pl 231 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 110 -232 -nt/pl //lun2/9.ityp(3,1) 8-1 - nt/pl //lun2/9.p_kin_auto.f(2,-14) 110 -232 -h/pl 232 -max 232 0 -h/pl 232 -max 232 -1 -h/pl 232 -max 232 1 -h/pl 232 -max 232 100 -h/pl 232 -max 232 60 -h/pl 232 -nt/pl //lun2/9.ityp(3,1) 11-1 -dir -shell ls -alF -shell ls -alFL -nt/pl //lun2/9.ityp(3,1) -set csiz 0.4 -nt/pl //lun2/9.ityp(3,1) -nt/pl //lun2/9.ityp(3,1) 11-1 -2dh 302 'p-th' 120 0 120 120 0 12 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 1000000 -h/pl 302 -1dh 300 'p' 120 0 12. -nt/pl //lun2/9.part_kin.f(0,8,0,300) -h/pl 300 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) ! 10 1 -nt/pl //lun2/9.part_kin.f(0,8,0,300) -h/pl 100000- -h/pl 1000000 -h/pl 300 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 302 -nt/pl //lun2/9.part_kin.f(2,9,0,302) -h/pl 302 -2dh 302 'p-th' 180 0 180 120 0 12 -nt/pl //lun2/9.part_kin.f(2,8,0,302) -h/pl 302 -nt/pl //lun2/9.part_kin.f(0,0,2214,300) -h/pl 302 -nt/pl //lun2/9.part_kin.f(0,0,2214,302) -h/pl 302 -*** End of history file: Thu Apr 30 17:11:53 2009 diff --git a/src/programs/Simulation/bggen_jpsi/paw/p_kin.f b/src/programs/Simulation/bggen_jpsi/paw/p_kin.f deleted file mode 100644 index ace8f44e74..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/p_kin.f +++ /dev/null @@ -1,105 +0,0 @@ - REAL FUNCTION P_KIN(IFL,K1,K2) -C -C--- Kinematic variables: -C -C IFL=1 - -t (target --> -(K1-targ)**2) -C =2 - cos(th) of K1 in CM of K2 with respect to the K2 direction -C K2=0 - in CM -C - IMPLICIT NONE - INTEGER IFL,K1,K2,K3,K4 -C - INCLUDE ? -C - INTEGER i,j,kf1,kf2 - REAL var,qq,en1,en2,dir(3),p1(5),p2(5),pp1,pp2,px(4),pa(4) - + ,bet(4),ptar(5) -C - P_KIN=-20. - kf1=0 - kf2=0 - IF(K1.GE.1.AND.K1.LE.NP) THEN - kf1=1 - qq=0. - DO j=1,3 - p1(j)=POUT(j,K1) - qq=qq+p1(j)**2 - ENDDO - p1(4)=SQRT(qq+AM(K1)**2) - p1(5)=SQRT(qq) - ENDIF - IF(K2.GE.1.AND.K2.LE.NP) THEN - kf2=1 - qq=0. - DO j=1,3 - p2(j)=POUT(j,K2) - qq=qq+p2(j)**2 - ENDDO - p2(4)=SQRT(qq+AM(K2)**2) - p2(5)=SQRT(qq) - ENDIF - DO j=1,3 - ptar(j)=PIN(j,2) - ENDDO - ptar(5)=SQRT(ptar(1)**2+ptar(2)**2+ptar(3)**2) - ptar(4)=SQRT(ptar(5)**2+AMIN(2)**2) - - IF(kf1.EQ.0) GO TO 999 - var=-20. - - IF(IFL.EQ.1) THEN -C - var=AM(K1)**2+AMIN(2)**2-2.*p1(4)*ptar(4) - DO j=1,3 - var=var+2.*p1(j)*ptar(j) - ENDDO - var=-var -C - ELSE IF(IFL.EQ.2) THEN -C - IF(kf2.EQ.0) THEN - pp1=0. - pp2=0. - DO j=1,3 - p2(j)=POUT(j,1)+POUT(j,2) - pp1=pp1+POUT(j,1)**2 - pp2=pp2+POUT(j,2)**2 - ENDDO - p2(5)=SQRT(p2(1)**2+p2(2)**2+p2(3)**2) - p2(4)=SQRT(pp1+AM(1)**2)+SQRT(pp2+AM(2)**2) - ENDIF -C - IF(p2(5).GT.0.) THEN - DO j=1,3 - dir(j)=p2(j)/p2(5) - ENDDO - ELSE - dir(1)=0. - dir(2)=0. - dir(3)=1. - ENDIF - - DO j=1,3 - bet(j)=p2(j)/p2(4) - ENDDO - bet(4)=1./SQRT(1.-bet(1)**2-bet(2)**2-bet(3)**2) -C - CALL GLOREN(bet,p1(1),px(1)) - qq=0. - var=0. - DO j=1,3 - qq=qq+px(j)**2 - var=var+px(j)*dir(j) - ENDDO - var=var/SQRT(qq) ! COS(th) -C write(6,FMT='(5F10.4)') p2,var - ENDIF -C - P_KIN=var -C - 999 RETURN -C - END -C - INCLUDE 'efmass.f' - INCLUDE 'gloren.f' diff --git a/src/programs/Simulation/bggen_jpsi/paw/p_kin_auto.f b/src/programs/Simulation/bggen_jpsi/paw/p_kin_auto.f deleted file mode 100644 index 7c5b068450..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/p_kin_auto.f +++ /dev/null @@ -1,93 +0,0 @@ - REAL FUNCTION P_KIN_AUTO(IFL,KGEAN) -C -C--- Find the recoil candidate, the type ABS(KGEAN) (=14 - proton) -C--- KGEAN>0 - not originated from a resonance -C--- <0 - all -C--- Kinematic variables: -C -C IFL=1 - -t -C =2 - eff. mass of the rest -C - IMPLICIT NONE - INTEGER IFL,KGEAN -C - INCLUDE ? -C - INTEGER ip,ip1,ipm,i,j - REAL var,qq,en1,en2,p1(5),p2(5),tt,efmr,ptar(5) -C - P_KIN_AUTO=-20. - IF(KGEAN.EQ.0) GO TO 999 - ip1=0 - DO ip=1,NP - IF(ITYP(1,ip).EQ.ABS(KGEAN)) THEN - ipm=ITYP(4,ip) - IF(KGEAN.LT.0) THEN - ip1=ip - ELSE - IF(ipm.EQ.0) THEN - ip1=ip - ELSE IF(ipm.GT.0.AND.ipm.LE.NP) THEN -C IF(ABS(ITYP(4,ipm)).LE.100) THEN - IF(ABS(ITYP(4,ipm)).EQ.0) THEN - ip1=ip - ENDIF - ENDIF - ENDIF - ENDIF - ENDDO -C - IF(ip1.GT.0) THEN - qq=0. - DO j=1,3 - p1(j)=POUT(j,ip1) - qq=qq+p1(j)**2 - ENDDO - p1(4)=SQRT(qq+AM(ip1)**2) - p1(5)=SQRT(qq) -C - DO j=1,4 - p2(j)=0. - ENDDO - DO ip=1,NP - IF(ip.NE.ip1) THEN - IF(ITYP(1,ip).GT.0.AND.ITYP(5,ip).EQ.0) THEN - qq=0. - DO j=1,3 - p2(j)=p2(j)+POUT(j,ip) - qq=qq+POUT(j,ip)**2 - ENDDO - en2=SQRT(qq+AM(ip)**2) - p2(4)=p2(4)+en2 - ENDIF - ENDIF - ENDDO -C - qq=0. - DO j=1,3 - ptar(j)=PIN(j,2) - qq=qq+PIN(j,2)**2 - ENDDO - ptar(4)=SQRT(qq+AMIN(2)**2) -C - efmr=SQRT(p2(4)**2-p2(1)**2-p2(2)**2-p2(3)**2) - tt=AM(ip1)+AMIN(2)**2-2.*ptar(4)*p1(4) - DO j=1,3 - tt=tt+2.*ptar(j)*p1(j) - ENDDO -C - IF(IFL.EQ.1) THEN - var=-tt - ELSE IF(IFL.EQ.2) THEN - var=efmr - ENDIF - P_KIN_AUTO=var -C - ENDIF -C - 999 RETURN -C - END -C -C INCLUDE 'efmass.f' -C INCLUDE 'gloren.f' diff --git a/src/programs/Simulation/bggen_jpsi/paw/part_kin.f b/src/programs/Simulation/bggen_jpsi/paw/part_kin.f deleted file mode 100644 index 026683b076..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/part_kin.f +++ /dev/null @@ -1,67 +0,0 @@ - REAL FUNCTION PART_KIN(IFL,KGEANT,KPYTH,IDH) -C -C-- Fills IDH with the kin. parameters of all tracks of a given type -C IFL=0 - p -C =1 - theta (degrees) -C =2 - p(Y)-theta(x)(degrees) -C KTYP>0 - GEANT particle type -C <=0 use KPYTH - PYTHIA KF type -C - IMPLICIT NONE - INTEGER IFL,KGEANT,KPYTH,IDH -C - INCLUDE ? - LOGICAL HEXIST -C - INTEGER ip,j,ifirst,ievstart,nfind,ifind - REAL pf,th,qq - DATA ifirst/1/ - DATA ievstart/0/ -C - IF(ifirst.EQ.1.OR.IDNEVT.EQ.ievstart) THEN - IF(IDH.NE.0.AND.HEXIST(IDH)) THEN - CALL HRESET(IDH,' ') - ievstart=IDNEVT - ELSE - WRITE(6,*) ' *** ERROR: no histogram ID=',IDH - ENDIF - ENDIF - ifirst=0 -C - nfind=0 -C - DO ip=1,NP - ifind=0 - IF(KGEANT.GT.0) THEN - IF(KGEANT.EQ.ITYP(1,ip)) THEN - ifind=1 - ENDIF - ELSE IF(KPYTH.NE.0) THEN - IF(KPYTH.EQ.ITYP(3,ip)) THEN - ifind=1 - ENDIF - ENDIF -C write(6,*) ifind,KGEANT,KPYTH,ITYP(1,ip),ITYP(3,ip) - IF(ifind.NE.0) THEN - nfind=nfind+1 - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip)**2 - ENDDO - pf=SQRT(qq) - th=ACOS(POUT(3,ip)/pf)*180./3.1416 -C - IF(IFL.EQ.0) THEN - CALL HFILL(IDH,pf,0.,1.) - ELSE IF(IFL.EQ.1) THEN - CALL HFILL(IDH,th,0.,1.) - ELSE IF(IFL.EQ.2) THEN - CALL HFILL(IDH,th,pf,1.) - ENDIF - ENDIF - ENDDO -C - PART_KIN=nfind -C - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/paw/pi_plot.f b/src/programs/Simulation/bggen_jpsi/paw/pi_plot.f deleted file mode 100644 index d4edd4c40c..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/pi_plot.f +++ /dev/null @@ -1,204 +0,0 @@ - REAL FUNCTION pi_plot(IFL,KGEANT,KPYTH,IDH) -C -C-- Fills IDH with the kin. parameters of all photons from pi0 or eta decay. -c -c photons in fcal selected with energies > fcal_thresh -c photons in bcal selected with energies > bcal_thresh - -c idh with pi0s with photons in fcal only -c idh+1 with pi0s with photons in bcal only -c idh+2 with pi0s with one photon in fcal, one photon in bcal -c idh+3 with pi0s failing above cuts -c -C IFL=0 - p -C =1 - theta (degrees) -C =2 - p(Y)-theta(x)(degrees) -c KGEANT >0 GENAT particle type -C KTYP>0 - GEANT particle type -C <=0 use KPYTH - PYTHIA KF type -c IDH - number of histogram to be filled -c -c function based on part_kin, but to plot photons from pi0 (or eta) decay. -c Elton Smith 2/8/11 -c -C - IMPLICIT NONE - INTEGER IFL,KGEANT,KPYTH,IDH -C - INCLUDE ? - LOGICAL HEXIST -C - INTEGER ip,j,ifirst,ievstart,nfind,ifind,icnt - REAL thcut, fcal_thresh, bcal_thresh - INTEGER jj,nkind, ip1, ip2, itopol - REAL pf1,th1,qq,pf2,th2, ivmass - LOGICAL fcal1, fcal2, bcal1, bcal2 - DATA ifirst/1/ - data icnt /0/ - DATA ievstart/0/ - DATA thcut /10./ - DATA fcal_thresh, bcal_thresh /0.2, 0.2/ -c DATA fcal_thresh, bcal_thresh /0.5, 0.5/ -c DATA fcal_thresh, bcal_thresh /0.1, 0.06/ -c -c count entries -c - icnt = icnt + 1 -c -c valid codes are: -c KGEANT = 7, KPYTH = 111 (pi0) -c KGEANT = 17, KPYTH = 221 (eta) -c - if (KGEANT.eq.7) then - KPYTH = 111 - elseif (KGEANT.eq.17) then - KPYTH = 221 - elseif (KPYTH.eq.111) then - KGEANT = 7 - elseif (KPYTH.eq.221) then - KGEANT = 17 - else -c -c invalid codes -cc - write (6,*) ' *** pi_plot illegal code KGEANT, KPYTH =' , - 1 KGEANT,KPYTH - pi_plot =0 - return - endif -c -C - IF(ifirst.EQ.1.OR.IDNEVT.EQ.ievstart) THEN - IF (IDH.NE.0.AND.HEXIST(IDH) .or.HEXIST(IDH+1).or. - 1 HEXIST(IDH+2).or.HEXIST(IDH+3)) THEN - CALL HRESET(IDH,' ') - CALL HRESET(IDH+1,' ') - CALL HRESET(IDH+2,' ') - CALL HRESET(IDH+3,' ') - ievstart=IDNEVT - ELSE - WRITE(6,*) ' *** ERROR: no histogram ID=', - 1 IDH,idh+1,idh+2,idh+3 - ENDIF - ENDIF - ifirst=0 -C - nfind=0 - itopol =0 -C - DO ip=1,NP - ifind=0 -c -c find pi0 or eta -c - IF(KPYTH.EQ.ITYP(3,ip)) THEN - ip1 = ityp(5,ip) - ip2 = ityp(6,ip) - -c write(6,*) ifind,KGEANT,KPYTH,(ITYP(jj,ip),jj=1,6) -c -c check decay products are photons -c - If (ip2.eq.ip1+1) then - if ( ityp(3,ip1).eq. 22 .and. ityp(3,ip2).eq.22) then - - nfind=nfind+1 - ifind = 1 -c - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip1)**2 - ENDDO - pf1=SQRT(qq) - th1=ACOS(POUT(3,ip1)/pf1)*180./3.1416 -c - qq=0. - DO j=1,3 - qq=qq+POUT(j,ip2)**2 - ENDDO - pf2=SQRT(qq) - th2=ACOS(POUT(3,ip2)/pf2)*180./3.1416 - -c write (6,*) 'ip1, pf1, th1=',ip1,pf1,th1, -c 1 ' ip2, pf2,th2=',ip2,pf2,th2 -c -c invariant mass -c - ivmass = sqrt(2*(pf1*pf2 - pout(1,ip1)*pout(1,ip2) - 1 - pout(2,ip1)*pout(2,ip2) - 2 - pout(3,ip1)*pout(3,ip2) )) -c write (6,*) ' ivmass =', ivmass - - -c -c determine topology -c nominal: fcal 1-11 deg, bcal 11-126 deg -c - fcal1 = th1.gt.1 .and. th1.lt.11.and. pf1.gt.fcal_thresh - fcal2 = th2.gt.1 .and. th2.lt.11.and.pf2.gt.fcal_thresh - bcal1 = th1.gt.11 .and. th1.lt.126.and. pf1.gt.bcal_thresh - bcal2 = th2.gt.11 .and. th2.lt.126.and.pf2.gt.bcal_thresh - if (fcal1 .and. fcal2) then - itopol = 1 -c write (6,*) ' fcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - elseif (bcal1 .and. bcal2) then - itopol = 2 -c write (6,*) ' bcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - elseif (fcal1.and. bcal2 .or. bcal1.and.fcal2) then - itopol = 3 -c write (6,*) ' fcal-bcal th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - else - itopol = 4 -c write (6,*) ' None th1, th2, pf1,pf2=', th1, th2, pf1,pf2 - endif - - endif - - - endif - ENDIF - - IF(ifind.NE.0) THEN -C - IF(IFL.EQ.0) THEN - if (itopol .eq. 1) then - CALL HFILL(IDH,pf1,0.,1.) - CALL HFILL(IDH,pf2,0.,1.) - elseif (itopol .eq. 2) then - CALL HFILL(IDH+1,pf1,0.,1.) - CALL HFILL(IDH+1,pf2,0.,1.) - elseif (itopol .eq. 3) then - CALL HFILL(IDH+2,pf1,0.,1.) - CALL HFILL(IDH+2,pf2,0.,1.) - else - CALL HFILL(IDH+3,pf1,0.,1.) - CALL HFILL(IDH+3,pf2,0.,1.) - endif -c - ELSE IF(IFL.EQ.1) THEN - if (itopol .eq. 1) then - CALL HFILL(IDH,th1,0.,1.) - CALL HFILL(IDH,th2,0.,1.) - elseif (itopol .eq. 2) then - CALL HFILL(IDH+1,th1,0.,1.) - CALL HFILL(IDH+1,th2,0.,1.) - elseif (itopol .eq. 3) then - CALL HFILL(IDH+2,th1,0.,1.) - CALL HFILL(IDH+2,th2,0.,1.) - else - CALL HFILL(IDH+3,th1,0.,1.) - CALL HFILL(IDH+3,th2,0.,1.) - endif - - ELSE IF(IFL.EQ.2) THEN - CALL HFILL(IDH,th1,pf1,1.) - ENDIF - ENDIF - ENDDO -C -c if (nfind.gt.0) write (6,*) -c 1 ' icnt, idnevt, nfind, itopol=', icnt, idnevt,nfind, itopol - pi_plot = nfind*10 + itopol -C - RETURN - END diff --git a/src/programs/Simulation/bggen_jpsi/paw/plot_pi0_photons.kumac b/src/programs/Simulation/bggen_jpsi/paw/plot_pi0_photons.kumac deleted file mode 100644 index 9dba45a4b4..0000000000 --- a/src/programs/Simulation/bggen_jpsi/paw/plot_pi0_photons.kumac +++ /dev/null @@ -1,141 +0,0 @@ -macro plot_pi0_photons -* -* Plot histograms obtained using pi_plot from the bggen.nt file -* 02/09/11 ES -* -* -* set options -* -* hi/create/title_global 'BGGEN Photons from [p]^0! /10 MeV/s E"g#0.1,0.06GeV' -hi/create/title_global 'BGGEN Photons from [p]^0! /10 MeV/s E"g#0.2GeV' -* hi/create/title_global 'BGGEN Photons from [c] /10 MeV/s E"g#0.5GeV' -* hi/create/title_global 'BGGEN Photons from [c] /10 MeV/s E"g#0.1,0.06GeV' -option ndate -option nbox -* set stat 1111111 -set stat 1111 -option stat -set fit 111 -option fit -option ngrid -* -* plotting options -* -* set * -set xmgl 4. -set ymgl 4. -set asiz 0.4 -* set xlab 2. -set xlab 1.25 -set ylab 1. -set xsiz 20. -set xmgl 3. -set ymgl 3. -set ysiz 20. -set gsiz 0.4 -* -* set font definitions to bold roman -* -set CFON -21 -set GFON -21 -set LFON -21 -set TFON -21 -set VFON -21 -set txfp -21 -set SMGU 0.02 -set SMGR 0.02 -set CSIZ 0.33 -set VSIZ 0.3 -set TSIZ 0.35 -set YHTI 0.9 -set HWID 3.0 -set BWID 3.0 -* -zone -* -* get ntuple -* -h/file 2 bggen.nt 0 -x -* -* define histograms per 10 MeV -* -* momentum -* -* 1dh 100 'fcal only photons' 400 0 4 -* 1dh 101 'bcal only photons' 400 0 4 -* 1dh 102 'fcal and bcal photons' 400 0 4 -* 1dh 103 'failed photons' 400 0 4 -* -* angle -* -1dh 100 'fcal only photons' 180 0 180 -1dh 101 'bcal only photons' 180 0 180 -1dh 102 'fcal and bcal photons' 180 0 180 -1dh 103 'failed photons' 180 0 180 -* -npts1 = 1001 -* -* message PDE ntubes dt DR sqrtDR pedr atten angle90 angle45 angle15 -* message [PDE] [ntubes] [dt] [DR] [sqrtDR] [pedr] [atten] [angle90] [angle45] [angle15] -* wait -* -emin=0 -emax=4 -ymin=0 -ymax=10000 -* KPHYTH flags gamma=22, pi0=111, eta=221 -nevents=999999999 -* -* nt/plot //lun2/9.pi_plot.f(0,0,111,100) pin(3,1).gt.2 [nevents] -* nt/plot //lun2/9.pi_plot.f(1,0,221,100) ! [nevents] -nt/plot //lun2/9.pi_plot.f(1,0,111,100) ! [nevents] -* -zone 2 2 -* -* open metafile -* -* for/file 66 plot_pi0_photons.ps -* meta 66 -111 -for/file 66 plot_pi0_photons_angle_cut2.eps -meta 66 -113 -* -* -option stat -option logy -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Fcal only p (GeV)' 'Photons/10 MeV/s' -* hi/plot 100 's' -hi/plot 100 -* igset chhe 0.3 -* exe window#push -* itx 0 1.1 'Angle "G# 10 deg' -* exe window#pop -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Bcal only p (GeV)' 'Photons/10 MeV/s' -* hi/plot 101 's' -hi/plot 101 -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Fcal and Bcal p (GeV)' 'Photons/10 MeV/s' -* hi/plot 102 's' -hi/plot 102 -csize = 0.05 -igset chhe [csize] -* hplot/null [emin] [emax] [ymin] [ymax] -* hplot/atitle 'Failed p (GeV)' 'Photons/10 MeV/s' -* hi/plot 103 's' -hi/plot 103 - -* -* -* - close 66 -* -exitm -return - diff --git a/src/programs/Simulation/bggen_jpsi/run/fort.15 b/src/programs/Simulation/bggen_jpsi/run/fort.15 deleted file mode 100644 index a777c8080d..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/fort.15 +++ /dev/null @@ -1,25 +0,0 @@ -LIST -C -C === INPUT file for BGGEN -C -TRIG 5000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -- writing out events -C HDDM simple ntuple -WROUT 1 0 0 - -NPRIEV 100 number of events to print -EPHLIM 0.15 10. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 10. electron beam energy -EPEAK 9.999 coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm -DCOLLIM 0.005 collimator diameter in m - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -RUNNO 2 specify run number - -STOP diff --git a/src/programs/Simulation/bggen_jpsi/run/particle.dat b/src/programs/Simulation/bggen_jpsi/run/particle.dat deleted file mode 100644 index 309fc4b507..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/particle.dat +++ /dev/null @@ -1,21 +0,0 @@ -* # mass width decay prod decay angle - 1 0.0 0. 0 0 0 0 - 2 0.000511 0. 0 0 0 0 - 3 0.000511 0. 0 0 0 0 - 4 0.0 0. 0 0 0 0 - 5 0.1057 0. 0 0 0 0 - 6 0.1057 0. 0 0 0 0 - 7 0.1350 0. 0 0 0 0 - 8 0.1396 0. 0 0 0 0 - 9 0.1396 0. 0 0 0 0 - 13 0.9396 0. 0 0 0 0 - 14 0.9383 0. 0 0 0 0 - 17 0.5475 0. 0 0 0 0 - 33 0.782 0. 0 0 0 0 - 34 1.0194 0. 0 0 0 0 - 35 0.9578 0. 0 0 0 0 - 42 0.7755 0. 0 0 0 0 - 43 0.7755 0. 0 0 0 0 - 44 0.7755 0. 0 0 0 0 - 80 0.7755 0.151 9 8 0 1 - 82 1.232 0.118 14 8 0 0 diff --git a/src/programs/Simulation/bggen_jpsi/run/pythia-geant.map b/src/programs/Simulation/bggen_jpsi/run/pythia-geant.map deleted file mode 100644 index cf78fab658..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/pythia-geant.map +++ /dev/null @@ -1,41 +0,0 @@ -! GEANT --> PYTHIA map -! GEANT type= id >0 (regular) - PYTHIA decays are forbidden -! type=-id PYTHIA decays are allowed -! GEANT PYTHIA Comment -! type KF - 1 22 ! gamma - 2 -11 ! e+ - 3 11 ! e- - 4 12 ! neutrino - 5 -13 ! mu+ - 6 13 ! mu- - 7 111 ! pi0 - 8 211 ! pi+ - 9 -211 ! pi- - 10 130 ! K0L - 11 321 ! K+ - 12 -321 ! K- - 13 2112 ! neutron - 14 2212 ! proton - 15 -2212 ! antiproton - 16 310 ! K0S - 17 221 ! eta - 18 3122 ! Lambda0 - 19 3222 ! Sigma+ - 20 3212 ! Sigma0 - 21 3112 ! Sigma- - 22 3322 ! Xi0 - 23 3312 ! Xi- - 24 3334 ! Omega- - 25 -2112 ! antineutron - 26 -3122 ! antiLambda0 - 27 -3112 ! antiSigma- - 28 -3212 ! antiSigma0 - 29 -3222 ! antiSigma+ - 30 -3322 ! antiXi0 - 31 -3312 ! antiXi+ - 32 -3334 ! antiOmega+ --80 113 ! rho 0 --81 223 ! omega0 --82 2224 ! Delta++ - diff --git a/src/programs/Simulation/bggen_jpsi/run/pythia.dat b/src/programs/Simulation/bggen_jpsi/run/pythia.dat deleted file mode 100644 index 4c3a7afc86..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/pythia.dat +++ /dev/null @@ -1,52 +0,0 @@ -! below follows commands sent to PYGIVE -msel=2 -MSTP(13)=2 -! MSTP(17)=6 -! MSTP(20)=4 -MSTP(20)=0 -! MSTP(38)=4 -! MSTP(51)=11 ! if pdflib is linked than non pythia-pdfs are available, -! like MSTP(51)=4046 -MSTP(58)=4 -! MSTP(61)=0 -! MSTP(71)=0 -! MSTP(81)=0 -! MSTP(82)=1 -MSTP(92)=4 -MSTP(101)=1 -MSTP(121)=1 -! ----------- Now all the PARPs ----------- -! PARP(2)=3.5 ! ecm, E_gamma =6.06 GeV -PARP(2)=2.54739 ! ecm, E_gamma =3.00 GeV -PARP(18)=0.17 -PARP(89)=1000 -PARP(91)=0.40 -PARP(93)=2. -PARP(99)=0.40 -PARP(102)=0.5 -PARP(103)=0.5 -PARP(104)=0.3 -PARP(111)=0. -PARP(121)=2. -PARP(161)=3.00 -PARP(162)=24.6 -PARP(165)=0.47679 -PARP(166)=0.67597 -! ----------- Now come all the switches for Jetset ----------- -PARJ(1)=0.029 -PARJ(2)=0.283 -PARJ(3)=1.20 -PARJ(21)= 0.40 -PARJ(23)=0.03 -PARJ(41)= 1.94 -PARJ(42)= 0.544 -PARJ(45 )= 1.05 -!---------------------------------------------------------------------- -MSTJ(12)=1 -MSTJ(45)=4 -MSTU(112)=4 -MSTU(113)=4 -MSTU(114)=4 -! ----------- Now all the CKINs for pythia ----------- -CKIN(1)=1. -CKIN(66)=100.0 ! Max for Q^2 diff --git a/src/programs/Simulation/bggen_jpsi/run/run.ffr b/src/programs/Simulation/bggen_jpsi/run/run.ffr deleted file mode 100644 index a777c8080d..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/run.ffr +++ /dev/null @@ -1,25 +0,0 @@ -LIST -C -C === INPUT file for BGGEN -C -TRIG 5000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -- writing out events -C HDDM simple ntuple -WROUT 1 0 0 - -NPRIEV 100 number of events to print -EPHLIM 0.15 10. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 10. electron beam energy -EPEAK 9.999 coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm -DCOLLIM 0.005 collimator diameter in m - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -RUNNO 2 specify run number - -STOP diff --git a/src/programs/Simulation/bggen_jpsi/run/run_jpsi.ffr b/src/programs/Simulation/bggen_jpsi/run/run_jpsi.ffr deleted file mode 100644 index decafa2cb5..0000000000 --- a/src/programs/Simulation/bggen_jpsi/run/run_jpsi.ffr +++ /dev/null @@ -1,78 +0,0 @@ -LIST -C -C === INPUT file for BGGEN -C -SIMUL 1 -C =0 - BG, =1 - J/psi -C -TRIG 10000 number of events to simulate -C TRIG 395000 number of events to simulate -C We expect 395kHz of hadronic rate at high luminosity -C -- writing out events -C HDDM simple ntuple -WROUT 1 0 1 - -NPRIEV 10 number of events to print -EPHLIM 8. 12. energy range in GeV - -RNDMSEQ 0 random number sequence integer values - -EELEC 12. electron beam energy -EPEAK 9. coherent peak energy -ZCOLLIM 7600. distance to the collimator in cm - -EPYTHMIN 3. minimal energy for PYTHIA simulation - -PARTINIT 1 14 GEANT types of the initial particles -C reac - J/psi: gamma p -> p J/psi tslope e1 e2 np cross section in nb -REACPAR 14 83 1.0 8.2300 13.0000 478 - 0.4296E-07 0.3736E-06 0.1191E-05 0.2656E-05 0.4915E-05 0.8112E-05 0.1239E-04 0.1787E-04 0.2472E-04 0.3306E-04 - 0.4303E-04 0.5477E-04 0.6843E-04 0.8414E-04 0.1020E-03 0.1223E-03 0.1450E-03 0.1704E-03 0.1985E-03 0.2295E-03 - 0.2635E-03 0.3008E-03 0.3414E-03 0.3855E-03 0.4332E-03 0.4847E-03 0.5401E-03 0.5996E-03 0.6633E-03 0.7313E-03 - 0.8038E-03 0.8810E-03 0.9629E-03 0.1050E-02 0.1142E-02 0.1239E-02 0.1341E-02 0.1449E-02 0.1563E-02 0.1682E-02 - 0.1807E-02 0.1938E-02 0.2076E-02 0.2219E-02 0.2370E-02 0.2526E-02 0.2690E-02 0.2860E-02 0.3037E-02 0.3221E-02 - 0.3413E-02 0.3612E-02 0.3818E-02 0.4032E-02 0.4254E-02 0.4483E-02 0.4721E-02 0.4966E-02 0.5220E-02 0.5482E-02 - 0.5753E-02 0.6032E-02 0.6320E-02 0.6616E-02 0.6922E-02 0.7236E-02 0.7560E-02 0.7893E-02 0.8235E-02 0.8587E-02 - 0.8948E-02 0.9319E-02 0.9699E-02 0.1009E-01 0.1049E-01 0.1090E-01 0.1132E-01 0.1175E-01 0.1219E-01 0.1265E-01 - 0.1311E-01 0.1358E-01 0.1406E-01 0.1456E-01 0.1506E-01 0.1558E-01 0.1611E-01 0.1665E-01 0.1720E-01 0.1776E-01 - 0.1833E-01 0.1891E-01 0.1951E-01 0.2011E-01 0.2073E-01 0.2136E-01 0.2201E-01 0.2266E-01 0.2333E-01 0.2401E-01 - 0.2470E-01 0.2540E-01 0.2611E-01 0.2684E-01 0.2758E-01 0.2833E-01 0.2910E-01 0.2987E-01 0.3066E-01 0.3146E-01 - 0.3228E-01 0.3311E-01 0.3395E-01 0.3480E-01 0.3567E-01 0.3655E-01 0.3744E-01 0.3834E-01 0.3926E-01 0.4019E-01 - 0.4114E-01 0.4210E-01 0.4307E-01 0.4405E-01 0.4505E-01 0.4606E-01 0.4709E-01 0.4813E-01 0.4918E-01 0.5024E-01 - 0.5132E-01 0.5241E-01 0.5352E-01 0.5464E-01 0.5577E-01 0.5692E-01 0.5808E-01 0.5926E-01 0.6045E-01 0.6165E-01 - 0.6286E-01 0.6409E-01 0.6534E-01 0.6660E-01 0.6787E-01 0.6916E-01 0.7046E-01 0.7177E-01 0.7310E-01 0.7444E-01 - 0.7580E-01 0.7717E-01 0.7855E-01 0.7995E-01 0.8136E-01 0.8279E-01 0.8423E-01 0.8568E-01 0.8715E-01 0.8863E-01 - 0.9013E-01 0.9164E-01 0.9317E-01 0.9471E-01 0.9626E-01 0.9783E-01 0.9941E-01 0.1010E+00 0.1026E+00 0.1042E+00 - 0.1059E+00 0.1075E+00 0.1092E+00 0.1109E+00 0.1126E+00 0.1143E+00 0.1160E+00 0.1178E+00 0.1195E+00 0.1213E+00 - 0.1231E+00 0.1248E+00 0.1267E+00 0.1285E+00 0.1303E+00 0.1322E+00 0.1340E+00 0.1359E+00 0.1378E+00 0.1397E+00 - 0.1416E+00 0.1436E+00 0.1455E+00 0.1475E+00 0.1495E+00 0.1514E+00 0.1535E+00 0.1555E+00 0.1575E+00 0.1596E+00 - 0.1616E+00 0.1637E+00 0.1658E+00 0.1679E+00 0.1700E+00 0.1721E+00 0.1743E+00 0.1764E+00 0.1786E+00 0.1808E+00 - 0.1830E+00 0.1852E+00 0.1874E+00 0.1897E+00 0.1919E+00 0.1942E+00 0.1965E+00 0.1987E+00 0.2011E+00 0.2034E+00 - 0.2057E+00 0.2081E+00 0.2104E+00 0.2128E+00 0.2152E+00 0.2176E+00 0.2200E+00 0.2224E+00 0.2249E+00 0.2273E+00 - 0.2298E+00 0.2323E+00 0.2348E+00 0.2373E+00 0.2398E+00 0.2423E+00 0.2449E+00 0.2474E+00 0.2500E+00 0.2526E+00 - 0.2552E+00 0.2578E+00 0.2604E+00 0.2630E+00 0.2657E+00 0.2683E+00 0.2710E+00 0.2737E+00 0.2764E+00 0.2791E+00 - 0.2818E+00 0.2846E+00 0.2873E+00 0.2901E+00 0.2929E+00 0.2956E+00 0.2984E+00 0.3013E+00 0.3041E+00 0.3069E+00 - 0.3098E+00 0.3126E+00 0.3155E+00 0.3184E+00 0.3213E+00 0.3242E+00 0.3271E+00 0.3300E+00 0.3330E+00 0.3359E+00 - 0.3389E+00 0.3419E+00 0.3449E+00 0.3479E+00 0.3509E+00 0.3539E+00 0.3570E+00 0.3600E+00 0.3631E+00 0.3661E+00 - 0.3692E+00 0.3723E+00 0.3754E+00 0.3785E+00 0.3817E+00 0.3848E+00 0.3880E+00 0.3911E+00 0.3943E+00 0.3975E+00 - 0.4007E+00 0.4039E+00 0.4071E+00 0.4103E+00 0.4136E+00 0.4168E+00 0.4201E+00 0.4234E+00 0.4266E+00 0.4299E+00 - 0.4332E+00 0.4366E+00 0.4399E+00 0.4432E+00 0.4466E+00 0.4499E+00 0.4533E+00 0.4567E+00 0.4601E+00 0.4635E+00 - 0.4669E+00 0.4703E+00 0.4737E+00 0.4772E+00 0.4806E+00 0.4841E+00 0.4875E+00 0.4910E+00 0.4945E+00 0.4980E+00 - 0.5015E+00 0.5050E+00 0.5086E+00 0.5121E+00 0.5156E+00 0.5192E+00 0.5228E+00 0.5264E+00 0.5299E+00 0.5335E+00 - 0.5371E+00 0.5408E+00 0.5444E+00 0.5480E+00 0.5517E+00 0.5553E+00 0.5590E+00 0.5627E+00 0.5663E+00 0.5700E+00 - 0.5737E+00 0.5774E+00 0.5812E+00 0.5849E+00 0.5886E+00 0.5924E+00 0.5961E+00 0.5999E+00 0.6036E+00 0.6074E+00 - 0.6112E+00 0.6150E+00 0.6188E+00 0.6226E+00 0.6264E+00 0.6303E+00 0.6341E+00 0.6380E+00 0.6418E+00 0.6457E+00 - 0.6496E+00 0.6534E+00 0.6573E+00 0.6612E+00 0.6651E+00 0.6690E+00 0.6730E+00 0.6769E+00 0.6808E+00 0.6848E+00 - 0.6887E+00 0.6927E+00 0.6967E+00 0.7006E+00 0.7046E+00 0.7086E+00 0.7126E+00 0.7166E+00 0.7206E+00 0.7247E+00 - 0.7287E+00 0.7327E+00 0.7368E+00 0.7408E+00 0.7449E+00 0.7490E+00 0.7530E+00 0.7571E+00 0.7612E+00 0.7653E+00 - 0.7694E+00 0.7735E+00 0.7776E+00 0.7818E+00 0.7859E+00 0.7900E+00 0.7942E+00 0.7983E+00 0.8025E+00 0.8067E+00 - 0.8108E+00 0.8150E+00 0.8192E+00 0.8234E+00 0.8276E+00 0.8318E+00 0.8360E+00 0.8402E+00 0.8445E+00 0.8487E+00 - 0.8529E+00 0.8572E+00 0.8614E+00 0.8657E+00 0.8700E+00 0.8742E+00 0.8785E+00 0.8828E+00 0.8871E+00 0.8914E+00 - 0.8957E+00 0.9000E+00 0.9043E+00 0.9086E+00 0.9129E+00 0.9173E+00 0.9216E+00 0.9259E+00 0.9303E+00 0.9347E+00 - 0.9390E+00 0.9434E+00 0.9478E+00 0.9521E+00 0.9565E+00 0.9609E+00 0.9653E+00 0.9697E+00 0.9741E+00 0.9785E+00 - 0.9829E+00 0.9874E+00 0.9918E+00 0.9962E+00 0.1001E+01 0.1005E+01 0.1010E+01 0.1014E+01 0.1018E+01 0.1023E+01 - 0.1027E+01 0.1032E+01 0.1036E+01 0.1041E+01 0.1045E+01 0.1050E+01 0.1054E+01 0.1059E+01 0.1063E+01 0.1068E+01 - 0.1072E+01 0.1077E+01 0.1081E+01 0.1086E+01 0.1090E+01 0.1095E+01 0.1100E+01 0.1104E+01 0.1109E+01 0.1113E+01 - 0.1118E+01 0.1122E+01 0.1127E+01 0.1131E+01 0.1136E+01 0.1141E+01 0.1145E+01 0.1150E+01 - -STOP diff --git a/src/programs/Simulation/bggen_jpsi/xsec_table/SConscript b/src/programs/Simulation/bggen_jpsi/xsec_table/SConscript deleted file mode 100644 index a113496d17..0000000000 --- a/src/programs/Simulation/bggen_jpsi/xsec_table/SConscript +++ /dev/null @@ -1,25 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify CERN environment variable is set -if os.getenv('CERN', 'nada')=='nada': - if env.Dir('.').srcnode().abspath.startswith(env.GetLaunchDir()): - print '============================================================' - print 'CERN environment variable not set. Skipping build of bggen' - print '============================================================' - -else: - - env = env.Clone() - - # Turn off warnings for bggen since Pythia has too many - fflags = env['FORTRANFLAGS'].remove('-Wall') - env.Replace(FORTRANFLAGS=fflags) - - sbms.AddCERNLIB(env) - sbms.AddHDDM(env) - sbms.executable(env, 'xsec_table') diff --git a/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.F b/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.F deleted file mode 100644 index b91986dea0..0000000000 --- a/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.F +++ /dev/null @@ -1,100 +0,0 @@ - REAL FUNCTION XSEC_JPSI(EB) -C--- J/psi photoproduction cross section (nb) near threshold: S.Brodsky et al PLB 498 (2001) -C--- The normalization is fit to the data at E>12 GeV (1 parameter) -C--- Calculates the cross_section * kineam_factor (phase space and tmin dependence) -C--- for 3 diagrams: -C 0) (s-s_thres)**0 -C 1) (s-s_thres)**2 -C 2) (s-s_thres)**4 -C - IMPLICIT NONE - REAL EB - REAL PHASE_V -C VECTOR PKIN_PSI(15) -C VECTOR CROSS_P(10,2) -C -C - INTEGER idiag - REAL e0,fkin,bsig,pow,s,s_thres,s0,am1,am2,am3,xx,xx0,scal - + ,tt,tslfac,xsec -C - REAL xsecfac(3) ! cross section factors for 3 diagrams (=cross section at E0=11 GeV) -C - XSEC_JPSI=0. - xsecfac(1)=0. ! 3-gluon exchange (1-x)**0 - xsecfac(2)=0.36 ! 2-gluon exchange (1-x)**2 - xsecfac(3)=0. ! 1-gluon exchange (1-x)**4 - - e0=11. ! Reference beam energy in GeV - this value was used in the fit (initially it was an arbitrary value) -C - am1=0.938 ! target mass - am2=3.1 ! J/psi mass - am3=0.938 ! recoil mass - tslfac=1.13 ! t-slope - the initial factor -C - s= am1**2+2.*am1*EB - s0=am1**2+2.*am1*e0 - s_thres=(am2+am3)**2 - IF(s.LE.s_thres.OR.s0.LE.s_thres) GO TO 999 -C - xx= (s_thres-am1**2)/(s-am1**2) - xx0=(s_thres-am1**2)/(s0-am1**2) -C -C-- Comment: Mark Srtikman defines x=1-(E_final-P_z_final)/M -C where E,P,M - parameters of the recoil -C - xsec=0. - DO idiag=1,3 - scal=xsecfac(idiag) - IF(scal.GT.1.E-10) THEN - pow=0. - tt=tslfac - IF(idiag.EQ.2) THEN - pow=2. - tt=tslfac*9./4. - ELSE IF(idiag.EQ.3) THEN - pow=4. - tt=tslfac*9./1. - ENDIF - fkin=PHASE_V(EB,am1,am2,am3,tt)/PHASE_V(e0,am1,am2,am3,tt) -C - bsig=1. - IF(idiag.GT.1) THEN - bsig=(1.-xx)**pow/(1.-xx0)**pow - ENDIF - bsig=bsig*(s-am1**2)**2/(s0-am1**2)**2 ! photon - ccbar coupling (from J.-M.Laget) -C - xsec=xsec+fkin*bsig*scal - ENDIF - ENDDO - XSEC_JPSI=xsec -C - 999 RETURN - END -C - REAL FUNCTION PHASE_V(EB,AM1,AM2,AM3,TT) -* phase space -* photoproduction: gamm+A-->Psi+A -* - IMPLICIT NONE - REAL EB,AM1,AM2,AM3,TT - INTEGER ifl -C - REAL s,ss,tmin,tmax,dsdt,b,pcm(2),ecm(2) -C -C PHASE_V=1. -c return - s=am1**2+2.*am1*EB -C - ss=SQRT(s) - dsdt=1./16/3.1415/(s**2+am1**4-2.*s*am1**2) - ecm(1)=(s-am1**2)/2./ss - ecm(2)=(s+am2**2-am3**2)/2./ss - pcm(1)=ecm(1) - pcm(2)=SQRT(ecm(2)**2-am2**2) - tmin=2.*(ecm(1)*ecm(2)-pcm(1)*pcm(2))-am2**2 - tmax=2.*(ecm(1)*ecm(2)+pcm(1)*pcm(2))-am2**2 - PHASE_V=dsdt/tt*(EXP(-tt*tmin)-EXP(-tt*tmax)) -C -C write(6,*) ss,dsdt,ecm,pcm,tmin,tmax,PHASE_V - END diff --git a/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.o b/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_jpsi.o deleted file mode 100644 index 2ff498587659743a4fe1540e3724e0cf327c344a..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4008 zcmb_eUuc_E6u)WKt?u9bIs}FJ5J6_d8M`rL)3IgF+kL_^*dVNd*qF_PPVHKoRO_H~ zP&WL?ig_rrhz~_yhVG%DNFRn~UB{vn?QpPyd&onT4Es<`AHpcs-?`tt$=BOPM7(gn zd(Q8kfA^eoZ}NdS+TP^zF+F_j0IPEvW$g70bvi7`Fx$d5vZ(F+Y7b3au${pP+vy*- zo#<8DiHsd}#HgJU;}vc(9xPUPtf<)v?w~8vUOFUSDDrReHgzV;+or{vQCLSzf2eY+1|J^z$IpQ*@TvisW z6byEhcyL-8qF^8|@)aI0^56{_tJUm!>r`gj(gn+dPPdhz*Y5tW`%$=ft$`nD1|TdUG@l#)bTq!_yZ5#A?t`mb}ni$1H&_p zxKEb;jVhuuRA+TI7H*3wy&6MU7Gc{S9>k1H*~8JI zJ={M{WqQ@A+Rp9Tvof+uW>^$f$jFDIvjmfL8@10Rgy1`$s7D$X_j!;mhKf8cP(<{6 zPAod~%2<&+4^Gzn<|TfaaQf69I;$J9on?3{%XbkaLNB0S>Lpy+d~UU=Ml-N4L!dV% zrrwy&NjGVDxh#51V)WR?WL+W)Xf~Cq1zEw70{^Bkgpyt?^fy1)_1E%pPAt&f5!dRs zi|#CA-#+|oKbA1jYFyBSUgwWb9AK>N(5*o4!F0MkeDCx8!R6n62{C3JV(dZ~^B_BN z`0$H?;E`j|X99ad`$D^w@}p|?ojbvN1D0?5<_#@*bk7sOY0~%<{m%|2R zaT7%39tB3D(~nPWKjx=>7RtQeolTy?n(cGfE=~2N-cE+HsevpDy^+i&S?E+I!$N&M zE_1r4yE}CjduMyHsSpBwE|X23ehUJmmg-8R`;y%$>G*&61YiTlW$O)FVZ}d`ZC2l; zUp(*F4#vc2-`?y>wNY*`Her$Px@^J{-M&}X5b`CL$5D;Xt|+2pENkX*3+^lmA)DOn9}dif@; z-UEX4ue!Yq|D9L&Drr52xy=*5eA|EpFwNcu#C9~mp9M~Kw7z@;fxXZ`o(*JDrxS1X zX3m7#St8Nf^WK?EdN=FsN@h}tcM~l0PG2_7QUkr|x@3YuEDeJgXWT{h3iaaBvOB)? z;M5Bmzvsaz%NlQ14M08T&3>c-KI*}}e%n>kYCEdk*f9@InD*P{!O5?d@Acqb`7b;; z$?M;uuNvUj4LkrH8n+Bw+xgMJpK`_7Jp&Iayky`z75>1$wfvt3uHO-T6=>Ugt~PZ= zG`>gK-*4bL{^JIak7_o|I<1J}RZmm1(#3|!kOcyM~6bbaR<;14}Goj0uF*+dM6 jK5tlZjBRg#@AcqYA*=nKXn+TlJ+eY5S>f>h@V8U5VS}o3c9FRsD(s=8blNX1wjbsd7|h=$(;}du@HoG{tSPD zy_G*iu&~h1LeP14JGyMH5(jqX?VFjMxw+lzrM2aZk`pq?IyR!XJ$!syES)>vUi&8cao2jF9IE;q@k=bfSM_S_wx zJyWC&`pH-DQc^|Wns0QM@p2qJfnZB$F_p`e<7;;P86N2K=M$R)KGhNQgHAn>cq zRZk;daT60^#yXMBgcCB&t;mp70PjN2#n&f4Q)bBS*#)yT8oi}jo(5h-~3@mv< zZ7=|r5klKDZD%cB<|p(j1A8X$O{UDhoq5TZ|I){tJv-#zL$T~6=11H8r}d8DoNnq( zXLfLw?opM5sKg9|eIRsOw?nt7iJ+KjowA?>vW8H9V6(K-?rOW+%uZ?P z13y`pu-UBoAc=_~5MzQ*#s@Wo2eVa^Ha-|*cxYlDs+MFMYy2T9G0J+*%)Q&QcXvSW zBr|jGcg{WMJLmq)J*7X_Tj%jGDIWGDTj@!ZvG*HR+TC`uo2_GO*`ZMO`tzYP%X1ON zLNgivrBVsCGno!(-487QV`Xp*TEE$9j#v{KZi7}m8s;+yhO#q7=v8%9-!K*iFMsXC zgTdGgWi#F2W5)J$$+kfEt84hn=ZiSN33_!ET4cXk3EsEpu3B(aZvBl_#svViJ-NYY?!E$hz@^Yz?~XPuc!l;|EVrcy(3{CD z06p--au<;3jJ}L}edm#7-y7dS!>+Ym{u{oRr+xlekx$Ws({aPs2G7yioW7i<$P3eA zNdNSZ?_?pX&zG0j_@+=^pNDmM1%ulA+A%3&sG^wGj88-`oWZyfWvf!Z4Fg-GD2W zGBo{tT`1q!3_w5)<#cNqBgY7POa6}IVAWl0UjVA)5(Mg^hvN;(E!yG=r&1hoS2=G+&1bLWC9UdS}|+Jcw1W=*Tdlh;axmzL~R2n z|CD8d^{t6zpsKx9v*1{GYcfH8wJMCbeS1^g173Ubz2)pHhj^=YFJrj< znh8(2k8$4c#-z$40Mx>JT<}9K_?QcR&IP~df`8_M|KNgqV8UwgXB9u#a)(8R;n!%v zZ!D6sA`@oZGHO7P!DK?gP53tvOZ1Q$GRz44+l*nutfhh>BLs(d=tT8h_B0TSn$ZEc z160u}n}}fU1{hLk?UY}E8vxulK*Y9YxV`A=^V?ch#$_#Wo>6d*u7w9~%eD+62!c5J zl6Vq95Y_)j4s6@wUY7RX5FEFx#D5|?_Ypt)1g`R&Aoeuh za{@;U>n3^Nod5;-V9g}Yiv*|jnH9Ji_jh7XOC z;snRMEa87j;406{#GdlJB5=u5*1bUNX??yWIQ}Cg&p%x7)#8vxHRT@^xXSY=v8Ozf z0+&2PBHsyOPkEjvIIZV<1gCu3#Ziwuaj(g|x(SYTo)mFE7P!j)O9k&2_J0yTG_Pi{ znK3S{XS)mjEWv4BFA|*QWe8m5Ii=un!SgclLwObnPI+z?_dRufIpl+aI6hMT1(LJ* AK>z>% diff --git a/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_table b/src/programs/Simulation/bggen_jpsi/xsec_table/xsec_table deleted file mode 100755 index 80f67be2949894998b0a654dd13db357d5b27ff6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 15886 zcmcIr4RjONm7dX$En=`_OcE1FnIxtd)|P*8sFOkv0fC&@;5e{_4KT>EWUH|yt$x7d zgp|Z_PE^H-+tQY9)0WeAx3rtnLwj;smZsDMQj;#5HCwjzHk=$cC0)6=jZ@gvO-Q`o zee<3)8cU_;?Ad3J?z`W+_rCk?d-G=Ao0(6!TQ-_xSrW-4-6IjF%yBVD`<0}=D#miG zNwP^U=?+Peihx*gxL65MEhp$OH!Y}*%b7tfls9p}_ zMH(w8TEYO*BVX%ydEKHt3>P%Q{WvK6;d;c9-gd6Ho$CpDj0__QD%wYFqhm3*x7g$Y zN4$#&x1Oae7Qoxyig!|eav@0(b>+|vjFTimh28_uBR~JzB>b%H33jY%tnKNn=?R7s zeKmbet7=v?I%8pH1M}YjgVe-Lo3}C3A|CU3MP;CrCn{1gGV^ed-dr4Z9F$5lBHaKg ze4T?l)ltgJ3K42&rfay6Xalh{CTL7uFZ~e$!gsywV+C-MRrG>9e_H{3HyWMK{+$Kn zA1Hvo4m_WoqXqC)1?qjI0DfZu{NV!j2MWl4p@9790{Ev2*pV;}y8_{8Jn9Y6=vyhN zYFBSKq{iajXk1k#^}fAoyT2y@Q{F0l8W<%i-#V+@qANE+LenStgZ@8b8Zb*=;5tt--Xwj4+q2!ehs4q z^b`&`;Dc z{t@CSbP?qX{-<&+Z+mn3L(|>8IZEN$$uyV6Y@{F9SV`Suon_NC3vQQ1_)A4U1(AzvUM?gIN)1{u|TYDEBr>aP$Y}ZeyU}ijEU-BfY zf7j^%C8yv|Qu#K|<9}cVPJL*G0Z($ub1J>oBmdNM{=@i<8EYlNnth1`JN6|T(En?` z4fmvkx($jC{>X#d8PDUFT|_kRKS$o5df)8nzbt$18jDqGdY=Aa*^{&;P&%{V6(*mu zc9HB|W6?L$OA&#eS~r82sm%}Vy29)GNgFf0R!Ue|+%wL-Lk`T0?wVKu)uAEcpn1@f zJaF8TOdRthw;lB)TaUCP-G@CX_pvK>hh(ohd&R!vtYEL$w+|zK97PV`FM~f7us=4O zbYHt-f53gs?i_x^il4Y6<-V45AA+3wP`doXnVBp0GWRsG*X&i}P{mQ^KSXv@k|(u| zDl^%u(kQ`E);shQ8kR}-Gob6 z^V+$Ta*rq7kaxH*WkbmI-v<0{*8gxTG7_>AbQ4x1sa&f|r1`qB9-tGq8rSIEL~uG;J*DW?eRJce>N| z{y3&%k|Oq!z2DDSgF9@fQdjRhZ?F29z3Mz!hc9g8qAx~acr@w0NS6K@Rd{Dm9ZOkX z#7v!ZPmQ>z>5|cZVA^bd?%$D3xu-pcJ^g7pwPD~`lE#O_eZlUuJ`Z{OQ*;-Qvi33E zt10(n()|)tO^Mo+b(02?uM}fz7(AkYf#aCh#q#2;eChHssxNU{%DUO0bhoB-7A-sr z+n&J#I9ktm2DhE{3?|M|H#H}xJ;{;uYChr)&5{{(4|ACcZOqZcu^Th|W8*j*Q`R?d z&BBxg7v#rO^7P*TAVltq_9{9ttUu;FIuT<&<-VGvS;o;iWUqQTz2MJ$q%-^(!s!PS z-Fwqi;^>9!?lfvkvw0C+geVM?oan;b!Kd{$_0cHoGZ$!%*}>8@}|BLj8F;Upul8`(YvMv(g>z>xt3Il8eN8K^{#ZVfzx45SXZ{HK{29os{!(Kg)x zjSNhVYL|ORQ`VClaKW5r{s@yG^K>Vov-bisKbR&3t8k?!V_mdU?bhlrajDMr(z0??@Iyu+r!}Y&8HIrxbDVl>+M^z=BOqAdKE4C5LesO01W`d_OUW8yXH7uv+@V}BiDEP zO&At~jRyS5W8Cd#Rxns#xP3XRM($OUdn();85oCqup_0uLaHO~Nt&_m+BIo^?$^k$ zShMhB3ZdH|-k!8f-Eqaf0>|#Nn5!|TXAw3px1s~ZE!@S-5KB~e2Hh9o1G{xhhcT^b zQxLlxrqQj7ac=HyPcg@Eo0?=9&Q8mTqLlk$(mlq0FK93>DT8g8jMB*`KQDcqVor?` z=tZDY;Hgb~3Y*lXFuKv7HQ4LXYJfCD4I{K812jX?8tOVTRPz<;nAS1TIlB4d!#}d3 z3weru!-@u(zq2Qvw^(Ur65LCyan@_d`g=a(FD-no(6hQmiXay|*MeT0gyf^r#%4gK?;>W6r1Jj-xVN0^?WD zV+8Fuo0uAy!JTfO^~!0ilSq4%-3RTa+wjv^$Kb!ZCfx#^k2JKEw5$|RkBo5D-0d2~KcvSF9? zecYQVLsZn}^q3T|5pArr*pZpdVin!WiE>ZB*}SNTL|CFap2Tq# z_tJ|95psX4iI9Ka#4(NXHY(?d@RxAZpmR)FqT0*j}O}V${U_6a7wOhtka& zkw}C)Q@$CSuHj`|-0U492m>wpX?F-sWJX8S1VD2&-|>m%lN`5_4GvC$T|rBe2S>9!prosTlFBevIwS;3gN zjn02dwY(ps&-OYob#f=jLEG<0tX?Lsp0M3b)*9q4VEwlLB(YWUJ}^()=+@q{R(=v> z$VO+q#UoRY4%>c6OfzGS*iI62A7hT%ULodw#vHSqBc?@egwAo>FR0SZ%(r1%m`d8@ z1HjHmbCy$lU%a6fV1?xbHL~P8B=953N+s{($MO<2*H-f1lpm%(a-c6)04uUR4{k1X zE4e+7dVx^tQ-%%-w4BCI1q@@DEkczhhqVKuCP(pU5c6S_SchJOw8>&osK92Xxy59& zj1cHB_cCI6nTTROp>ba$gNpfaNS68l$#uow1~CqA`FS_0wD*Z}h)a%M;;1q5wz7~U zHxzG0eie?g{gS+r+35!-%_pyl{*gj3e*w%C{S##+xlCSKT3%uD1`CN-DW0x5OMYZo#XtjiWQmy?UGiZ9-~kc8}bqGzKj zo6Ajb+o59-^RmXA()nO{OV%!2O|LP~d1sP-NHLJ#FP(>9I+f`XC_A0C+JBeNSJUXk zoJB7rfRSpwkw~l-xmpdrcUyDIhFT{>w0kSRRGWxJYdKTf5sb%j5Q#lg_W2r|KB_Ag z@9gvkoZU1b#`j13F=Wv@s4f^r7Sor_ zhj9yy;za1-PPtjb zU$`gH8$7z(VjMQ7h>>+fg77!+>+2%=*hN(hx1(u`^n(cVltt5E~zXIWTN1} z;2u(^s<4Vj*=TGc=I?A^hS>9Uij)@7oQfXYs6`Y(Loo!^#I4jw zqek!`eDgMCJ+8DEph`_IwV|dnoWOeqHBEH@;)#%dO&6^hfAQY~_yAHmGYa-Eb-0zEHMN<=qkiEd(U<{+QCm7$qraOpH zj5Z_q`+~7RLuOEE?&$i1jXoNBs~Rz$)IhMu9|}Ve2=O#VQClLSbsWwPgi?%9)=9!5 z8*+$CZ@5z%jx5I7h}#>dmo3Bq&kSj;5LGZy@&xw7iMVbEh@Pim1%E_Z!85Yt71_J8 zkdP7-a}!Indq+u@+C=tt4Z*7h5vhLZ*92S1VMy{^h6v4%XGA(gc1s5GX2eCt8Qb5B zC`e8$;56DTa%iJJ8j+kKbf|OPz0EaoZcq+C+>4Vp7!Kty zD$1h%9xo~IT%;#1IfJ1fe&aNLodGZ?3wL_sUdie2Rs&IQuV3x%gs$KuCk?3>D%8j) zeJF%YZ*S0t3d1miA1AY|+3AQu8Y80DkCW8d>F-E%sdzsH3u3au*kC9S7I|++N7TPp zaCn={FY*Y7$fCDJ-2QKL5!5kD(`2qClZ#W0&^l3{NLHWj07GjQp}*MV0+)SXPhnj4 z2bYJOM4NuJ1{3-&lM9@L^%*15A&v06X>V+1FimdJndQ~1weiG~5$7W!h{ILh@!J4O9MU*Nq4eX$NrbA7RHC4GvsQGXvW ziU}9bth*I1DC&U-OTrJqN0HI%H}Q3xwqlT^aUsa5(5KsUN(XT0^_4j;g7MxhBhr}u zWgb96PbZG!(CJcEv|qqqLq@M(cZ-V^)$v*Qnh@kv^q+vgjST72*rG%`pc-XlR=kY*#~`NH zr#D(CxoBcRGPc*K&+cX+C+ctG`fXg_C~xFnf-a3cp)d9w#Cyi#{H61UlF%1^y#h?{ zzm4zP*luOw8F`J%>I*wRGw6$b9|zYzC=@vrdV>Dkpg+XxAL9DLPhm#r3I4y3AxyNN zUT30oZ_^as<9dP^^&JKDJ8#!Cri3D=M*YQH-`LKrcW4TY1^gFwmKCV~>5ppq z|8kxB>G_zU3Z}7cnWoqvD&lqwEQ_6(ySNA=O>|*KI>HAWg`)|F7=IO1h(yzDzWT@b z-R3I8gk`Ls87c5%ChttHS*7%bthmq67t-6ZE|W_SvAh|x=2%|bn%Vc&E15B)i0gPR zUYyxy&Bbk!xbEiSb29t7x%ds4>trroB8lr?E?o27C|%-{M#GoE&cc{vxqQ4;fQE`C#H|2!AJSrYSO zE?$B8ZjT;fd9$=|7Dj+s5=)faVzb0AI=L|97aI_bHA{SwGnASoK6%Z;mlzOj?lR%2 zMGL=g5dw5xTcmep1TQFgBI7F&ah(=8E%Ic1>0s;^I%nlP{o)2r^+pW!{vF4U8F0E! zB>5==-p}l3<1fzd&vN`I?-wy|9N~8M+~7hkn+mn}1&C04n+)TP=0zEI7gdW~StH1e zFnsnnr0XpCKYX(bxonz1HeZ~t6u_xN^2yU4d_J6ZUS(D?t``Xa+IpYS+{x&K=NH}vm!3)r~;TrnC4|C<8%pO~H5^VJ6o zpKWL{9Gj2+dYX?DdaglfDaR}4xfsu$fg)E2TwzG=PYdue+{KIeP+X2^lRck&0=Oej zJf8rbFP`6G_+05phl^Frp1C6Ty#n&T0$zsAU*mlBTaF(#%wty=K3}32%ySYhx)dLJ zeV!7nLnt{IuI2T=s|(&Zg};fN1?S3pV3?6)#}_VxD;hBMLJAD_3UNB0Gl%LO_)2_@1T83}9TrS-=RJ5H8e|@SimcWKAHtlBF5uc>7 zZ^Uwx>!5u7FXA+-#?QTANcUA&1Ury^b+4L@7$Wc&Kc&Ny3fdo5X`fva6{8^cn>#gc zZ1kVK8JZ-z1`cFC!OMh_womb4ok2xaQD=5Y#KLN~H`GaA{AmMO43xpB*o1&@555 Umz#ZDz&`$CgIoLNFSq9Z1q;opW&i*H diff --git a/src/programs/Simulation/filtergen/Makefile b/src/programs/Simulation/filtergen/Makefile deleted file mode 100644 index bb4d883598..0000000000 --- a/src/programs/Simulation/filtergen/Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -ADDITIONAL_MODULES = HDDM - - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/filtergen/filter.cc b/src/programs/Simulation/filtergen/filter.cc deleted file mode 100644 index 7557498c60..0000000000 --- a/src/programs/Simulation/filtergen/filter.cc +++ /dev/null @@ -1,77 +0,0 @@ -// $Id: smear.cc 2432 2007-02-06 04:19:48Z davidl $ -// -// Created June 22, 2005 David Lawrence - -#include -#include -using namespace std; - -#include -#include "HDDM/hddm_s.hpp" - - -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " - -//----------- -// Filter -//----------- -bool Filter(hddm_s::HDDM &record) -{ - // Return "true" to keep event, "false" to throw it away - - // Loop over Physics Events - hddm_s::PhysicsEventList pes = record.getPhysicsEvents(); - if (pes.size() == 0) - return false; - - //------------- FCAL ------------- - double Efcal = 0.0; - hddm_s::FcalTruthHitList fcals = record.getFcalTruthHits(); - hddm_s::FcalTruthHitList::iterator fiter; - for (fiter = fcals.begin(); fiter != fcals.end(); ++fiter) { - Efcal += fiter->getE(); - } - //_DBG_ << "Efcal=" << Efcal << std::endl; - // There must be at least 0.5 GeV in the FCAL to pass the level-1 trigger - if (Efcal < 0.5) - return false; - - //------------- BCAL ------------- - double Ebcal = 0.0; - hddm_s::BcalTruthHitList bcals = record.getBcalTruthHits(); - hddm_s::BcalTruthHitList::iterator biter; - for (biter = bcals.begin(); biter != bcals.end(); ++biter) { - Ebcal += biter->getE(); - } - //_DBG_ << "Ebcal=" << Ebcal << endl; - - //------------- TOF ------------- - int Ntof_north = 0; - int Ntof_south = 0; - hddm_s::FtofTruthHitList ftofs = record.getFtofTruthHits(); - hddm_s::FtofTruthHitList::iterator titer; - for (titer = ftofs.begin(); titer != ftofs.end(); ++titer) { - if (titer->getT() < 50.0 && titer->getT() > 0.0) { - if (titer->getEnd() == 0) - Ntof_north++; - else - Ntof_south++; - } - } - - // We want the number of TOF coincidences which we'll estimate as the - // lesser of the north and south hits - int Ntof = (Ntof_north < Ntof_south)? Ntof_north : Ntof_south; - //_DBG_ << "Ntof=" << Ntof << std::endl; - - // If there are no hits in the TOF or the BCAL has more energy, then - // cut the event - if (Ntof == 0 || Ebcal > Efcal) - return false; - - // Reject events with too many TOF hits - else if (Ntof > 6) - return false; - - return true; -} diff --git a/src/programs/Simulation/filtergen/filtergen.cc b/src/programs/Simulation/filtergen/filtergen.cc deleted file mode 100644 index 6e6993a053..0000000000 --- a/src/programs/Simulation/filtergen/filtergen.cc +++ /dev/null @@ -1,176 +0,0 @@ -// $Id: mcsmear.cc 2388 2007-01-10 16:46:03Z davidl $ -// -// Created August 24, 2007 David Lawrence - -#include -#include -#include -#include -using namespace std; - -#include -#include - -#include "HDDM/hddm_s.hpp" - -bool Filter(hddm_s::HDDM &record); -void ParseCommandLineArguments(int narg, char* argv[]); -void Usage(void); -void ctrlCHandle(int x); - -char *INFILENAME = NULL; -char *OUTFILENAME = NULL; -int QUIT = 0; - - -//----------- -// main -//----------- -int main(int narg,char* argv[]) -{ - // Set up to catch SIGINTs for graceful exits - signal(SIGINT,ctrlCHandle); - - ParseCommandLineArguments(narg, argv); - - std::cout << " input file: " << INFILENAME << std::endl; - std::cout << " output file: " << OUTFILENAME << std::endl; - - // Open Input file - std::ifstream *ifs = new ifstream(INFILENAME); - if (! ifs->is_open()) { - std::cout << " Error opening input file \"" << INFILENAME << "\"!" - << std::endl; - exit(-1); - } - hddm_s::istream *fin = new hddm_s::istream(*ifs); - - // Output file - std::ofstream *ofs = new ofstream(OUTFILENAME); - if (! ofs->is_open()) { - std::cout << " Error opening output file \"" << OUTFILENAME << "\"!" - << std::endl; - exit(-1); - } - hddm_s::ostream *fout = new hddm_s::ostream(*ofs); - - // Loop over events in input file - int NEvents_read = 0; - int NEvents_written = 0; - time_t last_time = time(NULL); - while (ifs->good()) { - NEvents_read++; - hddm_s::HDDM record; - *fin >> record; - time_t now = time(NULL); - if (now != last_time) { - std::cout << " " << NEvents_read << " events read -- " - << NEvents_written << " events written \r"; - std::cout.flush(); - last_time = now; - } - - // Write or don't depending on return value of Filter() - if (Filter(record)) { - *fout << record; - NEvents_written++; - } - - if (QUIT) - break; - } - - // close input and output files - delete fin; - delete ifs; - delete fout; - delete ofs; - - std::cout << std::endl << "FINAL:" << endl; - std::cout << " " << NEvents_read << " events read -- " - << NEvents_written << " events written" << std::endl; - std::cout << "Output file has " - << 100.0*(double)NEvents_written/(double)NEvents_read - << "% of the events that were in the input file." << std::endl; - return 0; -} - -//----------- -// ParseCommandLineArguments -//----------- -void ParseCommandLineArguments(int narg, char* argv[]) -{ - - for (int i=1; i - Options: -N (number of events to generate) - -O (default: eta_gen.hddm) - -I (default: eta548.in) - -R (default: 9000) - -h (Print this message and exit.) - Coupling constants, photon beam energy range, and eta decay products are - specified in the file. - -The decay products are specified by their GEANT ids; the four-momenta are -generated according to n-body phase space. - -Note that currently the width parameter in the specification of the decaying -particle is not being used. - -To generate events with an incoherent bremsstrahlung distribution, set the -coherent peak position to a value less than Emin. \ No newline at end of file diff --git a/src/programs/Simulation/genEtaRegge/SConscript b/src/programs/Simulation/genEtaRegge/SConscript deleted file mode 100644 index 607722ecbb..0000000000 --- a/src/programs/Simulation/genEtaRegge/SConscript +++ /dev/null @@ -1,14 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddCobrems(env) -sbms.AddROOT(env) -sbms.AddHDDM(env) -sbms.executable(env) - - diff --git a/src/programs/Simulation/genEtaRegge/eta548.in b/src/programs/Simulation/genEtaRegge/eta548.in deleted file mode 100644 index 9281de856d..0000000000 --- a/src/programs/Simulation/genEtaRegge/eta548.in +++ /dev/null @@ -1,15 +0,0 @@ -#Emin Emax (photon energy range) -7.0 11.7 -#Electron beam energy [GeV], coherent peak [GeV] and collimator diameter [m] -12.0 9.0 0.0034 50e-6 -#mass[GeV] width[GeV] -0.547853 0.000 -#g_eta_gamma_gamma g_rho_eta_gamma g_omega_eta_gamma g_phi_eta_gamma -0.0429 0.81 0.29 0.38 -#Number of decay particles -2 -#GEANT ids of decay particles (1=gamma,7=pi0, 8=pi+, 9=pi-, 17=eta). -1 1 - - - diff --git a/src/programs/Simulation/genEtaRegge/eta958.in b/src/programs/Simulation/genEtaRegge/eta958.in deleted file mode 100644 index be6c51c1a9..0000000000 --- a/src/programs/Simulation/genEtaRegge/eta958.in +++ /dev/null @@ -1,12 +0,0 @@ -#Emin Emax (photon energy range) -7.0 11.7 -#Electron beam energy [GeV], coherent peak [GeV] and collimator diameter [m] -12.0 9.0 0.0034 50e-6 -#mass[GeV] width[GeV] -0.95766 0.000205 -#g_eta_gamma_gamma g_rho_eta_gamma g_omega_eta_gamma g_phi_eta_gamma -0.1 1.27 0.41 0.67 -#Number of decay particles -3 -#GEANT ids of decay particles (1=gamma,7=pi0, 8=pi+, 9=pi-,17=eta) -17 8 9 diff --git a/src/programs/Simulation/genEtaRegge/genEtaRegge.cc b/src/programs/Simulation/genEtaRegge/genEtaRegge.cc deleted file mode 100644 index b0dddb3b16..0000000000 --- a/src/programs/Simulation/genEtaRegge/genEtaRegge.cc +++ /dev/null @@ -1,663 +0,0 @@ -// Main program for generating eta events. -#include "HDDM/hddm_s.h" -#include "particleType.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -using namespace std; - -#include - -// Masses -const double m_p=0.93827; // GeV -const double m_p_sq=m_p*m_p; -double m_eta=0.54775; // GeV -double m_eta_sq=m_eta*m_eta; -// Width -double width=0.; -// Coupling constants -double g_rho_eta_gamma=0.81; -double g_omega_eta_gamma=0.29; -double g_eta_gamma_gamma=0.0429; -double g_phi_eta_gamma=0.38; - -double Emin=3.,Emax=12.0; // GeV -double zmin=50.0,zmax=80.0; // cm, target extent -int Nevents=10000; -int runNo=10000; -bool debug=false; - -// Diagnostic histograms -TH1D *thrown_t; -TH1D *thrown_dalitzZ; -TH1D *thrown_Egamma; -TH2D *thrown_dalitzXY; -TH2D *thrown_theta_vs_p; -TH1D *cobrems_vs_E; - -char input_file_name[250]="eta548.in"; -char output_file_name[250]="eta_gen.hddm"; - -void Usage(void){ - printf("genEtaRegge: generator for eta production based on Regge trajectory formalism.\n"); - printf(" Usage: genEtaRegge \n"); - printf(" Options: -N (number of events to generate)\n"); - printf(" -O (default: eta_gen.hddm)\n"); - printf(" -I (default: eta548.in)\n"); - printf(" -R (default: 10000)\n"); - printf(" -h (Print this message and exit.)\n"); - printf("Coupling constants, photon beam energy range, and eta decay products are\n"); - printf("specified in the file.\n"); - - exit(0); -} - -//----------- -// ParseCommandLineArguments -//----------- -void ParseCommandLineArguments(int narg, char* argv[]) -{ - int seed=0; - if (narg==1){ - Usage(); - } - for(int i=1; i 36: %f\n",p_gamma*p_eta*sqrt(mass_factor)); - - // amplitude factors for terms involving 0, 1 and 2 powers of kappa - double amp_factor_kappa0 - =8.*p_gamma_sq*(q1sq_plus_q2sq*(s+q0_minus_q3*pt0_minus_pt3) - +q0_minus_q3_sq*pt_dot_q); - double amp_factor_kappa1=32.*p_gamma_sq*m_p*(q0_minus_q3_sq*t - +2.*q0_sq*q1sq_plus_q2sq); - double amp_factor_kappa2 - =32.*p_gamma_sq*(q1sq_plus_q2sq*(2.*q0_sq*(pt_dot_q-2.*m_p_sq) - -t*pt0_plus_pt3*pt0_plus_pt3 - +4.*pt_dot_q*q0*pt0_plus_pt3) - +q0_minus_q3_sq*(t*(pt_dot_q-2.*m_p_sq) - +2.*pt_dot_q*pt_dot_q) - ); - - // rho amplitude - double M_rho_sq=16.*M_PI*M_PI*(g_rho_eta_gamma*g_rho_eta_gamma/m_eta_sq)*c_rho_p_p*regge_rho*regge_rho - *(amp_factor_kappa0-kappa_rho/(4.*m_p)*amp_factor_kappa1 - +kappa_rho*kappa_rho/(16.*m_p_sq)*amp_factor_kappa2); - double M_rho=-sqrt(M_rho_sq); - - // omega amplitude - double M_omega_sq=16.*M_PI*M_PI*(g_omega_eta_gamma*g_omega_eta_gamma/m_eta_sq)*c_omega_p_p*regge_omega*regge_omega - *amp_factor_kappa0; - double M_omega=-sqrt(M_omega_sq); - - // phi amplitude - double M_phi_sq=16.*M_PI*M_PI*(g_phi_eta_gamma*g_phi_eta_gamma/m_eta_sq)*c_phi_p_p*regge_phi*regge_phi - *amp_factor_kappa0; - double M_phi=+sqrt(M_phi_sq); - - // Primakoff amplitude - double M_primakoff_sq=16.*M_PI*M_PI*(g_eta_gamma_gamma*g_eta_gamma_gamma/m_eta_sq)*c_gamma_p_p/(t*t) - *(amp_factor_kappa0-kappa_gamma/(4.*m_p)*amp_factor_kappa1+kappa_gamma*kappa_gamma/(16.*m_p_sq)*amp_factor_kappa2); - double M_primakoff=sqrt(M_primakoff_sq); - - - // M_primakoff=0.; - //M_primakoff_sq=0.; - - //M_omega=0.; - // M_omega_sq=0.; - - //M_rho=0.; - // M_rho_sq=0.; - - //M_phi_sq=0.; - //M_phi=0.; - - double pi_a_omega=M_PI*a_omega; - double pi_a_rho=M_PI*a_rho; - double pi_a_phi=M_PI*a_phi; - double M_sq =M_omega_sq+M_rho_sq+M_primakoff_sq+M_phi_sq - +2.*M_omega*M_phi*cos(pi_a_omega-pi_a_phi) - +2.*M_omega*M_rho*cos(pi_a_omega-pi_a_rho) - +2.*M_omega*M_primakoff*cos(pi_a_omega) - +2.*M_rho*M_primakoff*cos(pi_a_rho) - +2.*M_rho*M_phi*cos(pi_a_rho-pi_a_phi) - +2.*M_phi*M_primakoff*cos(pi_a_phi) - ; - - double hbarc_sq=389.; // Convert to micro-barns - double dsigma_dt=hbarc_sq*M_sq/(4.*64.*M_PI*s*p_gamma_sq); - // the extra factor for is for 2 photon spins x 2 proton spins - - return(dsigma_dt); - - -} - -// Put particle data into hddm format and output to file -void WriteEvent(unsigned int eventNumber,TLorentzVector &beam, float vert[3], - vector&particle_types, - vector&particle_vectors, s_iostream_t *file){ - s_PhysicsEvents_t* pes; - s_Reactions_t* rs; - s_Target_t* ta; - s_Beam_t* be; - s_Vertices_t* vs; - s_Origin_t* origin; - s_Products_t* ps; - s_HDDM_t *thisOutputEvent = make_s_HDDM(); - thisOutputEvent->physicsEvents = pes = make_s_PhysicsEvents(1); - pes->mult = 1; - pes->in[0].runNo = runNo; - pes->in[0].eventNo = eventNumber; - pes->in[0].reactions = rs = make_s_Reactions(1); - rs->mult = 1; - // Beam - rs->in[0].beam = be = make_s_Beam(); - be->type = Gamma; - be->properties = make_s_Properties(); - be->properties->charge = ParticleCharge(be->type); - be->properties->mass = ParticleMass(be->type); - be->momentum = make_s_Momentum(); - be->momentum->px = 0.; - be->momentum->py = 0.; - be->momentum->pz = beam.Pz(); - be->momentum->E = beam.E(); - // Target - rs->in[0].target = ta = make_s_Target(); - ta->type = Proton; - ta->properties = make_s_Properties(); - ta->properties->charge = ParticleCharge(ta->type); - ta->properties->mass = ParticleMass(ta->type); - ta->momentum = make_s_Momentum(); - ta->momentum->px = 0.; - ta->momentum->py = 0.; - ta->momentum->pz = 0.; - ta->momentum->E = ParticleMass(ta->type); - // Primary vertex - rs->in[0].vertices = vs = make_s_Vertices(1); - vs->mult = 1; - vs->in[0].origin = origin = make_s_Origin(); - vs->in[0].products = ps = make_s_Products(particle_vectors.size()); - ps->mult = 0; - origin->t = 0.0; - origin->vx = vert[0]; - origin->vy = vert[1]; - origin->vz = vert[2]; - // Final state particles - for (unsigned int i=0;imult++){ - Particle_t my_particle=particle_types[i]; - ps->in[ps->mult].type = my_particle; - ps->in[ps->mult].pdgtype = PDGtype(my_particle); - ps->in[ps->mult].id = i+1; /* unique value for this particle within the event */ - ps->in[ps->mult].parentid = 0; /* All internally generated particles have no parent */ - ps->in[ps->mult].mech = 0; // ??? - ps->in[ps->mult].momentum = make_s_Momentum(); - ps->in[ps->mult].momentum->px = particle_vectors[i].Px(); - ps->in[ps->mult].momentum->py = particle_vectors[i].Py(); - ps->in[ps->mult].momentum->pz = particle_vectors[i].Pz(); - ps->in[ps->mult].momentum->E = particle_vectors[i].E(); - } - flush_s_HDDM(thisOutputEvent,file); -} - -// Create some diagnostic histograms -void CreateHistograms(){ - - thrown_t=new TH1D("thrown_t","Thrown -t distribution",1000,0.,2.0); - thrown_t->SetXTitle("-t [GeV^{2}]"); - thrown_dalitzZ=new TH1D("thrown_dalitzZ","thrown dalitz Z",110,-0.05,1.05); - thrown_Egamma=new TH1D("thrown_Egamma","Thrown E_{#gamma} distribution", - 1000,0,12.); - thrown_Egamma->SetTitle("E_{#gamma} [GeV]"); - thrown_dalitzXY=new TH2D("thrown_dalitzXY","Dalitz distribution Y vs X",100,-1.,1.,100,-1.,1); - - thrown_theta_vs_p=new TH2D("thrown_theta_vs_p","Proton #theta_{LAB} vs. p", - 200,0,2.,180,0.,90.); - thrown_theta_vs_p->SetXTitle("p [GeV/c]"); - thrown_theta_vs_p->SetYTitle("#theta [degrees]"); - - cobrems_vs_E=new TH1D("cobrems_vs_E","Coherent bremsstrahlung spectrum", - 1000,Emin,Emax); - -} - - -// Create a graph of the cross section dsigma/dt as a function of -t -void GraphCrossSection(){ - // beam energy in lab - double Egamma=Emin; - - // CM energy - double s=m_p*(m_p+2.*Egamma); - double Ecm=sqrt(s); - - // Momenta of incoming photon and outgoing eta and proton in cm frame - double p_gamma=(s-m_p_sq)/(2.*Ecm); - double E_eta=(s+m_eta_sq-m_p_sq)/(2.*Ecm); - double p_eta=sqrt(E_eta*E_eta-m_eta_sq); - - // Momentum transfer t - double p_diff=p_gamma-p_eta; - double t0=m_eta_sq*m_eta_sq/(4.*s)-p_diff*p_diff; - - double sum=0.; - double t_old=t0; - double t_array[10000]; - double xsec_array[10000]; - for (unsigned int k=0;k<10000;k++){ - double theta_cm=M_PI*double(k)/10000.; - double sin_theta_over_2=sin(0.5*theta_cm); - double t=t0-4.*p_gamma*p_eta*sin_theta_over_2*sin_theta_over_2; - double xsec=CrossSection(s,t,p_gamma,p_eta,theta_cm); - - t_array[k]=-t; - xsec_array[k]=xsec; - - sum-=xsec*(t-t_old); - t_old=t; - } - TGraph *Gxsec=new TGraph(10000,t_array,xsec_array); - Gxsec->Write("Cross section"); - - cout << "Total cross section at " << Egamma << " GeV = "<< sum - << " micro-barns"<> Emin; - infile >> Emax; - infile.ignore(); // ignore the '\n' at the end of this line - // Set sensible minimum energy - if (Emin> Ee; - infile >> Epeak; - infile >> collDiam; - infile >> radThickness; - infile.ignore(); // ignore the '\n' at the end of this line - - cout << "Electron beam energy = " << Ee << " GeV, Coherent peak = " - << Epeak <<" GeV, collimator diameter = " - <> m_eta; - infile >> width; - infile.ignore(); // ignore the '\n' at the end of this line - - m_eta_sq=m_eta*m_eta; - cout << "Mass, width of decaying particle [GeV] = "<< m_eta <<"," << width << endl; - - // Get coupling constants for photon vertex - getline(infile,comment_line); - infile >> g_eta_gamma_gamma; - infile >> g_rho_eta_gamma; - infile >> g_omega_eta_gamma; - infile >> g_phi_eta_gamma; - infile.ignore(); // ignore the '\n' at the end of this line - - cout << "Coupling constants:" <GetBinCenter(i)/Ee); - float y=0; - if (EpeakFill(Ee*double(x),double(y)); - } - - - //---------------------------------------------------------------------------- - // Event generation loop - //---------------------------------------------------------------------------- - for (int i=1;i<=Nevents;i++){ - double Egamma=0.; - // Maximum value for cross section - double xsec_max=0.3; - double xsec=0.,xsec_test=0.; - - // Polar angle in center of mass frame - double theta_cm=0.; - - // Eta momentum in cm - double p_eta=0.; - - // Transfer 4-momentum; - double t=0.; - - // vertex position at target - float vert[4]={0.,0.,0.,0.}; - - // use the rejection method to produce eta's based on the cross section - do{ - // First generate a beam photon using bremsstrahlung spectrum - Egamma = cobrems_vs_E->GetRandom(); - - // CM energy - double s=m_p*(m_p+2.*Egamma); - double Ecm=sqrt(s); - - // Momenta of incoming photon and outgoing eta and proton in cm frame - double p_gamma=(s-m_p_sq)/(2.*Ecm); - - if (width>0){ // Take into account width of resonance - // Use a relativistic Breit-Wigner distribution for the shape - - } - double E_eta=(s+m_eta_sq-m_p_sq)/(2.*Ecm); - p_eta=sqrt(E_eta*E_eta-m_eta_sq); - - // Momentum transfer t - double p_diff=p_gamma-p_eta; - double t0=m_eta_sq*m_eta_sq/(4.*s)-p_diff*p_diff; - double sin_theta_over_2=0.; - t=t0; - - // Generate cos(theta) with a uniform distribution and compute the cross - // section at this value - double cos_theta_cm=-1.0+myrand->Uniform(2.); - theta_cm=acos(cos_theta_cm); - - sin_theta_over_2=sin(0.5*theta_cm); - t=t0-4.*p_gamma*p_eta*sin_theta_over_2*sin_theta_over_2; - xsec=CrossSection(s,t,p_gamma,p_eta,theta_cm); - - // Generate a test value for the cross section - xsec_test=myrand->Uniform(xsec_max); - } - while (xsec_test>xsec); - - // Generate phi using uniform distribution - double phi_cm=myrand->Uniform(2.*M_PI); - - // beam 4-vector (ignoring px and py, which are extremely small) - TLorentzVector beam(0.,0.,Egamma,Egamma); - thrown_Egamma->Fill(Egamma); - - // Velocity of the cm frame with respect to the lab frame - TVector3 v_cm=(1./(Egamma+m_p))*beam.Vect(); - // Four-moementum of the eta in the CM frame - double pt=p_eta*sin(theta_cm); - TLorentzVector eta4(pt*cos(phi_cm),pt*sin(phi_cm),p_eta*cos(theta_cm), - sqrt(p_eta*p_eta+m_eta_sq)); - // eta4.Print(); - - //Boost the eta 4-momentum into the lab - eta4.Boost(v_cm); - // eta4.Print(); - - - // Compute the 4-momentum for the recoil proton - TLorentzVector proton4=beam+target-eta4; - - //proton4.Print(); - thrown_theta_vs_p->Fill(proton4.P(),180./M_PI*proton4.Theta()); - - // Generate 3-body decay of eta according to phase space - TGenPhaseSpace phase_space; - phase_space.SetDecay(eta4,num_decay_particles,decay_masses); - double weight=0.,rand_weight=1.; - do{ - weight=phase_space.Generate(); - rand_weight=myrand->Uniform(1.); - } - while (rand_weight>weight); - - // Histograms of Dalitz distribution - if (num_decay_particles==3){ - TLorentzVector one=*phase_space.GetDecay(0); - TLorentzVector two=*phase_space.GetDecay(1); - TLorentzVector three=*phase_space.GetDecay(2); - TLorentzVector one_two=one+two; - TLorentzVector one_three=one+three; - - TLorentzVector eta=one_two+three; - TVector3 boost=-eta.BoostVector(); - - double eta_mass=eta.M(); - eta.Boost(boost); - - one.Boost(boost); - two.Boost(boost); - three.Boost(boost); - - double m1=one.M(),m2=two.M(),m3=three.M(); - double E1=one.E(),E2=two.E(),E3=three.E(); - double T1=E1-m1; // pi0 for charged channel - double T2=E2-m2; // pi+ for charged channel - double T3=E3-m3; // pi- for charged channel - double Q_eta=eta_mass-m1-m2-m3; - double X=sqrt(3.)*(T2-T3)/Q_eta; - double Y=3.*T1/Q_eta-1.; - thrown_dalitzXY->Fill(X,Y); - - double z_dalitz=X*X+Y*Y; - //printf("z %f\n",z_dalitz); - thrown_dalitzZ->Fill(z_dalitz); - } - // Other diagnostic histograms - thrown_t->Fill(-t); - - // Randomly generate z position in target - vert[2]=zmin+myrand->Uniform(zmax-zmin); - - // Gather the particles in the reaction and write out event in hddm format - particle_vectors[last_index]=proton4; - for (int j=0;jWrite(); - rootfile->Close(); - - // Close HDDM file - close_s_HDDM(file); - cout< means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit twok - -reaction K+K- gamma p K+ K- - -# normalization integral output file -normintfile K+K- 2k_ni.txt - -# consider just x polarized amplitudes -sum K+K- xpol - -parameter rho000 0.0 bounded -1.0 1.0 -parameter rho100 0.0 bounded -1.0 1.0 -parameter rho1m10 0.0 bounded -1.0 1.0 -parameter rho111 0.0 bounded -1.0 1.0 -parameter rho001 0.0 bounded -1.0 1.0 -parameter rho101 0.0 bounded -1.0 1.0 -parameter rho1m11 0.0 bounded -1.0 1.0 -parameter rho102 0.0 bounded -1.0 1.0 -parameter rho1m12 0.0 bounded -1.0 1.0 - -genmc K+K- ROOTDataReader /path/to/generatedMC/AmpToolsFormatThrownFlat.root - -accmc K+K- ROOTDataReader /path/to/acceptedMC/AmpToolsInputTreeFlat.root - -data K+K- ROOTDataReader /path/to/data/AmpToolsInputTreeData.root - -# Notes from changelog v0.9.0 (10-Aug-2015) -## Add new method of accounting for background in samples. A background -## sample is specified in the configuration file using the "bkgnd" keyboard. -## This sample should be normalized such that the sum of the weights is -## equal to the estimated size of the background. This contribution will -## be subtracted during the fit. - -#bkgnd K+K- ROOTDataReader /path/to/file - -amplitude K+K-::xpol::phi TwoPiAngles [rho000] [rho100] [rho1m10] [rho111] [rho001] [rho101] [rho1m11] [rho102] [rho1m12] - -initialize K+K-::xpol::phi cartesian 1.0 0.0 fixed - -# Include the following file to override the above element parameters -# Useful when running many jobs with different initial values -include fit-params.txt diff --git a/src/programs/Simulation/gen_2k/gen_2k.cc b/src/programs/Simulation/gen_2k/gen_2k.cc deleted file mode 100644 index 2561cc9884..0000000000 --- a/src/programs/Simulation/gen_2k/gen_2k.cc +++ /dev/null @@ -1,310 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.2; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 0.139*2; - double beamHighE = 12.0; - - int runNum = 9001; - int seed = 0; - - double slope = 4.5; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-t"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else slope = atof( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -t \t Momentum transfer slope [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_2k -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - gRandom->SetSeed(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass -- the daughters are two charged kaons - GammaPToXYP resProd( lowMass, highMass, 0.494, 0.494, beamMaxE, beamPeakE, beamLowE, beamHighE, type, slope ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 1.020, 0.004, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( KPlus ); - pTypes.push_back( KMinus ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_2k_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos#theta vs. #psi", 180, -3.14, 3.14, 100, -1, 1); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - double cosTheta = angles.CosTheta(); - double phi = angles.Phi(); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - double Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - CosTheta_psi->Fill( psi, cosTheta); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - intenW->Write(); - intenWVsM->Write(); - CosTheta_psi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_2k/gen_2k.cfg b/src/programs/Simulation/gen_2k/gen_2k.cfg deleted file mode 100644 index 094da96fd4..0000000000 --- a/src/programs/Simulation/gen_2k/gen_2k.cfg +++ /dev/null @@ -1,53 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit twok - -reaction K+K- gamma p K+ K- - -# consider just x polarized amplitudes -sum K+K- xpol - -# Currently not using any input parameters for TwoPiAngles in the generator -amplitude K+K-::xpol::phi TwoPiAngles 0.0 0.0 0.0 0.0 0.0 0.0 0.5 0.0 -0.5 -amplitude K+K-::xpol::phi BreitWigner 1.020 0.004 0 2 3 - -initialize K+K-::xpol::phi cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_2k/gen_2k_flat.cfg b/src/programs/Simulation/gen_2k/gen_2k_flat.cfg deleted file mode 100644 index ff656d9ff4..0000000000 --- a/src/programs/Simulation/gen_2k/gen_2k_flat.cfg +++ /dev/null @@ -1,52 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit twok - -reaction K+K- gamma p K+ K- - -# consider just x polarized amplitudes -sum K+K- xpol - -# Currently not using any input parameters for TwoPiAngles in the generator -amplitude K+K-::xpol::phi BreitWigner 1.020 0.004 0 2 3 - -initialize K+K-::xpol::phi cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_2mu/CobremsGenerator.cc b/src/programs/Simulation/gen_2mu/CobremsGenerator.cc deleted file mode 100644 index 58efa53481..0000000000 --- a/src/programs/Simulation/gen_2mu/CobremsGenerator.cc +++ /dev/null @@ -1,1153 +0,0 @@ -// -// CobremsGenerator - class implementation -// -// author: richard.t.jones at uconn.edu -// version: july 27, 2015 -// -// notes: -// -// This class computes the spectrum of bremsstrahlung radiation from a -// crystal radiator. The formalism is that described in the following paper. -// -// W. Kaune, G. Miller, W. Oliver, R.W. Williams, and K.K. Young, -// "Inclusive cross sections for pion and proton production by photons -// using collimated coherent bremsstrahlung", Phys Rev D, vol 11, -// no 3 (1975) pp. 478-494. -// -// The model for the photon beam contains the following parameters. -// 1. electron beam -// * beam energy: mean and rms spread -// * spot on radiator: gaussian model, cylindrical symmetry -// * emittance: gaussian model, cylindrical symmetry -// 2. crystal target -// * implemented for diamond, silicon -// * uniform thickness across beam spot -// * mosaic spread: gaussian model -// * dipole atomic form factor -// * Debye-Waller factor: defines coherent domain in q sum -// 3. downstream collimator -// * fixed distance from radiator -// * sharp cutoff at collimator radius -// * perfect alignment with beam axis assumed -// -// The crystal orientation is computed based on the requested coherent -// edge position requested by the user. For a high-energy electron beam -// this fixes one of the angles of the crystal with respect to the -// electron beam. The other angle must be chosen based on other -// considerations. A default value for this secondary angle parameter -// is assigned below, based on the observation that -// a) it is significantly larger than the primary edge-defining -// angle, so that additional peaks from reciprocal lattice sites -// (hkl) with the same h and different k values do not contribute -// significantly to the spectrum below the endpoint, and -// b) it is small enough, to render it unlikely that a random lattice -// vector from a distant region in q-space will cross through the -// coherent enhancement region as the primary (220) peak is moved -// through its full range in x from 30% to 90% of the endpoint -// for beamline parameters similar to those describing Hall D and GlueX. -// Should the user wish to try other values for this angle, a public -// method is provided for this purpose. - -#define COBREMS_GENERATOR_VERBOSITY 1 - -#include -#include -#include -#include -using namespace std; - -#if BOOST_PYTHON_WRAPPING -#include -#include -#endif // BOOST_PYTHON_WRAPPING - -#include -extern TH1D *expint_z; - -#ifndef _DBG_ -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ cout<<__FILE__<<":"<<__LINE__< -static double MyExpInt(double z) -{ - if(expint_z) expint_z->Fill(z); - return expint_map(z); -// return boost::math::expint(1, z); -} - -CobremsGenerator::CobremsGenerator(double Emax_GeV, double Epeak_GeV) -{ - // Unique constructor for this class, initialize for the given - // endpoint energy and peak position but these can be changed. - - fBeamEnergy = Emax_GeV; - fBeamErms = 6.0e-4; // GeV - fBeamEmittance = 2.5e-9; // m r - fCollimatorSpotrms = 0.0005; // m - fCollimatorDistance = 76.0; // m - fCollimatorDiameter = 0.0034; // m - fTargetThickness = 20e-6; // m - fTargetThetay = 0.050; // radians - fTargetThetaz = 0; // radians - setTargetCrystal("diamond"); - setCoherentEdge(Epeak_GeV); - fPhotonEnergyMin = 0.211; // GeV - setPolarizedFlag(false); - setCollimatedFlag(true); - -#if COBREMS_GENERATOR_VERBOSITY > 0 -// std::cout << std::endl -// << "Initialization for coherent bremsstralung calculation" -// << std::endl; -// printBeamlineInfo(); -#endif -} - -void CobremsGenerator::setTargetCrystal(std::string crystal) -{ - // declare the radiator target crystal type by name - - if (crystal == "diamond") { - fTargetCrystal.name = "diamond"; - fTargetCrystal.Z = 6; - fTargetCrystal.A = 12.01; - fTargetCrystal.density = 3.534; // g/cm^3 - fTargetCrystal.lattice_constant = 3.56e-10; // m - fTargetCrystal.Debye_Waller_const = 0.40e9; // 1/GeV^2 - } - else if (crystal == "silicon") { - fTargetCrystal.name = "silicon"; - fTargetCrystal.Z = 14; - fTargetCrystal.A = 28.09; - fTargetCrystal.density = 2.320; // g/cm^3 - fTargetCrystal.lattice_constant = 5.431e-10; // m - fTargetCrystal.Debye_Waller_const = 1.5e9; // 1/GeV^2 - } - else { - std::cerr << "Error in CobremsGenerator::setTargetCrystal - " - << "unknown crystal " << crystal << " requested, " - << "cannot continue." << std::endl; - exit(1); - } - - // define the stanard unit cell of the diamond Bravais lattice - fTargetCrystal.nsites = 8; - fTargetCrystal.ucell_site.clear(); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.0, 0.0, 0.0)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.0, 0.5, 0.5)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.5, 0.0, 0.5)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.5, 0.5, 0.0)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.25, 0.25, 0.25)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.25, 0.75, 0.75)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.75, 0.25, 0.75)); - fTargetCrystal.ucell_site.push_back(lattice_vector(0.75, 0.75, 0.25)); - fTargetCrystal.primaryHKL = lattice_vector(2,2,0); - - // approximate formula for atomic form factor beta - fTargetCrystal.betaFF = 111 * pow(fTargetCrystal.Z, -1/3.) / me; - - // set mosaic spread to GlueX specification - fTargetCrystal.mosaic_spread = 20e-6; - - // compute the radiation length - fTargetCrystal.radiation_length = getTargetRadiationLength_Schiff(); -} - -double CobremsGenerator::getTargetDebyeWallerConstant(double DebyeT_K, - double T_K) -{ - // Computes the Debye-Waller constant A for a simple model - // assuming an isotropic crystal -- see Kaune et.al. - // - // A(T) = A0 f(T) - // where - // A0 = 3 / (4 * atomicMass_GeV * DebyeTemperature_GeV) - // and - // f(T) = (2 / DebyeTemperature_GeV^2) * - // Integral_dw[0,DebyeTemperature_GeV] - // {w (1 + 2 / (exp(w/T) - 1))} - // - // T is the crystal temperature in GeV and A0 is the limiting - // value of A as T->0. - - double kBoltzmann = 8.617e-14; // GeV/K - double amassGeV = fTargetCrystal.A * 0.932; // GeV - double A0 = 3 / (2 * amassGeV * kBoltzmann * DebyeT_K); // /GeV^2 - double Tnormal = (T_K + 0.1) / DebyeT_K; - int niter = 50; - double f = 0; - for (int iter=0; iter < niter; ++iter) { - double x = (iter + 0.5) / niter; - f += x * (1 + 2 / (exp(x / Tnormal) - 1)) / niter; - } - return A0 * f; -} - -void CobremsGenerator::printBeamlineInfo() -{ - // Print a summary of the target crystal model parameters - - std::cout << " electron beam energy: " << fBeamEnergy << " GeV" - << std::endl - << " electron beam emittance: " - << fBeamEmittance * 1e9 << " mm.urad" - << std::endl - << " radiator crystal: " << fTargetCrystal.name - << ", thickness " << fTargetThickness * 1e6 << " um" - << std::endl - << " radiation length: " - << fTargetCrystal.radiation_length * 100 << " cm," - << " mosaic spread: " - << fTargetCrystal.mosaic_spread * 1e6 << " urad" - << std::endl - << " photon beam collimator half-angle: " - << fCollimatorDiameter / (2 * fCollimatorDistance) - * fBeamEnergy / me << " (m/E)" - << std::endl - << " collimator diameter: " - << fCollimatorDiameter * 100 << " cm" - << std::endl - << " crystal orientation: theta_x " - << fTargetThetax * 1e3 << " mrad" - << std::endl - << " theta_y " - << fTargetThetay * 1e3 << " mrad" - << std::endl << std::endl; -} - -void CobremsGenerator::printTargetCrystalInfo() -{ - // Print a summary of the target crystal model parameters - - double kBoltzmann = 8.617e-14; // GeV/K - double amass = fTargetCrystal.A * 0.932; // GeV - double DebyeTheta0 = 3 / (4 * amass * fTargetCrystal.Debye_Waller_const); - double DebyeTheta300 = DebyeTheta0; - for (int i=0; i < 5; i++) { - DebyeTheta300 = DebyeTheta0 * (1 + - pow(2 * dpi * 300 * kBoltzmann / DebyeTheta300, 2) / 6); - } - - std::cout << "CobremsGenerator crystal type is " << fTargetCrystal.name - << std::endl - << " atomic number Z=" << fTargetCrystal.Z - << ", atomic weight A=" << fTargetCrystal.A << " amu" - << std::endl - << " mass density: " << fTargetCrystal.density << " g/cm^3" - << std::endl - << " radiation length: " << fTargetCrystal.radiation_length * 100 - << " cm" << std::endl - << " Debye-Waller constant: " << fTargetCrystal.Debye_Waller_const - << " /GeV^2 (" << DebyeTheta300 / kBoltzmann << " K)" - << std::endl - << " mosaic spread: " << fTargetCrystal.mosaic_spread * 1e6 - << " urad" << std::endl - << " atomic form-factor cutoff momentum: " - << sqrt(1 / fTargetCrystal.betaFF) * 1e6 << " keV" - << std::endl - << " primary lattice reflection h,k,l=" - << fTargetCrystal.primaryHKL.x << "," - << fTargetCrystal.primaryHKL.y << "," - << fTargetCrystal.primaryHKL.z - << std::endl - << " lattice constant: " << fTargetCrystal.lattice_constant * 1e9 - << " nm" << std::endl - << " occupied sites of the crystal lattice unit cell are:" - << std::endl; - for (unsigned int i=0; i < fTargetCrystal.ucell_site.size(); ++i) { - char s[100]; - snprintf(s, 100, "%4.2f %4.2f %4.2f", fTargetCrystal.ucell_site[i].x, - fTargetCrystal.ucell_site[i].y, - fTargetCrystal.ucell_site[i].z); - std::cout << " " << i + 1 << ": " << s << std::endl; - } - std::cout << " Crystal orientation matrix is:" << std::endl; - for (int i=0; i < 3; ++i) { - char s[100]; - snprintf(s, 100, "%15.12f %15.12f %15.12f", fTargetRmatrix[i][0], - fTargetRmatrix[i][1], - fTargetRmatrix[i][2]); - std::cout << " " << s << std::endl; - } -} - -void CobremsGenerator::applyBeamCrystalConvolution(int nbins, double *xvalues, - double *yvalues) -{ - // Electron beam emittance produces two effects in the coherent - // bremsstrahlung spectrum: - // 1) smears out the collimation acceptance function in production - // angle, so it varies smoothly to zero instead of being a step; - // 2) combines with mosaic spread of the target crystal to smear out - // the relation between photon energy fraction x and production - // angle theta for a given lattice reflection. - // The first one affects the left-hand (low energy) side of the - // coherent peaks in the coherent bremsstrahlung spectrum, while the - // second affects the right-hand (high energy) side, limiting the - // sharpness of the edges in either case. - // - // Effect (1) is taken into account in the way the acceptance function - // is computed on the final state, but effect (2) is more difficult to - // treat analytically because it involves smearing directions in the - // initial state. This is only relevant to the coherent part of the - // spectrum, where it acts by broadening the step on the high side of - // the coherent edge from a sharp drop to a gradually sloping curve. - // One way to take this into account in an effective manner is to treat - // the coherent spectrum at every photon energy bin as being dominated - // by a single reciprocal lattice vector, and smearing out the relation - // x=x(theta) that follows from the two-body nature of the scattering - // from that plane. Considering a 1D spectrum of beam intensity vs x, - // this leads to a convolution of the distribution with an x-dependent - // smearing function. The applyBeamConvolution method computes that - // smearing function for each value of x in the input xvalues array - // and applies it to the input spectrum represented by the yvalues - // array. The yvalues array is overwritten with the convoluted spectrum. - // For simplicity, the xvalues are assumed to be equally spaced. - - double x0 = xvalues[0]; - double x1 = xvalues[nbins - 1]; - double var0 = pow(fTargetCrystal.mosaic_spread, 2) + - pow(fBeamEmittance / fCollimatorSpotrms, 2); - double varMS = Sigma2MS(fTargetThickness); - - // Here we have to guess which characteristic angle alph inside the crystal - // is dominantly responsible for the coherent photons in each bin in x. - // I just use the smallest of the two angles, but this does not work when - // both angles are small, and you have to be more clever -- BEWARE!!! - double alph = (fabs(fTargetThetax) < fabs(fTargetThetay))? - fabs(fTargetThetax) : fabs(fTargetThetay); - if (alph == 0) { - alph = (fabs(fTargetThetax) > fabs(fTargetThetay))? - fabs(fTargetThetax) : fabs(fTargetThetay); - } - - // In any case, fine-tuning below the mosaic spread limit makes no sense. - else { - alph = (alph > fTargetCrystal.mosaic_spread)? - alph : fTargetCrystal.mosaic_spread; - } - - double *norm = new double[nbins]; - double *result = new double[nbins]; - for (int j=0; j < nbins; ++j) { - norm[j] = 0; - result[j] = 0; - for (int i=-nbins; i <= nbins; ++i) { - double dx = (x1 - x0) * (j - i) / nbins; - double x = x0 + (x1 - x0) * (j + 0.5) / nbins; - double dalph = dx * alph / (x * (1 - x)); - double term; - if (varMS / var0 > 1e-4) { - term = dalph / varMS * - (erf(dalph / sqrt(2 * (var0 + varMS))) - - erf(dalph / sqrt(2 * var0))) + - sqrt(2 / dpi) / varMS * - (exp(-dalph*dalph / (2 * (var0 + varMS))) * - sqrt(var0 + varMS) - - exp(-dalph*dalph / (2 * var0)) * sqrt(var0)); - } - else { - term = exp(-dalph*dalph / (2 * var0)) / sqrt(2 * dpi * var0); - } - term *= alph / x; - norm[j] += term; - } - } - - for (int i=-nbins; i <= nbins; ++i) { - int ii = abs(i); - for (int j=0; j < nbins; ++j) { - double dx = (x1 - x0) * (j - i) / nbins; - double x = x0 + (x1 - x0) * (j + 0.5) / nbins; - double dalph = dx * alph / (x * (1 - x)); - double term; - if (varMS / var0 > 1e-4) { - term = dalph / varMS * - (erf(dalph / sqrt(2 * (var0 + varMS))) - - erf(dalph / sqrt(2 * var0))) + - sqrt(2 / dpi) / varMS * - (exp(-dalph*dalph / (2 * (var0 + varMS))) * - sqrt(var0 + varMS) - - exp(-dalph*dalph/ (2 * var0)) * sqrt(var0)); - } - else { - term = exp(-dalph*dalph / (2 * var0)) / sqrt(2 * dpi * var0); - } - term *= alph / x; - result[ii] += term * yvalues[j] / norm[j]; - } - } - - for (int i=0; i < nbins; ++i) { - if (fabs(result[i]) > 1e-35) { - yvalues[i] = result[i]; - } - else { - yvalues[i] = 0; - } - } - - delete [] norm; - delete [] result; -} - -double CobremsGenerator::getTargetRadiationLength_PDG() -{ - // PDG formula for radiation length, converted to meters - - double Z = fTargetCrystal.Z; - double N = fTargetCrystal.nsites; - double a = fTargetCrystal.lattice_constant; - double c = alpha * Z; - double s = 4 * N * pow(alpha, 3) * pow(hbarc/(a*me), 2) / a * - (Z*Z * (log(184.15 * pow(Z, -1/3.)) - - c*c * (1 / (1 + c*c) + 0.20206 - 0.0369 * c*c + - 0.0083 * pow(c, 4) - 0.002 * pow(c, 6))) + - Z * log(1194 * pow(Z, -2/3.))); - return 1/s; -} - -double CobremsGenerator::getTargetRadiationLength_Schiff() -{ - // Schiff formula for radiation length, converted to meters - - double Z = fTargetCrystal.Z; - double N = fTargetCrystal.nsites; - double a = fTargetCrystal.lattice_constant; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double s = 4 * N * pow(alpha, 3) * pow(hbarc/(a*me), 2) / a * - Z * (Z + zeta) * log(183 * pow(Z, -1/3.)); - return 1/s; -} - -void CobremsGenerator::setCoherentEdge(double Epeak_GeV) -{ - // Adjust theta_x of the target to align the coherent edge at - // energy Epeak_GeV in the photon spectrum, then orient the - // crystal according to theta_x, theta_y, theta_z tip angles. - - double edge = Epeak_GeV; - double qtotal = hbarc * (2 * dpi / fTargetCrystal.lattice_constant); - lattice_vector hkl = fTargetCrystal.primaryHKL; - qtotal *= sqrt(hkl.x * hkl.x + hkl.y * hkl.y + hkl.z * hkl.z); - double qlong = edge * me*me / (2 * fBeamEnergy * (fBeamEnergy - edge)); - fTargetThetax = -qlong / qtotal; - resetTargetOrientation(); - RotateTarget(0, dpi/2, 0); // point (1,0,0) along beam - RotateTarget(0, 0, dpi/4); // point (0,1,1) vertically - RotateTarget(-fTargetThetax, 0, 0); - RotateTarget(0, -fTargetThetay, 0); - RotateTarget(0, 0, -fTargetThetaz); -} - -CobremsGenerator::CobremsGenerator(const CobremsGenerator &src) -{ - // copy constructor - - fTargetCrystal = src.fTargetCrystal; - fTargetThickness = src.fTargetThickness; - fTargetThetax = src.fTargetThetax; - fTargetThetay = src.fTargetThetay; - fTargetThetaz = src.fTargetThetaz; - for (int i=0; i < 3; ++i) - for (int j=0; j < 3; ++j) - fTargetRmatrix[i][j] = src.fTargetRmatrix[i][j]; - fBeamEnergy = src.fBeamEnergy; - fBeamErms = src.fBeamErms; - fBeamEmittance = src.fBeamEmittance; - fCollimatorSpotrms = src.fCollimatorSpotrms; - fCollimatorDistance = src.fCollimatorDistance; - fCollimatorDiameter = src.fCollimatorDiameter; - fQ2theta2 = src.fQ2theta2; - fQ2weight = src.fQ2weight; -} - -CobremsGenerator &CobremsGenerator::operator=(const CobremsGenerator &src) -{ - // assignment operator - - fTargetCrystal = src.fTargetCrystal; - fTargetThickness = src.fTargetThickness; - fTargetThetax = src.fTargetThetax; - fTargetThetay = src.fTargetThetay; - fTargetThetaz = src.fTargetThetaz; - for (int i=0; i < 3; ++i) - for (int j=0; j < 3; ++j) - fTargetRmatrix[i][j] = src.fTargetRmatrix[i][j]; - fBeamEnergy = src.fBeamEnergy; - fBeamErms = src.fBeamErms; - fBeamEmittance = src.fBeamEmittance; - fCollimatorSpotrms = src.fCollimatorSpotrms; - fCollimatorDistance = src.fCollimatorDistance; - fCollimatorDiameter = src.fCollimatorDiameter; - fQ2theta2 = src.fQ2theta2; - fQ2weight = src.fQ2weight; - return *this; -} - -CobremsGenerator::~CobremsGenerator() { } - -double CobremsGenerator::CoherentEnhancement(double x) -{ - // Returns ratio of total bremsstrahlung yield over incoherent yield - // for photon energy k = x*fBeamEnergy - - double yc = Rate_dNcdx(x); - double yi = Rate_dNidx(x); - return (yi + yc) / (yi + 1e-99); -} - -double CobremsGenerator::Rate_dNtdx(double x) -{ - // Returns total bremsstrahlung probability density differential in - // x (scaled photon energy) at photon energy k = x*fBeamEnergy. - - return Rate_dNcdx(x) + Rate_dNidx(x); -} - -double CobremsGenerator::Rate_dNtdx(double x, - double distance_m, double diameter_m) -{ - // Returns total bremsstrahlung probability density differential in x - // (scaled photon energy) at photon energy k = x*fBeamEnergy with - // user-specified variations in the collimator distance and diameter, - // for plotting. Special case: if diameter_m < 0 then interpret its - // absolute value as the collimator radius in characteristic units m/E. - - double dist = fCollimatorDistance; - double diam = fCollimatorDiameter; - fCollimatorDistance = (distance_m > 0)? distance_m : fCollimatorDistance; - fCollimatorDiameter = (diameter_m > 0)? diameter_m : (diameter_m < 0)? - -2 * distance_m * diameter_m * me / fBeamEnergy : - fCollimatorDiameter; - double rate = Rate_dNtdx(x); - fCollimatorDistance = dist; - fCollimatorDiameter = diam; - return rate; -} - -double CobremsGenerator::Rate_dNtdk(double k_GeV) -{ - // Returns total bremsstrahlung probability density differential - // in photon energy k (GeV). - - return Rate_dNtdx(k_GeV / fBeamEnergy) / fBeamEnergy; -} - -double CobremsGenerator::Rate_dNcdx(double x) -{ - // Returns the coherent bremsstrahlung probability density differential - // in x (scaled photon energy) at photon energy k = x*fBeamEnergy. - - return 2 * dpi * Rate_dNcdxdp(x, dpi/4); -} - -double CobremsGenerator::Rate_dNcdx(double x, - double distance_m, double diameter_m) -{ - // Returns the coherent bremsstrahlung probability density differential - // in x (scaled photon energy) at photon energy k = x*fBeamEnergy with - // user-specified variations in the collimator distance and diameter. - // Special case: if diameter_m < 0 then interpret its absolute - // value as the collimator radius in characteristic units m/E. - - double dist = fCollimatorDistance; - double diam = fCollimatorDiameter; - fCollimatorDistance = (distance_m > 0)? distance_m : fCollimatorDistance; - fCollimatorDiameter = (diameter_m > 0)? diameter_m : (diameter_m < 0)? - -2 * distance_m * diameter_m * me / fBeamEnergy : - fCollimatorDiameter; - double rate = 2 * dpi * Rate_dNcdxdp(x, dpi/4); - fCollimatorDistance = dist; - fCollimatorDiameter = diam; - return rate; -} - -double CobremsGenerator::Rate_dNcdxdp(double x, double phi) -{ - // Returns the coherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) and phi (azimuthal emission angle) for - // fixed photon energy k = x*fBeamEnergy and phi. If fPolarizedFlag is - // false (0, default) then the total yield is returned, otherwise it is - // only the polarized fraction. If fCollimatedFlag is false (0) then - // the total yield is returned, otherwise only the part that passes the - // collimator is counted (default). - - double Z = fTargetCrystal.Z; - double a = fTargetCrystal.lattice_constant; - double sigma0 = 16 * dpi * fTargetThickness * Z*Z * pow(alpha, 3) * - fBeamEnergy * hbarc/(a*a) * pow(hbarc / (a * me), 4); - - fQ2theta2.clear(); - fQ2weight.clear(); - double qzmin = 99; - int hmin, kmin, lmin; - double sum = 0; - // can restrict to h=0 for cpu speedup, if crystal alignment is "reasonable" - for (int h = -4; h <= 4; ++h) { - for (int k = -10; k <= 10; ++k) { - for (int l = -10; l <= 10; ++l) { - if (h/2 * 2 == h) { - if (k/2 * 2 != k || l/2 * 2 != l || - (h + k + l)/4 * 4 != h + k + l) - { - continue; - } - } - else if (k/2 * 2 == k || l/2 * 2 == l) { - continue; - } - double ReS = 0; - double ImS = 0; - for (int i=0; i < fTargetCrystal.nsites; ++i) { - double qdota = 2 * dpi * (h * fTargetCrystal.ucell_site[i].x + - k * fTargetCrystal.ucell_site[i].y + - l * fTargetCrystal.ucell_site[i].z); - ReS += cos(qdota); - ImS += sin(qdota); - } - double S2 = ReS*ReS + ImS*ImS; - if (S2 < 1e-4) - continue; - double qnorm = hbarc * 2 * dpi / a; - double q[3]; - q[0] = qnorm * (fTargetRmatrix[0][0] * h + - fTargetRmatrix[0][1] * k + - fTargetRmatrix[0][2] * l); - q[1] = qnorm * (fTargetRmatrix[1][0] * h + - fTargetRmatrix[1][1] * k + - fTargetRmatrix[1][2] * l); - q[2] = qnorm * (fTargetRmatrix[2][0] * h + - fTargetRmatrix[2][1] * k + - fTargetRmatrix[2][2] * l); - double q2 = q[0]*q[0] + q[1]*q[1] + q[2]*q[2]; - double qT2 = q[0]*q[0] + q[1]*q[1]; - double xmax = 2 * fBeamEnergy * q[2]; - xmax /= xmax + me*me; - if (x > xmax || xmax > 1) { - continue; - } - -#if COBREMS_GENERATOR_VERBOSITY > 2 - else { - std::cout << h << "," << k << "," << l << "," - << S2 << "," << q2 << "," << xmax - << std::endl; - } -#endif - - if (q[2] < qzmin) { - qzmin = q[2]; - hmin = h; - kmin = k; - lmin = l; - } - double theta2 = (1 - x) * xmax / (x * (1 - xmax)) - 1; - double betaFF2 = pow(fTargetCrystal.betaFF, 2); - double FF = 1 / (1 + q2 * betaFF2); - sum += sigma0 * qT2 * S2 * pow(FF * betaFF2, 2) * - exp(-q2 * fTargetCrystal.Debye_Waller_const) * - ((1 - x) / pow(x * (1 + theta2), 2)) * - ((1 + pow(1 - x, 2)) - 8 * (theta2 / pow(1 + theta2, 2) * - (1 - x) * pow(cos(phi), 2))) * - ((fCollimatedFlag)? Acceptance(theta2) : 1) * - ((fPolarizedFlag)? Polarization(x, theta2) : 1); - fQ2theta2.push_back(theta2); - fQ2weight.push_back(sum); - } - } - } - -#if COBREMS_GENERATOR_VERBOSITY > 1 - if (qzmin < 99) { - std::cout << hmin << "," << kmin << "," << lmin - << " is the best plane at x=" << x - << std::endl; - } -#endif - - return sum; -} - -double CobremsGenerator::Rate_dNidx(double x) -{ - // Returns the incoherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) at fixed photon energy k = x*fBeamEnergy. - - if (x > 1) - return 0; - - // Numerical integration in d(theta**2) over [0,inf] - // is mapped onto u=1/(1+theta^2) as (1/u^2) d(u) over [0,1] - int niter = 50; - double dNidx = 0; - double du = 1. / niter; - for (int iter = 0; iter < niter; ++iter) { - double u = (iter + 0.5) / niter; - double theta2 = (1 - u) / u; - dNidx += Rate_dNidxdt2(x, theta2) * du/(u*u); - } - return dNidx; -} - -double CobremsGenerator::Rate_dNBidx(double x) -{ - // In the following paper, a closed form is given for the integral that - // is being performed analytically by dNidx. I include this second form - // here in case some time it might be useful as a cross check. - // - // "Coherent bremsstrahlung in crystals as a tool for producing high - // energy photon beams to be used in photoproduction experiments at - // CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. - // - // Note: in this paper they have swapped subscripts for coherent and - // incoherent intensities. This is not very helpful to the reader! - // - // The result is some 15% lower radiation rate than the result of dNidx. - // I take the latter to be more detailed (because it gives a more - // realistic behaviour at the endpoint and agrees better with the PDG - // radiation length for carbon). Most of this deficiency is remedied - // by simply replacing Z**2 in the cross section with Z*(Z+zeta) as - // recommended by Kaune et.al., and followed by the PDG in their fit - // to radiation lengths. - // - // WARNING - // dNidx and dNBidx give the incoherent radiation rate for crystalline - // radiators. If you take the incoherent radiation formulae here and - // integrate them you will NOT obtain the radiation length for amorphous - // radiators; it will be overestimated by some 15%. The reason is that - // the part of the integral in q-space that is covered by the discrete - // sum has been subtracted to avoid double-counting with the coherent - // part. If you were to spin the crystal fast enough, the coherent - // spectrum should average out to yield the remaining 15% with a - // spectral shape resembling the Bethe-Heitler result. - - double Z = fTargetCrystal.Z; - double betaFF = fTargetCrystal.betaFF; - double a = fTargetCrystal.lattice_constant; - double AoverB2 = fTargetCrystal.Debye_Waller_const / (betaFF * betaFF); - double Tfact = -(1 + AoverB2) * exp(AoverB2) * - MyExpInt( AoverB2); - double psiC1 = 2 * (2 * log(betaFF * me) + Tfact + 2); - double psiC2 = psiC1 - 2/3.; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double dNBidx = fTargetCrystal.nsites * fTargetThickness * - Z * (Z + zeta) * pow(alpha, 3) * - pow(hbarc / (a*me), 2) / (a * x) * - (psiC1 * (1 + pow(1 - x, 2)) - psiC2 * (1 - x) * 2/3.); - return dNBidx; -} - -double CobremsGenerator::Rate_dNidxdt2(double x, double theta2) -{ - // Returns the incoherent bremsstrahlung probabililty density differential - // in x (scaled photon energy) and theta^2 at fixed photon energy - // k = x*fBeamEnergy and production angle theta. Argument theta2 is equal - // to theta^2 expressed in units of (me/fBeamEnergy)^2. If internal flag - // fCollimatedFlag is false (0) then the total yield is returned, - // otherwise only the part that passes the collimator is counted (default). - - double delta = 1.02; - double Z = fTargetCrystal.Z; - double betaFF = fTargetCrystal.betaFF; - double a = fTargetCrystal.lattice_constant; - double zeta = log(1440 * pow(Z, -2/3.)) / log(183 * pow(Z, -1/3.)); - double MSchiff = 1 / (pow((me * x) / (2 * fBeamEnergy * (1 - x)), 2) + - 1 / pow(betaFF * me * (1 + theta2), 2)); - double dNidxdt2 = 2 * fTargetCrystal.nsites * fTargetThickness * Z * - (Z + zeta) * pow(alpha, 3) * pow(hbarc/(a*me), 2) / (a*x) * - ( ((1 + pow(1 - x, 2)) - 4 * theta2 * (1 - x) / - pow(1 + theta2, 2)) / - pow(1 + theta2, 2) * - (log(MSchiff) - 2 * delta * Z / (Z + zeta)) + - 16 * theta2 * (1 - x) / pow(1 + theta2, 4) - - pow(2 - x, 2) / pow(1 + theta2, 2) ) * - ((fCollimatedFlag)? Acceptance(theta2) : 1); - - return dNidxdt2; -} - -double CobremsGenerator::Rate_para(double x, double theta2, double phi) -{ - // Returns the relative rate of in-plane polarized flux from coherent - // bremsstrahlung at production angles theta and phi and photon energy - // k = x*fBeamEnergy. The units are arbitrary, but the same as Rate_ortho - // (see below). The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. - - return 0.5 * pow((2 - x) * (1 + theta2), 2) - - 8 * theta2 * (1 - x) * pow(cos(phi), 2) - - 8 * pow(theta2, 2) * (1 - x) * pow(cos(phi), 2) * pow(sin(phi), 2); -} - -double CobremsGenerator::Rate_ortho(double x, double theta2, double phi) -{ - // Returns the relative rate of out-of-plane polarized flux from coherent - // bremsstrahlung at production angles theta and phi and photon energy k - // = x*fBeamEnergy. The units are arbitrary, but the same as Rate_para - // (see above). The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. - - return 0.5 * pow(x * (1 + theta2), 2) + - 8 * pow(theta2, 2) * (1 - x) * pow(cos(phi), 2) * pow(sin(phi), 2); -} - -double CobremsGenerator::Polarization(double x, double theta2) -{ - // Returns the degree of linear polarization in a coherent bremsstrahlung - // beam at photon energy k = x*fBeamEnergy and production angle theta. - // The formula evaluated below is the azimuthal average of the ratio - // (Rate_para - Rate_ortho) / (Rate_para + Rate_ortho) - // The argument theta2 is the production polar angle theta^2 expressed - // in units of (me/fBeamEnergy)^2. - - return 2 * (1 - x) / (pow(1 + theta2, 2) * (pow(1 - x, 2) + 1) - - 4 * theta2 * (1 - x)); -} - -double CobremsGenerator::Acceptance(double theta2, double phi, - double xshift_m, double yshift_m) -{ - // Returns the acceptance of the collimator for photons emitted at - // polar angle theta and azimuthal angle phi at the radiator. Both - // beam emittance and multiple-scattering in the target contribute - // to smearing of the angular acceptance at the the collimator edge. - // The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. Misalignment of the - // collimator with the beam axis is taken into account by the - // arguments xshift,yshift. - - double theta = sqrt(theta2) * (me/fBeamEnergy); - double xc = fCollimatorDistance * tan(theta) * cos(phi) + xshift_m; - double yc = fCollimatorDistance * tan(theta) * sin(phi) + yshift_m; - double thetaprime = atan2(sqrt(xc*xc + yc*yc), fCollimatorDistance); - return Acceptance(pow(thetaprime * fBeamEnergy/me, 2)); -} - -double CobremsGenerator::Acceptance(double theta2) -{ - // Returns the acceptance of the collimator for photons emitted at - // polar angle theta and azimuthal angle phi at the radiator. Both - // beam emittance and multiple-scattering in the target contribute - // to smearing of the angular acceptance at the the collimator edge. - // The argument theta2 is the production polar angle theta^2 - // expressed in units of (me/fBeamEnergy)^2. - - double acceptance = 0; - double niter = 50; - double theta = sqrt(theta2); - double thetaC = fCollimatorDiameter / (2 * fCollimatorDistance) * - fBeamEnergy / me; - double var0 = pow((fCollimatorSpotrms / fCollimatorDistance) * - fBeamEnergy / me, 2); - double varMS = Sigma2MS(fTargetThickness) * pow(fBeamEnergy / me, 2); - if (theta < thetaC) { - double u1 = thetaC - theta; - if (u1*u1 / (var0 + varMS) > 20) { - return 1; - } - for (int iter = 0; iter < niter; ++iter) { - double u = u1 * (iter + 0.5) / niter; - double u2 = u * u; - double du2 = 2 * u * u1 / niter; - double pu; - if (varMS / var0 > 1e-4) { - pu = (MyExpInt( u2 / (2 * (var0 + varMS))) - - MyExpInt( u2 / (2 * var0))) / (2 * varMS); - } - else { - pu = exp(-u2 / (2 * var0)) / (2 * var0); - } - acceptance += pu * du2; - } - } - double u0 = fabs(theta - thetaC); - double u1 = fabs(theta + thetaC); - for (int iter = 0; iter < niter; ++iter) { - double u = u0 + (u1 - u0) * (iter + 0.5) / niter; - double u2 = u * u; - double du2 = 2 * u * (u1 - u0) / niter; - double pu; - if (varMS / var0 > 1e-4) { - pu = (MyExpInt( u2 / (2 * (var0 + varMS))) - - MyExpInt( u2 / (2 * var0))) / (2 * varMS); - } - else { - pu = exp(-u2 / (2 * var0)) / (2 * var0); - } - acceptance += pu * du2/dpi * - atan2(sqrt((theta2 - pow(thetaC - u, 2)) * - (pow(thetaC + u, 2) - theta2)), - theta2 - pow(thetaC, 2) + u2); - } - return acceptance; -} - -void CobremsGenerator::RotateTarget(double thetax, - double thetay, - double thetaz) -{ - // Apply a sequence of rotations to the target crystal as - // Rmatrix(out) = Rx(thx) Ry(thy) Rz(thz) Rmatrix(in) - // with rotations understood in the passive sense. - - if (thetaz != 0) { - double sint = sin(thetaz); - double cost = cos(thetaz); - for (int i=0; i < 3; ++i) { - double x = fTargetRmatrix[0][i]; - double y = fTargetRmatrix[1][i]; - fTargetRmatrix[0][i] = cost * x + sint * y; - fTargetRmatrix[1][i] = cost * y - sint * x; - } - } - if (thetay != 0) { - double sint = -sin(thetay); - double cost = cos(thetay); - for (int i=0; i < 3; ++i) { - double x = fTargetRmatrix[0][i]; - double z = fTargetRmatrix[2][i]; - fTargetRmatrix[0][i] = cost * x + sint * z; - fTargetRmatrix[2][i] = cost * z - sint * x; - } - } - if (thetax != 0) { - double sint = sin(thetax); - double cost = cos(thetax); - for (int i=0; i < 3; ++i) { - double y = fTargetRmatrix[1][i]; - double z = fTargetRmatrix[2][i]; - fTargetRmatrix[1][i] = cost * y + sint * z; - fTargetRmatrix[2][i] = cost * z - sint * y; - } - } -} - -double CobremsGenerator::Sigma2MS(double thickness_m) -{ - // Returns the mean-square multiple-scattering angle of the - // electron beam inside the radiator crystal target, in radians. - // This method wraps one of the concrete implementations, see below. - // Some formulas, although valid for a reasonable range of target - // thickness, can go negative for extremely small target thicknesses. - // Here I protect against these unusual cases by taking the absolute value. - - return fabs(Sigma2MS_Geant(thickness_m)); -} - -double CobremsGenerator::Sigma2MS_Kaune(double thickness_m) -{ - // Multiple scattering formula of Kaune et.al. - // with a correction factor from a multiple-scattering calculation - // taking into account the atomic and nuclear form factors for carbon. - // - // Note by RTJ, Oct. 13, 2008: - // I think this formula overestimates multiple scattering in thin targets - // like these diamond radiators, because it scales simply like sqrt(t). - // Although the leading behavior is sqrt(t/radlen), it should increase - // faster than that because of the 1/theta^2 tail of the Rutherford - // distribution that makes the central gaussian region swell with increasing - // number of scattering events. For comparison, I include below the PDG - // formula (sigma2MS_PDG), the Moliere formula used in the Geant3 simulation - // of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for - // thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 - // (sigma2MS_Hanson). The latter two separate the gaussian part from the - // tails in different ways, but both agree that the central part is much - // more narrow than the formulation by Kaune et.al. below. - - double carboncor = 4.2 / 4.6; - double Z = fTargetCrystal.Z; - double a = fTargetCrystal.lattice_constant; - return 8 * dpi * fTargetCrystal.nsites * pow(alpha * Z, 2) * - thickness_m * pow(hbarc / (fBeamEnergy * a), 2) / a * - log(183 * pow(Z, -1/3.)) * - carboncor; -} - -double CobremsGenerator::Sigma2MS_PDG(double thickness_m) -{ - // Evaluates the PDG formula for multiple scattering of the beam electron - // inside the target crystal, with beta=1, charge=1. This formula is said - // to be within 11% for t > 1e-3 rad.len. - - double t = thickness_m / fTargetCrystal.radiation_length; - return pow(13.6e-3 / fBeamEnergy, 2) * t * pow(1 + 0.038 * log(t), 2); -} - -double CobremsGenerator::Sigma2MS_Geant(double thickness_m) -{ - // Returns the Geant3 formula for the rms multiple-scattering angle - // This formula is based on the theory of Moliere scattering. It contains - // a cutoff parameter F that is used for the fractional integral of the - // scattering probability distribution that is included in computing the - // rms. This is needed because the complete distribution of scattering - // angles connects smoothly from a central gaussian (small-angle - // multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford - // scattering regime) through the so-called plural scattering region. - - double rBohr = 0.52917721e-10; // m - double F = 0.98; // probability cutoff in definition of sigma2MS - double Z = fTargetCrystal.Z; - double chi2cc = pow(0.39612e-2, 2) * Z * (Z + 1) * - fTargetCrystal.density / 12; // GeV^2/m - double chi2c = chi2cc * thickness_m / pow(fBeamEnergy, 2); - double chi2alpha = 1.13 * pow(hbarc / (fBeamEnergy * rBohr * 0.885), 2) * - pow(Z, 2/3.) * (1 + 3.34 * pow(alpha * Z, 2)); - double omega0 = chi2c / (1.167 * chi2alpha); // mean number of scatters - double gnu = omega0 / (2 * (1 - F)); - return chi2c / (1 + pow(F, 2)) * ((1 + gnu) / gnu * log(1 + gnu) -1); -} - -double CobremsGenerator::Sigma2MS_Hanson(double thickness_m) -{ - // Formulation of the rms projected angle attributed to Hanson et.al. - // in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere - // theory used to give the 1/e angular width of the scattering distribution. - // In the paper, though, they compare it with experiment for a variety of - // metal foils down to 1e-4 rad.len. in thickness, and show excellent - // agreement with the gaussian approximation out to 4 sigma or so. I - // like this paper because of the excellent agreement between the theory - // and experimental data. - - double Z = fTargetCrystal.Z; - double ttingcm2 = thickness_m * 100 * fTargetCrystal.density; - double EinMeV = fBeamEnergy * 1000; - double theta2max = 0.157 * Z * (Z + 1) / fTargetCrystal.A * - ttingcm2 / pow(EinMeV, 2); - double theta2screen = theta2max * fTargetCrystal.A * - (1 + 3.35 * pow(Z * alpha, 2)) / - (7800 * (Z + 1) * pow(Z, 1/3.) * ttingcm2); - double BminuslogB = log(theta2max / theta2screen) - 0.154; - double Blast = 1; - double B; - for (int i=0; i < 999; ++i) { - B = BminuslogB + log(Blast); - if (B < 1.2) { - B = 1.21; - break; - } - else if (fabs(B - Blast) > 1e-6) { - Blast = B; - } - else { - break; - } - } - return theta2max * (B - 1.2) / 2; -} - -#ifdef BOOST_PYTHON_WRAPPING - -void CobremsGenerator::pyApplyBeamCrystalConvolution(int nbins, pyobject xarr, - pyobject yarr) -{ - using boost::python::extract; - typedef boost::python::tuple pytuple; - pytuple xtuple = extract(xarr.attr("buffer_info")()); - pytuple ytuple = extract(yarr.attr("buffer_info")()); - double *xbuf = reinterpret_cast((int)extract(xtuple[0])); - double *ybuf = reinterpret_cast((int)extract(ytuple[0])); - applyBeamCrystalConvolution(nbins, xbuf, ybuf); -} - -double (CobremsGenerator::*Rate_dNtdx_1)(double) = &CobremsGenerator::Rate_dNtdx; -double (CobremsGenerator::*Rate_dNtdx_3)(double, double, double) = &CobremsGenerator::Rate_dNtdx; -double (CobremsGenerator::*Rate_dNcdx_1)(double) = &CobremsGenerator::Rate_dNcdx; -double (CobremsGenerator::*Rate_dNcdx_3)(double, double, double) = &CobremsGenerator::Rate_dNcdx; -double (CobremsGenerator::*Acceptance_1)(double) = &CobremsGenerator::Acceptance; -double (CobremsGenerator::*Acceptance_4)(double, double, double, double) = &CobremsGenerator::Acceptance; - -BOOST_PYTHON_MODULE(libcobrems) -{ - using boost::python::class_; - using boost::python::enum_; - using boost::python::def; - - class_ - ("CobremsGenerator", - "coherent bremsstrahlung spectrum and polarization calculator, " - "with methods for generating random Monte Carlo samples", - boost::python::init()) - .def("setBeamEnergy", &CobremsGenerator::setBeamEnergy) - .def("setBeamErms", &CobremsGenerator::setBeamErms) - .def("setBeamEmittance", &CobremsGenerator::setBeamEmittance) - .def("setCollimatorSpotrms", &CobremsGenerator::setCollimatorSpotrms) - .def("setCollimatorDistance", &CobremsGenerator::setCollimatorDistance) - .def("setCollimatorDiameter", &CobremsGenerator::setCollimatorDiameter) - .def("setTargetThickness", &CobremsGenerator::setTargetThickness) - .def("setTargetCrystal", &CobremsGenerator::setTargetCrystal) - .def("resetTargetOrientation", &CobremsGenerator::resetTargetOrientation) - .def("setCoherentEdge", &CobremsGenerator::setCoherentEdge) - .def("setTargetThetax", &CobremsGenerator::setTargetThetax) - .def("setTargetThetay", &CobremsGenerator::setTargetThetay) - .def("setTargetThetaz", &CobremsGenerator::setTargetThetaz) - .def("RotateTarget", &CobremsGenerator::RotateTarget) - .def("getBeamEnergy", &CobremsGenerator::getBeamEnergy) - .def("getBeamErms", &CobremsGenerator::getBeamErms) - .def("getBeamEmittance", &CobremsGenerator::getBeamEmittance) - .def("getCollimatorSpotrms", &CobremsGenerator::getCollimatorSpotrms) - .def("getCollimatorDistance", &CobremsGenerator::getCollimatorDistance) - .def("getCollimatorDiameter", &CobremsGenerator::getCollimatorDiameter) - .def("getTargetThickness", &CobremsGenerator::getTargetThickness) - .def("getTargetCrystal", &CobremsGenerator::getTargetCrystal) - .def("getTargetCrystalNsites", &CobremsGenerator::getTargetCrystalNsites) - .def("getTargetCrystalAtomicNumber", &CobremsGenerator::getTargetCrystalAtomicNumber) - .def("getTargetCrystalAtomicWeight", &CobremsGenerator::getTargetCrystalAtomicWeight) - .def("getTargetCrystalDensity", &CobremsGenerator::getTargetCrystalDensity) - .def("getTargetCrystalLatticeConstant", &CobremsGenerator::getTargetCrystalLatticeConstant) - .def("getTargetCrystalRadiationLength", &CobremsGenerator::getTargetCrystalRadiationLength) - .def("getTargetCrystalDebyeWallerConst", &CobremsGenerator::getTargetCrystalDebyeWallerConst) - .def("getTargetCrystalMosaicSpread", &CobremsGenerator::getTargetCrystalMosaicSpread) - .def("getTargetCrystalBetaFF", &CobremsGenerator::getTargetCrystalBetaFF) - .def("getTargetThetax", &CobremsGenerator::getTargetThetax) - .def("getTargetThetay", &CobremsGenerator::getTargetThetay) - .def("getTargetThetaz", &CobremsGenerator::getTargetThetaz) - .def("getTargetRadiationLength_PDG", &CobremsGenerator::getTargetRadiationLength_PDG) - .def("getTargetRadiationLength_Schiff", &CobremsGenerator::getTargetRadiationLength_Schiff) - .def("getTargetDebyeWallerConstant", &CobremsGenerator::getTargetDebyeWallerConstant) - .def("getCollimatedFlag", &CobremsGenerator::getCollimatedFlag) - .def("setCollimatedFlag", &CobremsGenerator::setCollimatedFlag) - .def("getPolarizedFlag", &CobremsGenerator::getPolarizedFlag) - .def("setPolarizedFlag", &CobremsGenerator::setPolarizedFlag) - .def("applyBeamCrystalConvolution", &CobremsGenerator::pyApplyBeamCrystalConvolution) - .def("printBeamlineInfo", &CobremsGenerator::printBeamlineInfo) - .def("printTargetCrystalInfo", &CobremsGenerator::printTargetCrystalInfo) - .def("CoherentEnhancement", &CobremsGenerator::CoherentEnhancement) - .def("Rate_dNtdx", Rate_dNtdx_1) - .def("Rate_dNtdx", Rate_dNtdx_3) - .def("Rate_dNtdk", &CobremsGenerator::Rate_dNtdk) - .def("Rate_dNcdx", Rate_dNcdx_1) - .def("Rate_dNcdx", Rate_dNcdx_3) - .def("Rate_dNcdxdp", &CobremsGenerator::Rate_dNcdxdp) - .def("Rate_dNidx", &CobremsGenerator::Rate_dNidx) - .def("Rate_dNBidx", &CobremsGenerator::Rate_dNBidx) - .def("Rate_dNidxdt2", &CobremsGenerator::Rate_dNidxdt2) - .def("Rate_para", &CobremsGenerator::Rate_para) - .def("Rate_ortho", &CobremsGenerator::Rate_ortho) - .def("Polarization", &CobremsGenerator::Polarization) - .def("Acceptance", Acceptance_1) - .def("Acceptance", Acceptance_4) - .def("Sigma2MS", &CobremsGenerator::Sigma2MS) - .def("Sigma2MS_Kaune", &CobremsGenerator::Sigma2MS_Kaune) - .def("Sigma2MS_PDG", &CobremsGenerator::Sigma2MS_PDG) - .def("Sigma2MS_Geant", &CobremsGenerator::Sigma2MS_Geant) - .def("Sigma2MS_Hanson", &CobremsGenerator::Sigma2MS_Hanson) - .def_readonly("dpi", &CobremsGenerator::dpi) - .def_readonly("me", &CobremsGenerator::me) - .def_readonly("alpha", &CobremsGenerator::alpha) - .def_readonly("hbarc", &CobremsGenerator::hbarc) - ; -} - -#endif diff --git a/src/programs/Simulation/gen_2mu/CobremsGenerator.hh b/src/programs/Simulation/gen_2mu/CobremsGenerator.hh deleted file mode 100644 index ade4f2230e..0000000000 --- a/src/programs/Simulation/gen_2mu/CobremsGenerator.hh +++ /dev/null @@ -1,292 +0,0 @@ -// -// CobremsGenerator class header -// -// author: richard.t.jones at uconn.edu -// version: july 27, 2015 -// -// notes: -// -// This class computes differential rates and polarization factors -// for coherent bremsstrahlung by an electron beam passing through -// a crystal radiator. A beamline geometry similar to that in Hall D -// at Jefferson Lab is assumed, consisting of a single radiator -// followed by a collimator located some distance away. Rates are -// computed for both the pre-collimated and post-collimated beams. -// -// This code was ported from cobrems.f, written in Fortran 77. -// -// units: -// Any length is in m; energy,momentum,mass in GeV (c=1); angles in -// radians; time in seconds; current in microAmps. - -#ifndef CobremsGenerator_h -#define CobremsGenerator_h 1 - -#include -#include - -#if BOOST_PYTHON_WRAPPING -#include -#endif - -class CobremsGenerator { - public: - CobremsGenerator(double Emax_GeV, double Epeak_GeV); - CobremsGenerator(const CobremsGenerator &src); - CobremsGenerator &operator=(const CobremsGenerator &src); - ~CobremsGenerator(); - - void setBeamEnergy(double Ebeam_GeV); - void setBeamErms(double Erms_GeV); - void setBeamEmittance(double emit_m_r); - void setCollimatorSpotrms(double spotrms_m); - void setCollimatorDistance(double distance_m); - void setCollimatorDiameter(double diameter_m); - void setTargetThickness(double thickness_m); - void setTargetCrystal(std::string crystal); - void resetTargetOrientation(); - void setCoherentEdge(double Epeak_GeV); - void setTargetThetax(double thetax); - void setTargetThetay(double thetay); - void setTargetThetaz(double thetaz); - void setPhotonEnergyMin(double Emin_GeV); - void RotateTarget(double thetax, double thetay, double thetaz); - void setCollimatedFlag(bool flag); - void setPolarizedFlag(bool flag); - - double getBeamEnergy() { - return fBeamEnergy; // (GeV) - } - double getBeamErms() { - return fBeamErms; // (GeV) - } - double getBeamEmittance() { - return fBeamEmittance; // (m rad) - } - double getCollimatorSpotrms() { - return fCollimatorSpotrms; // (m) - } - double getCollimatorDistance() { - return fCollimatorDistance; // (m) - } - double getCollimatorDiameter() { - return fCollimatorDiameter; // (m) - } - double getTargetThickness() { - return fTargetThickness; // (m) - } - std::string getTargetCrystal() { - return fTargetCrystal.name; - } - int getTargetCrystalNsites() { - return fTargetCrystal.nsites; - } - double getTargetCrystalAtomicNumber() { - return fTargetCrystal.Z; - } - double getTargetCrystalAtomicWeight() { - return fTargetCrystal.A; // (amu) - } - double getTargetCrystalDensity() { - return fTargetCrystal.density; // (g/cm^3) - } - double getTargetCrystalLatticeConstant() { - return fTargetCrystal.lattice_constant; // (m) - } - double getTargetCrystalRadiationLength() { - return fTargetCrystal.radiation_length; // (m) - } - double getTargetCrystalDebyeWallerConst() { - return fTargetCrystal.Debye_Waller_const; // (1/GeV^2) - } - double getTargetCrystalMosaicSpread() { - return fTargetCrystal.mosaic_spread; // (rad) - } - double getTargetCrystalBetaFF() { - return fTargetCrystal.betaFF; // (1/GeV^2) - } - double getTargetThetax() { - return fTargetThetax; // (rad) - } - double getTargetThetay() { - return fTargetThetay; // (rad) - } - double getTargetThetaz() { - return fTargetThetaz; // (rad) - } - double getPhotonEnergyMin() { - return fPhotonEnergyMin; // (GeV) - } - bool getCollimatedFlag() { - return fCollimatedFlag; - } - bool getPolarizedFlag() { - return fPolarizedFlag; - } - - double getTargetRadiationLength_PDG(); - double getTargetRadiationLength_Schiff(); - double getTargetDebyeWallerConstant(double DebyeT_K, double T_K); - void applyBeamCrystalConvolution(int nbins, double *xvalues, - double *yvalues); -#if BOOST_PYTHON_WRAPPING - typedef boost::python::object pyobject; - void pyApplyBeamCrystalConvolution(int nbins, pyobject xarr, pyobject yarr); -#endif - void printBeamlineInfo(); - void printTargetCrystalInfo(); - double CoherentEnhancement(double x); - double Rate_dNtdx(double x); - double Rate_dNtdx(double x, double distance_m, double diameter_m); - double Rate_dNtdk(double k_GeV); - double Rate_dNcdx(double x); - double Rate_dNcdx(double x, double distance_m, double diameter_m); - double Rate_dNcdxdp(double x, double phi); - double Rate_dNidx(double x); - double Rate_dNBidx(double x); - double Rate_dNidxdt2(double x, double theta2); - double Rate_para(double x, double theta2, double phi); - double Rate_ortho(double x, double theta2, double phi); - double Polarization(double x, double theta2); - double Acceptance(double theta2, double phi, - double xshift_m, double yshift_m); - double Acceptance(double theta2); - double Sigma2MS(double thickness_m); - double Sigma2MS_Kaune(double thickness_m); - double Sigma2MS_PDG(double thickness_m); - double Sigma2MS_Geant(double thickness_m); - double Sigma2MS_Hanson(double thickness_m); - - // some math and physical constants - static const double dpi; - static const double me; - static const double alpha; - static const double hbarc; - - // statistical record from last sum over reciprocal lattice - std::vector fQ2theta2; - std::vector fQ2weight; - - private: - // description of the radiator crystal lattice, here configured for diamond - // but may be customized to describe any regular crystal - struct lattice_vector { - double x; - double y; - double z; - lattice_vector() - : x(0), y(0), z(0) {} - lattice_vector(double ux, double uy, double uz) - : x(ux), y(uy), z(uz) {} - lattice_vector(const lattice_vector &src) - : x(src.x), y(src.y), z(src.z) {} - lattice_vector &operator=(const lattice_vector &src) { - x = src.x; - y = src.y; - z = src.z; - return *this; - } - }; - struct crystal_parameters_t { - std::string name; - int nsites; - double Z; - double A; // amu - double density; // g/cm^3 - double lattice_constant; // m - double radiation_length; // m - double Debye_Waller_const; // 1/GeV^2 - double mosaic_spread; // rms radians - double betaFF; // 1/GeV^2 - std::vector ucell_site; - lattice_vector primaryHKL; - } fTargetCrystal; - double fTargetThickness; - - // orientation of the radiator with respect to the beam axis - double fTargetThetax; // the "small" angle - double fTargetThetay; // the "large" angle - double fTargetThetaz; - double fTargetRmatrix[3][3]; - - // description of the beam at the radiator - double fBeamEnergy; // GeV - double fBeamErms; // GeV - double fBeamEmittance; // m radians - double fCollimatorSpotrms; // m - double fCollimatorDistance; // m - double fCollimatorDiameter; // m - - // flags to select kind of flux to be computed - bool fCollimatedFlag; - bool fPolarizedFlag; - - // parameters controlling Monte Carlo generation of photons - double fPhotonEnergyMin; // GeV -}; - -inline void CobremsGenerator::setBeamEmittance(double emit_m_r) { - fBeamEmittance = emit_m_r; -} - -inline void CobremsGenerator::setBeamEnergy(double Ebeam_GeV) { - fBeamEnergy = Ebeam_GeV; -} - -inline void CobremsGenerator::setBeamErms(double Erms_GeV) { - fBeamErms = Erms_GeV; -} - -inline void CobremsGenerator::setCollimatorSpotrms(double spotrms_m) { - fCollimatorSpotrms = spotrms_m; -} - -inline void CobremsGenerator::setCollimatorDistance(double distance_m) { - fCollimatorDistance = distance_m; -} - -inline void CobremsGenerator::setCollimatorDiameter(double diameter_m) { - fCollimatorDiameter = diameter_m; -} - -inline void CobremsGenerator::setTargetThickness(double thickness_m) { - fTargetThickness = thickness_m; -} - -inline void CobremsGenerator::setTargetThetax(double thetax) { - fTargetThetax = thetax; -} - -inline void CobremsGenerator::setTargetThetay(double thetay) { - fTargetThetay = thetay; -} - -inline void CobremsGenerator::setTargetThetaz(double thetaz) { - fTargetThetaz = thetaz; -} - -inline void CobremsGenerator::setPhotonEnergyMin(double Emin_GeV) { - fPhotonEnergyMin = Emin_GeV; -} - -inline void CobremsGenerator::setCollimatedFlag(bool flag) { - fCollimatedFlag = flag; -} - -inline void CobremsGenerator::setPolarizedFlag(bool flag) { - fPolarizedFlag = flag; -} - -inline void CobremsGenerator::resetTargetOrientation() { - fTargetRmatrix[0][0] = 1; - fTargetRmatrix[0][1] = 0; - fTargetRmatrix[0][2] = 0; - fTargetRmatrix[1][0] = 0; - fTargetRmatrix[1][1] = 1; - fTargetRmatrix[1][2] = 0; - fTargetRmatrix[2][0] = 0; - fTargetRmatrix[2][1] = 0; - fTargetRmatrix[2][2] = 1; -} - -#endif diff --git a/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.cc b/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.cc deleted file mode 100644 index 5d3a282742..0000000000 --- a/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.cc +++ /dev/null @@ -1,1011 +0,0 @@ -// -// class implementation for GlueXPrimaryGeneratorAction -// -// author: richard.t.jones at uconn.edu -// version: may 12, 2012 - -#include - -#include -#include -#include -using namespace std; - -#include -#include - -#define s (1.0) -#define ns (1.0E-9) -#define m (1.0) -#define cm (1.0E-2) -#define GeV (1.0) -#define radian (1.0) - -#define twopi 6.28318530717958623 -#define pi 3.14159265358979312 -#define electron_mass_c2 0.000511 - -#ifndef _DBG_ -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ cout<<__FILE__<<":"<<__LINE__< -//#include -//#include -// -//typedef GlueXPrimaryGeneratorAction::source_type_t source_type_t; -//typedef GlueXPrimaryGeneratorAction::single_particle_gun_t particle_gun_t; -//typedef GlueXPrimaryGeneratorAction::ImportanceSampler ImportanceSampler; -// -//int GlueXPrimaryGeneratorAction::instanceCount = 0; -//source_type_t GlueXPrimaryGeneratorAction::fSourceType = SOURCE_TYPE_NONE; -// -//std::ifstream *GlueXPrimaryGeneratorAction::fHDDMinfile; -//hddm_s::istream *GlueXPrimaryGeneratorAction::fHDDMistream; -CobremsGenerator *GlueXPrimaryGeneratorAction::fCobremsGenerator; -//G4ParticleTable *GlueXPrimaryGeneratorAction::fParticleTable; -//GlueXParticleGun *GlueXPrimaryGeneratorAction::fParticleGun; -//particle_gun_t GlueXPrimaryGeneratorAction::fGunParticle; - -//double GlueXPrimaryGeneratorAction::fBeamBucketPeriod = 0; -//double GlueXPrimaryGeneratorAction::fBeamBackgroundRate = 0; -//double GlueXPrimaryGeneratorAction::fBeamBackgroundGateStart = 0; -//double GlueXPrimaryGeneratorAction::fBeamBackgroundGateStop = 0; -//double GlueXPrimaryGeneratorAction::fL1triggerTimeSigma = 10 * ns; -//double GlueXPrimaryGeneratorAction::fBeamStartZ = -24 * m; -double GlueXPrimaryGeneratorAction::fTargetCenterZ = 1 * cm; -//double GlueXPrimaryGeneratorAction::fTargetLength = 29.9746 * cm; -//double GlueXPrimaryGeneratorAction::fBeamDiameter = 0.5 * cm; - -//int GlueXPrimaryGeneratorAction::fEventCount = 0; - -GlueXPrimaryGeneratorAction::ImportanceSampler GlueXPrimaryGeneratorAction::fCoherentPDFx; -GlueXPrimaryGeneratorAction::ImportanceSampler GlueXPrimaryGeneratorAction::fIncoherentPDFlogx; -GlueXPrimaryGeneratorAction::ImportanceSampler GlueXPrimaryGeneratorAction::fIncoherentPDFy; -double GlueXPrimaryGeneratorAction::fIncoherentPDFtheta02; - -int LAST_COBREMS_MECH=0; // 0=unknown, 1=Coherent, 2=Incoherent - -//G4Mutex GlueXPrimaryGeneratorAction::fMutex = G4MUTEX_INITIALIZER; - -//-------------------------------------------- -// GetMech -//-------------------------------------------- -void GetMech(int &Ncoherent, int &Nincoherent) -{ - Ncoherent = GlueXPrimaryGeneratorAction::fCoherentPDFx.Npassed; - Nincoherent = GlueXPrimaryGeneratorAction::fIncoherentPDFlogx.Npassed; - - // Constructor initializes values to 1. Subtract that. - Ncoherent--; - Nincoherent--; -} - -//-------------------------------------------- -// GlueXPrimaryGeneratorAction (constructor) -//-------------------------------------------- -GlueXPrimaryGeneratorAction::GlueXPrimaryGeneratorAction() -{ -// G4AutoLock barrier(&fMutex); -// ++instanceCount; -// -// // Initializaton is driven by the control.in file, which -// // gets read and parsed only once, by the first constructor. -// -// if (fSourceType != SOURCE_TYPE_NONE) { -// return; -// } -// -// fParticleGun = new GlueXParticleGun(); -// fParticleTable = G4ParticleTable::GetParticleTable(); -// -// GlueXUserOptions *user_opts = GlueXUserOptions::GetInstance(); -// if (user_opts == 0) { -// cerr << "Error in GlueXPrimaryGeneratorAction constructor - " -// << "GlueXUserOptions::GetInstance() returns null, " -// << "cannot continue." << endl; -// exit(-1); -// } -// -// fHDDMinfile = 0; -// fHDDMistream = 0; -// fCobremsGenerator = 0; -// std::map infile; - std::map beampars; - std::map kinepars; - -// // Three event source options are supported: -// // 1) external generator, hddm input stream source -// // 2) internal coherent bremsstrahlung beam generator -// // 3) internal particle gun generator -// -// if (user_opts->Find("INFILE", infile) || -// user_opts->Find("INFI", infile)) -// { -// fHDDMinfile = new std::ifstream(infile[1].c_str()); -// if (!fHDDMinfile->is_open()) { -// cerr << "GlueXPrimaryGeneratorAction error: " -// << "Unable to open HDDM input file: " << infile[1] -// << endl; -// exit(-1); -// } -// fHDDMistream = new hddm_s::istream(*fHDDMinfile); -// cout << "Opened input file: " << infile[1] << endl; -// fSourceType = SOURCE_TYPE_HDDM; -// } -// -// else if (user_opts->Find("BEAM", beampars)) -// { - double beamE0 = beampars[1]; - double beamEpeak = beampars[2]; - double beamEmin = (beampars[3] > 0)? beampars[3] : 0.120; - double radColDist = (beampars[4] > 0)? beampars[4] : 76.; -// double colDiam = (beampars[5] > 0)? beampars[5] : 0.0034; - double beamEmit = (beampars[6] > 0)? beampars[6] : 2.5e-9; - double radThick = (beampars[7] > 0)? beampars[7] : 20e-6; - - // Overwrite with values from globals defined in gen_2mu.cc - beamE0=Eelectron_beam; - beamEpeak = Ecoherent_peak; - beamEmin = Emin; - - if (beamE0 == 0 || beamEpeak == 0) { - cerr << "GlueXPrimaryGeneratorAction error: " - << "BEAM card specified in control.in but required values " - << "Emax and/or Epeak are missing, cannot continue." - << endl; - exit(-1); - } - - fCobremsGenerator = new CobremsGenerator(beamE0, beamEpeak); - fCobremsGenerator->setPhotonEnergyMin(beamEmin); - fCobremsGenerator->setCollimatorDistance(radColDist); - fCobremsGenerator->setCollimatorDiameter(CollimatorDiameter); - fCobremsGenerator->setBeamEmittance(beamEmit); - fCobremsGenerator->setTargetThickness(radThick); - prepareCobremsImportanceSamplingPDFs(); - - std::cout << std::endl - << "Initialization for coherent bremsstralung calculation" - << std::endl; - fCobremsGenerator->printBeamlineInfo(); - -// std::map bgratepars; -// std::map bggatepars; -// if (user_opts->Find("BGRATE", bgratepars) && -// user_opts->Find("BGGATE", bggatepars)) -// { -// fBeamBackgroundRate = bgratepars[1] * 1/s; -// fBeamBackgroundGateStart = bgratepars[1] * ns; -// fBeamBackgroundGateStop = bgratepars[2] * ns; -// if (fBeamBackgroundRate > 0 && -// fBeamBackgroundGateStart >= fBeamBackgroundGateStop) -// { -// cerr << "GlueXPrimaryGeneratorAction error: " -// << "BGRATE is non-zero, but the time window specified " -// << "in BGGATE is invalid." -// << endl; -// exit(-1); -// } -// } -// fSourceType = SOURCE_TYPE_COBREMS_GEN; -// } -// -// else if (user_opts->Find("KINE", kinepars)) -// { -// if (kinepars[1] == 1000) { -// fGunParticle.geantType = 0; -// fGunParticle.pdgType = 999999; -// fGunParticle.partDef = fParticleTable->FindParticle("geantino"); -// } -// else if (kinepars[1] == 1001) { -// fGunParticle.geantType = 0; -// fGunParticle.pdgType = 999999; -// fGunParticle.partDef = fParticleTable->FindParticle("chargedgeantino"); -// } -// else { -// if (kinepars[1] > 100) -// fGunParticle.geantType = kinepars[1] - 100; -// else -// fGunParticle.geantType = kinepars[1]; -// fGunParticle.pdgType = ConvertGeant3ToPdg(fGunParticle.geantType); -// fGunParticle.partDef = fParticleTable->FindParticle(fGunParticle.pdgType); -// } -// if (fGunParticle.partDef == 0) { -// cerr << "GlueXPrimaryGeneratorAction constructor error - " -// << "Unknown GEANT particle type: " << kinepars[1] -// << " was specified in the control.in file." << endl; -// exit(-1); -// } -// fParticleGun->SetParticleDefinition(fGunParticle.partDef); -// -// double x(0), y(0), z(65 * cm); -// std::map scappars; -// if (user_opts->Find("SCAP", scappars)) { -// x = scappars[1] * cm; -// y = scappars[2] * cm; -// z = scappars[3] * cm; -// } -// fGunParticle.pos.set(x,y,z); -// std::map tgtwidthpars; -// if (user_opts->Find("tgtwidth", tgtwidthpars)) { -// fGunParticle.deltaR = tgtwidthpars[1] * cm; -// fGunParticle.deltaZ = tgtwidthpars[2] * cm; -// } -// else { -// fGunParticle.deltaR = 0; -// fGunParticle.deltaZ = 0; -// } -// -// fGunParticle.mom = kinepars[2] * GeV; -// if (kinepars[1] > 100) { -// fGunParticle.theta = kinepars[3] * degree; -// fGunParticle.phi = kinepars[4] * degree; -// fGunParticle.deltaMom = kinepars[5]; -// fGunParticle.deltaTheta = kinepars[6]; -// fGunParticle.deltaPhi = kinepars[7]; -// } -// else { -// fGunParticle.deltaMom = 0; -// fGunParticle.theta = 90 * degree; -// fGunParticle.deltaTheta = 180 * degree; -// fGunParticle.phi = 0; -// fGunParticle.deltaPhi = 360 * degree; -// } -// fSourceType = SOURCE_TYPE_PARTICLE_GUN; -// } -// -// std::map trefsigma; -// if (user_opts->Find("trefsigma", trefsigma)) { -// fL1triggerTimeSigma = trefsigma[1] * ns; -// } -// else { -// fL1triggerTimeSigma = 10 * ns; -// } -} - -//GlueXPrimaryGeneratorAction::GlueXPrimaryGeneratorAction(const -// GlueXPrimaryGeneratorAction &src) -// : G4VUserPrimaryGeneratorAction(src) -//{ -// G4AutoLock barrier(&fMutex); -// ++instanceCount; -//} -// -//GlueXPrimaryGeneratorAction &GlueXPrimaryGeneratorAction::operator=(const -// GlueXPrimaryGeneratorAction &src) -//{ -// *(G4VUserPrimaryGeneratorAction*)this = src; -// return *this; -//} - -//-------------------------------------------- -// ~GlueXPrimaryGeneratorAction (destructor) -//-------------------------------------------- - -GlueXPrimaryGeneratorAction::~GlueXPrimaryGeneratorAction() -{ -// G4AutoLock barrier(&fMutex); -// if (--instanceCount == 0) { -// if (fHDDMistream) -// delete fHDDMistream; -// if (fHDDMinfile) -// delete fHDDMinfile; - if (fCobremsGenerator) - delete fCobremsGenerator; -// delete fParticleGun; -// } -} - -void GlueXPrimaryGeneratorAction::prepareCobremsImportanceSamplingPDFs() -{ - - cout << "Preparing Cobrems Importance Sampling PDFs ..." << endl; - - // Construct lookup tables representing the PDFs used for - // importance-sampling the coherent bremsstrahlung kinematics. - - const int Ndim = 500; - double Emin = fCobremsGenerator->getPhotonEnergyMin() * GeV; - double Emax = fCobremsGenerator->getBeamEnergy() * GeV; - double sum; - - // Compute approximate PDF for dNc/dx - double xmin = Emin / Emax; - double dx = (1 - xmin) / Ndim; - double xarr[Ndim + 1], yarr[Ndim + 1]; - for (int i=0; i <= Ndim; ++i) { - xarr[i] = xmin + i * dx; - yarr[i] = twopi * fCobremsGenerator->Rate_dNcdxdp(xarr[i], pi/2); - } - fCobremsGenerator->applyBeamCrystalConvolution(Ndim + 1, xarr, yarr); - sum = 0; - for (int i=0; i <= Ndim; ++i) { - sum += (i > 0)? (yarr[i] + yarr[i - 1]) / 2 : 0; - fCoherentPDFx.randvar.push_back(xarr[i]); - fCoherentPDFx.density.push_back(yarr[i]); - fCoherentPDFx.integral.push_back(sum); - } - for (int i=0; i <= Ndim; ++i) { - fCoherentPDFx.density[i] /= sum * dx; - fCoherentPDFx.integral[i] /= sum; - } - - // Compute approximate PDF for dNi/dx - double logxmin = log(xmin); - double dlogx = -logxmin / Ndim; - sum = 0; - for (int i=0; i <= Ndim; ++i) { - double logx = logxmin + i * dlogx; - double x = exp(logx); - double dNidx = fCobremsGenerator->Rate_dNidxdt2(x, 0); - double dNidlogx = dNidx * x; - fIncoherentPDFlogx.randvar.push_back(logx); - fIncoherentPDFlogx.density.push_back(dNidlogx); - fIncoherentPDFlogx.integral.push_back(sum); - sum += (i < Ndim)? dNidlogx : 0; - } - for (int i=0; i <= Ndim; ++i) { - fIncoherentPDFlogx.density[i] /= sum * dlogx; - fIncoherentPDFlogx.integral[i] /= sum; - } - - // Compute approximate PDF for dNi/dy - fIncoherentPDFtheta02 = 1.8; - double ymin = 1e-3; - double dy = (1 - ymin) / Ndim; - sum = 0; - for (int i=0; i <= Ndim; ++i) { - double y = ymin + i * dy; - double theta2 = fIncoherentPDFtheta02 * (1 / y - 1); - double dNidxdt2 = fCobremsGenerator->Rate_dNidxdt2(0.5, theta2); - fIncoherentPDFy.randvar.push_back(y); - fIncoherentPDFy.density.push_back(dNidxdt2); - fIncoherentPDFy.integral.push_back(sum); - sum += (i < Ndim)? dNidxdt2 : 0; - } - for (int i=0; i <= Ndim; ++i) { - fIncoherentPDFy.density[i] /= sum * dy; - fIncoherentPDFy.integral[i] /= sum; - } - - // These cutoffs should be set empirically, as low as possible - // for good efficiency, but not too low so as to avoid excessive - // warnings about Pcut violations. - fCoherentPDFx.Pcut = .0002; - fIncoherentPDFlogx.Pcut = .001; - - cout << "Completed Cobrems Importance Sampling PDFs." << endl; -} -// -////-------------------------------------------- -//// GeneratePrimaries -////-------------------------------------------- -// -//void GlueXPrimaryGeneratorAction::GeneratePrimaries(G4Event* anEvent) -//{ -// G4AutoLock barrier(&fMutex); -// -// switch(fSourceType){ -// case SOURCE_TYPE_HDDM: -// GeneratePrimariesHDDM(anEvent); -// break; -// case SOURCE_TYPE_COBREMS_GEN: -// GeneratePrimariesCobrems(anEvent); -// break; -// case SOURCE_TYPE_PARTICLE_GUN: -// GeneratePrimariesParticleGun(anEvent); -// break; -// default: -// cout << "No event source selected, cannot continue!" << endl; -// exit(-1); -// } -//} -// -////-------------------------------------------- -//// GeneratePrimariesParticleGun -////-------------------------------------------- -// -//void GlueXPrimaryGeneratorAction::GeneratePrimariesParticleGun(G4Event* anEvent) -//{ -// // Unbelievably, GEANT4's G4ParticleGun class insists on printing -// // a message whenever the momentum or energy is changed, unless -// // the other is 0. Here, we reset the particle gun energy using -// // our own derived class. (Sheesh!!) -// fParticleGun->Reset(); -// -// // place and smear the particle gun origin -// G4ThreeVector pos(fGunParticle.pos); -// if (fGunParticle.deltaR > 0) { -// double dx, dy; -// while (true) { -// double rx = RAND.Rndm() - 0.5; -// double ry = RAND.Rndm() - 0.5; -// if (rx*rx + ry*ry <= 0.25) { -// dx = rx * 2 * fGunParticle.deltaR; -// dy = ry * 2 * fGunParticle.deltaR; -// break; -// } -// } -// pos += G4ThreeVector(dx, dy, 0); -// } -// if (fGunParticle.deltaZ > 0) { -// double dz = (RAND.Rndm() - 0.5) * fGunParticle.deltaZ; -// pos += G4ThreeVector(0, 0, dz); -// } -// fParticleGun->SetParticlePosition(pos); -// -// // Assign and optionally smear the particle momentum -// double p = fGunParticle.mom; -// double thetap = fGunParticle.theta; -// double phip = fGunParticle.phi; -// if (fGunParticle.deltaMom > 0) -// p += (RAND.Rndm() - 0.5) * fGunParticle.deltaMom; -// if (fGunParticle.deltaTheta > 0) -// thetap += (RAND.Rndm() - 0.5) * fGunParticle.deltaTheta; -// if (fGunParticle.deltaPhi > 0) -// phip += (RAND.Rndm() - 0.5) * fGunParticle.deltaPhi; -// G4ThreeVector mom(p * sin(thetap) * cos(phip), -// p * sin(thetap) * sin(phip), -// p * cos(thetap)); -// fParticleGun->SetParticleMomentum(mom); -// -// // Set the event number and fire the gun -// anEvent->SetEventID(++fEventCount); -// fParticleGun->GeneratePrimaryVertex(anEvent); -// -// // Store generated particle info so it can be written to output file -// pos *= 1 / cm; // convert to cm -// mom *= 1 / GeV; // convert to GeV -// int type = fGunParticle.geantType; -// anEvent->SetUserInformation(new GlueXUserEventInformation(type, pos, mom)); -//} -// -////-------------------------------------------- -//// GeneratePrimariesHDDM -////-------------------------------------------- -// -//void GlueXPrimaryGeneratorAction::GeneratePrimariesHDDM(G4Event* anEvent) -//{ -// if (! fHDDMinfile->good()) { -// anEvent->SetEventAborted(); -// return; -// } -// -// hddm_s::HDDM *hddmevent = new hddm_s::HDDM; -// try { -// *fHDDMistream >> *hddmevent; -// } -// catch(std::exception e) { -// cout << e.what() << endl; -// anEvent->SetEventAborted(); -// return; -// } -// -// // Store generated event info so it can be written to output file -// ++fEventCount; -// anEvent->SetUserInformation(new GlueXUserEventInformation(hddmevent)); -// -// // Unpack generated event and prepare initial state for simulation -// int Nprimaries = 0; -// hddm_s::VertexList vertices = hddmevent->getVertices(); -// if (vertices.size() == 0) { -// cout << "No vertices in input HDDM event!" << endl; -// anEvent->SetEventAborted(); -// return; -// } -// hddm_s::VertexList::iterator it_vertex; -// for (it_vertex = vertices.begin(); -// it_vertex != vertices.end(); ++it_vertex) -// { -// anEvent->SetEventID(it_vertex->getEventNo()); -// hddm_s::Origin &origin = it_vertex->getOrigin(); -// double x = origin.getVx() * cm; -// double y = origin.getVy() * cm; -// double z = origin.getVz() * cm; -// if (x == 0 && y == 0 && z == 0) { -// while (true) { -// x = RAND.Rndm() - 0.5; -// y = RAND.Rndm() - 0.5; -// if (x*x + y*y <= 0.25) { -// x *= fBeamDiameter; -// y *= fBeamDiameter; -// } -// } -// z = fTargetCenterZ + (RAND.Rndm() - 0.5) * fTargetLength; -// } -// G4ThreeVector pos(x, y, z); -// -// // The primary interaction vertex time is referenced to a clock -// // whose t=0 is synchronized to the crossing of a beam bunch -// // through the target midplane. This beam bunch may not contain -// // the beam particle whose interaction generated the vertex, -// // but it represents best-guess based on the arrival time of -// // the L1 trigger signal. The spread in the L1 relative to the -// // interacting bunch time is parameterized as a Gaussian. -// -// extern int run_number; -// if (fBeamBucketPeriod == 0) -// getBeamBucketPeriod(run_number); -// // getBeamBucketPeriod(it_vertex->getRunNo()); -// -// double t0, t0rf; -// double lightSpeed = 2.99792e8 * m/s; -// t0 = (origin.getT() * ns) + fL1triggerTimeSigma * RAND.Gaus::shoot(); -// t0rf = fBeamBucketPeriod * int(t0 / fBeamBucketPeriod + 0.5); -// t0 = t0rf + (z - fTargetCenterZ) / lightSpeed; -// G4PrimaryVertex* vertex = new G4PrimaryVertex(pos, t0); -// -// hddm_s::ProductList &products = it_vertex->getProducts(); -// hddm_s::ProductList::iterator it_product; -// for (it_product = products.begin(); -// it_product != products.end(); ++it_product) -// { -// // ignore intermediaries in the MC record -// if (it_product->getType() <= 0) -// continue; -// -// int g3type = it_product->getType(); -// int pdgtype = it_product->getPdgtype(); -// G4ParticleDefinition *part; -// if (pdgtype > 0 && pdgtype < 999999) { -// part = fParticleTable->FindParticle(pdgtype); -// } -// else if (g3type > 0) { -// pdgtype = ConvertGeant3ToPdg(g3type); -// part = fParticleTable->FindParticle(pdgtype); -//#if FORCE_PARTICLE_TYPE_CHARGED_GEANTINO -// part = fParticleTable->FindParticle("chargedgeantino"); -//#endif -// } -// else { -// cerr << "Unknown particle found in input MC record, " -// << "geant3 type " << g3type -// << ", PDG type " << pdgtype -// << ", failing over to geantino!" -// << endl; -// part = fParticleTable->FindParticle("geantino"); -// } -// hddm_s::Momentum &momentum = it_product->getMomentum(); -// double px = momentum.getPx() * GeV; -// double py = momentum.getPy() * GeV; -// double pz = momentum.getPz() * GeV; -// double Etot = momentum.getE() * GeV; -// vertex->SetPrimary(new G4PrimaryParticle(part, px, py, pz, Etot)); -// ++Nprimaries; -// } -// anEvent->AddPrimaryVertex(vertex); -// } -// -// if (Nprimaries == 0) { -// cerr << "Number of primaries in event is zero!!" << endl; -// anEvent->SetEventAborted(); -// } -// -// // Superimpose any request background minimum-bias beam interactions -// -// if (fBeamBackgroundRate > 0) { -// double t = fBeamBackgroundGateStart; -// while (true) { -// t += -log(RAND.Rndm()) / fBeamBackgroundRate; -// if (t > fBeamBackgroundGateStop) -// break; -// GenerateBeamPhoton(anEvent, t); -// } -// } -//} -// -//void GlueXPrimaryGeneratorAction::GeneratePrimariesCobrems(G4Event* anEvent) -//{ -// GenerateBeamPhoton(anEvent, 0); -// ++fEventCount; -//} - -void GlueXPrimaryGeneratorAction::GenerateBeamPhoton(TVector3 &pgamma, TVector3 &pol) -{ - int Nenergy = 0; - for(Nenergy=0; Nenergy<500000; Nenergy++){ - // Generates a single beam photon according to the coherent bremsstrahlung - // model defined by class CobremsGenerator. The photon begins its lifetime - // just upstream of the primary collimator (WARNING: position is hard-wired - // in the code below) and is tracked by the simulation from there forward. - // Its time t0 should identify its beam bucket, ie. the time the photon - // would reach the midplane of the target. To enable beam motion spreading, - // define the beam box size below. - -#define BEAM_PHOTON_START_Z (-24 * m) -// #define BEAM_BOX_SIZE (5 * mm) - - // The algorithm below generates coherent bremsstrahlung photons using a - // importance-sampling technique. This algorithm requires that we prepare - // an approximate probability density function for the generated photons. - // The function is not in general equal to the true physical PDF, which - // varies from event to event depending on the direction of the incident - // electron, and also the exact angle of the crystal planes at the point - // of scattering which moves because of the mosaic spread of the crystal. - // The important thing is that the approximate PDF be reasonably close to - // the average over all beam particles and the crystal mosaic, and that - // deviations from event to event are sufficiently small that rejection - // sampling can be used to take them into account with high efficiency. - // - // The kinematics of bremsstrahlung are described by three independent - // variables (x, theta, phi) where x is the photon energy in units of the - // incident electron energy, and theta,phi are the polar,azimuthal angles - // of the photon in a lab frame tilted so that the incident electron comes - // in along the z axis. Polar angle theta is represented by dimensionless - // variable y = theta0^2 / (theta^2 + theta0^2) where contant theta0 is - // chosen to optimize the uniformity of the PDF in y. On each event, - // a new random tuple (x, phi, y) is generated on the interval x:[0,1], - // phi:[0,2pi], y:[0,1] using a split-and-recombine strategy. One side - // of the split covers the coherent process and the other side covers the - // incoherent one. - // - // 1) coherent process - the PDF here is continuous in x,phi according - // the dNc/(dx dphi), and the dependence on y is a sequence of delta - // functions corresponding to the different planes that contribute to - // the scattering at the given value of x. Here we take advantage of - // the fact that the marginal distribution dNc/dx is proportional to - // dNc/(dx dphi) at phi=pi/4. This allows us to decompose the generation - // into two stages, first generating x from dNc/dx and then generating - // phi from dNc/(dx dphi) at fixed x. The x generation step is performed - // using importance sampling based on the average PDF stored in table - // fCoherentPDF, followed by rejection sampling based on the value of - // dNc/(dx dphi) computed for the particular kinematics of each event. - // The y value is obtained by sampling the weighted list of q2 values - // that contributed the to q-sum in the calculation of dNc/(dx dphi). - // - // 2) incoherent process - the PDF here is continuous in x,phi,y but it - // is uniform in phi, so it is effectively a 2D distribution. Here we - // take advantage of the fact that x and y are independent variables - // to a good approximation, which allows us to generate x using - // importance sampling from an approximation to dNi/(dx dtheta^2) at - // theta=0 and y ~ uniform [0,1], then employ rejection sampling based - // on the exact PDF dNi/(dx dtheta2) to get a true sample. - // - // Recombination after the split is very simple. First we integrate over - // phi in both cases to obtain values dNc/dx and dNi/(dx dy). It turns - // out that in spite of the fact that the y-dependence is discrete in the - // coherent case and continuous in the incoherent case, the sum over the - // probabilities for all values of y in dNc/dx is always normalized to 1 - // independently for all values of x. Hence we can treat y as a psuedo - // coordinate y' ~ Unif[0,1] and form a 2D PDF dNc/(dx dy') which is - // numerically equal to dNc/dx, do the rejection sampling in combination - // with that applied to dNi/(dx dy) and then replace the fake variable y' - // with the true y that was sampled as described above. - - LAST_COBREMS_MECH = 0; - - double phiMosaic = twopi * RAND.Rndm(); - double rhoMosaic = sqrt(-2 * log(RAND.Rndm())); - rhoMosaic *= fCobremsGenerator->getTargetCrystalMosaicSpread() * m*radian; - double thxMosaic = rhoMosaic * cos(phiMosaic); - double thyMosaic = rhoMosaic * sin(phiMosaic); - - double xemittance = fCobremsGenerator->getBeamEmittance() * m; - double yemittance = xemittance / 2.5; // nominal, should be checked - double xspotsize = fCobremsGenerator->getCollimatorSpotrms() * m; - double yspotsize = xspotsize; // nominal, should be checked - double thxBeam = (xemittance / xspotsize) * sqrt(-2 * log(RAND.Rndm())); - double thyBeam = (yemittance / yspotsize) * sqrt(-2 * log(RAND.Rndm())); - - double raddz = fCobremsGenerator->getTargetThickness() * m; - double varMS = fCobremsGenerator->Sigma2MS(raddz * RAND.Rndm()); - double thxMS = sqrt(-2 * varMS * log(RAND.Rndm())); - double thyMS = sqrt(-2 * varMS * log(RAND.Rndm())); - - double targetThetax = fCobremsGenerator->getTargetThetax() * radian; - double targetThetay = fCobremsGenerator->getTargetThetay() * radian; - double targetThetaz = fCobremsGenerator->getTargetThetaz() * radian; - double thetax = thxBeam + thxMS - targetThetax - thxMosaic; - double thetay = thyBeam + thyMS - targetThetay - thyMosaic; - double thetaz = -targetThetaz; - fCobremsGenerator->resetTargetOrientation(); - fCobremsGenerator->RotateTarget(0, pi/2, 0); // point (1,0,0) along beam - fCobremsGenerator->RotateTarget(0, 0, pi/4); // point (0,1,1) vertically - fCobremsGenerator->RotateTarget(thetax, thetay, thetaz); - - // Generate with importance sampling - double x, phi, theta2=0; - double polarization = 0; - double Scoherent = fCoherentPDFx.Npassed / - (fCoherentPDFx.Psum / fCoherentPDFx.Npassed); - double Sincoherent = fIncoherentPDFlogx.Npassed / - (fIncoherentPDFlogx.Psum / fIncoherentPDFlogx.Npassed); - - // Allow user to force (in)coherent production - bool generate_coherent = ScoherentRate_dNcdxdp(x, pi / 4); - double Pfactor = dNcdx / dNcdxPDF; - if (Pfactor > fCoherentPDFx.Pmax) - fCoherentPDFx.Pmax = Pfactor; - if (Pfactor > fCoherentPDFx.Pcut) { - cout << "Warning in GenerateBeamPhoton - Pfactor " << Pfactor - << " exceeds fCoherentPDFx.Pcut = " << fCoherentPDFx.Pcut - << ", please increase." << endl; - } - if (RAND.Rndm() * fCoherentPDFx.Pcut > Pfactor) { - ++fCoherentPDFx.Nfailed; - continue; - } - fCoherentPDFx.Psum += Pfactor; - ++fCoherentPDFx.Npassed; - - double fmax = dNcdx / pi; - while (true) { - phi = twopi * RAND.Rndm(); - double f = fCobremsGenerator->Rate_dNcdxdp(x, phi); - if (RAND.Rndm() * fmax < f) - break; - } - double uq = RAND.Rndm(); - for (unsigned int i=0; i < fCobremsGenerator->fQ2theta2.size(); ++i) { - if (uq <= fCobremsGenerator->fQ2weight[i]) { - theta2 = fCobremsGenerator->fQ2theta2[i]; - break; - } - } - polarization = fCobremsGenerator->Polarization(x, theta2); - break; - } - LAST_COBREMS_MECH = 1; - } - else { - while (true) { // try incoherent generation - double dNidxdyPDF; - double u = RAND.Rndm(); - for (unsigned int i=1; i < fIncoherentPDFlogx.randvar.size(); ++i) { - if (u <= fIncoherentPDFlogx.integral[i]) { - double logx0 = fIncoherentPDFlogx.randvar[i - 1]; - double logx1 = fIncoherentPDFlogx.randvar[i]; - double f0 = fIncoherentPDFlogx.density[i - 1]; - double f1 = fIncoherentPDFlogx.density[i]; - double u0 = fIncoherentPDFlogx.integral[i - 1]; - double u1 = fIncoherentPDFlogx.integral[i]; - double logx = (logx0 * (u1 - u) + logx1 * (u - u0)) / (u1 - u0); - dNidxdyPDF = (f0 * (u1 - u) + f1 * (u - u0)) / (u1 - u0); - x = exp(logx); - break; - } - } - double y=0.0; - double uy = RAND.Rndm(); - for (unsigned int i=1; i < fIncoherentPDFy.randvar.size(); ++i) { - if (uy <= fIncoherentPDFy.integral[i]) { - double y0 = fIncoherentPDFy.randvar[i - 1]; - double y1 = fIncoherentPDFy.randvar[i]; - double f0 = fIncoherentPDFy.density[i - 1]; - double f1 = fIncoherentPDFy.density[i]; - double u0 = fIncoherentPDFy.integral[i - 1]; - double u1 = fIncoherentPDFy.integral[i]; - y = (y0 * (u1 - uy) + y1 * (uy - u0)) / (u1 - u0); - dNidxdyPDF *= (f0 * (u1 - uy) + f1 * (uy - u0)) / (u1 - u0); - break; - } - } - theta2 = fIncoherentPDFtheta02 * (1 / (y + 1e-99) - 1); - double dNidxdy = fCobremsGenerator->Rate_dNidxdt2(x, theta2) * - fIncoherentPDFtheta02 / (y*y + 1e-99); - double Pfactor = dNidxdy / dNidxdyPDF; - if (Pfactor > fIncoherentPDFlogx.Pmax) - fIncoherentPDFlogx.Pmax = Pfactor; - if (Pfactor > fIncoherentPDFlogx.Pcut) { - cout << "Warning in GenerateBeamPhoton - Pfactor " << Pfactor - << " exceeds fIncoherentPDFlogx.Pcut = " - << fIncoherentPDFlogx.Pcut << ", please increase." - << endl; - } - if (RAND.Rndm() * fIncoherentPDFlogx.Pcut > Pfactor) { - ++fIncoherentPDFlogx.Nfailed; - continue; - } - fIncoherentPDFlogx.Psum += Pfactor; - ++fIncoherentPDFlogx.Npassed; - - phi = twopi * RAND.Rndm(); - polarization = 0; - break; - } - LAST_COBREMS_MECH = 2; - } - - // Define the particle kinematics and polarization in lab coordinates -// G4ParticleDefinition *part = fParticleTable->FindParticle("gamma"); - double Emax = fCobremsGenerator->getBeamEnergy() * GeV; - double Erms = fCobremsGenerator->getBeamErms() * GeV; - double Ebeam = Emax + Erms * RAND.Gaus(); - double theta = sqrt(theta2) * electron_mass_c2 / Emax; - double alphax = thxBeam + thxMS + theta * cos(phi); - double alphay = thyBeam + thyMS + theta * sin(phi); - double pabs = Ebeam * x; - double px = pabs * alphax; - double py = pabs * alphay; - double pz = sqrt(pabs*pabs - px*px - py*py); - //cout << "Energy is " << pabs <<" Beam" << endl; - -// cout << "Energy is " << pabs <<" Beam" << endl; -// double colphi = twopi * RAND.Rndm(); -// double vspotrms = fCobremsGenerator->getCollimatorSpotrms() * m; -// double colrho = vspotrms * sqrt(-2 * log(RAND.Rndm())); -// double colDist = fCobremsGenerator->getCollimatorDistance() * m; -// double radx = colrho * cos(colphi) - colDist * thxBeam; -// double rady = colrho * sin(colphi) - colDist * thyBeam; -// double colx = radx + colDist * alphax; -// double coly = rady + colDist * alphay; -//#if defined BEAM_BOX_SIZE -// colx += BEAM_BOX_SIZE * (RAND.Rndm() - 0.5); -// coly += BEAM_BOX_SIZE * (RAND.Rndm() - 0.5); -//#endif -// TVector3 vtx(colx, coly, fBeamStartZ); -// TVector3 pol(0, polarization, -polarization * py / pz); - pgamma.SetXYZ(px, py, pz); - pol.SetXYZ(0, polarization, -polarization * py / pz); - - int limit_n = 400000; - if(Nenergy>limit_n){ - - cout << "Warning: Event generation looped more" << endl; - cout << "than " << limit_n << " times to generate particle" << endl; - cout << "in proper energy range of " << Emin << " GeV to "<< EnergyMax << " GeV"<< endl; - cout << "Consider expanding energy range or examining gen_2mu source code" << endl; - break; - } - - if(pabsSetPolarization(pol); -// vertex->SetPrimary(photon); -// anEvent->AddPrimaryVertex(vertex); - - // call hitTagger(vertex,vertex,plab,plab,0.,1,0,0) -} -// -//// Convert particle types from Geant3 types to PDG scheme -// -//int GlueXPrimaryGeneratorAction::ConvertGeant3ToPdg(int Geant3number) const -//{ -// // This method was imported from ROOT source file TDatabasePDG.cc -// -// switch(Geant3number) { -// -// case 1 : return 22; // photon -// case 25 : return -2112; // anti-neutron -// case 2 : return -11; // e+ -// case 26 : return -3122; // anti-Lambda -// case 3 : return 11; // e- -// case 27 : return -3222; // Sigma- -// case 4 : return 12; // e-neutrino (NB: flavour undefined by Geant) -// case 28 : return -3212; // Sigma0 -// case 5 : return -13; // mu+ -// case 29 : return -3112; // Sigma+ (PB)*/ -// case 6 : return 13; // mu- -// case 30 : return -3322; // Xi0 -// case 7 : return 111; // pi0 -// case 31 : return -3312; // Xi+ -// case 8 : return 211; // pi+ -// case 32 : return -3334; // Omega+ (PB) -// case 9 : return -211; // pi- -// case 33 : return -15; // tau+ -// case 10 : return 130; // K long -// case 34 : return 15; // tau- -// case 11 : return 321; // K+ -// case 35 : return 411; // D+ -// case 12 : return -321; // K- -// case 36 : return -411; // D- -// case 13 : return 2112; // n -// case 37 : return 421; // D0 -// case 14 : return 2212; // p -// case 38 : return -421; // D0 -// case 15 : return -2212; // anti-proton -// case 39 : return 431; // Ds+ -// case 16 : return 310; // K short -// case 40 : return -431; // anti Ds- -// case 17 : return 221; // eta -// case 41 : return 4122; // Lamba_c+ -// case 18 : return 3122; // Lambda -// case 42 : return 24; // W+ -// case 19 : return 3222; // Sigma+ -// case 43 : return -24; // W- -// case 20 : return 3212; // Sigma0 -// case 44 : return 23; // Z -// case 21 : return 3112; // Sigma- -// case 45 : return 0; // deuteron -// case 22 : return 3322; // Xi0 -// case 46 : return 0; // triton -// case 23 : return 3312; // Xi- -// case 47 : return 0; // alpha -// case 24 : return 3334; // Omega- (PB) -// case 48 : return 0; // G nu ? PDG ID 0 is undefined -// -// default : return 0; -// -// } -//} -// -//double GlueXPrimaryGeneratorAction::getBeamBucketPeriod(int runno) -//{ -// // Look up the beam bucket period for this run in ccdb -// // unless the user has already set the value by hand. -// -// if (runno > 0) { -// jana::JCalibration *jcalib = japp->GetJCalibration(runno); -// std::map result; -// std::string map_key("/PHOTON_BEAM/RF/rf_period"); -// if (jcalib->Get(map_key, result)) { -// cerr << "Error in GeneratePrimariesHDDM - " -// << "error fetching " << map_key << " from ccdb, " -// << "cannot continue." << endl; -// exit(-1); -// } -// else if (result.find("rf_period") != result.end()) { -// fBeamBucketPeriod = result["rf_period"] * ns; -// } -// else { -// cerr << "Error in GeneratePrimariesHDDM - " -// << "error finding value for " << map_key -// << " in ccdb, cannot continue." << endl; -// exit(-1); -// } -// } -// return fBeamBucketPeriod; -//} diff --git a/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.hh b/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.hh deleted file mode 100644 index 9dad9d40ba..0000000000 --- a/src/programs/Simulation/gen_2mu/GlueXPrimaryGeneratorAction.hh +++ /dev/null @@ -1,196 +0,0 @@ -// -// WARNING!!!! -// -// This file was taken from the HDGeant4 project and has been -// modified for use in this program. It may be out of sync with -// that and has definitely had some of its original funtionality -// disabled. You can compare this to the HDGeant4 version by looking -// for the HDGeant4 project on github.com. -// - -// -// GlueXPrimaryGeneratorAction class header -// -// author: richard.t.jones at uconn.edu -// version: may 12, 2012 -// -// In the context of the Geant4 event-level multithreading model, -// this class is "thread-local", ie. has thread-local state. -// Separate object instances are created for each worker thread, -// but virtually all of its functions need to be serialized, so -// it maintains its own interlocks for this purpose. Resources -// are created once when the first object is instantiated, and -// destroyed once when the last object is destroyed. - -#ifndef _GLUEXPRIMARYGENERATORACTION_H_ -#define _GLUEXPRIMARYGENERATORACTION_H_ - -//#include "G4Threading.hh" -//#include "G4AutoLock.hh" - -#include "CobremsGenerator.hh" -//#include "G4VUserPrimaryGeneratorAction.hh" -//#include "G4ParticleDefinition.hh" -//#include "GlueXParticleGun.hh" -//#include "G4SystemOfUnits.hh" -// -//#include "globals.hh" -// -//#include -// -//#include -// -//class G4Event; - -#include - -//class GlueXPrimaryGeneratorAction : public G4VUserPrimaryGeneratorAction -class GlueXPrimaryGeneratorAction -{ - public: - -// enum source_type_t { -// SOURCE_TYPE_NONE, -// SOURCE_TYPE_PARTICLE_GUN, -// SOURCE_TYPE_COBREMS_GEN, -// SOURCE_TYPE_HDDM -// }; - - GlueXPrimaryGeneratorAction(); -// GlueXPrimaryGeneratorAction(const GlueXPrimaryGeneratorAction &src); -// GlueXPrimaryGeneratorAction &operator=(const GlueXPrimaryGeneratorAction &src); - ~GlueXPrimaryGeneratorAction(); - -// virtual void GeneratePrimaries(G4Event* anEvent); -// void GeneratePrimariesHDDM(G4Event* anEvent); -// void GeneratePrimariesParticleGun(G4Event* anEvent); -// void GeneratePrimariesCobrems(G4Event* anEvent); -// void GenerateBeamPhoton(G4Event* anEvent, double t0); - void GenerateBeamPhoton(TVector3 &pgamma, TVector3 &pol); - -// int ConvertGeant3ToPdg(int Geant3number) const; - - private: -// static int instanceCount; -// static source_type_t fSourceType; -// static std::ifstream *fHDDMinfile; -// static hddm_s::istream *fHDDMistream; - static CobremsGenerator *fCobremsGenerator; -// static G4ParticleTable *fParticleTable; -// static GlueXParticleGun *fParticleGun; - - public: -// struct single_particle_gun_t { -// int geantType; -// int pdgType; -// G4ParticleDefinition *partDef; -// G4ThreeVector pos; -// double mom; -// double theta; -// double phi; -// double deltaR; -// double deltaZ; -// double deltaMom; -// double deltaTheta; -// double deltaPhi; -// }; - - private: -// static single_particle_gun_t fGunParticle; - - static double fBeamBucketPeriod; - static double fBeamBackgroundRate; - static double fBeamBackgroundGateStart; - static double fBeamBackgroundGateStop; - static double fL1triggerTimeSigma; - static double fBeamStartZ; - -// static int fEventCount; - - // The following parameters describe the dimensions of the target - // that are used when generating the primary interaction vertex for - // events from an external generator. An external event generator - // knows nothing about the simulation geometry, so it makes sense - // that this should be modeled in the simulation. They only apply - // to the HDDM input source. They are initialized to default values - // for the GlueX liquid hydrogen target in the constructor, but - // can be accessed/changed by the getter/setter methods below. - static double fTargetCenterZ; -// static double fTargetLength; -// static double fBeamDiameter; - - public: -// void setTargetCenterZ(double Z_cm) { -// fTargetCenterZ = Z_cm * cm; -// } -// void setTargetLength(double L_cm) { -// fTargetLength = L_cm * cm; -// } -// void setBeamDiameter(double D_cm) { -// fBeamDiameter = D_cm * cm; -// } -// double getTargetCenterZ() { -// return fTargetCenterZ / cm; -// } -// double getTargetLength() { -// return fTargetLength / cm; -// } -// double getBeamDiameter() { -// return fBeamDiameter / cm; -// } -// -// double getBeamBucketPeriod(int runno=0); -// -// int getEventCount() { -// return fEventCount; -// } -// -// void setBeamBucketPeriod(double period_ns) { -// fBeamBucketPeriod = period_ns * ns; -// } -// void setL1triggerTimeSigma(double sigma_ns) { -// fL1triggerTimeSigma = sigma_ns; -// } -// void setBeamStartZ(double Z_cm) { -// fBeamStartZ = Z_cm * cm; -// } -// double getL1triggerTimeSigma() { -// return fL1triggerTimeSigma; -// } -// double getBeamStartZcm() { -// return fBeamStartZ / cm; -// } - - // The following tables contain PDFs for importance-sampling the - // kinematic variables in coherent bremsstrahlung beam generation. - - struct ImportanceSampler { - std::vector randvar; - std::vector density; - std::vector integral; - double Psum; - double Pcut; - double Pmax; - int Nfailed; - int Npassed; - - ImportanceSampler() - : Psum(1.0), Pcut(1), Pmax(0), Nfailed(0), Npassed(1) {} -// : Psum(0), Pcut(1), Pmax(0), Nfailed(0), Npassed(0) {} - }; - - static ImportanceSampler fCoherentPDFx; - static ImportanceSampler fIncoherentPDFlogx; - static ImportanceSampler fIncoherentPDFy; - - private: - - static double fIncoherentPDFtheta02; - - void prepareCobremsImportanceSamplingPDFs(); - - private: -// static G4Mutex fMutex; -}; - -#endif diff --git a/src/programs/Simulation/gen_2mu/SConscript b/src/programs/Simulation/gen_2mu/SConscript deleted file mode 100644 index 605a540591..0000000000 --- a/src/programs/Simulation/gen_2mu/SConscript +++ /dev/null @@ -1,17 +0,0 @@ - -import os - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddHDDM(env) -sbms.AddROOT(env) - -#boost = os.getenv('BOOST_ROOT','/usr') -#env.AppendUnique(CPPPATH=['%s' % boost]) - -sbms.executable(env) - diff --git a/src/programs/Simulation/gen_2mu/expint_spline.cc b/src/programs/Simulation/gen_2mu/expint_spline.cc deleted file mode 100644 index df4b037f96..0000000000 --- a/src/programs/Simulation/gen_2mu/expint_spline.cc +++ /dev/null @@ -1,36 +0,0 @@ -#include -#include -static double zspline[] ={ -0.05, 0.15, 0.25, 0.35, 0.45, 0.55, 0.65, 0.75, -0.85, 0.95, 1.05, 1.15, 1.25, 1.35, 1.45, 1.55, -1.65, 1.75, 1.85, 1.95, 2.05, 2.15, 2.25, 2.35, -2.45, 2.55, 2.65, 2.75, 2.85, 2.95, 3.05, 3.15, -3.25, 3.35, 3.45, 3.55, 3.65, 3.75, 3.85, 3.95, -4.05, 4.15, 4.25, 4.35, 4.45, 4.55, 4.65, 4.75, -4.85, 4.95, 5.05, 5.15, 5.25, 5.35, 5.45, 5.55, -5.65, 5.75, 5.85, 5.95, 6.05, 6.15, 6.25, 6.35, -6.45, 6.55, 6.65, 6.75, 6.85, 6.95, 7.05, 7.15, -7.25, 7.35, 7.45, 7.55, 7.65, 7.75, 7.85, 7.95, -8.05, 8.15, 8.25, 8.35, 8.45, 8.55, 8.65, 8.75, -8.85, 8.95, 9.05, 9.15, 9.25, 9.35, 9.45, 9.55, -9.65, 9.75, 9.85, 9.95, 0}; -static double yspline[] ={ -2.4679, 1.46446, 1.04428, 0.794215, 0.625331, 0.503364, 0.411517, 0.340341, -0.284019, 0.238738, 0.201873, 0.171555, 0.146413, 0.125417, 0.107777, 0.0928821, -0.0802476, 0.0694887, 0.060295, 0.0524144, 0.0456406, 0.0398035, 0.0347621, 0.0303989, -0.0266156, 0.0233293, 0.0204701, 0.0179789, 0.0158054, 0.0139065, 0.0122456, 0.0107913, -0.00951651, 0.008398, 0.00741571, 0.00655231, 0.00579278, 0.0051241, 0.00453499, 0.00401561, -0.00355741, 0.00315293, 0.00279565, 0.0024799, 0.00220069, 0.00195366, 0.001735, 0.00154136, -0.0013698, 0.00121774, 0.0010829, 0.000963279, 0.000857127, 0.000762889, 0.000679199, 0.000604849, -0.000538777, 0.000480041, 0.000427812, 0.000381353, 0.000340017, 0.000303227, 0.000270476, 0.000241312, -0.000215335, 0.000192192, 0.000171569, 0.000153187, 0.000136799, 0.000122185, 0.000109151, 9.75232e-05, -8.71483e-05, 7.78893e-05, 6.96246e-05, 6.22462e-05, 5.56577e-05, 4.97737e-05, 4.45178e-05, 3.98224e-05, -3.56268e-05, 3.18775e-05, 2.85262e-05, 2.55305e-05, 2.28521e-05, 2.04571e-05, 1.83152e-05, 1.63994e-05, -1.46856e-05, 1.31524e-05, 1.17804e-05, 1.05527e-05, 9.45388e-06, 8.47032e-06, 7.58982e-06, 6.8015e-06, -6.09563e-06, 5.46352e-06, 4.8974e-06, 4.39033e-06, 0}; -double expint_map(double z){ - static TSpline3 *sp = NULL; - if(!sp) sp = new TSpline3("sp", zspline, yspline, 100); - if(z<10) return sp->Eval(z); - return std::exp( (-2.17624) + (-1.02753)*z ); -} diff --git a/src/programs/Simulation/gen_2mu/gen_2mu.cc b/src/programs/Simulation/gen_2mu/gen_2mu.cc deleted file mode 100644 index 7278f3c7c8..0000000000 --- a/src/programs/Simulation/gen_2mu/gen_2mu.cc +++ /dev/null @@ -1,816 +0,0 @@ - -#include - -#include -#include -#include -#include -#include -using namespace std; - -#include - -#include "particleType.h" - -#include -#include -#include -#include -#include - -#include "GlueXPrimaryGeneratorAction.hh" - -string OUTPUT_FILENAME = "gen_2mu.hddm"; -int32_t RUN_NUMBER = 2; -uint32_t MAXEVENTS = 10000; -double Z = 82.0; // atomic number of target -double A = 208.0; // atomic weight of target -bool HDDM_USE_COMPRESSION = false; -bool HDDM_USE_INTEGRITY_CHECKS = false; -bool USE_ELECTRON_BEAM_DIRECTION = false; -double POLARIZATION_ANGLE = 0.0; // in degrees relative to x-axis -bool ROOT_DEBUG_FILE = false; - -TRandom *RAND = NULL; - -TFile *rootfile = NULL; -TH1D *expint_z = NULL; - -double Ecoherent_peak = 6.0; -double Eelectron_beam = 12.0; -double Emin = 1.0; -double EnergyMax = 6.5; -double Efixed = 0.0; -double CollimatorDiameter = 0.0034; // in meters -double TMin = 5; // minimum theta angle, in degrees -double TMax = 87; // maximum theta angle, in degrees -double Ntheta =0; -bool ONLY_COHERENT = false; -bool ONLY_INCOHERENT = false; -Particle_t PlusType = MuonPlus; -Particle_t MinusType = MuonMinus; - -static ofstream *OFS = NULL; -static hddm_s::ostream *FOUT = NULL; - -extern void GetMech(int &Ncoherent, int &Nincoherent); -extern int LAST_COBREMS_MECH; - -void GenerateMuPair(TVector3 &pgamma, TVector3 &pol, TLorentzVector &pmuplus, TLorentzVector &pmuminus); -void AddEventToHDDM(TVector3 &pgamma, TLorentzVector &pmuplus, TLorentzVector &pmuminus); -void Usage(string message=""); -void ParseCommandLineArguments(int narg, char *argv[]); - -#ifndef _DBG_ -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ cout<<__FILE__<<":"<<__LINE__<is_open()){ - try{ - FOUT = new hddm_s::ostream(*OFS); - }catch(exception &e){ - cout << e.what() << endl; - } - } - if( !FOUT ){ - cout << " Error opening output file \"" << OUTPUT_FILENAME << "\"!" << endl; - exit(-1); - } - } - - cout << "Opened output file: " << OUTPUT_FILENAME << " 0x" << FOUT << ")" << endl; - - // enable on-the-fly bzip2 compression on output stream - if (HDDM_USE_COMPRESSION == 0) { - cout << " HDDM compression disabled" << endl; - } else if (HDDM_USE_COMPRESSION == 1) { - cout << " Enabling bz2 compression of output HDDM file stream" << endl; - FOUT->setCompression(hddm_s::k_bz2_compression); - } else { - cout << " Enabling z compression of output HDDM file stream (default)" << endl; - FOUT->setCompression(hddm_s::k_z_compression); - } - - // enable a CRC data integrity check at the end of each event record - if (HDDM_USE_INTEGRITY_CHECKS) { - cout << " Enabling CRC data integrity check in output HDDM file stream (default)" << endl; - FOUT->setIntegrityChecks(hddm_s::k_crc32_integrity); - } else { - cout << " HDDM integrity checks disabled" << endl; - } - - // Start event processing - cout << "Event generation starting ..." << endl; - uint32_t Nevents_generated = 0; - for(Nevents_generated=0; Nevents_generatedGenerateBeamPhoton(pgamma, pol); - } - - // Generate mu+mu- pair - TLorentzVector pmuplus, pmuminus; - GenerateMuPair(pgamma, pol, pmuplus, pmuminus); - - // Write event to file - AddEventToHDDM(pgamma, pmuplus, pmuminus); - - // Update ticker so user knows we're working - if(Nevents_generated%100 == 0){ - cout << " " << Nevents_generated << " events generated \r"; - cout. flush(); - } - - } - - // Delete objects (closing output file) - if(photon_generator) delete photon_generator; - if(RAND) delete RAND; - if( FOUT && Nevents_generated>0) { // (program crashes if we close without writing any events!) - cout << "Closing file: " << OUTPUT_FILENAME << " (wrote " << Nevents_generated << " events)" << endl; - if(FOUT) delete FOUT; - if(OFS) delete OFS; - FOUT = NULL; - OFS = NULL; - } - - if(rootfile){ - rootfile->Write(); - delete rootfile; - rootfile = NULL; - } - - int Ncoherent=0, Nincoherent=0; - GetMech(Ncoherent, Nincoherent); - cout << " Ncoherent = " << Ncoherent << endl; - cout << "Nincoherent = " << Nincoherent << endl; - cout << Nevents_generated << " events generated Total." << endl; - - return 0; -} - -//----------------------- -// Usage -//----------------------- -void Usage(string message) -{ - cout << endl; - cout << "Usage:" << endl; - cout << " gen_2mu [options]" << endl; - cout << endl; - cout << " -h print this help message" << endl; - //cout << " --help print the long form help message" << endl; - cout << " -N events number of events to generate" << endl; - cout << " -o filename set output filename (def. is gen_2mu.hddm)" << endl; - cout << " -T target set target by name (Pb208, Sn116, C12, H)" << endl; - cout << " -A A set target A (def. " << A << ")" << endl; - cout << " -Z Z set target Z (def. " << Z << ")" << endl; - cout << " -p Epeak coherent peak energy (def="<GetKineticEnergy(); -// if (Egam <= LowestEnergyLimit) { -// return G4VDiscreteProcess::PostStepDoIt(aTrack,aStep); -// } -// G4ParticleMomentum GammaDirection = aDynamicGamma->GetMomentumDirection(); - - double Mmuon = 0.1056583715; - if(PlusType == PiPlus) Mmuon = 0.139570; - double electron_mass_c2 = 0.000511; - double sqrte = 1.648721270700128; - double pi = 3.141592653589793; - double Ntheta =0; - - for(Ntheta=0; Ntheta<500000; Ntheta++){ - - - TVector3 GammaDirection(pgamma); - GammaDirection.SetMag(1.0); - double Egam = pgamma.Mag(); - -// // select randomly one element constituting the material -// const G4Element* anElement = SelectRandomAtom(aDynamicGamma, aMaterial); -// int Z = G4lrint(anElement->GetZ()); -// G4NistManager* nist = G4NistManager::Instance(); - - double B,Dn; -// double A027 = nist->GetA27(Z); - double A027 = pow(A, 0.27); - - if(Z==1) // special case of Hydrogen - { B=202.4; - Dn=1.49; - } - else - { B=183.; - Dn=1.54*A027; - } -// double Zthird=1./nist->GetZ13(Z); // Z**(-1/3) - double Zthird=pow(Z, -1.0/3.0); // Z**(-1/3) - double Winfty=B*Zthird*Mmuon/(Dn*electron_mass_c2); - double C1Num=0.35*A027; - double C1Num2=C1Num*C1Num; - double C2Term2=electron_mass_c2/(183.*Zthird*Mmuon); - - double GammaMuonInv=Mmuon/Egam; - double sqrtx=sqrt(.25-GammaMuonInv); - double xmax=.5+sqrtx; - double xmin=.5-sqrtx; - - // generate xPlus according to the differential cross section by rejection - double Ds2=(Dn*sqrte-2.); - double sBZ=sqrte*B*Zthird/electron_mass_c2; - double LogWmaxInv=1./log(Winfty*(1.+2.*Ds2*GammaMuonInv) - /(1.+2.*sBZ*Mmuon*GammaMuonInv)); - double xPlus,xMinus,xPM,result,W; - int nn = 0; - const int nmax = 1000; - do - { xPlus=xmin+RAND->Rndm()*(xmax-xmin); - xMinus=1.-xPlus; - xPM=xPlus*xMinus; - double del=Mmuon*Mmuon/(2.*Egam*xPM); - W=Winfty*(1.+Ds2*del/Mmuon)/(1.+sBZ*del); - if(W<=1. || nn > nmax) { break; } // to avoid negative cross section at xmin - double xxp=1.-4./3.*xPM; // the main xPlus dependence - result=xxp*log(W)*LogWmaxInv; - if(result>1.) { - cout << "G4GammaConversionToMuons::PostStepDoIt WARNING:" - << " in dSigxPlusGen, result=" << result << " > 1" << endl; - } - ++nn; - if(nn >= nmax) { break; } - } - // Loop checking, 07-Aug-2015, Vladimir Ivanchenko - while (RAND->Rndm() > result); - - // now generate the angular variables via the auxilary variables t,psi,rho - double t; - double psi; - double rho; - - double thetaPlus,thetaMinus,phiHalf; // final angular variables - nn = 0; - do // t, psi, rho generation start (while angle < pi) - { - //generate t by the rejection method - double C1=C1Num2* GammaMuonInv/xPM; - double f1_max=(1.-xPM) / (1.+C1); - double f1; // the probability density - do - { - ++nn; - t=RAND->Rndm(); - f1=(1.-2.*xPM+4.*xPM*t*(1.-t)) / (1.+C1/(t*t)); - if(f1<0 || f1> f1_max) // should never happend - { - cout << "G4GammaConversionToMuons::PostStepDoIt WARNING:" - << "outside allowed range f1=" << f1 << " is set to zero" - << endl; - f1 = 0.0; - } - if(nn > nmax) { break; } - } - // Loop checking, 07-Aug-2015, Vladimir Ivanchenko - while ( RAND->Rndm()*f1_max > f1); - // generate psi by the rejection method - double f2_max=1.-2.*xPM*(1.-4.*t*(1.-t)); - - // long version - double f2; - do - { - ++nn; - psi=2.*pi*RAND->Rndm(); - f2=1.-2.*xPM+4.*xPM*t*(1.-t)*(1.+cos(2.*psi)); - if(f2<0 || f2> f2_max) // should never happend - { - cout << "G4GammaConversionToMuons::PostStepDoIt WARNING:" - << "outside allowed range f2=" << f2 << " is set to zero" - << endl; - f2 = 0.0; - } - if(nn >= nmax) { break; } - } - // Loop checking, 07-Aug-2015, Vladimir Ivanchenko - while ( RAND->Rndm()*f2_max > f2); - - // generate rho by direct transformation - double C2Term1=GammaMuonInv/(2.*xPM*t); - double C2=4./sqrt(xPM)*pow(C2Term1*C2Term1+C2Term2*C2Term2,2.); - double rhomax=1.9/A027*(1./t-1.); - double beta=log( (C2+rhomax*rhomax*rhomax*rhomax)/C2 ); - rho=exp(log(C2 *( exp(beta*RAND->Rndm())-1. ))*0.25); - - //now get from t and psi the kinematical variables - double u=sqrt(1./t-1.); - double xiHalf=0.5*rho*cos(psi); - phiHalf=0.5*rho/u*sin(psi); - - thetaPlus =GammaMuonInv*(u+xiHalf)/xPlus; - thetaMinus=GammaMuonInv*(u-xiHalf)/xMinus; - - - // protection against infinite loop - if(nn > nmax) { - if(std::abs(thetaPlus)>pi) { thetaPlus = 0.0; } - if(std::abs(thetaMinus)>pi) { thetaMinus = 0.0; } - } - - - - - - // Loop checking, 07-Aug-2015, Vladimir Ivanchenko - } while ( std::abs(thetaPlus)>pi || std::abs(thetaMinus) >pi); - - // now construct the vectors - // azimuthal symmetry, take phi0 at random between 0 and 2 pi - double phi0=2.*pi*RAND->Rndm(); - double EPlus=xPlus*Egam; - double EMinus=xMinus*Egam; - - - // ---------------------------------------------------- - - // mu+ mu- directions for gamma in z-direction - TVector3 MuPlusDirection ( sin(thetaPlus) *cos(phi0+phiHalf), - sin(thetaPlus) *sin(phi0+phiHalf), cos(thetaPlus) ); - TVector3 MuMinusDirection (-sin(thetaMinus)*cos(phi0-phiHalf), - -sin(thetaMinus) *sin(phi0-phiHalf), cos(thetaMinus) ); - - double Pplus = sqrt(EPlus*EPlus - Mmuon*Mmuon); - double Pminus = sqrt(EMinus*EMinus - Mmuon*Mmuon); - - pmuplus.SetVectM(Pplus*MuPlusDirection, Mmuon); - pmuminus.SetVectM(Pminus*MuMinusDirection, Mmuon); - - //-- Add phi dependence on photon polarization -- - // - // The polarization causes an azimuthal dependence of the mu+mu- - // system about the incident photon direction relative to the - // polarization vector that goes like: - // - // 1 + cos(2phi) - // - // see https://halldweb1.jlab.org/wiki/images/a/aa/20130418_cpp_rory.pdf - // - // To do this, we take the current phi angle of the mu+mu- system and assume - // it is evenly distributed over 0-2pi. We normalize this to get a number from - // 0-1 and equate it with the normalized integral of the above function of phi. - // (The integral fraction method). This results in a transcendental equation - // though so we use the ROOT TF1::GetX() method to find the root of a function - // defined as the difference between the "random number" and the normalized - // integral. - // - // f(phi) = s - (phi + 0.5*sin(2*phi))/2pi - // - // where: - // s = normalized phi from unpolarized (0 - 1) - // phi = azimuthal angle of mu+mu- relative to polarization direction - // pi = 3.14159...... - // - - if(LAST_COBREMS_MECH == 1){ // Only do this for coherently produced photons - static TF1 *normInt = NULL; - if(!normInt){ - // par0 is random number "s" - // 0.1591549430919 = 1/2pi - normInt = new TF1("normInt", "[0] - (x + 0.5*sin(2.0*x))*0.1591549430919", 0.0, TMath::TwoPi()); - } - - // direction of mu+mu- system - TVector3 vmumu = (pmuplus+pmuminus).Vect(); - double phi_init = vmumu.Phi(); - double s = 0.5+phi_init/TMath::TwoPi(); // s is 0-1 - normInt->SetParameter(0, s); - double deltaphi = normInt->GetX(0.0, 0.0, TMath::TwoPi()) - phi_init; - deltaphi += POLARIZATION_ANGLE*TMath::DegToRad(); - pmuplus.RotateZ(deltaphi); - pmuminus.RotateZ(deltaphi); - } - - // Rotate to actual gamma direction. - // The pmuplus and pmuminus vectors are currently relative to the - // beam photon direction. This is almost always what you want. - // This gives the option though of rotating to the direction where - // z is defined by the electron beam. For coherently produced photons, - // this option introduces an effective phi shift in the phi_mumu - // distribution since the gamma direction is concentrated in one - // region of phi (roughly 35 degrees) - if(USE_ELECTRON_BEAM_DIRECTION){ - pmuplus.RotateUz(GammaDirection); - pmuminus.RotateUz(GammaDirection); - } - -// aParticleChange.SetNumberOfSecondaries(2); -// // create G4DynamicParticle object for the particle1 -// G4DynamicParticle* aParticle1= new G4DynamicParticle( -// G4MuonPlus::MuonPlus(),MuPlusDirection,EPlus-Mmuon); -// aParticleChange.AddSecondary(aParticle1); -// // create G4DynamicParticle object for the particle2 -// G4DynamicParticle* aParticle2= new G4DynamicParticle( -// G4MuonMinus::MuonMinus(),MuMinusDirection,EMinus-Mmuon); -// aParticleChange.AddSecondary(aParticle2); -// // -// // Kill the incident photon -// // -// aParticleChange.ProposeMomentumDirection( 0., 0., 0. ) ; -// aParticleChange.ProposeEnergy( 0. ) ; -// aParticleChange.ProposeTrackStatus( fStopAndKill ) ; -// // Reset NbOfInteractionLengthLeft and return aParticleChange -// return G4VDiscreteProcess::PostStepDoIt( aTrack, aStep ); - - - //Following is for setting angular cuts on events - double RMax=TMax*pi/180; - double RMin=TMin*pi/180; - double looplimit = 200000; // User can set this limit to whatever seems reasonable - - if(thetaPlusRMin && thetaMinusRMin){ - - // The below 3 lines were used for debugging only - //cout << "Number of steps for theta " << Ntheta << endl; - //cout << "Value of thetaplus " << thetaPlus*180/pi << endl; - //cout << "Value of thetaminus " << thetaMinus*180/pi << endl; - - if(Ntheta>looplimit){ - cout << "Warning: took more than " << looplimit <<" loops to" << endl; - cout << "generate proper theta angle. Check angle limits" << endl; - } - - break; - } - } - - -} - -//----------------------- -// AddEventToHDDM -//----------------------- -void AddEventToHDDM(TVector3 &pgamma, TLorentzVector &pmuplus, TLorentzVector &pmuminus) -{ - using namespace hddm_s; - static uint32_t event_number = 0; - int mech = LAST_COBREMS_MECH; // 0=unknown, 1=coherent, 2=incoherent - - HDDM *hddmevent = new HDDM; - hddmevent->addPhysicsEvents(1); - PhysicsEvent &PE = hddmevent->getPhysicsEvent(); - PE.setRunNo( RUN_NUMBER ); - PE.setEventNo( ++event_number ); - - ReactionList reactions = PE.addReactions(); - VertexList vertices = reactions().addVertices(); - - // Add Beam - BeamList beam = reactions().addBeams(); - beam().setType(Gamma); - MomentumList momenta = beam().addMomenta(); - momenta().setE( pgamma.Mag() ); - //cout << "Energy is " << setE <<" Beam" << endl; - momenta().setPx( pgamma.x() ); - momenta().setPy( pgamma.y() ); - momenta().setPz( pgamma.z() ); - PropertiesList properties = beam().addPropertiesList(); - properties().setCharge( 0 ); - properties().setMass( 0 ); - - // Add Origin - TVector3 pos(0.0, 0.0, 1.0); - OriginList origins = vertices().addOrigins(); - origins().setT(0.0); - origins().setVx(pos.x()); - origins().setVy(pos.y()); - origins().setVz(pos.z()); - - // Add Products (particles) - ProductList products = vertices().addProducts(2); - ProductList::iterator it_product = products.begin(); - - // Product Mu+ - Particle_t geanttype = PlusType; - TVector3 mom = pmuplus.Vect(); // convert back to units of GeV - double mass = ParticleMass(geanttype); - it_product->setDecayVertex(0); - it_product->setId(1); - it_product->setMech(mech); - it_product->setParentid(0); - it_product->setType(geanttype); - it_product->setPdgtype(PDGtype(geanttype)); - - // Momentum Mu+ - momenta = it_product->addMomenta(); - momenta().setE( sqrt(mom.Mag2() + mass*mass) ); - //cout << "Energy is " << setE <<" Mu Plus" << endl; - momenta().setPx( mom.x() ); - momenta().setPy( mom.y() ); - momenta().setPz( mom.z() ); - - // Properties Mu+ - properties = it_product->addPropertiesList(); - properties().setCharge( ParticleCharge(geanttype) ); - properties().setMass( mass ); - - - it_product++; - - - // Product Mu- - geanttype = MinusType; - mom = pmuminus.Vect(); // convert back to units of GeV - mass = ParticleMass(geanttype); - it_product->setDecayVertex(0); - it_product->setId(2); - it_product->setMech(mech); - it_product->setParentid(0); - it_product->setType(geanttype); - it_product->setPdgtype(PDGtype(geanttype)); - - // Momentum Mu- - momenta = it_product->addMomenta(); - momenta().setE( sqrt(mom.Mag2() + mass*mass) ); - //cout << "Energy is " << setE <<" Mu minus" << endl; - momenta().setPx( mom.x() ); - momenta().setPy( mom.y() ); - momenta().setPz( mom.z() ); - - // Properties Mu- - properties = it_product->addPropertiesList(); - properties().setCharge( ParticleCharge(geanttype) ); - properties().setMass( mass ); - - (*FOUT) << (*hddmevent); - - delete hddmevent; -} - diff --git a/src/programs/Simulation/gen_2pi/SConscript b/src/programs/Simulation/gen_2pi/SConscript deleted file mode 100644 index 25c0cf7bc0..0000000000 --- a/src/programs/Simulation/gen_2pi/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_2pi/gen_2pi.cc b/src/programs/Simulation/gen_2pi/gen_2pi.cc deleted file mode 100644 index a9314afd33..0000000000 --- a/src/programs/Simulation/gen_2pi/gen_2pi.cc +++ /dev/null @@ -1,310 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/TwoPiAngles.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.2; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 0.139*2; - double beamHighE = 12.0; - - int runNum = 9001; - int seed = 0; - - double slope = 6.0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-t"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else slope = atof( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -t \t Momentum transfer slope [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_2pi -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - gRandom->SetSeed(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( TwoPiAngles() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass -- the daughters are two charged pions - GammaPToXYP resProd( lowMass, highMass, 0.140, 0.140, beamMaxE, beamPeakE, beamLowE, beamHighE, type, slope ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 0.775, 0.146, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( PiPlus ); - pTypes.push_back( PiMinus ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_2pi_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos#theta vs. #psi", 180, -3.14, 3.14, 100, -1, 1); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - double cosTheta = angles.CosTheta(); - double phi = angles.Phi(); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - double Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - CosTheta_psi->Fill( psi, cosTheta); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - intenW->Write(); - intenWVsM->Write(); - CosTheta_psi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_2pi/gen_2pi.cfg b/src/programs/Simulation/gen_2pi/gen_2pi.cfg deleted file mode 100644 index fdac657c46..0000000000 --- a/src/programs/Simulation/gen_2pi/gen_2pi.cfg +++ /dev/null @@ -1,53 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit twopi - -reaction Pi+Pi- gamma Pi+ Pi- p - -# consider just x polarized amplitudes -sum Pi+Pi- xpol - -# Currently not using any input parameters for TwoPiAngles in the generator -amplitude Pi+Pi-::xpol::rhoS TwoPiAngles 0.0 0.0 0.0 0.0 0.0 0.0 0.5 0.0 -0.5 -amplitude Pi+Pi-::xpol::rhoS BreitWigner 0.775 0.146 1 2 3 - -initialize Pi+Pi-::xpol::rhoS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_2pi_amp/README b/src/programs/Simulation/gen_2pi_amp/README deleted file mode 100644 index cf6155bf77..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/README +++ /dev/null @@ -1,24 +0,0 @@ -# Here is the sequence of instructions to generate, fit and view generated distributions - -gen_2pi_amp> gen_2pi_amp -c gen_2pi_amp.cfg -o tree_AmpToolsFormatThrown.root -hd HDDMFormatThrown.hddm -a 8.4 -b 9.0 -n 100000 -r 30000 -gen_2pi_amp> mv tree_AmpToolsFormatThrown.root tree_gen_2pi_amp.root -gen_2pi_amp> gen_2pi_amp -c gen_2pi_amp_flat.cfg -o tree_AmpToolsFormatThrown_flat.root -hd HDDMFormatThrown_flat.hddm -a 8.4 -b 9.0 -n 100000 -r 30000 -gen_2pi_amp> mv tree_AmpToolsFormatThrown_flat.root tree_gen_2pi_amp_flat.root -gen_2pi_amp> fit -c fit_2pi_amp.cfg -gen_2pi_amp> cp twopi_amp.fit twopi_amp_fitPars.fit -gen_2pi_amp> twopi_plotter_amp twopi_amp_fitPars.fit -o twopi_amp_fitPars.root -gen_2pi_amp> mv twopi_fitPars.txt twopi_amp_fitPars.fit2 -gen_2pi_amp> root -l -root [0] .x twopi_amp.C - -# Here are instructions for processing MC smeared output files / or data - -gen_2pi_amp> hd_root -PPLUGINS=monitoring_hists,p2pi_trees -PNTHREADS=12 ../hddm/dana_rest_gen_2pi_amp_pulls3_030000_00*.hddm -o hd_root_gen_2pi_amp_pulls3_030000.root -gen_2pi_amp> mv tree_p2pi_trees.root tree_hd_root_gen_2pi_amp_pulls3_030000.root -gen_2pi_amp> root -l -b tree_hd_root_gen_2pi_amp_pulls3_030000.root -root [0] .x $ROOT_ANALYSIS_HOME/scripts/Load_DSelector.C -root [0] p2pi_trees_Tree->Process("DSelector_p2pi_trees.C+"); - -gen_2pi_amp> root -l -root [0].x plot_p2pi_trees.C - diff --git a/src/programs/Simulation/gen_2pi_amp/SConscript b/src/programs/Simulation/gen_2pi_amp/SConscript deleted file mode 100644 index 25c0cf7bc0..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_2pi_amp/fit_2pi_amp.cfg b/src/programs/Simulation/gen_2pi_amp/fit_2pi_amp.cfg deleted file mode 100644 index 2f6ea7485b..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/fit_2pi_amp.cfg +++ /dev/null @@ -1,212 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -fit twopi_amp - -reaction Pi+Pi- gamma Pi+ Pi- p - -normintfile Pi+Pi- twopi_amp_ni.txt - -# sum for helicity of N'=+1/2. Amplitudes should be duplicated for N'=-1/2. -sum Pi+Pi- helplusN+ -sum Pi+Pi- helnegN+ -sum Pi+Pi- helplusN- -sum Pi+Pi- helnegN- - -# genmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# accmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# data Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_amp.root - -genmc Pi+Pi- ROOTDataReader tree_gen_2pi_amp_flat.root -accmc Pi+Pi- ROOTDataReader tree_gen_2pi_amp_flat.root -data Pi+Pi- ROOTDataReader tree_gen_2pi_amp.root - -# amplitude Pi+Pi-::helplusN+::rho1 TwoPiAngles_amp (phipol, pol fraction, Jz for rho M=+/-1 and 0, prefix factor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# Prefix factor 0: 0.5*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 1: 0.5*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 2: 0.5*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 3: -0.5*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 4: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 5: 0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 6: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# Prefix factor 7: -0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# flat=1 generates distribution uniform in angles. flat=0 use YLMs - -amplitude Pi+Pi-::helplusN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 0 flat -# amplitude Pi+Pi-::helplusN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 0 flat -# amplitude Pi+Pi-::helplusN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 0 flat -# amplitude Pi+Pi-::helplusN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 2 flat -# amplitude Pi+Pi-::helplusN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 2 flat -# amplitude Pi+Pi-::helplusN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 2 flat -# amplitude Pi+Pi-::helplusN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 1 flat -# amplitude Pi+Pi-::helnegN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 1 flat -# amplitude Pi+Pi-::helnegN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 1 flat -# amplitude Pi+Pi-::helnegN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 3 flat -# amplitude Pi+Pi-::helnegN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 3 flat -# amplitude Pi+Pi-::helnegN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 3 flat -# amplitude Pi+Pi-::helnegN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helplusN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 4 flat -# amplitude Pi+Pi-::helplusN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 4 flat -# amplitude Pi+Pi-::helplusN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 4 flat -# amplitude Pi+Pi-::helplusN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 6 flat -# amplitude Pi+Pi-::helplusN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 6 flat -# amplitude Pi+Pi-::helplusN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 6 flat -# amplitude Pi+Pi-::helplusN-::g1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 5 flat -# amplitude Pi+Pi-::helnegN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 5 flat -# amplitude Pi+Pi-::helnegN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 5 flat -# amplitude Pi+Pi-::helnegN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 7 flat -# amplitude Pi+Pi-::helnegN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 7 flat -# amplitude Pi+Pi-::helnegN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 7 flat -# amplitude Pi+Pi-::helnegN-::g1VM-1 BreitWigner rho 1 2 3 - - -initialize Pi+Pi-::helplusN+::g1VM1 cartesian 500.0 0.0 real -initialize Pi+Pi-::helplusN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN+::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helplusN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM-1 cartesian 500.0 0.0 - -constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN+::g1VM1 -constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN+::g1VM0 -constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN+::g1VM-1 -constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN+::g-1VM1 -constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN+::g-1VM0 -constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN+::g-1VM-1 - -constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helplusN-::g1VM1 -constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helplusN-::g1VM0 -constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helplusN-::g1VM-1 -constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helplusN-::g-1VM1 -constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helplusN-::g-1VM0 -constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helplusN-::g-1VM-1 - -constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN-::g1VM1 -constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN-::g1VM0 -constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN-::g1VM-1 -constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN-::g-1VM1 -constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN-::g-1VM0 -constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN-::g-1VM-1 - - - diff --git a/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cc b/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cc deleted file mode 100644 index 19aab48333..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cc +++ /dev/null @@ -1,329 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/TwoPiAngles_amp.h" -#include "AMPTOOLS_AMPS/TwoPSHelicity.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.2; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 0.139*2; - double beamHighE = 12.0; - - int runNum = 9001; - int seed = 0; - - double slope = 6.0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-t"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else slope = atof( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -t \t Momentum transfer slope [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_2pi -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - TRandom3* gRandom = new TRandom3(); - gRandom->SetSeed(seed); - cout << "TRandom3 Seed : " << gRandom->GetSeed() << endl; - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( TwoPiAngles_amp() ); - AmpToolsInterface::registerAmplitude( TwoPSHelicity() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass -- the daughters are two charged pions - GammaPToXYP resProd( lowMass, highMass, ParticleMass(PiPlus), ParticleMass(PiMinus), beamMaxE, beamPeakE, beamLowE, beamHighE, type, slope, seed ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 0.775, 0.146, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( PiPlus ); - pTypes.push_back( PiMinus ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum, seed); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_2pi_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH1F* t = new TH1F( "t", "-t Distribution", 200, 0, 2 ); - - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos#theta vs. #psi", 180, -3.14, 3.14, 100, -1, 1); - TH2F* M_CosTheta = new TH2F( "M_CosTheta", "M vs. cos#vartheta", 180, lowMass, highMass, 200, -1, 1); - TH2F* M_Phi = new TH2F( "M_Phi", "M vs. #varphi", 180, lowMass, highMass, 200, -3.14, 3.14); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - // cout << " i=" << i << " intensity_i=" << weightedInten << endl; - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - TLorentzVector target(0,0,0,recoil[3]); - - t->Fill(-1*(evt->particle(1)-target).M2()); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - double cosTheta = angles.CosTheta(); - double phi = angles.Phi(); - - M_CosTheta->Fill( resonance.M(), cosTheta); - M_Phi->Fill( resonance.M(), phi); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - double Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - CosTheta_psi->Fill( psi, cosTheta); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - if(eventCounter >= nEvents) break; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - intenW->Write(); - intenWVsM->Write(); - t->Write(); - CosTheta_psi->Write(); - M_CosTheta->Write(); - M_Phi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cfg b/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cfg deleted file mode 100644 index f1f2c1147d..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/gen_2pi_amp.cfg +++ /dev/null @@ -1,208 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit twopi_amp - -reaction Pi+Pi- gamma Pi+ Pi- p - -normintfile Pi+Pi- twopi_ni.txt - -# sum for helicity of N'=+1/2. Amplitudes should be duplicated for N'=-1/2. -sum Pi+Pi- helplusN+ -sum Pi+Pi- helnegN+ -sum Pi+Pi- helplusN- -sum Pi+Pi- helnegN- - -# genmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# accmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# data Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_amp.root - -# amplitude Pi+Pi-::helplusN+::rho1 TwoPiAngles_amp (phipol, pol fraction, Jz for rho M=+/-1 and 0, prefix factor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# Prefix factor 0: 0.5*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 1: 0.5*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 2: 0.5*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 3: -0.5*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 4: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 5: 0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 6: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# Prefix factor 7: -0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# flat=1 generates distribution uniform in angles. flat=0 use YLMs - -amplitude Pi+Pi-::helplusN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 0 flat -amplitude Pi+Pi-::helplusN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 0 flat -amplitude Pi+Pi-::helplusN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 0 flat -amplitude Pi+Pi-::helplusN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 1 flat -amplitude Pi+Pi-::helnegN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 1 flat -amplitude Pi+Pi-::helnegN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 1 flat -amplitude Pi+Pi-::helnegN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helplusN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 6 flat -amplitude Pi+Pi-::helplusN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 6 flat -amplitude Pi+Pi-::helplusN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 6 flat -amplitude Pi+Pi-::helplusN-::g1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 7 flat -amplitude Pi+Pi-::helnegN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 7 flat -amplitude Pi+Pi-::helnegN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 7 flat -amplitude Pi+Pi-::helnegN-::g1VM-1 BreitWigner rho 1 2 3 - - -initialize Pi+Pi-::helplusN+::g1VM1 cartesian 500.0 0.0 real -initialize Pi+Pi-::helplusN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN+::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helplusN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM-1 cartesian 500.0 0.0 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN+::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN+::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN+::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN+::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN+::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN+::g-1VM-1 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helplusN-::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helplusN-::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helplusN-::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helplusN-::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helplusN-::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helplusN-::g-1VM-1 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN-::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN-::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN-::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN-::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN-::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN-::g-1VM-1 - - - diff --git a/src/programs/Simulation/gen_2pi_amp/gen_2pi_mom.cfg b/src/programs/Simulation/gen_2pi_amp/gen_2pi_mom.cfg deleted file mode 100644 index f8afb623db..0000000000 --- a/src/programs/Simulation/gen_2pi_amp/gen_2pi_mom.cfg +++ /dev/null @@ -1,99 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_2pi_amp.cfg -define sigma 0.500 0.400 -define rho 0.775 0.146 -define f2 1.275 0.187 - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit twopi_amp - -reaction Pi+Pi- gamma Pi+ Pi- p - -normintfile Pi+Pi- twopi_ni.txt - -# sum for helicity of N'=+1/2. Amplitudes should be duplicated for N'=-1/2. -sum Pi+Pi- Positive -sum Pi+Pi- Negative - -# genmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# accmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# data Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_amp.root - -# Negative Reflectivity Waves - -amplitude Pi+Pi-::Negative::S0- TwoPSHelicity 0 0 -1 -amplitude Pi+Pi-::Negative::S0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::P0- TwoPSHelicity 1 0 -1 -amplitude Pi+Pi-::Negative::P0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::P1- TwoPSHelicity 1 1 -1 -amplitude Pi+Pi-::Negative::P1- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::D0- TwoPSHelicity 2 0 -1 -amplitude Pi+Pi-::Negative::D0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::D1- TwoPSHelicity 2 1 -1 -amplitude Pi+Pi-::Negative::D1- BreitWigner rho 1 2 3 - -# Positive Refectivity Waves: - -amplitude Pi+Pi-::Positive::P1+ TwoPSHelicity 1 1 1 -amplitude Pi+Pi-::Positive::P1+ BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Positive::D1+ TwoPSHelicity 2 1 1 -amplitude Pi+Pi-::Positive::D1+ BreitWigner rho 1 2 3 - -# Initialize: One of each set can be real - -initialize Pi+Pi-::Negative::S0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::P0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::P1- cartesian 500.0 0.0 real -initialize Pi+Pi-::Negative::D0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::D1- cartesian 0.0 0.0 - -initialize Pi+Pi-::Positive::P1+ cartesian 500.0 0.0 real -initialize Pi+Pi-::Positive::D1+ cartesian 0.0 0.0 - diff --git a/src/programs/Simulation/gen_2pi_primakoff/SConscript b/src/programs/Simulation/gen_2pi_primakoff/SConscript deleted file mode 100644 index 6ae1ed55a8..0000000000 --- a/src/programs/Simulation/gen_2pi_primakoff/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - #sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cc b/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cc deleted file mode 100644 index bcab086ce3..0000000000 --- a/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cc +++ /dev/null @@ -1,339 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/TwoPiAngles_primakoff.h" -#include "AMPTOOLS_AMPS/TwoPiWt_primakoff.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaZToXYZ.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - // double lowMass = 0.2; - // double highMass = 2.0; - double lowMass = 0.28; - double highMass = 0.58 ; - - double beamMaxE = 12.0; - double beamPeakE = 6.0; - double beamLowE = 0.139*2; - double beamHighE = 12.0; - - int runNum = 9001; - int seed = 0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_2pi_primakoff -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - gRandom->SetSeed(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( TwoPiAngles_primakoff() ); - AmpToolsInterface::registerAmplitude( TwoPiWt_primakoff() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass -- the daughters are two charged pions - GammaZToXYZ resProd( lowMass, highMass, 0.140, 0.140, beamMaxE, beamPeakE, beamLowE, beamHighE, type ); - - // seed the distribution with a sum of noninterfering s-wave amplitudes - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - // resProd.addResonance( 0.775, 0.146, 1.0 ); - resProd.addResonance( 0.4, 0.146, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( PiPlus ); - pTypes.push_back( PiMinus ); - pTypes.push_back( Pb208 ); // use lead instead of Sn116 since it is defined in particle list. - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_2pi_primakoff_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1D* intenW = new TH1D( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - intenW->SetCanExtend(TH1::kXaxis); - TH2D* intenWVsM = new TH2D( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - intenWVsM->SetCanExtend(TH2::kYaxis); - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos#theta vs. #psi", 180, -3.14, 3.14, 100, -1, 1); - - TH1D* h1_phi = new TH1D( "h1_phi", "#phi", 180, -PI,PI ); - TH1D* h1_psi = new TH1D( "h1_psi", "#psi", 180, -PI,PI ); - TH1D* h1_Phi = new TH1D( "h1_Phi", "#Phi", 180, -PI,PI ); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 1 ) + - evt->particle( 2 ) ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - // double ResM = resonance.M(); - // double intensity_i = ati.intensity( i ); - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - // cout << " i=" << i << " intensity_i=" << intensity_i << " maxInten=" << maxInten << " ResM=" << ResM << endl; - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 3 ); - TLorentzVector p1 = evt->particle ( 1 ); - TLorentzVector p2 = evt->particle ( 2 ); - - // cout << endl << " gen_2pi_primakoff particles " << " Mbeam=" << beam.M() << " Mrecoil=" << recoil.M() << " Mp1=" << p1.M() << endl; - // beam.Print(); recoil.Print(); p1.Print(); p2.Print(); resonance.Print(); - - Double_t phipol=0; // hardwire angle of photon polarization in lab. - TVector3 eps(cos(phipol), sin(phipol), 0.0); // beam polarization vector in lab - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // choose helicity frame: z-axis opposite recoil target in rho rest frame. Note that for Primakoff recoil is defined as missing P4 - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - GDouble CosTheta = angles.CosTheta(); - GDouble phi = angles.Phi(); - // GDouble sinSqTheta = sin(angles.Theta())*sin(angles.Theta()); - // GDouble sin2Theta = sin(2.*angles.Theta()); - - GDouble Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = Phi - phi; // define angle difference - if(psi < -1*PI) psi += 2*PI; - if (psi > PI) psi -= 2*PI; - - // double phi = angles.Phi(); - - /*cout << endl << " gen_2pi_primakoff " << endl; - cout << " Phi=" << Phi << endl; - cout << " phi= " << phi << endl; - cout << " psi=" << psi << endl;*/ - - h1_phi->Fill(phi); - h1_psi->Fill(psi); - h1_Phi->Fill(Phi); - CosTheta_psi->Fill( psi, CosTheta); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - float vx = 0; - float vy = 0; - float vz = 1; // vertex for CCP experiment - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes, vx, vy, vz); - // note that there is no provision currently for vertex output in root file - rootOut.writeEvent( *evt ); - ++eventCounter; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 3 ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - intenW->Write(); - intenWVsM->Write(); - CosTheta_psi->Write(); - h1_phi->Write(); - h1_psi->Write(); - h1_Phi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cfg b/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cfg deleted file mode 100644 index 6f49e27ea2..0000000000 --- a/src/programs/Simulation/gen_2pi_primakoff/gen_2pi_primakoff.cfg +++ /dev/null @@ -1,73 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit fit_Primakoff -reaction Primakoff gamma Pi+ Pi- p - -# sum is a single term from s-wave production of pi+pi- -sum Primakoff swave - - -# amplitude Primakoff::swave TwoPiAngles_primakoff (phipol, pol fraction, m_rho, PhaseFactor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# pol fraction is the linear polarization of the beam -# m_rho Jz component of rho -# prefix factor to amplitudes in computation ( 0=1/1=exp(2iPhi)/2=-exp(2iPhi) ) -# flat=1 generates distribution uniform in angles. flat=0 use YLMs -amplitude Primakoff::swave::g1sigma0 TwoPiAngles_primakoff phipol polFrac 1 0 flat -amplitude Primakoff::swave::g1sigma0 BreitWigner rho 1 2 3 - -initialize Primakoff::swave::g1sigma0 cartesian 500.0 0.0 real - - - diff --git a/src/programs/Simulation/gen_3pi/Makefile b/src/programs/Simulation/gen_3pi/Makefile deleted file mode 100644 index e8b1b1f67b..0000000000 --- a/src/programs/Simulation/gen_3pi/Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - -ADDITIONAL_MODULES += HDDM diff --git a/src/programs/Simulation/gen_3pi/SConscript b/src/programs/Simulation/gen_3pi/SConscript deleted file mode 100644 index d14f56018a..0000000000 --- a/src/programs/Simulation/gen_3pi/SConscript +++ /dev/null @@ -1,21 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_3pi/gen_3pi.cc b/src/programs/Simulation/gen_3pi/gen_3pi.cc deleted file mode 100644 index c4c31ac65a..0000000000 --- a/src/programs/Simulation/gen_3pi/gen_3pi.cc +++ /dev/null @@ -1,284 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/ThreePiAngles.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYZP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - // random number initialization - this is not GlueX standard and - // should be standardized in the future - - srand48( time( NULL ) ); - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.7; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 7.5; - double beamHighE = 9.5; - - int runNum = 9001; - int seed = 0; - - int nEvents = 100000; - int batchSize = 100000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_3pi -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - gRandom->SetSeed(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( ThreePiAngles() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass -- the daughters are three charged pions - GammaPToXYZP resProd( lowMass, highMass, 0.140, 0.140, 0.140, type, beamMaxE, beamPeakE, beamLowE, beamHighE ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 1.230, 0.400, 0.4 ); - resProd.addResonance( 1.318, 0.105, 0.3 ); - resProd.addResonance( 1.600, 0.200, 0.2 ); - resProd.addResonance( 1.670, 0.260, 0.4 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Neutron ); - pTypes.push_back( PiPlus ); - pTypes.push_back( PiMinus ); - pTypes.push_back( PiPlus ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_3pi_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH2F* dalitz = new TH2F( "dalitz", "Dalitz Plot", 100, 0, 3.0, 100, 0, 3.0 ); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) + - evt->particle( 4 ) ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = drand48() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - dalitz->Fill( ( evt->particle( 2 ) + evt->particle( 3 ) ).M2(), - ( evt->particle( 3 ) + evt->particle( 4 ) ).M2() ); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - dalitz->Fill( ( evt->particle( 2 ) + evt->particle( 3 ) ).M2(), - ( evt->particle( 3 ) + evt->particle( 4 ) ).M2() ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - dalitz->Write(); - intenW->Write(); - intenWVsM->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_3pi/gen_3pi.cfg b/src/programs/Simulation/gen_3pi/gen_3pi.cfg deleted file mode 100644 index 67841906f6..0000000000 --- a/src/programs/Simulation/gen_3pi/gen_3pi.cfg +++ /dev/null @@ -1,125 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - - -# useful masses and widths -define a1 1.23 0.4 -define a2 1.318 0.105 -define pi1 1.60 0.2 -define pi2 1.67 0.259 - -define rho 0.775 0.146 -define f2 1.270 0.185 - -# J, P and isospin definitions for resonances -define a2JPI 2 1 1 -define pi2JPI 2 -1 1 -define a1JPI 1 1 1 -define pi1JPI 1 -1 1 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -define rho0pi+ 1 1 1 -1 1 - -# isobar definitions for f2pi final state -define f2pi+ 2 0 1 -1 1 - -fit threepi - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -reaction Pi+Pi-Pi+ gamma n Pi+ Pi- Pib - -# this file has the y polarization states if partial or unpolarized beams -# are needed -#include gen_3pi_ypol.cfg - -# consider just x polarized amplitudes -sum Pi+Pi-Pi+ xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S ThreePiAngles beamX a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner a1 0 23 4 -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D ThreePiAngles beamX a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner a2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P ThreePiAngles beamX pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner pi1 1 23 4 -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S ThreePiAngles beamX pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner pi2 0 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::xpol::pi2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P ThreePiAngles beamX pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner pi2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi2_rhopi_P 0 1 4 3 2 - -initialize Pi+Pi-Pi+::xpol::a1_rhopi_S cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::xpol::a2_rhopi_D cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi1_rhopi_P cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_f2pi_S cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_rhopi_P cartesian 1.0 0.0 - - - diff --git a/src/programs/Simulation/gen_3pi/gen_3pi_ypol.cfg b/src/programs/Simulation/gen_3pi/gen_3pi_ypol.cfg deleted file mode 100644 index ec38b5d53f..0000000000 --- a/src/programs/Simulation/gen_3pi/gen_3pi_ypol.cfg +++ /dev/null @@ -1,33 +0,0 @@ - -sum Pi+Pi-Pi+ ypol - -amplitude Pi+Pi-Pi+::ypol::a1_rhopi_S ThreePiAngles beamY a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::a1_rhopi_S BreitWigner a1 0 23 4 -amplitude Pi+Pi-Pi+::ypol::a1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::a1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::a2_rhopi_D ThreePiAngles beamY a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::a2_rhopi_D BreitWigner a2 2 23 4 -amplitude Pi+Pi-Pi+::ypol::a2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::a2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::pi1_rhopi_P ThreePiAngles beamY pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::pi1_rhopi_P BreitWigner pi1 1 23 4 -amplitude Pi+Pi-Pi+::ypol::pi1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::pi1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::pi2_f2pi_S ThreePiAngles beamY pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::ypol::pi2_f2pi_S BreitWigner pi2 0 23 4 -amplitude Pi+Pi-Pi+::ypol::pi2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::ypol::pi2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::ypol::pi2_rhopi_P ThreePiAngles beamY pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::ypol::pi2_rhopi_P BreitWigner pi2 2 23 4 -amplitude Pi+Pi-Pi+::ypol::pi2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::ypol::pi2_rhopi_P 0 1 4 3 2 - -initialize Pi+Pi-Pi+::ypol::a1_rhopi_S cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::ypol::a2_rhopi_D cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::ypol::pi1_rhopi_P cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::ypol::pi2_f2pi_S cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::ypol::pi2_rhopi_P cartesian 1.0 0.0 diff --git a/src/programs/Simulation/gen_5pi/Makefile b/src/programs/Simulation/gen_5pi/Makefile deleted file mode 100644 index 41cad5dca6..0000000000 --- a/src/programs/Simulation/gen_5pi/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -PACKAGES = AmpTools:CLHEP:ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - -ADDITIONAL_MODULES += HDDM - diff --git a/src/programs/Simulation/gen_5pi/b1piAmpCheck.cc b/src/programs/Simulation/gen_5pi/b1piAmpCheck.cc deleted file mode 100644 index 664bd1ce8b..0000000000 --- a/src/programs/Simulation/gen_5pi/b1piAmpCheck.cc +++ /dev/null @@ -1,111 +0,0 @@ -#include - - -b1piAmpCheck::b1piAmpCheck(){} - -b1piAmpCheck::b1piAmpCheck(Kinematics &evt) -{ - SetEvent(evt); -} - - -TLorentzVector& -b1piAmpCheck::Hep2T(const HepLorentzVector &v1, TLorentzVector &v2) -{ - v2.SetXYZT(v1.px(),v1.py(),v1.pz(),v1.e()); - return v2; -} - - -/** - * This function sets the 4 vectors of an event. - * Seven vectors must be given in all: - * beam photon, recoil proton and the 5 pions - * starting from the bachelor and from there - * in order down the tree. The calculation - * are run automatically when a new event is loaded. - */ - -void -b1piAmpCheck::SetEvent(Kinematics &evt) -{ - assert(evt.particleList().size()==7); - - Hep2T(evt.particle(6), m_rhos_pip); - Hep2T(evt.particle(5), m_rhos_pim); - m_rho = m_rhos_pim + m_rhos_pip; - - Hep2T(evt.particle(4), m_omegas_pi); - m_omega= m_rho + m_omegas_pi; - - Hep2T(evt.particle(3), m_b1s_pi); - m_b1= m_omega + m_b1s_pi; - - Hep2T(evt.particle(2), m_Xs_pi); - m_X= m_b1 + m_Xs_pi; - - Hep2T(evt.particle(0), m_beam); - Hep2T(evt.particle(1), m_recoil); - - ProcKin(); -} - - - -TLorentzVector& -b1piAmpCheck::MoveToRF(TLorentzVector &parent, - TLorentzVector &daughter) -{ - daughter.RotateZ(-parent.Phi()); - daughter.RotateY(-parent.Theta()); - daughter.Boost(0,0,-parent.Beta()); - - return daughter; -} - -void -b1piAmpCheck::ProcKin() -{ - - //Resonance RF, Godfried-Jackson frame - TLorentzRotation XRFboost( -m_X.BoostVector() ); - - TLorentzVector beam_XRF = XRFboost * m_beam; - TLorentzVector recoil_XRF = XRFboost * m_recoil; - - //Define coordinate system - TVector3 zGJ = beam_XRF.Vect().Unit(); - TVector3 yGJ = zGJ.Cross(recoil_XRF.Vect()).Unit(); - TVector3 xGJ = yGJ.Cross(zGJ); - - TLorentzVector b1_XRF = XRFboost * m_b1; - TLorentzVector omega_XRF = XRFboost * m_omega; - TLorentzVector rho_XRF = XRFboost * m_rho; - TLorentzVector rhos_pip_XRF= XRFboost * m_rhos_pip; - - - TVector3 ang_b1( (b1_XRF.Vect()).Dot(xGJ), - (b1_XRF.Vect()).Dot(yGJ), - (b1_XRF.Vect()).Dot(zGJ) ); - - m_X_phi=ang_b1.Phi(); - m_X_cosTheta=ang_b1.CosTheta(); - - - TLorentzVector omega_b1RF(MoveToRF(b1_XRF, omega_XRF)); - TLorentzVector rho_omegaRF(MoveToRF(omega_b1RF, - MoveToRF(b1_XRF, rho_XRF))); - TLorentzVector rhos_pip_rhoRF(MoveToRF(rho_omegaRF, - MoveToRF(omega_b1RF, - MoveToRF(b1_XRF,rhos_pip_XRF)))); - - m_b1_phi=omega_b1RF.Phi(); - m_b1_cosTheta=omega_b1RF.CosTheta(); - - m_omega_phi=rho_omegaRF.Phi(); - m_omega_cosTheta=rho_omegaRF.CosTheta(); - - m_rho_phi=rhos_pip_rhoRF.Phi(); - m_rho_cosTheta=rhos_pip_rhoRF.CosTheta(); - -} diff --git a/src/programs/Simulation/gen_5pi/b1piAmpCheck.h b/src/programs/Simulation/gen_5pi/b1piAmpCheck.h deleted file mode 100644 index 7601c3aee6..0000000000 --- a/src/programs/Simulation/gen_5pi/b1piAmpCheck.h +++ /dev/null @@ -1,83 +0,0 @@ -// b1piAmpCheck - a class for computing -// angles and invariant masses of b1pi events -// by Igor Senderovich - 11/2011 - -#if !defined(B1PIAMPCHECK) -#define B1PIAMPCHECK - -#include "IUAmpTools/Amplitude.h" -#include "IUAmpTools/AmpParameter.h" -#include "GPUManager/GPUCustomTypes.h" - -#include -#include -#include -#include - -#include -#include -#include "CLHEP/Vector/LorentzVector.h" - - -using std::complex; -using namespace std; - - -/** - * An object of the b1piAmpCheck class computes - * kinamtical variables of a b1pi decay, such as - * decay angles, and invariant masses of all resonances - * in the decay tree - */ - -class b1piAmpCheck -{ - -public: - - b1piAmpCheck(); - b1piAmpCheck(Kinematics &evt); - ~b1piAmpCheck(){} - - void SetEvent(Kinematics &evt); - - void ProcKin(); - - //Getters - double GetRhoPhi(){return m_rho_phi;} - double GetRhoCosTheta(){return m_rho_cosTheta;} - double GetOmegaPhi(){return m_omega_phi;} - double GetOmegaCosTheta(){return m_omega_cosTheta;} - double Getb1Phi(){return m_b1_phi;} - double Getb1CosTheta(){return m_b1_cosTheta;} - double GetXPhi(){return m_X_phi;} - double GetXCosTheta(){return m_X_cosTheta;} - double GetMX(){return m_X.M();} - double GetMb1(){return m_b1.M();} - double GetMomega(){return m_omega.M();} - double GetMrho(){return m_rho.M();} - - double GetAlpha(){return m_recoil.Phi();} - - const TLorentzVector& GetOmega(){return m_omega;} - const TLorentzVector& GetXsPi(){return m_Xs_pi;} - const TLorentzVector& Getb1sPi(){return m_b1s_pi;} - -private: - - TLorentzVector& Hep2T(const HepLorentzVector &v1, TLorentzVector &v2); - - TLorentzVector& MoveToRF(TLorentzVector &parent, - TLorentzVector &daughter); - - TLorentzVector m_rhos_pip, m_rho,m_omega, m_b1, m_X, m_beam, m_recoil; - TLorentzVector m_Xs_pi, m_b1s_pi, m_omegas_pi, m_rhos_pim; - double m_rho_phi, m_rho_cosTheta; - double m_omega_phi, m_omega_cosTheta; - double m_b1_phi, m_b1_cosTheta; - double m_X_phi, m_X_cosTheta; - double m_alpha, m_X_M,m_b1_M,m_omega_M,m_rho_M; - -}; - -#endif diff --git a/src/programs/Simulation/gen_5pi/gen_5pi.cc b/src/programs/Simulation/gen_5pi/gen_5pi.cc deleted file mode 100644 index 2688180b27..0000000000 --- a/src/programs/Simulation/gen_5pi/gen_5pi.cc +++ /dev/null @@ -1,407 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -using std::complex; -using namespace std; - -#include "particleType.h" -#include "AMPTOOLS_DATAIO/ROOTDataReader.h" -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/ASCIIDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/b1piAngAmp.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToNPartP.h" -//#include "GammaPTob1piP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" -#include "CLHEP/Vector/LorentzVector.h" -#include "CLHEP/Vector/LorentzRotation.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TTree.h" - -#include "b1piAmpCheck.h" - -using namespace CLHEP; - -void Usage(char* progName ) -{ - cout << endl << " Usage for: " << progName << endl << endl; - cout << " -c \t Config file [required]" << endl; - cout << " -o \t Output name base (ascii, hddm and root files generated)" << endl; - cout << " -a \t File to record events before accept/reject" << endl; - cout << " -e \t Input file with MC sample to use instead of generating" << endl; - cout << " -l \t Low edge of mass range (GeV)" << endl; - cout << " -u \t Upper edge of mass range (GeV)" << endl; - cout << " -n \t Minimum number of events to generate (allows spill-over)" << endl; - cout << " -N \t Exact number of events to generate" << endl; - cout << " -f \t\t Generate flat in M(X) (no physics)" << endl; - cout << " -d \t\t Compute diagnostic histograms" << endl ; - cout << " -s \t Specify random number generator seed" << endl; - cout << " -b \t Batch size for intensities in accept/reject alg. (def. 200k)" << endl; - cout << " -i \t Specify maximum intensity (accept/reject range)" << endl << endl; - -} - - -bool fileGood(string fname) -{ - ifstream file(fname.c_str()); - return file.good(); -} - - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname("gen_5pi"), allGenFName, inMCFName; - b1piAmpCheck AmpCheck; - bool diag = false, genFlat = false, StrictEvtLimit=false; - bool saveAll=false, readInEvents=false; - - // default upper and lower bounds - double lowMass = 0.7, highMass = 3.0, Mpipm,Mpi0; - Mpipm=ParticleMass(PiPlus); - Mpi0=ParticleMass(Pi0); - - //Exprected particle list: - // pi- b1(pi+ omega(pi0 "rho"(pi- pi+))) - // 2 3 4 5 6 - int par_types_list[]={1,14,9,8,7,9,8}; - vector part_types(par_types_list,par_types_list+7); - float part_masses_list[]={Mpipm, Mpipm, Mpi0, Mpipm, Mpipm}; - vector part_masses(part_masses_list,part_masses_list+5); - - - double CustMaxInten=-1, maxInten=0, runs_maxInten=0.0; - long int Seed=0; - - int nEvents = 30, batchSize = 200000; - - //Parse command line: ----------------------------------------------- - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else allGenFName = argv[++i]; saveAll=true;} - if (arg == "-e"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else inMCFName = argv[++i]; readInEvents=true;} - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-N"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else { nEvents = atoi( argv[++i] ); StrictEvtLimit=true;} } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else batchSize = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else Seed = atoi( argv[++i] ); } - if (arg == "-i"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else CustMaxInten = runs_maxInten = atof( argv[++i] ); } - - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - Usage(argv[0]); - exit(1); - } - } - - if( configfile.size() == 0 ){ - cerr << "No config file specified." << endl; - Usage(argv[0]); - exit(1); - } - if(!fileGood(configfile)){ - cerr << "Invalid config file!" << endl; - exit(1); - } - - - // END OF ARGUMENT PARSING/CHECKING ///////////////////////////////////////// - - - srand48(Seed); - - // prepare output pipes ----------------------------- - string rootfname=outname + ".root"; - string asciifname=outname + ".ascii"; - string hddmfname=outname + ".hddm"; - - // open output file - ROOTDataWriter *rootAllOut=NULL; - if(saveAll) rootAllOut= new ROOTDataWriter( allGenFName, "kin", true ); - HDDMDataWriter hddmOut( hddmfname ); - ROOTDataWriter rootOut( rootfname); - ASCIIDataWriter asciiOut( asciifname ); - //---------------------------------------------------- - - vector< string > readerArgs; - readerArgs.push_back( inMCFName ); - readerArgs.push_back( "kin" ); - - if(readInEvents){ - cout << "Performing accept/reject on pre-generated sample from: " << inMCFName << endl; - ROOTDataReader rootIn( readerArgs ); - Kinematics *evt; - - if(CustMaxInten>0){ - cout << " using the specified intensity ceiling: " << CustMaxInten << endl; - maxInten=CustMaxInten; - }else{ - cout << "Looking for peak intensity...\n"; - int i=0; - while((evt=rootIn.getEvent())!=NULL){ - if(evt->weight() > maxInten) maxInten = evt->weight(); - delete evt; - if(++i % 50000==0) cout << i << " events searched\n"; - } - - cout << "Maximum intensity found: " << maxInten << endl; - rootIn.resetSource(); - } - - for(int i=0 ; (evt=rootIn.getEvent())!=NULL && - ((StrictEvtLimit && iweight() > drand48() * maxInten * 1.5 ) { - evt->setWeight( 1.0 ); - rootOut.writeEvent( *evt ); - asciiOut.writeEvent( *evt, part_types ); - hddmOut.writeEvent( *evt, part_types ); - } - delete evt; - if(i%9999==0) cout << i+1 << " events written\n"; - } - - return 0 ; - } - - - - - // prepare dyagnostic histograms --------------------- - TH1F* mass = new TH1F( "M", "Resonance Mass", 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH2F* dalitz = new TH2F( "dalitz", "Dalitz Plot", 100, 0, 3.0, 100, 0, 3.0 ); - - TH1F* prod_ang = new TH1F( "alpha", "Production angle #alpha", 100, -PI, PI); - - TH1F* M_rho = new TH1F( "M_rho", "#rho Mass", 200, 0.27, .9 ); - TH1F* M_omega = new TH1F( "M_omega", "#omega Mass", 200, 0.6, 1.1 ); - TH1F* M_b1 = new TH1F( "M_b1", "Isobar Mass", 200, 0.5, 3.0 ); - - TH2F *XAng = new TH2F("XAng","Angular distribution of X decay", - 50,-M_PI,M_PI,50,-1,1); - TH2F *b1Ang = new TH2F("b1Ang","Angular distribution of b_{1} decay", - 50,-M_PI,M_PI,50,-1,1); - TH2F *OmegaAng = new TH2F("OmegaAng","Angular distribution of #omega decay", - 50,-M_PI,M_PI,50,-1,1); - TH2F *RhoAng = new TH2F("RhoAng","Angular distribution of #rho decay", - 50,-M_PI,M_PI,50,-1,1); - // ----------------------------------------------------- - - - - //FILE *Ifid; - - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - AmpToolsInterface::registerAmplitude( b1piAngAmp() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - //generate over a range mass -- the daughters are pi-,pi+,omega - GammaPToNPartP resProd( lowMass, highMass, part_masses,type ); - //GammaPTob1piP resProd( lowMass, highMass, type ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - if( !genFlat ){ - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - resProd.addResonance( 1.89, 0.16, 1.0 ); - resProd.addResonance( 2.0, 0.25, 0.75 ); - } - - - //Ifid=fopen("Idump.dat","w"); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Number to generate: " << batchSize << endl; - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Calculating intensities..." << endl; - - maxInten=0; - if(!genFlat) // Signal intensity calculation - maxInten = ati.processEvents( reaction->reactionName() ); - else - for(int i = 0; i < batchSize; ++i ){ // Get the max. inten. for PS gen - Kinematics* kin = ati.kinematics(i); - if(kin->weight() > maxInten) - maxInten = kin->weight(); - delete kin; - } - - cout << "Beginning accept/reject..." << endl; - - printf("MAXINTEN: %25.20f\n",maxInten); - if(runs_maxInten < maxInten) runs_maxInten=maxInten; - - //override the max intensity found with that passed in through cmd line args - if( CustMaxInten > 0 ){ - if(maxInten>CustMaxInten){ - printf("WARNING: Event found with intensity greater than custom-specified maximum\n"); - CustMaxInten=maxInten; - }else maxInten=CustMaxInten; - }else maxInten*=1.5; - - - cout << "Processing events..." << endl; - - - //double IbatchSum=0; - for( int i = 0; i < batchSize ; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - - - double genWeight = evt->weight(); - double weightedInten = ati.intensity( i ); - - - - // obtain this by looking at the maximum value of intensity * genWeight - if((!genFlat && weightedInten > drand48() * maxInten) || - (genFlat && genWeight > drand48() * maxInten) ){ - - double histWeight = 1.0;//genFlat ? genWeight : 1.0; - - //Fill some useful histograms - if(diag){ - AmpCheck.SetEvent(*evt); - mass->Fill( AmpCheck.GetMX(), histWeight ); - massW->Fill( AmpCheck.GetMX(), genWeight ); - - intenW->Fill( weightedInten, histWeight ); - intenWVsM->Fill( AmpCheck.GetMX(), weightedInten ); - - dalitz->Fill( (AmpCheck.GetXsPi() + AmpCheck.Getb1sPi()).M2(), - (AmpCheck.Getb1sPi() + AmpCheck.GetOmega()).M2(),histWeight); - M_rho->Fill(AmpCheck.GetMrho(), histWeight); - M_omega->Fill(AmpCheck.GetMomega(), histWeight); - M_b1->Fill(AmpCheck.GetMb1(), histWeight); - - // orientation of production plane in lab - prod_ang->Fill(AmpCheck.GetAlpha(), histWeight); - XAng->Fill(AmpCheck.GetXPhi(), AmpCheck.GetXCosTheta(), histWeight); - b1Ang->Fill(AmpCheck.Getb1Phi(), AmpCheck.Getb1CosTheta(), histWeight); - OmegaAng->Fill(AmpCheck.GetOmegaPhi(),AmpCheck.GetOmegaCosTheta(), histWeight); - RhoAng->Fill(AmpCheck.GetRhoPhi(), AmpCheck.GetRhoCosTheta(), histWeight); - } - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - rootOut.writeEvent( *evt ); - asciiOut.writeEvent( *evt, part_types ); - hddmOut.writeEvent( *evt, part_types ); - ++eventCounter; - if(StrictEvtLimit && eventCounter>=nEvents) break; - } - - if(saveAll) { - evt->setWeight( weightedInten ); - rootAllOut->writeEvent( *evt ); - } - delete evt; - } - //printf("BATCH AVERAGE: %f\n",IbatchSum/batchSize); - - cout << eventCounter << " events were processed." << endl; - } - - if(!genFlat) printf("RUN_MAX_INTEN: %25.20f\n",runs_maxInten); - - mass->Write(); - massW->Write(); - dalitz->Write(); - intenW->Write(); - intenWVsM->Write(); - prod_ang->Write(); - M_b1->Write(); - M_omega->Write(); - M_rho->Write(); - XAng->Write(); - b1Ang->Write(); - OmegaAng->Write(); - RhoAng->Write(); - if(saveAll) delete rootAllOut; - //fclose(Ifid); - - return 0; -} - - diff --git a/src/programs/Simulation/gen_amp/SConscript b/src/programs/Simulation/gen_amp/SConscript deleted file mode 100644 index 25c0cf7bc0..0000000000 --- a/src/programs/Simulation/gen_amp/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_amp/gen_2k.cfg b/src/programs/Simulation/gen_amp/gen_2k.cfg deleted file mode 100644 index e7b6b18749..0000000000 --- a/src/programs/Simulation/gen_amp/gen_2k.cfg +++ /dev/null @@ -1,55 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Useful definition -define phi 1.020 0.043 - -fit twok - -reaction K+K- Beam Proton K+ K- - -# consider just x polarized amplitudes -sum K+K- xpol - -# Currently not using any input parameters for TwoPiAngles in the generator -amplitude K+K-::xpol::res BreitWigner phi 0 2 3 - -initialize K+K-::xpol::res cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_amp/gen_2pi_amp.cfg b/src/programs/Simulation/gen_amp/gen_2pi_amp.cfg deleted file mode 100644 index 3e56ecba65..0000000000 --- a/src/programs/Simulation/gen_amp/gen_2pi_amp.cfg +++ /dev/null @@ -1,208 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_3pi.cfg -define rho 0.775 0.146 -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit twopi_amp - -reaction Pi+Pi- Beam Proton Pi+ Pi- - -normintfile Pi+Pi- twopi_ni.txt - -# sum for helicity of N'=+1/2. Amplitudes should be duplicated for N'=-1/2. -sum Pi+Pi- helplusN+ -sum Pi+Pi- helnegN+ -sum Pi+Pi- helplusN- -sum Pi+Pi- helnegN- - -# genmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# accmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# data Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_amp.root - -# amplitude Pi+Pi-::helplusN+::rho1 TwoPiAngles_amp (phipol, pol fraction, Jz for rho M=+/-1 and 0, prefix factor, flat) -# phipol is the lab azimuthal angle of the polarization vector. -# Prefix factor 0: 0.5*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 1: 0.5*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=M -# Prefix factor 2: 0.5*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 3: -0.5*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=M -# Prefix factor 4: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 5: 0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) - i*sin(Phi)), M=-M -# Prefix factor 6: 0.5*(-1)^M*sqrt(1-polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# Prefix factor 7: -0.5*(-1)^M*sqrt(1+polFrac)*(cos(Phi) + i*sin(Phi)), M=-M -# flat=1 generates distribution uniform in angles. flat=0 use YLMs - -amplitude Pi+Pi-::helplusN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 0 flat -amplitude Pi+Pi-::helplusN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 0 flat -amplitude Pi+Pi-::helplusN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 0 flat -amplitude Pi+Pi-::helplusN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 2 flat -amplitude Pi+Pi-::helplusN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN+::g1VM1 TwoPiAngles_amp phipol polFrac 1 1 flat -amplitude Pi+Pi-::helnegN+::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM0 TwoPiAngles_amp phipol polFrac 0 1 flat -amplitude Pi+Pi-::helnegN+::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g1VM-1 TwoPiAngles_amp phipol polFrac -1 1 flat -amplitude Pi+Pi-::helnegN+::g1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM1 TwoPiAngles_amp phipol polFrac 1 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM0 TwoPiAngles_amp phipol polFrac 0 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN+::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 3 flat -amplitude Pi+Pi-::helnegN+::g-1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helplusN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 4 flat -amplitude Pi+Pi-::helplusN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 6 flat -amplitude Pi+Pi-::helplusN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 6 flat -amplitude Pi+Pi-::helplusN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helplusN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 6 flat -amplitude Pi+Pi-::helplusN-::g1VM-1 BreitWigner rho 1 2 3 - - -amplitude Pi+Pi-::helnegN-::g-1VM1 TwoPiAngles_amp phipol polFrac 1 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM0 TwoPiAngles_amp phipol polFrac 0 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g-1VM-1 TwoPiAngles_amp phipol polFrac -1 5 flat -amplitude Pi+Pi-::helnegN-::g-1VM-1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM1 TwoPiAngles_amp phipol polFrac 1 7 flat -amplitude Pi+Pi-::helnegN-::g1VM1 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM0 TwoPiAngles_amp phipol polFrac 0 7 flat -amplitude Pi+Pi-::helnegN-::g1VM0 BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::helnegN-::g1VM-1 TwoPiAngles_amp phipol polFrac -1 7 flat -amplitude Pi+Pi-::helnegN-::g1VM-1 BreitWigner rho 1 2 3 - - -initialize Pi+Pi-::helplusN+::g1VM1 cartesian 500.0 0.0 real -initialize Pi+Pi-::helplusN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN+::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN+::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helplusN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helplusN-::g-1VM-1 cartesian 500.0 0.0 - -initialize Pi+Pi-::helnegN-::g1VM1 cartesian 500.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g1VM-1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM1 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM0 cartesian 0.0 0.0 -initialize Pi+Pi-::helnegN-::g-1VM-1 cartesian 500.0 0.0 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN+::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN+::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN+::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN+::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN+::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN+::g-1VM-1 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helplusN-::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helplusN-::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helplusN-::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helplusN-::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helplusN-::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helplusN-::g-1VM-1 - -# constrain Pi+Pi-::helplusN+::g1VM1 Pi+Pi-::helnegN-::g1VM1 -# constrain Pi+Pi-::helplusN+::g1VM0 Pi+Pi-::helnegN-::g1VM0 -# constrain Pi+Pi-::helplusN+::g1VM-1 Pi+Pi-::helnegN-::g1VM-1 -# constrain Pi+Pi-::helplusN+::g-1VM1 Pi+Pi-::helnegN-::g-1VM1 -# constrain Pi+Pi-::helplusN+::g-1VM0 Pi+Pi-::helnegN-::g-1VM0 -# constrain Pi+Pi-::helplusN+::g-1VM-1 Pi+Pi-::helnegN-::g-1VM-1 - - - diff --git a/src/programs/Simulation/gen_amp/gen_2pi_mom.cfg b/src/programs/Simulation/gen_amp/gen_2pi_mom.cfg deleted file mode 100644 index eb9de1d101..0000000000 --- a/src/programs/Simulation/gen_amp/gen_2pi_mom.cfg +++ /dev/null @@ -1,99 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions from gen_2pi_amp.cfg -define sigma 0.500 0.400 -define rho 0.775 0.146 -define f2 1.275 0.187 - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit twopi_amp - -reaction Pi+Pi- Beam Proton Pi+ Pi- - -normintfile Pi+Pi- twopi_ni.txt - -# sum for helicity of N'=+1/2. Amplitudes should be duplicated for N'=-1/2. -sum Pi+Pi- Positive -sum Pi+Pi- Negative - -# genmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# accmc Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_flat_amp.root -# data Pi+Pi- ROOTDataReader tree_AmpToolsFormatThrown_amp.root - -# Negative Reflectivity Waves - -amplitude Pi+Pi-::Negative::S0- TwoPSHelicity 0 0 -1 -amplitude Pi+Pi-::Negative::S0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::P0- TwoPSHelicity 1 0 -1 -amplitude Pi+Pi-::Negative::P0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::P1- TwoPSHelicity 1 1 -1 -amplitude Pi+Pi-::Negative::P1- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::D0- TwoPSHelicity 2 0 -1 -amplitude Pi+Pi-::Negative::D0- BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Negative::D1- TwoPSHelicity 2 1 -1 -amplitude Pi+Pi-::Negative::D1- BreitWigner rho 1 2 3 - -# Positive Refectivity Waves: - -amplitude Pi+Pi-::Positive::P1+ TwoPSHelicity 1 1 1 -amplitude Pi+Pi-::Positive::P1+ BreitWigner rho 1 2 3 - -amplitude Pi+Pi-::Positive::D1+ TwoPSHelicity 2 1 1 -amplitude Pi+Pi-::Positive::D1+ BreitWigner rho 1 2 3 - -# Initialize: One of each set can be real - -initialize Pi+Pi-::Negative::S0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::P0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::P1- cartesian 500.0 0.0 real -initialize Pi+Pi-::Negative::D0- cartesian 0.0 0.0 -initialize Pi+Pi-::Negative::D1- cartesian 0.0 0.0 - -initialize Pi+Pi-::Positive::P1+ cartesian 500.0 0.0 real -initialize Pi+Pi-::Positive::D1+ cartesian 0.0 0.0 - diff --git a/src/programs/Simulation/gen_amp/gen_3pi.cfg b/src/programs/Simulation/gen_amp/gen_3pi.cfg deleted file mode 100644 index 6a29a4105b..0000000000 --- a/src/programs/Simulation/gen_amp/gen_3pi.cfg +++ /dev/null @@ -1,125 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - - -# useful masses and widths -define a1 1.23 0.4 -define a2 1.318 0.105 -define pi1 1.60 0.2 -define pi2 1.67 0.259 - -define rho 0.775 0.146 -define f2 1.270 0.185 - -# J, P and isospin definitions for resonances -define a2JPI 2 1 1 -define pi2JPI 2 -1 1 -define a1JPI 1 1 1 -define pi1JPI 1 -1 1 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -define rho0pi+ 1 1 1 -1 1 - -# isobar definitions for f2pi final state -define f2pi+ 2 0 1 -1 1 - -fit threepi - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -reaction Pi+Pi-Pi+ Beam Neutron Pi+ Pi- Pi+ - -# this file has the y polarization states if partial or unpolarized beams -# are needed -#include gen_3pi_ypol.cfg - -# consider just x polarized amplitudes -sum Pi+Pi-Pi+ xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S ThreePiAngles beamX a1JPI 0 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner a1 0 23 4 -amplitude Pi+Pi-Pi+::xpol::a1_rhopi_S BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a1_rhopi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D ThreePiAngles beamX a2JPI 2 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner a2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::a2_rhopi_D BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::a2_rhopi_D 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P ThreePiAngles beamX pi1JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner pi1 1 23 4 -amplitude Pi+Pi-Pi+::xpol::pi1_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi1_rhopi_P 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S ThreePiAngles beamX pi2JPI 0 f2pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner pi2 0 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_f2pi_S BreitWigner f2 2 2 3 -permute Pi+Pi-Pi+::xpol::pi2_f2pi_S 0 1 4 3 2 - -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P ThreePiAngles beamX pi2JPI 1 rho0pi+ -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner pi2 2 23 4 -amplitude Pi+Pi-Pi+::xpol::pi2_rhopi_P BreitWigner rho 1 2 3 -permute Pi+Pi-Pi+::xpol::pi2_rhopi_P 0 1 4 3 2 - -initialize Pi+Pi-Pi+::xpol::a1_rhopi_S cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::xpol::a2_rhopi_D cartesian 3.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi1_rhopi_P cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_f2pi_S cartesian 1.0 0.0 -initialize Pi+Pi-Pi+::xpol::pi2_rhopi_P cartesian 1.0 0.0 - - - diff --git a/src/programs/Simulation/gen_amp/gen_amp.cc b/src/programs/Simulation/gen_amp/gen_amp.cc deleted file mode 100644 index 7cda1aa531..0000000000 --- a/src/programs/Simulation/gen_amp/gen_amp.cc +++ /dev/null @@ -1,397 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/ThreePiAngles.h" -#include "AMPTOOLS_AMPS/TwoPiAngles_amp.h" -#include "AMPTOOLS_AMPS/TwoPSHelicity.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" -#include "AMPTOOLS_AMPS/BreitWigner3body.h" -#include "AMPTOOLS_AMPS/ThreePiAnglesSchilling.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToNPartP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.2; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = lowMass + 0.937; - double beamHighE = 12.0; - - int runNum = 9001; - unsigned int seed = 0; - - double slope = 6.0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-t"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else slope = atof( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -t \t Momentum transfer slope [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_amp -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // use particletype.h to convert reaction particle names - vector Particles; - vector childMasses; - double threshold = 0; - for (unsigned int i = 0; i < reaction->particleList().size(); i++){ - Particle_t locEnum = ParticleEnum(reaction->particleList()[i].c_str()); - // Beam particle is always photon - if (locEnum == 0 && i > 0) - cout << "ConfigFileParser WARNING: unknown particle type \"" << reaction->particleList()[i] << "\"" << endl; - Particles.push_back(ParticleEnum(reaction->particleList()[i].c_str())); - if (i>1){ - childMasses.push_back(ParticleMass(Particles[i])); - threshold += ParticleMass(Particles[i]); - } - } - - // loop to look for resonance in config file - // currently only one at a time is supported - const vector configFileLines = parser.getConfigFileLines(); - double resonance[]={1.0, 1.0}; - bool foundResonance = false; - for (vector::const_iterator it=configFileLines.begin(); it!=configFileLines.end(); it++) { - if ((*it).keyword() == "define") { - if ((*it).arguments()[0] == "rho" || (*it).arguments()[0] == "omega" || (*it).arguments()[0] == "phi" || (*it).arguments()[0] == "b1" || (*it).arguments()[0] == "a1"){ - if ( (*it).arguments().size() != 3 ) - continue; - resonance[0]=atof((*it).arguments()[1].c_str()); - resonance[1]=atof((*it).arguments()[2].c_str()); - cout << "Distribution seeded with resonance " << (*it).arguments()[0] << " : mass = " << resonance[0] << "GeV , width = " << resonance[1] << "GeV" << endl; - foundResonance = true; - break; - } - } - } - if (!foundResonance) - cout << "ConfigFileParser WARNING: no known resonance found, seed with mass = width = 1GeV" << endl; - - - // random number initialization (set to 0 by default) - TRandom3* gRandom = new TRandom3(); - gRandom->SetSeed(seed); - seed = gRandom->GetSeed(); - cout << "TRandom3 Seed : " << seed << endl; - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( ThreePiAngles() ); - AmpToolsInterface::registerAmplitude( TwoPiAngles_amp() ); - AmpToolsInterface::registerAmplitude( TwoPSHelicity() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface::registerAmplitude( BreitWigner3body() ); - AmpToolsInterface::registerAmplitude( ThreePiAnglesSchilling() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass - GammaPToNPartP resProd( threshold, highMass, childMasses, beamMaxE, beamPeakE, beamLowE, beamHighE, type, slope, seed ); - - if (childMasses.size() < 2){ - cout << "ConfigFileParser ERROR: single particle production is not yet implemented" << endl; - return 1; - } - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( resonance[0], resonance[1], 1.0 ); - } - - vector< int > pTypes; - for (unsigned int i=0; i 2 ) - locIsobarStream << ParticleName_ROOT(Particles[i]); - } - string locHistTitle = string("Resonance Mass ;") + locStream.str() + string(" Invariant Mass (GeV/c^{2});"); - string locIsobarTitle = string("Isobar Mass ;") + locIsobarStream.str() + string(" Invariant Mass (GeV/c^{2});"); - - TH1F* mass = new TH1F( "M", locHistTitle.c_str(), 180, lowMass, highMass ); - TH1F* massW = new TH1F( "M_W", ("Weighted "+locHistTitle).c_str(), 180, lowMass, highMass ); - massW->Sumw2(); - TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - - TH1F* t = new TH1F( "t", "-t Distribution", 200, 0, 2 ); - - TH1F* M_isobar = new TH1F( "M_isobar", locIsobarTitle.c_str(), 200, 0, 2 ); - - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos#theta vs. #psi", 180, -3.14, 3.14, 100, -1, 1); - TH2F* M_CosTheta = new TH2F( "M_CosTheta", "M vs. cos#vartheta", 180, lowMass, highMass, 200, -1, 1); - TH2F* M_Phi = new TH2F( "M_Phi", "M vs. #varphi", 180, lowMass, highMass, 200, -3.14, 3.14); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance; - for (unsigned int i=2; iparticle( i ); - - TLorentzVector isobar; - for (unsigned int i=3; iparticle( i ); - - double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - // cout << " i=" << i << " intensity_i=" << weightedInten << endl; - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - - M_isobar->Fill( isobar.M() ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - TLorentzVector target(0,0,0,recoil[3]); - - t->Fill(-1*(evt->particle(1)-target).M2()); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - - // normal to the production plane - TVector3 y = (beam.Vect().Unit().Cross(-recoil.Vect().Unit())).Unit(); - - // choose helicity frame: z-axis opposite recoil proton in rho rest frame - TVector3 z = -1. * recoil_res.Vect().Unit(); - TVector3 x = y.Cross(z).Unit(); - TVector3 angles( (p1_res.Vect()).Dot(x), - (p1_res.Vect()).Dot(y), - (p1_res.Vect()).Dot(z) ); - - double cosTheta = angles.CosTheta(); - double phi = angles.Phi(); - - M_CosTheta->Fill( resonance.M(), cosTheta); - M_Phi->Fill( resonance.M(), phi); - - TVector3 eps(1.0, 0.0, 0.0); // beam polarization vector - double Phi = atan2(y.Dot(eps), beam.Vect().Unit().Dot(eps.Cross(y))); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - - CosTheta_psi->Fill( psi, cosTheta); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - if(eventCounter >= nEvents) break; - } - } - else{ - - mass->Fill( resonance.M() ); - massW->Fill( resonance.M(), genWeight ); - - intenW->Fill( weightedInten ); - intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - massW->Write(); - intenW->Write(); - intenWVsM->Write(); - M_isobar->Write(); - t->Write(); - CosTheta_psi->Write(); - M_CosTheta->Write(); - M_Phi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_amp/gen_b1.cfg b/src/programs/Simulation/gen_amp/gen_b1.cfg deleted file mode 100644 index 1b96b2f196..0000000000 --- a/src/programs/Simulation/gen_amp/gen_b1.cfg +++ /dev/null @@ -1,89 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - - -# useful masses and widths -define b1 1.235 0.142 -#define b1JPI 1 1 1 -define omega 0.782 0.008 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -#define omegapi0 1 0 1 0 0 - -#fit name -fit fitb1 - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -reaction omegapi Beam Proton Pi0 Pi0 Pi+ Pi- - -# this file has the y polarization states if partial or unpolarized beams -# are needed -#include gen_3pi_ypol.cfg - -# consider just x polarized amplitudes -sum omegapi xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -#amplitude omegapi::xpol::amp_b1 ThreePiAngles beamX b1JPI 0 omegapi0 -amplitude omegapi::xpol::amp_b1 BreitWigner b1 1 2 345 -amplitude omegapi::xpol::amp_b1 BreitWigner3body omega 345 -#permute b1::xpol::amp_b1 0 1 3 2 4 5 - -initialize omegapi::xpol::amp_b1 cartesian 1.0 0.0 - - - diff --git a/src/programs/Simulation/gen_amp/gen_b1_pigamma.cfg b/src/programs/Simulation/gen_amp/gen_b1_pigamma.cfg deleted file mode 100644 index 7afd06f50e..0000000000 --- a/src/programs/Simulation/gen_amp/gen_b1_pigamma.cfg +++ /dev/null @@ -1,89 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - - -# useful masses and widths -define b1 1.235 0.142 -#define b1JPI 1 1 1 -define omega 0.782 0.008 - -# isobar definitions for rhopi final sate -# (J of isobar) (isospin of isobar) (Iz1) (Iz2) (Iz3) -#define omegapi0 1 0 1 0 0 - -#fit name -fit fitb1 - -# some definitions for adjusting the beam polarization -define polFrac 0.0 -define beamX 0 polFrac -define beamY 1 polFrac - -reaction omegapi Beam Proton Pi0 Pi0 Photon - -# this file has the y polarization states if partial or unpolarized beams -# are needed -#include gen_3pi_ypol.cfg - -# consider just x polarized amplitudes -sum omegapi xpol - -# ThreePiAngles assumes isobar is particles 23 with bachelor 4 -# arguments to ThreePiAngles (resonance) -> (isobar) + (bachelor) are: -# polarization: 0 = X; 1 = Y -# J of resonance -# parity of resonance -# total isospin of resonance -# L between bachelor and isobar -# J of isobar -# total isospin of isobar -# z component of isospin of first final state particle (index 2) -# z component of isospin of first second state particle (index 3) -# z component of isospin of first third state particle (index 4) - -#amplitude omegapi::xpol::amp_b1 ThreePiAngles beamX b1JPI 0 omegapi0 -amplitude omegapi::xpol::amp_b1 BreitWigner b1 1 2 34 -amplitude omegapi::xpol::amp_b1 BreitWigner omega 1 3 4 -#permute b1::xpol::amp_b1 0 1 3 2 4 5 - -initialize omegapi::xpol::amp_b1 cartesian 1.0 0.0 - - - diff --git a/src/programs/Simulation/gen_amp/gen_etapi0_2body.cfg b/src/programs/Simulation/gen_amp/gen_etapi0_2body.cfg deleted file mode 100644 index 1c0cb1502a..0000000000 --- a/src/programs/Simulation/gen_amp/gen_etapi0_2body.cfg +++ /dev/null @@ -1,57 +0,0 @@ -# -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -# some definitions for adjusting the beam polarization. In the equations beamX: Polarization>0, beamY: Polarization<0. -# Phi is the azimuthal angle of the polarization vector in degrees (in the lab coordinates) -define phipol 0 -define polFrac 0.4 -define beamX 0 polFrac -define beamY 90 polFrac - -# Uniform angles: flat=1; YLMs: flat=0; -define flat 0 - -# fit etapi_mom - -reaction EtaPi0 Beam Proton Eta Pi0 - -#normintfile EtaPi0 etapi_ni.txt - diff --git a/src/programs/Simulation/gen_amp/gen_omega_3pi.cfg b/src/programs/Simulation/gen_amp/gen_omega_3pi.cfg deleted file mode 100644 index 43005680d0..0000000000 --- a/src/programs/Simulation/gen_amp/gen_omega_3pi.cfg +++ /dev/null @@ -1,57 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit threepi - -define omega 0.783 0.008 - -define phipol 0 -define polFrac 0.4 - -reaction Pi+Pi-Pi0 Beam Proton Pi+ Pi- Pi0 - -# consider just x polarized amplitudes -sum Pi+Pi-Pi0 xpol - -amplitude Pi+Pi-Pi0::xpol::omegaS ThreePiAnglesSchilling 0.0 0.0 0.0 0.0 0.0 0.0 0.4 0.0 -0.2 phipol polFrac -amplitude Pi+Pi-Pi0::xpol::omegaS BreitWigner3body omega 234 - -initialize Pi+Pi-Pi0::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_amp/gen_omega_3pi_flat.cfg b/src/programs/Simulation/gen_amp/gen_omega_3pi_flat.cfg deleted file mode 100644 index 20ca60a22a..0000000000 --- a/src/programs/Simulation/gen_amp/gen_omega_3pi_flat.cfg +++ /dev/null @@ -1,54 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions -define omega 0.782 0.008 - -fit threepi - -reaction Pi+Pi-Pi0 Beam Proton Pi+ Pi- Pi0 - -# consider just x polarized amplitudes -sum Pi+Pi-Pi0 xpol - -amplitude Pi+Pi-Pi0::xpol::omegaS BreitWigner3body omega 234 - -initialize Pi+Pi-Pi0::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_amp/gen_omega_radiative_flat.cfg b/src/programs/Simulation/gen_amp/gen_omega_radiative_flat.cfg deleted file mode 100644 index 11521bdedd..0000000000 --- a/src/programs/Simulation/gen_amp/gen_omega_radiative_flat.cfg +++ /dev/null @@ -1,55 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -#Take useful definitions -define omega 0.782 0.008 - -fit radiative - -reaction Pi0Gamma Beam Proton Pi0 Photon - -# consider just x polarized amplitudes -sum Pi0Gamma xpol - -amplitude Pi0Gamma::xpol::omegaS BreitWigner omega 1 2 3 - -initialize Pi0Gamma::xpol::omegaS cartesian 1.0 0.0 - -#permute Pi0Gamma::xpol::omegaS 0 1 2 3 \ No newline at end of file diff --git a/src/programs/Simulation/gen_ee/SConscript b/src/programs/Simulation/gen_ee/SConscript deleted file mode 100644 index 2b381ea6bc..0000000000 --- a/src/programs/Simulation/gen_ee/SConscript +++ /dev/null @@ -1,6 +0,0 @@ - - -Import('*') - -SConscript(dirs=['code'], exports='env osname', duplicate=0) - diff --git a/src/programs/Simulation/gen_ee/code/HddmOut.h b/src/programs/Simulation/gen_ee/code/HddmOut.h deleted file mode 100644 index c46a6608de..0000000000 --- a/src/programs/Simulation/gen_ee/code/HddmOut.h +++ /dev/null @@ -1,154 +0,0 @@ -/* - * HddmOut.h - * - * Created on: Nov 14, 2013 - * Author: ben - */ - -#ifndef HDDMOUT_H_ -#define HDDMOUT_H_ - -using namespace std; - -#include "HDDM/hddm_s.h" - -struct tmpEvt_t { - int nGen; - int rxn; - double weight; - TLorentzVector beam; - TLorentzVector target; - TLorentzVector q1; - TLorentzVector q2; - TLorentzVector recoil; -}; - -class HddmOut { - private: - s_iostream_t* ostream; - //TDatabasePDG* pdg; - s_PhysicsEvents_t* phyEvt; - s_Reactions_t* reactions; - s_Reaction_t* reaction; - s_Target_t* target; - s_Beam_t* beam; - s_Vertices_t* vertices; - s_HDDM_t* hddmEvt; - s_Origin_t* origin; - s_Products_t* products; - - Particle_t targetType; - Particle_t beamType; - - public: - HddmOut(string filename) { - cout << "opening HDDM file: " << filename << endl; - ostream = init_s_HDDM((char*)filename.c_str()); - targetType = Proton; - beamType = Gamma; - } - - ~HddmOut() { - close_s_HDDM(ostream); - } - - void init(int runNo) { - //This sets the run number and event characteristics - //The HDDM entry has one event, which has one reaction - hddmEvt = make_s_HDDM(); - hddmEvt->physicsEvents = phyEvt = make_s_PhysicsEvents(1); - phyEvt->mult = 1; - phyEvt->in[0].runNo = runNo; - - //We define beam and target parameters for the reaction, which - //remain the same between events - phyEvt->in[0].reactions = reactions = make_s_Reactions(1); - reactions->mult = 1; - reaction = &reactions->in[0]; - reaction->target = target = make_s_Target(); - target->type = targetType; - target->properties = make_s_Properties(); - target->properties->charge = ParticleCharge(targetType); - target->properties->mass = ParticleMass(targetType); - target->momentum = make_s_Momentum(); - target->momentum->px = 0; - target->momentum->py = 0; - target->momentum->pz = 0; - target->momentum->E = ParticleMass(targetType); - reaction->beam = beam = make_s_Beam(); - beam->type = beamType; - beam->properties = make_s_Properties(); - beam->properties->charge = ParticleCharge(beamType); - beam->properties->mass = ParticleMass(beamType); - beam->momentum = make_s_Momentum(); - - } - - void write(tmpEvt_t evt, int eventNum) { - init(10000); - phyEvt->in[0].eventNo = eventNum; - reaction->vertices = vertices = make_s_Vertices(1); - vertices->mult = 1; - vertices->in[0].origin = origin = make_s_Origin(); - vertices->in[0].products = products = make_s_Products(evt.nGen); - - origin->t = 0.0; - origin->vx = 0.0; - origin->vy = 0.0; - origin->vz = 0.0; - - beam->momentum->px = evt.beam.Px(); - beam->momentum->py = evt.beam.Py(); - beam->momentum->pz = evt.beam.Pz(); - beam->momentum->E = evt.beam.E(); - - products->mult = evt.nGen; - reaction->weight = evt.weight; - - //PRODUCED ELECTRON - products->in[0].type = Electron; - products->in[0].pdgtype = 11; - products->in[0].id = 1; - products->in[0].parentid = 0; - products->in[0].mech = 0; - products->in[0].momentum = make_s_Momentum(); - products->in[0].momentum->px = evt.q1.Px(); - products->in[0].momentum->py = evt.q1.Py(); - products->in[0].momentum->pz = evt.q1.Pz(); - products->in[0].momentum->E = evt.q1.E(); - - //PRODUCED ELECTRON - products->in[1].type = Positron; - products->in[1].pdgtype = -11; - products->in[1].id = 2; - products->in[1].parentid = 0; - products->in[1].mech = 0; - products->in[1].momentum = make_s_Momentum(); - products->in[1].momentum->px = evt.q2.Px(); - products->in[1].momentum->py = evt.q2.Py(); - products->in[1].momentum->pz = evt.q2.Pz(); - products->in[1].momentum->E = evt.q2.E(); - - //RECOIL - if (evt.rxn == 2) {//set type - products->in[2].type = Proton; - products->in[2].pdgtype = 2212; - } else { - products->in[2].type = Electron; - products->in[2].pdgtype = 11; - } - products->in[2].id = 3; - products->in[2].parentid = 0; - products->in[2].mech = 0; - products->in[2].momentum = make_s_Momentum(); - products->in[2].momentum->px = evt.recoil.Px(); - products->in[2].momentum->py = evt.recoil.Py(); - products->in[2].momentum->pz = evt.recoil.Pz(); - products->in[2].momentum->E = evt.recoil.E(); - - flush_s_HDDM(hddmEvt, ostream); - - } -}; - -#endif /* HDDMOUT_H_ */ diff --git a/src/programs/Simulation/gen_ee/code/SConscript b/src/programs/Simulation/gen_ee/code/SConscript deleted file mode 100644 index 22157010e0..0000000000 --- a/src/programs/Simulation/gen_ee/code/SConscript +++ /dev/null @@ -1,13 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -env = env.Clone() - -sbms.AddHDDM(env) -sbms.AddROOT(env) -sbms.executable(env, 'ee_mc') -#sbms.executable(env) diff --git a/src/programs/Simulation/gen_ee/code/devilTreePT.h b/src/programs/Simulation/gen_ee/code/devilTreePT.h deleted file mode 100644 index cfee0fd56a..0000000000 --- a/src/programs/Simulation/gen_ee/code/devilTreePT.h +++ /dev/null @@ -1,59 +0,0 @@ -struct devilTreePT_t { - //Int_t nGen; - Double_t eGamma; - Double_t weight; - Double_t recoilE; - Double_t recoilPx; - Double_t recoilPy; - Double_t recoilPz; - Double_t electronE; - Double_t electronPx; - Double_t electronPy; - Double_t electronPz; - Double_t positronE; - Double_t positronPx; - Double_t positronPy; - Double_t positronPz; -}; - -void setBranchesT1(TTree *t1, devilTreePT_t *devilTree){ - t1->Branch("devilTree.eGamma",&devilTree->eGamma,"eGamma/D"); - t1->Branch("devilTree.weight",&devilTree->weight,"weight/D"); - - t1->Branch("devilTree.recoilE",&devilTree->recoilE,"recoilE/D"); - t1->Branch("devilTree.recoilPx",&devilTree->recoilPx,"recoilPx/D"); - t1->Branch("devilTree.recoilPy",&devilTree->recoilPy,"recoilPy/D"); - t1->Branch("devilTree.recoilPz",&devilTree->recoilPz,"recoilPz/D"); - - t1->Branch("devilTree.electronE",&devilTree->electronE,"electronE/D"); - t1->Branch("devilTree.electronPx",&devilTree->electronPx,"electronPx/D"); - t1->Branch("devilTree.electronPy",&devilTree->electronPy,"electronPy/D"); - t1->Branch("devilTree.electronPz",&devilTree->electronPz,"electronPz/D"); - - t1->Branch("devilTree.positronE",&devilTree->positronE,"positronE/D"); - t1->Branch("devilTree.positronPx",&devilTree->positronPx,"positronPx/D"); - t1->Branch("devilTree.positronPy",&devilTree->positronPy,"positronPy/D"); - t1->Branch("devilTree.positronPz",&devilTree->positronPz,"positronPz/D"); -} - -void getBranchesT1(TTree *t1,devilTreePT_t *devilTree){ - t1->SetBranchAddress("devilTree.eGamma",&devilTree->eGamma); - t1->SetBranchAddress("devilTree.vsWeight",&devilTree->weight); - - t1->SetBranchAddress("devilTree.recoilE",&devilTree->recoilE); - t1->SetBranchAddress("devilTree.recoilPx",&devilTree->recoilPx); - t1->SetBranchAddress("devilTree.recoilPy",&devilTree->recoilPy); - t1->SetBranchAddress("devilTree.recoilPz",&devilTree->recoilPz); - - t1->SetBranchAddress("devilTree.electronE",&devilTree->electronE); - t1->SetBranchAddress("devilTree.electronPx",&devilTree->electronPx); - t1->SetBranchAddress("devilTree.electronPy",&devilTree->electronPy); - t1->SetBranchAddress("devilTree.electronPz",&devilTree->electronPz); - - t1->SetBranchAddress("devilTree.positronE",&devilTree->positronE); - t1->SetBranchAddress("devilTree.positronPx",&devilTree->positronPx); - t1->SetBranchAddress("devilTree.positronPy",&devilTree->positronPy); - t1->SetBranchAddress("devilTree.positronPz",&devilTree->positronPz); -} - - diff --git a/src/programs/Simulation/gen_ee/code/gen_ee.cc b/src/programs/Simulation/gen_ee/code/gen_ee.cc deleted file mode 100644 index 64983b7f96..0000000000 --- a/src/programs/Simulation/gen_ee/code/gen_ee.cc +++ /dev/null @@ -1,522 +0,0 @@ -#include -#include -#include "TTree.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "Riostream.h" -#include "TH1.h" -#include "TH2.h" -#include "TRandom3.h" -#include "qDevilLib.h" -#include "devilTreePT.h" -#include "HddmOut.h" - -//STRUCTURE TO KEEP THE CONFIGURATION SETTINGS -struct genSettings_t { - int beamType; //Type of beam (1 -> single energy; 2-> bremstrahlung spectrum) - int polDir; //beam polarization direction (0-> unpolarized; 1-> pol in x; 2->pol in y) - double eGammaInit; //incident photon energy - double eLower; //incident photon energy min (only used for beamType = 1) - double eUpper; //incident photon energy max (only used for beamType = 1) - int corrYes; //do screening and radiative corrections if corrYes = 1 - int nToGen; //number of events to generate - int prescale; //number of events between printing to terminal - int rSeed; //seed for random number generator - int tOut; //type of output file (1->ROOT; 2->HDDM) - int reaction; //reaction (2->pair; 3->triplet) - char outFile[80]; //name of output file - char inFileBrem[80]; //name of input root file that contains spectra histogram cobrem_vs_E -}; - -//FUNCTION PROTOTYPES -double ampSqPT(int type, int polDir, TLorentzVector target, TLorentzVector beam, - TLorentzVector recoil,TLorentzVector q1,TLorentzVector q2); -void printUsage(genSettings_t genSettings, int goYes); - -int main(int argc, char **argv){ - - char *argptr; - //SET THE DEFAULT CONFIGURATION SETTINGS - genSettings_t genSettings; - genSettings.reaction = 2; - genSettings.tOut = 1; - genSettings.polDir = 2; - genSettings.beamType = 1; - genSettings.eGammaInit = 9.0; - genSettings.eLower = 8.0; - genSettings.eUpper = 9.0; - genSettings.corrYes = 1; - genSettings.nToGen = 100000; - genSettings.prescale = 1000; - genSettings.rSeed = 103; - sprintf(genSettings.outFile,"genOut.root"); - sprintf(genSettings.inFileBrem,"cobrems.root"); - - char rootFile[80]; - sprintf(rootFile,"genOut.root"); - - char hddmFile[80]; - sprintf(hddmFile,"genOut.hddm"); - - int outFileSet = 0; - //COMMAND LINE PARSING - for (int i=1; iGet("cobrem_vs_E"); - TH1D* hGvsEout = (TH1D*)hGvsE->Clone("hGvsEout"); - hGvsEout->Reset(); - hGvsEout->Rebin(30); - int eBinLow = hGvsE->GetXaxis()->FindBin(genSettings.eLower); - int eBinHigh = hGvsE->GetXaxis()->FindBin(genSettings.eUpper); - hGvsE->GetXaxis()->SetRange(eBinLow,eBinHigh); - double gMax = hGvsE->GetMaximum(); - - //GET THE TRIPLET TO PAIR FRACTION HISTOGRAM NEEDED FOR RADIATIVE CORRECTIONS - TH1D* hcsFraction; - TFile *inCSfrac=new TFile("csFraction.root"); - hcsFraction=(TH1D*)inCSfrac->Get("hcsFraction"); - - //DEFINE OUTPUT FILE - - HddmOut hddmGo(hddmFile); - int evtNumber = 0; - - TFile *fout = new TFile(rootFile,"RECREATE"); - - // DEFINE TREE TO STORE THE DATA (SEE qDevilLib.h) - TTree *t1 = new TTree("t1","genDevilPairs"); - devilTreePT_t devilTree; - setBranchesT1(t1, &devilTree); - - //PRINT OUT THE SETTINGS - printUsage(genSettings,1); - - double PIval =2*atan2(1,0); - double alphaQED = 1.0/137.036; - double hbarcSqr = 389.37966; - double crossSection = 0.0; - double fullWeight; - double mElectron = 0.51099907e-3; - double mProton = 0.938; - //SETTING THE CUT PARAMETERS IS A - //BALANCING ACT BETWEEN SPEED OF CONVERGENCE - //AND MAKING SURE THAT THE PHASE SPACE IS COMPLETE - double Mcut= 5.0e-3; - if (genSettings.reaction == 3) Mcut= 20.0e-3; - if (genSettings.reaction == 2) Mcut= 1.0; - double qRcut = 1.0e-3; - if (genSettings.reaction == 2) qRcut= 2.0; - - //DEFINE SOME FOUR VECTORS - TLorentzVector beam(0.0,0.0,eGamma,eGamma); - TLorentzVector target; - if (genSettings.reaction == 2) target.SetPxPyPzE(0.0,0.0,0.0,mProton); - if (genSettings.reaction == 3) target.SetPxPyPzE(0.0,0.0,0.0,mElectron); - TLorentzVector wVec = beam + target; - TLorentzVector q1; //electron from pair - TLorentzVector q2; //positron from pair - TLorentzVector recoil; - TLorentzVector q12; - TLorentzVector q23; - TLorentzVector moTransfer; - - if (genSettings.reaction == 2) recoil.SetPxPyPzE(0.0,0.0,0.0,mProton); - if (genSettings.reaction == 3) recoil.SetPxPyPzE(0.0,0.0,0.0,mElectron); - - //DEFINE SOME HISTGRAMS - double wMax = sqrt(target.Mag2() + 2*eGamma*target.Mag()); - if (genSettings.beamType == 2) { - wMax = sqrt(target.Mag2() + 2*genSettings.eUpper*target.Mag()); - } - double m12MinSq = pow(q1.Mag() + q2.Mag(),2); - double m23MinSq = pow(q2.Mag() + recoil.Mag(),2); - double m12MaxSq = pow(wMax - recoil.Mag(),2); - double m23MaxSq = pow(wMax - q1.Mag(),2); - int nBinXY = sqrt(genSettings.nToGen/100); - TH2D* hPhaseSpaceR = new TH2D("hPhaseSpaceR","",nBinXY,m12MinSq,m12MaxSq,nBinXY,m23MinSq,m23MaxSq); - - - TRandom3 *random = new TRandom3; - random->SetSeed(genSettings.rSeed); - double sigmaVal; - PhasePT phaseGenR; //phase space object (based off Richards calculations) - phaseGenR.SetRCut(qRcut); - phaseGenR.SetM12Cut(Mcut); - phaseGenR.SetBeam(beam); - phaseGenR.SetTarget(target); - double phaseSpaceWeight = 0.0; - double sum=0.0; - double sum2=0.0; - - double sumTest1=0.0; - double sumTest2=0.0; - double sumTest3=0.0; - double sumTest4=0.0; - double sumTest5=0.0; - - int genVal; - int nTest = 0; - double yMax,yVal,testValY; - int eBin; - int nGen = 0; - int nSkip = 0; - //nSkip = 79992;//ASDF - for (int nGenTmp = 1; nGenTmp <= genSettings.nToGen; nGenTmp++) { - genVal = -1; - //MONTE CARLO THE COHERENT BREMSTRAHLUNG SPECTRUM - if (genSettings.beamType == 2){ - yMax = gMax*1.02; - yVal = 0.0; - testValY = yMax + 10.0; - while(testValY>yVal){//Monte Carlo the event to get brem spectrum - eGamma = random->Uniform(genSettings.eLower,genSettings.eUpper); //Grab a photon energy - testValY = random->Uniform(0.0,yMax); //Grab a test value - eBin = hGvsE->GetXaxis()->FindBin(eGamma); - yVal = hGvsE->GetBinContent(eBin); - } - hGvsEout->Fill(eGamma); - beam.SetPxPyPzE(0,0,eGamma,eGamma); - wVec = beam + target; - phaseGenR.SetBeam(beam); - } - while (genVal < 0) { - if (nGenTmp >= nSkip) nTest++; - //GENERATE THE PHASE SPACE EVENT - genVal = phaseGenR.Gen(random); - if (genVal == -1) sumTest1 += 1.0; - if (genVal == -2) sumTest2 += 1.0; - if (genVal == -3) sumTest3 += 1.0; - if (genVal == -4) sumTest4 += 1.0; - if (genVal == -5) sumTest5 += 1.0; - //NOTE: if (genVal < 0) then phase space not physical - } - if (nGenTmp < nSkip) continue; - nGen++; - - //GET PHASE SPACE WEIGHT - phaseSpaceWeight = phaseGenR.GetWeight(); - - //GET THE FOUR-VECTORS - beam = phaseGenR.GetBeam(); - target = phaseGenR.GetTarget(); - q1 = phaseGenR.GetQ1(); - q2 = phaseGenR.GetQ2(); - q12 = phaseGenR.GetQ12(); - q23 = phaseGenR.GetQ23(); - recoil = phaseGenR.GetRecoil(); - moTransfer = recoil - target; - - //FILL PHASE SPACE HISTOGRAM - hPhaseSpaceR->Fill(q12.Mag2(),q23.Mag2(),phaseSpaceWeight); - - //NOTE: Richard's calculation for the phase space gives small recoil momentum - //very high probability. To account for this, the phase space weight is large - //when the recoil is large. The problem is that these rare events have a large - //weight. The rare events should not be a problem, except that one needs to - //generate a huge number of events to get the proper value. Instead, in the case - //of triplet production, we can notice that every diagram has a corresponding - //diagram that has the recoil electon momentum switched with the momentum of the - //produced electron. This means that the cross section for the phase space where - // q1.P > recoil.P will give identical results to the cross section for the - //phase space where q1.P < recoil.P. Because of this symmetry between - //q1.P and recoil.P, we can calculate the cross sections for the case - //q1.P > recoil.P and just make sure that we account for the "lost" phase space. - //Since we already have to account for the unphysical parts of the phase space - //generation, accounting for the case where a1.P < recoil.P does not require - //any additional work at this point in the code. For pair production, luckily - //the rare events (high momentum protons) are so rare that I have not seen - //any instability in the cross section results due to the rare large-weight - //events. - if (genSettings.reaction == 3 && recoil.P() > q1.P()) continue; - //If you comment out the line above and generate triplets, you should - //notice that everything is fine with the cross sections except that - //at some point (usualy after a very large number of events) there is - //a spike in the cross section. - - //ADDITIONAL FACTORS TO GET CROSS SECTION (micro barns) - double fluxFactor = 4*beam.E()*(target.P() + target.E()); - double rhoFactor = 1.0/(8*recoil.E()*q12.P()); - double piFactor = pow(2*PIval,4-9)*pow(4*PIval,3); - - //SCREENING AND RADIATIVE CORRECTIONS - double bohrRadius = (1.0/alphaQED)*(1.0/mElectron); - double fH = 1.0/pow(1 + pow(bohrRadius*moTransfer.P()/2.0,2),2); - - double sHfactor = 1.0; - double sHfactorPair = pow(1.0 - fH,2); //Screening for pair production - double sHfactorTrip = 1.0 - pow(fH,2); //Screening for triplet production - - //RADIATIVE CORRECTIONS FOR PAIRS IS SIMPLY A COMMON FACTOR :) - double radFactor = 1.0; - double radFactorDelta = 0.0093; - double radFactorPair = 1.0+radFactorDelta; - //THE RADIATIVE CORRECTION FOR TRIPLETS IS THE SAME MAG AS FOR PAIRS - //THIS MEANS WE HAVE TO GET THE FRACTION OF TRIPLETS TO PAIRS AND - //SCALE THE radFactorDelta USING THE TRIPLET TO PAIR FRACTION - int eFracBin = hcsFraction->GetXaxis()->FindBin(beam.E()); - double csFrac = hcsFraction->GetBinContent(eFracBin); - double radFactorTrip = 1.0 + radFactorDelta/csFrac; - - //GET THE CROSS SECTION - if (genSettings.reaction == 2) { //PAIR PRODUCTION - radFactor = radFactorPair; - sHfactor = sHfactorPair; - crossSection = ampSqPT(2,genSettings.polDir,target,beam,recoil,q1,q2)*hbarcSqr*pow(alphaQED,3) - / fluxFactor * rhoFactor * piFactor; - } - if (genSettings.reaction == 3) { //TRIPLET PRODUCTION - radFactor = radFactorTrip; - sHfactor = sHfactorTrip; - crossSection = ampSqPT(3,genSettings.polDir,target,beam,recoil,q1,q2)*hbarcSqr*pow(alphaQED,3) - / fluxFactor * rhoFactor * piFactor; - } - - if (genSettings.corrYes == 1) { - crossSection *= sHfactor; - crossSection *= radFactor; - } - - //GET INITIAL fullWeight - fullWeight = crossSection*phaseSpaceWeight; - - //CHECK FOR SOMETHING BAD - if (fullWeight >= 0 || fullWeight <=0){ - //do nothing - } else { - cout<<"!!!!Something Bad!!!!"<Fill(); - - //CALCULATING CROSS SECTION ERROR (SAME WAY THAT RICHARD DOES) AND PRINT RESULT - sum += fullWeight; - sum2 += pow(fullWeight,2); - - if (nGen/genSettings.prescale*genSettings.prescale == nGen) { - cout <<"Integrated cross section after " << nGen << " events : " - << sum/nGen << " +/- " <cd(); - t1->Write(); - hPhaseSpaceR->Write(); - hGvsEout->Write(); - } - fout->Close(); - cout<<"All done. Bye"<\tReaction:\n"); - fprintf(stderr,"\t\t-R2 = Pair production off of proton\n"); - fprintf(stderr,"\t\t-R3 = Triplet production\n"); - fprintf(stderr,"-n\tNumber of events to generate\n"); - fprintf(stderr,"-r\tUser defined random number seed\n"); - - fprintf(stderr,"-t\tType of output file\n"); - fprintf(stderr,"\t\t-t1 = ROOT file\n"); - fprintf(stderr,"\t\t-t2 = HDDM file\n"); - - fprintf(stderr,"-p\tPrescale factor (number of events between printing to terminal)\n"); - fprintf(stderr,"-P\tPhoton beam polarization direction:\n"); - fprintf(stderr,"\t\t-P0 = Unpolarized\n"); - fprintf(stderr,"\t\t-P2 = Polarized in x-direction (100 percent)\n"); - fprintf(stderr,"\t\t-P3 = Polarized in y-direction (100 percent)\n"); - fprintf(stderr,"-b\tBeam type:\n"); - fprintf(stderr,"\t\t-b1 = Single photon energy\n"); - fprintf(stderr,"\t\t-b2 = Bremstrahlung spectra\n"); - fprintf(stderr,"-e\tPhoton energy in GeV. ONLY USED IF -b1\n"); - fprintf(stderr,"-l\tMinimum incident photon energy in GeV. ONLY USED IF -b2\n"); - fprintf(stderr,"-u\tMaximum incident photon energy in GeV. ONLY USED IF -b2\n"); - fprintf(stderr,"-s\tfile with histogram cobrem_vs_E. ONLY USED IF -b2\n"); - fprintf(stderr,"-o\tOutFile name\n"); - - cout<<""< If providing custom photon spectrum histogram:"< To be able to output in HDDM mode you must compile like:"< -#include -#include -#include -#include -#include -#include -#include "TRandom.h" -#include "TRandom3.h" -#include "TLorentzVector.h" -#include "TGenPhaseSpace.h" -#include "qDevilLib.h" - -// define overloaded + (plus) operator -Complx Complx::operator+ (const Complx& c) const -{ - Complx result; - result.real = (this->real + c.real); - result.imag = (this->imag + c.imag); - return result; -} -// define overloaded - (minus) operator -Complx Complx::operator- (const Complx& c) const -{ - Complx result; - result.real = (this->real - c.real); - result.imag = (this->imag - c.imag); - return result; -} - -// define overloaded * (mult) operator -Complx Complx::operator* (const Complx& c) const -{ - Complx result; - result.real = (this->real * c.real - this->imag * c.imag); - result.imag = (this->real * c.imag + c.real * this->imag); - return result; -} - -// define overloaded = (equal) operator -Complx Complx::operator= (const Complx& c) -{ - this->real = c.real; - this->imag = c.imag; - - return *this; -} - -void Complx::Show(void) -{ - cout<QedType == "scalar" && q.QedType == "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - result.scalar = (this->scalar + q.scalar); - result.QedType = "scalar"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - result.scalar0 = (this->scalar0 + q.scalar); - result.scalarX = (this->scalarX + q.scalar); - result.scalarY = (this->scalarY + q.scalar); - result.scalarZ = (this->scalarZ + q.scalar); - result.scalar5 = (this->scalar5 + q.scalar); - result.QedType = "scalar"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - result.scalar0 = (this->scalar + q.scalar0); - result.scalarX = (this->scalar + q.scalarX); - result.scalarY = (this->scalar + q.scalarY); - result.scalarZ = (this->scalar + q.scalarZ); - result.scalar5 = (this->scalar + q.scalar5); - result.QedType = "scalar"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - result.scalar0 = (this->scalar0 + q.scalar0); - result.scalarX = (this->scalarX + q.scalarX); - result.scalarY = (this->scalarY + q.scalarY); - result.scalarZ = (this->scalarZ + q.scalarZ); - result.scalar5 = (this->scalar5 + q.scalar5); - result.QedType = "scalar"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED SCALAR + SCALAR - //START SCALAR + MATRIX - if (this->QedType == "scalar" && q.QedType == "matrix") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix[i][j] = (q.matrix[i][j]); - } else { - result.matrix[i][j] = (this->scalar + q.matrix[i][j]); - } - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (q.matrix[i][j]); - result.matrixX[i][j] = (q.matrix[i][j]); - result.matrixY[i][j] = (q.matrix[i][j]); - result.matrixZ[i][j] = (q.matrix[i][j]); - result.matrix5[i][j] = (q.matrix[i][j]); - } else { - result.matrix0[i][j] = (this->scalar0 + q.matrix[i][j]); - result.matrixX[i][j] = (this->scalarX + q.matrix[i][j]); - result.matrixY[i][j] = (this->scalarY + q.matrix[i][j]); - result.matrixZ[i][j] = (this->scalarZ + q.matrix[i][j]); - result.matrix5[i][j] = (this->scalar5 + q.matrix[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (q.matrix0[i][j]); - result.matrixX[i][j] = (q.matrixX[i][j]); - result.matrixY[i][j] = (q.matrixY[i][j]); - result.matrixZ[i][j] = (q.matrixZ[i][j]); - result.matrix5[i][j] = (q.matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->scalar + q.matrix0[i][j]); - result.matrixX[i][j] = (this->scalar + q.matrixX[i][j]); - result.matrixY[i][j] = (this->scalar + q.matrixY[i][j]); - result.matrixZ[i][j] = (this->scalar + q.matrixZ[i][j]); - result.matrix5[i][j] = (this->scalar + q.matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (q.matrix0[i][j]); - result.matrixX[i][j] = (q.matrixX[i][j]); - result.matrixY[i][j] = (q.matrixY[i][j]); - result.matrixZ[i][j] = (q.matrixZ[i][j]); - result.matrix5[i][j] = (q.matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->scalar0 + q.matrix0[i][j]); - result.matrixX[i][j] = (this->scalarX + q.matrixX[i][j]); - result.matrixY[i][j] = (this->scalarY + q.matrixY[i][j]); - result.matrixZ[i][j] = (this->scalarZ + q.matrixZ[i][j]); - result.matrix5[i][j] = (this->scalar5 + q.matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED SCALAR + MATRIX - //START MATRIX + SCALAR - if (this->QedType == "matrix" && q.QedType == "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix[i][j] = (this->matrix[i][j]); - } else { - result.matrix[i][j] = (q.scalar + this->matrix[i][j]); - } - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j]); - } else { - result.matrix0[i][j] = (q.scalar + this->matrix0[i][j]); - result.matrixX[i][j] = (q.scalar + this->matrixX[i][j]); - result.matrixY[i][j] = (q.scalar + this->matrixY[i][j]); - result.matrixZ[i][j] = (q.scalar + this->matrixZ[i][j]); - result.matrix5[i][j] = (q.scalar + this->matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix[i][j]); - result.matrixX[i][j] = (this->matrix[i][j]); - result.matrixY[i][j] = (this->matrix[i][j]); - result.matrixZ[i][j] = (this->matrix[i][j]); - result.matrix5[i][j] = (this->matrix[i][j]); - } else { - result.matrix0[i][j] = (q.scalar0 + this->matrix[i][j]); - result.matrixX[i][j] = (q.scalarX + this->matrix[i][j]); - result.matrixY[i][j] = (q.scalarY + this->matrix[i][j]); - result.matrixZ[i][j] = (q.scalarZ + this->matrix[i][j]); - result.matrix5[i][j] = (q.scalar5 + this->matrix[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j]); - } else { - result.matrix0[i][j] = (q.scalar0 + this->matrix0[i][j]); - result.matrixX[i][j] = (q.scalarX + this->matrixX[i][j]); - result.matrixY[i][j] = (q.scalarY + this->matrixY[i][j]); - result.matrixZ[i][j] = (q.scalarZ + this->matrixZ[i][j]); - result.matrix5[i][j] = (q.scalar5 + this->matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED MATRIX + SCALAR - //START !SCALAR + !SCALAR - if (this->QedType != "scalar" && q.QedType != "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = (this->matrix[i][j] + q.matrix[i][j]); - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix0[i][j] + q.matrix[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j] + q.matrix[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j] + q.matrix[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j] + q.matrix[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j] + q.matrix[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix[i][j] + q.matrix0[i][j]); - result.matrixX[i][j] = (this->matrix[i][j] + q.matrixX[i][j]); - result.matrixY[i][j] = (this->matrix[i][j] + q.matrixY[i][j]); - result.matrixZ[i][j] = (this->matrix[i][j] + q.matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix[i][j] + q.matrix5[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix0[i][j] + q.matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j] + q.matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j] + q.matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j] + q.matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j] + q.matrix5[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - }//FINISHED !SCALAR + !SCALAR - return result; -} //FINISHED DEFINING + - -// define overloaded - (minus) operator -QedElement QedElement::operator- (const QedElement& q) const -{ - QedElement result; - //START SCALAR - SCALAR - Complx Zero(0.0,0.0); - if (this->QedType == "scalar" && q.QedType == "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - result.scalar = (this->scalar - q.scalar); - result.QedType = "scalar"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - result.scalar0 = (this->scalar0 - q.scalar); - result.scalarX = (this->scalarX - q.scalar); - result.scalarY = (this->scalarY - q.scalar); - result.scalarZ = (this->scalarZ - q.scalar); - result.scalar5 = (this->scalar5 - q.scalar); - result.QedType = "scalar"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - result.scalar0 = (this->scalar - q.scalar0); - result.scalarX = (this->scalar - q.scalarX); - result.scalarY = (this->scalar - q.scalarY); - result.scalarZ = (this->scalar - q.scalarZ); - result.scalar5 = (this->scalar - q.scalar5); - result.QedType = "scalar"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - result.scalar0 = (this->scalar0 - q.scalar0); - result.scalarX = (this->scalarX - q.scalarX); - result.scalarY = (this->scalarY - q.scalarY); - result.scalarZ = (this->scalarZ - q.scalarZ); - result.scalar5 = (this->scalar5 - q.scalar5); - result.QedType = "scalar"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED SCALAR - SCALAR - //START SCALAR - MATRIX - if (this->QedType == "scalar" && q.QedType == "matrix") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix[i][j] = (Zero - q.matrix[i][j]); - } else { - result.matrix[i][j] = (this->scalar - q.matrix[i][j]); - } - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (Zero - q.matrix[i][j]); - result.matrixX[i][j] = (Zero - q.matrix[i][j]); - result.matrixY[i][j] = (Zero - q.matrix[i][j]); - result.matrixZ[i][j] = (Zero - q.matrix[i][j]); - result.matrix5[i][j] = (Zero - q.matrix[i][j]); - } else { - result.matrix0[i][j] = (this->scalar0 - q.matrix[i][j]); - result.matrixX[i][j] = (this->scalarX - q.matrix[i][j]); - result.matrixY[i][j] = (this->scalarY - q.matrix[i][j]); - result.matrixZ[i][j] = (this->scalarZ - q.matrix[i][j]); - result.matrix5[i][j] = (this->scalar5 - q.matrix[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (Zero - q.matrix0[i][j]); - result.matrixX[i][j] = (Zero - q.matrixX[i][j]); - result.matrixY[i][j] = (Zero - q.matrixY[i][j]); - result.matrixZ[i][j] = (Zero - q.matrixZ[i][j]); - result.matrix5[i][j] = (Zero - q.matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->scalar - q.matrix0[i][j]); - result.matrixX[i][j] = (this->scalar - q.matrixX[i][j]); - result.matrixY[i][j] = (this->scalar - q.matrixY[i][j]); - result.matrixZ[i][j] = (this->scalar - q.matrixZ[i][j]); - result.matrix5[i][j] = (this->scalar - q.matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (Zero - q.matrix0[i][j]); - result.matrixX[i][j] = (Zero - q.matrixX[i][j]); - result.matrixY[i][j] = (Zero - q.matrixY[i][j]); - result.matrixZ[i][j] = (Zero - q.matrixZ[i][j]); - result.matrix5[i][j] = (Zero - q.matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->scalar0 - q.matrix0[i][j]); - result.matrixX[i][j] = (this->scalarX - q.matrixX[i][j]); - result.matrixY[i][j] = (this->scalarY - q.matrixY[i][j]); - result.matrixZ[i][j] = (this->scalarZ - q.matrixZ[i][j]); - result.matrix5[i][j] = (this->scalar5 - q.matrix5[i][j]); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED SCALAR - MATRIX - //START MATRIX - SCALAR - if (this->QedType == "matrix" && q.QedType == "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix[i][j] = (this->matrix[i][j]); - } else { - result.matrix[i][j] = (this->matrix[i][j] - q.scalar); - } - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->matrix0[i][j] - q.scalar); - result.matrixX[i][j] = (this->matrixX[i][j] - q.scalar); - result.matrixY[i][j] = (this->matrixY[i][j] - q.scalar); - result.matrixZ[i][j] = (this->matrixZ[i][j] - q.scalar); - result.matrix5[i][j] = (this->matrix5[i][j] - q.scalar); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix[i][j]); - result.matrixX[i][j] = (this->matrix[i][j]); - result.matrixY[i][j] = (this->matrix[i][j]); - result.matrixZ[i][j] = (this->matrix[i][j]); - result.matrix5[i][j] = (this->matrix[i][j]); - } else { - result.matrix0[i][j] = (this->matrix[i][j] - q.scalar0); - result.matrixX[i][j] = (this->matrix[i][j] - q.scalarX); - result.matrixY[i][j] = (this->matrix[i][j] - q.scalarY); - result.matrixZ[i][j] = (this->matrix[i][j] - q.scalarZ); - result.matrix5[i][j] = (this->matrix[i][j] - q.scalar5); - } - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - if (i != j) { - result.matrix0[i][j] = (this->matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j]); - } else { - result.matrix0[i][j] = (this->matrix0[i][j] - q.scalar); - result.matrixX[i][j] = (this->matrixX[i][j] - q.scalar); - result.matrixY[i][j] = (this->matrixY[i][j] - q.scalar); - result.matrixZ[i][j] = (this->matrixZ[i][j] - q.scalar); - result.matrix5[i][j] = (this->matrix5[i][j] - q.scalar); - } - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - } //FINISHED MATRIX - SCALAR - //START !SCALAR - !SCALAR - if (this->QedType != "scalar" && q.QedType != "scalar") { - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = (this->matrix[i][j] - q.matrix[i][j]); - } - } - result.QedType = "matrix"; - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix0[i][j] - q.matrix[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j] - q.matrix[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j] - q.matrix[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j] - q.matrix[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j] - q.matrix[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix[i][j] - q.matrix0[i][j]); - result.matrixX[i][j] = (this->matrix[i][j] - q.matrixX[i][j]); - result.matrixY[i][j] = (this->matrix[i][j] - q.matrixY[i][j]); - result.matrixZ[i][j] = (this->matrix[i][j] - q.matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix[i][j] - q.matrix5[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = q.lIndexName; - result.lIndexName = q.lIndexPosition; - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix0[i][j] - q.matrix0[i][j]); - result.matrixX[i][j] = (this->matrixX[i][j] - q.matrixX[i][j]); - result.matrixY[i][j] = (this->matrixY[i][j] - q.matrixY[i][j]); - result.matrixZ[i][j] = (this->matrixZ[i][j] - q.matrixZ[i][j]); - result.matrix5[i][j] = (this->matrix5[i][j] - q.matrix5[i][j]); - } - } - result.QedType = "matrix"; - result.lIndexName = this->lIndexName; - result.lIndexName = this->lIndexPosition; - } - }//FINISHED !SCALAR - !SCALAR - return result; -} //FINISHED DEFINING - - - - -// define overloaded * (mult) operator -QedElement QedElement::operator* (const QedElement& q) const -{ - QedElement result; - //START SCALAR * SCALAR - if (this->QedType == "scalar" && q.QedType == "scalar") { - result.SetZeroNone(); - result.QedType = "scalar"; - if (this->lIndexName == "none" && q.lIndexName == "none"){ - result.scalar = (this->scalar * q.scalar); - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - result.scalar0 = (this->scalar0 * q.scalar); - result.scalarX = (this->scalarX * q.scalar); - result.scalarY = (this->scalarY * q.scalar); - result.scalarZ = (this->scalarZ * q.scalar); - result.scalar5 = (this->scalar5 * q.scalar); - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - result.scalar0 = (this->scalar * q.scalar0); - result.scalarX = (this->scalar * q.scalarX); - result.scalarY = (this->scalar * q.scalarY); - result.scalarZ = (this->scalar * q.scalarZ); - result.scalar5 = (this->scalar * q.scalar5); - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - result.scalar = ( - this->scalar0 * q.scalar0 - - this->scalarX * q.scalarX - - this->scalarY * q.scalarY - - this->scalarZ * q.scalarZ); - } - } //FINISHED SCALAR * SCALAR - //START SCALAR * !SCALAR - if (this->QedType == "scalar" && q.QedType != "scalar") { - result.SetZeroNone(); - result.QedType = q.QedType; - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = (this->scalar * q.matrix[i][j]); - } - } - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->scalar0 * q.matrix[i][j]); - result.matrixX[i][j] = (this->scalarX * q.matrix[i][j]); - result.matrixY[i][j] = (this->scalarY * q.matrix[i][j]); - result.matrixZ[i][j] = (this->scalarZ * q.matrix[i][j]); - result.matrix5[i][j] = (this->scalar5 * q.matrix[i][j]); - } - } - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->scalar * q.matrix0[i][j]); - result.matrixX[i][j] = (this->scalar * q.matrixX[i][j]); - result.matrixY[i][j] = (this->scalar * q.matrixY[i][j]); - result.matrixZ[i][j] = (this->scalar * q.matrixZ[i][j]); - result.matrix5[i][j] = (this->scalar * q.matrix5[i][j]); - } - } - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->scalar0 * q.matrix0[i][j] - - this->scalarX * q.matrixX[i][j] - - this->scalarY * q.matrixY[i][j] - - this->scalarZ * q.matrixZ[i][j]); - } - } - } - } //FINISHED SCALAR * !SCALAR - //START !SCALAR * SCALAR - if (this->QedType != "scalar" && q.QedType == "scalar") { - result.SetZeroNone(); - result.QedType = q.QedType; - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = (this->matrix[i][j] * q.scalar); - } - } - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix0[i][j] * q.scalar); - result.matrixX[i][j] = (this->matrixX[i][j] * q.scalar); - result.matrixY[i][j] = (this->matrixY[i][j] * q.scalar); - result.matrixZ[i][j] = (this->matrixZ[i][j] * q.scalar); - result.matrix5[i][j] = (this->matrix5[i][j] * q.scalar); - } - } - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = (this->matrix[i][j] * q.scalar0); - result.matrixX[i][j] = (this->matrix[i][j] * q.scalarX); - result.matrixY[i][j] = (this->matrix[i][j] * q.scalarY); - result.matrixZ[i][j] = (this->matrix[i][j] * q.scalarZ); - result.matrix5[i][j] = (this->matrix[i][j] * q.scalar5); - } - } - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = (this->matrix0[i][j] * q.scalar0 - - this->matrixX[i][j] * q.scalarX - - this->matrixY[i][j] * q.scalarY - - this->matrixZ[i][j] * q.scalarZ); - } - } - } - } //FINISHED !SCALAR * SCALAR - //START !SCALAR * !SCALAR - if (this->QedType != "scalar" && q.QedType != "scalar") { - Complx zero(0.0,0.0); - result.SetZeroNone(); - if (this->lIndexName == "none" && q.lIndexName == "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = zero; - for (int k=0; k<4; k++) { - result.matrix[i][j] = result.matrix[i][j] + (this->matrix[i][k] * q.matrix[k][j]); - } - } - } - } - if (this->lIndexName != "none" && q.lIndexName == "none"){ - result.lIndexName = this->lIndexName; - result.lIndexPosition = this->lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = zero; - result.matrixX[i][j] = zero; - result.matrixY[i][j] = zero; - result.matrixZ[i][j] = zero; - result.matrix5[i][j] = zero; - for (int k=0; k<4; k++) { - result.matrix0[i][j] = result.matrix0[i][j] + (this->matrix0[i][k] * q.matrix[k][j]); - result.matrixX[i][j] = result.matrixX[i][j] + (this->matrixX[i][k] * q.matrix[k][j]); - result.matrixY[i][j] = result.matrixY[i][j] + (this->matrixY[i][k] * q.matrix[k][j]); - result.matrixZ[i][j] = result.matrixZ[i][j] + (this->matrixZ[i][k] * q.matrix[k][j]); - result.matrix5[i][j] = result.matrix5[i][j] + (this->matrix5[i][k] * q.matrix[k][j]); - } - } - } - } - if (this->lIndexName == "none" && q.lIndexName != "none"){ - result.lIndexName = q.lIndexName; - result.lIndexPosition = q.lIndexPosition; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix0[i][j] = zero; - result.matrixX[i][j] = zero; - result.matrixY[i][j] = zero; - result.matrixZ[i][j] = zero; - result.matrix5[i][j] = zero; - for (int k=0; k<4; k++) { - result.matrix0[i][j] = result.matrix0[i][j] + (this->matrix[i][k] * q.matrix0[k][j]); - result.matrixX[i][j] = result.matrixX[i][j] + (this->matrix[i][k] * q.matrixX[k][j]); - result.matrixY[i][j] = result.matrixY[i][j] + (this->matrix[i][k] * q.matrixY[k][j]); - result.matrixZ[i][j] = result.matrixZ[i][j] + (this->matrix[i][k] * q.matrixZ[k][j]); - result.matrix5[i][j] = result.matrix5[i][j] + (this->matrix[i][k] * q.matrix5[k][j]); - } - } - } - } - if (this->lIndexName != "none" && q.lIndexName != "none"){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - result.matrix[i][j] = zero; - for (int k=0; k<4; k++) { - result.matrix[i][j] = result.matrix[i][j] + (this->matrix0[i][k] * q.matrix0[k][j] - - this->matrixX[i][k] * q.matrixX[k][j] - - this->matrixY[i][k] * q.matrixY[k][j] - - this->matrixZ[i][k] * q.matrixZ[k][j]); - } - } - } - } - if (this->QedType == "matrix" && q.QedType == "matrix") { - result.QedType = "matrix"; - } - if (this->QedType == "matrix" && q.QedType == "vector") { - result.QedType = "vector"; - } - if (this->QedType == "matrix" && q.QedType == "vectorT") { - result.QedType = "matrix"; - } - if (this->QedType == "vector" && q.QedType == "matrix") { - result.QedType = "matrix"; - } - if (this->QedType == "vectorT" && q.QedType == "matrix") { - result.QedType = "vectorT"; - } - if (this->QedType == "vector" && q.QedType == "vectorT") { - result.QedType = "matrix"; - } - if (this->QedType == "vectorT" && q.QedType == "vector") { - result.QedType = "scalar"; - result.scalar = result.matrix[0][0]; - result.scalar0 = result.matrix0[0][0]; - result.scalarX = result.matrixX[0][0]; - result.scalarY = result.matrixY[0][0]; - result.scalarZ = result.matrixZ[0][0]; - result.scalar5 = result.matrix5[0][0]; - } - }//FINISHED !SCALAR * !SCALAR - - return result; - -} -// define overloaded = (equal) operator -QedElement QedElement::operator= (const QedElement& q) -{ - QedElement result; - this->scalar = q.scalar; - this->scalar0 = q.scalar0; - this->scalarX = q.scalarX; - this->scalarY = q.scalarY; - this->scalarZ = q.scalarZ; - this->scalar5 = q.scalar5; - - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - this->matrix[i][j] = q.matrix[i][j]; - this->matrix0[i][j] = q.matrix0[i][j]; - this->matrixX[i][j] = q.matrixX[i][j]; - this->matrixY[i][j] = q.matrixY[i][j]; - this->matrixZ[i][j] = q.matrixZ[i][j]; - this->matrix5[i][j] = q.matrix5[i][j]; - } - } - this->QedType = q.QedType; - this->lIndexName = q.lIndexName; - this->lIndexPosition = q.lIndexPosition; - return *this; -} -void QedElement::SetScalar(Complx sVal){ - SetZeroNone(); - QedType = "scalar"; - scalar = sVal; -} - -void QedElement::SetZeroNone(){ - QedType = "none"; - lIndexName = "none"; - lIndexPosition = 0; - scalar.Set(0,0); - scalar0.Set(0,0); - scalarX.Set(0,0); - scalarY.Set(0,0); - scalarZ.Set(0,0); - scalar5.Set(0,0); - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j].Set(0,0); - matrix0[i][j].Set(0,0); - matrixX[i][j].Set(0,0); - matrixY[i][j].Set(0,0); - matrixZ[i][j].Set(0,0); - matrix5[i][j].Set(0,0); - } - } -} -void QedElement::SetGamma(string lIndexNameVal){ - SetZeroNone(); - lIndexName = lIndexNameVal; - lIndexPosition = 1; - QedType = "matrix"; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix0[i][j] = gamma0[i][j]; - matrixX[i][j] = gammaX[i][j]; - matrixY[i][j] = gammaY[i][j]; - matrixZ[i][j] = gammaZ[i][j]; - matrix5[i][j] = gamma5[i][j]; - } - } -} -void QedElement::Star(){ - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j] = matrix[i][j].Star(); - matrix0[i][j] = matrix0[i][j].Star(); - matrixX[i][j] = matrixX[i][j].Star(); - matrixY[i][j] = matrixY[i][j].Star(); - matrixZ[i][j] = matrixZ[i][j].Star(); - matrix5[i][j] = matrix5[i][j].Star(); - } - } - scalar = scalar.Star(); -} -void QedElement::Transpose(){ - Complx tmpMatrix[4][4], - tmpMatrix0[4][4], - tmpMatrixX[4][4], - tmpMatrixY[4][4], - tmpMatrixZ[4][4], - tmpMatrix5[4][4]; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - tmpMatrix[j][i] = matrix[i][j]; - tmpMatrix0[j][i] = matrix0[i][j]; - tmpMatrixX[j][i] = matrixX[i][j]; - tmpMatrixY[j][i] = matrixY[i][j]; - tmpMatrixZ[j][i] = matrixZ[i][j]; - tmpMatrix5[j][i] = matrix5[i][j]; - } - } - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j] = tmpMatrix[i][j]; - matrix0[i][j] = tmpMatrix0[i][j]; - matrixX[i][j] = tmpMatrixX[i][j]; - matrixY[i][j] = tmpMatrixY[i][j]; - matrixZ[i][j] = tmpMatrixZ[i][j]; - matrix5[i][j] = tmpMatrix5[i][j]; - } - } - -} -void QedElement::SetU(double px,double py, - double pz,double mass, - int spin){ - SetZeroNone(); - QedType = "vector"; - - double energy,momentum,norm; - Complx a00,a10,a20,a30; - double tmpValR,tmpValI; - momentum = sqrt(pow(px,2)+pow(py,2)+pow(pz,2)); - energy = sqrt(pow(momentum,2) + pow(mass,2)); - norm = sqrt(energy + mass); - if (spin == 1) { - a00.Set(norm,0.0); - a10.Set(0.0,0.0); - - tmpValR = norm*pz/(energy + mass); - a20.Set(tmpValR,0.0); - - tmpValR = norm*px/(energy + mass); - tmpValI = norm*py/(energy + mass); - a30.Set(tmpValR,tmpValI); - - } - if (spin == -1) { - a00.Set(0.0,0.0); - a10.Set(norm,0.0); - - tmpValR = norm*px/(energy + mass); - tmpValI = -norm*py/(energy + mass); - a20.Set(tmpValR,tmpValI); - - tmpValR = -norm*pz/(energy + mass); - a30.Set(tmpValR,0.0); - - } - matrix[0][0] = a00; - matrix[1][0] = a10; - matrix[2][0] = a20; - matrix[3][0] = a30; -} -void QedElement::SetV(double px,double py, - double pz,double mass, - int spin){ - SetZeroNone(); - - double energy,momentum,norm; - double tmpValR,tmpValI; - Complx a00,a10,a20,a30; - QedType = "vector"; - momentum = sqrt(pow(px,2)+pow(py,2)+pow(pz,2)); - energy = sqrt(pow(momentum,2) + pow(mass,2)); - norm = sqrt(energy + mass); - if (spin == 1) { - tmpValR = norm*px/(energy + mass); - tmpValI = -norm*py/(energy + mass); - a00.Set(tmpValR,tmpValI); - - tmpValR = -norm*pz/(energy + mass); - a10.Set(tmpValR,0.0); - - a20.Set(0.0,0.0); - a30.Set(norm,0.0); - } - if (spin == -1) { - tmpValR = -norm*pz/(energy + mass); - a00.Set(tmpValR,0.0); - - tmpValR = -norm*px/(energy + mass); - tmpValI = -norm*py/(energy + mass); - a10.Set(tmpValR,tmpValI); - - a20.Set(-norm,0.0); - a30.Set(0.0,0.0); - } - matrix[0][0] = a00; - matrix[1][0] = a10; - matrix[2][0] = a20; - matrix[3][0] = a30; -} -void QedElement::SetUBar(double px,double py, - double pz,double mass, - int spin){ - Complx tmp[4][4]; - SetU(px,py,pz,mass,spin); - Star(); - Transpose(); - //Multiply Udagger by gamma0 - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - tmp[i][j] = 0.0; - for (int k=0; k<4; k++) { - tmp[i][j] = tmp[i][j] + (matrix[i][k] * gamma0[k][j]); - } - matrix[i][j] = tmp[i][j]; - } - } - - QedType = "vectorT"; -} -void QedElement::SetVBar(double px,double py, - double pz,double mass, - int spin){ - Complx tmp[4][4]; - SetV(px,py,pz,mass,spin); - Star(); - Transpose(); - //Multiply Udagger by gamma0 - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - tmp[i][j] = 0.0; - for (int k=0; k<4; k++) { - tmp[i][j] = tmp[i][j] + (matrix[i][k] * gamma0[k][j]); - } - matrix[i][j] = tmp[i][j]; - } - } - QedType = "vectorT"; -} -void QedElement::SetMomentumSlash(double px,double py, - double pz,double mass){ - SetZeroNone(); - double energy,momentum; - Complx cE,cPx,cPy,cPz; - momentum = sqrt(pow(px,2)+pow(py,2)+pow(pz,2)); - energy = sqrt(pow(momentum,2) + pow(mass,2)); - cE.Set(energy,0.0); - cPx.Set(-px,0.0); - cPy.Set(-py,0.0); - cPz.Set(-pz,0.0); - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j] = cE * gamma0[i][j] + - cPx* gammaX[i][j] + - cPy* gammaY[i][j] + - cPz* gammaZ[i][j]; - } - } - QedType = "matrix"; -} -void QedElement::SetEpsilonSlash(double cx,double cy, - double cz){ - SetZeroNone(); - Complx cCx,cCy,cCz; - cCx.Set(-cx,0.0); - cCy.Set(-cy,0.0); - cCz.Set(-cz,0.0); - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j] = cCx*gammaX[i][j] + - cCy*gammaY[i][j] + - cCz*gammaZ[i][j]; - } - } - QedType = "matrix"; -} -void QedElement::ShowMatrix(int matNumber){ - if (matNumber == -1) { - double rVal,iVal; - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - rVal = matrix[i][j].r(); - iVal = matrix[i][j].i(); - cout<<"("<= 0 || mAmplSqSum <=0){ - //do nothing - } else { - cout<<"!!!!!Bad Event!!!!!"<Uniform(event_E0); - event_weight *= event_E0; - - // generate phi12 uniform on [0,2pi] - event_phi12 = random->Uniform(2*PIval); - event_weight *= 2*PIval; - - // generate phiR uniform on [0,2pi] - event_phiR = random->Uniform(2*PIval); - event_weight *= 2*PIval; - - // generate Mpair with weight (1/M) / (Mcut^2 + M^2) - Double_t Mmin=2*mElectron; - Double_t Mcut=m12Cut; - Double_t um0 = 1 + pow(Mcut/Mmin,2); - Double_t um = pow(um0,random->Uniform(1)); - event_Mpair = Mcut/sqrt(um-1); - event_weight *= event_Mpair*(pow(Mcut,2)+pow(event_Mpair,2)) - *log(um0)/(2*pow(Mcut,2)); - - // generate qR^2 with weight (1/qR^2) / sqrt(qRcut^2 + qR^2) - Double_t qRmin = pow(event_Mpair,2)/(2*event_E0); - Double_t qRcut = rCut; - Double_t uq0 = qRmin/(qRcut+sqrt(pow(qRcut,2)+pow(qRmin,2))); - Double_t uq = pow(uq0,random->Uniform(1)); - event_qR2 = pow(2*qRcut*uq/pow(1-pow(uq,2),2),2); - event_weight *= event_qR2*sqrt(1+event_qR2/pow(qRcut,2)) - *(-2*log(uq0)); - - // overall measure Jacobian factor - event_weight *= event_Mpair/(2*event_E0); - - // compute recoil polar angle thetaR - Double_t E3 = sqrt(event_qR2 + target.Mag2()); - Double_t costhetaR = (pow(event_Mpair,2)/2 + (kin + target.Mag())*(E3-target.Mag()) - )/(kin*sqrt(event_qR2)); - - int killVal = 0; - if (fabs(costhetaR) > 1) { - //cout << "no kinematic solution because |costhetaR| > 1" << endl; - event_thetaR = 99; - killVal = 1; - } - else { - event_thetaR = acos(costhetaR); - } - - - //RECOIL: - double moR = sqrt(event_qR2); - double eR = sqrt(pow(moR,2) + target.Mag2()); - double moRx = moR*cos(event_phiR)*sin(event_thetaR); - double moRy = moR*sin(event_phiR)*sin(event_thetaR); - double moRz = moR*cos(event_thetaR); - - //POSITRON: - double ePos = event_Epos; - Double_t k12star2 = pow(event_Mpair/2,2) - pow(mElectron,2); //mo^2 of e+ in Mpair rest frame - if (k12star2 < 0) { - //cout << "no kinematic solution because k12star2 < 0" << endl; - if (killVal == 0) killVal = 2; - //return 0; - } - - Double_t k12star = sqrt(k12star2); //mo of e+ in Mpair rest frame - Double_t E12 = event_E0 + target.Mag() - eR; //Energy of pair in lab frame - Double_t q12mag=sqrt(pow(E12,2) - pow(event_Mpair,2)); //momentum of pair in lab frame - Double_t costhetastar=(ePos-E12/2)*event_Mpair/(k12star*q12mag); //???? - if (fabs(costhetastar) > 1) { - //cout << "no kinematic solution because |costhetastar| > 1" << endl; - if (killVal == 0) killVal = 3; - if (killVal == 1) killVal = 4; - //return 0; - } - - Double_t sinthetastar = sqrt(1-pow(costhetastar,2)); - Double_t moK12starX = k12star*sinthetastar*cos(event_phi12); - Double_t moK12starY = k12star*sinthetastar*sin(event_phi12); - Double_t moK12starZ = k12star*costhetastar; - - TLorentzVector q1star(-moK12starX,-moK12starY,-moK12starZ,event_Mpair/2.0); - TLorentzVector q2star(moK12starX,moK12starY,moK12starZ,event_Mpair/2.0); - - if (killVal == 1110){ - cout<<"q1star P,E,M = "< m23Max) return -6; - if (q23.Mag2() < m23Min) return -7; - - return 1; -} - - - diff --git a/src/programs/Simulation/gen_ee/code/qDevilLib.h b/src/programs/Simulation/gen_ee/code/qDevilLib.h deleted file mode 100644 index a99404e611..0000000000 --- a/src/programs/Simulation/gen_ee/code/qDevilLib.h +++ /dev/null @@ -1,214 +0,0 @@ -#ifndef _QDEVILLIB_ -#define _QDEVILLIB_ - -using std::string; -using std::cout; -using std::endl; - -class PhasePT -{ - TLorentzVector beam; - TLorentzVector target; - TLorentzVector q1; - TLorentzVector q2; - TLorentzVector recoil; - TLorentzVector q12; - TLorentzVector q23; - double m12Cut; - double rCut; - double event_weight; - public: - TLorentzVector GetBeam(){return beam;} - TLorentzVector GetTarget(){return target;} - TLorentzVector GetQ1(){return q1;} - TLorentzVector GetQ2(){return q2;} - TLorentzVector GetQ12(){return q12;} - TLorentzVector GetQ23(){return q23;} - TLorentzVector GetRecoil(){return recoil;} - double GetWeight(){return event_weight;}; - void SetBeam(TLorentzVector beamIn){beam = beamIn;} - void SetTarget(TLorentzVector targetIn){target = targetIn;} - void SetM12Cut(double m12CutIn){m12Cut = m12CutIn;} - void SetRCut(double rCutIn){rCut = rCutIn;} - int Gen(TRandom3 *random); -}; - -class Complx -{ - double real, - imag; - public: - Complx( double r = 0., double i = 0.) { real = r; imag = i; } // constructor - Complx operator+(const Complx&) const; // operator+() - Complx operator-(const Complx&) const; // operator-() - Complx operator*(const Complx&) const; // operator*() - Complx operator=(const Complx&); // operator=() - void Show(); - void Set(double rVal,double iVal); - double r(){return real;} - double i(){return imag;} - Complx Star(){ - Complx starVal(real,-imag); - return starVal; - } - double Abs(){return sqrt(pow(real,2)+pow(imag,2));} -}; -/* -// define constructor -Complx::Complx( double r, double i ) -{ - real = r; imag = i; -} -*/ -///////////////////////////// -class QedElement -{ - Complx scalar,scalar0,scalarX,scalarY,scalarZ,scalar5; - Complx matrix[4][4], - matrix0[4][4], - matrixX[4][4], - matrixY[4][4], - matrixZ[4][4], - matrix5[4][4], - gamma0[4][4], - gammaX[4][4], - gammaY[4][4], - gammaZ[4][4], - gamma5[4][4]; - string QedType; - string lIndexName; - int lIndexPosition; - public: - QedElement() { // constructor - QedType = "none"; - lIndexName = "none"; - lIndexPosition = 0; - scalar.Set(0,0); - scalar0.Set(0,0); - scalarX.Set(0,0); - scalarY.Set(0,0); - scalarZ.Set(0,0); - scalar5.Set(0,0); - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j].Set(0,0); - matrix0[i][j].Set(0,0); - matrixX[i][j].Set(0,0); - matrixY[i][j].Set(0,0); - matrixZ[i][j].Set(0,0); - matrix5[i][j].Set(0,0); - gamma0[i][j].Set(0,0); - gammaX[i][j].Set(0,0); - gammaY[i][j].Set(0,0); - gammaZ[i][j].Set(0,0); - gamma5[i][j].Set(0,0); - } - } - //Gamma0 - gamma0[0][0].Set(1,0); - gamma0[1][1].Set(1,0); - gamma0[2][2].Set(-1,0); - gamma0[3][3].Set(-1,0); - //GammaX - gammaX[0][3].Set(1,0); - gammaX[1][2].Set(1,0); - gammaX[2][1].Set(-1,0); - gammaX[3][0].Set(-1,0); - //GammaY - gammaY[0][3].Set(0,-1); - gammaY[1][2].Set(0,1); - gammaY[2][1].Set(0,1); - gammaY[3][0].Set(0,-1); - //GammaZ - gammaZ[0][2].Set(1,0); - gammaZ[1][3].Set(-1,0); - gammaZ[2][0].Set(-1,0); - gammaZ[3][1].Set(1,0); - //Gamma5 - gamma5[0][2].Set(1,0); - gamma5[1][3].Set(1,0); - gamma5[2][0].Set(1,0); - gamma5[3][1].Set(1,0); - } - QedElement operator=(const QedElement&); // operator=() - QedElement operator*(const QedElement&) const; // operator*() - QedElement operator+(const QedElement&) const; // operator+() - QedElement operator-(const QedElement&) const; // operator-() - void SetGamma(string lIndexNameVal); - void SetZeroNone(); - void Transpose(); - void Star(); - void SetScalar(Complx sVal); - void SetU(double px,double py, - double pz,double mass,int spin); - void SetV(double px,double py, - double pz,double mass,int spin); - void SetUBar(double px,double py, - double pz,double mass,int spin); - void SetVBar(double px,double py, - double pz,double mass,int spin); - void SetMomentumSlash(double px,double py, - double pz,double mass); - void SetEpsilonSlash(double cx,double cy, - double cz); - Complx GetScalar(){return scalar;}; - void ShowAll(); - void ShowMatrix(int matNumber); -}; -/* -// define constructor -QedElement::QedElement() -{ - QedType = "none"; - lIndexName = "none"; - lIndexPosition = 0; - scalar.Set(0,0); - scalar0.Set(0,0); - scalarX.Set(0,0); - scalarY.Set(0,0); - scalarZ.Set(0,0); - scalar5.Set(0,0); - for (int i=0; i<4; i++) { - for (int j=0; j<4; j++) { - matrix[i][j].Set(0,0); - matrix0[i][j].Set(0,0); - matrixX[i][j].Set(0,0); - matrixY[i][j].Set(0,0); - matrixZ[i][j].Set(0,0); - matrix5[i][j].Set(0,0); - gamma0[i][j].Set(0,0); - gammaX[i][j].Set(0,0); - gammaY[i][j].Set(0,0); - gammaZ[i][j].Set(0,0); - gamma5[i][j].Set(0,0); - } - } - //Gamma0 - gamma0[0][0].Set(1,0); - gamma0[1][1].Set(1,0); - gamma0[2][2].Set(-1,0); - gamma0[3][3].Set(-1,0); - //GammaX - gammaX[0][3].Set(1,0); - gammaX[1][2].Set(1,0); - gammaX[2][1].Set(-1,0); - gammaX[3][0].Set(-1,0); - //GammaY - gammaY[0][3].Set(0,-1); - gammaY[1][2].Set(0,1); - gammaY[2][1].Set(0,1); - gammaY[3][0].Set(0,-1); - //GammaZ - gammaZ[0][2].Set(1,0); - gammaZ[1][3].Set(-1,0); - gammaZ[2][0].Set(-1,0); - gammaZ[3][1].Set(1,0); - //Gamma5 - gamma5[0][2].Set(1,0); - gamma5[1][3].Set(1,0); - gamma5[2][0].Set(1,0); - gamma5[3][1].Set(1,0); -} -*/ - -#endif // _QDEVILLIB_ diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/GPDs.cc b/src/programs/Simulation/gen_ee_hb/HallBTCS/GPDs.cc deleted file mode 100644 index 718a27f95a..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/GPDs.cc +++ /dev/null @@ -1,289 +0,0 @@ -#include "GPDs.hh" - -GPDs::GPDs(const char *file_name, int nn_q2, int nn_t, int nn_eta, double q2_, double t_, double eta_) -{ - fname = (char*)file_name; - n_q2 = nn_q2; - n_t = nn_t; - n_eta = nn_eta; - Q2 = q2_; - tM = -t_; // t -s real t, tM is -t - eta = eta_; - - arr_q2 = new double[n_q2]; - arr_t = new double[n_t]; - arr_eta = new double[n_eta]; - - ImH_2 = new double[n_q2*n_t*n_eta]; - ReH_2 = new double[n_q2*n_t*n_eta]; - ImE_2 = new double[n_q2*n_t*n_eta]; - ReE_2 = new double[n_q2*n_t*n_eta]; - ImHtild_2 = new double[n_q2*n_t*n_eta]; - ReHtild_2 = new double[n_q2*n_t*n_eta]; - Dterm_2 = new double[n_q2*n_t*n_eta]; - - ReadFile(); - DefineValues(); -} - -bool GPDs::ReadFile() -{ - ifstream inp(fname); - - if( inp.is_open() ) - { - for( int i = 0; i < n_q2; i++ ) - { - for( int j = 0; j < n_t; j++ ) - { - for( int k = 0; k < n_eta; k++ ) - { - inp>>arr_q2[i]; - inp>>arr_t[j]; - arr_t[j] = -arr_t[j]; - inp>>arr_eta[k]; - inp>>ImH_2[i*n_t*n_eta + j*n_eta + k]; - inp>>ReH_2[i*n_t*n_eta + j*n_eta + k]; - inp>>ImE_2[i*n_t*n_eta + j*n_eta + k]; - inp>>ReE_2[i*n_t*n_eta + j*n_eta + k]; - inp>>ImHtild_2[i*n_t*n_eta + j*n_eta + k]; - inp>>ReHtild_2[i*n_t*n_eta + j*n_eta + k]; - inp>>Dterm_2[i*n_t*n_eta + j*n_eta + k]; - - //cout< -#include -#include -#include -#include -#include - - -#ifndef GPDS_H -#define GPDS_H - -//#ifdef __cplusplus -//extern"C" { -//#endif - -using namespace std; - -class GPDs -{ - public: - GPDs(const char*, int, int, int, double, double, double); - double GetReH() const; - double GetImH() const; - double GetReE() const; - double GetImE() const; - double GetReHtild() const; - double GetImHtild() const; - double GetDterm() const; - void Set_q2_t_eta(double, double, double); - ~GPDs(); - - private: - int n_q2, n_t, n_eta; - double tM, Q2, eta; - double q21, t1, eta1; - double q22, t2, eta2; - double *arr_t; - double *arr_eta; - double *arr_q2; - double ReH, ImH, ReE, ImE, ImHtild, ReHtild, Dterm; - char *fname; - bool ReadFile(); - void DefineValues(); - - double *ImH_2; - double *ReH_2; - double *ImE_2; - double *ReE_2; - double *ImHtild_2; - double *ReHtild_2; - double *Dterm_2; - - bool fstat; // Status of the file '1' if file read succsessfully '0' if not - - vector v_q2; - vector v_t; - vector v_eta; -}; - -//#ifdef __cplusplus -//} -//#endif - -#endif diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/GenTCS.cc b/src/programs/Simulation/gen_ee_hb/HallBTCS/GenTCS.cc deleted file mode 100644 index 882d5f4ae9..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/GenTCS.cc +++ /dev/null @@ -1,267 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include "TTCS_crs.hh" -#include "TTCS_kine.hh" -//#include "kin_funcs.cc" -#include "kin_funcs.h" -#include - -// #include "CobremsGenerator.hh" - -#define USEHDDM -#ifdef USEHDDM -#include "HddmOut.h" -#endif - -#include - -using namespace std; - -int main(int argc, char **argv) -{ - TCanvas *c1 = new TCanvas(); - - // output configuration - int run = 10000; - int Nsim = 25000; - int seedVal = 0; - - //COMMAND LINE PARSING - char *argptr; - for (int i=1; iGet("cobrem_vs_E"); - TH1D* hGvsEout = (TH1D*)hGvsE->Clone("hGvsEout"); - hGvsEout->Reset(); - hGvsEout->Rebin(30); - int eBinLow = hGvsE->GetXaxis()->FindBin(eLower); - int eBinHigh = hGvsE->GetXaxis()->FindBin(eUpper); - hGvsE->GetXaxis()->SetRange(eBinLow,eBinHigh); - double gMax = hGvsE->GetMaximum(); - - //const double Eb = 12.; - //const double Eg = Eb; - - - - //const double Q2min = 2*Mp*Eg + t_lim - (Eg/Mp)*( 2*Mp*Mp - t_lim - sqrt(t_lim*t_lim - 4*Mp*Mp*t_lim) ); - const double Q2min = 2*Me; - const double Minv_min = sqrt(Q2min); - - TRandom3 rand; - rand.SetSeed(seedVal); // need to set this - - //TTCS_kine tcs_kin1(Mp, Eb); - TTCS_crs crs_lmlp; - - TLorentzVector target(0., 0., 0., Mp); - TLorentzVector Lcm; - TLorentzVector Lbeam; - - TFile *file_out = new TFile("tcs_gen.root", "Recreate"); - - TH2D *h_ph_h_ph_cm1 = new TH2D("h_ph_h_ph_cm1", "", 200, 0., 360., 200, 0., 360.); - TH2D *h_th_g_th_cm1 = new TH2D("h_th_g_th_cm1", "", 200, 0., 180., 200, 0., 180.); - TH1D *h_mee = new TH1D("mee", "", 200, 0, 4.); - - //================= Definition of Tree Variables ================= - double Minv, t, Q2; - double psf, crs_BH, crs_INT, crs_int; - double psf_flux, flux_factor; - TLorentzVector L_em, L_ep, L_prot; - TLorentzVector L_gprime; - - TTree *tr1 = new TTree("tr1", "TCS MC events"); - tr1->Branch("L_em", "TLorentzVector", &L_em, 3200, 99); - tr1->Branch("L_ep", "TLorentzVector", &L_ep, 3200, 99); - tr1->Branch("L_prot", "TLorentzVector", &L_prot, 3200, 99); - tr1->Branch("Q2", &Q2, "Q2/D"); - tr1->Branch("t", &t, "t/D"); - tr1->Branch("psf", &psf, "psf/D"); - tr1->Branch("crs_BH", &crs_BH, "crs_BH/D"); - -#ifdef USEHDDM - //============Initialize HDDM output =============== - char hddmFile[80]; - sprintf(hddmFile,"genOut.hddm"); - - HddmOut hddmGo(hddmFile); - int evtNumber = 0; -#endif - - ofstream outf("ee.ascii"); - - for( int i = 0; i < Nsim; i++ ) { - - if( i%50000 == 0) - { - cout.flush()<<"Processed "<yVal){//Monte Carlo the event to get brem spectrum - eGamma = rand.Uniform(eLower,eUpper); //Grab a photon energy - testValY = rand.Uniform(0.0,yMax); //Grab a test value - eBin = hGvsE->GetXaxis()->FindBin(eGamma); - yVal = hGvsE->GetBinContent(eBin); - } - hGvsEout->Fill(eGamma); - - double Eb = eGamma; - double Eg = Eb; - TTCS_kine tcs_kin1(Mp, Eb); - - double s = Mp*Mp + 2*Mp*Eg; - double t_min = T_min(0., Mp*Mp, Q2min, Mp*Mp, s); - double t_max = T_max(0., Mp*Mp, Q2min, Mp*Mp, s); - double psf_t = t_min - TMath::Max(t_max, t_lim); - - if( t_min > t_lim ) - { - t = rand.Uniform( t_min - psf_t, t_min); - double Q2max = 2*Mp*Eg + t - (Eg/Mp)*( 2*Mp*Mp - t - sqrt(t*t - 4*Mp*Mp*t) ); // Page 182 of my notebook. Derived using "Q2max = s + t - 2Mp**2 + u_max" relation - - double psf_Q2 = Q2max - Q2min; - - Q2 = rand.Uniform(Q2min, Q2min + psf_Q2); - - double u = 2*Mp*Mp + Q2 - s - t; - double th_qprime = acos((s*(t - u) - Mp*Mp*(Q2 - Mp*Mp))/sqrt(LambdaFunc(s, 0, Mp*Mp)*LambdaFunc(s, Q2, Mp*Mp))); //Byukling Kayanti (4.9) - double th_pprime = PI + th_qprime; - - double Pprime = 0.5*sqrt(LambdaFunc(s, Q2, Mp*Mp)/s); // Momentum in c.m. it is the same for q_pr and p_pr - - Lbeam.SetPxPyPzE(0., 0., Eg, Eg); - Lcm.SetPxPyPzE(0., 0., Eg, Mp + Eg); - L_prot.SetPxPyPzE(Pprime*sin(th_pprime), 0., Pprime*cos(th_pprime), sqrt(Pprime*Pprime + Mp*Mp) ); - L_gprime.SetPxPyPzE( Pprime*sin(th_qprime), 0., Pprime*cos(th_qprime), sqrt(Pprime*Pprime + Q2) ); - - double psf_cos_th = 2.; // cos(th):(-1 : 1) - double psf_phi_cm = 2*PI; - - double cos_th = rand.Uniform(-1., -1 + psf_cos_th); - double sin_th = sqrt( 1 - cos_th*cos_th ); - double phi_cm = rand.Uniform(0., 0. + psf_phi_cm); - - double El = sqrt(Q2)/2.; // Energy of lepton in the rest frame of qprime - double Pl = sqrt( El*El - Me*Me ); - - L_em.SetPxPyPzE( Pl*sin_th*cos(phi_cm), Pl*sin_th*sin(phi_cm), Pl*cos_th, El ); - L_ep.SetPxPyPzE( -Pl*sin_th*cos(phi_cm), -Pl*sin_th*sin(phi_cm), -Pl*cos_th, El ); - - L_em.RotateY(th_qprime); // Rotate in order to get Z axis be antiparallel to the p_prime direction in the CM frame - L_ep.RotateY(th_qprime); // Rotate in order to get Z axis be antiparallel to the p_prime direction in the CM frame - - L_em.Boost(L_gprime.BoostVector()); // Move to the CM Frame - L_ep.Boost(L_gprime.BoostVector()); // Move to the CM Frame - - L_em.Boost(Lcm.BoostVector()); // Move to the Lab Frame - L_ep.Boost(Lcm.BoostVector()); // Move to the Lab Frame - - - L_gprime.Boost(Lcm.BoostVector()); - L_prot.Boost(Lcm.BoostVector()); - - double psf_phi_lab = 2*PI; - double phi_rot = rand.Uniform(0., psf_phi_lab); - - L_prot.RotateZ(phi_rot); - L_gprime.RotateZ(phi_rot); - L_em.RotateZ(phi_rot); - L_ep.RotateZ(phi_rot); - tcs_kin1.SetLemLepLp(L_em, L_ep, L_prot); - - psf = psf_t*psf_Q2*psf_phi_lab*psf_cos_th*psf_phi_cm; - - crs_BH = crs_lmlp.Eval_BH(s, Q2, t, -1, tcs_kin1.GetPhi_cm(), tcs_kin1.GetTheta_cm()); // -1: cros section is not weighted by L/L0 - - tr1->Fill(); - - - // monitoring histograms - h_ph_h_ph_cm1->Fill(phi_cm*TMath::RadToDeg(), tcs_kin1.GetPhi_cm()); - h_th_g_th_cm1->Fill(acos(cos_th)*TMath::RadToDeg(), tcs_kin1.GetTheta_cm()); - if( (L_em.Theta()*180./TMath::Pi() > 1.) && (L_ep.Theta()*180./TMath::Pi() > 1.) ) - h_mee->Fill((L_em+L_ep).M(), psf*crs_BH); - -#ifdef USEHDDM - // ======= HDDM output ========= - tmpEvt_t tmpEvt; - tmpEvt.beam = Lbeam; - tmpEvt.target = target; - tmpEvt.q1 = L_em; - tmpEvt.q2 = L_ep; - tmpEvt.recoil = L_prot; - tmpEvt.nGen = 3; - tmpEvt.rxn = 2; - //tmpEvt.weight = psf*crs_BH; - //tmpEvt.weight = crs_BH; - tmpEvt.weight = psf; - evtNumber++; - hddmGo.write(tmpEvt,run,evtNumber); -#endif - - } - else - { - cout<<" |t_min| > |t_lim|"<physicsEvents = phyEvt = make_s_PhysicsEvents(1); - phyEvt->mult = 1; - phyEvt->in[0].runNo = runNo; - - //We define beam and target parameters for the reaction, which - //remain the same between events - phyEvt->in[0].reactions = reactions = make_s_Reactions(1); - reactions->mult = 1; - reaction = &reactions->in[0]; - reaction->target = target = make_s_Target(); - target->type = targetType; - target->properties = make_s_Properties(); - target->properties->charge = ParticleCharge(targetType); - target->properties->mass = ParticleMass(targetType); - target->momentum = make_s_Momentum(); - target->momentum->px = 0; - target->momentum->py = 0; - target->momentum->pz = 0; - target->momentum->E = ParticleMass(targetType); - reaction->beam = beam = make_s_Beam(); - beam->type = beamType; - beam->properties = make_s_Properties(); - beam->properties->charge = ParticleCharge(beamType); - beam->properties->mass = ParticleMass(beamType); - beam->momentum = make_s_Momentum(); - - } - - void write(tmpEvt_t evt, int runNum, int eventNum) { - //init(10000); - init(runNum); - phyEvt->in[0].eventNo = eventNum; - reaction->vertices = vertices = make_s_Vertices(1); - vertices->mult = 1; - vertices->in[0].origin = origin = make_s_Origin(); - vertices->in[0].products = products = make_s_Products(evt.nGen); - - origin->t = 0.0; - origin->vx = 0.0; - origin->vy = 0.0; - origin->vz = 0.0; - - beam->momentum->px = evt.beam.Px(); - beam->momentum->py = evt.beam.Py(); - beam->momentum->pz = evt.beam.Pz(); - beam->momentum->E = evt.beam.E(); - - products->mult = evt.nGen; - reaction->weight = evt.weight; - - //PRODUCED ELECTRON - products->in[0].type = Electron; - products->in[0].pdgtype = 11; - products->in[0].id = 1; - products->in[0].parentid = 0; - products->in[0].mech = 0; - products->in[0].momentum = make_s_Momentum(); - products->in[0].momentum->px = evt.q1.Px(); - products->in[0].momentum->py = evt.q1.Py(); - products->in[0].momentum->pz = evt.q1.Pz(); - products->in[0].momentum->E = evt.q1.E(); - - //PRODUCED ELECTRON - products->in[1].type = Positron; - products->in[1].pdgtype = -11; - products->in[1].id = 2; - products->in[1].parentid = 0; - products->in[1].mech = 0; - products->in[1].momentum = make_s_Momentum(); - products->in[1].momentum->px = evt.q2.Px(); - products->in[1].momentum->py = evt.q2.Py(); - products->in[1].momentum->pz = evt.q2.Pz(); - products->in[1].momentum->E = evt.q2.E(); - - //RECOIL - if (evt.rxn == 2) {//set type - products->in[2].type = Proton; - products->in[2].pdgtype = 2212; - } else { - products->in[2].type = Electron; - products->in[2].pdgtype = 11; - } - products->in[2].id = 3; - products->in[2].parentid = 0; - products->in[2].mech = 0; - products->in[2].momentum = make_s_Momentum(); - products->in[2].momentum->px = evt.recoil.Px(); - products->in[2].momentum->py = evt.recoil.Py(); - products->in[2].momentum->pz = evt.recoil.Pz(); - products->in[2].momentum->E = evt.recoil.E(); - - flush_s_HDDM(hddmEvt, ostream); - - } -}; - -#endif /* HDDMOUT_H_ */ diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/SConscript b/src/programs/Simulation/gen_ee_hb/HallBTCS/SConscript deleted file mode 100644 index 3135275e32..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/SConscript +++ /dev/null @@ -1,13 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -env = env.Clone() - -sbms.AddHDDM(env) -sbms.AddROOT(env) -sbms.executable(env, 'ee_mc_hb') -#sbms.executable(env) diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.cc b/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.cc deleted file mode 100644 index 0897ef12ad..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.cc +++ /dev/null @@ -1,303 +0,0 @@ -#include "TTCS_crs.hh" -#include -#include "kin_funcs.h" -#include -#include "GPDs.hh" -#include -#include - -using namespace std; - - -//typedef double (TTCS_crs::*BH_crs_section_mf)(double *, double *); - -TTCS_crs::TTCS_crs() -{ - f_BH = new TF2("f_BH", BH_crs_section, 0, 360, 0, 180, 4); - f_INT = new TF2("f_INT", INT_crs_section, 0., 360., 0., 180., 12); - gp = new GPDs("CFFs_DD_Feb2012.dat", 17, 17, 9, 1.49, -0.20, 0.072); -} - -TTCS_crs::TTCS_crs( double a_s, double a_Q2, double a_t )// s(GeV)^2, Q2(GeV)^2, t(GeV)^2 -{ - Set_SQ2t(a_s, a_Q2, a_t); - iweight = -1; - // BH_crs_section_mf p = &TTCS_crs::BH_crs_section; - //cout<<"p = "<SetParameters(is, iQ2, it); - - f_INT = new TF2("f_INT", INT_crs_section, 0., 360., 0., 180., 12); - double eta = iQ2/( 2*(is - M_p*M_p) - iQ2 ); - gp = new GPDs("CFFs_DD_Feb2012.dat", 17, 17, 9, iQ2, it, eta); - - gp->Set_q2_t_eta(iQ2, it, eta); -} - -double TTCS_crs::BH_crs_section( double *x, double *par) -{ - double phi = x[0]/radian; - double theta = x[1]/radian; - - double s = par[0]; - double Q2 = par[1]; - double t = par[2]; - - //cout<<" s Q2 t phi, theta ="<SetParameters(a_s, a_Q2, a_t, a_sc_D, a_weight, ImH, ReH, ImE, ReE, ImHtild, ReHtild); - f_INT->SetParameter(11, Dterm); - return f_INT->Eval(a_phi, a_th)/sin(a_th/radian); // 1/sin(theta) is for getting d\sigma/dcos(\theta) -} - -void TTCS_crs::Set_SQ2t(double a_s, double a_Q2, double a_t) -{ - is = a_s; - it = a_t; - iQ2 = a_Q2; -} - -// double TTCS_crs::Get_M2int() const -// { -// return M2_int; -// } - -// double TTCS_crs::Get_M2int(double a_s, double a_Q2, double a_t, double a_sc_D) -// { -// Set_SQ2t( a_s, a_Q2, a_t); // phi and theta 10, are just random angles (no matter), -// Eval_INT(10, 10, a_sc_D); -// return M2_int; -// } - -double TTCS_crs::Integral_BH_phi_th( double a_phi_min, double a_phi_max, double a_th_min, double a_th_max) -{ - f_BH->SetParameters(is, iQ2, it, iweight); - return f_BH->Integral(a_phi_min, a_phi_max, a_th_min, a_th_max); -} - -void TTCS_crs::Set_Weight( double a_weight) -{ - iweight = a_weight; -} - -void TTCS_crs::Set_sc_D( double a_sc_D) -{ - isc_D = a_sc_D; -} - -void TTCS_crs::Draw_BH(const char* option) -{ - f_BH->SetParameters(is, iQ2, it, iweight); - f_BH->Draw(option); -} - -void TTCS_crs::Draw_INT(const char* option, double a_sc_D) -{ - double eta = iQ2/( 2*(is - M_p*M_p) - iQ2 ); - gp->Set_q2_t_eta(iQ2, it, eta); - - double ImH = gp->GetImH(); - double ReH = gp->GetReH(); - double ImE = gp->GetImE(); - double ReE = gp->GetReE(); - double ImHtild = gp->GetImHtild(); - double ReHtild = gp->GetReHtild(); - double Dterm = gp->GetDterm(); - - f_INT->SetParameters(is, iQ2, it, a_sc_D, iweight, ImH, ReH, ImE, ReE, ImHtild, ReHtild); - f_INT->SetParameter(11, Dterm); - f_INT->SetNpx(500); - f_INT->SetNpy(500); - f_INT->Draw(option); -} - -TH2D *TTCS_crs::Get_BH_Crs_Histogream_ThPhi(const char *name) -{ - TCanvas *ctmp = new TCanvas(); - f_BH->SetParameters(is, iQ2, it, iweight); - f_BH->SetNpx(500); - f_BH->SetNpy(500); - f_BH->Draw("colz"); - TH2D *h_tmp = (TH2D*)f_BH->GetHistogram(); - h_tmp->SetName(name); - delete ctmp; - return h_tmp; -} - -TH2D *TTCS_crs::Get_INT_Crs_Histogream_ThPhi(const char *name) -{ - TCanvas *ctmp = new TCanvas(); // Without this I was getting crazy results in utility programs :-) - double eta = iQ2/( 2*(is - M_p*M_p) - iQ2 ); - gp->Set_q2_t_eta(iQ2, it, eta); - - double ImH = gp->GetImH(); - double ReH = gp->GetReH(); - double ImE = gp->GetImE(); - double ReE = gp->GetReE(); - double ImHtild = gp->GetImHtild(); - double ReHtild = gp->GetReHtild(); - double Dterm = gp->GetDterm(); - - f_INT->SetParameters(is, iQ2, it, isc_D, iweight, ImH, ReH, ImE, ReE, ImHtild, ReHtild); - f_INT->SetParameter(11, Dterm); - f_INT->SetNpx(500); - f_INT->SetNpy(500); - f_INT->Draw("colz"); - TH2D *h_tmp = (TH2D*)f_INT->GetHistogram(); - h_tmp->SetName(name); - delete ctmp; - return h_tmp; -} diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.hh b/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.hh deleted file mode 100644 index 67ee27b8f9..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_crs.hh +++ /dev/null @@ -1,54 +0,0 @@ -#ifndef TTCS_crs_HH -#define TTCS_crs_HH - -#include -#include -#include "GPDs.hh" - -class TH2D; - -class TTCS_crs: public TObject -{ -public: - TTCS_crs(); - TTCS_crs(double, double, double); // s(GeV)^2, Q2(GeV)^2, t(GeV)^2 - double Eval_BH(double, double) const;// phi and theta in radians - double Eval_BH(double, double, double, double, double, double) const; // s, Q2, t, weight, phi, theta - double Eval_INT(double, double, double) const;// (phi, theta, scale of Dterm) phi and theta in radians - double Eval_INT(double, double, double, double, double, double, double) const; // s, Q2, t, weight, phi, theta, sc_D - //double Get_Delta_Perp() const; - // double Get_M2int() const; // M^{--} - // double Get_M2int(double, double, double, double ); // M^{--} - void Set_SQ2t(double, double, double); - double Integral_BH_phi_th( double phi_min = 0, double phi_max = 360, double th_min = 0, double th_max = 180); - void Set_Weight( double weight = -1.); // with +1 it will weight with L/L0, otherwise it will not - void Set_sc_D(double); // Set magnitude of D-term - void Draw_BH(const char* option); - void Draw_INT(const char* option, double sc_D = 1.); - TH2D *Get_BH_Crs_Histogream_ThPhi(const char *name); - TH2D *Get_INT_Crs_Histogream_ThPhi(const char *name); - -private: - // double M2_int; - double is, iQ2, it; - double iweight; - double isc_D; - GPDs *gp; - - //static double iDelta_Perp; // This 'static' is not a good idea, but it didn't work without this... - - static constexpr double radian = 57.2957795130823229; - static constexpr double m_e = 0.00051; - static constexpr double M_p = 0.938272; - static constexpr double alpha_em = 1./137.; - static constexpr double PI = 3.14159265358979312; - static constexpr double ammp = 2.793; - static constexpr double ammn = -1.913; - - static double BH_crs_section( double *, double *); // Hmmm why it worked with static ?, and didn't work without static? - static double INT_crs_section( double *, double *); // Hmmm why it worked with static ?, and didn't work without static? - TF2 *f_BH; - TF2 *f_INT; -}; - -#endif diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.cc b/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.cc deleted file mode 100644 index 28ab39292a..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.cc +++ /dev/null @@ -1,171 +0,0 @@ -#include "TTCS_kine.hh" -//#include "/home/rafayel/WORKDIR/e1-6/pass2_v1/tcs_analyse2/include/TTCS_kine.hh" - -TTCS_kine::TTCS_kine(double m, double E) -{ - // Lem.SetPxPyPzE(0., 0., -1., 1.); - // Lep.SetPxPyPzE(0., 0., -1., 1.); - // Lp1.SetPxPyPzE(0., 0., -1., 1.); - - mprot = m; - Eb = E; - - Lp.SetPxPyPzE(0., 0., 0., mprot); - Lbeam.SetPxPyPzE(0, 0, Eb, Eb); - - //Define_kinematic(); -} - -TTCS_kine::TTCS_kine( TLorentzVector em, TLorentzVector ep, TLorentzVector p1, - double m, double E ) -{ - Lem = em; - Lep = ep; - Lp1 = p1; - - mprot = m; - Eb = E; - - Lp.SetPxPyPzE(0., 0., 0., mprot); - Lbeam.SetPxPyPzE(0, 0, Eb, Eb); - - Define_kinematic(); -} - -void TTCS_kine::SetLemLepLp(TLorentzVector em, TLorentzVector ep, TLorentzVector p1) -{ - Lem = em; - Lep = ep; - Lp1 = p1; - - Define_kinematic(); -} - -void TTCS_kine::Define_kinematic() -{ - L_mis = Lbeam + Lp - Lem - Lep - Lp1; - Lg = Lp1 + Lem + Lep - Lp; - Lemep = Lem + Lep; - - Minv = Lemep.M(); - Eq_prime = Lemep.E(); - tM = (Lp - Lp1).M2(); - Egamma = Lg.E(); - MM2 = L_mis.M2(); - mis_mom = L_mis.P(); - px_mis = L_mis.Px(); - py_mis = L_mis.Py(); - pz_mis = L_mis.Pz(); - - Q2 = 2*Eb*(mis_mom - pz_mis); - - Lcm = Lg + Lp; - - Lp_cm = Lp; - Lp_cm.Boost( -Lcm.BoostVector() ); - Lp1_cm = Lp1; - Lp1_cm.Boost( -Lcm.BoostVector() ); - Lem_cm = Lem; - Lem_cm.Boost( -Lcm.BoostVector() ); - Lep_cm = Lep; - Lep_cm.Boost( -Lcm.BoostVector() ); - - Lem_eep_cm = Lem; - Lem_eep_cm.Boost( -Lemep.BoostVector() ); - Lep_eep_cm = Lep; - Lep_eep_cm.Boost( -Lemep.BoostVector() ); - Lp1_eep_cm = Lp1; - Lp1_eep_cm.Boost( -Lemep.BoostVector() ); - - TV3_em = Lem_cm.Vect(); - TV3_ep = Lep_cm.Vect(); - TV3_p = Lp_cm.Vect(); - TV3_p1 = Lp1_cm.Vect(); - TV3_emep_crs = TV3_ep.Cross(TV3_em); - TV3_pp1_crs = TV3_p.Cross(TV3_p1); - - if( TV3_em.Dot( TV3_pp1_crs ) > 0 ) - { - phi_cm = TV3_emep_crs.Angle(TV3_pp1_crs)*radian; - } - else - { - phi_cm = (2*PI - TV3_emep_crs.Angle(TV3_pp1_crs))*radian; - } - - theta_cm = (PI - Lem_eep_cm.Angle(Lp1_eep_cm.Vect()))*radian; - - double bb = 2*(Lem - Lep).Dot(Lp - Lp1); - L = ((Minv*Minv - tM)*(Minv*Minv - tM) - bb*bb)/4.; - L0 = Minv*Minv*Minv*Minv*sin(theta_cm/radian)*sin(theta_cm/radian); -} - -double TTCS_kine::GetPhi_cm() const -{ - return phi_cm; -} - -double TTCS_kine::GetTheta_cm() const -{ - return theta_cm; -} - -double TTCS_kine::Get_tM() const -{ - return tM; -} - -double TTCS_kine::GetMinv() const -{ - return Minv; -} - -double TTCS_kine::GetMM2() const -{ - return MM2; -} - -double TTCS_kine::GetEg() const -{ - return Egamma; -} - -double TTCS_kine::GetEq_prime() const -{ - return Eq_prime; -} - -double TTCS_kine::GetMis_mom() const -{ - return mis_mom; -} - -double TTCS_kine::GetPx_mis() const -{ - return px_mis; -} - -double TTCS_kine::GetPy_mis() const -{ - return py_mis; -} - -double TTCS_kine::GetPz_mis() const -{ - return pz_mis; -} - -double TTCS_kine::GetQ2()const -{ - return Q2; -} - -double TTCS_kine::Get_L() const -{ - return L; -} - -double TTCS_kine::Get_L0() const -{ - return L0; -} diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.hh b/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.hh deleted file mode 100644 index 0ce7da726a..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/TTCS_kine.hh +++ /dev/null @@ -1,75 +0,0 @@ -#ifndef TTCS_KINE_ifndef -#define TTCS_KINE_ifndef - -#include -#include - -class TTCS_kine : public TObject -{ -public: - TTCS_kine(double m = 0.938, double E = 5.76); - TTCS_kine( TLorentzVector, TLorentzVector, TLorentzVector, - double m = 0.938, double E = 5.76 ); // e-,e+,p, mp, Eg - - double GetPhi_cm() const; - double GetTheta_cm() const; - double Get_tM() const; - double GetMinv() const; - double GetMM2() const; - double GetEg() const; // Energy of incpming photon - double GetEq_prime() const; // Energy of the timelike photon - double GetMis_mom() const; - double GetPx_mis() const; - double GetPy_mis() const; - double GetPz_mis() const; - double Get_L() const; - double Get_L0() const; - double GetQ2()const; // Q2 of the quasi-real photon - void SetLemLepLp( TLorentzVector, TLorentzVector, TLorentzVector); - - void Define_kinematic(); - // ClassDef(TTCS_kine,1); - -private: - - TLorentzVector Lp; TLorentzVector Lp_cm; - TLorentzVector Lp1; TLorentzVector Lp1_cm; - TLorentzVector Lem; TLorentzVector Lem_cm; - TLorentzVector Lep; TLorentzVector Lep_cm; - TLorentzVector Lg; TLorentzVector Lg_cm; - TLorentzVector Lemep; TLorentzVector Lemep_cm; - TLorentzVector Lgemep; TLorentzVector Lgemep_cm; - TLorentzVector Lem_eep_cm; - TLorentzVector Lep_eep_cm; - TLorentzVector Lp1_eep_cm; - TLorentzVector Lcm; - TLorentzVector Lbeam; - - TLorentzVector L_mis; - - double Eq_prime; - double mprot; - double Egamma; - double Eb; - double Minv, tM; - double MM2; - double mis_mom; - double px_mis; - double py_mis; - double pz_mis; - double L, L0; - double Q2; // Q2 of the quasi-real photon - static constexpr double radian = 57.2957795130823229; - static constexpr double PI = 3.14159265358979312; - - // Lp.SetPxPyPzE(0., 0., 0., mprot); - // Lbeam.SetPxPyPzE(0, 0, Eb, Eb); - - TVector3 TV3_em, TV3_ep, TV3_p, TV3_p1; - TVector3 TV3_emep_crs, TV3_pp1_crs; //cross products of (em X ep) and (p X p1) - - double phi_cm, theta_cm; - -}; - -#endif diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.cc b/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.cc deleted file mode 100644 index 8255281142..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.cc +++ /dev/null @@ -1,34 +0,0 @@ -//#include "kin_funcs.h" -#include - - -// This is from Byukling Kayanti Formula (6.3) -double LambdaFunc( double x, double y, double z ) -{ - return (x - y - z)*(x - y - z) - 4*y*z; -} - -//From Byukling Kayanti Formula (5.14) Page 86 -double T_min( double ma_2, double mb_2, double m1_2, double m2_2, double s) // arguments are squares of masses of particles in the reaction a+b->1+2, and s is the square of the total c.m. energy i.e. (a+b)^2 -{ - return ma_2 + m1_2 - (1/(2*s))*( (s + ma_2 - mb_2)*(s + m1_2 - m2_2) - sqrt( LambdaFunc(s, ma_2, mb_2)*LambdaFunc(s, m1_2, m2_2) ) ); -} - -//From Byukling Kayanti Formula (5.14) page 86 -double T_max( double ma_2, double mb_2, double m1_2, double m2_2, double s) -{ - return ma_2 + m1_2 - (1/(2*s))*( (s + ma_2 - mb_2)*(s + m1_2 - m2_2) + sqrt( LambdaFunc(s, ma_2, mb_2)*LambdaFunc(s, m1_2, m2_2) ) ); -} - -double Q2_min( double s, double Eb, double M ) -{ - // M is the target mass; - double me = 0.00051; - double Eg = (s - M*M)/(2*M); - double E_pr = Eb - Eg; - double P0 = sqrt(Eb*Eb - me*me); - double P_pr = sqrt(E_pr*E_pr - me*me); - double Q2min = 2*(Eb*E_pr - P0*P_pr - me*me); - - return Q2min; -} diff --git a/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.h b/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.h deleted file mode 100755 index 331f2f93fd..0000000000 --- a/src/programs/Simulation/gen_ee_hb/HallBTCS/kin_funcs.h +++ /dev/null @@ -1,10 +0,0 @@ -#ifndef KINEMATIC_FUNCS -#define KINEMATIC_FUNCS - - -double LambdaFunc( double, double, double ); -double T_min( double, double, double, double, double); -double T_max( double, double, double, double, double); -double Q2_min( double s, double Eb, double M ); - -#endif diff --git a/src/programs/Simulation/gen_ee_hb/SConscript b/src/programs/Simulation/gen_ee_hb/SConscript deleted file mode 100644 index cadd5e2de4..0000000000 --- a/src/programs/Simulation/gen_ee_hb/SConscript +++ /dev/null @@ -1,6 +0,0 @@ - - -Import('*') - -SConscript(dirs=['HallBTCS'], exports='env osname', duplicate=0) - diff --git a/src/programs/Simulation/gen_ee_hb/run/CFFs_DD_Feb2012.dat b/src/programs/Simulation/gen_ee_hb/run/CFFs_DD_Feb2012.dat deleted file mode 100644 index b9a0ee7772..0000000000 --- a/src/programs/Simulation/gen_ee_hb/run/CFFs_DD_Feb2012.dat +++ /dev/null @@ -1,2755 +0,0 @@ - 0.0000 0.0000 0.0526 -30.81649 -1.44276 -0.25840 -0.46833 3.49718 -0.23974 -3.28889 - 0.0000 0.0000 0.1111 -15.34977 0.50507 -0.38127 -0.07622 2.85075 0.23756 -3.28889 - 0.0000 0.0000 0.1765 -9.80824 1.54392 -0.47646 0.14763 2.52064 0.00348 -3.28889 - 0.0000 0.0000 0.2500 -6.84756 1.91646 -0.53758 0.46229 2.21382 -0.08682 -3.28889 - 0.0000 0.0000 0.3333 -4.90844 2.10817 -0.55528 0.59440 1.87986 -0.40731 -3.28889 - 0.0000 0.0000 0.4286 -3.47136 2.17774 -0.52412 0.66684 1.51611 -0.68999 -3.28889 - 0.0000 0.0000 0.5385 -2.32806 2.12361 -0.44415 0.67594 1.13263 -0.91548 -3.28889 - 0.0000 0.0000 0.6667 -1.38910 1.94261 -0.32126 0.61781 0.74277 -1.06132 -3.28889 - 0.0000 0.0000 0.8182 -0.61706 1.62330 -0.16720 0.48732 0.36055 -1.10657 -3.28889 - 0.0000 -0.0500 0.0526 -27.00561 -1.28239 -0.22236 -0.40301 3.27503 -0.06307 -2.86802 - 0.0000 -0.0500 0.1111 -13.45705 0.42994 -0.32809 -0.06559 2.66794 0.35831 -2.86802 - 0.0000 -0.0500 0.1765 -8.60330 1.34365 -0.41001 0.12704 2.35790 0.11645 -2.86802 - 0.0000 -0.0500 0.2500 -6.00985 1.67352 -0.46260 0.39782 2.07017 0.02766 -2.86802 - 0.0000 -0.0500 0.3333 -4.31047 1.84467 -0.47783 0.51150 1.75742 -0.28775 -2.86802 - 0.0000 -0.0500 0.4286 -3.05011 1.90833 -0.45102 0.57383 1.41707 -0.56774 -2.86802 - 0.0000 -0.0500 0.5385 -2.04654 1.86290 -0.38221 0.58167 1.05846 -0.79389 -2.86802 - 0.0000 -0.0500 0.6667 -1.22163 1.70548 -0.27646 0.53164 0.69403 -0.94525 -2.86802 - 0.0000 -0.0500 0.8182 -0.54286 1.42595 -0.14388 0.41935 0.33685 -1.00193 -2.86802 - 0.0000 -0.1000 0.0526 -23.86910 -1.14881 -0.19305 -0.34989 3.07954 0.09239 -2.52306 - 0.0000 -0.1000 0.1111 -11.89880 0.36922 -0.28485 -0.05695 2.50707 0.46456 -2.52306 - 0.0000 -0.1000 0.1765 -7.61092 1.17963 -0.35597 0.11029 2.21469 0.21586 -2.52306 - 0.0000 -0.1000 0.2500 -5.31961 1.47410 -0.40163 0.34539 1.94377 0.12838 -2.52306 - 0.0000 -0.1000 0.3333 -3.81753 1.62805 -0.41486 0.44409 1.64968 -0.18255 -2.52306 - 0.0000 -0.1000 0.4286 -2.70270 1.68660 -0.39158 0.49820 1.32993 -0.46017 -2.52306 - 0.0000 -0.1000 0.5385 -1.81428 1.64817 -0.33183 0.50501 0.99320 -0.68691 -2.52306 - 0.0000 -0.1000 0.6667 -1.08343 1.51005 -0.24002 0.46157 0.65114 -0.84311 -2.52306 - 0.0000 -0.1000 0.8182 -0.48162 1.26323 -0.12491 0.36408 0.31599 -0.90986 -2.52306 - 0.0000 -0.1500 0.0526 -21.25599 -1.03622 -0.16893 -0.30616 2.90663 0.22990 -2.23679 - 0.0000 -0.1500 0.1111 -10.60019 0.31953 -0.24925 -0.04983 2.36477 0.55854 -2.23679 - 0.0000 -0.1500 0.1765 -6.78356 1.04365 -0.31148 0.09651 2.08802 0.30379 -2.23679 - 0.0000 -0.1500 0.2500 -4.74389 1.30838 -0.35144 0.30222 1.83195 0.21748 -2.23679 - 0.0000 -0.1500 0.3333 -3.40621 1.44777 -0.36301 0.38858 1.55438 -0.08949 -2.23679 - 0.0000 -0.1500 0.4286 -2.41270 1.50189 -0.34264 0.43594 1.25284 -0.36502 -2.23679 - 0.0000 -0.1500 0.5385 -1.62033 1.46913 -0.29036 0.44189 0.93547 -0.59227 -2.23679 - 0.0000 -0.1500 0.6667 -0.96798 1.34701 -0.21002 0.40389 0.61321 -0.75277 -2.23679 - 0.0000 -0.1500 0.8182 -0.43044 1.12742 -0.10930 0.31858 0.29754 -0.82842 -2.23679 - 0.0000 -0.2000 0.0526 -19.05535 -0.94034 -0.14885 -0.26977 2.75294 0.35212 -1.99661 - 0.0000 -0.2000 0.1111 -9.50624 0.27843 -0.21962 -0.04391 2.23830 0.64208 -1.99661 - 0.0000 -0.2000 0.1765 -6.08633 0.92969 -0.27446 0.08504 1.97542 0.38195 -1.99661 - 0.0000 -0.2000 0.2500 -4.25852 1.16916 -0.30966 0.26629 1.73257 0.29667 -1.99661 - 0.0000 -0.2000 0.3333 -3.05929 1.29612 -0.31986 0.34239 1.46967 -0.00677 -1.99661 - 0.0000 -0.2000 0.4286 -2.16801 1.34633 -0.30191 0.38412 1.18432 -0.28045 -1.99661 - 0.0000 -0.2000 0.5385 -1.45662 1.31824 -0.25585 0.38936 0.88416 -0.50815 -1.99661 - 0.0000 -0.2000 0.6667 -0.87051 1.20952 -0.18506 0.35588 0.57949 -0.67246 -1.99661 - 0.0000 -0.2000 0.8182 -0.38722 1.01285 -0.09631 0.28071 0.28114 -0.75603 -1.99661 - 0.0000 -0.2500 0.0526 -17.18425 -0.85792 -0.13197 -0.23919 2.61572 0.46124 -1.79314 - 0.0000 -0.2500 0.1111 -8.57583 0.24411 -0.19472 -0.03893 2.12538 0.71666 -1.79314 - 0.0000 -0.2500 0.1765 -5.49311 0.83324 -0.24334 0.07540 1.87490 0.45172 -1.79314 - 0.0000 -0.2500 0.2500 -3.84539 1.05108 -0.27456 0.23611 1.64385 0.36738 -1.79314 - 0.0000 -0.2500 0.3333 -2.76387 1.16731 -0.28359 0.30358 1.39405 0.06708 -1.79314 - 0.0000 -0.2500 0.4286 -1.95956 1.21408 -0.26768 0.34057 1.12315 -0.20495 -1.79314 - 0.0000 -0.2500 0.5385 -1.31711 1.18985 -0.22684 0.34522 0.83835 -0.43305 -1.79314 - 0.0000 -0.2500 0.6667 -0.78741 1.09247 -0.16408 0.31553 0.54938 -0.60077 -1.79314 - 0.0000 -0.2500 0.8182 -0.35036 0.91527 -0.08539 0.24889 0.26650 -0.69140 -1.79314 - 0.0000 -0.3000 0.0526 -15.57964 -0.78649 -0.11767 -0.21326 2.49271 0.55906 -1.61926 - 0.0000 -0.3000 0.1111 -7.77770 0.21520 -0.17362 -0.03471 2.02415 0.78352 -1.61926 - 0.0000 -0.3000 0.1765 -4.98405 0.75092 -0.21697 0.06722 1.78478 0.51428 -1.61926 - 0.0000 -0.3000 0.2500 -3.49072 0.95006 -0.24480 0.21052 1.56430 0.43076 -1.61926 - 0.0000 -0.3000 0.3333 -2.51016 1.05696 -0.25286 0.27067 1.32625 0.13328 -1.61926 - 0.0000 -0.3000 0.4286 -1.78047 1.10066 -0.23867 0.30366 1.06831 -0.13726 -1.61926 - 0.0000 -0.3000 0.5385 -1.19721 1.07967 -0.20226 0.30781 0.79728 -0.36573 -1.61926 - 0.0000 -0.3000 0.6667 -0.71598 0.99196 -0.14629 0.28133 0.52239 -0.53650 -1.61926 - 0.0000 -0.3000 0.8182 -0.31867 0.83144 -0.07614 0.22191 0.25337 -0.63346 -1.61926 - 0.0000 -0.3500 0.0526 -14.19291 -0.72413 -0.10545 -0.19112 2.38201 0.64710 -1.46949 - 0.0000 -0.3500 0.1111 -7.08776 0.19066 -0.15559 -0.03111 1.93305 0.84369 -1.46949 - 0.0000 -0.3500 0.1765 -4.54383 0.68010 -0.19444 0.06024 1.70368 0.57057 -1.46949 - 0.0000 -0.3500 0.2500 -3.18389 0.86297 -0.21938 0.18866 1.49272 0.48781 -1.46949 - 0.0000 -0.3500 0.3333 -2.29058 0.96169 -0.22660 0.24257 1.26523 0.19286 -1.46949 - 0.0000 -0.3500 0.4286 -1.62541 1.00265 -0.21389 0.27213 1.01895 -0.07634 -1.46949 - 0.0000 -0.3500 0.5385 -1.09336 0.98438 -0.18125 0.27584 0.76032 -0.30514 -1.46949 - 0.0000 -0.3500 0.6667 -0.65409 0.90499 -0.13110 0.25212 0.49810 -0.47866 -1.46949 - 0.0000 -0.3500 0.8182 -0.29121 0.75888 -0.06823 0.19887 0.24156 -0.58132 -1.46949 - 0.0000 -0.4000 0.0526 -12.98607 -0.66933 -0.09494 -0.17207 2.28202 0.72661 -1.33958 - 0.0000 -0.4000 0.1111 -6.48715 0.16967 -0.14008 -0.02800 1.85077 0.89804 -1.33958 - 0.0000 -0.4000 0.1765 -4.16048 0.61875 -0.17506 0.05424 1.63044 0.62142 -1.33958 - 0.0000 -0.4000 0.2500 -2.91659 0.78735 -0.19751 0.16985 1.42807 0.53933 -1.33958 - 0.0000 -0.4000 0.3333 -2.09921 0.87886 -0.20401 0.21839 1.21013 0.24667 -1.33958 - 0.0000 -0.4000 0.4286 -1.49023 0.91736 -0.19256 0.24500 0.97438 -0.02132 -1.33958 - 0.0000 -0.4000 0.5385 -1.00280 0.90140 -0.16318 0.24835 0.72694 -0.25041 -1.33958 - 0.0000 -0.4000 0.6667 -0.60010 0.82921 -0.11803 0.22699 0.47617 -0.42642 -1.33958 - 0.0000 -0.4000 0.8182 -0.26724 0.69564 -0.06143 0.17904 0.23089 -0.53423 -1.33958 - 0.0000 -0.4500 0.0526 -11.92909 -0.62086 -0.08584 -0.15557 2.19142 0.79867 -1.22617 - 0.0000 -0.4500 0.1111 -5.96098 0.15162 -0.12665 -0.02532 1.77621 0.94728 -1.22617 - 0.0000 -0.4500 0.1765 -3.82453 0.56525 -0.15827 0.04904 1.56406 0.66749 -1.22617 - 0.0000 -0.4500 0.2500 -2.68225 0.72127 -0.17857 0.15356 1.36948 0.58601 -1.22617 - 0.0000 -0.4500 0.3333 -1.93138 0.80639 -0.18445 0.19745 1.16019 0.29544 -1.22617 - 0.0000 -0.4500 0.4286 -1.37164 0.84266 -0.17410 0.22151 0.93399 0.02854 -1.22617 - 0.0000 -0.4500 0.5385 -0.92332 0.82867 -0.14754 0.22453 0.69669 -0.20082 -1.22617 - 0.0000 -0.4500 0.6667 -0.55271 0.76277 -0.10672 0.20522 0.45629 -0.37908 -1.22617 - 0.0000 -0.4500 0.8182 -0.24620 0.64016 -0.05554 0.16188 0.22122 -0.49155 -1.22617 - 0.0000 -0.5000 0.0526 -10.99800 -0.57777 -0.07791 -0.14120 2.10905 0.86417 -1.12657 - 0.0000 -0.5000 0.1111 -5.49736 0.13600 -0.11495 -0.02298 1.70843 0.99205 -1.12657 - 0.0000 -0.5000 0.1765 -3.52841 0.51833 -0.14365 0.04451 1.50372 0.70938 -1.12657 - 0.0000 -0.5000 0.2500 -2.47562 0.66319 -0.16208 0.13938 1.31622 0.62845 -1.12657 - 0.0000 -0.5000 0.3333 -1.78334 0.74261 -0.16742 0.17921 1.11479 0.33977 -1.12657 - 0.0000 -0.5000 0.4286 -1.26699 0.77685 -0.15802 0.20105 0.89727 0.07386 -1.12657 - 0.0000 -0.5000 0.5385 -0.85316 0.76456 -0.13391 0.20380 0.66919 -0.15574 -1.12657 - 0.0000 -0.5000 0.6667 -0.51087 0.70416 -0.09686 0.18627 0.43822 -0.33604 -1.12657 - 0.0000 -0.5000 0.8182 -0.22762 0.59121 -0.05041 0.14693 0.21244 -0.45276 -1.12657 - 0.0000 -0.5500 0.0526 -10.17342 -0.53927 -0.07096 -0.12862 2.03396 0.92388 -1.03864 - 0.0000 -0.5500 0.1111 -5.08667 0.12241 -0.10471 -0.02093 1.64663 1.03287 -1.03864 - 0.0000 -0.5500 0.1765 -3.26601 0.47696 -0.13085 0.04054 1.44871 0.74757 -1.03864 - 0.0000 -0.5500 0.2500 -2.29245 0.61188 -0.14764 0.12696 1.26766 0.66715 -1.03864 - 0.0000 -0.5500 0.3333 -1.65206 0.68618 -0.15250 0.16324 1.07341 0.38018 -1.03864 - 0.0000 -0.5500 0.4286 -1.17415 0.71858 -0.14394 0.18313 0.86379 0.11518 -1.03864 - 0.0000 -0.5500 0.5385 -0.79091 0.70775 -0.12198 0.18563 0.64412 -0.11464 -1.03864 - 0.0000 -0.5500 0.6667 -0.47373 0.65220 -0.08823 0.16967 0.42174 -0.29681 -1.03864 - 0.0000 -0.5500 0.8182 -0.21112 0.54779 -0.04592 0.13383 0.20442 -0.41739 -1.03864 - 0.0000 -0.6000 0.0526 -9.43959 -0.50470 -0.06485 -0.11754 1.96530 0.97848 -0.96061 - 0.0000 -0.6000 0.1111 -4.72108 0.11052 -0.09569 -0.01913 1.59014 1.07018 -0.96061 - 0.0000 -0.6000 0.1765 -3.03236 0.44030 -0.11958 0.03705 1.39841 0.78248 -0.96061 - 0.0000 -0.6000 0.2500 -2.12929 0.56630 -0.13492 0.11603 1.22327 0.70252 -0.96061 - 0.0000 -0.6000 0.3333 -1.53508 0.63601 -0.13937 0.14919 1.03557 0.41713 -0.96061 - 0.0000 -0.6000 0.4286 -1.09140 0.66672 -0.13155 0.16736 0.83318 0.15296 -0.96061 - 0.0000 -0.6000 0.5385 -0.73540 0.65716 -0.11148 0.16965 0.62120 -0.07707 -0.96061 - 0.0000 -0.6000 0.6667 -0.44060 0.60591 -0.08063 0.15506 0.40668 -0.26093 -0.96061 - 0.0000 -0.6000 0.8182 -0.19641 0.50910 -0.04196 0.12231 0.19710 -0.38505 -0.96061 - 0.0000 -0.6500 0.0526 -8.78357 -0.47353 -0.05945 -0.10775 1.90237 1.02853 -0.89105 - 0.0000 -0.6500 0.1111 -4.39418 0.10008 -0.08772 -0.01754 1.53835 1.10439 -0.89105 - 0.0000 -0.6500 0.1765 -2.82337 0.40766 -0.10962 0.03397 1.35231 0.81448 -0.89105 - 0.0000 -0.6500 0.2500 -1.98330 0.52565 -0.12368 0.10636 1.18257 0.73495 -0.89105 - 0.0000 -0.6500 0.3333 -1.43037 0.59120 -0.12776 0.13676 1.00088 0.45100 -0.89105 - 0.0000 -0.6500 0.4286 -1.01731 0.62037 -0.12059 0.15342 0.80513 0.18759 -0.89105 - 0.0000 -0.6500 0.5385 -0.68569 0.61190 -0.10219 0.15552 0.60019 -0.04263 -0.89105 - 0.0000 -0.6500 0.6667 -0.41092 0.56448 -0.07392 0.14214 0.39287 -0.22805 -0.89105 - 0.0000 -0.6500 0.8182 -0.18322 0.47446 -0.03847 0.11212 0.19038 -0.35541 -0.89105 - 0.0000 -0.7000 0.0526 -8.19467 -0.44532 -0.05466 -0.09906 1.84455 1.07451 -0.82879 - 0.0000 -0.7000 0.1111 -4.10065 0.09087 -0.08064 -0.01612 1.49077 1.13582 -0.82879 - 0.0000 -0.7000 0.1765 -2.63565 0.37848 -0.10078 0.03122 1.30995 0.84389 -0.82879 - 0.0000 -0.7000 0.2500 -1.85212 0.48923 -0.11371 0.09778 1.14518 0.76474 -0.82879 - 0.0000 -0.7000 0.3333 -1.33625 0.55101 -0.11745 0.12572 0.96901 0.48212 -0.82879 - 0.0000 -0.7000 0.4286 -0.95069 0.57875 -0.11086 0.14104 0.77935 0.21941 -0.82879 - 0.0000 -0.7000 0.5385 -0.64098 0.57126 -0.09394 0.14297 0.58088 -0.01098 -0.82879 - 0.0000 -0.7000 0.6667 -0.38423 0.52725 -0.06795 0.13068 0.38018 -0.19784 -0.82879 - 0.0000 -0.7000 0.8182 -0.17135 0.44332 -0.03536 0.10307 0.18421 -0.32818 -0.82879 - 0.0000 -0.7500 0.0526 -7.66394 -0.41969 -0.05038 -0.09131 1.79129 1.11686 -0.77283 - 0.0000 -0.7500 0.1111 -3.83606 0.08272 -0.07433 -0.01486 1.44694 1.16476 -0.77283 - 0.0000 -0.7500 0.1765 -2.46639 0.35229 -0.09289 0.02878 1.27093 0.87097 -0.77283 - 0.0000 -0.7500 0.2500 -1.73381 0.45648 -0.10481 0.09013 1.11074 0.79219 -0.77283 - 0.0000 -0.7500 0.3333 -1.25133 0.51482 -0.10826 0.11589 0.93966 0.51078 -0.77283 - 0.0000 -0.7500 0.4286 -0.89056 0.54125 -0.10219 0.13001 0.75560 0.24872 -0.77283 - 0.0000 -0.7500 0.5385 -0.60061 0.53460 -0.08659 0.13179 0.56310 0.01817 -0.77283 - 0.0000 -0.7500 0.6667 -0.36012 0.49366 -0.06264 0.12045 0.36850 -0.17002 -0.77283 - 0.0000 -0.7500 0.8182 -0.16064 0.41522 -0.03260 0.09501 0.17853 -0.30309 -0.77283 - 0.0000 -0.8000 0.0526 -7.18393 -0.39632 -0.04655 -0.08437 1.74213 1.15596 -0.72235 - 0.0000 -0.8000 0.1111 -3.59669 0.07547 -0.06869 -0.01373 1.40649 1.19148 -0.72235 - 0.0000 -0.8000 0.1765 -2.31322 0.32870 -0.08584 0.02660 1.23492 0.89597 -0.72235 - 0.0000 -0.8000 0.2500 -1.62670 0.42692 -0.09685 0.08329 1.07896 0.81752 -0.72235 - 0.0000 -0.8000 0.3333 -1.17443 0.48212 -0.10004 0.10709 0.91257 0.53724 -0.72235 - 0.0000 -0.8000 0.4286 -0.83610 0.50733 -0.09442 0.12014 0.73369 0.27577 -0.72235 - 0.0000 -0.8000 0.5385 -0.56404 0.50143 -0.08002 0.12178 0.54669 0.04508 -0.72235 - 0.0000 -0.8000 0.6667 -0.33827 0.46325 -0.05788 0.11130 0.35771 -0.14433 -0.72235 - 0.0000 -0.8000 0.8182 -0.15092 0.38977 -0.03012 0.08779 0.17329 -0.27994 -0.72235 - 1.0000 0.0000 0.0526 -30.81649 -1.44276 -0.25840 -0.46833 3.49718 -0.23974 -3.28889 - 1.0000 0.0000 0.1111 -15.34977 0.50507 -0.38127 -0.07622 2.85075 0.23756 -3.28889 - 1.0000 0.0000 0.1765 -9.80824 1.54392 -0.47646 0.14763 2.52064 0.00348 -3.28889 - 1.0000 0.0000 0.2500 -6.84756 1.91646 -0.53758 0.46229 2.21382 -0.08682 -3.28889 - 1.0000 0.0000 0.3333 -4.90844 2.10817 -0.55528 0.59440 1.87986 -0.40731 -3.28889 - 1.0000 0.0000 0.4286 -3.47136 2.17774 -0.52412 0.66684 1.51611 -0.68999 -3.28889 - 1.0000 0.0000 0.5385 -2.32806 2.12361 -0.44415 0.67594 1.13263 -0.91548 -3.28889 - 1.0000 0.0000 0.6667 -1.38910 1.94261 -0.32126 0.61781 0.74277 -1.06132 -3.28889 - 1.0000 0.0000 0.8182 -0.61706 1.62330 -0.16720 0.48732 0.36055 -1.10657 -3.28889 - 1.0000 -0.0500 0.0526 -27.00561 -1.28239 -0.22236 -0.40301 3.27503 -0.06307 -2.86802 - 1.0000 -0.0500 0.1111 -13.45705 0.42994 -0.32809 -0.06559 2.66794 0.35831 -2.86802 - 1.0000 -0.0500 0.1765 -8.60330 1.34365 -0.41001 0.12704 2.35790 0.11645 -2.86802 - 1.0000 -0.0500 0.2500 -6.00985 1.67352 -0.46260 0.39782 2.07017 0.02766 -2.86802 - 1.0000 -0.0500 0.3333 -4.31047 1.84467 -0.47783 0.51150 1.75742 -0.28775 -2.86802 - 1.0000 -0.0500 0.4286 -3.05011 1.90833 -0.45102 0.57383 1.41707 -0.56774 -2.86802 - 1.0000 -0.0500 0.5385 -2.04654 1.86290 -0.38221 0.58167 1.05846 -0.79389 -2.86802 - 1.0000 -0.0500 0.6667 -1.22163 1.70548 -0.27646 0.53164 0.69403 -0.94525 -2.86802 - 1.0000 -0.0500 0.8182 -0.54286 1.42595 -0.14388 0.41935 0.33685 -1.00193 -2.86802 - 1.0000 -0.1000 0.0526 -23.86910 -1.14881 -0.19305 -0.34989 3.07954 0.09239 -2.52306 - 1.0000 -0.1000 0.1111 -11.89880 0.36922 -0.28485 -0.05695 2.50707 0.46456 -2.52306 - 1.0000 -0.1000 0.1765 -7.61092 1.17963 -0.35597 0.11029 2.21469 0.21586 -2.52306 - 1.0000 -0.1000 0.2500 -5.31961 1.47410 -0.40163 0.34539 1.94377 0.12838 -2.52306 - 1.0000 -0.1000 0.3333 -3.81753 1.62805 -0.41486 0.44409 1.64968 -0.18255 -2.52306 - 1.0000 -0.1000 0.4286 -2.70270 1.68660 -0.39158 0.49820 1.32993 -0.46017 -2.52306 - 1.0000 -0.1000 0.5385 -1.81428 1.64817 -0.33183 0.50501 0.99320 -0.68691 -2.52306 - 1.0000 -0.1000 0.6667 -1.08343 1.51005 -0.24002 0.46157 0.65114 -0.84311 -2.52306 - 1.0000 -0.1000 0.8182 -0.48162 1.26323 -0.12491 0.36408 0.31599 -0.90986 -2.52306 - 1.0000 -0.1500 0.0526 -21.25599 -1.03622 -0.16893 -0.30616 2.90663 0.22990 -2.23679 - 1.0000 -0.1500 0.1111 -10.60019 0.31953 -0.24925 -0.04983 2.36477 0.55854 -2.23679 - 1.0000 -0.1500 0.1765 -6.78356 1.04365 -0.31148 0.09651 2.08802 0.30379 -2.23679 - 1.0000 -0.1500 0.2500 -4.74389 1.30838 -0.35144 0.30222 1.83195 0.21748 -2.23679 - 1.0000 -0.1500 0.3333 -3.40621 1.44777 -0.36301 0.38858 1.55438 -0.08949 -2.23679 - 1.0000 -0.1500 0.4286 -2.41270 1.50189 -0.34264 0.43594 1.25284 -0.36502 -2.23679 - 1.0000 -0.1500 0.5385 -1.62033 1.46913 -0.29036 0.44189 0.93547 -0.59227 -2.23679 - 1.0000 -0.1500 0.6667 -0.96798 1.34701 -0.21002 0.40389 0.61321 -0.75277 -2.23679 - 1.0000 -0.1500 0.8182 -0.43044 1.12742 -0.10930 0.31858 0.29754 -0.82842 -2.23679 - 1.0000 -0.2000 0.0526 -19.05535 -0.94034 -0.14885 -0.26977 2.75294 0.35212 -1.99661 - 1.0000 -0.2000 0.1111 -9.50624 0.27843 -0.21962 -0.04391 2.23830 0.64208 -1.99661 - 1.0000 -0.2000 0.1765 -6.08633 0.92969 -0.27446 0.08504 1.97542 0.38195 -1.99661 - 1.0000 -0.2000 0.2500 -4.25852 1.16916 -0.30966 0.26629 1.73257 0.29667 -1.99661 - 1.0000 -0.2000 0.3333 -3.05929 1.29612 -0.31986 0.34239 1.46967 -0.00677 -1.99661 - 1.0000 -0.2000 0.4286 -2.16801 1.34633 -0.30191 0.38412 1.18432 -0.28045 -1.99661 - 1.0000 -0.2000 0.5385 -1.45662 1.31824 -0.25585 0.38936 0.88416 -0.50815 -1.99661 - 1.0000 -0.2000 0.6667 -0.87051 1.20952 -0.18506 0.35588 0.57949 -0.67246 -1.99661 - 1.0000 -0.2000 0.8182 -0.38722 1.01285 -0.09631 0.28071 0.28114 -0.75603 -1.99661 - 1.0000 -0.2500 0.0526 -17.18425 -0.85792 -0.13197 -0.23919 2.61572 0.46124 -1.79314 - 1.0000 -0.2500 0.1111 -8.57583 0.24411 -0.19472 -0.03893 2.12538 0.71666 -1.79314 - 1.0000 -0.2500 0.1765 -5.49311 0.83324 -0.24334 0.07540 1.87490 0.45172 -1.79314 - 1.0000 -0.2500 0.2500 -3.84539 1.05108 -0.27456 0.23611 1.64385 0.36738 -1.79314 - 1.0000 -0.2500 0.3333 -2.76387 1.16731 -0.28359 0.30358 1.39405 0.06708 -1.79314 - 1.0000 -0.2500 0.4286 -1.95956 1.21408 -0.26768 0.34057 1.12315 -0.20495 -1.79314 - 1.0000 -0.2500 0.5385 -1.31711 1.18985 -0.22684 0.34522 0.83835 -0.43305 -1.79314 - 1.0000 -0.2500 0.6667 -0.78741 1.09247 -0.16408 0.31553 0.54938 -0.60077 -1.79314 - 1.0000 -0.2500 0.8182 -0.35036 0.91527 -0.08539 0.24889 0.26650 -0.69140 -1.79314 - 1.0000 -0.3000 0.0526 -15.57964 -0.78649 -0.11767 -0.21326 2.49271 0.55906 -1.61926 - 1.0000 -0.3000 0.1111 -7.77770 0.21520 -0.17362 -0.03471 2.02415 0.78352 -1.61926 - 1.0000 -0.3000 0.1765 -4.98405 0.75092 -0.21697 0.06722 1.78478 0.51428 -1.61926 - 1.0000 -0.3000 0.2500 -3.49072 0.95006 -0.24480 0.21052 1.56430 0.43076 -1.61926 - 1.0000 -0.3000 0.3333 -2.51016 1.05696 -0.25286 0.27067 1.32625 0.13328 -1.61926 - 1.0000 -0.3000 0.4286 -1.78047 1.10066 -0.23867 0.30366 1.06831 -0.13726 -1.61926 - 1.0000 -0.3000 0.5385 -1.19721 1.07967 -0.20226 0.30781 0.79728 -0.36573 -1.61926 - 1.0000 -0.3000 0.6667 -0.71598 0.99196 -0.14629 0.28133 0.52239 -0.53650 -1.61926 - 1.0000 -0.3000 0.8182 -0.31867 0.83144 -0.07614 0.22191 0.25337 -0.63346 -1.61926 - 1.0000 -0.3500 0.0526 -14.19291 -0.72413 -0.10545 -0.19112 2.38201 0.64710 -1.46949 - 1.0000 -0.3500 0.1111 -7.08776 0.19066 -0.15559 -0.03111 1.93305 0.84369 -1.46949 - 1.0000 -0.3500 0.1765 -4.54383 0.68010 -0.19444 0.06024 1.70368 0.57057 -1.46949 - 1.0000 -0.3500 0.2500 -3.18389 0.86297 -0.21938 0.18866 1.49272 0.48781 -1.46949 - 1.0000 -0.3500 0.3333 -2.29058 0.96169 -0.22660 0.24257 1.26523 0.19286 -1.46949 - 1.0000 -0.3500 0.4286 -1.62541 1.00265 -0.21389 0.27213 1.01895 -0.07634 -1.46949 - 1.0000 -0.3500 0.5385 -1.09336 0.98438 -0.18125 0.27584 0.76032 -0.30514 -1.46949 - 1.0000 -0.3500 0.6667 -0.65409 0.90499 -0.13110 0.25212 0.49810 -0.47866 -1.46949 - 1.0000 -0.3500 0.8182 -0.29121 0.75888 -0.06823 0.19887 0.24156 -0.58132 -1.46949 - 1.0000 -0.4000 0.0526 -12.98607 -0.66933 -0.09494 -0.17207 2.28202 0.72661 -1.33958 - 1.0000 -0.4000 0.1111 -6.48715 0.16967 -0.14008 -0.02800 1.85077 0.89804 -1.33958 - 1.0000 -0.4000 0.1765 -4.16048 0.61875 -0.17506 0.05424 1.63044 0.62142 -1.33958 - 1.0000 -0.4000 0.2500 -2.91659 0.78735 -0.19751 0.16985 1.42807 0.53933 -1.33958 - 1.0000 -0.4000 0.3333 -2.09921 0.87886 -0.20401 0.21839 1.21013 0.24667 -1.33958 - 1.0000 -0.4000 0.4286 -1.49023 0.91736 -0.19256 0.24500 0.97438 -0.02132 -1.33958 - 1.0000 -0.4000 0.5385 -1.00280 0.90140 -0.16318 0.24835 0.72694 -0.25041 -1.33958 - 1.0000 -0.4000 0.6667 -0.60010 0.82921 -0.11803 0.22699 0.47617 -0.42642 -1.33958 - 1.0000 -0.4000 0.8182 -0.26724 0.69564 -0.06143 0.17904 0.23089 -0.53423 -1.33958 - 1.0000 -0.4500 0.0526 -11.92909 -0.62086 -0.08584 -0.15557 2.19142 0.79867 -1.22617 - 1.0000 -0.4500 0.1111 -5.96098 0.15162 -0.12665 -0.02532 1.77621 0.94728 -1.22617 - 1.0000 -0.4500 0.1765 -3.82453 0.56525 -0.15827 0.04904 1.56406 0.66749 -1.22617 - 1.0000 -0.4500 0.2500 -2.68225 0.72127 -0.17857 0.15356 1.36948 0.58601 -1.22617 - 1.0000 -0.4500 0.3333 -1.93138 0.80639 -0.18445 0.19745 1.16019 0.29544 -1.22617 - 1.0000 -0.4500 0.4286 -1.37164 0.84266 -0.17410 0.22151 0.93399 0.02854 -1.22617 - 1.0000 -0.4500 0.5385 -0.92332 0.82867 -0.14754 0.22453 0.69669 -0.20082 -1.22617 - 1.0000 -0.4500 0.6667 -0.55271 0.76277 -0.10672 0.20522 0.45629 -0.37908 -1.22617 - 1.0000 -0.4500 0.8182 -0.24620 0.64016 -0.05554 0.16188 0.22122 -0.49155 -1.22617 - 1.0000 -0.5000 0.0526 -10.99800 -0.57777 -0.07791 -0.14120 2.10905 0.86417 -1.12657 - 1.0000 -0.5000 0.1111 -5.49736 0.13600 -0.11495 -0.02298 1.70843 0.99205 -1.12657 - 1.0000 -0.5000 0.1765 -3.52841 0.51833 -0.14365 0.04451 1.50372 0.70938 -1.12657 - 1.0000 -0.5000 0.2500 -2.47562 0.66319 -0.16208 0.13938 1.31622 0.62845 -1.12657 - 1.0000 -0.5000 0.3333 -1.78334 0.74261 -0.16742 0.17921 1.11479 0.33977 -1.12657 - 1.0000 -0.5000 0.4286 -1.26699 0.77685 -0.15802 0.20105 0.89727 0.07386 -1.12657 - 1.0000 -0.5000 0.5385 -0.85316 0.76456 -0.13391 0.20380 0.66919 -0.15574 -1.12657 - 1.0000 -0.5000 0.6667 -0.51087 0.70416 -0.09686 0.18627 0.43822 -0.33604 -1.12657 - 1.0000 -0.5000 0.8182 -0.22762 0.59121 -0.05041 0.14693 0.21244 -0.45276 -1.12657 - 1.0000 -0.5500 0.0526 -10.17342 -0.53927 -0.07096 -0.12862 2.03396 0.92388 -1.03864 - 1.0000 -0.5500 0.1111 -5.08667 0.12241 -0.10471 -0.02093 1.64663 1.03287 -1.03864 - 1.0000 -0.5500 0.1765 -3.26601 0.47696 -0.13085 0.04054 1.44871 0.74757 -1.03864 - 1.0000 -0.5500 0.2500 -2.29245 0.61188 -0.14764 0.12696 1.26766 0.66715 -1.03864 - 1.0000 -0.5500 0.3333 -1.65206 0.68618 -0.15250 0.16324 1.07341 0.38018 -1.03864 - 1.0000 -0.5500 0.4286 -1.17415 0.71858 -0.14394 0.18313 0.86379 0.11518 -1.03864 - 1.0000 -0.5500 0.5385 -0.79091 0.70775 -0.12198 0.18563 0.64412 -0.11464 -1.03864 - 1.0000 -0.5500 0.6667 -0.47373 0.65220 -0.08823 0.16967 0.42174 -0.29681 -1.03864 - 1.0000 -0.5500 0.8182 -0.21112 0.54779 -0.04592 0.13383 0.20442 -0.41739 -1.03864 - 1.0000 -0.6000 0.0526 -9.43959 -0.50470 -0.06485 -0.11754 1.96530 0.97848 -0.96061 - 1.0000 -0.6000 0.1111 -4.72108 0.11052 -0.09569 -0.01913 1.59014 1.07018 -0.96061 - 1.0000 -0.6000 0.1765 -3.03236 0.44030 -0.11958 0.03705 1.39841 0.78248 -0.96061 - 1.0000 -0.6000 0.2500 -2.12929 0.56630 -0.13492 0.11603 1.22327 0.70252 -0.96061 - 1.0000 -0.6000 0.3333 -1.53508 0.63601 -0.13937 0.14919 1.03557 0.41713 -0.96061 - 1.0000 -0.6000 0.4286 -1.09140 0.66672 -0.13155 0.16736 0.83318 0.15296 -0.96061 - 1.0000 -0.6000 0.5385 -0.73540 0.65716 -0.11148 0.16965 0.62120 -0.07707 -0.96061 - 1.0000 -0.6000 0.6667 -0.44060 0.60591 -0.08063 0.15506 0.40668 -0.26093 -0.96061 - 1.0000 -0.6000 0.8182 -0.19641 0.50910 -0.04196 0.12231 0.19710 -0.38505 -0.96061 - 1.0000 -0.6500 0.0526 -8.78357 -0.47353 -0.05945 -0.10775 1.90237 1.02853 -0.89105 - 1.0000 -0.6500 0.1111 -4.39418 0.10008 -0.08772 -0.01754 1.53835 1.10439 -0.89105 - 1.0000 -0.6500 0.1765 -2.82337 0.40766 -0.10962 0.03397 1.35231 0.81448 -0.89105 - 1.0000 -0.6500 0.2500 -1.98330 0.52565 -0.12368 0.10636 1.18257 0.73495 -0.89105 - 1.0000 -0.6500 0.3333 -1.43037 0.59120 -0.12776 0.13676 1.00088 0.45100 -0.89105 - 1.0000 -0.6500 0.4286 -1.01731 0.62037 -0.12059 0.15342 0.80513 0.18759 -0.89105 - 1.0000 -0.6500 0.5385 -0.68569 0.61190 -0.10219 0.15552 0.60019 -0.04263 -0.89105 - 1.0000 -0.6500 0.6667 -0.41092 0.56448 -0.07392 0.14214 0.39287 -0.22805 -0.89105 - 1.0000 -0.6500 0.8182 -0.18322 0.47446 -0.03847 0.11212 0.19038 -0.35541 -0.89105 - 1.0000 -0.7000 0.0526 -8.19467 -0.44532 -0.05466 -0.09906 1.84455 1.07451 -0.82879 - 1.0000 -0.7000 0.1111 -4.10065 0.09087 -0.08064 -0.01612 1.49077 1.13582 -0.82879 - 1.0000 -0.7000 0.1765 -2.63565 0.37848 -0.10078 0.03122 1.30995 0.84389 -0.82879 - 1.0000 -0.7000 0.2500 -1.85212 0.48923 -0.11371 0.09778 1.14518 0.76474 -0.82879 - 1.0000 -0.7000 0.3333 -1.33625 0.55101 -0.11745 0.12572 0.96901 0.48212 -0.82879 - 1.0000 -0.7000 0.4286 -0.95069 0.57875 -0.11086 0.14104 0.77935 0.21941 -0.82879 - 1.0000 -0.7000 0.5385 -0.64098 0.57126 -0.09394 0.14297 0.58088 -0.01098 -0.82879 - 1.0000 -0.7000 0.6667 -0.38423 0.52725 -0.06795 0.13068 0.38018 -0.19784 -0.82879 - 1.0000 -0.7000 0.8182 -0.17135 0.44332 -0.03536 0.10307 0.18421 -0.32818 -0.82879 - 1.0000 -0.7500 0.0526 -7.66394 -0.41969 -0.05038 -0.09131 1.79129 1.11686 -0.77283 - 1.0000 -0.7500 0.1111 -3.83606 0.08272 -0.07433 -0.01486 1.44694 1.16476 -0.77283 - 1.0000 -0.7500 0.1765 -2.46639 0.35229 -0.09289 0.02878 1.27093 0.87097 -0.77283 - 1.0000 -0.7500 0.2500 -1.73381 0.45648 -0.10481 0.09013 1.11074 0.79219 -0.77283 - 1.0000 -0.7500 0.3333 -1.25133 0.51482 -0.10826 0.11589 0.93966 0.51078 -0.77283 - 1.0000 -0.7500 0.4286 -0.89056 0.54125 -0.10219 0.13001 0.75560 0.24872 -0.77283 - 1.0000 -0.7500 0.5385 -0.60061 0.53460 -0.08659 0.13179 0.56310 0.01817 -0.77283 - 1.0000 -0.7500 0.6667 -0.36012 0.49366 -0.06264 0.12045 0.36850 -0.17002 -0.77283 - 1.0000 -0.7500 0.8182 -0.16064 0.41522 -0.03260 0.09501 0.17853 -0.30309 -0.77283 - 1.0000 -0.8000 0.0526 -7.18393 -0.39632 -0.04655 -0.08437 1.74213 1.15596 -0.72235 - 1.0000 -0.8000 0.1111 -3.59669 0.07547 -0.06869 -0.01373 1.40649 1.19148 -0.72235 - 1.0000 -0.8000 0.1765 -2.31322 0.32870 -0.08584 0.02660 1.23492 0.89597 -0.72235 - 1.0000 -0.8000 0.2500 -1.62670 0.42692 -0.09685 0.08329 1.07896 0.81752 -0.72235 - 1.0000 -0.8000 0.3333 -1.17443 0.48212 -0.10004 0.10709 0.91257 0.53724 -0.72235 - 1.0000 -0.8000 0.4286 -0.83610 0.50733 -0.09442 0.12014 0.73369 0.27577 -0.72235 - 1.0000 -0.8000 0.5385 -0.56404 0.50143 -0.08002 0.12178 0.54669 0.04508 -0.72235 - 1.0000 -0.8000 0.6667 -0.33827 0.46325 -0.05788 0.11130 0.35771 -0.14433 -0.72235 - 1.0000 -0.8000 0.8182 -0.15092 0.38977 -0.03012 0.08779 0.17329 -0.27994 -0.72235 - 1.5000 0.0000 0.0526 -32.40743 0.14086 -0.26825 -0.44268 3.68791 -0.23885 -3.28889 - 1.5000 0.0000 0.1111 -15.70563 1.16018 -0.38885 -0.04763 2.96591 0.18806 -3.28889 - 1.5000 0.0000 0.1765 -9.86417 1.94817 -0.47655 0.16994 2.57549 -0.08160 -3.28889 - 1.5000 0.0000 0.2500 -6.78426 2.17304 -0.52728 0.46957 2.22114 -0.18081 -3.28889 - 1.5000 0.0000 0.3333 -4.79394 2.26072 -0.53444 0.58547 1.85359 -0.48826 -3.28889 - 1.5000 0.0000 0.4286 -3.34308 2.24929 -0.49531 0.64333 1.47024 -0.75988 -3.28889 - 1.5000 0.0000 0.5385 -2.21110 2.13312 -0.41228 0.63996 1.08071 -0.95976 -3.28889 - 1.5000 0.0000 0.6667 -1.30123 1.90877 -0.29291 0.57499 0.69729 -1.07754 -3.28889 - 1.5000 0.0000 0.8182 -0.57014 1.56787 -0.14967 0.44664 0.33277 -1.09779 -3.28889 - 1.5000 -0.0500 0.0526 -28.39904 0.10341 -0.23084 -0.38094 3.45329 -0.05583 -2.86802 - 1.5000 -0.0500 0.1111 -13.76929 1.00362 -0.33461 -0.04099 2.77544 0.31631 -2.86802 - 1.5000 -0.0500 0.1765 -8.65266 1.69805 -0.41009 0.14623 2.40902 0.03916 -2.86802 - 1.5000 -0.0500 0.2500 -5.95448 1.89874 -0.45374 0.40408 2.07689 -0.05948 -2.86802 - 1.5000 -0.0500 0.3333 -4.20999 1.97877 -0.45990 0.50382 1.73279 -0.36450 -2.86802 - 1.5000 -0.0500 0.4286 -2.93741 1.97129 -0.42623 0.55361 1.37415 -0.63430 -2.86802 - 1.5000 -0.0500 0.5385 -1.94369 1.87132 -0.35478 0.55070 1.00992 -0.83684 -2.86802 - 1.5000 -0.0500 0.6667 -1.14432 1.67575 -0.25206 0.49479 0.65153 -0.96190 -2.86802 - 1.5000 -0.0500 0.8182 -0.50156 1.37718 -0.12880 0.38435 0.31089 -0.99481 -2.86802 - 1.5000 -0.1000 0.0526 -25.10021 0.07436 -0.20041 -0.33073 3.24684 0.10522 -2.52306 - 1.5000 -0.1000 0.1111 -12.17512 0.87592 -0.29051 -0.03558 2.60783 0.42916 -2.52306 - 1.5000 -0.1000 0.1765 -7.65483 1.49300 -0.35604 0.12696 2.26253 0.14543 -2.52306 - 1.5000 -0.1000 0.2500 -5.27076 1.67347 -0.39394 0.35082 1.94996 0.04729 -2.52306 - 1.5000 -0.1000 0.3333 -3.72862 1.74692 -0.39929 0.43741 1.62649 -0.25560 -2.52306 - 1.5000 -0.1000 0.4286 -2.60285 1.74248 -0.37005 0.48064 1.28961 -0.52380 -2.52306 - 1.5000 -0.1000 0.5385 -1.72309 1.65568 -0.30802 0.47812 0.94763 -0.72867 -2.52306 - 1.5000 -0.1000 0.6667 -1.01483 1.48371 -0.21884 0.42958 0.61126 -0.86015 -2.52306 - 1.5000 -0.1000 0.8182 -0.44495 1.21997 -0.11182 0.33369 0.29164 -0.90420 -2.52306 - 1.5000 -0.1500 0.0526 -22.35191 0.05161 -0.17537 -0.28939 3.06423 0.24767 -2.23679 - 1.5000 -0.1500 0.1111 -10.84655 0.77046 -0.25420 -0.03114 2.45958 0.52898 -2.23679 - 1.5000 -0.1500 0.1765 -6.82292 1.32283 -0.31154 0.11109 2.13295 0.23943 -2.23679 - 1.5000 -0.1500 0.2500 -4.70047 1.48619 -0.34470 0.30697 1.83769 0.14173 -2.23679 - 1.5000 -0.1500 0.3333 -3.32694 1.55393 -0.34938 0.38275 1.53247 -0.15928 -2.23679 - 1.5000 -0.1500 0.4286 -2.32357 1.55183 -0.32380 0.42057 1.21482 -0.42605 -2.23679 - 1.5000 -0.1500 0.5385 -1.53886 1.47589 -0.26952 0.41836 0.89254 -0.63300 -2.23679 - 1.5000 -0.1500 0.6667 -0.90667 1.32350 -0.19149 0.37589 0.57564 -0.77014 -2.23679 - 1.5000 -0.1500 0.8182 -0.39766 1.08875 -0.09785 0.29199 0.27461 -0.82404 -2.23679 - 1.5000 -0.2000 0.0526 -20.03747 0.03364 -0.15452 -0.25499 2.90192 0.37428 -1.99661 - 1.5000 -0.2000 0.1111 -9.72735 0.68242 -0.22399 -0.02744 2.32781 0.61771 -1.99661 - 1.5000 -0.2000 0.1765 -6.12183 1.18005 -0.27451 0.09789 2.01778 0.32298 -1.99661 - 1.5000 -0.2000 0.2500 -4.21966 1.32880 -0.30373 0.27048 1.73790 0.22566 -1.99661 - 1.5000 -0.2000 0.3333 -2.98814 1.39154 -0.30785 0.33725 1.44889 -0.07366 -1.99661 - 1.5000 -0.2000 0.4286 -2.08792 1.39127 -0.28531 0.37058 1.14835 -0.33917 -1.99661 - 1.5000 -0.2000 0.5385 -1.38336 1.32435 -0.23749 0.36863 0.84356 -0.54795 -1.99661 - 1.5000 -0.2000 0.6667 -0.81534 1.18840 -0.16872 0.33121 0.54398 -0.69014 -1.99661 - 1.5000 -0.2000 0.8182 -0.35771 0.97807 -0.08622 0.25728 0.25947 -0.75280 -1.99661 - 1.5000 -0.2500 0.0526 -18.06964 0.01935 -0.13700 -0.22609 2.75701 0.48733 -1.79314 - 1.5000 -0.2500 0.1111 -8.77545 0.60820 -0.19859 -0.02433 2.21016 0.69692 -1.79314 - 1.5000 -0.2500 0.1765 -5.52532 1.05911 -0.24339 0.08679 1.91496 0.39757 -1.79314 - 1.5000 -0.2500 0.2500 -3.81040 1.19525 -0.26930 0.23982 1.64880 0.30061 -1.79314 - 1.5000 -0.2500 0.3333 -2.69964 1.25359 -0.27295 0.29902 1.37428 0.00278 -1.79314 - 1.5000 -0.2500 0.4286 -1.88718 1.25475 -0.25297 0.32857 1.08900 -0.26160 -1.79314 - 1.5000 -0.2500 0.5385 -1.25086 1.19541 -0.21056 0.32684 0.79984 -0.47203 -1.79314 - 1.5000 -0.2500 0.6667 -0.73750 1.07338 -0.14960 0.29366 0.51571 -0.61872 -1.79314 - 1.5000 -0.2500 0.8182 -0.32365 0.88380 -0.07644 0.22811 0.24596 -0.68920 -1.79314 - 1.5000 -0.3000 0.0526 -16.38210 0.00792 -0.12216 -0.20158 2.62709 0.58867 -1.61926 - 1.5000 -0.3000 0.1111 -7.95889 0.54510 -0.17707 -0.02169 2.10469 0.76793 -1.61926 - 1.5000 -0.3000 0.1765 -5.01342 0.95577 -0.21701 0.07738 1.82278 0.46445 -1.61926 - 1.5000 -0.3000 0.2500 -3.45905 1.08095 -0.24011 0.21383 1.56893 0.36779 -1.61926 - 1.5000 -0.3000 0.3333 -2.45186 1.13538 -0.24337 0.26661 1.30739 0.07130 -1.61926 - 1.5000 -0.3000 0.4286 -1.71471 1.13766 -0.22555 0.29296 1.03580 -0.19207 -1.61926 - 1.5000 -0.3000 0.5385 -1.13697 1.08476 -0.18774 0.29142 0.76064 -0.40396 -1.61926 - 1.5000 -0.3000 0.6667 -0.67057 0.97462 -0.13338 0.26183 0.49037 -0.55469 -1.61926 - 1.5000 -0.3000 0.8182 -0.29436 0.80282 -0.06816 0.20339 0.23385 -0.63217 -1.61926 - 1.5000 -0.3500 0.0526 -14.92372 -0.00125 -0.10947 -0.18065 2.51018 0.67987 -1.46949 - 1.5000 -0.3500 0.1111 -7.25299 0.49102 -0.15868 -0.01944 2.00977 0.83184 -1.46949 - 1.5000 -0.3500 0.1765 -4.57074 0.86679 -0.19447 0.06935 1.73982 0.52463 -1.46949 - 1.5000 -0.3500 0.2500 -3.15509 0.98237 -0.21518 0.19162 1.49705 0.42825 -1.46949 - 1.5000 -0.3500 0.3333 -2.23742 1.03330 -0.21810 0.23892 1.24719 0.13297 -1.46949 - 1.5000 -0.3500 0.4286 -1.56539 1.03646 -0.20213 0.26254 0.98792 -0.12949 -1.46949 - 1.5000 -0.3500 0.5385 -1.03834 0.98905 -0.16825 0.26116 0.72537 -0.34271 -1.46949 - 1.5000 -0.3500 0.6667 -0.61260 0.88916 -0.11953 0.23464 0.46757 -0.49706 -1.46949 - 1.5000 -0.3500 0.8182 -0.26898 0.73273 -0.06108 0.18227 0.22294 -0.58086 -1.46949 - 1.5000 -0.4000 0.0526 -13.65454 -0.00863 -0.09856 -0.16264 2.40459 0.76224 -1.33958 - 1.5000 -0.4000 0.1111 -6.63849 0.44435 -0.14286 -0.01750 1.92405 0.88956 -1.33958 - 1.5000 -0.4000 0.1765 -4.18524 0.78962 -0.17509 0.06244 1.66489 0.57898 -1.33958 - 1.5000 -0.4000 0.2500 -2.89028 0.89673 -0.19373 0.17252 1.43213 0.48286 -1.33958 - 1.5000 -0.4000 0.3333 -2.05053 0.94454 -0.19636 0.21511 1.19282 0.18867 -1.33958 - 1.5000 -0.4000 0.4286 -1.43520 0.94839 -0.18198 0.23636 0.94467 -0.07297 -1.33958 - 1.5000 -0.4000 0.5385 -0.95233 0.90571 -0.15147 0.23512 0.69351 -0.28738 -1.33958 - 1.5000 -0.4000 0.6667 -0.56202 0.81470 -0.10762 0.21125 0.44697 -0.44502 -1.33958 - 1.5000 -0.4000 0.8182 -0.24684 0.67164 -0.05499 0.16410 0.21310 -0.53451 -1.33958 - 1.5000 -0.4500 0.0526 -12.54299 -0.01459 -0.08911 -0.14705 2.30890 0.83689 -1.22617 - 1.5000 -0.4500 0.1111 -6.10015 0.40381 -0.12917 -0.01582 1.84636 0.94187 -1.22617 - 1.5000 -0.4500 0.1765 -3.84739 0.72227 -0.15830 0.05645 1.59700 0.62824 -1.22617 - 1.5000 -0.4500 0.2500 -2.65812 0.82188 -0.17515 0.15598 1.37330 0.53234 -1.22617 - 1.5000 -0.4500 0.3333 -1.88662 0.86686 -0.17753 0.19448 1.14355 0.23915 -1.22617 - 1.5000 -0.4500 0.4286 -1.32099 0.87125 -0.16453 0.21370 0.90548 -0.02175 -1.22617 - 1.5000 -0.4500 0.5385 -0.87684 0.83266 -0.13695 0.21258 0.66464 -0.23725 -1.22617 - 1.5000 -0.4500 0.6667 -0.51762 0.74940 -0.09730 0.19100 0.42831 -0.39786 -1.22617 - 1.5000 -0.4500 0.8182 -0.22740 0.61805 -0.04972 0.14837 0.20417 -0.49251 -1.22617 - 1.5000 -0.5000 0.0526 -11.56383 -0.01939 -0.08088 -0.13347 2.22191 0.90474 -1.12657 - 1.5000 -0.5000 0.1111 -5.62578 0.36838 -0.11724 -0.01436 1.77574 0.98942 -1.12657 - 1.5000 -0.5000 0.1765 -3.54959 0.66314 -0.14368 0.05124 1.53527 0.67301 -1.12657 - 1.5000 -0.5000 0.2500 -2.45341 0.75606 -0.15897 0.14157 1.31982 0.57733 -1.12657 - 1.5000 -0.5000 0.3333 -1.74203 0.79849 -0.16113 0.17652 1.09876 0.28503 -1.12657 - 1.5000 -0.5000 0.4286 -1.22021 0.80330 -0.14934 0.19396 0.86986 0.02481 -1.12657 - 1.5000 -0.5000 0.5385 -0.81021 0.76827 -0.12430 0.19295 0.63839 -0.19167 -1.12657 - 1.5000 -0.5000 0.6667 -0.47842 0.69182 -0.08831 0.17336 0.41134 -0.35498 -1.12657 - 1.5000 -0.5000 0.8182 -0.21023 0.57077 -0.04513 0.13466 0.19606 -0.45433 -1.12657 - 1.5000 -0.5500 0.0526 -10.69669 -0.02326 -0.07367 -0.12157 2.14261 0.96661 -1.03864 - 1.5000 -0.5500 0.1111 -5.20558 0.33726 -0.10679 -0.01308 1.71136 1.03277 -1.03864 - 1.5000 -0.5500 0.1765 -3.28571 0.61096 -0.13087 0.04667 1.47900 0.71383 -1.03864 - 1.5000 -0.5500 0.2500 -2.27194 0.69788 -0.14481 0.12896 1.27106 0.61834 -1.03864 - 1.5000 -0.5500 0.3333 -1.61382 0.73798 -0.14677 0.16079 1.05793 0.32686 -1.03864 - 1.5000 -0.5500 0.4286 -1.13080 0.74311 -0.13603 0.17668 0.83738 0.06726 -1.03864 - 1.5000 -0.5500 0.5385 -0.75108 0.71120 -0.11323 0.17575 0.61446 -0.15012 -1.03864 - 1.5000 -0.5500 0.6667 -0.44363 0.64077 -0.08044 0.15791 0.39587 -0.31590 -1.03864 - 1.5000 -0.5500 0.8182 -0.19499 0.52884 -0.04110 0.12266 0.18867 -0.41952 -1.03864 - 1.5000 -0.6000 0.0526 -9.92500 -0.02637 -0.06733 -0.11110 2.07010 1.02317 -0.96061 - 1.5000 -0.6000 0.1111 -4.83152 0.30978 -0.09759 -0.01195 1.65250 1.07241 -0.96061 - 1.5000 -0.6000 0.1765 -3.05072 0.56467 -0.11961 0.04265 1.42755 0.75116 -0.96061 - 1.5000 -0.6000 0.2500 -2.11029 0.64620 -0.13234 0.11785 1.22648 0.65584 -0.96061 - 1.5000 -0.6000 0.3333 -1.49956 0.68417 -0.13414 0.14694 1.02060 0.36511 -0.96061 - 1.5000 -0.6000 0.4286 -1.05111 0.68955 -0.12432 0.16147 0.80769 0.10607 -0.96061 - 1.5000 -0.6000 0.5385 -0.69836 0.66039 -0.10348 0.16062 0.59259 -0.11213 -0.96061 - 1.5000 -0.6000 0.6667 -0.41260 0.59528 -0.07352 0.14431 0.38173 -0.28016 -0.96061 - 1.5000 -0.6000 0.8182 -0.18139 0.49147 -0.03757 0.11210 0.18191 -0.38770 -0.96061 - 1.5000 -0.6500 0.0526 -9.23514 -0.02886 -0.06172 -0.10185 2.00364 1.07501 -0.89105 - 1.5000 -0.6500 0.1111 -4.49704 0.28541 -0.08946 -0.01096 1.59854 1.10873 -0.89105 - 1.5000 -0.6500 0.1765 -2.84053 0.52342 -0.10964 0.03910 1.38040 0.78537 -0.89105 - 1.5000 -0.6500 0.2500 -1.96564 0.60007 -0.12132 0.10804 1.18562 0.69021 -0.89105 - 1.5000 -0.6500 0.3333 -1.39729 0.63611 -0.12296 0.13470 0.98638 0.40016 -0.89105 - 1.5000 -0.6500 0.4286 -0.97975 0.64166 -0.11396 0.14802 0.78047 0.14165 -0.89105 - 1.5000 -0.6500 0.5385 -0.65115 0.61493 -0.09486 0.14724 0.57254 -0.07731 -0.89105 - 1.5000 -0.6500 0.6667 -0.38481 0.55457 -0.06739 0.13229 0.36876 -0.24740 -0.89105 - 1.5000 -0.6500 0.8182 -0.16920 0.45801 -0.03444 0.10276 0.17571 -0.35852 -0.89105 - 1.5000 -0.7000 0.0526 -8.61586 -0.03084 -0.05674 -0.09363 1.94257 1.12265 -0.82879 - 1.5000 -0.7000 0.1111 -4.19669 0.26370 -0.08225 -0.01007 1.54896 1.14212 -0.82879 - 1.5000 -0.7000 0.1765 -2.65173 0.48652 -0.10080 0.03594 1.33706 0.81680 -0.82879 - 1.5000 -0.7000 0.2500 -1.83567 0.55874 -0.11153 0.09932 1.14807 0.72179 -0.82879 - 1.5000 -0.7000 0.3333 -1.30537 0.59299 -0.11304 0.12384 0.95493 0.43238 -0.82879 - 1.5000 -0.7000 0.4286 -0.91560 0.59867 -0.10477 0.13607 0.75546 0.17433 -0.82879 - 1.5000 -0.7000 0.5385 -0.60868 0.57409 -0.08720 0.13536 0.55411 -0.04532 -0.82879 - 1.5000 -0.7000 0.6667 -0.35980 0.51799 -0.06195 0.12162 0.35685 -0.21730 -0.82879 - 1.5000 -0.7000 0.8182 -0.15824 0.42794 -0.03166 0.09447 0.17001 -0.33172 -0.82879 - 1.5000 -0.7500 0.0526 -8.05777 -0.03239 -0.05230 -0.08631 1.88633 1.16652 -0.77283 - 1.5000 -0.7500 0.1111 -3.92596 0.24428 -0.07581 -0.00929 1.50330 1.17286 -0.77283 - 1.5000 -0.7500 0.1765 -2.48149 0.45336 -0.09291 0.03313 1.29716 0.84575 -0.77283 - 1.5000 -0.7500 0.2500 -1.71844 0.52156 -0.10280 0.09155 1.11349 0.75088 -0.77283 - 1.5000 -0.7500 0.3333 -1.22243 0.55416 -0.10420 0.11415 0.92597 0.46205 -0.77283 - 1.5000 -0.7500 0.4286 -0.85769 0.55993 -0.09657 0.12543 0.73243 0.20444 -0.77283 - 1.5000 -0.7500 0.5385 -0.57035 0.53727 -0.08038 0.12477 0.53714 -0.01585 -0.77283 - 1.5000 -0.7500 0.6667 -0.33722 0.48499 -0.05711 0.11210 0.34588 -0.18958 -0.77283 - 1.5000 -0.7500 0.8182 -0.14834 0.40080 -0.02918 0.08708 0.16477 -0.30703 -0.77283 - 1.5000 -0.8000 0.0526 -7.55302 -0.03360 -0.04833 -0.07975 1.83441 1.20702 -0.72235 - 1.5000 -0.8000 0.1111 -3.68103 0.22685 -0.07005 -0.00858 1.46115 1.20124 -0.72235 - 1.5000 -0.8000 0.1765 -2.32744 0.42346 -0.08585 0.03062 1.26032 0.87248 -0.72235 - 1.5000 -0.8000 0.2500 -1.61231 0.48798 -0.09499 0.08460 1.08157 0.77772 -0.72235 - 1.5000 -0.8000 0.3333 -1.14732 0.51906 -0.09628 0.10548 0.89924 0.48943 -0.72235 - 1.5000 -0.8000 0.4286 -0.80524 0.52489 -0.08923 0.11590 0.71117 0.23223 -0.72235 - 1.5000 -0.8000 0.5385 -0.53561 0.50395 -0.07428 0.11529 0.52148 0.01135 -0.72235 - 1.5000 -0.8000 0.6667 -0.31675 0.45511 -0.05277 0.10359 0.33575 -0.16399 -0.72235 - 1.5000 -0.8000 0.8182 -0.13936 0.37622 -0.02696 0.08047 0.15993 -0.28425 -0.72235 - 2.0000 0.0000 0.0526 -33.67354 1.48387 -0.27398 -0.42604 3.81725 -0.27084 -3.28889 - 2.0000 0.0000 0.1111 -16.01445 1.70549 -0.39258 -0.02969 3.03931 0.13211 -3.28889 - 2.0000 0.0000 0.1765 -9.93943 2.28113 -0.47519 0.18355 2.60745 -0.15489 -3.28889 - 2.0000 0.0000 0.2500 -6.76675 2.38501 -0.51932 0.47323 2.22233 -0.25538 -3.28889 - 2.0000 0.0000 0.3333 -4.73594 2.39046 -0.52013 0.57948 1.83412 -0.55519 -3.28889 - 2.0000 0.0000 0.4286 -3.27220 2.31937 -0.47652 0.62815 1.43958 -0.81301 -3.28889 - 2.0000 0.0000 0.5385 -2.14481 2.15840 -0.39220 0.61759 1.04749 -0.99497 -3.28889 - 2.0000 0.0000 0.6667 -1.25117 1.90337 -0.27555 0.54911 0.66906 -1.09441 -3.28889 - 2.0000 0.0000 0.8182 -0.54354 1.54641 -0.13923 0.42273 0.31599 -1.09870 -3.28889 - 2.0000 -0.0500 0.0526 -29.50814 1.27887 -0.23577 -0.36662 3.57418 -0.08074 -2.86802 - 2.0000 -0.0500 0.1111 -14.04009 1.48119 -0.33782 -0.02555 2.84395 0.26723 -2.86802 - 2.0000 -0.0500 0.1765 -8.71877 1.98992 -0.40892 0.15795 2.43880 -0.02760 -2.86802 - 2.0000 -0.0500 0.2500 -5.93916 2.08472 -0.44689 0.40723 2.07794 -0.12850 -2.86802 - 2.0000 -0.0500 0.3333 -4.15906 2.09268 -0.44759 0.49866 1.71455 -0.42719 -2.86802 - 2.0000 -0.0500 0.4286 -2.87509 2.03285 -0.41006 0.54054 1.34548 -0.68456 -2.86802 - 2.0000 -0.0500 0.5385 -1.88537 1.89352 -0.33750 0.53145 0.97886 -0.87055 -2.86802 - 2.0000 -0.0500 0.6667 -1.10026 1.67096 -0.23712 0.47253 0.62515 -0.97843 -2.86802 - 2.0000 -0.0500 0.8182 -0.47814 1.35827 -0.11981 0.36377 0.29521 -0.99617 -2.86802 - 2.0000 -0.1000 0.0526 -26.08004 1.11207 -0.20470 -0.31830 3.36029 0.08653 -2.52306 - 2.0000 -0.1000 0.1111 -12.41463 1.29777 -0.29330 -0.02218 2.67206 0.38612 -2.52306 - 2.0000 -0.1000 0.1765 -7.71341 1.75104 -0.35502 0.13713 2.29040 0.08440 -2.52306 - 2.0000 -0.1000 0.2500 -5.25723 1.83804 -0.38799 0.35355 1.95088 -0.01686 -2.52306 - 2.0000 -0.1000 0.3333 -3.68350 1.84779 -0.38859 0.43294 1.60933 -0.31455 -2.52306 - 2.0000 -0.1000 0.4286 -2.54760 1.79701 -0.35602 0.46930 1.26268 -0.57153 -2.52306 - 2.0000 -0.1000 0.5385 -1.67134 1.67534 -0.29302 0.46141 0.91848 -0.76107 -2.52306 - 2.0000 -0.1000 0.6667 -0.97572 1.47943 -0.20586 0.41025 0.58651 -0.87637 -2.52306 - 2.0000 -0.1000 0.8182 -0.42416 1.20315 -0.10402 0.31583 0.27693 -0.90595 -2.52306 - 2.0000 -0.1500 0.0526 -23.22409 0.97465 -0.17911 -0.27852 3.17110 0.23449 -2.23679 - 2.0000 -0.1500 0.1111 -11.05998 1.14591 -0.25664 -0.01941 2.52000 0.49129 -2.23679 - 2.0000 -0.1500 0.1765 -6.87521 1.55268 -0.31065 0.11999 2.15913 0.18348 -2.23679 - 2.0000 -0.1500 0.2500 -4.68844 1.63290 -0.33950 0.30937 1.83850 0.08189 -2.23679 - 2.0000 -0.1500 0.3333 -3.28668 1.64391 -0.34003 0.37883 1.51626 -0.21492 -2.23679 - 2.0000 -0.1500 0.4286 -2.27422 1.60050 -0.31152 0.41064 1.18943 -0.47155 -2.23679 - 2.0000 -0.1500 0.5385 -1.49262 1.49343 -0.25640 0.40374 0.86507 -0.66423 -2.23679 - 2.0000 -0.1500 0.6667 -0.87170 1.31965 -0.18013 0.35897 0.55233 -0.78610 -2.23679 - 2.0000 -0.1500 0.8182 -0.37905 1.07370 -0.09102 0.27635 0.26076 -0.82615 -2.23679 - 2.0000 -0.2000 0.0526 -20.81902 0.86021 -0.15782 -0.24541 3.00294 0.36600 -1.99661 - 2.0000 -0.2000 0.1111 -9.91880 1.01881 -0.22613 -0.01710 2.38486 0.58477 -1.99661 - 2.0000 -0.2000 0.1765 -6.16881 1.38616 -0.27372 0.10573 2.04246 0.27154 -1.99661 - 2.0000 -0.2000 0.2500 -4.20890 1.46046 -0.29915 0.27259 1.73860 0.16966 -1.99661 - 2.0000 -0.2000 0.3333 -2.95198 1.47235 -0.29961 0.33380 1.43354 -0.12637 -1.99661 - 2.0000 -0.2000 0.4286 -2.04355 1.43500 -0.27449 0.36183 1.12433 -0.38268 -1.99661 - 2.0000 -0.2000 0.5385 -1.34176 1.34011 -0.22592 0.35575 0.81760 -0.57815 -1.99661 - 2.0000 -0.2000 0.6667 -0.78387 1.18492 -0.15872 0.31630 0.52195 -0.70586 -1.99661 - 2.0000 -0.2000 0.8182 -0.34096 0.96450 -0.08020 0.24350 0.24639 -0.75522 -1.99661 - 2.0000 -0.2500 0.0526 -18.77417 0.76397 -0.13993 -0.21759 2.85280 0.48342 -1.79314 - 2.0000 -0.2500 0.1111 -8.94821 0.91141 -0.20050 -0.01516 2.26420 0.66822 -1.79314 - 2.0000 -0.2500 0.1765 -5.56778 1.24503 -0.24269 0.09374 1.93829 0.35016 -1.79314 - 2.0000 -0.2500 0.2500 -3.80071 1.31411 -0.26523 0.24169 1.64942 0.24803 -1.79314 - 2.0000 -0.2500 0.3333 -2.66697 1.32658 -0.26564 0.29596 1.35969 -0.04730 -1.79314 - 2.0000 -0.2500 0.4286 -1.84706 1.29426 -0.24337 0.32081 1.06621 -0.30334 -1.79314 - 2.0000 -0.2500 0.5385 -1.21321 1.20964 -0.20031 0.31542 0.77521 -0.50130 -1.79314 - 2.0000 -0.2500 0.6667 -0.70901 1.07021 -0.14073 0.28044 0.49482 -0.63422 -1.79314 - 2.0000 -0.2500 0.8182 -0.30848 0.87150 -0.07111 0.21590 0.23356 -0.69190 -1.79314 - 2.0000 -0.3000 0.0526 -17.02060 0.68232 -0.12476 -0.19401 2.71821 0.58868 -1.61926 - 2.0000 -0.3000 0.1111 -8.11561 0.81985 -0.17877 -0.01352 2.15602 0.74304 -1.61926 - 2.0000 -0.3000 0.1765 -5.05200 1.12438 -0.21639 0.08358 1.84490 0.42065 -1.61926 - 2.0000 -0.3000 0.2500 -3.45027 1.18882 -0.23649 0.21550 1.56947 0.31828 -1.61926 - 2.0000 -0.3000 0.3333 -2.42219 1.20167 -0.23685 0.26388 1.29348 0.02357 -1.61926 - 2.0000 -0.3000 0.4286 -1.67823 1.17356 -0.21700 0.28604 1.01411 -0.23222 -1.61926 - 2.0000 -0.3000 0.5385 -1.10274 1.09768 -0.17860 0.28123 0.73722 -0.43241 -1.61926 - 2.0000 -0.3000 0.6667 -0.64465 0.97172 -0.12548 0.25005 0.47051 -0.57000 -1.61926 - 2.0000 -0.3000 0.8182 -0.28056 0.79162 -0.06340 0.19250 0.22205 -0.63512 -1.61926 - 2.0000 -0.3500 0.0526 -15.50517 0.61252 -0.11181 -0.17386 2.59708 0.68340 -1.46949 - 2.0000 -0.3500 0.1111 -7.39584 0.74120 -0.16021 -0.01212 2.05868 0.81037 -1.46949 - 2.0000 -0.3500 0.1765 -4.60596 1.02042 -0.19392 0.07490 1.76086 0.48408 -1.46949 - 2.0000 -0.3500 0.2500 -3.14710 1.08073 -0.21193 0.19312 1.49751 0.38150 -1.46949 - 2.0000 -0.3500 0.3333 -2.21033 1.09379 -0.21226 0.23648 1.23389 0.08736 -1.46949 - 2.0000 -0.3500 0.4286 -1.53207 1.06923 -0.19446 0.25634 0.96721 -0.16821 -1.46949 - 2.0000 -0.3500 0.5385 -1.00706 1.00085 -0.16005 0.25203 0.70302 -0.37041 -1.46949 - 2.0000 -0.3500 0.6667 -0.58890 0.88650 -0.11245 0.22408 0.44863 -0.51220 -1.46949 - 2.0000 -0.3500 0.8182 -0.25636 0.72248 -0.05682 0.17251 0.21170 -0.58403 -1.46949 - 2.0000 -0.4000 0.0526 -14.18636 0.55241 -0.10066 -0.15653 2.48769 0.76896 -1.33958 - 2.0000 -0.4000 0.1111 -6.76927 0.67314 -0.14423 -0.01091 1.97075 0.87119 -1.33958 - 2.0000 -0.4000 0.1765 -4.21752 0.93022 -0.17459 0.06744 1.68496 0.54137 -1.33958 - 2.0000 -0.4000 0.2500 -2.88298 0.98682 -0.19080 0.17387 1.43253 0.43861 -1.33958 - 2.0000 -0.4000 0.3333 -2.02570 0.99997 -0.19110 0.21290 1.18008 0.14497 -1.33958 - 2.0000 -0.4000 0.4286 -1.40465 0.97843 -0.17508 0.23078 0.92486 -0.11039 -1.33958 - 2.0000 -0.4000 0.5385 -0.92362 0.91652 -0.14410 0.22690 0.67214 -0.31441 -1.33958 - 2.0000 -0.4000 0.6667 -0.54026 0.81224 -0.10124 0.20175 0.42886 -0.46000 -1.33958 - 2.0000 -0.4000 0.8182 -0.23525 0.66221 -0.05115 0.15531 0.20235 -0.53789 -1.33958 - 2.0000 -0.4500 0.0526 -13.03136 0.50032 -0.09101 -0.14152 2.38855 0.84649 -1.22617 - 2.0000 -0.4500 0.1111 -6.22035 0.61388 -0.13041 -0.00986 1.89108 0.92630 -1.22617 - 2.0000 -0.4500 0.1765 -3.87710 0.85146 -0.15785 0.06097 1.61617 0.59328 -1.22617 - 2.0000 -0.4500 0.2500 -2.65143 0.90471 -0.17251 0.15720 1.37364 0.49035 -1.22617 - 2.0000 -0.4500 0.3333 -1.86378 0.91785 -0.17278 0.19249 1.13131 0.19718 -1.22617 - 2.0000 -0.4500 0.4286 -1.29285 0.89890 -0.15829 0.20866 0.88648 -0.05800 -1.22617 - 2.0000 -0.4500 0.5385 -0.85039 0.84260 -0.13028 0.20515 0.64415 -0.26366 -1.22617 - 2.0000 -0.4500 0.6667 -0.49757 0.74713 -0.09153 0.18240 0.41095 -0.41270 -1.22617 - 2.0000 -0.4500 0.8182 -0.21671 0.60935 -0.04625 0.14042 0.19388 -0.49607 -1.22617 - 2.0000 -0.5000 0.0526 -12.01393 0.45490 -0.08261 -0.12845 2.29843 0.91697 -1.12657 - 2.0000 -0.5000 0.1111 -5.73667 0.56198 -0.11836 -0.00895 1.81865 0.97639 -1.12657 - 2.0000 -0.5000 0.1765 -3.57704 0.78228 -0.14327 0.05534 1.55364 0.64047 -1.12657 - 2.0000 -0.5000 0.2500 -2.44724 0.83249 -0.15658 0.14268 1.32010 0.53739 -1.12657 - 2.0000 -0.5000 0.3333 -1.72094 0.84557 -0.15682 0.17471 1.08697 0.24464 -1.12657 - 2.0000 -0.5000 0.4286 -1.19421 0.82883 -0.14367 0.18939 0.85159 -0.01038 -1.12657 - 2.0000 -0.5000 0.5385 -0.78575 0.77745 -0.11825 0.18620 0.61871 -0.21753 -1.12657 - 2.0000 -0.5000 0.6667 -0.45988 0.68971 -0.08308 0.16556 0.39467 -0.36970 -1.12657 - 2.0000 -0.5000 0.8182 -0.20034 0.56272 -0.04198 0.12745 0.18618 -0.45806 -1.12657 - 2.0000 -0.5500 0.0526 -11.11292 0.41509 -0.07524 -0.11700 2.21627 0.98123 -1.03864 - 2.0000 -0.5500 0.1111 -5.30820 0.51627 -0.10781 -0.00815 1.75262 1.02207 -1.03864 - 2.0000 -0.5500 0.1765 -3.31114 0.72118 -0.13050 0.05041 1.49664 0.68350 -1.03864 - 2.0000 -0.5500 0.2500 -2.26624 0.76864 -0.14262 0.12996 1.27130 0.58028 -1.03864 - 2.0000 -0.5500 0.3333 -1.59428 0.78159 -0.14284 0.15914 1.04656 0.28791 -1.03864 - 2.0000 -0.5500 0.4286 -1.10670 0.76677 -0.13087 0.17251 0.81978 0.03304 -1.03864 - 2.0000 -0.5500 0.5385 -0.72840 0.71971 -0.10771 0.16961 0.59551 -0.17547 -1.03864 - 2.0000 -0.5500 0.6667 -0.42643 0.63880 -0.07567 0.15080 0.37983 -0.33049 -1.03864 - 2.0000 -0.5500 0.8182 -0.18581 0.52136 -0.03824 0.11609 0.17915 -0.42340 -1.03864 - 2.0000 -0.6000 0.0526 -10.31109 0.38002 -0.06877 -0.10693 2.14115 1.03997 -0.96061 - 2.0000 -0.6000 0.1111 -4.92679 0.47581 -0.09853 -0.00745 1.69225 1.06382 -0.96061 - 2.0000 -0.6000 0.1765 -3.07436 0.66697 -0.11926 0.04607 1.44452 0.72284 -0.96061 - 2.0000 -0.6000 0.2500 -2.10501 0.71191 -0.13034 0.11877 1.22667 0.61949 -0.96061 - 2.0000 -0.6000 0.3333 -1.48140 0.72469 -0.13054 0.14544 1.00960 0.32746 -0.96061 - 2.0000 -0.6000 0.4286 -1.02870 0.71154 -0.11960 0.15765 0.79070 0.07274 -0.96061 - 2.0000 -0.6000 0.5385 -0.67727 0.66829 -0.09844 0.15500 0.57431 -0.13702 -0.96061 - 2.0000 -0.6000 0.6667 -0.39659 0.59345 -0.06916 0.13782 0.36626 -0.29465 -0.96061 - 2.0000 -0.6000 0.8182 -0.17285 0.48450 -0.03494 0.10610 0.17273 -0.39172 -0.96061 - 2.0000 -0.6500 0.0526 -9.59430 0.34898 -0.06304 -0.09802 2.07229 1.09382 -0.89105 - 2.0000 -0.6500 0.1111 -4.58573 0.43984 -0.09032 -0.00683 1.63691 1.10210 -0.89105 - 2.0000 -0.6500 0.1765 -2.86257 0.61863 -0.10933 0.04223 1.39674 0.75890 -0.89105 - 2.0000 -0.6500 0.2500 -1.96073 0.66127 -0.11948 0.10888 1.18577 0.65543 -0.89105 - 2.0000 -0.6500 0.3333 -1.38037 0.67386 -0.11967 0.13333 0.97573 0.36372 -0.89105 - 2.0000 -0.6500 0.4286 -0.95886 0.66215 -0.10964 0.14452 0.76405 0.10912 -0.89105 - 2.0000 -0.6500 0.5385 -0.63147 0.62229 -0.09024 0.14209 0.55487 -0.10178 -0.89105 - 2.0000 -0.6500 0.6667 -0.36986 0.55286 -0.06340 0.12634 0.35382 -0.26179 -0.89105 - 2.0000 -0.6500 0.8182 -0.16123 0.45151 -0.03203 0.09726 0.16685 -0.36268 -0.89105 - 2.0000 -0.7000 0.0526 -8.95084 0.32140 -0.05795 -0.09011 2.00902 1.14330 -0.82879 - 2.0000 -0.7000 0.1111 -4.27948 0.40772 -0.08304 -0.00628 1.58606 1.13727 -0.82879 - 2.0000 -0.7000 0.1765 -2.67233 0.57536 -0.10051 0.03882 1.35284 0.79203 -0.82879 - 2.0000 -0.7000 0.2500 -1.83110 0.61588 -0.10984 0.10009 1.14819 0.68845 -0.82879 - 2.0000 -0.7000 0.3333 -1.28956 0.62825 -0.11001 0.12257 0.94461 0.39704 -0.82879 - 2.0000 -0.7000 0.4286 -0.89606 0.61782 -0.10079 0.13286 0.73955 0.14256 -0.82879 - 2.0000 -0.7000 0.5385 -0.59028 0.58098 -0.08296 0.13063 0.53701 -0.06939 -0.82879 - 2.0000 -0.7000 0.6667 -0.34582 0.51638 -0.05828 0.11614 0.34239 -0.23160 -0.82879 - 2.0000 -0.7000 0.8182 -0.15078 0.42185 -0.02945 0.08941 0.16144 -0.33599 -0.82879 - 2.0000 -0.7500 0.0526 -8.37098 0.29678 -0.05342 -0.08306 1.95075 1.18888 -0.77283 - 2.0000 -0.7500 0.1111 -4.00342 0.37892 -0.07654 -0.00579 1.53923 1.16966 -0.77283 - 2.0000 -0.7500 0.1765 -2.50079 0.53647 -0.09265 0.03579 1.31241 0.82254 -0.77283 - 2.0000 -0.7500 0.2500 -1.71417 0.57503 -0.10125 0.09226 1.11357 0.71886 -0.77283 - 2.0000 -0.7500 0.3333 -1.20762 0.58718 -0.10141 0.11298 0.91594 0.42773 -0.77283 - 2.0000 -0.7500 0.4286 -0.83938 0.57786 -0.09291 0.12247 0.71699 0.17335 -0.77283 - 2.0000 -0.7500 0.5385 -0.55309 0.54372 -0.07647 0.12041 0.52055 -0.03956 -0.77283 - 2.0000 -0.7500 0.6667 -0.32411 0.48347 -0.05372 0.10706 0.33186 -0.20380 -0.77283 - 2.0000 -0.7500 0.8182 -0.14134 0.39508 -0.02714 0.08242 0.15646 -0.31141 -0.77283 - 2.0000 -0.8000 0.0526 -7.84652 0.27473 -0.04936 -0.07675 1.89697 1.23094 -0.72235 - 2.0000 -0.8000 0.1111 -3.75367 0.35301 -0.07073 -0.00535 1.49600 1.19956 -0.72235 - 2.0000 -0.8000 0.1765 -2.34555 0.50138 -0.08561 0.03307 1.27509 0.85071 -0.72235 - 2.0000 -0.8000 0.2500 -1.60831 0.53815 -0.09356 0.08526 1.08162 0.74694 -0.72235 - 2.0000 -0.8000 0.3333 -1.13342 0.55005 -0.09371 0.10440 0.88948 0.45605 -0.72235 - 2.0000 -0.8000 0.4286 -0.78805 0.54172 -0.08585 0.11317 0.69617 0.20178 -0.72235 - 2.0000 -0.8000 0.5385 -0.51940 0.51000 -0.07066 0.11126 0.50537 -0.01203 -0.72235 - 2.0000 -0.8000 0.6667 -0.30444 0.45368 -0.04964 0.09893 0.32214 -0.17813 -0.72235 - 2.0000 -0.8000 0.8182 -0.13279 0.37084 -0.02508 0.07616 0.15187 -0.28872 -0.72235 - 2.5000 0.0000 0.0526 -34.63358 2.54925 -0.27802 -0.41413 3.91286 -0.29512 -3.28889 - 2.5000 0.0000 0.1111 -16.24274 2.12553 -0.39502 -0.01711 3.09179 0.08953 -3.28889 - 2.5000 0.0000 0.1765 -9.99365 2.53211 -0.47391 0.19287 2.62909 -0.20933 -3.28889 - 2.5000 0.0000 0.2500 -6.75358 2.54225 -0.51338 0.47535 2.22175 -0.30987 -3.28889 - 2.5000 0.0000 0.3333 -4.69425 2.48546 -0.50981 0.57479 1.81907 -0.60335 -3.28889 - 2.5000 0.0000 0.4286 -3.22199 2.37031 -0.46323 0.61711 1.41705 -0.85070 -3.28889 - 2.5000 0.0000 0.5385 -2.09841 2.17698 -0.37821 0.60173 1.02362 -1.01960 -3.28889 - 2.5000 0.0000 0.6667 -1.21652 1.90025 -0.26361 0.53106 0.64913 -1.10605 -3.28889 - 2.5000 0.0000 0.8182 -0.52534 1.53201 -0.13215 0.40624 0.30432 -1.09904 -3.28889 - 2.5000 -0.0500 0.0526 -30.34901 2.21137 -0.23925 -0.35637 3.66353 -0.09979 -2.86802 - 2.5000 -0.0500 0.1111 -14.24027 1.84905 -0.33992 -0.01472 2.89295 0.22973 -2.86802 - 2.5000 -0.0500 0.1765 -8.76639 2.20991 -0.40782 0.16597 2.45896 -0.07727 -2.86802 - 2.5000 -0.0500 0.2500 -5.92762 2.22266 -0.44178 0.40905 2.07735 -0.17900 -2.86802 - 2.5000 -0.0500 0.3333 -4.12243 2.17608 -0.43871 0.49463 1.70045 -0.47232 -2.86802 - 2.5000 -0.0500 0.4286 -2.83094 2.07758 -0.39863 0.53105 1.32440 -0.72024 -2.86802 - 2.5000 -0.0500 0.5385 -1.84455 1.90983 -0.32546 0.51780 0.95655 -0.89415 -2.86802 - 2.5000 -0.0500 0.6667 -1.06976 1.66819 -0.22685 0.45700 0.60652 -0.98984 -2.86802 - 2.5000 -0.0500 0.8182 -0.46211 1.34556 -0.11372 0.34958 0.28431 -0.99685 -2.86802 - 2.5000 -0.1000 0.0526 -26.82288 1.93530 -0.20771 -0.30940 3.44413 0.07208 -2.52306 - 2.5000 -0.1000 0.1111 -12.59165 1.62271 -0.29512 -0.01278 2.71797 0.35311 -2.52306 - 2.5000 -0.1000 0.1765 -7.75558 1.94552 -0.35407 0.14410 2.30926 0.03893 -2.52306 - 2.5000 -0.1000 0.2500 -5.24704 1.96008 -0.38355 0.35514 1.95029 -0.06384 -2.52306 - 2.5000 -0.1000 0.3333 -3.65105 1.92163 -0.38088 0.42944 1.59607 -0.35703 -2.52306 - 2.5000 -0.1000 0.4286 -2.50845 1.83663 -0.34609 0.46105 1.24288 -0.60544 -2.52306 - 2.5000 -0.1000 0.5385 -1.63512 1.68978 -0.28256 0.44956 0.89754 -0.78376 -2.52306 - 2.5000 -0.1000 0.6667 -0.94865 1.47695 -0.19695 0.39676 0.56903 -0.88758 -2.52306 - 2.5000 -0.1000 0.8182 -0.40992 1.19185 -0.09873 0.30351 0.26671 -0.90693 -2.52306 - 2.5000 -0.1500 0.0526 -23.88529 1.70694 -0.18175 -0.27073 3.25007 0.22412 -2.23679 - 2.5000 -0.1500 0.1111 -11.21771 1.43511 -0.25824 -0.01118 2.56320 0.46223 -2.23679 - 2.5000 -0.1500 0.1765 -6.91284 1.72591 -0.30981 0.12609 2.17684 0.14172 -2.23679 - 2.5000 -0.1500 0.2500 -4.67937 1.74169 -0.33562 0.31075 1.83789 0.03802 -2.23679 - 2.5000 -0.1500 0.3333 -3.25772 1.70978 -0.33328 0.37576 1.50375 -0.25505 -2.23679 - 2.5000 -0.1500 0.4286 -2.23926 1.63586 -0.30283 0.40343 1.17078 -0.50389 -2.23679 - 2.5000 -0.1500 0.5385 -1.46025 1.50630 -0.24725 0.39337 0.84534 -0.68612 -2.23679 - 2.5000 -0.1500 0.6667 -0.84749 1.31741 -0.17233 0.34718 0.53587 -0.79713 -2.23679 - 2.5000 -0.1500 0.8182 -0.36632 1.06358 -0.08639 0.26557 0.25113 -0.82739 -2.23679 - 2.5000 -0.2000 0.0526 -21.41151 1.51598 -0.16015 -0.23855 3.07758 0.35925 -1.99661 - 2.5000 -0.2000 0.1111 -10.06027 1.27793 -0.22754 -0.00985 2.42563 0.55923 -1.99661 - 2.5000 -0.2000 0.1765 -6.20262 1.54149 -0.27299 0.11110 2.05915 0.23309 -1.99661 - 2.5000 -0.2000 0.2500 -4.20077 1.55809 -0.29572 0.27381 1.73799 0.12856 -1.99661 - 2.5000 -0.2000 0.3333 -2.92596 1.53149 -0.29366 0.33110 1.42168 -0.16440 -1.99661 - 2.5000 -0.2000 0.4286 -2.01211 1.46675 -0.26683 0.35547 1.10668 -0.41363 -1.99661 - 2.5000 -0.2000 0.5385 -1.31264 1.35166 -0.21786 0.34661 0.79895 -0.59933 -1.99661 - 2.5000 -0.2000 0.6667 -0.76209 1.18288 -0.15185 0.30591 0.50639 -0.71674 -1.99661 - 2.5000 -0.2000 0.8182 -0.32950 0.95537 -0.07612 0.23400 0.23729 -0.75669 -1.99661 - 2.5000 -0.2500 0.0526 -19.30825 1.35473 -0.14199 -0.21151 2.92358 0.47990 -1.79314 - 2.5000 -0.2500 0.1111 -9.07586 1.14496 -0.20174 -0.00874 2.30282 0.64583 -1.79314 - 2.5000 -0.2500 0.1765 -5.59832 1.38514 -0.24204 0.09851 1.95407 0.31465 -1.79314 - 2.5000 -0.2500 0.2500 -3.79338 1.40223 -0.26220 0.24277 1.64880 0.20940 -1.79314 - 2.5000 -0.2500 0.3333 -2.64345 1.38000 -0.26037 0.29356 1.34842 -0.08347 -1.79314 - 2.5000 -0.2500 0.4286 -1.81863 1.32295 -0.23658 0.31518 1.04946 -0.33305 -1.79314 - 2.5000 -0.2500 0.5385 -1.18687 1.22008 -0.19316 0.30732 0.75752 -0.52185 -1.79314 - 2.5000 -0.2500 0.6667 -0.68929 1.06835 -0.13463 0.27123 0.48007 -0.64496 -1.79314 - 2.5000 -0.2500 0.8182 -0.29811 0.86323 -0.06749 0.20748 0.22493 -0.69358 -1.79314 - 2.5000 -0.3000 0.0526 -17.50460 1.21739 -0.12660 -0.18859 2.78552 0.58805 -1.61926 - 2.5000 -0.3000 0.1111 -8.23139 1.03149 -0.17988 -0.00779 2.19271 0.72347 -1.61926 - 2.5000 -0.3000 0.1765 -5.07974 1.25143 -0.21581 0.08783 1.85986 0.38778 -1.61926 - 2.5000 -0.3000 0.2500 -3.44363 1.26878 -0.23378 0.21646 1.56884 0.28187 -1.61926 - 2.5000 -0.3000 0.3333 -2.40083 1.25017 -0.23215 0.26175 1.28274 -0.01092 -1.61926 - 2.5000 -0.3000 0.4286 -1.65239 1.19961 -0.21094 0.28102 0.99816 -0.26081 -1.61926 - 2.5000 -0.3000 0.5385 -1.07877 1.10715 -0.17223 0.27401 0.72039 -0.45238 -1.61926 - 2.5000 -0.3000 0.6667 -0.62671 0.97002 -0.12004 0.24183 0.45648 -0.58061 -1.61926 - 2.5000 -0.3000 0.8182 -0.27111 0.78408 -0.06018 0.18499 0.21386 -0.63699 -1.61926 - 2.5000 -0.3500 0.0526 -15.94592 1.09949 -0.11346 -0.16900 2.66127 0.68539 -1.46949 - 2.5000 -0.3500 0.1111 -7.50138 0.93390 -0.16120 -0.00698 2.09362 0.79333 -1.46949 - 2.5000 -0.3500 0.1765 -4.63127 1.13619 -0.19340 0.07871 1.77508 0.45359 -1.46949 - 2.5000 -0.3500 0.2500 -3.14105 1.15364 -0.20950 0.19398 1.49689 0.34708 -1.46949 - 2.5000 -0.3500 0.3333 -2.19084 1.13803 -0.20805 0.23457 1.22363 0.05437 -1.46949 - 2.5000 -0.3500 0.4286 -1.50847 1.09301 -0.18904 0.25184 0.95200 -0.19580 -1.46949 - 2.5000 -0.3500 0.5385 -0.98516 1.00949 -0.15434 0.24556 0.68697 -0.38987 -1.46949 - 2.5000 -0.3500 0.6667 -0.57250 0.88493 -0.10758 0.21672 0.43525 -0.52270 -1.46949 - 2.5000 -0.3500 0.8182 -0.24772 0.71557 -0.05393 0.16578 0.20389 -0.58607 -1.46949 - 2.5000 -0.4000 0.0526 -14.58949 0.99756 -0.10215 -0.15215 2.54906 0.77330 -1.33958 - 2.5000 -0.4000 0.1111 -6.86587 0.84938 -0.14513 -0.00629 2.00413 0.85644 -1.33958 - 2.5000 -0.4000 0.1765 -4.24073 1.03617 -0.17412 0.07086 1.69851 0.51303 -1.33958 - 2.5000 -0.4000 0.2500 -2.87745 1.05359 -0.18862 0.17464 1.43190 0.40598 -1.33958 - 2.5000 -0.4000 0.3333 -2.00783 1.04051 -0.18731 0.21118 1.17024 0.11335 -1.33958 - 2.5000 -0.4000 0.4286 -1.38299 1.00022 -0.17019 0.22673 0.91030 -0.13708 -1.33958 - 2.5000 -0.4000 0.5385 -0.90352 0.92443 -0.13896 0.22108 0.65679 -0.33341 -1.33958 - 2.5000 -0.4000 0.6667 -0.52521 0.81079 -0.09685 0.19511 0.41607 -0.47040 -1.33958 - 2.5000 -0.4000 0.8182 -0.22732 0.65586 -0.04855 0.14925 0.19488 -0.54008 -1.33958 - 2.5000 -0.4500 0.0526 -13.40154 0.90886 -0.09235 -0.13757 2.44737 0.85297 -1.22617 - 2.5000 -0.4500 0.1111 -6.30913 0.77570 -0.13122 -0.00568 1.92303 0.91362 -1.22617 - 2.5000 -0.4500 0.1765 -3.89846 0.94880 -0.15742 0.06407 1.62913 0.56689 -1.22617 - 2.5000 -0.4500 0.2500 -2.64635 0.96609 -0.17053 0.15790 1.37300 0.45936 -1.22617 - 2.5000 -0.4500 0.3333 -1.84733 0.95514 -0.16935 0.19093 1.12186 0.16679 -1.22617 - 2.5000 -0.4500 0.4286 -1.27291 0.91895 -0.15388 0.20499 0.87252 -0.08387 -1.22617 - 2.5000 -0.4500 0.5385 -0.83187 0.84988 -0.12563 0.19988 0.62943 -0.28224 -1.22617 - 2.5000 -0.4500 0.6667 -0.48369 0.74579 -0.08757 0.17641 0.39870 -0.42301 -1.22617 - 2.5000 -0.4500 0.8182 -0.20940 0.60349 -0.04390 0.13494 0.18672 -0.49840 -1.22617 - 2.5000 -0.5000 0.0526 -12.35510 0.83123 -0.08382 -0.12486 2.35493 0.92539 -1.12657 - 2.5000 -0.5000 0.1111 -5.81856 0.71110 -0.11910 -0.00516 1.84930 0.96560 -1.12657 - 2.5000 -0.5000 0.1765 -3.59676 0.87204 -0.14288 0.05815 1.56605 0.61585 -1.12657 - 2.5000 -0.5000 0.2500 -2.44256 0.88913 -0.15478 0.14332 1.31946 0.50788 -1.12657 - 2.5000 -0.5000 0.3333 -1.70575 0.87999 -0.15371 0.17330 1.07788 0.21536 -1.12657 - 2.5000 -0.5000 0.4286 -1.17578 0.84734 -0.13966 0.18606 0.83817 -0.03550 -1.12657 - 2.5000 -0.5000 0.5385 -0.76863 0.78417 -0.11403 0.18142 0.60457 -0.23573 -1.12657 - 2.5000 -0.5000 0.6667 -0.44705 0.68846 -0.07948 0.16011 0.38290 -0.37992 -1.12657 - 2.5000 -0.5000 0.8182 -0.19358 0.55729 -0.03984 0.12248 0.17930 -0.46051 -1.12657 - 2.5000 -0.5500 0.0526 -11.42840 0.76291 -0.07635 -0.11373 2.27065 0.99141 -1.03864 - 2.5000 -0.5500 0.1111 -5.38398 0.65415 -0.10848 -0.00470 1.78209 1.01300 -1.03864 - 2.5000 -0.5500 0.1765 -3.32941 0.80423 -0.13015 0.05297 1.50854 0.66049 -1.03864 - 2.5000 -0.5500 0.2500 -2.26191 0.82108 -0.14099 0.13054 1.27065 0.55212 -1.03864 - 2.5000 -0.5500 0.3333 -1.58020 0.81347 -0.14001 0.15786 1.03779 0.25965 -1.03864 - 2.5000 -0.5500 0.4286 -1.08961 0.78392 -0.12722 0.16948 0.80685 0.00860 -1.03864 - 2.5000 -0.5500 0.5385 -0.71252 0.72593 -0.10387 0.16525 0.58190 -0.19333 -1.03864 - 2.5000 -0.5500 0.6667 -0.41452 0.63763 -0.07240 0.14585 0.36850 -0.34064 -1.03864 - 2.5000 -0.5500 0.8182 -0.17953 0.51632 -0.03629 0.11157 0.17254 -0.42597 -1.03864 - 2.5000 -0.6000 0.0526 -10.60372 0.70249 -0.06978 -0.10394 2.19360 1.05178 -0.96061 - 2.5000 -0.6000 0.1111 -4.99714 0.60369 -0.09914 -0.00429 1.72063 1.05632 -0.96061 - 2.5000 -0.6000 0.1765 -3.09134 0.74403 -0.11894 0.04841 1.45597 0.70130 -0.96061 - 2.5000 -0.6000 0.2500 -2.10099 0.76060 -0.12885 0.11930 1.22603 0.59257 -0.96061 - 2.5000 -0.6000 0.3333 -1.46832 0.75431 -0.12795 0.14426 1.00113 0.30015 -0.96061 - 2.5000 -0.6000 0.4286 -1.01281 0.72748 -0.11626 0.15489 0.77823 0.04892 -0.96061 - 2.5000 -0.6000 0.5385 -0.66249 0.67407 -0.09492 0.15102 0.56118 -0.15456 -0.96061 - 2.5000 -0.6000 0.6667 -0.38551 0.59235 -0.06616 0.13329 0.35533 -0.30473 -0.96061 - 2.5000 -0.6000 0.8182 -0.16700 0.47981 -0.03317 0.10196 0.16636 -0.39439 -0.96061 - 2.5000 -0.6500 0.0526 -9.86651 0.64880 -0.06397 -0.09528 2.12297 1.10711 -0.89105 - 2.5000 -0.6500 0.1111 -4.65122 0.55878 -0.09088 -0.00394 1.66431 1.09604 -0.89105 - 2.5000 -0.6500 0.1765 -2.87839 0.69036 -0.10904 0.04438 1.40777 0.73871 -0.89105 - 2.5000 -0.6500 0.2500 -1.95700 0.70661 -0.11812 0.10937 1.18512 0.62964 -0.89105 - 2.5000 -0.6500 0.3333 -1.36818 0.70145 -0.11730 0.13225 0.96753 0.33726 -0.89105 - 2.5000 -0.6500 0.4286 -0.94404 0.67701 -0.10658 0.14198 0.75198 0.08588 -0.89105 - 2.5000 -0.6500 0.5385 -0.61769 0.62768 -0.08702 0.13844 0.54218 -0.11902 -0.89105 - 2.5000 -0.6500 0.6667 -0.35952 0.55183 -0.06065 0.12219 0.34326 -0.27181 -0.89105 - 2.5000 -0.6500 0.8182 -0.15578 0.44712 -0.03040 0.09347 0.16069 -0.36544 -0.89105 - 2.5000 -0.7000 0.0526 -9.20472 0.60090 -0.05881 -0.08759 2.05807 1.15795 -0.82879 - 2.5000 -0.7000 0.1111 -4.34060 0.51865 -0.08355 -0.00362 1.61255 1.13254 -0.82879 - 2.5000 -0.7000 0.1765 -2.68711 0.64229 -0.10024 0.04080 1.36349 0.77309 -0.82879 - 2.5000 -0.7000 0.2500 -1.82762 0.65821 -0.10859 0.10054 1.14753 0.66370 -0.82879 - 2.5000 -0.7000 0.3333 -1.27817 0.65403 -0.10783 0.12158 0.93665 0.37137 -0.82879 - 2.5000 -0.7000 0.4286 -0.88221 0.63170 -0.09798 0.13053 0.72787 0.11983 -0.82879 - 2.5000 -0.7000 0.5385 -0.57739 0.58600 -0.08000 0.12727 0.52472 -0.08637 -0.82879 - 2.5000 -0.7000 0.6667 -0.33615 0.51541 -0.05576 0.11233 0.33217 -0.24156 -0.82879 - 2.5000 -0.7000 0.8182 -0.14568 0.41774 -0.02795 0.08593 0.15548 -0.33884 -0.82879 - 2.5000 -0.7500 0.0526 -8.60834 0.55799 -0.05420 -0.08074 1.99830 1.20478 -0.77283 - 2.5000 -0.7500 0.1111 -4.06061 0.48263 -0.07701 -0.00334 1.56488 1.16615 -0.77283 - 2.5000 -0.7500 0.1765 -2.51463 0.59907 -0.09240 0.03760 1.32271 0.80474 -0.77283 - 2.5000 -0.7500 0.2500 -1.71091 0.61465 -0.10009 0.09268 1.11292 0.69508 -0.77283 - 2.5000 -0.7500 0.3333 -1.19696 0.61131 -0.09939 0.11206 0.90822 0.40278 -0.77283 - 2.5000 -0.7500 0.4286 -0.82640 0.59086 -0.09031 0.12032 0.70566 0.15111 -0.77283 - 2.5000 -0.7500 0.5385 -0.54101 0.54842 -0.07374 0.11732 0.50864 -0.05629 -0.77283 - 2.5000 -0.7500 0.6667 -0.31504 0.48256 -0.05140 0.10354 0.32196 -0.21370 -0.77283 - 2.5000 -0.7500 0.8182 -0.13655 0.39123 -0.02576 0.07920 0.15069 -0.31434 -0.77283 - 2.5000 -0.8000 0.0526 -8.06896 0.51940 -0.05009 -0.07461 1.94313 1.24800 -0.72235 - 2.5000 -0.8000 0.1111 -3.80730 0.45019 -0.07117 -0.00308 1.52088 1.19717 -0.72235 - 2.5000 -0.8000 0.1765 -2.35854 0.56007 -0.08538 0.03475 1.28506 0.83397 -0.72235 - 2.5000 -0.8000 0.2500 -1.60526 0.57531 -0.09249 0.08564 1.08096 0.72404 -0.72235 - 2.5000 -0.8000 0.3333 -1.12341 0.57269 -0.09185 0.10355 0.88197 0.43177 -0.72235 - 2.5000 -0.8000 0.4286 -0.77586 0.55392 -0.08346 0.11118 0.68516 0.17998 -0.72235 - 2.5000 -0.8000 0.5385 -0.50805 0.51441 -0.06814 0.10841 0.49380 -0.02854 -0.72235 - 2.5000 -0.8000 0.6667 -0.29591 0.45282 -0.04749 0.09568 0.31253 -0.18799 -0.72235 - 2.5000 -0.8000 0.8182 -0.12829 0.36722 -0.02381 0.07319 0.14626 -0.29173 -0.72235 - 3.0000 0.0000 0.0526 -35.40269 3.43110 -0.28109 -0.40497 3.98624 -0.31443 -3.28889 - 3.0000 0.0000 0.1111 -16.42228 2.46618 -0.39676 -0.00758 3.13034 0.05570 -3.28889 - 3.0000 0.0000 0.1765 -10.03543 2.73259 -0.47276 0.19981 2.64385 -0.25127 -3.28889 - 3.0000 0.0000 0.2500 -6.74302 2.66644 -0.50867 0.47668 2.22001 -0.35103 -3.28889 - 3.0000 0.0000 0.3333 -4.66203 2.55982 -0.50183 0.57096 1.80698 -0.63903 -3.28889 - 3.0000 0.0000 0.4286 -3.18364 2.40998 -0.45310 0.60853 1.39993 -0.87815 -3.28889 - 3.0000 0.0000 0.5385 -2.06328 2.19157 -0.36766 0.58960 1.00599 -1.03722 -3.28889 - 3.0000 0.0000 0.6667 -1.19051 1.89819 -0.25471 0.51742 0.63470 -1.11403 -3.28889 - 3.0000 0.0000 0.8182 -0.51178 1.52152 -0.12692 0.39390 0.29603 -1.09915 -3.28889 - 3.0000 -0.0500 0.0526 -31.02264 2.98324 -0.24189 -0.34849 3.73210 -0.11507 -2.86802 - 3.0000 -0.0500 0.1111 -14.39768 2.14739 -0.34142 -0.00652 2.92892 0.19982 -2.86802 - 3.0000 -0.0500 0.1765 -8.80308 2.38563 -0.40682 0.17194 2.47271 -0.11560 -2.86802 - 3.0000 -0.0500 0.2500 -5.91837 2.33159 -0.43773 0.41020 2.07569 -0.21718 -2.86802 - 3.0000 -0.0500 0.3333 -4.09412 2.24135 -0.43184 0.49133 1.68913 -0.50580 -2.86802 - 3.0000 -0.0500 0.4286 -2.79722 2.11241 -0.38990 0.52366 1.30839 -0.74625 -2.86802 - 3.0000 -0.0500 0.5385 -1.81364 1.92263 -0.31638 0.50737 0.94007 -0.91105 -2.86802 - 3.0000 -0.0500 0.6667 -1.04686 1.66635 -0.21918 0.44525 0.59304 -0.99769 -2.86802 - 3.0000 -0.0500 0.8182 -0.45017 1.33631 -0.10922 0.33897 0.27657 -0.99721 -2.86802 - 3.0000 -0.1000 0.0526 -27.41796 2.61674 -0.21001 -0.30256 3.50847 0.06034 -2.52306 - 3.0000 -0.1000 0.1111 -12.73084 1.88623 -0.29642 -0.00566 2.75169 0.32664 -2.52306 - 3.0000 -0.1000 0.1765 -7.78807 2.10087 -0.35320 0.14928 2.32212 0.00378 -2.52306 - 3.0000 -0.1000 0.2500 -5.23885 2.05646 -0.38003 0.35614 1.94869 -0.09940 -2.52306 - 3.0000 -0.1000 0.3333 -3.62597 1.97941 -0.37492 0.42657 1.58543 -0.38856 -2.52306 - 3.0000 -0.1000 0.4286 -2.47855 1.86747 -0.33851 0.45464 1.22785 -0.63017 -2.52306 - 3.0000 -0.1000 0.5385 -1.60770 1.70111 -0.27468 0.44050 0.88207 -0.80003 -2.52306 - 3.0000 -0.1000 0.6667 -0.92833 1.47529 -0.19029 0.38657 0.55638 -0.89532 -2.52306 - 3.0000 -0.1000 0.8182 -0.39932 1.18362 -0.09482 0.29429 0.25944 -0.90751 -2.52306 - 3.0000 -0.1500 0.0526 -24.41497 2.31311 -0.18376 -0.26474 3.31066 0.21551 -2.23679 - 3.0000 -0.1500 0.1111 -11.34172 1.66965 -0.25937 -0.00495 2.59491 0.43881 -2.23679 - 3.0000 -0.1500 0.1765 -6.94183 1.86427 -0.30906 0.13062 2.18891 0.10938 -2.23679 - 3.0000 -0.1500 0.2500 -4.67208 1.82760 -0.33254 0.31163 1.83636 0.00478 -2.23679 - 3.0000 -0.1500 0.3333 -3.23533 1.76131 -0.32806 0.37326 1.49370 -0.28485 -2.23679 - 3.0000 -0.1500 0.4286 -2.21254 1.66337 -0.29621 0.39782 1.15661 -0.52750 -2.23679 - 3.0000 -0.1500 0.5385 -1.43574 1.51640 -0.24035 0.38545 0.83077 -0.70183 -2.23679 - 3.0000 -0.1500 0.6667 -0.82932 1.31591 -0.16651 0.33826 0.52395 -0.80477 -2.23679 - 3.0000 -0.1500 0.8182 -0.35684 1.05620 -0.08297 0.25751 0.24429 -0.82816 -2.23679 - 3.0000 -0.2000 0.0526 -21.88612 2.05881 -0.16192 -0.23327 3.13484 0.35342 -1.99661 - 3.0000 -0.2000 0.1111 -10.17150 1.48807 -0.22854 -0.00436 2.45557 0.53852 -1.99661 - 3.0000 -0.2000 0.1765 -6.22865 1.66555 -0.27232 0.11509 2.07051 0.20324 -1.99661 - 3.0000 -0.2000 0.2500 -4.19423 1.63517 -0.29301 0.27458 1.73651 0.09737 -1.99661 - 3.0000 -0.2000 0.3333 -2.90584 1.57776 -0.28907 0.32889 1.41217 -0.19268 -1.99661 - 3.0000 -0.2000 0.4286 -1.98810 1.49146 -0.26100 0.35053 1.09328 -0.43625 -1.99661 - 3.0000 -0.2000 0.5385 -1.29060 1.36073 -0.21178 0.33963 0.78517 -0.61454 -1.99661 - 3.0000 -0.2000 0.6667 -0.74573 1.18152 -0.14672 0.29805 0.49513 -0.72428 -1.99661 - 3.0000 -0.2000 0.8182 -0.32096 0.94872 -0.07311 0.22690 0.23083 -0.75764 -1.99661 - 3.0000 -0.2500 0.0526 -19.73606 1.84376 -0.14356 -0.20683 2.97786 0.47655 -1.79314 - 3.0000 -0.2500 0.1111 -9.17621 1.33437 -0.20263 -0.00387 2.33116 0.62753 -1.79314 - 3.0000 -0.2500 0.1765 -5.62184 1.49703 -0.24145 0.10205 1.96480 0.28704 -1.79314 - 3.0000 -0.2500 0.2500 -3.78748 1.47181 -0.25979 0.24345 1.64737 0.18004 -1.79314 - 3.0000 -0.2500 0.3333 -2.62527 1.42178 -0.25629 0.29160 1.33938 -0.11039 -1.79314 - 3.0000 -0.2500 0.4286 -1.79690 1.34527 -0.23141 0.31079 1.03675 -0.35477 -1.79314 - 3.0000 -0.2500 0.5385 -1.16692 1.22826 -0.18777 0.30113 0.74446 -0.53661 -1.79314 - 3.0000 -0.2500 0.6667 -0.67448 1.06710 -0.13008 0.26426 0.46940 -0.65243 -1.79314 - 3.0000 -0.2500 0.8182 -0.29038 0.85720 -0.06482 0.20118 0.21881 -0.69468 -1.79314 - 3.0000 -0.3000 0.0526 -17.89231 1.66032 -0.12800 -0.18441 2.83714 0.58694 -1.61926 - 3.0000 -0.3000 0.1111 -8.32241 1.20312 -0.18067 -0.00345 2.21963 0.70734 -1.61926 - 3.0000 -0.3000 0.1765 -5.10110 1.35289 -0.21528 0.09099 1.87004 0.36217 -1.61926 - 3.0000 -0.3000 0.2500 -3.43829 1.33192 -0.23163 0.21707 1.56746 0.25416 -1.61926 - 3.0000 -0.3000 0.3333 -2.38431 1.28810 -0.22852 0.26000 1.27412 -0.03661 -1.61926 - 3.0000 -0.3000 0.4286 -1.63264 1.21989 -0.20633 0.27711 0.98606 -0.28173 -1.61926 - 3.0000 -0.3000 0.5385 -1.06062 1.11458 -0.16742 0.26849 0.70796 -0.46675 -1.61926 - 3.0000 -0.3000 0.6667 -0.61324 0.96887 -0.11599 0.23562 0.44633 -0.58801 -1.61926 - 3.0000 -0.3000 0.8182 -0.26408 0.77858 -0.05780 0.17937 0.20803 -0.63823 -1.61926 - 3.0000 -0.3500 0.0526 -16.29897 1.50261 -0.11471 -0.16526 2.71049 0.68628 -1.46949 - 3.0000 -0.3500 0.1111 -7.58433 1.09018 -0.16191 -0.00309 2.11926 0.77915 -1.46949 - 3.0000 -0.3500 0.1765 -4.65076 1.22864 -0.19293 0.08154 1.78476 0.42978 -1.46949 - 3.0000 -0.3500 0.2500 -3.13618 1.21120 -0.20758 0.19453 1.49554 0.32086 -1.46949 - 3.0000 -0.3500 0.3333 -2.17576 1.17264 -0.20479 0.23300 1.21540 0.02978 -1.46949 - 3.0000 -0.3500 0.4286 -1.49043 1.11151 -0.18490 0.24833 0.94045 -0.21600 -1.46949 - 3.0000 -0.3500 0.5385 -0.96857 1.01626 -0.15004 0.24061 0.67512 -0.40388 -1.46949 - 3.0000 -0.3500 0.6667 -0.56018 0.88387 -0.10394 0.21115 0.42557 -0.53004 -1.46949 - 3.0000 -0.3500 0.8182 -0.24129 0.71054 -0.05179 0.16075 0.19833 -0.58743 -1.46949 - 3.0000 -0.4000 0.0526 -14.91239 1.36606 -0.10327 -0.14879 2.59611 0.77600 -1.33958 - 3.0000 -0.4000 0.1111 -6.94181 0.99230 -0.14577 -0.00278 2.02861 0.84402 -1.33958 - 3.0000 -0.4000 0.1765 -4.25858 1.12077 -0.17369 0.07341 1.70773 0.49084 -1.33958 - 3.0000 -0.4000 0.2500 -2.87299 1.10630 -0.18689 0.17514 1.43058 0.38110 -1.33958 - 3.0000 -0.4000 0.3333 -1.99401 1.07221 -0.18437 0.20977 1.16236 0.08975 -1.33958 - 3.0000 -0.4000 0.4286 -1.36644 1.01717 -0.16647 0.22358 0.89925 -0.15663 -1.33958 - 3.0000 -0.4000 0.5385 -0.88830 0.93063 -0.13508 0.21662 0.64545 -0.34709 -1.33958 - 3.0000 -0.4000 0.6667 -0.51390 0.80981 -0.09358 0.19010 0.40682 -0.47768 -1.33958 - 3.0000 -0.4000 0.8182 -0.22141 0.65124 -0.04663 0.14472 0.18957 -0.54155 -1.33958 - 3.0000 -0.4500 0.0526 -13.69805 1.24707 -0.09337 -0.13452 2.49246 0.85731 -1.22617 - 3.0000 -0.4500 0.1111 -6.37891 0.90693 -0.13179 -0.00252 1.94646 0.90280 -1.22617 - 3.0000 -0.4500 0.1765 -3.91489 1.02653 -0.15704 0.06637 1.63793 0.54617 -1.22617 - 3.0000 -0.4500 0.2500 -2.64225 1.01455 -0.16897 0.15834 1.37172 0.43569 -1.22617 - 3.0000 -0.4500 0.3333 -1.83461 0.98431 -0.16670 0.18966 1.11429 0.14409 -1.22617 - 3.0000 -0.4500 0.4286 -1.25767 0.93454 -0.15051 0.20214 0.86192 -0.10283 -1.22617 - 3.0000 -0.4500 0.5385 -0.81785 0.85559 -0.12213 0.19585 0.61857 -0.29563 -1.22617 - 3.0000 -0.4500 0.6667 -0.47327 0.74487 -0.08461 0.17188 0.38983 -0.43023 -1.22617 - 3.0000 -0.4500 0.8182 -0.20395 0.59922 -0.04216 0.13085 0.18164 -0.49997 -1.22617 - 3.0000 -0.5000 0.0526 -12.62836 1.14278 -0.08475 -0.12210 2.39823 0.93122 -1.12657 - 3.0000 -0.5000 0.1111 -5.88292 0.83203 -0.11962 -0.00228 1.87178 0.95623 -1.12657 - 3.0000 -0.5000 0.1765 -3.61193 0.94371 -0.14253 0.06024 1.57448 0.59647 -1.12657 - 3.0000 -0.5000 0.2500 -2.43879 0.93384 -0.15336 0.14372 1.31821 0.48531 -1.12657 - 3.0000 -0.5000 0.3333 -1.69400 0.90691 -0.15130 0.17214 1.07060 0.19349 -1.12657 - 3.0000 -0.5000 0.4286 -1.16170 0.86174 -0.13661 0.18347 0.82798 -0.05393 -1.12657 - 3.0000 -0.5000 0.5385 -0.75567 0.78943 -0.11085 0.17776 0.59413 -0.24886 -1.12657 - 3.0000 -0.5000 0.6667 -0.43741 0.68761 -0.07679 0.15600 0.37438 -0.38710 -1.12657 - 3.0000 -0.5000 0.8182 -0.18854 0.55334 -0.03827 0.11876 0.17442 -0.46218 -1.12657 - 3.0000 -0.5500 0.0526 -11.68109 1.05086 -0.07720 -0.11122 2.31233 0.99860 -1.03864 - 3.0000 -0.5500 0.1111 -5.44354 0.76597 -0.10896 -0.00208 1.80369 1.00495 -1.03864 - 3.0000 -0.5500 0.1765 -3.34346 0.87054 -0.12983 0.05487 1.51663 0.64233 -1.03864 - 3.0000 -0.5500 0.2500 -2.25842 0.86246 -0.13970 0.13091 1.26943 0.53056 -1.03864 - 3.0000 -0.5500 0.3333 -1.56932 0.83840 -0.13782 0.15680 1.03076 0.23853 -1.03864 - 3.0000 -0.5500 0.4286 -1.07656 0.79726 -0.12443 0.16712 0.79704 -0.00934 -1.03864 - 3.0000 -0.5500 0.5385 -0.70050 0.73081 -0.10097 0.16192 0.57185 -0.20621 -1.03864 - 3.0000 -0.5500 0.6667 -0.40558 0.63684 -0.06995 0.14210 0.36030 -0.34777 -1.03864 - 3.0000 -0.5500 0.8182 -0.17485 0.51264 -0.03486 0.10818 0.16784 -0.42772 -1.03864 - 3.0000 -0.6000 0.0526 -10.83810 0.96945 -0.07055 -0.10164 2.23379 1.06021 -0.96061 - 3.0000 -0.6000 0.1111 -5.05242 0.70740 -0.09958 -0.00190 1.74145 1.04949 -0.96061 - 3.0000 -0.6000 0.1765 -3.10440 0.80557 -0.11865 0.05015 1.46374 0.68426 -0.96061 - 3.0000 -0.6000 0.2500 -2.09775 0.79902 -0.12767 0.11964 1.22483 0.57192 -0.96061 - 3.0000 -0.6000 0.3333 -1.45821 0.77747 -0.12595 0.14330 0.99434 0.27970 -0.96061 - 3.0000 -0.6000 0.4286 -1.00067 0.73987 -0.11372 0.15273 0.76875 0.03143 -0.96061 - 3.0000 -0.6000 0.5385 -0.65131 0.67860 -0.09228 0.14798 0.55148 -0.16722 -0.96061 - 3.0000 -0.6000 0.6667 -0.37719 0.59160 -0.06393 0.12986 0.34742 -0.31182 -0.96061 - 3.0000 -0.6000 0.8182 -0.16265 0.47638 -0.03185 0.09886 0.16183 -0.39621 -0.96061 - 3.0000 -0.6500 0.0526 -10.08453 0.89702 -0.06467 -0.09317 2.16179 1.11668 -0.89105 - 3.0000 -0.6500 0.1111 -4.70268 0.65525 -0.09128 -0.00174 1.68439 1.09031 -0.89105 - 3.0000 -0.6500 0.1765 -2.89056 0.74763 -0.10877 0.04597 1.41526 0.72269 -0.89105 - 3.0000 -0.6500 0.2500 -1.95398 0.74239 -0.11703 0.10967 1.18394 0.60984 -0.89105 - 3.0000 -0.6500 0.3333 -1.35875 0.72302 -0.11546 0.13136 0.96096 0.31744 -0.89105 - 3.0000 -0.6500 0.4286 -0.93272 0.68856 -0.10425 0.14001 0.74283 0.06879 -0.89105 - 3.0000 -0.6500 0.5385 -0.60725 0.63189 -0.08459 0.13565 0.53281 -0.13148 -0.89105 - 3.0000 -0.6500 0.6667 -0.35176 0.55112 -0.05860 0.11905 0.33562 -0.27886 -0.89105 - 3.0000 -0.6500 0.8182 -0.15171 0.44392 -0.02920 0.09063 0.15631 -0.36734 -0.89105 - 3.0000 -0.7000 0.0526 -9.40806 0.83230 -0.05945 -0.08566 2.09564 1.16857 -0.82879 - 3.0000 -0.7000 0.1111 -4.38863 0.60861 -0.08392 -0.00160 1.63197 1.12782 -0.82879 - 3.0000 -0.7000 0.1765 -2.69848 0.69573 -0.09999 0.04226 1.37072 0.75801 -0.82879 - 3.0000 -0.7000 0.2500 -1.82480 0.69161 -0.10759 0.10082 1.14638 0.64467 -0.82879 - 3.0000 -0.7000 0.3333 -1.26936 0.67417 -0.10614 0.12077 0.93028 0.35212 -0.82879 - 3.0000 -0.7000 0.4286 -0.87162 0.64249 -0.09584 0.12871 0.71900 0.10313 -0.82879 - 3.0000 -0.7000 0.5385 -0.56763 0.58994 -0.07776 0.12471 0.51565 -0.09864 -0.82879 - 3.0000 -0.7000 0.6667 -0.32888 0.51475 -0.05387 0.10944 0.32478 -0.24858 -0.82879 - 3.0000 -0.7000 0.8182 -0.14188 0.41474 -0.02684 0.08332 0.15125 -0.34080 -0.82879 - 3.0000 -0.7500 0.0526 -8.79846 0.77424 -0.05480 -0.07895 2.03472 1.21636 -0.77283 - 3.0000 -0.7500 0.1111 -4.10554 0.56674 -0.07735 -0.00148 1.58368 1.16238 -0.77283 - 3.0000 -0.7500 0.1765 -2.52527 0.64906 -0.09217 0.03896 1.32969 0.79053 -0.77283 - 3.0000 -0.7500 0.2500 -1.70828 0.64591 -0.09917 0.09294 1.11178 0.67676 -0.77283 - 3.0000 -0.7500 0.3333 -1.18870 0.63017 -0.09784 0.11132 0.90203 0.38406 -0.77283 - 3.0000 -0.7500 0.4286 -0.81648 0.60096 -0.08834 0.11864 0.69706 0.13475 -0.77283 - 3.0000 -0.7500 0.5385 -0.53186 0.55211 -0.07168 0.11495 0.49985 -0.06839 -0.77283 - 3.0000 -0.7500 0.6667 -0.30823 0.48193 -0.04966 0.10088 0.31479 -0.22069 -0.77283 - 3.0000 -0.7500 0.8182 -0.13299 0.38841 -0.02474 0.07680 0.14658 -0.31636 -0.77283 - 3.0000 -0.8000 0.0526 -8.24711 0.72197 -0.05064 -0.07296 1.97848 1.26047 -0.72235 - 3.0000 -0.8000 0.1111 -3.84943 0.52900 -0.07148 -0.00136 1.53911 1.19427 -0.72235 - 3.0000 -0.8000 0.1765 -2.36853 0.60693 -0.08517 0.03600 1.29182 0.82056 -0.72235 - 3.0000 -0.8000 0.2500 -1.60280 0.60463 -0.09164 0.08588 1.07984 0.70638 -0.72235 - 3.0000 -0.8000 0.3333 -1.11566 0.59039 -0.09041 0.10286 0.87595 0.41355 -0.72235 - 3.0000 -0.8000 0.4286 -0.76654 0.56340 -0.08163 0.10963 0.67680 0.16394 -0.72235 - 3.0000 -0.8000 0.5385 -0.49945 0.51787 -0.06624 0.10622 0.48526 -0.04047 -0.72235 - 3.0000 -0.8000 0.6667 -0.28951 0.45223 -0.04589 0.09322 0.30557 -0.19495 -0.72235 - 3.0000 -0.8000 0.8182 -0.12494 0.36457 -0.02287 0.07097 0.14228 -0.29381 -0.72235 - 3.5000 0.0000 0.0526 -36.04194 4.18279 -0.28354 -0.39757 4.04829 -0.33075 -3.28889 - 3.5000 0.0000 0.1111 -16.56935 2.75214 -0.39807 0.00001 3.16293 0.02710 -3.28889 - 3.5000 0.0000 0.1765 -10.06910 2.89897 -0.47171 0.20524 2.65633 -0.28673 -3.28889 - 3.5000 0.0000 0.2500 -6.73421 2.76862 -0.50478 0.47757 2.21854 -0.38582 -3.28889 - 3.5000 0.0000 0.3333 -4.63595 2.62058 -0.49536 0.56772 1.79676 -0.66920 -3.28889 - 3.5000 0.0000 0.4286 -3.15288 2.44227 -0.44498 0.60154 1.38546 -0.90137 -3.28889 - 3.5000 0.0000 0.5385 -2.03531 2.20354 -0.35928 0.57988 0.99108 -1.05211 -3.28889 - 3.5000 0.0000 0.6667 -1.16993 1.89690 -0.24769 0.50659 0.62250 -1.12099 -3.28889 - 3.5000 0.0000 0.8182 -0.50113 1.51345 -0.12283 0.38418 0.28902 -1.09925 -3.28889 - 3.5000 -0.0500 0.0526 -31.58251 3.64118 -0.24399 -0.34212 3.79008 -0.12800 -2.86802 - 3.5000 -0.0500 0.1111 -14.52662 2.39783 -0.34255 0.00001 2.95934 0.17453 -2.86802 - 3.5000 -0.0500 0.1765 -8.83264 2.53146 -0.40592 0.17661 2.48433 -0.14800 -2.86802 - 3.5000 -0.0500 0.2500 -5.91064 2.42123 -0.43438 0.41097 2.07428 -0.24946 -2.86802 - 3.5000 -0.0500 0.3333 -4.07121 2.29468 -0.42628 0.48854 1.67956 -0.53410 -2.86802 - 3.5000 -0.0500 0.4286 -2.77017 2.14077 -0.38292 0.51764 1.29486 -0.76824 -2.86802 - 3.5000 -0.0500 0.5385 -1.78904 1.93313 -0.30917 0.49900 0.92614 -0.92534 -2.86802 - 3.5000 -0.0500 0.6667 -1.02875 1.66519 -0.21315 0.43594 0.58164 -1.00453 -2.86802 - 3.5000 -0.0500 0.8182 -0.44079 1.32918 -0.10570 0.33060 0.27002 -0.99752 -2.86802 - 3.5000 -0.1000 0.0526 -27.91255 3.19760 -0.21183 -0.29703 3.56286 0.05041 -2.52306 - 3.5000 -0.1000 0.1111 -12.84486 2.10745 -0.29740 0.00001 2.78019 0.30426 -2.52306 - 3.5000 -0.1000 0.1765 -7.81424 2.22977 -0.35242 0.15334 2.33298 -0.02593 -2.52306 - 3.5000 -0.1000 0.2500 -5.23202 2.13576 -0.37713 0.35680 1.94734 -0.12947 -2.52306 - 3.5000 -0.1000 0.3333 -3.60567 2.02662 -0.37009 0.42415 1.57643 -0.41522 -2.52306 - 3.5000 -0.1000 0.4286 -2.45457 1.89258 -0.33245 0.44942 1.21514 -0.65109 -2.52306 - 3.5000 -0.1000 0.5385 -1.58587 1.71039 -0.26842 0.43324 0.86900 -0.81378 -2.52306 - 3.5000 -0.1000 0.6667 -0.91225 1.47425 -0.18505 0.37848 0.54568 -0.90204 -2.52306 - 3.5000 -0.1000 0.8182 -0.39099 1.17728 -0.09177 0.28702 0.25330 -0.90800 -2.52306 - 3.5000 -0.1500 0.0526 -24.85518 2.82982 -0.18536 -0.25991 3.36188 0.20823 -2.23679 - 3.5000 -0.1500 0.1111 -11.44329 1.86653 -0.26023 0.00001 2.62172 0.41901 -2.23679 - 3.5000 -0.1500 0.1765 -6.96517 1.97908 -0.30837 0.13417 2.19911 0.08204 -2.23679 - 3.5000 -0.1500 0.2500 -4.66599 1.89828 -0.32999 0.31221 1.83506 -0.02334 -2.23679 - 3.5000 -0.1500 0.3333 -3.21721 1.80341 -0.32384 0.37114 1.48521 -0.31006 -2.23679 - 3.5000 -0.1500 0.4286 -2.19112 1.68577 -0.29090 0.39325 1.14463 -0.54747 -2.23679 - 3.5000 -0.1500 0.5385 -1.41623 1.52468 -0.23488 0.37909 0.81845 -0.71511 -2.23679 - 3.5000 -0.1500 0.6667 -0.81495 1.31496 -0.16192 0.33118 0.51388 -0.81139 -2.23679 - 3.5000 -0.1500 0.8182 -0.34939 1.05052 -0.08030 0.25115 0.23851 -0.82882 -2.23679 - 3.5000 -0.2000 0.0526 -22.28057 2.52154 -0.16333 -0.22901 3.18325 0.34849 -1.99661 - 3.5000 -0.2000 0.1111 -10.26259 1.66447 -0.22930 0.00001 2.48087 0.52100 -1.99661 - 3.5000 -0.2000 0.1765 -6.24961 1.76849 -0.27172 0.11822 2.08012 0.17801 -1.99661 - 3.5000 -0.2000 0.2500 -4.18876 1.69858 -0.29077 0.27509 1.73526 0.07100 -1.99661 - 3.5000 -0.2000 0.3333 -2.88956 1.61555 -0.28534 0.32702 1.40413 -0.21659 -1.99661 - 3.5000 -0.2000 0.4286 -1.96883 1.51157 -0.25632 0.34650 1.08195 -0.45537 -1.99661 - 3.5000 -0.2000 0.5385 -1.27304 1.36815 -0.20696 0.33403 0.77352 -0.62740 -1.99661 - 3.5000 -0.2000 0.6667 -0.73279 1.18064 -0.14268 0.29181 0.48561 -0.73082 -1.99661 - 3.5000 -0.2000 0.8182 -0.31425 0.94360 -0.07075 0.22130 0.22536 -0.75844 -1.99661 - 3.5000 -0.2500 0.0526 -20.09161 2.26063 -0.14481 -0.20305 3.02376 0.47372 -1.79314 - 3.5000 -0.2500 0.1111 -9.25839 1.49336 -0.20331 0.00001 2.35512 0.61206 -1.79314 - 3.5000 -0.2500 0.1765 -5.64077 1.58988 -0.24091 0.10482 1.97389 0.26370 -1.79314 - 3.5000 -0.2500 0.2500 -3.78255 1.52904 -0.25780 0.24391 1.64616 0.15523 -1.79314 - 3.5000 -0.2500 0.3333 -2.61055 1.45592 -0.25299 0.28995 1.33174 -0.13314 -1.79314 - 3.5000 -0.2500 0.4286 -1.77948 1.36344 -0.22726 0.30722 1.02599 -0.37314 -1.79314 - 3.5000 -0.2500 0.5385 -1.15103 1.23497 -0.18349 0.29616 0.73341 -0.54910 -1.79314 - 3.5000 -0.2500 0.6667 -0.66277 1.06630 -0.12650 0.25873 0.46037 -0.65888 -1.79314 - 3.5000 -0.2500 0.8182 -0.28430 0.85254 -0.06273 0.19621 0.21363 -0.69560 -1.79314 - 3.5000 -0.3000 0.0526 -18.21452 2.03789 -0.12912 -0.18104 2.88078 0.58599 -1.61926 - 3.5000 -0.3000 0.1111 -8.39695 1.34720 -0.18127 0.00001 2.24239 0.69370 -1.61926 - 3.5000 -0.3000 0.1765 -5.11829 1.43708 -0.21480 0.09346 1.87865 0.34051 -1.61926 - 3.5000 -0.3000 0.2500 -3.43381 1.38385 -0.22986 0.21747 1.56628 0.23073 -1.61926 - 3.5000 -0.3000 0.3333 -2.37094 1.31909 -0.22557 0.25852 1.26684 -0.05833 -1.61926 - 3.5000 -0.3000 0.4286 -1.61680 1.23638 -0.20263 0.27392 0.97583 -0.29942 -1.61926 - 3.5000 -0.3000 0.5385 -1.04618 1.12066 -0.16361 0.26406 0.69745 -0.47890 -1.61926 - 3.5000 -0.3000 0.6667 -0.60258 0.96813 -0.11279 0.23069 0.43775 -0.59439 -1.61926 - 3.5000 -0.3000 0.8182 -0.25855 0.77434 -0.05593 0.17494 0.20311 -0.63927 -1.61926 - 3.5000 -0.3500 0.0526 -16.59237 1.84625 -0.11571 -0.16224 2.75211 0.68703 -1.46949 - 3.5000 -0.3500 0.1111 -7.65226 1.22137 -0.16245 0.00000 2.14094 0.76717 -1.46949 - 3.5000 -0.3500 0.1765 -4.66644 1.30535 -0.19250 0.08376 1.79294 0.40964 -1.46949 - 3.5000 -0.3500 0.2500 -3.13210 1.25855 -0.20599 0.19489 1.49440 0.29869 -1.46949 - 3.5000 -0.3500 0.3333 -2.16355 1.20090 -0.20215 0.23168 1.20844 0.00899 -1.46949 - 3.5000 -0.3500 0.4286 -1.47596 1.12656 -0.18159 0.24548 0.93068 -0.23308 -1.46949 - 3.5000 -0.3500 0.5385 -0.95537 1.02181 -0.14662 0.23664 0.66509 -0.41572 -1.46949 - 3.5000 -0.3500 0.6667 -0.55044 0.88318 -0.10108 0.20673 0.41738 -0.53635 -1.46949 - 3.5000 -0.3500 0.8182 -0.23623 0.70665 -0.05013 0.15678 0.19364 -0.58858 -1.46949 - 3.5000 -0.4000 0.0526 -15.18073 1.68020 -0.10417 -0.14607 2.63589 0.77828 -1.33958 - 3.5000 -0.4000 0.1111 -7.00398 1.11228 -0.14625 0.00000 2.04930 0.83352 -1.33958 - 3.5000 -0.4000 0.1765 -4.27295 1.19097 -0.17331 0.07541 1.71553 0.47208 -1.33958 - 3.5000 -0.4000 0.2500 -2.86926 1.14965 -0.18546 0.17546 1.42947 0.36006 -1.33958 - 3.5000 -0.4000 0.3333 -1.98282 1.09810 -0.18200 0.20858 1.15569 0.06980 -1.33958 - 3.5000 -0.4000 0.4286 -1.35317 1.03096 -0.16349 0.22101 0.88991 -0.17316 -1.33958 - 3.5000 -0.4000 0.5385 -0.87618 0.93571 -0.13200 0.21305 0.63586 -0.35866 -1.33958 - 3.5000 -0.4000 0.6667 -0.50495 0.80917 -0.09100 0.18612 0.39899 -0.48393 -1.33958 - 3.5000 -0.4000 0.8182 -0.21676 0.64766 -0.04513 0.14115 0.18509 -0.54279 -1.33958 - 3.5000 -0.4500 0.0526 -13.94445 1.53539 -0.09419 -0.13206 2.53058 0.86097 -1.22617 - 3.5000 -0.4500 0.1111 -6.43605 1.01709 -0.13223 0.00000 1.96627 0.89365 -1.22617 - 3.5000 -0.4500 0.1765 -3.92811 1.09102 -0.15669 0.06818 1.64538 0.52866 -1.22617 - 3.5000 -0.4500 0.2500 -2.63882 1.05440 -0.16768 0.15864 1.37064 0.41567 -1.22617 - 3.5000 -0.4500 0.3333 -1.82431 1.00812 -0.16455 0.18858 1.10789 0.12490 -1.22617 - 3.5000 -0.4500 0.4286 -1.24545 0.94723 -0.14781 0.19982 0.85296 -0.11887 -1.22617 - 3.5000 -0.4500 0.5385 -0.80669 0.86025 -0.11935 0.19262 0.60938 -0.30696 -1.22617 - 3.5000 -0.4500 0.6667 -0.46503 0.74428 -0.08228 0.16828 0.38233 -0.43643 -1.22617 - 3.5000 -0.4500 0.8182 -0.19967 0.59592 -0.04080 0.12762 0.17734 -0.50130 -1.22617 - 3.5000 -0.5000 0.0526 -12.85545 1.40836 -0.08549 -0.11987 2.43485 0.93615 -1.12657 - 3.5000 -0.5000 0.1111 -5.93561 0.93355 -0.12002 0.00000 1.89078 0.94831 -1.12657 - 3.5000 -0.5000 0.1765 -3.62413 1.00318 -0.14222 0.06188 1.58161 0.58009 -1.12657 - 3.5000 -0.5000 0.2500 -2.43562 0.97061 -0.15219 0.14399 1.31715 0.46623 -1.12657 - 3.5000 -0.5000 0.3333 -1.68449 0.92889 -0.14935 0.17116 1.06444 0.17499 -1.12657 - 3.5000 -0.5000 0.4286 -1.15040 0.87345 -0.13416 0.18136 0.81937 -0.06951 -1.12657 - 3.5000 -0.5000 0.5385 -0.74535 0.79374 -0.10832 0.17483 0.58530 -0.25995 -1.12657 - 3.5000 -0.5000 0.6667 -0.42979 0.68705 -0.07468 0.15274 0.36718 -0.39325 -1.12657 - 3.5000 -0.5000 0.8182 -0.18458 0.55028 -0.03703 0.11583 0.17029 -0.46358 -1.12657 - 3.5000 -0.5500 0.0526 -11.89108 1.29633 -0.07787 -0.10918 2.34756 1.00468 -1.03864 - 3.5000 -0.5500 0.1111 -5.49231 0.85983 -0.10932 0.00000 1.82196 0.99814 -1.03864 - 3.5000 -0.5500 0.1765 -3.35477 0.92556 -0.12955 0.05636 1.52347 0.62698 -1.03864 - 3.5000 -0.5500 0.2500 -2.25549 0.89650 -0.13863 0.13116 1.26839 0.51232 -1.03864 - 3.5000 -0.5500 0.3333 -1.56050 0.85876 -0.13604 0.15591 1.02482 0.22066 -1.03864 - 3.5000 -0.5500 0.4286 -1.06608 0.80811 -0.12221 0.16520 0.78874 -0.02451 -1.03864 - 3.5000 -0.5500 0.5385 -0.69092 0.73479 -0.09867 0.15925 0.56335 -0.21710 -1.03864 - 3.5000 -0.5500 0.6667 -0.39850 0.63631 -0.06802 0.13913 0.35337 -0.35388 -1.03864 - 3.5000 -0.5500 0.8182 -0.17118 0.50980 -0.03373 0.10551 0.16387 -0.42920 -1.03864 - 3.5000 -0.6000 0.0526 -11.03287 1.19704 -0.07116 -0.09978 2.26776 1.06734 -0.96061 - 3.5000 -0.6000 0.1111 -5.09768 0.79446 -0.09991 0.00000 1.75905 1.04370 -0.96061 - 3.5000 -0.6000 0.1765 -3.11490 0.85663 -0.11839 0.05151 1.47031 0.66986 -0.96061 - 3.5000 -0.6000 0.2500 -2.09503 0.83063 -0.12669 0.11986 1.22381 0.55447 -0.96061 - 3.5000 -0.6000 0.3333 -1.45001 0.79638 -0.12433 0.14249 0.98860 0.26241 -0.96061 - 3.5000 -0.6000 0.4286 -0.99093 0.74995 -0.11168 0.15098 0.76075 0.01664 -0.96061 - 3.5000 -0.6000 0.5385 -0.64240 0.68230 -0.09017 0.14554 0.54328 -0.17792 -0.96061 - 3.5000 -0.6000 0.6667 -0.37061 0.59111 -0.06217 0.12715 0.34074 -0.31789 -0.96061 - 3.5000 -0.6000 0.8182 -0.15923 0.47373 -0.03083 0.09642 0.15800 -0.39776 -0.96061 - 3.5000 -0.6500 0.0526 -10.26570 1.10863 -0.06524 -0.09147 2.19462 1.12477 -0.89105 - 3.5000 -0.6500 0.1111 -4.74481 0.73622 -0.09159 0.00000 1.70138 1.08547 -0.89105 - 3.5000 -0.6500 0.1765 -2.90034 0.79514 -0.10853 0.04722 1.42159 0.70915 -0.89105 - 3.5000 -0.6500 0.2500 -1.95145 0.77181 -0.11614 0.10988 1.18295 0.59309 -0.89105 - 3.5000 -0.6500 0.3333 -1.35111 0.74064 -0.11397 0.13062 0.95540 0.30069 -0.89105 - 3.5000 -0.6500 0.4286 -0.92363 0.69794 -0.10238 0.13840 0.73508 0.05435 -0.89105 - 3.5000 -0.6500 0.5385 -0.59894 0.63534 -0.08266 0.13342 0.52488 -0.14201 -0.89105 - 3.5000 -0.6500 0.6667 -0.34562 0.55066 -0.05699 0.11655 0.32916 -0.28490 -0.89105 - 3.5000 -0.6500 0.8182 -0.14852 0.44144 -0.02826 0.08839 0.15261 -0.36894 -0.89105 - 3.5000 -0.7000 0.0526 -9.57703 1.02957 -0.05997 -0.08409 2.12741 1.17755 -0.82879 - 3.5000 -0.7000 0.1111 -4.42795 0.68413 -0.08420 0.00000 1.64838 1.12384 -0.82879 - 3.5000 -0.7000 0.1765 -2.70761 0.74006 -0.09977 0.04341 1.37682 0.74526 -0.82879 - 3.5000 -0.7000 0.2500 -1.82244 0.71908 -0.10677 0.10101 1.14540 0.62859 -0.82879 - 3.5000 -0.7000 0.3333 -1.26222 0.69062 -0.10478 0.12008 0.92489 0.33585 -0.82879 - 3.5000 -0.7000 0.4286 -0.86313 0.65125 -0.09412 0.12723 0.71150 0.08900 -0.82879 - 3.5000 -0.7000 0.5385 -0.55986 0.59316 -0.07599 0.12265 0.50798 -0.10901 -0.82879 - 3.5000 -0.7000 0.6667 -0.32314 0.51431 -0.05239 0.10715 0.31853 -0.25458 -0.82879 - 3.5000 -0.7000 0.8182 -0.13889 0.41242 -0.02598 0.08126 0.14767 -0.34246 -0.82879 - 3.5000 -0.7500 0.0526 -8.95643 0.95860 -0.05528 -0.07751 2.06551 1.22615 -0.77283 - 3.5000 -0.7500 0.1111 -4.14232 0.63733 -0.07761 0.00000 1.59957 1.15919 -0.77283 - 3.5000 -0.7500 0.1765 -2.53383 0.69052 -0.09197 0.04001 1.33559 0.77852 -0.77283 - 3.5000 -0.7500 0.2500 -1.70607 0.67162 -0.09841 0.09311 1.11081 0.66128 -0.77283 - 3.5000 -0.7500 0.3333 -1.18201 0.64557 -0.09658 0.11068 0.89680 0.36824 -0.77283 - 3.5000 -0.7500 0.4286 -0.80852 0.60917 -0.08676 0.11728 0.68978 0.12091 -0.77283 - 3.5000 -0.7500 0.5385 -0.52457 0.55512 -0.07005 0.11306 0.49241 -0.07862 -0.77283 - 3.5000 -0.7500 0.6667 -0.30284 0.48152 -0.04829 0.09877 0.30873 -0.22666 -0.77283 - 3.5000 -0.7500 0.8182 -0.13019 0.38623 -0.02395 0.07490 0.14311 -0.31807 -0.77283 - 3.5000 -0.8000 0.0526 -8.39515 0.89466 -0.05108 -0.07163 2.00837 1.27102 -0.72235 - 3.5000 -0.8000 0.1111 -3.88392 0.59515 -0.07172 0.00000 1.55452 1.19181 -0.72235 - 3.5000 -0.8000 0.1765 -2.37656 0.64581 -0.08498 0.03698 1.29753 0.80922 -0.72235 - 3.5000 -0.8000 0.2500 -1.60072 0.62874 -0.09094 0.08604 1.07889 0.69145 -0.72235 - 3.5000 -0.8000 0.3333 -1.10938 0.60484 -0.08924 0.10228 0.87086 0.39814 -0.72235 - 3.5000 -0.8000 0.4286 -0.75906 0.57110 -0.08017 0.10837 0.66974 0.15037 -0.72235 - 3.5000 -0.8000 0.5385 -0.49260 0.52069 -0.06473 0.10447 0.47804 -0.05056 -0.72235 - 3.5000 -0.8000 0.6667 -0.28444 0.45183 -0.04462 0.09127 0.29969 -0.20089 -0.72235 - 3.5000 -0.8000 0.8182 -0.12230 0.36252 -0.02213 0.06921 0.13891 -0.29556 -0.72235 - 4.0000 0.0000 0.0526 -36.58741 4.83743 -0.28556 -0.39141 4.10204 -0.34489 -3.28889 - 4.0000 0.0000 0.1111 -16.69338 2.99819 -0.39911 0.00626 3.19116 0.00233 -3.28889 - 4.0000 0.0000 0.1765 -10.09710 3.04083 -0.47076 0.20965 2.66714 -0.31744 -3.28889 - 4.0000 0.0000 0.2500 -6.72665 2.85517 -0.50148 0.47818 2.21726 -0.41597 -3.28889 - 4.0000 0.0000 0.3333 -4.61416 2.67176 -0.48996 0.56491 1.78791 -0.69534 -3.28889 - 4.0000 0.0000 0.4286 -3.12737 2.46940 -0.43826 0.59568 1.37292 -0.92147 -3.28889 - 4.0000 0.0000 0.5385 -2.01225 2.21365 -0.35239 0.57181 0.97817 -1.06502 -3.28889 - 4.0000 0.0000 0.6667 -1.15305 1.89593 -0.24196 0.49767 0.61193 -1.12684 -3.28889 - 4.0000 0.0000 0.8182 -0.49243 1.50698 -0.11951 0.37622 0.28295 -1.09933 -3.28889 - 4.0000 -0.0500 0.0526 -32.06025 4.21419 -0.24573 -0.33682 3.84030 -0.13919 -2.86802 - 4.0000 -0.0500 0.1111 -14.63535 2.61331 -0.34344 0.00539 2.98569 0.15262 -2.86802 - 4.0000 -0.0500 0.1765 -8.85721 2.65579 -0.40511 0.18041 2.49440 -0.17607 -2.86802 - 4.0000 -0.0500 0.2500 -5.90401 2.49714 -0.43154 0.41149 2.07306 -0.27743 -2.86802 - 4.0000 -0.0500 0.3333 -4.05206 2.33960 -0.42163 0.48612 1.67127 -0.55861 -2.86802 - 4.0000 -0.0500 0.4286 -2.74774 2.16458 -0.37714 0.51260 1.28314 -0.78728 -2.86802 - 4.0000 -0.0500 0.5385 -1.76875 1.94199 -0.30325 0.49206 0.91407 -0.93771 -2.86802 - 4.0000 -0.0500 0.6667 -1.01390 1.66432 -0.20821 0.42826 0.57176 -1.01028 -2.86802 - 4.0000 -0.0500 0.8182 -0.43314 1.32347 -0.10284 0.32375 0.26435 -0.99778 -2.86802 - 4.0000 -0.1000 0.0526 -28.33457 3.70349 -0.21334 -0.29242 3.60998 0.04181 -2.52306 - 4.0000 -0.1000 0.1111 -12.94099 2.29779 -0.29818 0.00468 2.80488 0.28487 -2.52306 - 4.0000 -0.1000 0.1765 -7.83600 2.33968 -0.35171 0.15664 2.34240 -0.05168 -2.52306 - 4.0000 -0.1000 0.2500 -5.22615 2.20291 -0.37466 0.35725 1.94618 -0.15552 -2.52306 - 4.0000 -0.1000 0.3333 -3.58870 2.06637 -0.36606 0.42205 1.56864 -0.43831 -2.52306 - 4.0000 -0.1000 0.4286 -2.43468 1.91366 -0.32743 0.44504 1.20413 -0.66921 -2.52306 - 4.0000 -0.1000 0.5385 -1.56787 1.71823 -0.26328 0.42721 0.85767 -0.82570 -2.52306 - 4.0000 -0.1000 0.6667 -0.89907 1.47345 -0.18077 0.37181 0.53642 -0.90771 -2.52306 - 4.0000 -0.1000 0.8182 -0.38420 1.17219 -0.08929 0.28108 0.24798 -0.90842 -2.52306 - 4.0000 -0.1500 0.0526 -25.23081 3.27983 -0.18668 -0.25588 3.40626 0.20192 -2.23679 - 4.0000 -0.1500 0.1111 -11.52894 2.03594 -0.26091 0.00410 2.64495 0.40185 -2.23679 - 4.0000 -0.1500 0.1765 -6.98457 2.07697 -0.30776 0.13706 2.20795 0.05836 -2.23679 - 4.0000 -0.1500 0.2500 -4.66076 1.95813 -0.32784 0.31260 1.83394 -0.04769 -2.23679 - 4.0000 -0.1500 0.3333 -3.20206 1.83887 -0.32031 0.36930 1.47785 -0.33189 -2.23679 - 4.0000 -0.1500 0.4286 -2.17335 1.70457 -0.28651 0.38942 1.13425 -0.56476 -2.23679 - 4.0000 -0.1500 0.5385 -1.40014 1.53166 -0.23037 0.37382 0.80778 -0.72661 -2.23679 - 4.0000 -0.1500 0.6667 -0.80316 1.31423 -0.15818 0.32534 0.50515 -0.81698 -2.23679 - 4.0000 -0.1500 0.8182 -0.34331 1.04596 -0.07813 0.24595 0.23350 -0.82938 -2.23679 - 4.0000 -0.2000 0.0526 -22.61714 2.92454 -0.16449 -0.22546 3.22518 0.34422 -1.99661 - 4.0000 -0.2000 0.1111 -10.33940 1.81625 -0.22990 0.00361 2.50280 0.50583 -1.99661 - 4.0000 -0.2000 0.1765 -6.26703 1.85626 -0.27117 0.12077 2.08844 0.15616 -1.99661 - 4.0000 -0.2000 0.2500 -4.18407 1.75228 -0.28887 0.27545 1.73418 0.04816 -1.99661 - 4.0000 -0.2000 0.3333 -2.87594 1.64738 -0.28223 0.32541 1.39716 -0.23730 -1.99661 - 4.0000 -0.2000 0.4286 -1.95285 1.52845 -0.25245 0.34313 1.07213 -0.47193 -1.99661 - 4.0000 -0.2000 0.5385 -1.25857 1.37442 -0.20299 0.32938 0.76343 -0.63854 -1.99661 - 4.0000 -0.2000 0.6667 -0.72218 1.17998 -0.13937 0.28667 0.47736 -0.73635 -1.99661 - 4.0000 -0.2000 0.8182 -0.30878 0.93948 -0.06884 0.21671 0.22063 -0.75913 -1.99661 - 4.0000 -0.2500 0.0526 -20.39499 2.62370 -0.14584 -0.19990 3.06352 0.47127 -1.79314 - 4.0000 -0.2500 0.1111 -9.32768 1.63016 -0.20383 0.00320 2.37588 0.59866 -1.79314 - 4.0000 -0.2500 0.1765 -5.65650 1.66904 -0.24043 0.10708 1.98175 0.24348 -1.79314 - 4.0000 -0.2500 0.2500 -3.77831 1.57750 -0.25612 0.24422 1.64512 0.13373 -1.79314 - 4.0000 -0.2500 0.3333 -2.59825 1.48465 -0.25024 0.28852 1.32512 -0.15285 -1.79314 - 4.0000 -0.2500 0.4286 -1.76503 1.37868 -0.22383 0.30423 1.01668 -0.38905 -1.79314 - 4.0000 -0.2500 0.5385 -1.13793 1.24062 -0.17998 0.29204 0.72384 -0.55991 -1.79314 - 4.0000 -0.2500 0.6667 -0.65317 1.06569 -0.12357 0.25417 0.45255 -0.66435 -1.79314 - 4.0000 -0.2500 0.8182 -0.27934 0.84881 -0.06104 0.19214 0.20914 -0.69641 -1.79314 - 4.0000 -0.3000 0.0526 -18.48944 2.36674 -0.13004 -0.17824 2.91859 0.58517 -1.61926 - 4.0000 -0.3000 0.1111 -8.45979 1.47116 -0.18174 0.00285 2.26211 0.68189 -1.61926 - 4.0000 -0.3000 0.1765 -5.13257 1.50886 -0.21437 0.09547 1.88610 0.32176 -1.61926 - 4.0000 -0.3000 0.2500 -3.42997 1.42782 -0.22836 0.21775 1.56527 0.21044 -1.61926 - 4.0000 -0.3000 0.3333 -2.35975 1.34517 -0.22312 0.25725 1.26053 -0.07715 -1.61926 - 4.0000 -0.3000 0.4286 -1.60366 1.25022 -0.19957 0.27125 0.96696 -0.31475 -1.61926 - 4.0000 -0.3000 0.5385 -1.03426 1.12579 -0.16047 0.26039 0.68835 -0.48942 -1.61926 - 4.0000 -0.3000 0.6667 -0.59384 0.96756 -0.11018 0.22662 0.43031 -0.59981 -1.61926 - 4.0000 -0.3000 0.8182 -0.25404 0.77094 -0.05442 0.17132 0.19884 -0.64018 -1.61926 - 4.0000 -0.3500 0.0526 -16.84272 2.14555 -0.11653 -0.15973 2.78816 0.68768 -1.46949 - 4.0000 -0.3500 0.1111 -7.70953 1.33424 -0.16287 0.00256 2.15971 0.75678 -1.46949 - 4.0000 -0.3500 0.1765 -4.67947 1.37074 -0.19211 0.08556 1.80002 0.39220 -1.46949 - 4.0000 -0.3500 0.2500 -3.12860 1.29863 -0.20465 0.19514 1.49341 0.27948 -1.46949 - 4.0000 -0.3500 0.3333 -2.15334 1.22470 -0.19995 0.23053 1.20241 -0.00902 -1.46949 - 4.0000 -0.3500 0.4286 -1.46395 1.13918 -0.17885 0.24309 0.92222 -0.24788 -1.46949 - 4.0000 -0.3500 0.5385 -0.94448 1.02648 -0.14381 0.23335 0.65641 -0.42598 -1.46949 - 4.0000 -0.3500 0.6667 -0.54245 0.88266 -0.09874 0.20309 0.41030 -0.54173 -1.46949 - 4.0000 -0.3500 0.8182 -0.23211 0.70354 -0.04877 0.15353 0.18957 -0.58958 -1.46949 - 4.0000 -0.4000 0.0526 -15.40970 1.95380 -0.10492 -0.14380 2.67035 0.78026 -1.33958 - 4.0000 -0.4000 0.1111 -7.05640 1.21550 -0.14663 0.00230 2.06723 0.82442 -1.33958 - 4.0000 -0.4000 0.1765 -4.28489 1.25081 -0.17296 0.07703 1.72228 0.45583 -1.33958 - 4.0000 -0.4000 0.2500 -2.86605 1.18635 -0.18425 0.17569 1.42851 0.34183 -1.33958 - 4.0000 -0.4000 0.3333 -1.97346 1.11990 -0.18002 0.20755 1.14991 0.05252 -1.33958 - 4.0000 -0.4000 0.4286 -1.34216 1.04253 -0.16102 0.21885 0.88181 -0.18748 -1.33958 - 4.0000 -0.4000 0.5385 -0.86619 0.93999 -0.12947 0.21009 0.62756 -0.36869 -1.33958 - 4.0000 -0.4000 0.6667 -0.49762 0.80868 -0.08890 0.18284 0.39222 -0.48926 -1.33958 - 4.0000 -0.4000 0.8182 -0.21298 0.64479 -0.04391 0.13822 0.18120 -0.54387 -1.33958 - 4.0000 -0.4500 0.0526 -14.15470 1.78650 -0.09486 -0.13002 2.56360 0.86415 -1.22617 - 4.0000 -0.4500 0.1111 -6.48422 1.11187 -0.13257 0.00208 1.98343 0.88572 -1.22617 - 4.0000 -0.4500 0.1765 -3.93909 1.14600 -0.15638 0.06964 1.65182 0.51349 -1.22617 - 4.0000 -0.4500 0.2500 -2.63587 1.08814 -0.16658 0.15884 1.36970 0.39834 -1.22617 - 4.0000 -0.4500 0.3333 -1.81569 1.02816 -0.16276 0.18765 1.10234 0.10828 -1.22617 - 4.0000 -0.4500 0.4286 -1.23531 0.95787 -0.14558 0.19787 0.84519 -0.13276 -1.22617 - 4.0000 -0.4500 0.5385 -0.79748 0.86419 -0.11706 0.18994 0.60142 -0.31676 -1.22617 - 4.0000 -0.4500 0.6667 -0.45827 0.74382 -0.08037 0.16531 0.37583 -0.44173 -1.22617 - 4.0000 -0.4500 0.8182 -0.19618 0.59327 -0.03970 0.12497 0.17361 -0.50245 -1.22617 - 4.0000 -0.5000 0.0526 -13.04921 1.63968 -0.08610 -0.11801 2.46656 0.94042 -1.12657 - 4.0000 -0.5000 0.1111 -5.98004 1.02089 -0.12033 0.00189 1.90725 0.94145 -1.12657 - 4.0000 -0.5000 0.1765 -3.63427 1.05387 -0.14193 0.06321 1.58778 0.56590 -1.12657 - 4.0000 -0.5000 0.2500 -2.43290 1.00174 -0.15120 0.14417 1.31624 0.44970 -1.12657 - 4.0000 -0.5000 0.3333 -1.67653 0.94739 -0.14772 0.17032 1.05910 0.15897 -1.12657 - 4.0000 -0.5000 0.4286 -1.14103 0.88328 -0.13214 0.17960 0.81191 -0.08300 -1.12657 - 4.0000 -0.5000 0.5385 -0.73684 0.79737 -0.10625 0.17240 0.57765 -0.26957 -1.12657 - 4.0000 -0.5000 0.6667 -0.42353 0.68662 -0.07295 0.15005 0.36094 -0.39851 -1.12657 - 4.0000 -0.5000 0.8182 -0.18135 0.54782 -0.03603 0.11343 0.16671 -0.46480 -1.12657 - 4.0000 -0.5500 0.0526 -12.07024 1.51013 -0.07842 -0.10749 2.37809 1.00995 -1.03864 - 4.0000 -0.5500 0.1111 -5.53341 0.94059 -0.10961 0.00172 1.83779 0.99225 -1.03864 - 4.0000 -0.5500 0.1765 -3.36415 0.97246 -0.12929 0.05758 1.52939 0.61369 -1.03864 - 4.0000 -0.5500 0.2500 -2.25297 0.92531 -0.13772 0.13132 1.26749 0.49653 -1.03864 - 4.0000 -0.5500 0.3333 -1.55312 0.87589 -0.13456 0.15514 1.01967 0.20519 -1.03864 - 4.0000 -0.5500 0.4286 -1.05739 0.81721 -0.12036 0.16359 0.78156 -0.03765 -1.03864 - 4.0000 -0.5500 0.5385 -0.68303 0.73815 -0.09678 0.15704 0.55599 -0.22653 -1.03864 - 4.0000 -0.5500 0.6667 -0.39270 0.63591 -0.06645 0.13667 0.34736 -0.35911 -1.03864 - 4.0000 -0.5500 0.8182 -0.16818 0.50752 -0.03282 0.10332 0.16043 -0.43048 -1.03864 - 4.0000 -0.6000 0.0526 -11.19905 1.39526 -0.07167 -0.09824 2.29720 1.07352 -0.96061 - 4.0000 -0.6000 0.1111 -5.13583 0.86936 -0.10017 0.00157 1.77429 1.03870 -0.96061 - 4.0000 -0.6000 0.1765 -3.12362 0.90015 -0.11815 0.05262 1.47601 0.65738 -0.96061 - 4.0000 -0.6000 0.2500 -2.09269 0.85738 -0.12586 0.12002 1.22293 0.53934 -0.96061 - 4.0000 -0.6000 0.3333 -1.44315 0.81229 -0.12297 0.14178 0.98363 0.24744 -0.96061 - 4.0000 -0.6000 0.4286 -0.98284 0.75840 -0.11000 0.14950 0.75381 0.00382 -0.96061 - 4.0000 -0.6000 0.5385 -0.63505 0.68542 -0.08844 0.14352 0.53618 -0.18719 -0.96061 - 4.0000 -0.6000 0.6667 -0.36521 0.59073 -0.06073 0.12491 0.33495 -0.32309 -0.96061 - 4.0000 -0.6000 0.8182 -0.15644 0.47160 -0.03000 0.09442 0.15468 -0.39910 -0.96061 - 4.0000 -0.6500 0.0526 -10.42028 1.29293 -0.06570 -0.09005 2.22306 1.13178 -0.89105 - 4.0000 -0.6500 0.1111 -4.78032 0.80590 -0.09183 0.00144 1.71609 1.08127 -0.89105 - 4.0000 -0.6500 0.1765 -2.90846 0.83564 -0.10831 0.04824 1.42707 0.69742 -0.89105 - 4.0000 -0.6500 0.2500 -1.94927 0.79672 -0.11538 0.11002 1.18208 0.57859 -0.89105 - 4.0000 -0.6500 0.3333 -1.34472 0.75546 -0.11273 0.12997 0.95059 0.28617 -0.89105 - 4.0000 -0.6500 0.4286 -0.91610 0.70582 -0.10083 0.13705 0.72838 0.04183 -0.89105 - 4.0000 -0.6500 0.5385 -0.59209 0.63824 -0.08108 0.13156 0.51802 -0.15113 -0.89105 - 4.0000 -0.6500 0.6667 -0.34058 0.55030 -0.05567 0.11450 0.32357 -0.29007 -0.89105 - 4.0000 -0.6500 0.8182 -0.14592 0.43945 -0.02750 0.08656 0.14941 -0.37033 -0.89105 - 4.0000 -0.7000 0.0526 -9.72120 1.20139 -0.06040 -0.08279 2.15493 1.18532 -0.82879 - 4.0000 -0.7000 0.1111 -4.46109 0.74910 -0.08442 0.00133 1.66260 1.12039 -0.82879 - 4.0000 -0.7000 0.1765 -2.71520 0.77785 -0.09957 0.04434 1.38211 0.73422 -0.82879 - 4.0000 -0.7000 0.2500 -1.82041 0.74233 -0.10607 0.10114 1.14455 0.61465 -0.82879 - 4.0000 -0.7000 0.3333 -1.25625 0.70446 -0.10363 0.11949 0.92023 0.32176 -0.82879 - 4.0000 -0.7000 0.4286 -0.85608 0.65861 -0.09270 0.12599 0.70501 0.07676 -0.82879 - 4.0000 -0.7000 0.5385 -0.55345 0.59587 -0.07454 0.12095 0.50134 -0.11800 -0.82879 - 4.0000 -0.7000 0.6667 -0.31842 0.51397 -0.05118 0.10526 0.31312 -0.25973 -0.82879 - 4.0000 -0.7000 0.8182 -0.13645 0.41056 -0.02528 0.07957 0.14457 -0.34390 -0.82879 - 4.0000 -0.7500 0.0526 -9.09122 1.11918 -0.05567 -0.07631 2.09218 1.23464 -0.77283 - 4.0000 -0.7500 0.1111 -4.17333 0.69808 -0.07781 0.00122 1.61334 1.15642 -0.77283 - 4.0000 -0.7500 0.1765 -2.54094 0.72587 -0.09178 0.04088 1.34070 0.76811 -0.77283 - 4.0000 -0.7500 0.2500 -1.70417 0.69337 -0.09777 0.09323 1.10998 0.64786 -0.77283 - 4.0000 -0.7500 0.3333 -1.17642 0.65853 -0.09553 0.11014 0.89227 0.35453 -0.77283 - 4.0000 -0.7500 0.4286 -0.80192 0.61606 -0.08545 0.11614 0.68348 0.10893 -0.77283 - 4.0000 -0.7500 0.5385 -0.51856 0.55765 -0.06870 0.11148 0.48597 -0.08748 -0.77283 - 4.0000 -0.7500 0.6667 -0.29842 0.48120 -0.04717 0.09703 0.30349 -0.23179 -0.77283 - 4.0000 -0.7500 0.8182 -0.12790 0.38448 -0.02330 0.07335 0.14011 -0.31955 -0.77283 - 4.0000 -0.8000 0.0526 -8.52146 1.04508 -0.05145 -0.07052 2.03426 1.28015 -0.72235 - 4.0000 -0.8000 0.1111 -3.91299 0.65207 -0.07190 0.00113 1.56787 1.18968 -0.72235 - 4.0000 -0.8000 0.1765 -2.38323 0.67895 -0.08481 0.03777 1.30248 0.79939 -0.72235 - 4.0000 -0.8000 0.2500 -1.59894 0.64914 -0.09035 0.08615 1.07807 0.67852 -0.72235 - 4.0000 -0.8000 0.3333 -1.10413 0.61700 -0.08827 0.10177 0.86646 0.38479 -0.72235 - 4.0000 -0.8000 0.4286 -0.75286 0.57757 -0.07896 0.10732 0.66361 0.13862 -0.72235 - 4.0000 -0.8000 0.5385 -0.48696 0.52307 -0.06349 0.10302 0.47179 -0.05931 -0.72235 - 4.0000 -0.8000 0.6667 -0.28029 0.45153 -0.04359 0.08966 0.29460 -0.20599 -0.72235 - 4.0000 -0.8000 0.8182 -0.12015 0.36087 -0.02153 0.06778 0.13599 -0.29708 -0.72235 - 4.5000 0.0000 0.0526 -37.06216 5.41697 -0.28727 -0.38614 4.14566 -0.35698 -3.28889 - 4.5000 0.0000 0.1111 -16.80026 3.21387 -0.39994 0.01155 3.21282 -0.01863 -3.28889 - 4.5000 0.0000 0.1765 -10.12093 3.16426 -0.46990 0.21334 2.67459 -0.34249 -3.28889 - 4.5000 0.0000 0.2500 -6.72004 2.93005 -0.49862 0.47860 2.21531 -0.43996 -3.28889 - 4.5000 0.0000 0.3333 -4.59551 2.71584 -0.48534 0.56245 1.78035 -0.71566 -3.28889 - 4.5000 0.0000 0.4286 -3.10568 2.49271 -0.43256 0.59064 1.36287 -0.93678 -3.28889 - 4.5000 0.0000 0.5385 -1.99274 2.22238 -0.34658 0.56495 0.96815 -1.07463 -3.28889 - 4.5000 0.0000 0.6667 -1.13884 1.89524 -0.23715 0.49012 0.60394 -1.13106 -3.28889 - 4.5000 0.0000 0.8182 -0.48514 1.50106 -0.11674 0.36941 0.27846 -1.09867 -3.28889 - 4.5000 -0.0500 0.0526 -32.47605 4.72146 -0.24720 -0.33229 3.88105 -0.14888 -2.86802 - 4.5000 -0.0500 0.1111 -14.72904 2.80219 -0.34416 0.00994 3.00589 0.13400 -2.86802 - 4.5000 -0.0500 0.1765 -8.87813 2.76397 -0.40436 0.18359 2.50133 -0.19901 -2.86802 - 4.5000 -0.0500 0.2500 -5.89820 2.56281 -0.42908 0.41185 2.07122 -0.29972 -2.86802 - 4.5000 -0.0500 0.3333 -4.03567 2.37828 -0.41765 0.48400 1.66420 -0.57770 -2.86802 - 4.5000 -0.0500 0.4286 -2.72867 2.18504 -0.37223 0.50827 1.27374 -0.80180 -2.86802 - 4.5000 -0.0500 0.5385 -1.75158 1.94965 -0.29824 0.48616 0.90471 -0.94694 -2.86802 - 4.5000 -0.0500 0.6667 -1.00138 1.66369 -0.20407 0.42177 0.56429 -1.01444 -2.86802 - 4.5000 -0.0500 0.8182 -0.42672 1.31826 -0.10046 0.31789 0.26015 -0.99732 -2.86802 - 4.5000 -0.1000 0.0526 -28.70187 4.15134 -0.21462 -0.28849 3.64822 0.03424 -2.52306 - 4.5000 -0.1000 0.1111 -13.02383 2.46463 -0.29880 0.00863 2.82381 0.26831 -2.52306 - 4.5000 -0.1000 0.1765 -7.85451 2.43531 -0.35107 0.15939 2.34888 -0.07276 -2.52306 - 4.5000 -0.1000 0.2500 -5.22101 2.26100 -0.37253 0.35757 1.94443 -0.17631 -2.52306 - 4.5000 -0.1000 0.3333 -3.57417 2.10061 -0.36261 0.42021 1.56199 -0.45631 -2.52306 - 4.5000 -0.1000 0.4286 -2.41776 1.93177 -0.32317 0.44128 1.19531 -0.68303 -2.52306 - 4.5000 -0.1000 0.5385 -1.55264 1.72500 -0.25893 0.42208 0.84888 -0.83459 -2.52306 - 4.5000 -0.1000 0.6667 -0.88796 1.47288 -0.17718 0.36618 0.52941 -0.91182 -2.52306 - 4.5000 -0.1000 0.8182 -0.37849 1.16755 -0.08722 0.27599 0.24404 -0.90814 -2.52306 - 4.5000 -0.1500 0.0526 -25.55772 3.67822 -0.18780 -0.25244 3.44226 0.19622 -2.23679 - 4.5000 -0.1500 0.1111 -11.60273 2.18443 -0.26146 0.00755 2.66275 0.38711 -2.23679 - 4.5000 -0.1500 0.1765 -7.00108 2.16214 -0.30719 0.13947 2.21403 0.03892 -2.23679 - 4.5000 -0.1500 0.2500 -4.65617 2.00991 -0.32597 0.31288 1.83228 -0.06716 -2.23679 - 4.5000 -0.1500 0.3333 -3.18909 1.86940 -0.31729 0.36769 1.47158 -0.34892 -2.23679 - 4.5000 -0.1500 0.4286 -2.15824 1.72072 -0.28278 0.38613 1.12593 -0.57797 -2.23679 - 4.5000 -0.1500 0.5385 -1.38652 1.53770 -0.22657 0.36933 0.79950 -0.73521 -2.23679 - 4.5000 -0.1500 0.6667 -0.79322 1.31371 -0.15503 0.32041 0.49855 -0.82105 -2.23679 - 4.5000 -0.1500 0.8182 -0.33821 1.04180 -0.07632 0.24150 0.22979 -0.82925 -2.23679 - 4.5000 -0.2000 0.0526 -22.91006 3.28132 -0.16547 -0.22243 3.25920 0.34019 -1.99661 - 4.5000 -0.2000 0.1111 -10.40558 1.94930 -0.23038 0.00665 2.51960 0.49270 -1.99661 - 4.5000 -0.2000 0.1765 -6.28185 1.93262 -0.27067 0.12289 2.09417 0.13818 -1.99661 - 4.5000 -0.2000 0.2500 -4.17996 1.79873 -0.28722 0.27569 1.73259 0.02987 -1.99661 - 4.5000 -0.2000 0.3333 -2.86429 1.67478 -0.27957 0.32399 1.39122 -0.25348 -1.99661 - 4.5000 -0.2000 0.4286 -1.93927 1.54296 -0.24916 0.34023 1.06427 -0.48459 -1.99661 - 4.5000 -0.2000 0.5385 -1.24632 1.37983 -0.19964 0.32543 0.75561 -0.64687 -1.99661 - 4.5000 -0.2000 0.6667 -0.71324 1.17949 -0.13660 0.28232 0.47112 -0.74037 -1.99661 - 4.5000 -0.2000 0.8182 -0.30419 0.93573 -0.06725 0.21279 0.21713 -0.75914 -1.99661 - 4.5000 -0.2500 0.0526 -20.65902 2.94512 -0.14671 -0.19721 3.09576 0.46873 -1.79314 - 4.5000 -0.2500 0.1111 -9.38738 1.75008 -0.20426 0.00590 2.39179 0.58697 -1.79314 - 4.5000 -0.2500 0.1765 -5.66989 1.73791 -0.23999 0.10896 1.98716 0.22680 -1.79314 - 4.5000 -0.2500 0.2500 -3.77460 1.61942 -0.25466 0.24444 1.64359 0.11649 -1.79314 - 4.5000 -0.2500 0.3333 -2.58771 1.50940 -0.24788 0.28726 1.31948 -0.16827 -1.79314 - 4.5000 -0.2500 0.4286 -1.75274 1.39178 -0.22092 0.30166 1.00921 -0.40122 -1.79314 - 4.5000 -0.2500 0.5385 -1.12685 1.24550 -0.17701 0.28854 0.71642 -0.56801 -1.79314 - 4.5000 -0.2500 0.6667 -0.64508 1.06524 -0.12112 0.25032 0.44664 -0.66835 -1.79314 - 4.5000 -0.2500 0.8182 -0.27519 0.84541 -0.05962 0.18867 0.20582 -0.69654 -1.79314 - 4.5000 -0.3000 0.0526 -18.72871 2.65787 -0.13081 -0.17584 2.94924 0.58396 -1.61926 - 4.5000 -0.3000 0.1111 -8.51394 1.57982 -0.18212 0.00526 2.27721 0.67149 -1.61926 - 4.5000 -0.3000 0.1765 -5.14472 1.57130 -0.21398 0.09715 1.89122 0.30625 -1.61926 - 4.5000 -0.3000 0.2500 -3.42659 1.46585 -0.22706 0.21794 1.56380 0.19414 -1.61926 - 4.5000 -0.3000 0.3333 -2.35018 1.36764 -0.22101 0.25612 1.25516 -0.09188 -1.61926 - 4.5000 -0.3000 0.4286 -1.59249 1.26211 -0.19697 0.26896 0.95986 -0.32648 -1.61926 - 4.5000 -0.3000 0.5385 -1.02418 1.13022 -0.15782 0.25726 0.68129 -0.49731 -1.61926 - 4.5000 -0.3000 0.6667 -0.58648 0.96714 -0.10799 0.22319 0.42469 -0.60377 -1.61926 - 4.5000 -0.3000 0.8182 -0.25025 0.76783 -0.05316 0.16822 0.19568 -0.64042 -1.61926 - 4.5000 -0.3500 0.0526 -17.06059 2.41052 -0.11723 -0.15758 2.81738 0.68766 -1.46949 - 4.5000 -0.3500 0.1111 -7.75887 1.43318 -0.16321 0.00471 2.17410 0.74755 -1.46949 - 4.5000 -0.3500 0.1765 -4.69055 1.42764 -0.19176 0.08706 1.80488 0.37775 -1.46949 - 4.5000 -0.3500 0.2500 -3.12552 1.33331 -0.20348 0.19531 1.49200 0.26403 -1.46949 - 4.5000 -0.3500 0.3333 -2.14460 1.24518 -0.19806 0.22953 1.19727 -0.02313 -1.46949 - 4.5000 -0.3500 0.4286 -1.45375 1.15003 -0.17652 0.24103 0.91544 -0.25922 -1.46949 - 4.5000 -0.3500 0.5385 -0.93527 1.03052 -0.14143 0.23055 0.64967 -0.43368 -1.46949 - 4.5000 -0.3500 0.6667 -0.53572 0.88227 -0.09678 0.20001 0.40493 -0.54566 -1.46949 - 4.5000 -0.3500 0.8182 -0.22865 0.70069 -0.04764 0.15075 0.18656 -0.58991 -1.46949 - 4.5000 -0.4000 0.0526 -15.60896 2.19602 -0.10554 -0.14187 2.69829 0.78133 -1.33958 - 4.5000 -0.4000 0.1111 -7.10156 1.30599 -0.14694 0.00424 2.08097 0.81624 -1.33958 - 4.5000 -0.4000 0.1765 -4.29504 1.30287 -0.17264 0.07838 1.72691 0.44233 -1.33958 - 4.5000 -0.4000 0.2500 -2.86323 1.21810 -0.18320 0.17584 1.42715 0.32715 -1.33958 - 4.5000 -0.4000 0.3333 -1.96544 1.13867 -0.17832 0.20665 1.14500 0.03896 -1.33958 - 4.5000 -0.4000 0.4286 -1.33280 1.05247 -0.15892 0.21700 0.87533 -0.19847 -1.33958 - 4.5000 -0.4000 0.5385 -0.85773 0.94369 -0.12734 0.20757 0.62112 -0.37621 -1.33958 - 4.5000 -0.4000 0.6667 -0.49144 0.80832 -0.08713 0.18007 0.38709 -0.49317 -1.33958 - 4.5000 -0.4000 0.8182 -0.20980 0.64218 -0.04289 0.13572 0.17832 -0.54430 -1.33958 - 4.5000 -0.4500 0.0526 -14.33767 2.00882 -0.09542 -0.12827 2.59036 0.86620 -1.22617 - 4.5000 -0.4500 0.1111 -6.52571 1.19495 -0.13285 0.00384 1.99657 0.87849 -1.22617 - 4.5000 -0.4500 0.1765 -3.94842 1.19383 -0.15609 0.07087 1.65625 0.50085 -1.22617 - 4.5000 -0.4500 0.2500 -2.63328 1.11732 -0.16563 0.15898 1.36838 0.38434 -1.22617 - 4.5000 -0.4500 0.3333 -1.80832 1.04542 -0.16122 0.18683 1.09762 0.09523 -1.22617 - 4.5000 -0.4500 0.4286 -1.22669 0.96701 -0.14369 0.19620 0.83897 -0.14342 -1.22617 - 4.5000 -0.4500 0.5385 -0.78969 0.86759 -0.11513 0.18767 0.59524 -0.32414 -1.22617 - 4.5000 -0.4500 0.6667 -0.45258 0.74348 -0.07878 0.16281 0.37092 -0.44561 -1.22617 - 4.5000 -0.4500 0.8182 -0.19325 0.59086 -0.03878 0.12271 0.17086 -0.50296 -1.22617 - 4.5000 -0.5000 0.0526 -13.21783 1.84448 -0.08661 -0.11642 2.49226 0.94336 -1.12657 - 4.5000 -0.5000 0.1111 -6.01831 1.09746 -0.12058 0.00348 1.91985 0.93508 -1.12657 - 4.5000 -0.5000 0.1765 -3.64289 1.09797 -0.14167 0.06432 1.59201 0.55404 -1.12657 - 4.5000 -0.5000 0.2500 -2.43051 1.02866 -0.15033 0.14430 1.31496 0.43634 -1.12657 - 4.5000 -0.5000 0.3333 -1.66972 0.96332 -0.14633 0.16958 1.05456 0.14638 -1.12657 - 4.5000 -0.5000 0.4286 -1.13306 0.89171 -0.13042 0.17808 0.80593 -0.09338 -1.12657 - 4.5000 -0.5000 0.5385 -0.72963 0.80050 -0.10449 0.17033 0.57172 -0.27680 -1.12657 - 4.5000 -0.5000 0.6667 -0.41827 0.68630 -0.07150 0.14777 0.35622 -0.40237 -1.12657 - 4.5000 -0.5000 0.8182 -0.17864 0.54559 -0.03520 0.11138 0.16407 -0.46538 -1.12657 - 4.5000 -0.5500 0.0526 -12.22616 1.69942 -0.07889 -0.10605 2.40281 1.01370 -1.03864 - 4.5000 -0.5500 0.1111 -5.56882 1.01138 -0.10984 0.00317 1.84991 0.98668 -1.03864 - 4.5000 -0.5500 0.1765 -3.37214 1.01325 -0.12905 0.05859 1.53345 0.60254 -1.03864 - 4.5000 -0.5500 0.2500 -2.25076 0.95023 -0.13694 0.13144 1.26625 0.48375 -1.03864 - 4.5000 -0.5500 0.3333 -1.54681 0.89064 -0.13329 0.15446 1.01529 0.19301 -1.03864 - 4.5000 -0.5500 0.4286 -1.05000 0.82502 -0.11879 0.16221 0.77580 -0.04775 -1.03864 - 4.5000 -0.5500 0.5385 -0.67635 0.74105 -0.09518 0.15515 0.55028 -0.23364 -1.03864 - 4.5000 -0.5500 0.6667 -0.38782 0.63561 -0.06513 0.13460 0.34282 -0.36295 -1.03864 - 4.5000 -0.5500 0.8182 -0.16567 0.50544 -0.03206 0.10145 0.15788 -0.43112 -1.03864 - 4.5000 -0.6000 0.0526 -11.34367 1.57076 -0.07210 -0.09692 2.32104 1.07802 -0.96061 - 4.5000 -0.6000 0.1111 -5.16870 0.93502 -0.10038 0.00290 1.78596 1.03385 -0.96061 - 4.5000 -0.6000 0.1765 -3.13104 0.93801 -0.11794 0.05355 1.47990 0.64688 -0.96061 - 4.5000 -0.6000 0.2500 -2.09064 0.88051 -0.12515 0.12012 1.22172 0.52709 -0.96061 - 4.5000 -0.6000 0.3333 -1.43728 0.82599 -0.12181 0.14117 0.97940 0.23565 -0.96061 - 4.5000 -0.6000 0.4286 -0.97597 0.76566 -0.10856 0.14824 0.74825 -0.00604 -0.96061 - 4.5000 -0.6000 0.5385 -0.62884 0.68811 -0.08699 0.14179 0.53067 -0.19418 -0.96061 - 4.5000 -0.6000 0.6667 -0.36066 0.59044 -0.05952 0.12301 0.33057 -0.32691 -0.96061 - 4.5000 -0.6000 0.8182 -0.15410 0.46967 -0.02930 0.09272 0.15222 -0.39980 -0.96061 - 4.5000 -0.6500 0.0526 -10.55480 1.45611 -0.06609 -0.08884 2.24608 1.13697 -0.89105 - 4.5000 -0.6500 0.1111 -4.81091 0.86697 -0.09202 0.00266 1.72734 1.07708 -0.89105 - 4.5000 -0.6500 0.1765 -2.91537 0.87087 -0.10811 0.04908 1.43082 0.68753 -0.89105 - 4.5000 -0.6500 0.2500 -1.94736 0.81826 -0.11472 0.11012 1.18090 0.56681 -0.89105 - 4.5000 -0.6500 0.3333 -1.33925 0.76822 -0.11167 0.12941 0.94649 0.27473 -0.89105 - 4.5000 -0.6500 0.4286 -0.90969 0.71258 -0.09952 0.13589 0.72300 0.03220 -0.89105 - 4.5000 -0.6500 0.5385 -0.58629 0.64075 -0.07974 0.12998 0.51270 -0.15801 -0.89105 - 4.5000 -0.6500 0.6667 -0.33633 0.55003 -0.05456 0.11277 0.31934 -0.29388 -0.89105 - 4.5000 -0.6500 0.8182 -0.14373 0.43764 -0.02686 0.08499 0.14704 -0.37109 -0.89105 - 4.5000 -0.7000 0.0526 -9.84666 1.35352 -0.06076 -0.08167 2.17721 1.19113 -0.82879 - 4.5000 -0.7000 0.1111 -4.48963 0.80606 -0.08459 0.00244 1.67348 1.11681 -0.82879 - 4.5000 -0.7000 0.1765 -2.72165 0.81072 -0.09939 0.04512 1.38573 0.72487 -0.82879 - 4.5000 -0.7000 0.2500 -1.81862 0.76244 -0.10546 0.10123 1.14340 0.60332 -0.82879 - 4.5000 -0.7000 0.3333 -1.25113 0.71638 -0.10266 0.11897 0.91626 0.31064 -0.82879 - 4.5000 -0.7000 0.4286 -0.85009 0.66492 -0.09149 0.12493 0.69980 0.06733 -0.82879 - 4.5000 -0.7000 0.5385 -0.54802 0.59821 -0.07331 0.11950 0.49619 -0.12478 -0.82879 - 4.5000 -0.7000 0.6667 -0.31445 0.51371 -0.05016 0.10367 0.30902 -0.26352 -0.82879 - 4.5000 -0.7000 0.8182 -0.13441 0.40886 -0.02469 0.07814 0.14227 -0.34471 -0.82879 - 4.5000 -0.7500 0.0526 -9.20851 1.26135 -0.05601 -0.07528 2.11377 1.24102 -0.77283 - 4.5000 -0.7500 0.1111 -4.20003 0.75132 -0.07797 0.00225 1.62388 1.15340 -0.77283 - 4.5000 -0.7500 0.1765 -2.54698 0.75662 -0.09161 0.04159 1.34419 0.75927 -0.77283 - 4.5000 -0.7500 0.2500 -1.70249 0.71219 -0.09721 0.09331 1.10885 0.63694 -0.77283 - 4.5000 -0.7500 0.3333 -1.17163 0.66968 -0.09462 0.10966 0.88841 0.34371 -0.77283 - 4.5000 -0.7500 0.4286 -0.79630 0.62197 -0.08433 0.11515 0.67844 0.09969 -0.77283 - 4.5000 -0.7500 0.5385 -0.51348 0.55984 -0.06757 0.11015 0.48098 -0.09417 -0.77283 - 4.5000 -0.7500 0.6667 -0.29470 0.48095 -0.04624 0.09556 0.29951 -0.23557 -0.77283 - 4.5000 -0.7500 0.8182 -0.12598 0.38289 -0.02276 0.07202 0.13788 -0.32042 -0.77283 - 4.5000 -0.8000 0.0526 -8.63137 1.17825 -0.05175 -0.06957 2.05522 1.28707 -0.72235 - 4.5000 -0.8000 0.1111 -3.93803 0.70197 -0.07205 0.00208 1.57809 1.18718 -0.72235 - 4.5000 -0.8000 0.1765 -2.38890 0.70777 -0.08466 0.03844 1.30586 0.79102 -0.72235 - 4.5000 -0.8000 0.2500 -1.59737 0.66679 -0.08983 0.08622 1.07697 0.66797 -0.72235 - 4.5000 -0.8000 0.3333 -1.09963 0.62746 -0.08744 0.10133 0.86271 0.37424 -0.72235 - 4.5000 -0.8000 0.4286 -0.74758 0.58311 -0.07793 0.10641 0.65871 0.12956 -0.72235 - 4.5000 -0.8000 0.5385 -0.48218 0.52512 -0.06244 0.10178 0.46694 -0.06591 -0.72235 - 4.5000 -0.8000 0.6667 -0.27679 0.45129 -0.04272 0.08830 0.29074 -0.20976 -0.72235 - 4.5000 -0.8000 0.8182 -0.11835 0.35937 -0.02103 0.06655 0.13383 -0.29799 -0.72235 - 5.0000 0.0000 0.0526 -37.48177 5.93668 -0.28874 -0.38156 4.18469 -0.36780 -3.28889 - 5.0000 0.0000 0.1111 -16.89392 3.40568 -0.40064 0.01611 3.23219 -0.03738 -3.28889 - 5.0000 0.0000 0.1765 -10.14159 3.27334 -0.46910 0.21649 2.68125 -0.36490 -3.28889 - 5.0000 0.0000 0.2500 -6.71415 2.99592 -0.49610 0.47890 2.21357 -0.46142 -3.28889 - 5.0000 0.0000 0.3333 -4.57925 2.75447 -0.48132 0.56025 1.77359 -0.73384 -3.28889 - 5.0000 0.0000 0.4286 -3.08689 2.51309 -0.42762 0.58624 1.35388 -0.95048 -3.28889 - 5.0000 0.0000 0.5385 -1.97590 2.23005 -0.34158 0.55901 0.95919 -1.08323 -3.28889 - 5.0000 0.0000 0.6667 -1.12662 1.89483 -0.23302 0.48364 0.59678 -1.13505 -3.28889 - 5.0000 0.0000 0.8182 -0.47890 1.49656 -0.11438 0.36367 0.27444 -1.09864 -3.28889 - 5.0000 -0.0500 0.0526 -32.84354 5.17637 -0.24847 -0.32835 3.91751 -0.15754 -2.86802 - 5.0000 -0.0500 0.1111 -14.81114 2.97018 -0.34476 0.01386 3.02397 0.11734 -2.86802 - 5.0000 -0.0500 0.1765 -8.89626 2.85957 -0.40368 0.18629 2.50754 -0.21953 -2.86802 - 5.0000 -0.0500 0.2500 -5.89304 2.62059 -0.42691 0.41211 2.06957 -0.31966 -2.86802 - 5.0000 -0.0500 0.3333 -4.02138 2.41218 -0.41419 0.48211 1.65787 -0.59478 -2.86802 - 5.0000 -0.0500 0.4286 -2.71214 2.20293 -0.36798 0.50448 1.26533 -0.81479 -2.86802 - 5.0000 -0.0500 0.5385 -1.73677 1.95638 -0.29394 0.48104 0.89633 -0.95520 -2.86802 - 5.0000 -0.0500 0.6667 -0.99063 1.66331 -0.20052 0.41619 0.55761 -1.01836 -2.86802 - 5.0000 -0.0500 0.8182 -0.42122 1.31427 -0.09842 0.31295 0.25640 -0.99741 -2.86802 - 5.0000 -0.1000 0.0526 -29.02650 4.55296 -0.21572 -0.28507 3.68241 0.02747 -2.52306 - 5.0000 -0.1000 0.1111 -13.09642 2.61302 -0.29932 0.01203 2.84075 0.25349 -2.52306 - 5.0000 -0.1000 0.1765 -7.87055 2.51981 -0.35047 0.16174 2.35468 -0.09162 -2.52306 - 5.0000 -0.1000 0.2500 -5.21644 2.31210 -0.37064 0.35779 1.94287 -0.19491 -2.52306 - 5.0000 -0.1000 0.3333 -3.56151 2.13061 -0.35960 0.41857 1.55604 -0.47241 -2.52306 - 5.0000 -0.1000 0.4286 -2.40310 1.94760 -0.31948 0.43799 1.18741 -0.69540 -2.52306 - 5.0000 -0.1000 0.5385 -1.53950 1.73095 -0.25519 0.41764 0.84102 -0.84255 -2.52306 - 5.0000 -0.1000 0.6667 -0.87841 1.47253 -0.17409 0.36133 0.52314 -0.91568 -2.52306 - 5.0000 -0.1000 0.8182 -0.37361 1.16401 -0.08545 0.27170 0.24052 -0.90834 -2.52306 - 5.0000 -0.1500 0.0526 -25.84666 4.03549 -0.18876 -0.24944 3.47446 0.19113 -2.23679 - 5.0000 -0.1500 0.1111 -11.66740 2.31649 -0.26191 0.01053 2.67868 0.37392 -2.23679 - 5.0000 -0.1500 0.1765 -7.01539 2.23740 -0.30667 0.14153 2.21947 0.02153 -2.23679 - 5.0000 -0.1500 0.2500 -4.65210 2.05545 -0.32432 0.31308 1.83079 -0.08457 -2.23679 - 5.0000 -0.1500 0.3333 -3.17778 1.89615 -0.31466 0.36626 1.46597 -0.36416 -2.23679 - 5.0000 -0.1500 0.4286 -2.14514 1.73485 -0.27955 0.38325 1.11849 -0.58979 -2.23679 - 5.0000 -0.1500 0.5385 -1.37477 1.54299 -0.22330 0.36544 0.79209 -0.74290 -2.23679 - 5.0000 -0.1500 0.6667 -0.78469 1.31338 -0.15234 0.31617 0.49264 -0.82485 -2.23679 - 5.0000 -0.1500 0.8182 -0.33384 1.03862 -0.07477 0.23775 0.22648 -0.82955 -2.23679 - 5.0000 -0.2000 0.0526 -23.16895 3.60127 -0.16632 -0.21979 3.28962 0.33659 -1.99661 - 5.0000 -0.2000 0.1111 -10.46357 2.06762 -0.23078 0.00928 2.53463 0.48095 -1.99661 - 5.0000 -0.2000 0.1765 -6.29469 2.00010 -0.27022 0.12470 2.09929 0.12210 -1.99661 - 5.0000 -0.2000 0.2500 -4.17629 1.83959 -0.28577 0.27586 1.73117 0.01350 -1.99661 - 5.0000 -0.2000 0.3333 -2.85413 1.69879 -0.27725 0.32272 1.38590 -0.26795 -1.99661 - 5.0000 -0.2000 0.4286 -1.92749 1.55563 -0.24632 0.33769 1.05723 -0.49592 -1.99661 - 5.0000 -0.2000 0.5385 -1.23575 1.38458 -0.19676 0.32200 0.74861 -0.65433 -1.99661 - 5.0000 -0.2000 0.6667 -0.70556 1.17919 -0.13423 0.27859 0.46554 -0.74413 -1.99661 - 5.0000 -0.2000 0.8182 -0.30026 0.93286 -0.06588 0.20949 0.21400 -0.75953 -1.99661 - 5.0000 -0.2500 0.0526 -20.89238 3.23337 -0.14747 -0.19487 3.12460 0.46645 -1.79314 - 5.0000 -0.2500 0.1111 -9.43969 1.85673 -0.20462 0.00823 2.40602 0.57652 -1.79314 - 5.0000 -0.2500 0.1765 -5.68148 1.79877 -0.23958 0.11057 1.99199 0.21189 -1.79314 - 5.0000 -0.2500 0.2500 -3.77129 1.65629 -0.25337 0.24459 1.64223 0.10106 -1.79314 - 5.0000 -0.2500 0.3333 -2.57853 1.53108 -0.24582 0.28613 1.31443 -0.18206 -1.79314 - 5.0000 -0.2500 0.4286 -1.74209 1.40323 -0.21840 0.29941 1.00254 -0.41211 -1.79314 - 5.0000 -0.2500 0.5385 -1.11729 1.24979 -0.17445 0.28550 0.70978 -0.57526 -1.79314 - 5.0000 -0.2500 0.6667 -0.63812 1.06496 -0.11901 0.24701 0.44135 -0.67205 -1.79314 - 5.0000 -0.2500 0.8182 -0.27163 0.84280 -0.05842 0.18574 0.20285 -0.69701 -1.79314 - 5.0000 -0.3000 0.0526 -18.94017 2.91896 -0.13149 -0.17375 2.97666 0.58288 -1.61926 - 5.0000 -0.3000 0.1111 -8.56138 1.67646 -0.18244 0.00734 2.29072 0.66219 -1.61926 - 5.0000 -0.3000 0.1765 -5.15525 1.62649 -0.21362 0.09858 1.89580 0.29238 -1.61926 - 5.0000 -0.3000 0.2500 -3.42359 1.49931 -0.22591 0.21808 1.56249 0.17956 -1.61926 - 5.0000 -0.3000 0.3333 -2.34183 1.38731 -0.21918 0.25512 1.25035 -0.10505 -1.61926 - 5.0000 -0.3000 0.4286 -1.58280 1.27250 -0.19473 0.26696 0.95351 -0.33698 -1.61926 - 5.0000 -0.3000 0.5385 -1.01548 1.13411 -0.15554 0.25456 0.67497 -0.50437 -1.61926 - 5.0000 -0.3000 0.6667 -0.58015 0.96688 -0.10611 0.22024 0.41965 -0.60744 -1.61926 - 5.0000 -0.3000 0.8182 -0.24701 0.76546 -0.05208 0.16561 0.19286 -0.64096 -1.61926 - 5.0000 -0.3500 0.0526 -17.25315 2.64815 -0.11783 -0.15571 2.84352 0.68765 -1.46949 - 5.0000 -0.3500 0.1111 -7.80210 1.52117 -0.16349 0.00657 2.18696 0.73929 -1.46949 - 5.0000 -0.3500 0.1765 -4.70016 1.47791 -0.19143 0.08835 1.80923 0.36482 -1.46949 - 5.0000 -0.3500 0.2500 -3.12278 1.36380 -0.20245 0.19543 1.49074 0.25021 -1.46949 - 5.0000 -0.3500 0.3333 -2.13698 1.26313 -0.19642 0.22863 1.19268 -0.03575 -1.46949 - 5.0000 -0.3500 0.4286 -1.44490 1.15951 -0.17451 0.23924 0.90938 -0.26937 -1.46949 - 5.0000 -0.3500 0.5385 -0.92732 1.03406 -0.13939 0.22812 0.64365 -0.44057 -1.46949 - 5.0000 -0.3500 0.6667 -0.52993 0.88202 -0.09509 0.19737 0.40013 -0.54929 -1.46949 - 5.0000 -0.3500 0.8182 -0.22568 0.69852 -0.04668 0.14841 0.18387 -0.59051 -1.46949 - 5.0000 -0.4000 0.0526 -15.78507 2.41325 -0.10609 -0.14019 2.72327 0.78228 -1.33958 - 5.0000 -0.4000 0.1111 -7.14112 1.38646 -0.14720 0.00592 2.09325 0.80893 -1.33958 - 5.0000 -0.4000 0.1765 -4.30384 1.34888 -0.17235 0.07954 1.73105 0.43025 -1.33958 - 5.0000 -0.4000 0.2500 -2.86073 1.24602 -0.18227 0.17595 1.42593 0.31401 -1.33958 - 5.0000 -0.4000 0.3333 -1.95846 1.15510 -0.17684 0.20584 1.14060 0.02684 -1.33958 - 5.0000 -0.4000 0.4286 -1.32468 1.06115 -0.15711 0.21539 0.86953 -0.20830 -1.33958 - 5.0000 -0.4000 0.5385 -0.85043 0.94693 -0.12550 0.20538 0.61536 -0.38295 -1.33958 - 5.0000 -0.4000 0.6667 -0.48613 0.80808 -0.08561 0.17769 0.38250 -0.49677 -1.33958 - 5.0000 -0.4000 0.8182 -0.20708 0.64017 -0.04202 0.13361 0.17575 -0.54496 -1.33958 - 5.0000 -0.4500 0.0526 -14.49937 2.20820 -0.09591 -0.12675 2.61430 0.86804 -1.22617 - 5.0000 -0.4500 0.1111 -6.56207 1.26884 -0.13308 0.00535 2.00833 0.87203 -1.22617 - 5.0000 -0.4500 0.1765 -3.95651 1.23609 -0.15583 0.07191 1.66020 0.48954 -1.22617 - 5.0000 -0.4500 0.2500 -2.63097 1.14299 -0.16480 0.15908 1.36720 0.37183 -1.22617 - 5.0000 -0.4500 0.3333 -1.80188 1.06054 -0.15988 0.18610 1.09340 0.08355 -1.22617 - 5.0000 -0.4500 0.4286 -1.21921 0.97500 -0.14205 0.19474 0.83341 -0.15296 -1.22617 - 5.0000 -0.4500 0.5385 -0.78297 0.87057 -0.11346 0.18569 0.58972 -0.33073 -1.22617 - 5.0000 -0.4500 0.6667 -0.44768 0.74326 -0.07741 0.16065 0.36652 -0.44918 -1.22617 - 5.0000 -0.4500 0.8182 -0.19074 0.58901 -0.03799 0.12080 0.16839 -0.50367 -1.22617 - 5.0000 -0.5000 0.0526 -13.36686 2.02814 -0.08706 -0.11504 2.51525 0.94599 -1.12657 - 5.0000 -0.5000 0.1111 -6.05183 1.16555 -0.12079 0.00486 1.93113 0.92939 -1.12657 - 5.0000 -0.5000 0.1765 -3.65035 1.13694 -0.14143 0.06527 1.59579 0.54343 -1.12657 - 5.0000 -0.5000 0.2500 -2.42838 1.05233 -0.14957 0.14439 1.31381 0.42439 -1.12657 - 5.0000 -0.5000 0.3333 -1.66377 0.97727 -0.14512 0.16891 1.05049 0.13511 -1.12657 - 5.0000 -0.5000 0.4286 -1.12615 0.89908 -0.12893 0.17675 0.80058 -0.10265 -1.12657 - 5.0000 -0.5000 0.5385 -0.72342 0.80325 -0.10298 0.16854 0.56642 -0.28327 -1.12657 - 5.0000 -0.5000 0.6667 -0.41374 0.68609 -0.07026 0.14582 0.35200 -0.40592 -1.12657 - 5.0000 -0.5000 0.8182 -0.17632 0.54387 -0.03448 0.10965 0.16170 -0.46614 -1.12657 - 5.0000 -0.5500 0.0526 -12.36396 1.86917 -0.07930 -0.10479 2.42493 1.01706 -1.03864 - 5.0000 -0.5500 0.1111 -5.59984 1.07434 -0.11003 0.00442 1.86074 0.98169 -1.03864 - 5.0000 -0.5500 0.1765 -3.37905 1.04931 -0.12883 0.05945 1.53707 0.59257 -1.03864 - 5.0000 -0.5500 0.2500 -2.24879 0.97214 -0.13624 0.13152 1.26514 0.47231 -1.03864 - 5.0000 -0.5500 0.3333 -1.54130 0.90355 -0.13218 0.15386 1.01137 0.18212 -1.03864 - 5.0000 -0.5500 0.4286 -1.04360 0.83185 -0.11744 0.16100 0.77065 -0.05679 -1.03864 - 5.0000 -0.5500 0.5385 -0.67058 0.74359 -0.09381 0.15352 0.54517 -0.23999 -1.03864 - 5.0000 -0.5500 0.6667 -0.38361 0.63541 -0.06400 0.13282 0.33876 -0.36647 -1.03864 - 5.0000 -0.5500 0.8182 -0.16351 0.50385 -0.03141 0.09988 0.15560 -0.43193 -1.03864 - 5.0000 -0.6000 0.0526 -11.47148 1.72814 -0.07247 -0.09577 2.34237 1.08204 -0.96061 - 5.0000 -0.6000 0.1111 -5.19749 0.99342 -0.10055 0.00404 1.79640 1.02951 -0.96061 - 5.0000 -0.6000 0.1765 -3.13746 0.97146 -0.11774 0.05433 1.48339 0.63750 -0.96061 - 5.0000 -0.6000 0.2500 -2.08881 0.90086 -0.12451 0.12020 1.22064 0.51612 -0.96061 - 5.0000 -0.6000 0.3333 -1.43216 0.83798 -0.12080 0.14061 0.97561 0.22510 -0.96061 - 5.0000 -0.6000 0.4286 -0.97001 0.77200 -0.10733 0.14714 0.74328 -0.01486 -0.96061 - 5.0000 -0.6000 0.5385 -0.62347 0.69047 -0.08573 0.14030 0.52574 -0.20043 -0.96061 - 5.0000 -0.6000 0.6667 -0.35675 0.59025 -0.05849 0.12139 0.32665 -0.33041 -0.96061 - 5.0000 -0.6000 0.8182 -0.15209 0.46818 -0.02871 0.09128 0.15003 -0.40064 -0.96061 - 5.0000 -0.6500 0.0526 -10.67369 1.60245 -0.06643 -0.08779 2.26668 1.14160 -0.89105 - 5.0000 -0.6500 0.1111 -4.83771 0.92128 -0.09218 0.00371 1.73741 1.07333 -0.89105 - 5.0000 -0.6500 0.1765 -2.92135 0.90201 -0.10793 0.04981 1.43418 0.67868 -0.89105 - 5.0000 -0.6500 0.2500 -1.94565 0.83720 -0.11414 0.11018 1.17985 0.55628 -0.89105 - 5.0000 -0.6500 0.3333 -1.33448 0.77939 -0.11074 0.12890 0.94283 0.26449 -0.89105 - 5.0000 -0.6500 0.4286 -0.90413 0.71849 -0.09839 0.13488 0.71820 0.02358 -0.89105 - 5.0000 -0.6500 0.5385 -0.58128 0.64294 -0.07859 0.12861 0.50794 -0.16416 -0.89105 - 5.0000 -0.6500 0.6667 -0.33269 0.54985 -0.05361 0.11127 0.31555 -0.29736 -0.89105 - 5.0000 -0.6500 0.8182 -0.14186 0.43625 -0.02632 0.08367 0.14492 -0.37197 -0.89105 - 5.0000 -0.7000 0.0526 -9.95754 1.48994 -0.06107 -0.08071 2.19714 1.19633 -0.82879 - 5.0000 -0.7000 0.1111 -4.51464 0.85671 -0.08474 0.00341 1.68321 1.11361 -0.82879 - 5.0000 -0.7000 0.1765 -2.72724 0.83977 -0.09922 0.04579 1.38896 0.71651 -0.82879 - 5.0000 -0.7000 0.2500 -1.81703 0.78012 -0.10493 0.10129 1.14237 0.59318 -0.82879 - 5.0000 -0.7000 0.3333 -1.24667 0.72681 -0.10181 0.11850 0.91271 0.30069 -0.82879 - 5.0000 -0.7000 0.4286 -0.84489 0.67044 -0.09045 0.12400 0.69515 0.05889 -0.82879 - 5.0000 -0.7000 0.5385 -0.54334 0.60026 -0.07225 0.11824 0.49158 -0.13084 -0.82879 - 5.0000 -0.7000 0.6667 -0.31104 0.51354 -0.04929 0.10230 0.30535 -0.26699 -0.82879 - 5.0000 -0.7000 0.8182 -0.13265 0.40756 -0.02419 0.07692 0.14022 -0.34562 -0.82879 - 5.0000 -0.7500 0.0526 -9.31218 1.38885 -0.05629 -0.07439 2.13309 1.24673 -0.77283 - 5.0000 -0.7500 0.1111 -4.22343 0.79868 -0.07811 0.00314 1.63330 1.15070 -0.77283 - 5.0000 -0.7500 0.1765 -2.55220 0.78379 -0.09146 0.04221 1.34732 0.75136 -0.77283 - 5.0000 -0.7500 0.2500 -1.70100 0.72874 -0.09672 0.09337 1.10785 0.62716 -0.77283 - 5.0000 -0.7500 0.3333 -1.16745 0.67945 -0.09384 0.10923 0.88496 0.33403 -0.77283 - 5.0000 -0.7500 0.4286 -0.79143 0.62713 -0.08337 0.11430 0.67392 0.09142 -0.77283 - 5.0000 -0.7500 0.5385 -0.50909 0.56176 -0.06660 0.10899 0.47651 -0.10015 -0.77283 - 5.0000 -0.7500 0.6667 -0.29149 0.48079 -0.04543 0.09429 0.29596 -0.23901 -0.77283 - 5.0000 -0.7500 0.8182 -0.12434 0.38166 -0.02230 0.07090 0.13590 -0.32136 -0.77283 - 5.0000 -0.8000 0.0526 -8.72851 1.29768 -0.05202 -0.06874 2.07397 1.29326 -0.72235 - 5.0000 -0.8000 0.1111 -3.95997 0.74634 -0.07218 0.00290 1.58722 1.18493 -0.72235 - 5.0000 -0.8000 0.1765 -2.39380 0.73324 -0.08451 0.03900 1.30888 0.78353 -0.72235 - 5.0000 -0.8000 0.2500 -1.59597 0.68231 -0.08938 0.08628 1.07598 0.65853 -0.72235 - 5.0000 -0.8000 0.3333 -1.09571 0.63662 -0.08671 0.10093 0.85936 0.36480 -0.72235 - 5.0000 -0.8000 0.4286 -0.74301 0.58796 -0.07704 0.10562 0.65433 0.12145 -0.72235 - 5.0000 -0.8000 0.5385 -0.47806 0.52692 -0.06154 0.10071 0.46260 -0.07182 -0.72235 - 5.0000 -0.8000 0.6667 -0.27378 0.45114 -0.04198 0.08713 0.28729 -0.21319 -0.72235 - 5.0000 -0.8000 0.8182 -0.11681 0.35822 -0.02061 0.06552 0.13190 -0.29896 -0.72235 - 5.5000 0.0000 0.0526 -37.85723 6.40762 -0.29004 -0.37752 4.21999 -0.37759 -3.28889 - 5.5000 0.0000 0.1111 -16.97710 3.57827 -0.40122 0.02010 3.24971 -0.05433 -3.28889 - 5.5000 0.0000 0.1765 -10.15976 3.37096 -0.46837 0.21921 2.68728 -0.38517 -3.28889 - 5.5000 0.0000 0.2500 -6.70886 3.05463 -0.49386 0.47911 2.21199 -0.48084 -3.28889 - 5.5000 0.0000 0.3333 -4.56486 2.78879 -0.47776 0.55827 1.76748 -0.75029 -3.28889 - 5.5000 0.0000 0.4286 -3.07035 2.53117 -0.42328 0.58234 1.34575 -0.96287 -3.28889 - 5.5000 0.0000 0.5385 -1.96115 2.23688 -0.33720 0.55377 0.95108 -1.09100 -3.28889 - 5.5000 0.0000 0.6667 -1.11594 1.89447 -0.22943 0.47795 0.59031 -1.13846 -3.28889 - 5.5000 0.0000 0.8182 -0.47346 1.49269 -0.11232 0.35866 0.27080 -1.09861 -3.28889 - 5.5000 -0.0500 0.0526 -33.17238 5.58859 -0.24959 -0.32487 3.95049 -0.16538 -2.86802 - 5.5000 -0.0500 0.1111 -14.88406 3.12132 -0.34526 0.01730 3.04032 0.10228 -2.86802 - 5.5000 -0.0500 0.1765 -8.91220 2.94512 -0.40305 0.18864 2.51315 -0.23809 -2.86802 - 5.5000 -0.0500 0.2500 -5.88839 2.67207 -0.42498 0.41229 2.06808 -0.33770 -2.86802 - 5.5000 -0.0500 0.3333 -4.00874 2.44229 -0.41113 0.48041 1.65215 -0.61022 -2.86802 - 5.5000 -0.0500 0.4286 -2.69759 2.21879 -0.36424 0.50112 1.25773 -0.82654 -2.86802 - 5.5000 -0.0500 0.5385 -1.72378 1.96236 -0.29017 0.47654 0.88875 -0.96267 -2.86802 - 5.5000 -0.0500 0.6667 -0.98123 1.66298 -0.19743 0.41129 0.55156 -1.02173 -2.86802 - 5.5000 -0.0500 0.8182 -0.41643 1.31085 -0.09666 0.30864 0.25300 -0.99750 -2.86802 - 5.5000 -0.1000 0.0526 -29.31697 4.91691 -0.21669 -0.28205 3.71335 0.02135 -2.52306 - 5.5000 -0.1000 0.1111 -13.16089 2.74652 -0.29976 0.01502 2.85607 0.24008 -2.52306 - 5.5000 -0.1000 0.1765 -7.88467 2.59544 -0.34992 0.16378 2.35992 -0.10868 -2.52306 - 5.5000 -0.1000 0.2500 -5.21232 2.35765 -0.36897 0.35795 1.94145 -0.21174 -2.52306 - 5.5000 -0.1000 0.3333 -3.55031 2.15726 -0.35694 0.41709 1.55066 -0.48697 -2.52306 - 5.5000 -0.1000 0.4286 -2.39020 1.96165 -0.31624 0.43508 1.18027 -0.70659 -2.52306 - 5.5000 -0.1000 0.5385 -1.52797 1.73624 -0.25192 0.41373 0.83391 -0.84975 -2.52306 - 5.5000 -0.1000 0.6667 -0.87007 1.47222 -0.17141 0.35708 0.51746 -0.91901 -2.52306 - 5.5000 -0.1000 0.8182 -0.36936 1.16096 -0.08392 0.26796 0.23733 -0.90853 -2.52306 - 5.5000 -0.1500 0.0526 -26.10519 4.35925 -0.18961 -0.24680 3.50359 0.18652 -2.23679 - 5.5000 -0.1500 0.1111 -11.72482 2.43531 -0.26229 0.01314 2.69309 0.36198 -2.23679 - 5.5000 -0.1500 0.1765 -7.02797 2.30475 -0.30619 0.14331 2.22439 0.00580 -2.23679 - 5.5000 -0.1500 0.2500 -4.64842 2.09604 -0.32285 0.31321 1.82944 -0.10033 -2.23679 - 5.5000 -0.1500 0.3333 -3.16778 1.91991 -0.31233 0.36496 1.46089 -0.37795 -2.23679 - 5.5000 -0.1500 0.4286 -2.13362 1.74737 -0.27671 0.38070 1.11176 -0.60048 -2.23679 - 5.5000 -0.1500 0.5385 -1.36448 1.54771 -0.22044 0.36202 0.78539 -0.74986 -2.23679 - 5.5000 -0.1500 0.6667 -0.77723 1.31309 -0.14999 0.31245 0.48730 -0.82815 -2.23679 - 5.5000 -0.1500 0.8182 -0.33004 1.03589 -0.07343 0.23447 0.22348 -0.82983 -2.23679 - 5.5000 -0.2000 0.0526 -23.40060 3.89121 -0.16707 -0.21746 3.31715 0.33332 -1.99661 - 5.5000 -0.2000 0.1111 -10.51506 2.17408 -0.23111 0.01158 2.54823 0.47033 -1.99661 - 5.5000 -0.2000 0.1765 -6.30598 2.06048 -0.26979 0.12627 2.10392 0.10755 -1.99661 - 5.5000 -0.2000 0.2500 -4.17300 1.87600 -0.28447 0.27598 1.72988 -0.00130 -1.99661 - 5.5000 -0.2000 0.3333 -2.84514 1.72012 -0.27520 0.32158 1.38110 -0.28105 -1.99661 - 5.5000 -0.2000 0.4286 -1.91712 1.56688 -0.24382 0.33545 1.05087 -0.50617 -1.99661 - 5.5000 -0.2000 0.5385 -1.22648 1.38881 -0.19423 0.31899 0.74227 -0.66108 -1.99661 - 5.5000 -0.2000 0.6667 -0.69885 1.17892 -0.13216 0.27531 0.46049 -0.74739 -1.99661 - 5.5000 -0.2000 0.8182 -0.29683 0.93040 -0.06470 0.20660 0.21116 -0.75988 -1.99661 - 5.5000 -0.2500 0.0526 -21.10118 3.49458 -0.14813 -0.19281 3.15069 0.46439 -1.79314 - 5.5000 -0.2500 0.1111 -9.48614 1.95268 -0.20491 0.01027 2.41889 0.56706 -1.79314 - 5.5000 -0.2500 0.1765 -5.69168 1.85323 -0.23921 0.11196 1.99637 0.19840 -1.79314 - 5.5000 -0.2500 0.2500 -3.76831 1.68915 -0.25222 0.24469 1.64100 0.08711 -1.79314 - 5.5000 -0.2500 0.3333 -2.57040 1.55033 -0.24401 0.28512 1.30986 -0.19453 -1.79314 - 5.5000 -0.2500 0.4286 -1.73271 1.41338 -0.21618 0.29742 0.99650 -0.42197 -1.79314 - 5.5000 -0.2500 0.5385 -1.10890 1.25360 -0.17221 0.28283 0.70377 -0.58181 -1.79314 - 5.5000 -0.2500 0.6667 -0.63204 1.06471 -0.11718 0.24410 0.43656 -0.67529 -1.79314 - 5.5000 -0.2500 0.8182 -0.26853 0.84056 -0.05737 0.18318 0.20017 -0.69743 -1.79314 - 5.5000 -0.3000 0.0526 -19.12939 3.15555 -0.13207 -0.17191 3.00146 0.58189 -1.61926 - 5.5000 -0.3000 0.1111 -8.60350 1.76341 -0.18271 0.00915 2.30295 0.65378 -1.61926 - 5.5000 -0.3000 0.1765 -5.16450 1.67586 -0.21328 0.09982 1.89994 0.27984 -1.61926 - 5.5000 -0.3000 0.2500 -3.42089 1.52912 -0.22489 0.21817 1.56131 0.16637 -1.61926 - 5.5000 -0.3000 0.3333 -2.33445 1.40479 -0.21756 0.25422 1.24600 -0.11697 -1.61926 - 5.5000 -0.3000 0.4286 -1.57428 1.28172 -0.19275 0.26518 0.94776 -0.34648 -1.61926 - 5.5000 -0.3000 0.5385 -1.00785 1.13757 -0.15355 0.25217 0.66926 -0.51075 -1.61926 - 5.5000 -0.3000 0.6667 -0.57462 0.96664 -0.10448 0.21764 0.41510 -0.61065 -1.61926 - 5.5000 -0.3000 0.8182 -0.24419 0.76341 -0.05115 0.16333 0.19031 -0.64144 -1.61926 - 5.5000 -0.3500 0.0526 -17.42544 2.86348 -0.11836 -0.15406 2.86717 0.68764 -1.46949 - 5.5000 -0.3500 0.1111 -7.84048 1.60034 -0.16373 0.00820 2.19860 0.73182 -1.46949 - 5.5000 -0.3500 0.1765 -4.70860 1.52290 -0.19114 0.08946 1.81317 0.35313 -1.46949 - 5.5000 -0.3500 0.2500 -3.12032 1.39098 -0.20154 0.19552 1.48960 0.23770 -1.46949 - 5.5000 -0.3500 0.3333 -2.13024 1.27907 -0.19497 0.22782 1.18852 -0.04717 -1.46949 - 5.5000 -0.3500 0.4286 -1.43711 1.16791 -0.17273 0.23765 0.90389 -0.27855 -1.46949 - 5.5000 -0.3500 0.5385 -0.92035 1.03721 -0.13761 0.22599 0.63820 -0.44680 -1.46949 - 5.5000 -0.3500 0.6667 -0.52488 0.88179 -0.09363 0.19504 0.39579 -0.55248 -1.46949 - 5.5000 -0.3500 0.8182 -0.22310 0.69664 -0.04584 0.14637 0.18144 -0.59106 -1.46949 - 5.5000 -0.4000 0.0526 -15.94264 2.61010 -0.10656 -0.13870 2.74587 0.78315 -1.33958 - 5.5000 -0.4000 0.1111 -7.17626 1.45886 -0.14741 0.00738 2.10436 0.80230 -1.33958 - 5.5000 -0.4000 0.1765 -4.31157 1.39004 -0.17208 0.08054 1.73480 0.41932 -1.33958 - 5.5000 -0.4000 0.2500 -2.85846 1.27090 -0.18145 0.17603 1.42483 0.30213 -1.33958 - 5.5000 -0.4000 0.3333 -1.95227 1.16970 -0.17553 0.20511 1.13662 0.01587 -1.33958 - 5.5000 -0.4000 0.4286 -1.31754 1.06885 -0.15551 0.21396 0.86428 -0.21719 -1.33958 - 5.5000 -0.4000 0.5385 -0.84404 0.94982 -0.12389 0.20346 0.61015 -0.38904 -1.33958 - 5.5000 -0.4000 0.6667 -0.48149 0.80787 -0.08429 0.17560 0.37835 -0.49994 -1.33958 - 5.5000 -0.4000 0.8182 -0.20471 0.63845 -0.04127 0.13178 0.17342 -0.54555 -1.33958 - 5.5000 -0.4500 0.0526 -14.64406 2.38887 -0.09634 -0.12541 2.63596 0.86970 -1.22617 - 5.5000 -0.4500 0.1111 -6.59435 1.33532 -0.13328 0.00668 2.01896 0.86618 -1.22617 - 5.5000 -0.4500 0.1765 -3.96362 1.27391 -0.15558 0.07282 1.66378 0.47931 -1.22617 - 5.5000 -0.4500 0.2500 -2.62889 1.16586 -0.16405 0.15915 1.36613 0.36051 -1.22617 - 5.5000 -0.4500 0.3333 -1.79619 1.07396 -0.15870 0.18544 1.08958 0.07299 -1.22617 - 5.5000 -0.4500 0.4286 -1.21263 0.98208 -0.14060 0.19344 0.82838 -0.16159 -1.22617 - 5.5000 -0.4500 0.5385 -0.77707 0.87322 -0.11201 0.18395 0.58473 -0.33670 -1.22617 - 5.5000 -0.4500 0.6667 -0.44340 0.74306 -0.07621 0.15876 0.36254 -0.45233 -1.22617 - 5.5000 -0.4500 0.8182 -0.18856 0.58742 -0.03731 0.11914 0.16616 -0.50432 -1.22617 - 5.5000 -0.5000 0.0526 -13.50020 2.19457 -0.08745 -0.11382 2.53604 0.94837 -1.12657 - 5.5000 -0.5000 0.1111 -6.08160 1.22681 -0.12097 0.00606 1.94133 0.92424 -1.12657 - 5.5000 -0.5000 0.1765 -3.65692 1.17181 -0.14121 0.06609 1.59922 0.53384 -1.12657 - 5.5000 -0.5000 0.2500 -2.42646 1.07343 -0.14890 0.14445 1.31278 0.41358 -1.12657 - 5.5000 -0.5000 0.3333 -1.65851 0.98965 -0.14404 0.16832 1.04682 0.12492 -1.12657 - 5.5000 -0.5000 0.4286 -1.12007 0.90562 -0.12762 0.17558 0.79574 -0.11105 -1.12657 - 5.5000 -0.5000 0.5385 -0.71797 0.80569 -0.10166 0.16696 0.56162 -0.28912 -1.12657 - 5.5000 -0.5000 0.6667 -0.40978 0.68590 -0.06917 0.14410 0.34818 -0.40905 -1.12657 - 5.5000 -0.5000 0.8182 -0.17430 0.54240 -0.03387 0.10814 0.15956 -0.46683 -1.12657 - 5.5000 -0.5500 0.0526 -12.48725 2.02301 -0.07965 -0.10368 2.44494 1.02010 -1.03864 - 5.5000 -0.5500 0.1111 -5.62739 1.13099 -0.11019 0.00552 1.87055 0.97718 -1.03864 - 5.5000 -0.5500 0.1765 -3.38513 1.08156 -0.12863 0.06020 1.54035 0.58355 -1.03864 - 5.5000 -0.5500 0.2500 -2.24701 0.99167 -0.13563 0.13158 1.26413 0.46196 -1.03864 - 5.5000 -0.5500 0.3333 -1.53643 0.91502 -0.13121 0.15332 1.00783 0.17227 -1.03864 - 5.5000 -0.5500 0.4286 -1.03796 0.83790 -0.11625 0.15993 0.76599 -0.06497 -1.03864 - 5.5000 -0.5500 0.5385 -0.66553 0.74586 -0.09260 0.15208 0.54055 -0.24574 -1.03864 - 5.5000 -0.5500 0.6667 -0.37994 0.63523 -0.06301 0.13126 0.33508 -0.36959 -1.03864 - 5.5000 -0.5500 0.8182 -0.16164 0.50247 -0.03085 0.09850 0.15354 -0.43265 -1.03864 - 5.5000 -0.6000 0.0526 -11.58584 1.87077 -0.07279 -0.09475 2.36166 1.08568 -0.96061 - 5.5000 -0.6000 0.1111 -5.22305 1.04595 -0.10070 0.00504 1.80584 1.02558 -0.96061 - 5.5000 -0.6000 0.1765 -3.14310 1.00140 -0.11755 0.05502 1.48654 0.62901 -0.96061 - 5.5000 -0.6000 0.2500 -2.08715 0.91899 -0.12395 0.12025 1.21966 0.50620 -0.96061 - 5.5000 -0.6000 0.3333 -1.42763 0.84864 -0.11991 0.14012 0.97219 0.21556 -0.96061 - 5.5000 -0.6000 0.4286 -0.96477 0.77762 -0.10624 0.14616 0.73879 -0.02284 -0.96061 - 5.5000 -0.6000 0.5385 -0.61877 0.69257 -0.08463 0.13899 0.52129 -0.20608 -0.96061 - 5.5000 -0.6000 0.6667 -0.35333 0.59009 -0.05758 0.11996 0.32310 -0.33351 -0.96061 - 5.5000 -0.6000 0.8182 -0.15035 0.46690 -0.02819 0.09002 0.14804 -0.40140 -0.96061 - 5.5000 -0.6500 0.0526 -10.78006 1.73506 -0.06673 -0.08686 2.28532 1.14579 -0.89105 - 5.5000 -0.6500 0.1111 -4.86150 0.97015 -0.09231 0.00462 1.74652 1.06994 -0.89105 - 5.5000 -0.6500 0.1765 -2.92661 0.92986 -0.10776 0.05044 1.43721 0.67067 -0.89105 - 5.5000 -0.6500 0.2500 -1.94412 0.85408 -0.11362 0.11023 1.17890 0.54675 -0.89105 - 5.5000 -0.6500 0.3333 -1.33025 0.78931 -0.10992 0.12844 0.93952 0.25524 -0.89105 - 5.5000 -0.6500 0.4286 -0.89924 0.72372 -0.09739 0.13398 0.71385 0.01578 -0.89105 - 5.5000 -0.6500 0.5385 -0.57690 0.64490 -0.07758 0.12741 0.50363 -0.16973 -0.89105 - 5.5000 -0.6500 0.6667 -0.32950 0.54969 -0.05279 0.10996 0.31213 -0.30044 -0.89105 - 5.5000 -0.6500 0.8182 -0.14023 0.43506 -0.02584 0.08252 0.14300 -0.37276 -0.89105 - 5.5000 -0.7000 0.0526 -10.05674 1.61357 -0.06135 -0.07985 2.21517 1.20103 -0.82879 - 5.5000 -0.7000 0.1111 -4.53685 0.90228 -0.08486 0.00425 1.69202 1.11071 -0.82879 - 5.5000 -0.7000 0.1765 -2.73215 0.86576 -0.09907 0.04637 1.39189 0.70895 -0.82879 - 5.5000 -0.7000 0.2500 -1.81559 0.79588 -0.10446 0.10134 1.14144 0.58401 -0.82879 - 5.5000 -0.7000 0.3333 -1.24273 0.73608 -0.10105 0.11808 0.90950 0.29169 -0.82879 - 5.5000 -0.7000 0.4286 -0.84032 0.67533 -0.08953 0.12317 0.69094 0.05126 -0.82879 - 5.5000 -0.7000 0.5385 -0.53924 0.60208 -0.07132 0.11713 0.48741 -0.13633 -0.82879 - 5.5000 -0.7000 0.6667 -0.30806 0.51339 -0.04853 0.10109 0.30204 -0.27006 -0.82879 - 5.5000 -0.7000 0.8182 -0.13113 0.40644 -0.02376 0.07586 0.13836 -0.34645 -0.82879 - 5.5000 -0.7500 0.0526 -9.40493 1.50439 -0.05655 -0.07360 2.15056 1.25190 -0.77283 - 5.5000 -0.7500 0.1111 -4.24420 0.84128 -0.07822 0.00392 1.64182 1.14825 -0.77283 - 5.5000 -0.7500 0.1765 -2.55680 0.80809 -0.09132 0.04274 1.35014 0.74421 -0.77283 - 5.5000 -0.7500 0.2500 -1.69966 0.74348 -0.09628 0.09341 1.10694 0.61832 -0.77283 - 5.5000 -0.7500 0.3333 -1.16375 0.68812 -0.09315 0.10884 0.88185 0.32527 -0.77283 - 5.5000 -0.7500 0.4286 -0.78715 0.63171 -0.08252 0.11354 0.66984 0.08394 -0.77283 - 5.5000 -0.7500 0.5385 -0.50524 0.56347 -0.06574 0.10797 0.47247 -0.10556 -0.77283 - 5.5000 -0.7500 0.6667 -0.28870 0.48064 -0.04473 0.09318 0.29275 -0.24207 -0.77283 - 5.5000 -0.7500 0.8182 -0.12291 0.38061 -0.02190 0.06993 0.13410 -0.32221 -0.77283 - 5.5000 -0.8000 0.0526 -8.81542 1.40591 -0.05225 -0.06801 2.09093 1.29886 -0.72235 - 5.5000 -0.8000 0.1111 -3.97944 0.78626 -0.07228 0.00362 1.59549 1.18291 -0.72235 - 5.5000 -0.8000 0.1765 -2.39812 0.75603 -0.08438 0.03949 1.31161 0.77676 -0.72235 - 5.5000 -0.8000 0.2500 -1.59471 0.69614 -0.08897 0.08632 1.07509 0.65000 -0.72235 - 5.5000 -0.8000 0.3333 -1.09224 0.64476 -0.08607 0.10058 0.85632 0.35627 -0.72235 - 5.5000 -0.8000 0.4286 -0.73898 0.59225 -0.07626 0.10491 0.65036 0.11411 -0.72235 - 5.5000 -0.8000 0.5385 -0.47444 0.52852 -0.06075 0.09977 0.45867 -0.07716 -0.72235 - 5.5000 -0.8000 0.6667 -0.27116 0.45100 -0.04133 0.08611 0.28417 -0.21624 -0.72235 - 5.5000 -0.8000 0.8182 -0.11546 0.35722 -0.02024 0.06462 0.13016 -0.29983 -0.72235 - 6.0000 0.0000 0.0526 -38.19661 6.83806 -0.29118 -0.37391 4.25222 -0.38652 -3.28889 - 6.0000 0.0000 0.1111 -17.05179 3.73503 -0.40172 0.02364 3.26571 -0.06982 -3.28889 - 6.0000 0.0000 0.1765 -10.17594 3.45921 -0.46769 0.22161 2.69279 -0.40368 -3.28889 - 6.0000 0.0000 0.2500 -6.70405 3.10752 -0.49183 0.47925 2.21055 -0.49856 -3.28889 - 6.0000 0.0000 0.3333 -4.55200 2.81961 -0.47458 0.55646 1.76190 -0.76530 -3.28889 - 6.0000 0.0000 0.4286 -3.05561 2.54739 -0.41942 0.57885 1.33832 -0.97418 -3.28889 - 6.0000 0.0000 0.5385 -1.94804 2.24303 -0.33332 0.54911 0.94368 -1.09810 -3.28889 - 6.0000 0.0000 0.6667 -1.10650 1.89421 -0.22626 0.47290 0.58441 -1.14158 -3.28889 - 6.0000 0.0000 0.8182 -0.46866 1.48931 -0.11052 0.35424 0.26749 -1.09858 -3.28889 - 6.0000 -0.0500 0.0526 -33.46961 5.96536 -0.25057 -0.32176 3.98060 -0.17254 -2.86802 - 6.0000 -0.0500 0.1111 -14.94953 3.25861 -0.34569 0.02034 3.05525 0.08852 -2.86802 - 6.0000 -0.0500 0.1765 -8.92639 3.02246 -0.40246 0.19070 2.51827 -0.25504 -2.86802 - 6.0000 -0.0500 0.2500 -5.88416 2.71846 -0.42324 0.41241 2.06672 -0.35416 -2.86802 - 6.0000 -0.0500 0.3333 -3.99743 2.46934 -0.40839 0.47885 1.64692 -0.62432 -2.86802 - 6.0000 -0.0500 0.4286 -2.68464 2.23303 -0.36092 0.49812 1.25078 -0.83727 -2.86802 - 6.0000 -0.0500 0.5385 -1.71225 1.96775 -0.28683 0.47253 0.88184 -0.96949 -2.86802 - 6.0000 -0.0500 0.6667 -0.97291 1.66274 -0.19470 0.40694 0.54604 -1.02480 -2.86802 - 6.0000 -0.0500 0.8182 -0.41220 1.30787 -0.09511 0.30483 0.24990 -0.99757 -2.86802 - 6.0000 -0.1000 0.0526 -29.57953 5.24955 -0.21755 -0.27935 3.74160 0.01575 -2.52306 - 6.0000 -0.1000 0.1111 -13.21878 2.86779 -0.30013 0.01766 2.87005 0.22785 -2.52306 - 6.0000 -0.1000 0.1765 -7.89722 2.66380 -0.34941 0.16557 2.36471 -0.12425 -2.52306 - 6.0000 -0.1000 0.2500 -5.20858 2.39868 -0.36745 0.35805 1.94016 -0.22710 -2.52306 - 6.0000 -0.1000 0.3333 -3.54028 2.18120 -0.35457 0.41574 1.54575 -0.50027 -2.52306 - 6.0000 -0.1000 0.4286 -2.37871 1.97424 -0.31335 0.43246 1.17375 -0.71680 -2.52306 - 6.0000 -0.1000 0.5385 -1.51775 1.74101 -0.24902 0.41025 0.82741 -0.85632 -2.52306 - 6.0000 -0.1000 0.6667 -0.86269 1.47199 -0.16904 0.35331 0.51228 -0.92205 -2.52306 - 6.0000 -0.1000 0.8182 -0.36561 1.15831 -0.08257 0.26466 0.23443 -0.90870 -2.52306 - 6.0000 -0.1500 0.0526 -26.33888 4.65516 -0.19036 -0.24444 3.53018 0.18231 -2.23679 - 6.0000 -0.1500 0.1111 -11.77638 2.54324 -0.26262 0.01545 2.70624 0.35109 -2.23679 - 6.0000 -0.1500 0.1765 -7.03917 2.36563 -0.30575 0.14488 2.22888 -0.00856 -2.23679 - 6.0000 -0.1500 0.2500 -4.64509 2.13260 -0.32153 0.31330 1.82821 -0.11471 -2.23679 - 6.0000 -0.1500 0.3333 -3.15883 1.94125 -0.31025 0.36378 1.45625 -0.39053 -2.23679 - 6.0000 -0.1500 0.4286 -2.12335 1.75860 -0.27419 0.37841 1.10562 -0.61024 -2.23679 - 6.0000 -0.1500 0.5385 -1.35533 1.55195 -0.21790 0.35898 0.77928 -0.75621 -2.23679 - 6.0000 -0.1500 0.6667 -0.77063 1.31288 -0.14791 0.30915 0.48242 -0.83115 -2.23679 - 6.0000 -0.1500 0.8182 -0.32668 1.03351 -0.07225 0.23158 0.22074 -0.83008 -2.23679 - 6.0000 -0.2000 0.0526 -23.60998 4.15621 -0.16773 -0.21538 3.34227 0.33034 -1.99661 - 6.0000 -0.2000 0.1111 -10.56130 2.27078 -0.23140 0.01362 2.56064 0.46063 -1.99661 - 6.0000 -0.2000 0.1765 -6.31603 2.11506 -0.26940 0.12765 2.10815 0.09427 -1.99661 - 6.0000 -0.2000 0.2500 -4.17000 1.90880 -0.28331 0.27606 1.72871 -0.01481 -1.99661 - 6.0000 -0.2000 0.3333 -2.83709 1.73927 -0.27337 0.32054 1.37671 -0.29300 -1.99661 - 6.0000 -0.2000 0.4286 -1.90789 1.57696 -0.24160 0.33343 1.04505 -0.51552 -1.99661 - 6.0000 -0.2000 0.5385 -1.21826 1.39261 -0.19200 0.31630 0.73649 -0.66723 -1.99661 - 6.0000 -0.2000 0.6667 -0.69291 1.17872 -0.13033 0.27240 0.45588 -0.75036 -1.99661 - 6.0000 -0.2000 0.8182 -0.29381 0.92825 -0.06366 0.20405 0.20857 -0.76020 -1.99661 - 6.0000 -0.2500 0.0526 -21.28990 3.73333 -0.14871 -0.19097 3.17451 0.46251 -1.79314 - 6.0000 -0.2500 0.1111 -9.52785 2.03983 -0.20517 0.01207 2.43065 0.55842 -1.79314 - 6.0000 -0.2500 0.1765 -5.70075 1.90246 -0.23886 0.11318 2.00036 0.18608 -1.79314 - 6.0000 -0.2500 0.2500 -3.76561 1.71875 -0.25119 0.24476 1.63987 0.07438 -1.79314 - 6.0000 -0.2500 0.3333 -2.56313 1.56762 -0.24238 0.28420 1.30569 -0.20592 -1.79314 - 6.0000 -0.2500 0.4286 -1.72436 1.42248 -0.21421 0.29563 0.99098 -0.43096 -1.79314 - 6.0000 -0.2500 0.5385 -1.10146 1.25703 -0.17023 0.28045 0.69829 -0.58780 -1.79314 - 6.0000 -0.2500 0.6667 -0.62667 1.06452 -0.11556 0.24152 0.43219 -0.67824 -1.79314 - 6.0000 -0.2500 0.8182 -0.26579 0.83861 -0.05644 0.18092 0.19771 -0.69782 -1.79314 - 6.0000 -0.3000 0.0526 -19.30041 3.37180 -0.13260 -0.17027 3.02411 0.58100 -1.61926 - 6.0000 -0.3000 0.1111 -8.64132 1.84239 -0.18293 0.01076 2.31411 0.64610 -1.61926 - 6.0000 -0.3000 0.1765 -5.17274 1.72050 -0.21297 0.10092 1.90373 0.26838 -1.61926 - 6.0000 -0.3000 0.2500 -3.41843 1.55597 -0.22397 0.21824 1.56023 0.15433 -1.61926 - 6.0000 -0.3000 0.3333 -2.32784 1.42048 -0.21611 0.25340 1.24203 -0.12785 -1.61926 - 6.0000 -0.3000 0.4286 -1.56668 1.28998 -0.19099 0.26359 0.94251 -0.35515 -1.61926 - 6.0000 -0.3000 0.5385 -1.00108 1.14068 -0.15178 0.25005 0.66405 -0.51658 -1.61926 - 6.0000 -0.3000 0.6667 -0.56972 0.96646 -0.10303 0.21534 0.41094 -0.61357 -1.61926 - 6.0000 -0.3000 0.8182 -0.24170 0.76163 -0.05033 0.16131 0.18798 -0.64189 -1.61926 - 6.0000 -0.3500 0.0526 -17.58117 3.06031 -0.11883 -0.15259 2.88875 0.68763 -1.46949 - 6.0000 -0.3500 0.1111 -7.87495 1.67225 -0.16394 0.00965 2.20923 0.72500 -1.46949 - 6.0000 -0.3500 0.1765 -4.71611 1.56356 -0.19086 0.09044 1.81676 0.34245 -1.46949 - 6.0000 -0.3500 0.2500 -3.11807 1.41546 -0.20071 0.19557 1.48855 0.22629 -1.46949 - 6.0000 -0.3500 0.3333 -2.12421 1.29338 -0.19367 0.22708 1.18473 -0.05760 -1.46949 - 6.0000 -0.3500 0.4286 -1.43018 1.17545 -0.17116 0.23622 0.89889 -0.28693 -1.46949 - 6.0000 -0.3500 0.5385 -0.91416 1.04005 -0.13602 0.22409 0.63323 -0.45249 -1.46949 - 6.0000 -0.3500 0.6667 -0.52040 0.88162 -0.09233 0.19298 0.39183 -0.55538 -1.46949 - 6.0000 -0.3500 0.8182 -0.22082 0.69501 -0.04510 0.14456 0.17921 -0.59156 -1.46949 - 6.0000 -0.4000 0.0526 -16.08506 2.79003 -0.10698 -0.13738 2.76651 0.78394 -1.33958 - 6.0000 -0.4000 0.1111 -7.20780 1.52463 -0.14760 0.00869 2.11451 0.79626 -1.33958 - 6.0000 -0.4000 0.1765 -4.31845 1.42725 -0.17183 0.08142 1.73822 0.40935 -1.33958 - 6.0000 -0.4000 0.2500 -2.85641 1.29331 -0.18070 0.17608 1.42382 0.29128 -1.33958 - 6.0000 -0.4000 0.3333 -1.94674 1.18281 -0.17436 0.20445 1.13298 0.00585 -1.33958 - 6.0000 -0.4000 0.4286 -1.31117 1.07576 -0.15410 0.21267 0.85949 -0.22531 -1.33958 - 6.0000 -0.4000 0.5385 -0.83836 0.95241 -0.12246 0.20175 0.60539 -0.39460 -1.33958 - 6.0000 -0.4000 0.6667 -0.47738 0.80771 -0.08313 0.17374 0.37456 -0.50282 -1.33958 - 6.0000 -0.4000 0.8182 -0.20261 0.63695 -0.04061 0.13015 0.17130 -0.54610 -1.33958 - 6.0000 -0.4500 0.0526 -14.77484 2.55401 -0.09673 -0.12421 2.65573 0.87121 -1.22617 - 6.0000 -0.4500 0.1111 -6.62333 1.39570 -0.13344 0.00785 2.02867 0.86084 -1.22617 - 6.0000 -0.4500 0.1765 -3.96995 1.30810 -0.15536 0.07361 1.66704 0.46997 -1.22617 - 6.0000 -0.4500 0.2500 -2.62700 1.18646 -0.16338 0.15920 1.36516 0.35017 -1.22617 - 6.0000 -0.4500 0.3333 -1.79110 1.08601 -0.15765 0.18485 1.08609 0.06335 -1.22617 - 6.0000 -0.4500 0.4286 -1.20677 0.98842 -0.13932 0.19228 0.82378 -0.16947 -1.22617 - 6.0000 -0.4500 0.5385 -0.77184 0.87560 -0.11072 0.18240 0.58017 -0.34215 -1.22617 - 6.0000 -0.4500 0.6667 -0.43962 0.74290 -0.07516 0.15709 0.35891 -0.45520 -1.22617 - 6.0000 -0.4500 0.8182 -0.18663 0.58603 -0.03671 0.11767 0.16413 -0.50490 -1.22617 - 6.0000 -0.5000 0.0526 -13.62072 2.34670 -0.08779 -0.11273 2.55502 0.95055 -1.12657 - 6.0000 -0.5000 0.1111 -6.10833 1.28245 -0.12112 0.00713 1.95064 0.91954 -1.12657 - 6.0000 -0.5000 0.1765 -3.66275 1.20333 -0.14101 0.06682 1.60234 0.52508 -1.12657 - 6.0000 -0.5000 0.2500 -2.42471 1.09243 -0.14829 0.14449 1.31183 0.40371 -1.12657 - 6.0000 -0.5000 0.3333 -1.65381 1.00078 -0.14309 0.16777 1.04346 0.11562 -1.12657 - 6.0000 -0.5000 0.4286 -1.11465 0.91148 -0.12645 0.17452 0.79133 -0.11871 -1.12657 - 6.0000 -0.5000 0.5385 -0.71313 0.80789 -0.10049 0.16556 0.55724 -0.29447 -1.12657 - 6.0000 -0.5000 0.6667 -0.40628 0.68575 -0.06822 0.14258 0.34469 -0.41190 -1.12657 - 6.0000 -0.5000 0.8182 -0.17251 0.54111 -0.03332 0.10680 0.15761 -0.46746 -1.12657 - 6.0000 -0.5500 0.0526 -12.59869 2.16361 -0.07997 -0.10269 2.46321 1.02288 -1.03864 - 6.0000 -0.5500 0.1111 -5.65212 1.18244 -0.11033 0.00649 1.87950 0.97306 -1.03864 - 6.0000 -0.5500 0.1765 -3.39053 1.11072 -0.12844 0.06086 1.54335 0.57532 -1.03864 - 6.0000 -0.5500 0.2500 -2.24539 1.00926 -0.13507 0.13162 1.26322 0.45252 -1.03864 - 6.0000 -0.5500 0.3333 -1.53206 0.92533 -0.13033 0.15282 1.00459 0.16328 -1.03864 - 6.0000 -0.5500 0.4286 -1.03293 0.84332 -0.11518 0.15897 0.76174 -0.07243 -1.03864 - 6.0000 -0.5500 0.5385 -0.66104 0.74789 -0.09154 0.15080 0.53633 -0.25099 -1.03864 - 6.0000 -0.5500 0.6667 -0.37670 0.63509 -0.06214 0.12987 0.33172 -0.37243 -1.03864 - 6.0000 -0.5500 0.8182 -0.15998 0.50128 -0.03035 0.09728 0.15166 -0.43331 -1.03864 - 6.0000 -0.6000 0.0526 -11.68920 2.00113 -0.07308 -0.09385 2.37927 1.08901 -0.96061 - 6.0000 -0.6000 0.1111 -5.24600 1.09367 -0.10083 0.00593 1.81446 1.02200 -0.96061 - 6.0000 -0.6000 0.1765 -3.14812 1.02845 -0.11738 0.05562 1.48942 0.62125 -0.96061 - 6.0000 -0.6000 0.2500 -2.08565 0.93532 -0.12344 0.12028 1.21877 0.49714 -0.96061 - 6.0000 -0.6000 0.3333 -1.42358 0.85820 -0.11911 0.13966 0.96906 0.20685 -0.96061 - 6.0000 -0.6000 0.4286 -0.96010 0.78266 -0.10527 0.14528 0.73468 -0.03012 -0.96061 - 6.0000 -0.6000 0.5385 -0.61460 0.69445 -0.08366 0.13782 0.51722 -0.21124 -0.96061 - 6.0000 -0.6000 0.6667 -0.35031 0.58995 -0.05679 0.11869 0.31987 -0.33634 -0.96061 - 6.0000 -0.6000 0.8182 -0.14881 0.46578 -0.02774 0.08891 0.14623 -0.40210 -0.96061 - 6.0000 -0.6500 0.0526 -10.87620 1.85627 -0.06699 -0.08603 2.30233 1.14962 -0.89105 - 6.0000 -0.6500 0.1111 -4.88286 1.01453 -0.09243 0.00544 1.75484 1.06685 -0.89105 - 6.0000 -0.6500 0.1765 -2.93128 0.95504 -0.10760 0.05099 1.43998 0.66336 -0.89105 - 6.0000 -0.6500 0.2500 -1.94271 0.86928 -0.11316 0.11026 1.17803 0.53805 -0.89105 - 6.0000 -0.6500 0.3333 -1.32647 0.79822 -0.10919 0.12803 0.93649 0.24678 -0.89105 - 6.0000 -0.6500 0.4286 -0.89488 0.72841 -0.09650 0.13318 0.70989 0.00866 -0.89105 - 6.0000 -0.6500 0.5385 -0.57300 0.64666 -0.07669 0.12634 0.49970 -0.17481 -0.89105 - 6.0000 -0.6500 0.6667 -0.32668 0.54956 -0.05206 0.10880 0.30900 -0.30326 -0.89105 - 6.0000 -0.6500 0.8182 -0.13879 0.43401 -0.02543 0.08150 0.14125 -0.37349 -0.89105 - 6.0000 -0.7000 0.0526 -10.14641 1.72658 -0.06159 -0.07909 2.23163 1.20532 -0.82879 - 6.0000 -0.7000 0.1111 -4.55678 0.94367 -0.08497 0.00500 1.70006 1.10806 -0.82879 - 6.0000 -0.7000 0.1765 -2.73651 0.88925 -0.09892 0.04687 1.39456 0.70205 -0.82879 - 6.0000 -0.7000 0.2500 -1.81428 0.81007 -0.10403 0.10137 1.14059 0.57563 -0.82879 - 6.0000 -0.7000 0.3333 -1.23919 0.74439 -0.10038 0.11770 0.90656 0.28348 -0.82879 - 6.0000 -0.7000 0.4286 -0.83625 0.67971 -0.08871 0.12243 0.68710 0.04430 -0.82879 - 6.0000 -0.7000 0.5385 -0.53560 0.60372 -0.07050 0.11614 0.48360 -0.14134 -0.82879 - 6.0000 -0.7000 0.6667 -0.30542 0.51327 -0.04786 0.10002 0.29901 -0.27286 -0.82879 - 6.0000 -0.7000 0.8182 -0.12978 0.40546 -0.02338 0.07493 0.13667 -0.34720 -0.82879 - 6.0000 -0.7500 0.0526 -9.48875 1.61001 -0.05677 -0.07290 2.16652 1.25662 -0.77283 - 6.0000 -0.7500 0.1111 -4.26284 0.87998 -0.07832 0.00461 1.64960 1.14602 -0.77283 - 6.0000 -0.7500 0.1765 -2.56089 0.83007 -0.09118 0.04321 1.35272 0.73768 -0.77283 - 6.0000 -0.7500 0.2500 -1.69843 0.75676 -0.09589 0.09344 1.10611 0.61025 -0.77283 - 6.0000 -0.7500 0.3333 -1.16044 0.69590 -0.09253 0.10849 0.87900 0.31728 -0.77283 - 6.0000 -0.7500 0.4286 -0.78333 0.63581 -0.08177 0.11286 0.66611 0.07712 -0.77283 - 6.0000 -0.7500 0.5385 -0.50183 0.56500 -0.06498 0.10706 0.46878 -0.11050 -0.77283 - 6.0000 -0.7500 0.6667 -0.28622 0.48053 -0.04411 0.09220 0.28982 -0.24487 -0.77283 - 6.0000 -0.7500 0.8182 -0.12165 0.37969 -0.02155 0.06906 0.13245 -0.32298 -0.77283 - 6.0000 -0.8000 0.0526 -8.89397 1.50484 -0.05246 -0.06736 2.10641 1.30397 -0.72235 - 6.0000 -0.8000 0.1111 -3.99692 0.82252 -0.07237 0.00426 1.60303 1.18106 -0.72235 - 6.0000 -0.8000 0.1765 -2.40195 0.77663 -0.08426 0.03992 1.31411 0.77057 -0.72235 - 6.0000 -0.8000 0.2500 -1.59356 0.70859 -0.08861 0.08634 1.07428 0.64220 -0.72235 - 6.0000 -0.8000 0.3333 -1.08913 0.65206 -0.08550 0.10025 0.85356 0.34847 -0.72235 - 6.0000 -0.8000 0.4286 -0.73540 0.59610 -0.07556 0.10428 0.64674 0.10741 -0.72235 - 6.0000 -0.8000 0.5385 -0.47124 0.52996 -0.06005 0.09893 0.45509 -0.08204 -0.72235 - 6.0000 -0.8000 0.6667 -0.26883 0.45089 -0.04076 0.08520 0.28133 -0.21903 -0.72235 - 6.0000 -0.8000 0.8182 -0.11427 0.35636 -0.01991 0.06382 0.12856 -0.30063 -0.72235 - 6.5000 0.0000 0.0526 -38.50596 7.23433 -0.29221 -0.37066 4.28145 -0.39470 -3.28889 - 6.5000 0.0000 0.1111 -17.11947 3.87856 -0.40216 0.02681 3.28008 -0.08395 -3.28889 - 6.5000 0.0000 0.1765 -10.19047 3.53968 -0.46705 0.22374 2.69764 -0.42047 -3.28889 - 6.5000 0.0000 0.2500 -6.69964 3.15560 -0.48999 0.47934 2.20915 -0.51459 -3.28889 - 6.5000 0.0000 0.3333 -4.54037 2.84756 -0.47171 0.55481 1.75680 -0.77883 -3.28889 - 6.5000 0.0000 0.4286 -3.04236 2.56207 -0.41595 0.57569 1.33161 -0.98433 -3.28889 - 6.5000 0.0000 0.5385 -1.93629 2.24862 -0.32984 0.54492 0.93702 -1.10446 -3.28889 - 6.5000 0.0000 0.6667 -1.09804 1.89411 -0.22342 0.46838 0.57911 -1.14457 -3.28889 - 6.5000 0.0000 0.8182 -0.46437 1.48634 -0.10891 0.35028 0.26452 -1.09855 -3.28889 - 6.5000 -0.0500 0.0526 -33.74054 6.31222 -0.25146 -0.31896 4.00791 -0.17910 -2.86802 - 6.5000 -0.0500 0.1111 -15.00886 3.38430 -0.34607 0.02307 3.06866 0.07596 -2.86802 - 6.5000 -0.0500 0.1765 -8.93915 3.09298 -0.40191 0.19254 2.52279 -0.27042 -2.86802 - 6.5000 -0.0500 0.2500 -5.88029 2.76062 -0.42165 0.41248 2.06540 -0.36905 -2.86802 - 6.5000 -0.0500 0.3333 -3.98721 2.49386 -0.40592 0.47743 1.64215 -0.63703 -2.86802 - 6.5000 -0.0500 0.4286 -2.67298 2.24591 -0.35794 0.49539 1.24450 -0.84690 -2.86802 - 6.5000 -0.0500 0.5385 -1.70191 1.97264 -0.28384 0.46892 0.87561 -0.97559 -2.86802 - 6.5000 -0.0500 0.6667 -0.96547 1.66264 -0.19226 0.40306 0.54109 -1.02774 -2.86802 - 6.5000 -0.0500 0.8182 -0.40843 1.30524 -0.09372 0.30143 0.24713 -0.99764 -2.86802 - 6.5000 -0.1000 0.0526 -29.81885 5.55579 -0.21832 -0.27692 3.76721 0.01061 -2.52306 - 6.5000 -0.1000 0.1111 -13.27122 2.97882 -0.30046 0.02003 2.88262 0.21666 -2.52306 - 6.5000 -0.1000 0.1765 -7.90851 2.72613 -0.34894 0.16716 2.36894 -0.13839 -2.52306 - 6.5000 -0.1000 0.2500 -5.20515 2.43597 -0.36608 0.35812 1.93891 -0.24100 -2.52306 - 6.5000 -0.1000 0.3333 -3.53123 2.20290 -0.35242 0.41450 1.54126 -0.51225 -2.52306 - 6.5000 -0.1000 0.4286 -2.36837 1.98565 -0.31076 0.43010 1.16785 -0.72597 -2.52306 - 6.5000 -0.1000 0.5385 -1.50857 1.74533 -0.24643 0.40712 0.82157 -0.86220 -2.52306 - 6.5000 -0.1000 0.6667 -0.85608 1.47189 -0.16692 0.34994 0.50764 -0.92493 -2.52306 - 6.5000 -0.1000 0.8182 -0.36226 1.15597 -0.08137 0.26170 0.23183 -0.90884 -2.52306 - 6.5000 -0.1500 0.0526 -26.55188 4.92758 -0.19103 -0.24231 3.55430 0.17842 -2.23679 - 6.5000 -0.1500 0.1111 -11.82310 2.64205 -0.26290 0.01753 2.71806 0.34112 -2.23679 - 6.5000 -0.1500 0.1765 -7.04923 2.42115 -0.30533 0.14627 2.23284 -0.02160 -2.23679 - 6.5000 -0.1500 0.2500 -4.64203 2.16583 -0.32032 0.31336 1.82702 -0.12772 -2.23679 - 6.5000 -0.1500 0.3333 -3.15074 1.96060 -0.30838 0.36270 1.45202 -0.40187 -2.23679 - 6.5000 -0.1500 0.4286 -2.11411 1.76877 -0.27192 0.37635 1.10006 -0.61900 -2.23679 - 6.5000 -0.1500 0.5385 -1.34713 1.55580 -0.21563 0.35624 0.77377 -0.76190 -2.23679 - 6.5000 -0.1500 0.6667 -0.76472 1.31278 -0.14606 0.30620 0.47805 -0.83399 -2.23679 - 6.5000 -0.1500 0.8182 -0.32369 1.03140 -0.07120 0.22899 0.21829 -0.83030 -2.23679 - 6.5000 -0.2000 0.0526 -23.80083 4.40018 -0.16832 -0.21351 3.36506 0.32757 -1.99661 - 6.5000 -0.2000 0.1111 -10.60319 2.35931 -0.23165 0.01544 2.57179 0.45174 -1.99661 - 6.5000 -0.2000 0.1765 -6.32506 2.16483 -0.26903 0.12888 2.11188 0.08220 -1.99661 - 6.5000 -0.2000 0.2500 -4.16725 1.93861 -0.28225 0.27611 1.72757 -0.02704 -1.99661 - 6.5000 -0.2000 0.3333 -2.82982 1.75664 -0.27172 0.31958 1.37270 -0.30377 -1.99661 - 6.5000 -0.2000 0.4286 -1.89959 1.58608 -0.23960 0.33161 1.03980 -0.52393 -1.99661 - 6.5000 -0.2000 0.5385 -1.21088 1.39607 -0.19000 0.31389 0.73128 -0.67275 -1.99661 - 6.5000 -0.2000 0.6667 -0.68759 1.17862 -0.12870 0.26980 0.45175 -0.75317 -1.99661 - 6.5000 -0.2000 0.8182 -0.29111 0.92635 -0.06274 0.20177 0.20626 -0.76049 -1.99661 - 6.5000 -0.2500 0.0526 -21.46193 3.95313 -0.14924 -0.18930 3.19611 0.46074 -1.79314 - 6.5000 -0.2500 0.1111 -9.56563 2.11963 -0.20539 0.01369 2.44120 0.55050 -1.79314 - 6.5000 -0.2500 0.1765 -5.70890 1.94734 -0.23854 0.11427 2.00388 0.17488 -1.79314 - 6.5000 -0.2500 0.2500 -3.76312 1.74566 -0.25025 0.24481 1.63878 0.06285 -1.79314 - 6.5000 -0.2500 0.3333 -2.55656 1.58330 -0.24091 0.28335 1.30189 -0.21619 -1.79314 - 6.5000 -0.2500 0.4286 -1.71685 1.43072 -0.21244 0.29402 0.98600 -0.43904 -1.79314 - 6.5000 -0.2500 0.5385 -1.09478 1.26015 -0.16846 0.27830 0.69335 -0.59316 -1.79314 - 6.5000 -0.2500 0.6667 -0.62185 1.06442 -0.11411 0.23922 0.42827 -0.68100 -1.79314 - 6.5000 -0.2500 0.8182 -0.26335 0.83689 -0.05562 0.17890 0.19552 -0.69816 -1.79314 - 6.5000 -0.3000 0.0526 -19.45629 3.57088 -0.13307 -0.16879 3.04464 0.58012 -1.61926 - 6.5000 -0.3000 0.1111 -8.67559 1.91469 -0.18313 0.01221 2.32413 0.63905 -1.61926 - 6.5000 -0.3000 0.1765 -5.18013 1.76120 -0.21268 0.10189 1.90706 0.25797 -1.61926 - 6.5000 -0.3000 0.2500 -3.41617 1.58038 -0.22313 0.21828 1.55918 0.14343 -1.61926 - 6.5000 -0.3000 0.3333 -2.32187 1.43471 -0.21480 0.25264 1.23840 -0.13767 -1.61926 - 6.5000 -0.3000 0.4286 -1.55985 1.29746 -0.18941 0.26215 0.93776 -0.36294 -1.61926 - 6.5000 -0.3000 0.5385 -0.99501 1.14350 -0.15020 0.24814 0.65935 -0.52180 -1.61926 - 6.5000 -0.3000 0.6667 -0.56535 0.96637 -0.10174 0.21329 0.40722 -0.61631 -1.61926 - 6.5000 -0.3000 0.8182 -0.23948 0.76006 -0.04960 0.15951 0.18589 -0.64228 -1.61926 - 6.5000 -0.3500 0.0526 -17.72311 3.24151 -0.11925 -0.15126 2.90833 0.68756 -1.46949 - 6.5000 -0.3500 0.1111 -7.90617 1.73809 -0.16411 0.01094 2.21878 0.71873 -1.46949 - 6.5000 -0.3500 0.1765 -4.72285 1.60064 -0.19060 0.09131 1.81993 0.33274 -1.46949 - 6.5000 -0.3500 0.2500 -3.11601 1.43770 -0.19996 0.19561 1.48755 0.21595 -1.46949 - 6.5000 -0.3500 0.3333 -2.11875 1.30635 -0.19250 0.22641 1.18127 -0.06700 -1.46949 - 6.5000 -0.3500 0.4286 -1.42394 1.18227 -0.16974 0.23493 0.89436 -0.29446 -1.46949 - 6.5000 -0.3500 0.5385 -0.90861 1.04262 -0.13460 0.22238 0.62875 -0.45759 -1.46949 - 6.5000 -0.3500 0.6667 -0.51640 0.88153 -0.09118 0.19114 0.38827 -0.55809 -1.46949 - 6.5000 -0.3500 0.8182 -0.21879 0.69357 -0.04445 0.14295 0.17723 -0.59200 -1.46949 - 6.5000 -0.4000 0.0526 -16.21488 2.95568 -0.10736 -0.13618 2.78522 0.78459 -1.33958 - 6.5000 -0.4000 0.1111 -7.23637 1.58484 -0.14775 0.00985 2.12362 0.79070 -1.33958 - 6.5000 -0.4000 0.1765 -4.32463 1.46118 -0.17160 0.08220 1.74123 0.40027 -1.33958 - 6.5000 -0.4000 0.2500 -2.85452 1.31368 -0.18002 0.17611 1.42285 0.28145 -1.33958 - 6.5000 -0.4000 0.3333 -1.94174 1.19469 -0.17331 0.20384 1.12967 -0.00318 -1.33958 - 6.5000 -0.4000 0.4286 -1.30545 1.08200 -0.15282 0.21151 0.85515 -0.23260 -1.33958 - 6.5000 -0.4000 0.5385 -0.83326 0.95477 -0.12118 0.20021 0.60111 -0.39959 -1.33958 - 6.5000 -0.4000 0.6667 -0.47371 0.80762 -0.08209 0.17209 0.37116 -0.50551 -1.33958 - 6.5000 -0.4000 0.8182 -0.20075 0.63562 -0.04001 0.12870 0.16940 -0.54658 -1.33958 - 6.5000 -0.4500 0.0526 -14.89403 2.70605 -0.09707 -0.12312 2.67366 0.87252 -1.22617 - 6.5000 -0.4500 0.1111 -6.64959 1.45099 -0.13359 0.00891 2.03739 0.85591 -1.22617 - 6.5000 -0.4500 0.1765 -3.97563 1.33927 -0.15515 0.07432 1.66992 0.46147 -1.22617 - 6.5000 -0.4500 0.2500 -2.62527 1.20518 -0.16276 0.15923 1.36422 0.34081 -1.22617 - 6.5000 -0.4500 0.3333 -1.78650 1.09694 -0.15669 0.18430 1.08290 0.05465 -1.22617 - 6.5000 -0.4500 0.4286 -1.20150 0.99417 -0.13817 0.19123 0.81963 -0.17655 -1.22617 - 6.5000 -0.4500 0.5385 -0.76715 0.87776 -0.10957 0.18101 0.57606 -0.34703 -1.22617 - 6.5000 -0.4500 0.6667 -0.43623 0.74282 -0.07422 0.15559 0.35566 -0.45785 -1.22617 - 6.5000 -0.4500 0.8182 -0.18491 0.58480 -0.03618 0.11636 0.16231 -0.50542 -1.22617 - 6.5000 -0.5000 0.0526 -13.73057 2.48675 -0.08810 -0.11175 2.57224 0.95246 -1.12657 - 6.5000 -0.5000 0.1111 -6.13254 1.33340 -0.12125 0.00808 1.95900 0.91520 -1.12657 - 6.5000 -0.5000 0.1765 -3.66800 1.23207 -0.14082 0.06746 1.60509 0.51710 -1.12657 - 6.5000 -0.5000 0.2500 -2.42311 1.10970 -0.14773 0.14452 1.31092 0.39477 -1.12657 - 6.5000 -0.5000 0.3333 -1.64956 1.01086 -0.14222 0.16727 1.04040 0.10723 -1.12657 - 6.5000 -0.5000 0.4286 -1.10978 0.91678 -0.12541 0.17357 0.78733 -0.12560 -1.12657 - 6.5000 -0.5000 0.5385 -0.70879 0.80989 -0.09945 0.16429 0.55329 -0.29925 -1.12657 - 6.5000 -0.5000 0.6667 -0.40315 0.68567 -0.06736 0.14122 0.34156 -0.41454 -1.12657 - 6.5000 -0.5000 0.8182 -0.17092 0.53997 -0.03284 0.10561 0.15586 -0.46801 -1.12657 - 6.5000 -0.5500 0.0526 -12.70026 2.29306 -0.08025 -0.10179 2.47977 1.02533 -1.03864 - 6.5000 -0.5500 0.1111 -5.67452 1.22955 -0.11044 0.00736 1.88754 0.96925 -1.03864 - 6.5000 -0.5500 0.1765 -3.39539 1.13731 -0.12827 0.06145 1.54599 0.56782 -1.03864 - 6.5000 -0.5500 0.2500 -2.24391 1.02524 -0.13457 0.13164 1.26233 0.44396 -1.03864 - 6.5000 -0.5500 0.3333 -1.52812 0.93466 -0.12955 0.15237 1.00164 0.15516 -1.03864 - 6.5000 -0.5500 0.4286 -1.02841 0.84823 -0.11423 0.15810 0.75789 -0.07914 -1.03864 - 6.5000 -0.5500 0.5385 -0.65701 0.74974 -0.09058 0.14965 0.53253 -0.25570 -1.03864 - 6.5000 -0.5500 0.6667 -0.37379 0.63501 -0.06136 0.12863 0.32871 -0.37505 -1.03864 - 6.5000 -0.5500 0.8182 -0.15850 0.50022 -0.02991 0.09620 0.14998 -0.43390 -1.03864 - 6.5000 -0.6000 0.0526 -11.78341 2.12115 -0.07334 -0.09303 2.39524 1.09196 -0.96061 - 6.5000 -0.6000 0.1111 -5.26679 1.13736 -0.10093 0.00673 1.82220 1.01866 -0.96061 - 6.5000 -0.6000 0.1765 -3.15263 1.05312 -0.11722 0.05616 1.49195 0.61419 -0.96061 - 6.5000 -0.6000 0.2500 -2.08427 0.95016 -0.12298 0.12031 1.21791 0.48893 -0.96061 - 6.5000 -0.6000 0.3333 -1.41991 0.86687 -0.11839 0.13925 0.96621 0.19899 -0.96061 - 6.5000 -0.6000 0.4286 -0.95589 0.78722 -0.10440 0.14449 0.73097 -0.03667 -0.96061 - 6.5000 -0.6000 0.5385 -0.61085 0.69617 -0.08278 0.13677 0.51356 -0.21587 -0.96061 - 6.5000 -0.6000 0.6667 -0.34761 0.58987 -0.05608 0.11756 0.31696 -0.33894 -0.96061 - 6.5000 -0.6000 0.8182 -0.14743 0.46479 -0.02734 0.08792 0.14461 -0.40271 -0.96061 - 6.5000 -0.6500 0.0526 -10.96383 1.96787 -0.06723 -0.08528 2.31775 1.15303 -0.89105 - 6.5000 -0.6500 0.1111 -4.90221 1.05517 -0.09253 0.00617 1.76231 1.06396 -0.89105 - 6.5000 -0.6500 0.1765 -2.93548 0.97800 -0.10746 0.05148 1.44242 0.65669 -0.89105 - 6.5000 -0.6500 0.2500 -1.94143 0.88310 -0.11274 0.11028 1.17719 0.53016 -0.89105 - 6.5000 -0.6500 0.3333 -1.32306 0.80629 -0.10853 0.12765 0.93373 0.23915 -0.89105 - 6.5000 -0.6500 0.4286 -0.89096 0.73266 -0.09570 0.13245 0.70630 0.00226 -0.89105 - 6.5000 -0.6500 0.5385 -0.56951 0.64825 -0.07589 0.12537 0.49616 -0.17937 -0.89105 - 6.5000 -0.6500 0.6667 -0.32415 0.54949 -0.05140 0.10776 0.30619 -0.30584 -0.89105 - 6.5000 -0.6500 0.8182 -0.13751 0.43309 -0.02506 0.08059 0.13968 -0.37413 -0.89105 - 6.5000 -0.7000 0.0526 -10.22813 1.83062 -0.06181 -0.07840 2.24655 1.20915 -0.82879 - 6.5000 -0.7000 0.1111 -4.57484 0.98157 -0.08506 0.00567 1.70727 1.10558 -0.82879 - 6.5000 -0.7000 0.1765 -2.74043 0.91067 -0.09879 0.04732 1.39691 0.69575 -0.82879 - 6.5000 -0.7000 0.2500 -1.81308 0.82296 -0.10364 0.10139 1.13977 0.56804 -0.82879 - 6.5000 -0.7000 0.3333 -1.23600 0.75193 -0.09977 0.11735 0.90389 0.27606 -0.82879 - 6.5000 -0.7000 0.4286 -0.83258 0.68368 -0.08798 0.12177 0.68362 0.03803 -0.82879 - 6.5000 -0.7000 0.5385 -0.53233 0.60521 -0.06977 0.11526 0.48017 -0.14583 -0.82879 - 6.5000 -0.7000 0.6667 -0.30306 0.51319 -0.04726 0.09907 0.29630 -0.27543 -0.82879 - 6.5000 -0.7000 0.8182 -0.12858 0.40459 -0.02304 0.07409 0.13515 -0.34786 -0.82879 - 6.5000 -0.7500 0.0526 -9.56516 1.70724 -0.05697 -0.07226 2.18098 1.26084 -0.77283 - 6.5000 -0.7500 0.1111 -4.27973 0.91541 -0.07841 0.00523 1.65659 1.14391 -0.77283 - 6.5000 -0.7500 0.1765 -2.56456 0.85010 -0.09106 0.04362 1.35500 0.73172 -0.77283 - 6.5000 -0.7500 0.2500 -1.69731 0.76882 -0.09553 0.09345 1.10531 0.60293 -0.77283 - 6.5000 -0.7500 0.3333 -1.15745 0.70296 -0.09197 0.10817 0.87640 0.31006 -0.77283 - 6.5000 -0.7500 0.4286 -0.77989 0.63953 -0.08110 0.11224 0.66274 0.07097 -0.77283 - 6.5000 -0.7500 0.5385 -0.49877 0.56639 -0.06431 0.10624 0.46545 -0.11493 -0.77283 - 6.5000 -0.7500 0.6667 -0.28401 0.48046 -0.04356 0.09132 0.28718 -0.24742 -0.77283 - 6.5000 -0.7500 0.8182 -0.12052 0.37888 -0.02123 0.06829 0.13098 -0.32367 -0.77283 - 6.5000 -0.8000 0.0526 -8.96557 1.59592 -0.05264 -0.06678 2.12045 1.30855 -0.72235 - 6.5000 -0.8000 0.1111 -4.01276 0.85572 -0.07245 0.00483 1.60981 1.17930 -0.72235 - 6.5000 -0.8000 0.1765 -2.40539 0.79541 -0.08414 0.04031 1.31630 0.76492 -0.72235 - 6.5000 -0.8000 0.2500 -1.59250 0.71990 -0.08828 0.08636 1.07350 0.63513 -0.72235 - 6.5000 -0.8000 0.3333 -1.08632 0.65868 -0.08498 0.09995 0.85103 0.34144 -0.72235 - 6.5000 -0.8000 0.4286 -0.73217 0.59959 -0.07494 0.10371 0.64347 0.10139 -0.72235 - 6.5000 -0.8000 0.5385 -0.46836 0.53126 -0.05942 0.09817 0.45186 -0.08642 -0.72235 - 6.5000 -0.8000 0.6667 -0.26675 0.45082 -0.04025 0.08438 0.27877 -0.22157 -0.72235 - 6.5000 -0.8000 0.8182 -0.11322 0.35559 -0.01962 0.06311 0.12714 -0.30134 -0.72235 - 7.0000 0.0000 0.0526 -38.78996 7.60138 -0.29314 -0.36769 4.30691 -0.40213 -3.28889 - 7.0000 0.0000 0.1111 -17.18127 4.01086 -0.40254 0.02968 3.29207 -0.09660 -3.28889 - 7.0000 0.0000 0.1765 -10.20365 3.61357 -0.46646 0.22565 2.70133 -0.43513 -3.28889 - 7.0000 0.0000 0.2500 -6.69557 3.19963 -0.48830 0.47939 2.20758 -0.52834 -3.28889 - 7.0000 0.0000 0.3333 -4.52978 2.87310 -0.46910 0.55328 1.75223 -0.79024 -3.28889 - 7.0000 0.0000 0.4286 -3.03033 2.57547 -0.41280 0.57280 1.32582 -0.99278 -3.28889 - 7.0000 0.0000 0.5385 -1.92565 2.25373 -0.32670 0.54112 0.93140 -1.10965 -3.28889 - 7.0000 0.0000 0.6667 -1.09041 1.89399 -0.22087 0.46429 0.57472 -1.14679 -3.28889 - 7.0000 0.0000 0.8182 -0.46052 1.48369 -0.10747 0.34672 0.26210 -1.09848 -3.28889 - 7.0000 -0.0500 0.0526 -33.98926 6.63352 -0.25226 -0.31641 4.03169 -0.18512 -2.86802 - 7.0000 -0.0500 0.1111 -15.06303 3.50017 -0.34639 0.02554 3.07984 0.06467 -2.86802 - 7.0000 -0.0500 0.1765 -8.95071 3.15774 -0.40140 0.19418 2.52622 -0.28387 -2.86802 - 7.0000 -0.0500 0.2500 -5.87672 2.79923 -0.42020 0.41253 2.06392 -0.38184 -2.86802 - 7.0000 -0.0500 0.3333 -3.97790 2.51627 -0.40367 0.47612 1.63787 -0.64775 -2.86802 - 7.0000 -0.0500 0.4286 -2.66240 2.25767 -0.35523 0.49291 1.23909 -0.85492 -2.86802 - 7.0000 -0.0500 0.5385 -1.69255 1.97712 -0.28114 0.46565 0.87036 -0.98059 -2.86802 - 7.0000 -0.0500 0.6667 -0.95875 1.66252 -0.19007 0.39954 0.53699 -1.02993 -2.86802 - 7.0000 -0.0500 0.8182 -0.40503 1.30290 -0.09248 0.29836 0.24487 -0.99765 -2.86802 - 7.0000 -0.1000 0.0526 -30.03856 5.83945 -0.21901 -0.27471 3.78952 0.00584 -2.52306 - 7.0000 -0.1000 0.1111 -13.31911 3.08116 -0.30074 0.02217 2.89309 0.20657 -2.52306 - 7.0000 -0.1000 0.1765 -7.91874 2.78338 -0.34849 0.16859 2.37214 -0.15077 -2.52306 - 7.0000 -0.1000 0.2500 -5.20199 2.47012 -0.36482 0.35816 1.93751 -0.25294 -2.52306 - 7.0000 -0.1000 0.3333 -3.52297 2.22272 -0.35047 0.41336 1.53724 -0.52237 -2.52306 - 7.0000 -0.1000 0.4286 -2.35899 1.99606 -0.30841 0.42795 1.16277 -0.73361 -2.52306 - 7.0000 -0.1000 0.5385 -1.50027 1.74929 -0.24408 0.40427 0.81664 -0.86702 -2.52306 - 7.0000 -0.1000 0.6667 -0.85012 1.47177 -0.16502 0.34688 0.50379 -0.92711 -2.52306 - 7.0000 -0.1000 0.8182 -0.35924 1.15388 -0.08029 0.25904 0.22971 -0.90893 -2.52306 - 7.0000 -0.1500 0.0526 -26.74742 5.17992 -0.19164 -0.24037 3.57530 0.17476 -2.23679 - 7.0000 -0.1500 0.1111 -11.86576 2.73314 -0.26315 0.01940 2.72790 0.33210 -2.23679 - 7.0000 -0.1500 0.1765 -7.05835 2.47212 -0.30494 0.14752 2.23584 -0.03303 -2.23679 - 7.0000 -0.1500 0.2500 -4.63920 2.19626 -0.31922 0.31339 1.82569 -0.13892 -2.23679 - 7.0000 -0.1500 0.3333 -3.14337 1.97827 -0.30667 0.36170 1.44823 -0.41147 -2.23679 - 7.0000 -0.1500 0.4286 -2.10573 1.77805 -0.26986 0.37446 1.09527 -0.62631 -2.23679 - 7.0000 -0.1500 0.5385 -1.33971 1.55933 -0.21358 0.35375 0.76913 -0.76657 -2.23679 - 7.0000 -0.1500 0.6667 -0.75939 1.31267 -0.14439 0.30353 0.47442 -0.83615 -2.23679 - 7.0000 -0.1500 0.8182 -0.32099 1.02953 -0.07026 0.22666 0.21630 -0.83044 -2.23679 - 7.0000 -0.2000 0.0526 -23.97604 4.62617 -0.16886 -0.21180 3.38490 0.32489 -1.99661 - 7.0000 -0.2000 0.1111 -10.64144 2.44092 -0.23187 0.01710 2.58108 0.44367 -1.99661 - 7.0000 -0.2000 0.1765 -6.33324 2.21053 -0.26869 0.12998 2.11470 0.07161 -1.99661 - 7.0000 -0.2000 0.2500 -4.16471 1.96591 -0.28127 0.27614 1.72630 -0.03757 -1.99661 - 7.0000 -0.2000 0.3333 -2.82320 1.77250 -0.27021 0.31871 1.36911 -0.31289 -1.99661 - 7.0000 -0.2000 0.4286 -1.89205 1.59441 -0.23779 0.32995 1.03527 -0.53093 -1.99661 - 7.0000 -0.2000 0.5385 -1.20420 1.39923 -0.18819 0.31170 0.72690 -0.67728 -1.99661 - 7.0000 -0.2000 0.6667 -0.68279 1.17851 -0.12723 0.26745 0.44832 -0.75530 -1.99661 - 7.0000 -0.2000 0.8182 -0.28869 0.92465 -0.06190 0.19972 0.20438 -0.76069 -1.99661 - 7.0000 -0.2500 0.0526 -21.61985 4.15672 -0.14972 -0.18779 3.21491 0.45893 -1.79314 - 7.0000 -0.2500 0.1111 -9.60014 2.19319 -0.20559 0.01516 2.45000 0.54327 -1.79314 - 7.0000 -0.2500 0.1765 -5.71629 1.98856 -0.23823 0.11525 2.00655 0.16504 -1.79314 - 7.0000 -0.2500 0.2500 -3.76083 1.77029 -0.24939 0.24484 1.63757 0.05291 -1.79314 - 7.0000 -0.2500 0.3333 -2.55057 1.59762 -0.23958 0.28257 1.29848 -0.22488 -1.79314 - 7.0000 -0.2500 0.4286 -1.71003 1.43824 -0.21083 0.29254 0.98170 -0.44578 -1.79314 - 7.0000 -0.2500 0.5385 -1.08874 1.26300 -0.16685 0.27636 0.68919 -0.59756 -1.79314 - 7.0000 -0.2500 0.6667 -0.61751 1.06431 -0.11281 0.23713 0.42502 -0.68313 -1.79314 - 7.0000 -0.2500 0.8182 -0.26115 0.83535 -0.05489 0.17708 0.19373 -0.69841 -1.79314 - 7.0000 -0.3000 0.0526 -19.59940 3.75529 -0.13349 -0.16744 3.06251 0.57909 -1.61926 - 7.0000 -0.3000 0.1111 -8.70688 1.98135 -0.18330 0.01352 2.33248 0.63257 -1.61926 - 7.0000 -0.3000 0.1765 -5.18684 1.79857 -0.21241 0.10276 1.90958 0.24880 -1.61926 - 7.0000 -0.3000 0.2500 -3.41409 1.60272 -0.22236 0.21830 1.55802 0.13402 -1.61926 - 7.0000 -0.3000 0.3333 -2.31643 1.44771 -0.21361 0.25195 1.23515 -0.14598 -1.61926 - 7.0000 -0.3000 0.4286 -1.55365 1.30429 -0.18798 0.26084 0.93367 -0.36945 -1.61926 - 7.0000 -0.3000 0.5385 -0.98951 1.14609 -0.14877 0.24641 0.65539 -0.52610 -1.61926 - 7.0000 -0.3000 0.6667 -0.56139 0.96626 -0.10058 0.21143 0.40413 -0.61842 -1.61926 - 7.0000 -0.3000 0.8182 -0.23747 0.75866 -0.04894 0.15789 0.18419 -0.64258 -1.61926 - 7.0000 -0.3500 0.0526 -17.85342 3.40935 -0.11963 -0.15005 2.92537 0.68724 -1.46949 - 7.0000 -0.3500 0.1111 -7.93468 1.79878 -0.16427 0.01211 2.22672 0.71294 -1.46949 - 7.0000 -0.3500 0.1765 -4.72897 1.63469 -0.19035 0.09209 1.82233 0.32417 -1.46949 - 7.0000 -0.3500 0.2500 -3.11411 1.45807 -0.19927 0.19563 1.48643 0.20702 -1.46949 - 7.0000 -0.3500 0.3333 -2.11378 1.31821 -0.19143 0.22579 1.17816 -0.07498 -1.46949 - 7.0000 -0.3500 0.4286 -1.41827 1.18850 -0.16846 0.23375 0.89045 -0.30075 -1.46949 - 7.0000 -0.3500 0.5385 -0.90358 1.04498 -0.13332 0.22082 0.62497 -0.46178 -1.46949 - 7.0000 -0.3500 0.6667 -0.51278 0.88143 -0.09014 0.18947 0.38533 -0.56019 -1.46949 - 7.0000 -0.3500 0.8182 -0.21696 0.69228 -0.04386 0.14149 0.17561 -0.59233 -1.46949 - 7.0000 -0.4000 0.0526 -16.33405 3.10911 -0.10770 -0.13509 2.80150 0.78491 -1.33958 - 7.0000 -0.4000 0.1111 -7.26246 1.64034 -0.14789 0.01090 2.13121 0.78552 -1.33958 - 7.0000 -0.4000 0.1765 -4.33023 1.49233 -0.17138 0.08291 1.74351 0.39225 -1.33958 - 7.0000 -0.4000 0.2500 -2.85278 1.33233 -0.17940 0.17613 1.42178 0.27295 -1.33958 - 7.0000 -0.4000 0.3333 -1.93718 1.20555 -0.17235 0.20328 1.12669 -0.01085 -1.33958 - 7.0000 -0.4000 0.4286 -1.30025 1.08770 -0.15167 0.21045 0.85142 -0.23870 -1.33958 - 7.0000 -0.4000 0.5385 -0.82865 0.95692 -0.12003 0.19881 0.59750 -0.40369 -1.33958 - 7.0000 -0.4000 0.6667 -0.47039 0.80753 -0.08115 0.17058 0.36835 -0.50759 -1.33958 - 7.0000 -0.4000 0.8182 -0.19907 0.63443 -0.03948 0.12739 0.16785 -0.54695 -1.33958 - 7.0000 -0.4500 0.0526 -15.00346 2.84688 -0.09738 -0.12214 2.68925 0.87342 -1.22617 - 7.0000 -0.4500 0.1111 -6.67356 1.50195 -0.13371 0.00986 2.04465 0.85129 -1.22617 - 7.0000 -0.4500 0.1765 -3.98078 1.36789 -0.15495 0.07496 1.67210 0.45394 -1.22617 - 7.0000 -0.4500 0.2500 -2.62366 1.22232 -0.16220 0.15924 1.36319 0.33270 -1.22617 - 7.0000 -0.4500 0.3333 -1.78230 1.10692 -0.15582 0.18379 1.08005 0.04726 -1.22617 - 7.0000 -0.4500 0.4286 -1.19671 0.99941 -0.13712 0.19027 0.81605 -0.18248 -1.22617 - 7.0000 -0.4500 0.5385 -0.76290 0.87974 -0.10852 0.17975 0.57260 -0.35105 -1.22617 - 7.0000 -0.4500 0.6667 -0.43317 0.74273 -0.07337 0.15423 0.35296 -0.45993 -1.22617 - 7.0000 -0.4500 0.8182 -0.18336 0.58370 -0.03570 0.11517 0.16082 -0.50583 -1.22617 - 7.0000 -0.5000 0.0526 -13.83141 2.61648 -0.08838 -0.11086 2.58721 0.95388 -1.12657 - 7.0000 -0.5000 0.1111 -6.15465 1.38036 -0.12136 0.00895 1.96596 0.91109 -1.12657 - 7.0000 -0.5000 0.1765 -3.67275 1.25846 -0.14064 0.06803 1.60717 0.51002 -1.12657 - 7.0000 -0.5000 0.2500 -2.42163 1.12552 -0.14722 0.14453 1.30992 0.38701 -1.12657 - 7.0000 -0.5000 0.3333 -1.64568 1.02007 -0.14143 0.16681 1.03765 0.10009 -1.12657 - 7.0000 -0.5000 0.4286 -1.10535 0.92162 -0.12446 0.17270 0.78389 -0.13137 -1.12657 - 7.0000 -0.5000 0.5385 -0.70486 0.81171 -0.09850 0.16315 0.54997 -0.30320 -1.12657 - 7.0000 -0.5000 0.6667 -0.40032 0.68558 -0.06659 0.13998 0.33897 -0.41661 -1.12657 - 7.0000 -0.5000 0.8182 -0.16949 0.53895 -0.03240 0.10453 0.15443 -0.46844 -1.12657 - 7.0000 -0.5500 0.0526 -12.79351 2.41297 -0.08051 -0.10098 2.49418 1.02723 -1.03864 - 7.0000 -0.5500 0.1111 -5.69497 1.27297 -0.11055 0.00815 1.89423 0.96560 -1.03864 - 7.0000 -0.5500 0.1765 -3.39978 1.16172 -0.12810 0.06197 1.54798 0.56115 -1.03864 - 7.0000 -0.5500 0.2500 -2.24253 1.03988 -0.13410 0.13165 1.26136 0.43653 -1.03864 - 7.0000 -0.5500 0.3333 -1.52453 0.94319 -0.12883 0.15195 0.99899 0.14826 -1.03864 - 7.0000 -0.5500 0.4286 -1.02431 0.85271 -0.11337 0.15731 0.75457 -0.08477 -1.03864 - 7.0000 -0.5500 0.5385 -0.65337 0.75142 -0.08972 0.14861 0.52933 -0.25958 -1.03864 - 7.0000 -0.5500 0.6667 -0.37117 0.63492 -0.06066 0.12751 0.32622 -0.37710 -1.03864 - 7.0000 -0.5500 0.8182 -0.15717 0.49927 -0.02951 0.09522 0.14861 -0.43436 -1.03864 - 7.0000 -0.6000 0.0526 -11.86990 2.23233 -0.07357 -0.09228 2.40913 1.09430 -0.96061 - 7.0000 -0.6000 0.1111 -5.28578 1.17764 -0.10103 0.00745 1.82864 1.01544 -0.96061 - 7.0000 -0.6000 0.1765 -3.15671 1.07577 -0.11707 0.05663 1.49387 0.60790 -0.96061 - 7.0000 -0.6000 0.2500 -2.08300 0.96374 -0.12256 0.12032 1.21697 0.48180 -0.96061 - 7.0000 -0.6000 0.3333 -1.41657 0.87479 -0.11774 0.13886 0.96365 0.19229 -0.96061 - 7.0000 -0.6000 0.4286 -0.95208 0.79138 -0.10361 0.14376 0.72777 -0.04216 -0.96061 - 7.0000 -0.6000 0.5385 -0.60746 0.69773 -0.08200 0.13581 0.51047 -0.21969 -0.96061 - 7.0000 -0.6000 0.6667 -0.34516 0.58979 -0.05544 0.11653 0.31456 -0.34099 -0.96061 - 7.0000 -0.6000 0.8182 -0.14619 0.46391 -0.02697 0.08702 0.14328 -0.40320 -0.96061 - 7.0000 -0.6500 0.0526 -11.04428 2.07124 -0.06745 -0.08460 2.33117 1.15577 -0.89105 - 7.0000 -0.6500 0.1111 -4.91988 1.09263 -0.09261 0.00683 1.76852 1.06112 -0.89105 - 7.0000 -0.6500 0.1765 -2.93929 0.99908 -0.10732 0.05192 1.44426 0.65075 -0.89105 - 7.0000 -0.6500 0.2500 -1.94024 0.89575 -0.11235 0.11030 1.17627 0.52330 -0.89105 - 7.0000 -0.6500 0.3333 -1.31994 0.81367 -0.10793 0.12730 0.93126 0.23265 -0.89105 - 7.0000 -0.6500 0.4286 -0.88740 0.73654 -0.09498 0.13179 0.70320 -0.00311 -0.89105 - 7.0000 -0.6500 0.5385 -0.56635 0.64971 -0.07517 0.12450 0.49318 -0.18313 -0.89105 - 7.0000 -0.6500 0.6667 -0.32187 0.54941 -0.05082 0.10682 0.30387 -0.30789 -0.89105 - 7.0000 -0.6500 0.8182 -0.13635 0.43226 -0.02473 0.07977 0.13840 -0.37464 -0.89105 - 7.0000 -0.7000 0.0526 -10.30316 1.92699 -0.06200 -0.07777 2.25953 1.21226 -0.82879 - 7.0000 -0.7000 0.1111 -4.59132 1.01651 -0.08514 0.00628 1.71328 1.10310 -0.82879 - 7.0000 -0.7000 0.1765 -2.74399 0.93034 -0.09866 0.04773 1.39869 0.69012 -0.82879 - 7.0000 -0.7000 0.2500 -1.81197 0.83477 -0.10328 0.10140 1.13888 0.56143 -0.82879 - 7.0000 -0.7000 0.3333 -1.23309 0.75882 -0.09922 0.11703 0.90149 0.26974 -0.82879 - 7.0000 -0.7000 0.4286 -0.82926 0.68730 -0.08731 0.12115 0.68063 0.03277 -0.82879 - 7.0000 -0.7000 0.5385 -0.52937 0.60657 -0.06910 0.11445 0.47729 -0.14954 -0.82879 - 7.0000 -0.7000 0.6667 -0.30093 0.51312 -0.04672 0.09820 0.29405 -0.27747 -0.82879 - 7.0000 -0.7000 0.8182 -0.12750 0.40382 -0.02273 0.07334 0.13392 -0.34839 -0.82879 - 7.0000 -0.7500 0.0526 -9.63530 1.79730 -0.05715 -0.07169 2.19355 1.26429 -0.77283 - 7.0000 -0.7500 0.1111 -4.29515 0.94807 -0.07848 0.00579 1.66240 1.14176 -0.77283 - 7.0000 -0.7500 0.1765 -2.56788 0.86849 -0.09094 0.04399 1.35671 0.72638 -0.77283 - 7.0000 -0.7500 0.2500 -1.69627 0.77987 -0.09520 0.09346 1.10444 0.59655 -0.77283 - 7.0000 -0.7500 0.3333 -1.15472 0.70941 -0.09146 0.10787 0.87407 0.30390 -0.77283 - 7.0000 -0.7500 0.4286 -0.77678 0.64291 -0.08048 0.11168 0.65984 0.06582 -0.77283 - 7.0000 -0.7500 0.5385 -0.49599 0.56766 -0.06369 0.10550 0.46265 -0.11860 -0.77283 - 7.0000 -0.7500 0.6667 -0.28201 0.48038 -0.04306 0.09052 0.28501 -0.24946 -0.77283 - 7.0000 -0.7500 0.8182 -0.11951 0.37815 -0.02095 0.06760 0.12979 -0.32422 -0.77283 - 7.0000 -0.8000 0.0526 -9.03129 1.68029 -0.05281 -0.06624 2.13265 1.31231 -0.72235 - 7.0000 -0.8000 0.1111 -4.02722 0.88632 -0.07252 0.00535 1.61544 1.17744 -0.72235 - 7.0000 -0.8000 0.1765 -2.40851 0.81265 -0.08404 0.04065 1.31796 0.75985 -0.72235 - 7.0000 -0.8000 0.2500 -1.59153 0.73026 -0.08797 0.08637 1.07265 0.62896 -0.72235 - 7.0000 -0.8000 0.3333 -1.08376 0.66473 -0.08451 0.09968 0.84877 0.33543 -0.72235 - 7.0000 -0.8000 0.4286 -0.72924 0.60276 -0.07437 0.10319 0.64065 0.09633 -0.72235 - 7.0000 -0.8000 0.5385 -0.46575 0.53246 -0.05886 0.09749 0.44915 -0.09004 -0.72235 - 7.0000 -0.8000 0.6667 -0.26487 0.45075 -0.03979 0.08365 0.27666 -0.22360 -0.72235 - 7.0000 -0.8000 0.8182 -0.11226 0.35491 -0.01936 0.06246 0.12598 -0.30191 -0.72235 - 7.5000 0.0000 0.0526 -39.05227 7.94318 -0.29399 -0.36498 4.33061 -0.40905 -3.28889 - 7.5000 0.0000 0.1111 -17.23808 4.13351 -0.40287 0.03229 3.30322 -0.10839 -3.28889 - 7.5000 0.0000 0.1765 -10.21568 3.68185 -0.46590 0.22738 2.70477 -0.44877 -3.28889 - 7.5000 0.0000 0.2500 -6.69180 3.24021 -0.48674 0.47941 2.20611 -0.54113 -3.28889 - 7.5000 0.0000 0.3333 -4.52007 2.89659 -0.46670 0.55186 1.74797 -0.80087 -3.28889 - 7.5000 0.0000 0.4286 -3.01933 2.58779 -0.40993 0.57015 1.32043 -1.00064 -3.28889 - 7.5000 0.0000 0.5385 -1.91596 2.25844 -0.32384 0.53764 0.92618 -1.11449 -3.28889 - 7.5000 0.0000 0.6667 -1.08347 1.89391 -0.21855 0.46056 0.57063 -1.14886 -3.28889 - 7.5000 0.0000 0.8182 -0.45701 1.48130 -0.10616 0.34347 0.25985 -1.09842 -3.28889 - 7.5000 -0.0500 0.0526 -34.21899 6.93270 -0.25299 -0.31408 4.05383 -0.19071 -2.86802 - 7.5000 -0.0500 0.1111 -15.11282 3.60758 -0.34668 0.02779 3.09025 0.05416 -2.86802 - 7.5000 -0.0500 0.1765 -8.96126 3.21758 -0.40092 0.19567 2.52942 -0.29638 -2.86802 - 7.5000 -0.0500 0.2500 -5.87340 2.83482 -0.41886 0.41255 2.06254 -0.39375 -2.86802 - 7.5000 -0.0500 0.3333 -3.96937 2.53687 -0.40161 0.47490 1.63389 -0.65774 -2.86802 - 7.5000 -0.0500 0.4286 -2.65273 2.26848 -0.35276 0.49063 1.23405 -0.86238 -2.86802 - 7.5000 -0.0500 0.5385 -1.68402 1.98125 -0.27867 0.46265 0.86547 -0.98524 -2.86802 - 7.5000 -0.0500 0.6667 -0.95264 1.66244 -0.18807 0.39633 0.53317 -1.03198 -2.86802 - 7.5000 -0.0500 0.8182 -0.40195 1.30080 -0.09135 0.29557 0.24277 -0.99767 -2.86802 - 7.5000 -0.1000 0.0526 -30.24149 6.10360 -0.21964 -0.27268 3.81028 0.00140 -2.52306 - 7.5000 -0.1000 0.1111 -13.36313 3.17604 -0.30099 0.02413 2.90284 0.19718 -2.52306 - 7.5000 -0.1000 0.1765 -7.92807 2.83627 -0.34808 0.16988 2.37512 -0.16229 -2.52306 - 7.5000 -0.1000 0.2500 -5.19905 2.50159 -0.36365 0.35817 1.93620 -0.26406 -2.52306 - 7.5000 -0.1000 0.3333 -3.51541 2.24096 -0.34868 0.41230 1.53350 -0.53180 -2.52306 - 7.5000 -0.1000 0.4286 -2.35041 2.00562 -0.30626 0.42597 1.15804 -0.74072 -2.52306 - 7.5000 -0.1000 0.5385 -1.49269 1.75294 -0.24194 0.40168 0.81206 -0.87151 -2.52306 - 7.5000 -0.1000 0.6667 -0.84470 1.47169 -0.16328 0.34409 0.50021 -0.92913 -2.52306 - 7.5000 -0.1000 0.8182 -0.35650 1.15200 -0.07931 0.25661 0.22773 -0.90901 -2.52306 - 7.5000 -0.1500 0.0526 -26.92804 5.41490 -0.19219 -0.23860 3.59485 0.17134 -2.23679 - 7.5000 -0.1500 0.1111 -11.90496 2.81758 -0.26337 0.02111 2.73707 0.32370 -2.23679 - 7.5000 -0.1500 0.1765 -7.06667 2.51923 -0.30457 0.14865 2.23864 -0.04367 -2.23679 - 7.5000 -0.1500 0.2500 -4.63658 2.22431 -0.31820 0.31341 1.82445 -0.14934 -2.23679 - 7.5000 -0.1500 0.3333 -3.13661 1.99453 -0.30510 0.36077 1.44470 -0.42040 -2.23679 - 7.5000 -0.1500 0.4286 -2.09807 1.78657 -0.26799 0.37273 1.09081 -0.63311 -2.23679 - 7.5000 -0.1500 0.5385 -1.33294 1.56258 -0.21171 0.35147 0.76481 -0.77091 -2.23679 - 7.5000 -0.1500 0.6667 -0.75454 1.31259 -0.14288 0.30109 0.47105 -0.83816 -2.23679 - 7.5000 -0.1500 0.8182 -0.31854 1.02785 -0.06940 0.22454 0.21444 -0.83058 -2.23679 - 7.5000 -0.2000 0.0526 -24.13786 4.83661 -0.16935 -0.21024 3.40337 0.32239 -1.99661 - 7.5000 -0.2000 0.1111 -10.67659 2.51658 -0.23206 0.01860 2.58973 0.43615 -1.99661 - 7.5000 -0.2000 0.1765 -6.34071 2.25276 -0.26837 0.13098 2.11733 0.06175 -1.99661 - 7.5000 -0.2000 0.2500 -4.16235 1.99107 -0.28038 0.27615 1.72512 -0.04738 -1.99661 - 7.5000 -0.2000 0.3333 -2.81713 1.78709 -0.26883 0.31789 1.36577 -0.32138 -1.99661 - 7.5000 -0.2000 0.4286 -1.88516 1.60207 -0.23613 0.32842 1.03105 -0.53746 -1.99661 - 7.5000 -0.2000 0.5385 -1.19811 1.40214 -0.18654 0.30969 0.72282 -0.68149 -1.99661 - 7.5000 -0.2000 0.6667 -0.67843 1.17843 -0.12589 0.26530 0.44513 -0.75730 -1.99661 - 7.5000 -0.2000 0.8182 -0.28648 0.92313 -0.06115 0.19785 0.20262 -0.76088 -1.99661 - 7.5000 -0.2500 0.0526 -21.76571 4.34631 -0.15015 -0.18640 3.23241 0.45724 -1.79314 - 7.5000 -0.2500 0.1111 -9.63184 2.26138 -0.20576 0.01649 2.45819 0.53654 -1.79314 - 7.5000 -0.2500 0.1765 -5.72303 2.02664 -0.23794 0.11613 2.00903 0.15588 -1.79314 - 7.5000 -0.2500 0.2500 -3.75870 1.79299 -0.24859 0.24485 1.63644 0.04365 -1.79314 - 7.5000 -0.2500 0.3333 -2.54508 1.61079 -0.23836 0.28185 1.29530 -0.23298 -1.79314 - 7.5000 -0.2500 0.4286 -1.70379 1.44515 -0.20936 0.29119 0.97770 -0.45206 -1.79314 - 7.5000 -0.2500 0.5385 -1.08323 1.26563 -0.16539 0.27458 0.68532 -0.60166 -1.79314 - 7.5000 -0.2500 0.6667 -0.61356 1.06423 -0.11162 0.23522 0.42200 -0.68510 -1.79314 - 7.5000 -0.2500 0.8182 -0.25915 0.83397 -0.05422 0.17542 0.19207 -0.69864 -1.79314 - 7.5000 -0.3000 0.0526 -19.73157 3.92702 -0.13387 -0.16620 3.07915 0.57814 -1.61926 - 7.5000 -0.3000 0.1111 -8.73563 2.04314 -0.18346 0.01470 2.34026 0.62655 -1.61926 - 7.5000 -0.3000 0.1765 -5.19296 1.83310 -0.21216 0.10354 1.91193 0.24026 -1.61926 - 7.5000 -0.3000 0.2500 -3.41215 1.62332 -0.22165 0.21831 1.55694 0.12526 -1.61926 - 7.5000 -0.3000 0.3333 -2.31143 1.45966 -0.21252 0.25130 1.23213 -0.15373 -1.61926 - 7.5000 -0.3000 0.4286 -1.54798 1.31056 -0.18667 0.25963 0.92987 -0.37551 -1.61926 - 7.5000 -0.3000 0.5385 -0.98450 1.14847 -0.14747 0.24483 0.65171 -0.53009 -1.61926 - 7.5000 -0.3000 0.6667 -0.55780 0.96619 -0.09952 0.20973 0.40125 -0.62038 -1.61926 - 7.5000 -0.3000 0.8182 -0.23566 0.75739 -0.04834 0.15641 0.18261 -0.64285 -1.61926 - 7.5000 -0.3500 0.0526 -17.97378 3.56565 -0.11997 -0.14894 2.94123 0.68694 -1.46949 - 7.5000 -0.3500 0.1111 -7.96088 1.85505 -0.16441 0.01318 2.23413 0.70754 -1.46949 - 7.5000 -0.3500 0.1765 -4.73454 1.66614 -0.19013 0.09279 1.82456 0.31620 -1.46949 - 7.5000 -0.3500 0.2500 -3.11235 1.47685 -0.19863 0.19564 1.48540 0.19871 -1.46949 - 7.5000 -0.3500 0.3333 -2.10923 1.32911 -0.19045 0.22521 1.17527 -0.08241 -1.46949 - 7.5000 -0.3500 0.4286 -1.41309 1.19421 -0.16729 0.23267 0.88682 -0.30661 -1.46949 - 7.5000 -0.3500 0.5385 -0.89900 1.04715 -0.13215 0.21940 0.62146 -0.46569 -1.46949 - 7.5000 -0.3500 0.6667 -0.50950 0.88136 -0.08919 0.18795 0.38259 -0.56214 -1.46949 - 7.5000 -0.3500 0.8182 -0.21530 0.69112 -0.04332 0.14017 0.17410 -0.59264 -1.46949 - 7.5000 -0.4000 0.0526 -16.44412 3.25200 -0.10801 -0.13410 2.81666 0.78521 -1.33958 - 7.5000 -0.4000 0.1111 -7.28644 1.69180 -0.14802 0.01186 2.13827 0.78070 -1.33958 - 7.5000 -0.4000 0.1765 -4.33534 1.52112 -0.17117 0.08354 1.74564 0.38478 -1.33958 - 7.5000 -0.4000 0.2500 -2.85116 1.34952 -0.17883 0.17614 1.42078 0.26504 -1.33958 - 7.5000 -0.4000 0.3333 -1.93300 1.21553 -0.17147 0.20276 1.12393 -0.01799 -1.33958 - 7.5000 -0.4000 0.4286 -1.29550 1.09294 -0.15061 0.20948 0.84794 -0.24438 -1.33958 - 7.5000 -0.4000 0.5385 -0.82445 0.95890 -0.11898 0.19753 0.59414 -0.40752 -1.33958 - 7.5000 -0.4000 0.6667 -0.46737 0.80745 -0.08030 0.16921 0.36573 -0.50954 -1.33958 - 7.5000 -0.4000 0.8182 -0.19754 0.63337 -0.03900 0.12619 0.16641 -0.54729 -1.33958 - 7.5000 -0.4500 0.0526 -15.10453 2.97802 -0.09766 -0.12124 2.70377 0.87425 -1.22617 - 7.5000 -0.4500 0.1111 -6.69559 1.54920 -0.13383 0.01073 2.05141 0.84699 -1.22617 - 7.5000 -0.4500 0.1765 -3.98547 1.39433 -0.15476 0.07553 1.67412 0.44694 -1.22617 - 7.5000 -0.4500 0.2500 -2.62217 1.23812 -0.16169 0.15925 1.36222 0.32515 -1.22617 - 7.5000 -0.4500 0.3333 -1.77845 1.11610 -0.15503 0.18332 1.07740 0.04038 -1.22617 - 7.5000 -0.4500 0.4286 -1.19233 1.00423 -0.13617 0.18939 0.81271 -0.18799 -1.22617 - 7.5000 -0.4500 0.5385 -0.75903 0.88157 -0.10757 0.17859 0.56938 -0.35480 -1.22617 - 7.5000 -0.4500 0.6667 -0.43039 0.74265 -0.07260 0.15299 0.35045 -0.46186 -1.22617 - 7.5000 -0.4500 0.8182 -0.18195 0.58272 -0.03526 0.11410 0.15944 -0.50620 -1.22617 - 7.5000 -0.5000 0.0526 -13.92455 2.73729 -0.08864 -0.11004 2.60115 0.95520 -1.12657 - 7.5000 -0.5000 0.1111 -6.17496 1.42390 -0.12146 0.00974 1.97245 0.90726 -1.12657 - 7.5000 -0.5000 0.1765 -3.67708 1.28284 -0.14047 0.06855 1.60911 0.50344 -1.12657 - 7.5000 -0.5000 0.2500 -2.42026 1.14009 -0.14675 0.14454 1.30899 0.37980 -1.12657 - 7.5000 -0.5000 0.3333 -1.64213 1.02854 -0.14071 0.16639 1.03510 0.09345 -1.12657 - 7.5000 -0.5000 0.4286 -1.10131 0.92606 -0.12359 0.17190 0.78069 -0.13673 -1.12657 - 7.5000 -0.5000 0.5385 -0.70128 0.81339 -0.09764 0.16210 0.54688 -0.30688 -1.12657 - 7.5000 -0.5000 0.6667 -0.39775 0.68551 -0.06589 0.13886 0.33656 -0.41853 -1.12657 - 7.5000 -0.5000 0.8182 -0.16818 0.53804 -0.03201 0.10356 0.15311 -0.46884 -1.12657 - 7.5000 -0.5500 0.0526 -12.87963 2.52464 -0.08074 -0.10023 2.50759 1.02900 -1.03864 - 7.5000 -0.5500 0.1111 -5.71377 1.31323 -0.11064 0.00887 1.90046 0.96220 -1.03864 - 7.5000 -0.5500 0.1765 -3.40380 1.18427 -0.12795 0.06245 1.54984 0.55495 -1.03864 - 7.5000 -0.5500 0.2500 -2.24126 1.05336 -0.13367 0.13166 1.26046 0.42962 -1.03864 - 7.5000 -0.5500 0.3333 -1.52123 0.95103 -0.12817 0.15156 0.99653 0.14183 -1.03864 - 7.5000 -0.5500 0.4286 -1.02056 0.85683 -0.11258 0.15658 0.75149 -0.09000 -1.03864 - 7.5000 -0.5500 0.5385 -0.65005 0.75298 -0.08894 0.14765 0.52636 -0.26319 -1.03864 - 7.5000 -0.5500 0.6667 -0.36878 0.63486 -0.06002 0.12648 0.32390 -0.37902 -1.03864 - 7.5000 -0.5500 0.8182 -0.15597 0.49842 -0.02915 0.09433 0.14733 -0.43479 -1.03864 - 7.5000 -0.6000 0.0526 -11.94978 2.33586 -0.07379 -0.09160 2.42206 1.09648 -0.96061 - 7.5000 -0.6000 0.1111 -5.30322 1.21497 -0.10111 0.00810 1.83464 1.01243 -0.96061 - 7.5000 -0.6000 0.1765 -3.16044 1.09670 -0.11693 0.05707 1.49565 0.60204 -0.96061 - 7.5000 -0.6000 0.2500 -2.08181 0.97626 -0.12216 0.12032 1.21609 0.47516 -0.96061 - 7.5000 -0.6000 0.3333 -1.41351 0.88207 -0.11713 0.13851 0.96127 0.18606 -0.96061 - 7.5000 -0.6000 0.4286 -0.94859 0.79520 -0.10289 0.14310 0.72479 -0.04727 -0.96061 - 7.5000 -0.6000 0.5385 -0.60437 0.69918 -0.08128 0.13494 0.50760 -0.22325 -0.96061 - 7.5000 -0.6000 0.6667 -0.34294 0.58973 -0.05485 0.11559 0.31232 -0.34290 -0.96061 - 7.5000 -0.6000 0.8182 -0.14507 0.46312 -0.02664 0.08621 0.14205 -0.40365 -0.96061 - 7.5000 -0.6500 0.0526 -11.11858 2.16750 -0.06764 -0.08397 2.34365 1.15832 -0.89105 - 7.5000 -0.6500 0.1111 -4.93611 1.12736 -0.09269 0.00743 1.77431 1.05848 -0.89105 - 7.5000 -0.6500 0.1765 -2.94276 1.01855 -0.10719 0.05231 1.44598 0.64521 -0.89105 - 7.5000 -0.6500 0.2500 -1.93914 0.90740 -0.11199 0.11030 1.17542 0.51691 -0.89105 - 7.5000 -0.6500 0.3333 -1.31709 0.82045 -0.10738 0.12697 0.92896 0.22660 -0.89105 - 7.5000 -0.6500 0.4286 -0.88415 0.74010 -0.09432 0.13118 0.70033 -0.00811 -0.89105 - 7.5000 -0.6500 0.5385 -0.56346 0.65105 -0.07451 0.12370 0.49040 -0.18663 -0.89105 - 7.5000 -0.6500 0.6667 -0.31980 0.54934 -0.05028 0.10597 0.30171 -0.30979 -0.89105 - 7.5000 -0.6500 0.8182 -0.13530 0.43152 -0.02443 0.07903 0.13722 -0.37511 -0.89105 - 7.5000 -0.7000 0.0526 -10.37245 2.01673 -0.06218 -0.07720 2.27161 1.21515 -0.82879 - 7.5000 -0.7000 0.1111 -4.60647 1.04889 -0.08521 0.00683 1.71887 1.10079 -0.82879 - 7.5000 -0.7000 0.1765 -2.74723 0.94851 -0.09854 0.04809 1.40034 0.68487 -0.82879 - 7.5000 -0.7000 0.2500 -1.81094 0.84565 -0.10295 0.10140 1.13805 0.55528 -0.82879 - 7.5000 -0.7000 0.3333 -1.23042 0.76515 -0.09871 0.11673 0.89926 0.26386 -0.82879 - 7.5000 -0.7000 0.4286 -0.82621 0.69062 -0.08671 0.12059 0.67784 0.02788 -0.82879 - 7.5000 -0.7000 0.5385 -0.52667 0.60782 -0.06850 0.11372 0.47460 -0.15299 -0.82879 - 7.5000 -0.7000 0.6667 -0.29899 0.51306 -0.04623 0.09742 0.29196 -0.27937 -0.82879 - 7.5000 -0.7000 0.8182 -0.12652 0.40312 -0.02245 0.07265 0.13277 -0.34888 -0.82879 - 7.5000 -0.7500 0.0526 -9.70008 1.88118 -0.05732 -0.07116 2.20526 1.26750 -0.77283 - 7.5000 -0.7500 0.1111 -4.30932 0.97835 -0.07855 0.00630 1.66782 1.13975 -0.77283 - 7.5000 -0.7500 0.1765 -2.57091 0.88549 -0.09083 0.04433 1.35830 0.72141 -0.77283 - 7.5000 -0.7500 0.2500 -1.69530 0.79005 -0.09490 0.09347 1.10363 0.59061 -0.77283 - 7.5000 -0.7500 0.3333 -1.15222 0.71533 -0.09099 0.10759 0.87191 0.29817 -0.77283 - 7.5000 -0.7500 0.4286 -0.77393 0.64602 -0.07992 0.11116 0.65713 0.06102 -0.77283 - 7.5000 -0.7500 0.5385 -0.49346 0.56883 -0.06314 0.10482 0.46005 -0.12201 -0.77283 - 7.5000 -0.7500 0.6667 -0.28019 0.48032 -0.04261 0.08979 0.28298 -0.25135 -0.77283 - 7.5000 -0.7500 0.8182 -0.11859 0.37750 -0.02070 0.06697 0.12867 -0.32473 -0.77283 - 7.5000 -0.8000 0.0526 -9.09200 1.75886 -0.05296 -0.06575 2.14401 1.31581 -0.72235 - 7.5000 -0.8000 0.1111 -4.04050 0.91469 -0.07258 0.00582 1.62069 1.17572 -0.72235 - 7.5000 -0.8000 0.1765 -2.41135 0.82858 -0.08394 0.04096 1.31950 0.75513 -0.72235 - 7.5000 -0.8000 0.2500 -1.59062 0.73981 -0.08769 0.08637 1.07186 0.62322 -0.72235 - 7.5000 -0.8000 0.3333 -1.08141 0.67029 -0.08408 0.09942 0.84666 0.32984 -0.72235 - 7.5000 -0.8000 0.4286 -0.72656 0.60568 -0.07385 0.10272 0.63802 0.09162 -0.72235 - 7.5000 -0.8000 0.5385 -0.46338 0.53355 -0.05834 0.09686 0.44662 -0.09341 -0.72235 - 7.5000 -0.8000 0.6667 -0.26316 0.45069 -0.03937 0.08297 0.27469 -0.22549 -0.72235 - 7.5000 -0.8000 0.8182 -0.11140 0.35429 -0.01913 0.06188 0.12489 -0.30243 -0.72235 - 8.0000 0.0000 0.0526 -39.29585 8.26293 -0.29477 -0.36248 4.35278 -0.41552 -3.28889 - 8.0000 0.0000 0.1111 -17.29058 4.24780 -0.40317 0.03469 3.31366 -0.11941 -3.28889 - 8.0000 0.0000 0.1765 -10.22673 3.74528 -0.46537 0.22895 2.70798 -0.46154 -3.28889 - 8.0000 0.0000 0.2500 -6.68828 3.27782 -0.48530 0.47941 2.20474 -0.55311 -3.28889 - 8.0000 0.0000 0.3333 -4.51110 2.91832 -0.46449 0.55054 1.74399 -0.81081 -3.28889 - 8.0000 0.0000 0.4286 -3.00921 2.59917 -0.40729 0.56770 1.31539 -1.00799 -3.28889 - 8.0000 0.0000 0.5385 -1.90706 2.26280 -0.32122 0.53444 0.92129 -1.11902 -3.28889 - 8.0000 0.0000 0.6667 -1.07711 1.89387 -0.21644 0.45715 0.56681 -1.15079 -3.28889 - 8.0000 0.0000 0.8182 -0.45381 1.47915 -0.10497 0.34051 0.25774 -1.09837 -3.28889 - 8.0000 -0.0500 0.0526 -34.43231 7.21259 -0.25366 -0.31192 4.07454 -0.19595 -2.86802 - 8.0000 -0.0500 0.1111 -15.15884 3.70767 -0.34694 0.02985 3.09998 0.04432 -2.86802 - 8.0000 -0.0500 0.1765 -8.97095 3.27316 -0.40046 0.19702 2.53241 -0.30809 -2.86802 - 8.0000 -0.0500 0.2500 -5.87031 2.86780 -0.41762 0.41255 2.06124 -0.40489 -2.86802 - 8.0000 -0.0500 0.3333 -3.96149 2.55594 -0.39971 0.47376 1.63016 -0.66709 -2.86802 - 8.0000 -0.0500 0.4286 -2.64383 2.27847 -0.35048 0.48853 1.22934 -0.86936 -2.86802 - 8.0000 -0.0500 0.5385 -1.67619 1.98507 -0.27642 0.45990 0.86090 -0.98960 -2.86802 - 8.0000 -0.0500 0.6667 -0.94705 1.66239 -0.18625 0.39339 0.52960 -1.03389 -2.86802 - 8.0000 -0.0500 0.8182 -0.39913 1.29889 -0.09033 0.29302 0.24080 -0.99768 -2.86802 - 8.0000 -0.1000 0.0526 -30.42992 6.35070 -0.22022 -0.27081 3.82971 -0.00275 -2.52306 - 8.0000 -0.1000 0.1111 -13.40381 3.26445 -0.30121 0.02592 2.91196 0.18840 -2.52306 - 8.0000 -0.1000 0.1765 -7.93665 2.88540 -0.34768 0.17105 2.37791 -0.17307 -2.52306 - 8.0000 -0.1000 0.2500 -5.19631 2.53076 -0.36257 0.35817 1.93498 -0.27446 -2.52306 - 8.0000 -0.1000 0.3333 -3.50842 2.25782 -0.34703 0.41132 1.52999 -0.54062 -2.52306 - 8.0000 -0.1000 0.4286 -2.34252 2.01446 -0.30429 0.42414 1.15362 -0.74737 -2.52306 - 8.0000 -0.1000 0.5385 -1.48574 1.75632 -0.23999 0.39929 0.80777 -0.87571 -2.52306 - 8.0000 -0.1000 0.6667 -0.83973 1.47164 -0.16170 0.34154 0.49686 -0.93102 -2.52306 - 8.0000 -0.1000 0.8182 -0.35400 1.15030 -0.07842 0.25440 0.22589 -0.90908 -2.52306 - 8.0000 -0.1500 0.0526 -27.09575 5.63473 -0.19270 -0.23697 3.61314 0.16815 -2.23679 - 8.0000 -0.1500 0.1111 -11.94120 2.89627 -0.26357 0.02268 2.74565 0.31584 -2.23679 - 8.0000 -0.1500 0.1765 -7.07431 2.56298 -0.30423 0.14968 2.24126 -0.05363 -2.23679 - 8.0000 -0.1500 0.2500 -4.63413 2.25030 -0.31726 0.31341 1.82329 -0.15910 -2.23679 - 8.0000 -0.1500 0.3333 -3.13038 2.00957 -0.30366 0.35991 1.44139 -0.42876 -2.23679 - 8.0000 -0.1500 0.4286 -2.09102 1.79445 -0.26626 0.37113 1.08664 -0.63947 -2.23679 - 8.0000 -0.1500 0.5385 -1.32673 1.56558 -0.20999 0.34938 0.76077 -0.77498 -2.23679 - 8.0000 -0.1500 0.6667 -0.75010 1.31253 -0.14149 0.29885 0.46789 -0.84003 -2.23679 - 8.0000 -0.1500 0.8182 -0.31630 1.02632 -0.06862 0.22260 0.21270 -0.83071 -2.23679 - 8.0000 -0.2000 0.0526 -24.28813 5.03348 -0.16979 -0.20880 3.42064 0.32005 -1.99661 - 8.0000 -0.2000 0.1111 -10.70908 2.58708 -0.23224 0.01998 2.59782 0.42911 -1.99661 - 8.0000 -0.2000 0.1765 -6.34757 2.29199 -0.26806 0.13188 2.11979 0.05253 -1.99661 - 8.0000 -0.2000 0.2500 -4.16016 2.01439 -0.27955 0.27615 1.72402 -0.05655 -1.99661 - 8.0000 -0.2000 0.3333 -2.81152 1.80059 -0.26756 0.31713 1.36264 -0.32933 -1.99661 - 8.0000 -0.2000 0.4286 -1.87882 1.60914 -0.23461 0.32701 1.02710 -0.54356 -1.99661 - 8.0000 -0.2000 0.5385 -1.19252 1.40484 -0.18503 0.30785 0.71900 -0.68544 -1.99661 - 8.0000 -0.2000 0.6667 -0.67443 1.17838 -0.12467 0.26333 0.44215 -0.75916 -1.99661 - 8.0000 -0.2000 0.8182 -0.28446 0.92176 -0.06046 0.19614 0.20098 -0.76105 -1.99661 - 8.0000 -0.2500 0.0526 -21.90115 4.52368 -0.15054 -0.18513 3.24879 0.45567 -1.79314 - 8.0000 -0.2500 0.1111 -9.66115 2.32492 -0.20591 0.01772 2.46584 0.53025 -1.79314 - 8.0000 -0.2500 0.1765 -5.72922 2.06202 -0.23767 0.11693 2.01135 0.14730 -1.79314 - 8.0000 -0.2500 0.2500 -3.75671 1.81404 -0.24786 0.24485 1.63539 0.03500 -1.79314 - 8.0000 -0.2500 0.3333 -2.54001 1.62297 -0.23723 0.28118 1.29233 -0.24056 -1.79314 - 8.0000 -0.2500 0.4286 -1.69806 1.45154 -0.20801 0.28994 0.97395 -0.45794 -1.79314 - 8.0000 -0.2500 0.5385 -1.07817 1.26806 -0.16405 0.27295 0.68170 -0.60550 -1.79314 - 8.0000 -0.2500 0.6667 -0.60994 1.06418 -0.11054 0.23348 0.41917 -0.68695 -1.79314 - 8.0000 -0.2500 0.8182 -0.25733 0.83272 -0.05361 0.17391 0.19051 -0.69886 -1.79314 - 8.0000 -0.3000 0.0526 -19.85431 4.08767 -0.13423 -0.16506 3.09472 0.57725 -1.61926 - 8.0000 -0.3000 0.1111 -8.76221 2.10072 -0.18359 0.01580 2.34753 0.62091 -1.61926 - 8.0000 -0.3000 0.1765 -5.19857 1.86517 -0.21192 0.10426 1.91413 0.23227 -1.61926 - 8.0000 -0.3000 0.2500 -3.41035 1.64241 -0.22099 0.21831 1.55593 0.11707 -1.61926 - 8.0000 -0.3000 0.3333 -2.30683 1.47072 -0.21152 0.25070 1.22930 -0.16097 -1.61926 - 8.0000 -0.3000 0.4286 -1.54277 1.31635 -0.18547 0.25852 0.92630 -0.38117 -1.61926 - 8.0000 -0.3000 0.5385 -0.97990 1.15067 -0.14627 0.24337 0.64826 -0.53383 -1.61926 - 8.0000 -0.3000 0.6667 -0.55450 0.96613 -0.09856 0.20817 0.39857 -0.62222 -1.61926 - 8.0000 -0.3000 0.8182 -0.23399 0.75625 -0.04780 0.15506 0.18113 -0.64311 -1.61926 - 8.0000 -0.3500 0.0526 -18.08553 3.71187 -0.12029 -0.14792 2.95606 0.68666 -1.46949 - 8.0000 -0.3500 0.1111 -7.98510 1.90747 -0.16453 0.01416 2.24105 0.70250 -1.46949 - 8.0000 -0.3500 0.1765 -4.73967 1.69536 -0.18991 0.09343 1.82664 0.30874 -1.46949 - 8.0000 -0.3500 0.2500 -3.11070 1.49425 -0.19804 0.19564 1.48443 0.19093 -1.46949 - 8.0000 -0.3500 0.3333 -2.10502 1.33919 -0.18955 0.22467 1.17257 -0.08935 -1.46949 - 8.0000 -0.3500 0.4286 -1.40833 1.19950 -0.16621 0.23167 0.88342 -0.31209 -1.46949 - 8.0000 -0.3500 0.5385 -0.89480 1.04915 -0.13109 0.21810 0.61817 -0.46934 -1.46949 - 8.0000 -0.3500 0.6667 -0.50649 0.88130 -0.08832 0.18655 0.38002 -0.56397 -1.46949 - 8.0000 -0.3500 0.8182 -0.21378 0.69007 -0.04284 0.13896 0.17269 -0.59293 -1.46949 - 8.0000 -0.4000 0.0526 -16.54633 3.38567 -0.10830 -0.13318 2.83084 0.78548 -1.33958 - 8.0000 -0.4000 0.1111 -7.30860 1.73974 -0.14813 0.01274 2.14488 0.77619 -1.33958 - 8.0000 -0.4000 0.1765 -4.34003 1.54785 -0.17098 0.08412 1.74762 0.37780 -1.33958 - 8.0000 -0.4000 0.2500 -2.84965 1.36544 -0.17830 0.17614 1.41984 0.25764 -1.33958 - 8.0000 -0.4000 0.3333 -1.92915 1.22476 -0.17066 0.20227 1.12134 -0.02467 -1.33958 - 8.0000 -0.4000 0.4286 -1.29113 1.09778 -0.14964 0.20858 0.84469 -0.24970 -1.33958 - 8.0000 -0.4000 0.5385 -0.82059 0.96074 -0.11802 0.19636 0.59100 -0.41109 -1.33958 - 8.0000 -0.4000 0.6667 -0.46460 0.80740 -0.07952 0.16796 0.36328 -0.51135 -1.33958 - 8.0000 -0.4000 0.8182 -0.19615 0.63240 -0.03857 0.12510 0.16506 -0.54762 -1.33958 - 8.0000 -0.4500 0.0526 -15.19838 3.10070 -0.09792 -0.12041 2.71735 0.87503 -1.22617 - 8.0000 -0.4500 0.1111 -6.71595 1.59322 -0.13392 0.01152 2.05773 0.84297 -1.22617 - 8.0000 -0.4500 0.1765 -3.98979 1.41889 -0.15459 0.07605 1.67601 0.44038 -1.22617 - 8.0000 -0.4500 0.2500 -2.62078 1.25276 -0.16121 0.15925 1.36132 0.31809 -1.22617 - 8.0000 -0.4500 0.3333 -1.77490 1.12459 -0.15429 0.18288 1.07491 0.03395 -1.22617 - 8.0000 -0.4500 0.4286 -1.18831 1.00868 -0.13529 0.18858 0.80960 -0.19315 -1.22617 - 8.0000 -0.4500 0.5385 -0.75547 0.88325 -0.10670 0.17753 0.56637 -0.35830 -1.22617 - 8.0000 -0.4500 0.6667 -0.42784 0.74260 -0.07190 0.15185 0.34810 -0.46367 -1.22617 - 8.0000 -0.4500 0.8182 -0.18066 0.58183 -0.03487 0.11311 0.15815 -0.50655 -1.22617 - 8.0000 -0.5000 0.0526 -14.01104 2.85031 -0.08887 -0.10929 2.61419 0.95644 -1.12657 - 8.0000 -0.5000 0.1111 -6.19374 1.46447 -0.12155 0.01046 1.97851 0.90368 -1.12657 - 8.0000 -0.5000 0.1765 -3.68106 1.30548 -0.14031 0.06903 1.61092 0.49727 -1.12657 - 8.0000 -0.5000 0.2500 -2.41897 1.15359 -0.14632 0.14454 1.30812 0.37305 -1.12657 - 8.0000 -0.5000 0.3333 -1.63884 1.03637 -0.14004 0.16599 1.03271 0.08723 -1.12657 - 8.0000 -0.5000 0.4286 -1.09759 0.93017 -0.12280 0.17116 0.77769 -0.14176 -1.12657 - 8.0000 -0.5000 0.5385 -0.69800 0.81495 -0.09685 0.16113 0.54398 -0.31032 -1.12657 - 8.0000 -0.5000 0.6667 -0.39539 0.68546 -0.06525 0.13783 0.33430 -0.42033 -1.12657 - 8.0000 -0.5000 0.8182 -0.16699 0.53721 -0.03165 0.10266 0.15187 -0.46922 -1.12657 - 8.0000 -0.5500 0.0526 -12.95960 2.62910 -0.08095 -0.09955 2.52014 1.03066 -1.03864 - 8.0000 -0.5500 0.1111 -5.73114 1.35073 -0.11072 0.00953 1.90628 0.95902 -1.03864 - 8.0000 -0.5500 0.1765 -3.40748 1.20522 -0.12780 0.06288 1.55157 0.54914 -1.03864 - 8.0000 -0.5500 0.2500 -2.24007 1.06586 -0.13328 0.13166 1.25961 0.42315 -1.03864 - 8.0000 -0.5500 0.3333 -1.51819 0.95828 -0.12756 0.15120 0.99423 0.13582 -1.03864 - 8.0000 -0.5500 0.4286 -1.01711 0.86063 -0.11185 0.15591 0.74860 -0.09490 -1.03864 - 8.0000 -0.5500 0.5385 -0.64700 0.75442 -0.08822 0.14677 0.52357 -0.26657 -1.03864 - 8.0000 -0.5500 0.6667 -0.36659 0.63480 -0.05944 0.12555 0.32173 -0.38081 -1.03864 - 8.0000 -0.5500 0.8182 -0.15486 0.49765 -0.02883 0.09351 0.14614 -0.43519 -1.03864 - 8.0000 -0.6000 0.0526 -12.02395 2.43271 -0.07398 -0.09098 2.43415 1.09851 -0.96061 - 8.0000 -0.6000 0.1111 -5.31934 1.24976 -0.10119 0.00871 1.84025 1.00962 -0.96061 - 8.0000 -0.6000 0.1765 -3.16386 1.11614 -0.11680 0.05746 1.49731 0.59656 -0.96061 - 8.0000 -0.6000 0.2500 -2.08071 0.98786 -0.12180 0.12032 1.21527 0.46895 -0.96061 - 8.0000 -0.6000 0.3333 -1.41068 0.88881 -0.11658 0.13818 0.95905 0.18023 -0.96061 - 8.0000 -0.6000 0.4286 -0.94538 0.79873 -0.10222 0.14248 0.72201 -0.05205 -0.96061 - 8.0000 -0.6000 0.5385 -0.60153 0.70051 -0.08062 0.13414 0.50491 -0.22657 -0.96061 - 8.0000 -0.6000 0.6667 -0.34091 0.58968 -0.05432 0.11474 0.31023 -0.34469 -0.96061 - 8.0000 -0.6000 0.8182 -0.14404 0.46240 -0.02635 0.08546 0.14090 -0.40407 -0.96061 - 8.0000 -0.6500 0.0526 -11.18757 2.25756 -0.06782 -0.08340 2.35534 1.16071 -0.89105 - 8.0000 -0.6500 0.1111 -4.95111 1.15972 -0.09276 0.00798 1.77972 1.05600 -0.89105 - 8.0000 -0.6500 0.1765 -2.94594 1.03664 -0.10707 0.05268 1.44758 0.64003 -0.89105 - 8.0000 -0.6500 0.2500 -1.93811 0.91820 -0.11166 0.11030 1.17462 0.51094 -0.89105 - 8.0000 -0.6500 0.3333 -1.31445 0.82672 -0.10687 0.12667 0.92680 0.22094 -0.89105 - 8.0000 -0.6500 0.4286 -0.88116 0.74338 -0.09371 0.13062 0.69763 -0.01278 -0.89105 - 8.0000 -0.6500 0.5385 -0.56082 0.65229 -0.07391 0.12296 0.48780 -0.18991 -0.89105 - 8.0000 -0.6500 0.6667 -0.31790 0.54929 -0.04980 0.10518 0.29969 -0.31157 -0.89105 - 8.0000 -0.6500 0.8182 -0.13434 0.43085 -0.02415 0.07834 0.13610 -0.37555 -0.89105 - 8.0000 -0.7000 0.0526 -10.43679 2.10069 -0.06235 -0.07667 2.28291 1.21786 -0.82879 - 8.0000 -0.7000 0.1111 -4.62047 1.07907 -0.08528 0.00734 1.72410 1.09862 -0.82879 - 8.0000 -0.7000 0.1765 -2.75020 0.96539 -0.09843 0.04843 1.40188 0.67997 -0.82879 - 8.0000 -0.7000 0.2500 -1.80998 0.85573 -0.10265 0.10140 1.13727 0.54952 -0.82879 - 8.0000 -0.7000 0.3333 -1.22796 0.77101 -0.09825 0.11645 0.89717 0.25835 -0.82879 - 8.0000 -0.7000 0.4286 -0.82342 0.69369 -0.08615 0.12008 0.67524 0.02330 -0.82879 - 8.0000 -0.7000 0.5385 -0.52420 0.60898 -0.06794 0.11304 0.47209 -0.15622 -0.82879 - 8.0000 -0.7000 0.6667 -0.29721 0.51301 -0.04578 0.09669 0.29000 -0.28114 -0.82879 - 8.0000 -0.7000 0.8182 -0.12562 0.40249 -0.02220 0.07202 0.13169 -0.34934 -0.82879 - 8.0000 -0.7500 0.0526 -9.76024 1.95964 -0.05747 -0.07067 2.21621 1.27050 -0.77283 - 8.0000 -0.7500 0.1111 -4.32242 1.00656 -0.07860 0.00676 1.67288 1.13788 -0.77283 - 8.0000 -0.7500 0.1765 -2.57370 0.90127 -0.09073 0.04464 1.35979 0.71676 -0.77283 - 8.0000 -0.7500 0.2500 -1.69440 0.79948 -0.09462 0.09347 1.10287 0.58505 -0.77283 - 8.0000 -0.7500 0.3333 -1.14991 0.72081 -0.09056 0.10734 0.86988 0.29281 -0.77283 - 8.0000 -0.7500 0.4286 -0.77130 0.64890 -0.07941 0.11068 0.65461 0.05654 -0.77283 - 8.0000 -0.7500 0.5385 -0.49114 0.56992 -0.06263 0.10420 0.45761 -0.12520 -0.77283 - 8.0000 -0.7500 0.6667 -0.27853 0.48028 -0.04220 0.08913 0.28108 -0.25312 -0.77283 - 8.0000 -0.7500 0.8182 -0.11774 0.37690 -0.02047 0.06639 0.12763 -0.32520 -0.77283 - 8.0000 -0.8000 0.0526 -9.14836 1.83236 -0.05310 -0.06530 2.15464 1.31908 -0.72235 - 8.0000 -0.8000 0.1111 -4.05278 0.94113 -0.07263 0.00625 1.62560 1.17411 -0.72235 - 8.0000 -0.8000 0.1765 -2.41396 0.84338 -0.08384 0.04125 1.32094 0.75071 -0.72235 - 8.0000 -0.8000 0.2500 -1.58977 0.74866 -0.08743 0.08637 1.07112 0.61785 -0.72235 - 8.0000 -0.8000 0.3333 -1.07924 0.67543 -0.08368 0.09918 0.84469 0.32461 -0.72235 - 8.0000 -0.8000 0.4286 -0.72410 0.60838 -0.07338 0.10228 0.63556 0.08721 -0.72235 - 8.0000 -0.8000 0.5385 -0.46120 0.53457 -0.05787 0.09628 0.44425 -0.09656 -0.72235 - 8.0000 -0.8000 0.6667 -0.26160 0.45064 -0.03899 0.08236 0.27285 -0.22725 -0.72235 - 8.0000 -0.8000 0.8182 -0.11061 0.35373 -0.01891 0.06135 0.12388 -0.30292 -0.72235 - 8.5000 0.0000 0.0526 -39.52308 8.56326 -0.29548 -0.36016 4.37361 -0.42160 -3.28889 - 8.5000 0.0000 0.1111 -17.33936 4.35475 -0.40344 0.03690 3.32346 -0.12977 -3.28889 - 8.5000 0.0000 0.1765 -10.23693 3.80447 -0.46487 0.23040 2.71099 -0.47353 -3.28889 - 8.5000 0.0000 0.2500 -6.68498 3.31284 -0.48396 0.47939 2.20345 -0.56435 -3.28889 - 8.5000 0.0000 0.3333 -4.50279 2.93852 -0.46244 0.54931 1.74025 -0.82015 -3.28889 - 8.5000 0.0000 0.4286 -2.99986 2.60975 -0.40485 0.56543 1.31066 -1.01490 -3.28889 - 8.5000 0.0000 0.5385 -1.89884 2.26686 -0.31880 0.53148 0.91669 -1.12328 -3.28889 - 8.5000 0.0000 0.6667 -1.07125 1.89386 -0.21449 0.45399 0.56322 -1.15261 -3.28889 - 8.5000 0.0000 0.8182 -0.45087 1.47718 -0.10387 0.33778 0.25577 -1.09832 -3.28889 - 8.5000 -0.0500 0.0526 -34.63132 7.47548 -0.25427 -0.30993 4.09400 -0.20087 -2.86802 - 8.5000 -0.0500 0.1111 -15.20159 3.80134 -0.34717 0.03175 3.10913 0.03509 -2.86802 - 8.5000 -0.0500 0.1765 -8.97990 3.32504 -0.40003 0.19826 2.53521 -0.31909 -2.86802 - 8.5000 -0.0500 0.2500 -5.86741 2.89852 -0.41646 0.41253 2.06003 -0.41535 -2.86802 - 8.5000 -0.0500 0.3333 -3.95418 2.57366 -0.39795 0.47269 1.62666 -0.67587 -2.86802 - 8.5000 -0.0500 0.4286 -2.63560 2.28774 -0.34839 0.48657 1.22491 -0.87592 -2.86802 - 8.5000 -0.0500 0.5385 -1.66896 1.98863 -0.27434 0.45735 0.85661 -0.99369 -2.86802 - 8.5000 -0.0500 0.6667 -0.94189 1.66237 -0.18457 0.39067 0.52625 -1.03569 -2.86802 - 8.5000 -0.0500 0.8182 -0.39654 1.29715 -0.08939 0.29067 0.23895 -0.99769 -2.86802 - 8.5000 -0.1000 0.0526 -30.60571 6.58281 -0.22076 -0.26908 3.84795 -0.00665 -2.52306 - 8.5000 -0.1000 0.1111 -13.44161 3.34719 -0.30141 0.02757 2.92053 0.18015 -2.52306 - 8.5000 -0.1000 0.1765 -7.94456 2.93124 -0.34731 0.17213 2.38053 -0.18319 -2.52306 - 8.5000 -0.1000 0.2500 -5.19374 2.55793 -0.36157 0.35816 1.93383 -0.28423 -2.52306 - 8.5000 -0.1000 0.3333 -3.50194 2.27351 -0.34550 0.41039 1.52670 -0.54891 -2.52306 - 8.5000 -0.1000 0.4286 -2.33523 2.02267 -0.30247 0.42244 1.14946 -0.75362 -2.52306 - 8.5000 -0.1000 0.5385 -1.47933 1.75946 -0.23818 0.39707 0.80374 -0.87966 -2.52306 - 8.5000 -0.1000 0.6667 -0.83515 1.47162 -0.16025 0.33918 0.49371 -0.93280 -2.52306 - 8.5000 -0.1000 0.8182 -0.35170 1.14875 -0.07760 0.25236 0.22416 -0.90915 -2.52306 - 8.5000 -0.1500 0.0526 -27.25220 5.84120 -0.19317 -0.23545 3.63031 0.16516 -2.23679 - 8.5000 -0.1500 0.1111 -11.97486 2.96990 -0.26374 0.02412 2.75370 0.30846 -2.23679 - 8.5000 -0.1500 0.1765 -7.08137 2.60381 -0.30390 0.15062 2.24371 -0.06298 -2.23679 - 8.5000 -0.1500 0.2500 -4.63183 2.27451 -0.31638 0.31340 1.82220 -0.16826 -2.23679 - 8.5000 -0.1500 0.3333 -3.12459 2.02355 -0.30232 0.35910 1.43829 -0.43661 -2.23679 - 8.5000 -0.1500 0.4286 -2.08450 1.80177 -0.26467 0.36964 1.08272 -0.64544 -2.23679 - 8.5000 -0.1500 0.5385 -1.32100 1.56839 -0.20841 0.34745 0.75697 -0.77879 -2.23679 - 8.5000 -0.1500 0.6667 -0.74600 1.31250 -0.14022 0.29679 0.46493 -0.84180 -2.23679 - 8.5000 -0.1500 0.8182 -0.31424 1.02493 -0.06791 0.22082 0.21107 -0.83083 -2.23679 - 8.5000 -0.2000 0.0526 -24.42831 5.21839 -0.17021 -0.20746 3.43687 0.31786 -1.99661 - 8.5000 -0.2000 0.1111 -10.73927 2.65305 -0.23239 0.02125 2.60542 0.42251 -1.99661 - 8.5000 -0.2000 0.1765 -6.35390 2.32859 -0.26778 0.13271 2.12211 0.04386 -1.99661 - 8.5000 -0.2000 0.2500 -4.15809 2.03611 -0.27877 0.27614 1.72298 -0.06517 -1.99661 - 8.5000 -0.2000 0.3333 -2.80632 1.81313 -0.26638 0.31641 1.35970 -0.33679 -1.99661 - 8.5000 -0.2000 0.4286 -1.87295 1.61570 -0.23320 0.32570 1.02340 -0.54929 -1.99661 - 8.5000 -0.2000 0.5385 -1.18737 1.40735 -0.18364 0.30615 0.71541 -0.68914 -1.99661 - 8.5000 -0.2000 0.6667 -0.67074 1.17834 -0.12355 0.26151 0.43935 -0.76091 -1.99661 - 8.5000 -0.2000 0.8182 -0.28261 0.92050 -0.05983 0.19457 0.19944 -0.76122 -1.99661 - 8.5000 -0.2500 0.0526 -22.02750 4.69027 -0.15091 -0.18394 3.26417 0.45419 -1.79314 - 8.5000 -0.2500 0.1111 -9.68838 2.38439 -0.20604 0.01884 2.47304 0.52433 -1.79314 - 8.5000 -0.2500 0.1765 -5.73494 2.09503 -0.23742 0.11767 2.01353 0.13925 -1.79314 - 8.5000 -0.2500 0.2500 -3.75485 1.83363 -0.24717 0.24484 1.63440 0.02686 -1.79314 - 8.5000 -0.2500 0.3333 -2.53531 1.63430 -0.23618 0.28054 1.28954 -0.24767 -1.79314 - 8.5000 -0.2500 0.4286 -1.69276 1.45746 -0.20677 0.28878 0.97044 -0.46345 -1.79314 - 8.5000 -0.2500 0.5385 -1.07350 1.27032 -0.16282 0.27144 0.67830 -0.60910 -1.79314 - 8.5000 -0.2500 0.6667 -0.60660 1.06414 -0.10954 0.23186 0.41651 -0.68869 -1.79314 - 8.5000 -0.2500 0.8182 -0.25565 0.83158 -0.05305 0.17251 0.18905 -0.69907 -1.79314 - 8.5000 -0.3000 0.0526 -19.96880 4.23857 -0.13456 -0.16401 3.10934 0.57641 -1.61926 - 8.5000 -0.3000 0.1111 -8.78690 2.15460 -0.18371 0.01680 2.35436 0.61561 -1.61926 - 8.5000 -0.3000 0.1765 -5.20376 1.89510 -0.21169 0.10492 1.91620 0.22477 -1.61926 - 8.5000 -0.3000 0.2500 -3.40866 1.66018 -0.22038 0.21830 1.55498 0.10937 -1.61926 - 8.5000 -0.3000 0.3333 -2.30255 1.48099 -0.21058 0.25014 1.22664 -0.16778 -1.61926 - 8.5000 -0.3000 0.4286 -1.53795 1.32173 -0.18436 0.25748 0.92296 -0.38649 -1.61926 - 8.5000 -0.3000 0.5385 -0.97565 1.15273 -0.14517 0.24202 0.64503 -0.53735 -1.61926 - 8.5000 -0.3000 0.6667 -0.55147 0.96609 -0.09767 0.20674 0.39604 -0.62395 -1.61926 - 8.5000 -0.3000 0.8182 -0.23247 0.75521 -0.04730 0.15381 0.17974 -0.64335 -1.61926 - 8.5000 -0.3500 0.0526 -18.18979 3.84921 -0.12058 -0.14698 2.97000 0.68640 -1.46949 - 8.5000 -0.3500 0.1111 -8.00759 1.95654 -0.16464 0.01506 2.24755 0.69776 -1.46949 - 8.5000 -0.3500 0.1765 -4.74439 1.72263 -0.18971 0.09402 1.82860 0.30173 -1.46949 - 8.5000 -0.3500 0.2500 -3.10915 1.51045 -0.19750 0.19563 1.48351 0.18362 -1.46949 - 8.5000 -0.3500 0.3333 -2.10112 1.34856 -0.18872 0.22416 1.17003 -0.09588 -1.46949 - 8.5000 -0.3500 0.4286 -1.40392 1.20440 -0.16521 0.23075 0.88023 -0.31724 -1.46949 - 8.5000 -0.3500 0.5385 -0.89092 1.05102 -0.13010 0.21689 0.61509 -0.47277 -1.46949 - 8.5000 -0.3500 0.6667 -0.50371 0.88126 -0.08753 0.18527 0.37761 -0.56568 -1.46949 - 8.5000 -0.3500 0.8182 -0.21238 0.68912 -0.04239 0.13784 0.17136 -0.59321 -1.46949 - 8.5000 -0.4000 0.0526 -16.64168 3.51122 -0.10856 -0.13232 2.84415 0.78574 -1.33958 - 8.5000 -0.4000 0.1111 -7.32919 1.78461 -0.14822 0.01356 2.15109 0.77196 -1.33958 - 8.5000 -0.4000 0.1765 -4.34436 1.57280 -0.17079 0.08465 1.74949 0.37124 -1.33958 - 8.5000 -0.4000 0.2500 -2.84823 1.38028 -0.17781 0.17613 1.41897 0.25069 -1.33958 - 8.5000 -0.4000 0.3333 -1.92557 1.23335 -0.16990 0.20182 1.11891 -0.03094 -1.33958 - 8.5000 -0.4000 0.4286 -1.28709 1.10227 -0.14874 0.20774 0.84164 -0.25469 -1.33958 - 8.5000 -0.4000 0.5385 -0.81703 0.96245 -0.11713 0.19527 0.58804 -0.41445 -1.33958 - 8.5000 -0.4000 0.6667 -0.46206 0.80736 -0.07880 0.16680 0.36097 -0.51306 -1.33958 - 8.5000 -0.4000 0.8182 -0.19486 0.63152 -0.03816 0.12410 0.16379 -0.54792 -1.33958 - 8.5000 -0.4500 0.0526 -15.28592 3.21594 -0.09815 -0.11964 2.73011 0.87577 -1.22617 - 8.5000 -0.4500 0.1111 -6.73487 1.63441 -0.13401 0.01226 2.06367 0.83919 -1.22617 - 8.5000 -0.4500 0.1765 -3.99377 1.44181 -0.15442 0.07653 1.67779 0.43423 -1.22617 - 8.5000 -0.4500 0.2500 -2.61948 1.26639 -0.16076 0.15924 1.36047 0.31146 -1.22617 - 8.5000 -0.4500 0.3333 -1.77161 1.13248 -0.15361 0.18247 1.07258 0.02790 -1.22617 - 8.5000 -0.4500 0.4286 -1.18459 1.01281 -0.13448 0.18782 0.80667 -0.19800 -1.22617 - 8.5000 -0.4500 0.5385 -0.75219 0.88483 -0.10590 0.17655 0.56354 -0.36159 -1.22617 - 8.5000 -0.4500 0.6667 -0.42550 0.74256 -0.07125 0.15081 0.34589 -0.46537 -1.22617 - 8.5000 -0.4500 0.8182 -0.17948 0.58101 -0.03450 0.11220 0.15694 -0.50688 -1.22617 - 8.5000 -0.5000 0.0526 -14.09171 2.95646 -0.08909 -0.10859 2.62644 0.95760 -1.12657 - 8.5000 -0.5000 0.1111 -6.21118 1.50243 -0.12164 0.01112 1.98421 0.90031 -1.12657 - 8.5000 -0.5000 0.1765 -3.68473 1.32662 -0.14016 0.06946 1.61262 0.49148 -1.12657 - 8.5000 -0.5000 0.2500 -2.41777 1.16617 -0.14591 0.14453 1.30730 0.36670 -1.12657 - 8.5000 -0.5000 0.3333 -1.63580 1.04366 -0.13943 0.16561 1.03046 0.08140 -1.12657 - 8.5000 -0.5000 0.4286 -1.09415 0.93398 -0.12206 0.17048 0.77488 -0.14647 -1.12657 - 8.5000 -0.5000 0.5385 -0.69496 0.81640 -0.09612 0.16024 0.54126 -0.31355 -1.12657 - 8.5000 -0.5000 0.6667 -0.39322 0.68542 -0.06467 0.13688 0.33218 -0.42202 -1.12657 - 8.5000 -0.5000 0.8182 -0.16590 0.53646 -0.03132 0.10184 0.15070 -0.46957 -1.12657 - 8.5000 -0.5500 0.0526 -13.03420 2.72722 -0.08115 -0.09891 2.53193 1.03221 -1.03864 - 8.5000 -0.5500 0.1111 -5.74728 1.38584 -0.11080 0.01013 1.91176 0.95604 -1.03864 - 8.5000 -0.5500 0.1765 -3.41088 1.22477 -0.12767 0.06327 1.55320 0.54369 -1.03864 - 8.5000 -0.5500 0.2500 -2.23895 1.07750 -0.13291 0.13165 1.25882 0.41707 -1.03864 - 8.5000 -0.5500 0.3333 -1.51537 0.96502 -0.12700 0.15086 0.99206 0.13017 -1.03864 - 8.5000 -0.5500 0.4286 -1.01392 0.86416 -0.11118 0.15528 0.74589 -0.09949 -1.03864 - 8.5000 -0.5500 0.5385 -0.64419 0.75576 -0.08755 0.14596 0.52095 -0.26975 -1.03864 - 8.5000 -0.5500 0.6667 -0.36458 0.63476 -0.05890 0.12468 0.31969 -0.38250 -1.03864 - 8.5000 -0.5500 0.8182 -0.15385 0.49695 -0.02853 0.09276 0.14502 -0.43556 -1.03864 - 8.5000 -0.6000 0.0526 -12.09314 2.52368 -0.07416 -0.09039 2.44552 1.10042 -0.96061 - 8.5000 -0.6000 0.1111 -5.33432 1.28232 -0.10126 0.00926 1.84552 1.00698 -0.96061 - 8.5000 -0.6000 0.1765 -3.16702 1.13428 -0.11667 0.05783 1.49888 0.59142 -0.96061 - 8.5000 -0.6000 0.2500 -2.07967 0.99867 -0.12146 0.12032 1.21450 0.46312 -0.96061 - 8.5000 -0.6000 0.3333 -1.40806 0.89507 -0.11607 0.13787 0.95696 0.17476 -0.96061 - 8.5000 -0.6000 0.4286 -0.94241 0.80201 -0.10161 0.14191 0.71939 -0.05654 -0.96061 - 8.5000 -0.6000 0.5385 -0.59892 0.70176 -0.08001 0.13339 0.50239 -0.22970 -0.96061 - 8.5000 -0.6000 0.6667 -0.33903 0.58964 -0.05383 0.11394 0.30826 -0.34637 -0.96061 - 8.5000 -0.6000 0.8182 -0.14309 0.46175 -0.02607 0.08478 0.13982 -0.40446 -0.96061 - 8.5000 -0.6500 0.0526 -11.25193 2.34215 -0.06798 -0.08286 2.36631 1.16295 -0.89105 - 8.5000 -0.6500 0.1111 -4.96505 1.19000 -0.09282 0.00849 1.78481 1.05368 -0.89105 - 8.5000 -0.6500 0.1765 -2.94888 1.05352 -0.10696 0.05301 1.44909 0.63516 -0.89105 - 8.5000 -0.6500 0.2500 -1.93714 0.92826 -0.11135 0.11030 1.17387 0.50533 -0.89105 - 8.5000 -0.6500 0.3333 -1.31200 0.83255 -0.10640 0.12638 0.92478 0.21563 -0.89105 - 8.5000 -0.6500 0.4286 -0.87839 0.74644 -0.09315 0.13009 0.69510 -0.01717 -0.89105 - 8.5000 -0.6500 0.5385 -0.55837 0.65345 -0.07335 0.12228 0.48537 -0.19299 -0.89105 - 8.5000 -0.6500 0.6667 -0.31615 0.54926 -0.04935 0.10445 0.29779 -0.31324 -0.89105 - 8.5000 -0.6500 0.8182 -0.13346 0.43024 -0.02390 0.07771 0.13506 -0.37596 -0.89105 - 8.5000 -0.7000 0.0526 -10.49681 2.17955 -0.06250 -0.07618 2.29353 1.22040 -0.82879 - 8.5000 -0.7000 0.1111 -4.63347 1.10731 -0.08533 0.00780 1.72902 1.09659 -0.82879 - 8.5000 -0.7000 0.1765 -2.75294 0.98113 -0.09833 0.04873 1.40333 0.67536 -0.82879 - 8.5000 -0.7000 0.2500 -1.80907 0.86512 -0.10236 0.10140 1.13654 0.54411 -0.82879 - 8.5000 -0.7000 0.3333 -1.22567 0.77645 -0.09781 0.11619 0.89521 0.25318 -0.82879 - 8.5000 -0.7000 0.4286 -0.82083 0.69654 -0.08563 0.11960 0.67279 0.01900 -0.82879 - 8.5000 -0.7000 0.5385 -0.52191 0.61006 -0.06743 0.11241 0.46973 -0.15926 -0.82879 - 8.5000 -0.7000 0.6667 -0.29557 0.51297 -0.04537 0.09603 0.28816 -0.28281 -0.82879 - 8.5000 -0.7000 0.8182 -0.12480 0.40192 -0.02197 0.07144 0.13068 -0.34977 -0.82879 - 8.5000 -0.7500 0.0526 -9.81635 2.03334 -0.05761 -0.07022 2.22649 1.27332 -0.77283 - 8.5000 -0.7500 0.1111 -4.33458 1.03296 -0.07866 0.00719 1.67763 1.13611 -0.77283 - 8.5000 -0.7500 0.1765 -2.57626 0.91600 -0.09063 0.04492 1.36119 0.71239 -0.77283 - 8.5000 -0.7500 0.2500 -1.69355 0.80827 -0.09435 0.09346 1.10216 0.57983 -0.77283 - 8.5000 -0.7500 0.3333 -1.14777 0.72591 -0.09016 0.10710 0.86798 0.28777 -0.77283 - 8.5000 -0.7500 0.4286 -0.76888 0.65156 -0.07893 0.11024 0.65223 0.05232 -0.77283 - 8.5000 -0.7500 0.5385 -0.48900 0.57093 -0.06216 0.10362 0.45532 -0.12819 -0.77283 - 8.5000 -0.7500 0.6667 -0.27699 0.48024 -0.04182 0.08851 0.27930 -0.25478 -0.77283 - 8.5000 -0.7500 0.8182 -0.11697 0.37636 -0.02025 0.06585 0.12665 -0.32565 -0.77283 - 8.5000 -0.8000 0.0526 -9.20094 1.90140 -0.05323 -0.06489 2.16462 1.32216 -0.72235 - 8.5000 -0.8000 0.1111 -4.06419 0.96587 -0.07268 0.00665 1.63021 1.17259 -0.72235 - 8.5000 -0.8000 0.1765 -2.41637 0.85718 -0.08375 0.04151 1.32229 0.74656 -0.72235 - 8.5000 -0.8000 0.2500 -1.58898 0.75689 -0.08719 0.08637 1.07042 0.61281 -0.72235 - 8.5000 -0.8000 0.3333 -1.07723 0.68021 -0.08331 0.09896 0.84284 0.31970 -0.72235 - 8.5000 -0.8000 0.4286 -0.72182 0.61088 -0.07294 0.10187 0.63326 0.08307 -0.72235 - 8.5000 -0.8000 0.5385 -0.45918 0.53552 -0.05744 0.09575 0.44203 -0.09952 -0.72235 - 8.5000 -0.8000 0.6667 -0.26015 0.45061 -0.03864 0.08179 0.27112 -0.22891 -0.72235 - 8.5000 -0.8000 0.8182 -0.10988 0.35323 -0.01871 0.06085 0.12293 -0.30338 -0.72235 - 9.0000 0.0000 0.0526 -39.73593 8.84637 -0.29615 -0.35800 4.39325 -0.42733 -3.28889 - 9.0000 0.0000 0.1111 -17.38488 4.45524 -0.40368 0.03894 3.33270 -0.13953 -3.28889 - 9.0000 0.0000 0.1765 -10.24640 3.85994 -0.46439 0.23172 2.71384 -0.48483 -3.28889 - 9.0000 0.0000 0.2500 -6.68187 3.34561 -0.48270 0.47936 2.20223 -0.57496 -3.28889 - 9.0000 0.0000 0.3333 -4.49504 2.95738 -0.46054 0.54814 1.73673 -0.82895 -3.28889 - 9.0000 0.0000 0.4286 -2.99116 2.61961 -0.40258 0.56331 1.30619 -1.02141 -3.28889 - 9.0000 0.0000 0.5385 -1.89122 2.27066 -0.31657 0.52873 0.91236 -1.12729 -3.28889 - 9.0000 0.0000 0.6667 -1.06583 1.89394 -0.21269 0.45108 0.55984 -1.15453 -3.28889 - 9.0000 0.0000 0.8182 -0.44815 1.47538 -0.10286 0.33525 0.25390 -1.09827 -3.28889 - 9.0000 -0.0500 0.0526 -34.81773 7.72330 -0.25484 -0.30807 4.11234 -0.20551 -2.86802 - 9.0000 -0.0500 0.1111 -15.24149 3.88934 -0.34738 0.03351 3.11775 0.02638 -2.86802 - 9.0000 -0.0500 0.1765 -8.98820 3.37365 -0.39962 0.19940 2.53786 -0.32946 -2.86802 - 9.0000 -0.0500 0.2500 -5.86468 2.92725 -0.41538 0.41250 2.05889 -0.42521 -2.86802 - 9.0000 -0.0500 0.3333 -3.94737 2.59021 -0.39631 0.47169 1.62336 -0.68414 -2.86802 - 9.0000 -0.0500 0.4286 -2.62796 2.29640 -0.34644 0.48475 1.22074 -0.88210 -2.86802 - 9.0000 -0.0500 0.5385 -1.66226 1.99196 -0.27241 0.45499 0.85256 -0.99754 -2.86802 - 9.0000 -0.0500 0.6667 -0.93712 1.66243 -0.18302 0.38817 0.52308 -1.03757 -2.86802 - 9.0000 -0.0500 0.8182 -0.39414 1.29556 -0.08852 0.28849 0.23721 -0.99770 -2.86802 - 9.0000 -0.1000 0.0526 -30.77037 6.80160 -0.22126 -0.26747 3.86516 -0.01032 -2.52306 - 9.0000 -0.1000 0.1111 -13.47688 3.42492 -0.30159 0.02909 2.92860 0.17237 -2.52306 - 9.0000 -0.1000 0.1765 -7.95191 2.97421 -0.34695 0.17312 2.38301 -0.19274 -2.52306 - 9.0000 -0.1000 0.2500 -5.19132 2.58334 -0.36063 0.35813 1.93275 -0.29345 -2.52306 - 9.0000 -0.1000 0.3333 -3.49591 2.28815 -0.34407 0.40952 1.52360 -0.55672 -2.52306 - 9.0000 -0.1000 0.4286 -2.32844 2.03033 -0.30078 0.42086 1.14554 -0.75951 -2.52306 - 9.0000 -0.1000 0.5385 -1.47338 1.76240 -0.23651 0.39502 0.79994 -0.88338 -2.52306 - 9.0000 -0.1000 0.6667 -0.83091 1.47166 -0.15890 0.33701 0.49074 -0.93465 -2.52306 - 9.0000 -0.1000 0.8182 -0.34957 1.14734 -0.07685 0.25047 0.22252 -0.90922 -2.52306 - 9.0000 -0.1500 0.0526 -27.39875 6.03584 -0.19360 -0.23404 3.64651 0.16233 -2.23679 - 9.0000 -0.1500 0.1111 -12.00628 3.03908 -0.26390 0.02546 2.76130 0.30150 -2.23679 - 9.0000 -0.1500 0.1765 -7.08791 2.64207 -0.30359 0.15149 2.24603 -0.07180 -2.23679 - 9.0000 -0.1500 0.2500 -4.62968 2.29715 -0.31556 0.31337 1.82117 -0.17689 -2.23679 - 9.0000 -0.1500 0.3333 -3.11920 2.03660 -0.30107 0.35834 1.43536 -0.44401 -2.23679 - 9.0000 -0.1500 0.4286 -2.07844 1.80860 -0.26318 0.36826 1.07903 -0.65108 -2.23679 - 9.0000 -0.1500 0.5385 -1.31568 1.57100 -0.20695 0.34565 0.75340 -0.78239 -2.23679 - 9.0000 -0.1500 0.6667 -0.74221 1.31254 -0.13904 0.29489 0.46214 -0.84362 -2.23679 - 9.0000 -0.1500 0.8182 -0.31234 1.02366 -0.06725 0.21917 0.20953 -0.83094 -2.23679 - 9.0000 -0.2000 0.0526 -24.55962 5.39270 -0.17059 -0.20622 3.45217 0.31579 -1.99661 - 9.0000 -0.2000 0.1111 -10.76743 2.71503 -0.23253 0.02243 2.61259 0.41628 -1.99661 - 9.0000 -0.2000 0.1765 -6.35978 2.36289 -0.26750 0.13348 2.12429 0.03569 -1.99661 - 9.0000 -0.2000 0.2500 -4.15615 2.05641 -0.27805 0.27612 1.72200 -0.07330 -1.99661 - 9.0000 -0.2000 0.3333 -2.80147 1.82485 -0.26528 0.31574 1.35693 -0.34382 -1.99661 - 9.0000 -0.2000 0.4286 -1.86750 1.62183 -0.23190 0.32448 1.01991 -0.55470 -1.99661 - 9.0000 -0.2000 0.5385 -1.18258 1.40969 -0.18235 0.30456 0.71203 -0.69264 -1.99661 - 9.0000 -0.2000 0.6667 -0.66733 1.17837 -0.12251 0.25983 0.43671 -0.76270 -1.99661 - 9.0000 -0.2000 0.8182 -0.28090 0.91935 -0.05925 0.19311 0.19798 -0.76137 -1.99661 - 9.0000 -0.2500 0.0526 -22.14585 4.84731 -0.15125 -0.18284 3.27867 0.45279 -1.79314 - 9.0000 -0.2500 0.1111 -9.71378 2.44025 -0.20617 0.01989 2.47982 0.51875 -1.79314 - 9.0000 -0.2500 0.1765 -5.74024 2.12596 -0.23718 0.11835 2.01559 0.13166 -1.79314 - 9.0000 -0.2500 0.2500 -3.75309 1.85195 -0.24653 0.24482 1.63346 0.01920 -1.79314 - 9.0000 -0.2500 0.3333 -2.53093 1.64487 -0.23521 0.27995 1.28691 -0.25438 -1.79314 - 9.0000 -0.2500 0.4286 -1.68783 1.46300 -0.20561 0.28770 0.96712 -0.46865 -1.79314 - 9.0000 -0.2500 0.5385 -1.06917 1.27244 -0.16168 0.27004 0.67509 -0.61250 -1.79314 - 9.0000 -0.2500 0.6667 -0.60352 1.06416 -0.10862 0.23038 0.41401 -0.69046 -1.79314 - 9.0000 -0.2500 0.8182 -0.25410 0.83053 -0.05253 0.17122 0.18767 -0.69926 -1.79314 - 9.0000 -0.3000 0.0526 -20.07605 4.38081 -0.13486 -0.16302 3.12312 0.57562 -1.61926 - 9.0000 -0.3000 0.1111 -8.80993 2.20522 -0.18382 0.01773 2.36080 0.61062 -1.61926 - 9.0000 -0.3000 0.1765 -5.20857 1.92315 -0.21147 0.10552 1.91815 0.21769 -1.61926 - 9.0000 -0.3000 0.2500 -3.40706 1.67681 -0.21981 0.21829 1.55409 0.10211 -1.61926 - 9.0000 -0.3000 0.3333 -2.29857 1.49059 -0.20972 0.24961 1.22413 -0.17420 -1.61926 - 9.0000 -0.3000 0.4286 -1.53346 1.32675 -0.18333 0.25652 0.91981 -0.39151 -1.61926 - 9.0000 -0.3000 0.5385 -0.97172 1.15464 -0.14416 0.24077 0.64198 -0.54066 -1.61926 - 9.0000 -0.3000 0.6667 -0.54866 0.96611 -0.09685 0.20541 0.39366 -0.62569 -1.61926 - 9.0000 -0.3000 0.8182 -0.23105 0.75425 -0.04684 0.15266 0.17843 -0.64358 -1.61926 - 9.0000 -0.3500 0.0526 -18.28744 3.97868 -0.12085 -0.14610 2.98314 0.68615 -1.46949 - 9.0000 -0.3500 0.1111 -8.02858 2.00263 -0.16473 0.01589 2.25368 0.69330 -1.46949 - 9.0000 -0.3500 0.1765 -4.74878 1.74818 -0.18951 0.09456 1.83045 0.29512 -1.46949 - 9.0000 -0.3500 0.2500 -3.10770 1.52560 -0.19698 0.19562 1.48266 0.17673 -1.46949 - 9.0000 -0.3500 0.3333 -2.09748 1.35731 -0.18794 0.22369 1.16764 -0.10203 -1.46949 - 9.0000 -0.3500 0.4286 -1.39983 1.20898 -0.16429 0.22988 0.87722 -0.32209 -1.46949 - 9.0000 -0.3500 0.5385 -0.88732 1.05277 -0.12919 0.21577 0.61218 -0.47601 -1.46949 - 9.0000 -0.3500 0.6667 -0.50114 0.88127 -0.08679 0.18408 0.37534 -0.56741 -1.46949 - 9.0000 -0.3500 0.8182 -0.21109 0.68824 -0.04198 0.13681 0.17011 -0.59347 -1.46949 - 9.0000 -0.4000 0.0526 -16.73098 3.62958 -0.10881 -0.13153 2.85671 0.78599 -1.33958 - 9.0000 -0.4000 0.1111 -7.34840 1.82676 -0.14831 0.01431 2.15694 0.76797 -1.33958 - 9.0000 -0.4000 0.1765 -4.34837 1.59618 -0.17062 0.08514 1.75125 0.36505 -1.33958 - 9.0000 -0.4000 0.2500 -2.84690 1.39415 -0.17735 0.17612 1.41814 0.24413 -1.33958 - 9.0000 -0.4000 0.3333 -1.92223 1.24136 -0.16920 0.20139 1.11661 -0.03686 -1.33958 - 9.0000 -0.4000 0.4286 -1.28333 1.10647 -0.14791 0.20696 0.83876 -0.25939 -1.33958 - 9.0000 -0.4000 0.5385 -0.81373 0.96405 -0.11631 0.19426 0.58526 -0.41761 -1.33958 - 9.0000 -0.4000 0.6667 -0.45970 0.80736 -0.07814 0.16573 0.35880 -0.51477 -1.33958 - 9.0000 -0.4000 0.8182 -0.19368 0.63072 -0.03779 0.12317 0.16260 -0.54821 -1.33958 - 9.0000 -0.4500 0.0526 -15.36792 3.32457 -0.09837 -0.11892 2.74214 0.87646 -1.22617 - 9.0000 -0.4500 0.1111 -6.75252 1.67312 -0.13409 0.01294 2.06927 0.83563 -1.22617 - 9.0000 -0.4500 0.1765 -3.99746 1.46329 -0.15426 0.07697 1.67947 0.42842 -1.22617 - 9.0000 -0.4500 0.2500 -2.61825 1.27914 -0.16034 0.15923 1.35967 0.30520 -1.22617 - 9.0000 -0.4500 0.3333 -1.76854 1.13985 -0.15298 0.18208 1.07038 0.02220 -1.22617 - 9.0000 -0.4500 0.4286 -1.18113 1.01666 -0.13373 0.18712 0.80391 -0.20257 -1.22617 - 9.0000 -0.4500 0.5385 -0.74915 0.88629 -0.10516 0.17563 0.56087 -0.36470 -1.22617 - 9.0000 -0.4500 0.6667 -0.42332 0.74256 -0.07065 0.14984 0.34381 -0.46707 -1.22617 - 9.0000 -0.4500 0.8182 -0.17839 0.58027 -0.03417 0.11136 0.15579 -0.50719 -1.22617 - 9.0000 -0.5000 0.0526 -14.16729 3.05653 -0.08929 -0.10794 2.63799 0.95870 -1.12657 - 9.0000 -0.5000 0.1111 -6.22745 1.53810 -0.12171 0.01174 1.98958 0.89714 -1.12657 - 9.0000 -0.5000 0.1765 -3.68814 1.34642 -0.14001 0.06986 1.61423 0.48603 -1.12657 - 9.0000 -0.5000 0.2500 -2.41663 1.17793 -0.14553 0.14452 1.30653 0.36072 -1.12657 - 9.0000 -0.5000 0.3333 -1.63296 1.05045 -0.13885 0.16526 1.02834 0.07589 -1.12657 - 9.0000 -0.5000 0.4286 -1.09095 0.93754 -0.12138 0.16984 0.77222 -0.15092 -1.12657 - 9.0000 -0.5000 0.5385 -0.69215 0.81775 -0.09544 0.15941 0.53870 -0.31659 -1.12657 - 9.0000 -0.5000 0.6667 -0.39121 0.68542 -0.06412 0.13600 0.33019 -0.42370 -1.12657 - 9.0000 -0.5000 0.8182 -0.16489 0.53577 -0.03101 0.10108 0.14960 -0.46991 -1.12657 - 9.0000 -0.5500 0.0526 -13.10408 2.81971 -0.08133 -0.09832 2.54304 1.03368 -1.03864 - 9.0000 -0.5500 0.1111 -5.76233 1.41882 -0.11086 0.01069 1.91692 0.95322 -1.03864 - 9.0000 -0.5500 0.1765 -3.41403 1.24309 -0.12754 0.06364 1.55474 0.53855 -1.03864 - 9.0000 -0.5500 0.2500 -2.23790 1.08838 -0.13256 0.13165 1.25807 0.41134 -1.03864 - 9.0000 -0.5500 0.3333 -1.51274 0.97132 -0.12648 0.15054 0.99002 0.12484 -1.03864 - 9.0000 -0.5500 0.4286 -1.01096 0.86745 -0.11056 0.15470 0.74334 -0.10383 -1.03864 - 9.0000 -0.5500 0.5385 -0.64158 0.75701 -0.08694 0.14520 0.51849 -0.27274 -1.03864 - 9.0000 -0.5500 0.6667 -0.36271 0.63476 -0.05841 0.12388 0.31776 -0.38417 -1.03864 - 9.0000 -0.5500 0.8182 -0.15291 0.49631 -0.02825 0.09207 0.14396 -0.43591 -1.03864 - 9.0000 -0.6000 0.0526 -12.15795 2.60944 -0.07433 -0.08985 2.45623 1.10223 -0.96061 - 9.0000 -0.6000 0.1111 -5.34829 1.31291 -0.10132 0.00977 1.85049 1.00450 -0.96061 - 9.0000 -0.6000 0.1765 -3.16994 1.15128 -0.11655 0.05816 1.50035 0.58656 -0.96061 - 9.0000 -0.6000 0.2500 -2.07869 1.00877 -0.12115 0.12031 1.21377 0.45762 -0.96061 - 9.0000 -0.6000 0.3333 -1.40561 0.90091 -0.11559 0.13757 0.95499 0.16959 -0.96061 - 9.0000 -0.6000 0.4286 -0.93966 0.80507 -0.10104 0.14138 0.71693 -0.06078 -0.96061 - 9.0000 -0.6000 0.5385 -0.59649 0.70292 -0.07945 0.13270 0.50001 -0.23264 -0.96061 - 9.0000 -0.6000 0.6667 -0.33730 0.58963 -0.05338 0.11321 0.30641 -0.34802 -0.96061 - 9.0000 -0.6000 0.8182 -0.14222 0.46115 -0.02582 0.08414 0.13880 -0.40484 -0.96061 - 9.0000 -0.6500 0.0526 -11.31221 2.42189 -0.06814 -0.08237 2.37665 1.16506 -0.89105 - 9.0000 -0.6500 0.1111 -4.97806 1.21845 -0.09288 0.00896 1.78960 1.05149 -0.89105 - 9.0000 -0.6500 0.1765 -2.95161 1.06934 -0.10685 0.05331 1.45050 0.63058 -0.89105 - 9.0000 -0.6500 0.2500 -1.93623 0.93767 -0.11106 0.11029 1.17316 0.50004 -0.89105 - 9.0000 -0.6500 0.3333 -1.30973 0.83799 -0.10596 0.12611 0.92287 0.21061 -0.89105 - 9.0000 -0.6500 0.4286 -0.87582 0.74928 -0.09263 0.12961 0.69272 -0.02131 -0.89105 - 9.0000 -0.6500 0.5385 -0.55611 0.65453 -0.07283 0.12165 0.48307 -0.19589 -0.89105 - 9.0000 -0.6500 0.6667 -0.31453 0.54925 -0.04893 0.10378 0.29599 -0.31489 -0.89105 - 9.0000 -0.6500 0.8182 -0.13265 0.42968 -0.02367 0.07713 0.13407 -0.37635 -0.89105 - 9.0000 -0.7000 0.0526 -10.55303 2.25389 -0.06264 -0.07572 2.30354 1.22280 -0.82879 - 9.0000 -0.7000 0.1111 -4.64561 1.13384 -0.08538 0.00824 1.73365 1.09468 -0.82879 - 9.0000 -0.7000 0.1765 -2.75549 0.99589 -0.09823 0.04901 1.40470 0.67102 -0.82879 - 9.0000 -0.7000 0.2500 -1.80822 0.87390 -0.10210 0.10139 1.13585 0.53901 -0.82879 - 9.0000 -0.7000 0.3333 -1.22354 0.78153 -0.09741 0.11594 0.89337 0.24831 -0.82879 - 9.0000 -0.7000 0.4286 -0.81842 0.69920 -0.08515 0.11915 0.67048 0.01495 -0.82879 - 9.0000 -0.7000 0.5385 -0.51980 0.61106 -0.06696 0.11183 0.46750 -0.16212 -0.82879 - 9.0000 -0.7000 0.6667 -0.29406 0.51296 -0.04499 0.09541 0.28643 -0.28445 -0.82879 - 9.0000 -0.7000 0.8182 -0.12403 0.40139 -0.02176 0.07091 0.12973 -0.35018 -0.82879 - 9.0000 -0.7500 0.0526 -9.86891 2.10282 -0.05774 -0.06980 2.23619 1.27598 -0.77283 - 9.0000 -0.7500 0.1111 -4.34593 1.05777 -0.07870 0.00759 1.68212 1.13445 -0.77283 - 9.0000 -0.7500 0.1765 -2.57865 0.92981 -0.09054 0.04518 1.36251 0.70827 -0.77283 - 9.0000 -0.7500 0.2500 -1.69276 0.81648 -0.09411 0.09346 1.10149 0.57491 -0.77283 - 9.0000 -0.7500 0.3333 -1.14577 0.73066 -0.08979 0.10687 0.86619 0.28302 -0.77283 - 9.0000 -0.7500 0.4286 -0.76662 0.65405 -0.07849 0.10983 0.64999 0.04835 -0.77283 - 9.0000 -0.7500 0.5385 -0.48702 0.57187 -0.06172 0.10308 0.45316 -0.13102 -0.77283 - 9.0000 -0.7500 0.6667 -0.27557 0.48023 -0.04147 0.08794 0.27762 -0.25641 -0.77283 - 9.0000 -0.7500 0.8182 -0.11625 0.37587 -0.02005 0.06536 0.12573 -0.32607 -0.77283 - 9.0000 -0.8000 0.0526 -9.25019 1.96648 -0.05335 -0.06450 2.17403 1.32506 -0.72235 - 9.0000 -0.8000 0.1111 -4.07483 0.98911 -0.07273 0.00702 1.63455 1.17116 -0.72235 - 9.0000 -0.8000 0.1765 -2.41861 0.87012 -0.08366 0.04175 1.32357 0.74265 -0.72235 - 9.0000 -0.8000 0.2500 -1.58823 0.76460 -0.08696 0.08636 1.06977 0.60805 -0.72235 - 9.0000 -0.8000 0.3333 -1.07536 0.68467 -0.08297 0.09875 0.84110 0.31507 -0.72235 - 9.0000 -0.8000 0.4286 -0.71970 0.61321 -0.07253 0.10149 0.63108 0.07917 -0.72235 - 9.0000 -0.8000 0.5385 -0.45732 0.53640 -0.05703 0.09526 0.43993 -0.10231 -0.72235 - 9.0000 -0.8000 0.6667 -0.25882 0.45059 -0.03832 0.08127 0.26948 -0.23053 -0.72235 - 9.0000 -0.8000 0.8182 -0.10921 0.35276 -0.01853 0.06040 0.12204 -0.30382 -0.72235 - diff --git a/src/programs/Simulation/gen_omega_3pi/SConscript b/src/programs/Simulation/gen_omega_3pi/SConscript deleted file mode 100644 index 25c0cf7bc0..0000000000 --- a/src/programs/Simulation/gen_omega_3pi/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cc b/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cc deleted file mode 100644 index d8a9ea7d6b..0000000000 --- a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cc +++ /dev/null @@ -1,318 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/ThreePiAnglesSchilling.h" -#include "AMPTOOLS_AMPS/BreitWigner3body.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYZP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.4; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 7.5; - double beamHighE = 9.5; - - int runNum = 9001; - int seed = 0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_omega_3pi -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - TRandom3* gRandom = new TRandom3(); - gRandom->SetSeed(seed); - // set seed for drand48() in amptools as well - srand48(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( ThreePiAnglesSchilling() ); - AmpToolsInterface::registerAmplitude( BreitWigner3body() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass - GammaPToXYZP resProd( lowMass, highMass, 0.140, 0.140, 0.135, type , beamMaxE, beamPeakE, beamLowE, beamHighE ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 0.783, 0.008, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( PiPlus ); - pTypes.push_back( PiMinus ); - pTypes.push_back( Pi0 ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_omega_3pi_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass; 3#pi Invariant mass [GeV];", 180, lowMass, highMass ); - //TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - //massW->Sumw2(); - //TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - //TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - TH2F* dalitz = new TH2F( "dalitz", "Dalitz plot; M^{2} #pi^{+}#pi^{0}; M^{2} #pi^{-}#pi^{0}", 100, 0., 0.75 , 100, 0., 0.75 ); - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos(#theta) vs. #Psi;#Psi; cos(#theta)", 180, -3.14, 3.14, 100, -1, 1); - TH2F* CosTheta_VsE = new TH2F( "CosTheta_VsE", "cos(#theta) vs. E_{#gamma}; E_{#gamma} [GeV];cos(#theta)", 100, 0.0, 12.0, 100, -1, 1); - TH2F* Psi_VsE = new TH2F( "Psi_VsE", "#Psi vs. E_{#gamma};E_{#gamma} [GeV];#psi", 100, 0.0, 12.0, 180, -3.14, 3.14); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) + - evt->particle( 4 ) ); - - //double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - //massW->Fill( resonance.M(), genWeight ); - - //intenW->Fill( weightedInten ); - //intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - TLorentzVector p2 = evt->particle ( 3 ); - TLorentzVector p3 = evt->particle ( 4 ); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - TLorentzVector p2_res = resonanceBoost * p2; - TLorentzVector p3_res = resonanceBoost * p3; - - TVector3 z = -recoil_res.Vect().Unit(); - TVector3 y = beam_res.Vect().Cross(z).Unit(); - TVector3 x = y.Cross(z).Unit(); - - TVector3 norm = p1_res.Vect().Cross(p2_res.Vect()).Unit(); - TVector3 angles( norm.Dot(x), - norm.Dot(y), - norm.Dot(z) ); - - GDouble CosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - GDouble Phi = recoil.Vect().Phi(); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - dalitz->Fill((p1_res+p3_res).M2(), (p2_res+p3_res).M2()); - CosTheta_psi->Fill( psi, CosTheta); - CosTheta_VsE->Fill(beam.E(), CosTheta); - Psi_VsE->Fill(beam.E(), psi); - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - if(eventCounter >= nEvents) break; - } - } - else{ - mass->Fill( resonance.M() ); - //massW->Fill( resonance.M(), genWeight ); - - //intenW->Fill( weightedInten ); - //intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - //massW->Write(); - //intenW->Write(); - //intenWVsM->Write(); - CosTheta_psi->Write(); - CosTheta_VsE->Write(); - Psi_VsE->Write(); - dalitz->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cfg b/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cfg deleted file mode 100644 index ca5afeadfa..0000000000 --- a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi.cfg +++ /dev/null @@ -1,52 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit threepi - -reaction Pi+Pi-Pi0 gamma p Pi+ Pi- Pi0 - -# consider just x polarized amplitudes -sum Pi+Pi-Pi0 xpol - -amplitude Pi+Pi-Pi0::xpol::omegaS ThreePiAnglesSchilling 0.0 0.0 0.0 0.0 0.0 0.0 0.4 0.0 -0.2 -amplitude Pi+Pi-Pi0::xpol::omegaS BreitWigner3body 0.783 0.008 234 - -initialize Pi+Pi-Pi0::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi_flat.cfg b/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi_flat.cfg deleted file mode 100644 index abd69f5008..0000000000 --- a/src/programs/Simulation/gen_omega_3pi/gen_omega_3pi_flat.cfg +++ /dev/null @@ -1,51 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit threepi - -reaction Pi+Pi-Pi0 gamma p Pi+ Pi- Pi0 - -# consider just x polarized amplitudes -sum Pi+Pi-Pi0 xpol - -amplitude Pi+Pi-Pi0::xpol::omegaS BreitWigner3body 0.783 0.008 234 - -initialize Pi+Pi-Pi0::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_omega_radiative/SConscript b/src/programs/Simulation/gen_omega_radiative/SConscript deleted file mode 100644 index 25c0cf7bc0..0000000000 --- a/src/programs/Simulation/gen_omega_radiative/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_omega_radiative/gen_omega_3pi.cfg b/src/programs/Simulation/gen_omega_radiative/gen_omega_3pi.cfg deleted file mode 100644 index ca5afeadfa..0000000000 --- a/src/programs/Simulation/gen_omega_radiative/gen_omega_3pi.cfg +++ /dev/null @@ -1,52 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit threepi - -reaction Pi+Pi-Pi0 gamma p Pi+ Pi- Pi0 - -# consider just x polarized amplitudes -sum Pi+Pi-Pi0 xpol - -amplitude Pi+Pi-Pi0::xpol::omegaS ThreePiAnglesSchilling 0.0 0.0 0.0 0.0 0.0 0.0 0.4 0.0 -0.2 -amplitude Pi+Pi-Pi0::xpol::omegaS BreitWigner3body 0.783 0.008 234 - -initialize Pi+Pi-Pi0::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative.cc b/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative.cc deleted file mode 100644 index ba5ac06ec1..0000000000 --- a/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative.cc +++ /dev/null @@ -1,311 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/TwoPiAnglesRadiative.h" -#include "AMPTOOLS_AMPS/BreitWigner.h" - -#include "AMPTOOLS_MCGEN/ProductionMechanism.h" -#include "AMPTOOLS_MCGEN/GammaPToXYP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - // default upper and lower bounds - double lowMass = 0.4; - double highMass = 2.0; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 7.5; - double beamHighE = 9.5; - - int runNum = 10000; - int seed = 0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-l"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else lowMass = atof( argv[++i] ); } - if (arg == "-u"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else highMass = atof( argv[++i] ); } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -l \t Low edge of mass range (GeV) [optional]" << endl; - cout << "\t -u \t Upper edge of mass range (GeV) [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_omega_radiative -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - TRandom3* gRandom = new TRandom3(); - gRandom->SetSeed(seed); - // set seed for drand48() in amptools as well - srand48(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( TwoPiAnglesRadiative() ); - AmpToolsInterface::registerAmplitude( BreitWigner() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - ProductionMechanism::Type type = - ( genFlat ? ProductionMechanism::kFlat : ProductionMechanism::kResonant ); - - // generate over a range of mass - GammaPToXYP resProd( lowMass, highMass, 0.135, 0.0, beamMaxE, beamPeakE, beamLowE, beamHighE, type ); - - // seed the distribution with a sum of noninterfering Breit-Wigners - // we can easily compute the PDF for this and divide by that when - // doing accept/reject -- improves efficiency if seeds are picked well - - if( !genFlat ){ - - // the lines below should be tailored by the user for the particular desired - // set of amplitudes -- doing so will improve efficiency. Leaving as is - // won't make MC incorrect, it just won't be as fast as it could be - - resProd.addResonance( 0.783, 0.008, 1.0 ); - } - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( Pi0 ); - pTypes.push_back( Gamma ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_omega_radiative_diagnostic.root", "recreate" ); - - TH1F* mass = new TH1F( "M", "Resonance Mass; 3#pi Invariant mass [GeV];", 180, lowMass, highMass ); - //TH1F* massW = new TH1F( "M_W", "Weighted Resonance Mass", 180, lowMass, highMass ); - //massW->Sumw2(); - //TH1F* intenW = new TH1F( "intenW", "True PDF / Gen. PDF", 1000, 0, 100 ); - //TH2F* intenWVsM = new TH2F( "intenWVsM", "Ratio vs. M", 100, lowMass, highMass, 1000, 0, 10 ); - TH2F* CosTheta_psi = new TH2F( "CosTheta_psi", "cos(#theta) vs. #Psi;#Psi; cos(#theta)", 180, -3.14, 3.14, 100, -1, 1); - TH2F* CosTheta_VsE = new TH2F( "CosTheta_VsE", "cos(#theta) vs. E_{#gamma}; E_{#gamma} [GeV];cos(#theta)", 100, 0.0, 12.0, 100, -1, 1); - TH2F* Psi_VsE = new TH2F( "Psi_VsE", "#Psi vs. E_{#gamma};E_{#gamma} [GeV];#psi", 100, 0.0, 12.0, 180, -3.14, 3.14); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = resProd.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - TLorentzVector resonance( evt->particle( 2 ) + - evt->particle( 3 ) ); - - //double genWeight = evt->weight(); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - mass->Fill( resonance.M() ); - //massW->Fill( resonance.M(), genWeight ); - - //intenW->Fill( weightedInten ); - //intenWVsM->Fill( resonance.M(), weightedInten ); - - // calculate angular variables - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - TLorentzVector p2 = evt->particle ( 3 ); - - TLorentzRotation resonanceBoost( -resonance.BoostVector() ); - - TLorentzVector beam_res = resonanceBoost * beam; - TLorentzVector recoil_res = resonanceBoost * recoil; - TLorentzVector p1_res = resonanceBoost * p1; - TLorentzVector p2_res = resonanceBoost * p2; - - TVector3 z = -recoil_res.Vect().Unit(); - TVector3 y = beam_res.Vect().Cross(z).Unit(); - TVector3 x = y.Cross(z).Unit(); - - TVector3 norm = p1_res.Vect(); - TVector3 angles( norm.Dot(x), - norm.Dot(y), - norm.Dot(z) ); - - GDouble CosTheta = angles.CosTheta(); - - GDouble phi = angles.Phi(); - GDouble Phi = recoil.Vect().Phi(); - - GDouble psi = phi - Phi; - if(psi < -1*PI) psi += 2*PI; - if(psi > PI) psi -= 2*PI; - CosTheta_psi->Fill( psi, CosTheta); - CosTheta_VsE->Fill(beam.E(), CosTheta); - Psi_VsE->Fill(beam.E(), psi); - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - if(eventCounter >= nEvents) break; - } - } - else{ - mass->Fill( resonance.M() ); - //massW->Fill( resonance.M(), genWeight ); - - //intenW->Fill( weightedInten ); - //intenWVsM->Fill( resonance.M(), weightedInten ); - TLorentzVector recoil = evt->particle ( 1 ); - - ++eventCounter; - - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - mass->Write(); - //massW->Write(); - //intenW->Write(); - //intenWVsM->Write(); - CosTheta_psi->Write(); - CosTheta_VsE->Write(); - Psi_VsE->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative_flat.cfg b/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative_flat.cfg deleted file mode 100644 index 736d280f9d..0000000000 --- a/src/programs/Simulation/gen_omega_radiative/gen_omega_radiative_flat.cfg +++ /dev/null @@ -1,51 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -fit radiative - -reaction Pi0Gamma gamma p Pi0 gamma - -# consider just x polarized amplitudes -sum Pi0Gamma xpol - -amplitude Pi0Gamma::xpol::omegaS BreitWigner 0.783 0.008 1 2 3 - -initialize Pi0Gamma::xpol::omegaS cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_pi0/SConscript b/src/programs/Simulation/gen_pi0/SConscript deleted file mode 100644 index 1b16593a61..0000000000 --- a/src/programs/Simulation/gen_pi0/SConscript +++ /dev/null @@ -1,22 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') - -# Verify AMPTOOLS environment variable is set -if os.getenv('AMPTOOLS', 'nada')!='nada' and os.getenv('CERN', 'nada')!='nada': - - env = env.Clone() - - AMPTOOLS_LIBS = "AMPTOOLS_AMPS AMPTOOLS_DATAIO AMPTOOLS_MCGEN" - env.AppendUnique(LIBS = AMPTOOLS_LIBS.split()) - - sbms.AddHDDM(env) - sbms.AddROOT(env) - sbms.AddAmpTools(env) - sbms.AddCERNLIB(env) - - sbms.executable(env) - diff --git a/src/programs/Simulation/gen_pi0/gen_pi0.cc b/src/programs/Simulation/gen_pi0/gen_pi0.cc deleted file mode 100644 index 6116d16d2a..0000000000 --- a/src/programs/Simulation/gen_pi0/gen_pi0.cc +++ /dev/null @@ -1,235 +0,0 @@ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include "particleType.h" - -#include "AMPTOOLS_DATAIO/ROOTDataWriter.h" -#include "AMPTOOLS_DATAIO/HDDMDataWriter.h" - -#include "AMPTOOLS_AMPS/Pi0Regge.h" -#include "AMPTOOLS_AMPS/Pi0SAID.h" - -#include "AMPTOOLS_MCGEN/GammaPToXP.h" - -#include "IUAmpTools/AmpToolsInterface.h" -#include "IUAmpTools/ConfigFileParser.h" - -#include "TH1F.h" -#include "TH2F.h" -#include "TFile.h" -#include "TLorentzVector.h" -#include "TLorentzRotation.h" -#include "TRandom3.h" - -using std::complex; -using namespace std; - -int main( int argc, char* argv[] ){ - - string configfile(""); - string outname(""); - string hddmname(""); - - bool diag = false; - bool genFlat = false; - - double beamMaxE = 12.0; - double beamPeakE = 9.0; - double beamLowE = 0.5; - double beamHighE = 12.0; - - int runNum = 9001; - int seed = 0; - - int nEvents = 10000; - int batchSize = 10000; - - //parse command line: - for (int i = 1; i < argc; i++){ - - string arg(argv[i]); - - if (arg == "-c"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else configfile = argv[++i]; } - if (arg == "-o"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else outname = argv[++i]; } - if (arg == "-hd"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else hddmname = argv[++i]; } - if (arg == "-n"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else nEvents = atoi( argv[++i] ); } - if (arg == "-m"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamMaxE = atof( argv[++i] ); } - if (arg == "-p"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamPeakE = atof( argv[++i] ); } - if (arg == "-a"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamLowE = atof( argv[++i] ); } - if (arg == "-b"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else beamHighE = atof( argv[++i] ); } - if (arg == "-r"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else runNum = atoi( argv[++i] ); } - if (arg == "-s"){ - if ((i+1 == argc) || (argv[i+1][0] == '-')) arg = "-h"; - else seed = atoi( argv[++i] ); } - if (arg == "-d"){ - diag = true; } - if (arg == "-f"){ - genFlat = true; } - if (arg == "-h"){ - cout << endl << " Usage for: " << argv[0] << endl << endl; - cout << "\t -c \t Config file" << endl; - cout << "\t -o \t ROOT file output name" << endl; - cout << "\t -hd \t HDDM file output name [optional]" << endl; - cout << "\t -n \t Minimum number of events to generate [optional]" << endl; - cout << "\t -m \t Electron beam energy (or photon energy endpoint) [optional]" << endl; - cout << "\t -p \t Coherent peak photon energy [optional]" << endl; - cout << "\t -a \t Minimum photon energy to simulate events [optional]" << endl; - cout << "\t -b \t Maximum photon energy to simulate events [optional]" << endl; - cout << "\t -r \t Run number assigned to generated events [optional]" << endl; - cout << "\t -s \t Random number seed initialization [optional]" << endl; - cout << "\t -f \t\t Generate flat in M(X) (no physics) [optional]" << endl; - cout << "\t -d \t\t Plot only diagnostic histograms [optional]" << endl << endl; - exit(1); - } - } - - if( configfile.size() == 0 || outname.size() == 0 ){ - cout << "No config file or output specificed: run gen_pi0 -h for help" << endl; - exit(1); - } - - // open config file and be sure only one reaction is specified - ConfigFileParser parser( configfile ); - ConfigurationInfo* cfgInfo = parser.getConfigurationInfo(); - assert( cfgInfo->reactionList().size() == 1 ); - ReactionInfo* reaction = cfgInfo->reactionList()[0]; - - // random number initialization (set to 0 by default) - gRandom->SetSeed(seed); - - // setup AmpToolsInterface - AmpToolsInterface::registerAmplitude( Pi0Regge() ); - AmpToolsInterface::registerAmplitude( Pi0SAID() ); - AmpToolsInterface ati( cfgInfo, AmpToolsInterface::kMCGeneration ); - - // generate single pi0 production - GammaPToXP phasespace( 0.135, beamMaxE, beamPeakE, beamLowE, beamHighE); - - vector< int > pTypes; - pTypes.push_back( Gamma ); - pTypes.push_back( Proton ); - pTypes.push_back( Pi0 ); - - HDDMDataWriter* hddmOut = NULL; - if( hddmname.size() != 0 ) hddmOut = new HDDMDataWriter( hddmname, runNum ); - ROOTDataWriter rootOut( outname ); - - TFile* diagOut = new TFile( "gen_ppi0_diagnostic.root", "recreate" ); - TH2F* hCosTheta_phi = new TH2F( "CosTheta_phi", "cos#theta vs. #phi; #phi; cos#theta", 180, -3.14, 3.14, 100, -1, 1); - TH2F* ht_phi = new TH2F( "t_phi", "-t vs. #phi; #phi; -t (GeV^{2})", 100, -3.14, 3.14, 100, 0, 2); - - int eventCounter = 0; - while( eventCounter < nEvents ){ - - if( batchSize < 1E4 ){ - - cout << "WARNING: small batches could have batch-to-batch variations\n" - << " due to different maximum intensities!" << endl; - } - - cout << "Generating four-vectors..." << endl; - - ati.clearEvents(); - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* kin = phasespace.generate(); - ati.loadEvent( kin, i, batchSize ); - delete kin; - } - - cout << "Processing events..." << endl; - - // include factor of 1.5 to be safe in case we miss peak -- avoid - // intensity calculation of we are generating flat data - double maxInten = ( genFlat ? 1 : 1.5 * ati.processEvents( reaction->reactionName() ) ); - - for( int i = 0; i < batchSize; ++i ){ - - Kinematics* evt = ati.kinematics( i ); - - // cannot ask for the intensity if we haven't called process events above - double weightedInten = ( genFlat ? 1 : ati.intensity( i ) ); - - if( !diag ){ - - // obtain this by looking at the maximum value of intensity * genWeight - double rand = gRandom->Uniform() * maxInten; - - if( weightedInten > rand || genFlat ){ - - // calculate angular variables - TLorentzVector target ( 0., 0., 0., 0.938); - TLorentzVector beam = evt->particle ( 0 ); - TLorentzVector recoil = evt->particle ( 1 ); - TLorentzVector p1 = evt->particle ( 2 ); - - TLorentzVector cm = recoil + p1; - TLorentzRotation cmBoost( -cm.BoostVector() ); - - TLorentzVector recoil_cm = cmBoost * recoil; - TLorentzVector p1_cm = cmBoost * p1; - - GDouble t = (target - recoil).M2(); - GDouble CosTheta = p1_cm.CosTheta(); - GDouble phi = p1_cm.Phi(); - if(phi < -1*PI) phi += 2*PI; - if(phi > PI) phi -= 2*PI; - - hCosTheta_phi->Fill( phi, CosTheta); - ht_phi->Fill( phi, -1.*t); - - // we want to save events with weight 1 - evt->setWeight( 1.0 ); - - if( hddmOut ) hddmOut->writeEvent( *evt, pTypes ); - rootOut.writeEvent( *evt ); - ++eventCounter; - } - } - else{ - - ++eventCounter; - } - - delete evt; - } - - cout << eventCounter << " events were processed." << endl; - } - - hCosTheta_phi->Write(); - ht_phi->Write(); - diagOut->Close(); - - if( hddmOut ) delete hddmOut; - - return 0; -} - - diff --git a/src/programs/Simulation/gen_pi0/saidPWA.cfg b/src/programs/Simulation/gen_pi0/saidPWA.cfg deleted file mode 100644 index f7ba6d8ecf..0000000000 --- a/src/programs/Simulation/gen_pi0/saidPWA.cfg +++ /dev/null @@ -1,50 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -reaction Pi0 gamma Pi0 p - -# consider just x polarized amplitudes -sum Pi0 xpol - -# SAID parameterization of amplitude (not viable for E_gamma > 2.7 GeV) -amplitude Pi0::xpol::xsection Pi0SAID 0.5 - -initialize Pi0::xpol::xsection cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/gen_pi0/vmRegge.cfg b/src/programs/Simulation/gen_pi0/vmRegge.cfg deleted file mode 100644 index b9e1b695d9..0000000000 --- a/src/programs/Simulation/gen_pi0/vmRegge.cfg +++ /dev/null @@ -1,51 +0,0 @@ -##################################### -#### THIS IS A CONFIG FILE #### -##################################### -## -## Blank lines or lines beginning with a "#" are ignored. -## -## Double colons (::) are treated like a space. -## This is sometimes useful for grouping (for example, -## grouping strings like "reaction::sum::amplitudeName") -## -## All non-comment lines must begin with one of the following keywords. -## -## (note: means necessary -## (word) means optional) -## -## include -## define (defn1) (defn2) (defn3) ... -## fit -## keyword -## reaction (particle3) ... -## data (arg1) (arg2) (arg3) ... -## genmc (arg1) (arg2) (arg3) ... -## accmc (arg1) (arg2) (arg3) ... -## normintfile -## sum (sum2) (sum3) ... -## amplitude (arg1) (arg2) ([par]) ... -## initialize <"events"/"polar"/"cartesian"> -## ("fixed"/"real") -## scale -## constrain ... -## permute ... -## parameter ("fixed"/"bounded"/"gaussian") -## (lower/central) (upper/error) -## DEPRECATED: -## datafile (file2) (file3) ... -## genmcfile (file2) (file3) ... -## accmcfile (file2) (file3) ... -## -##################################### - -reaction Pi0 gamma Pi0 p - -sum Pi0 Regge - -# Vincent's Regge model parameters: -# Polarization magnitude determined by cobrems.F in Pi0Regge amplitude -# Polarization plane angle: PARA = 0 and PERP = 90 -amplitude Pi0::Regge::Intensity Pi0Regge 0.0 - -initialize Pi0::Regge::Intensity cartesian 1.0 0.0 - diff --git a/src/programs/Simulation/geneta/Makefile b/src/programs/Simulation/geneta/Makefile deleted file mode 100644 index 2df7a7727e..0000000000 --- a/src/programs/Simulation/geneta/Makefile +++ /dev/null @@ -1,24 +0,0 @@ - -PACKAGES := CERNLIB:JANA:ROOT -MISC_LIBS = -L/sw/lib -lXm -L/usr/X11R6/lib -lXt -lgelhad -lhitutil -#FFLAGS = -Wno-globals -CFLAGS += -I$(HALLD_MY)/src/libraries/HDDM -I$(HALLD_HOME)/src/libraries/HDDM -ADDITIONAL_MODULES += HDDM - - -# Mac OS X 10.5 seems to have a picky linker that spits out -# tons of warnings about "can't find atom for N_GSYM stabs" -# for each of the cernlib routines. -# I can't find much on the web about it and don't recall -# anyone else using 10.5 complaining. No such warnings seem to -# exist for pure C++ code with no FORTRAN. The fix is -# therefore to supress all warnings for HDGeant, but only -# for this specific platform/OS since a global solution -# applied through BMS core files would supress warnings -# uneccessarily. -ifeq ($(BMS_OSNAME), Darwin_macosx10.5-i386-gcc4.0.1) - LD_FLAGS += -w -endif - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/geneta/README b/src/programs/Simulation/geneta/README deleted file mode 100644 index b4e860e09a..0000000000 --- a/src/programs/Simulation/geneta/README +++ /dev/null @@ -1,15 +0,0 @@ - -README geneta -10/22/2009 David Lawrence - - -This directory contains files for the eta Primakoff generator -originally authored by Ashot Gasparian. It has been modified -to be used as a stand-alone program that writes out HDDM files -suitable as input to hdgeant. - -The program reads some of its configuration from the eta_p_gen.dat -file which needs to be in the current directory when the -program is run. - -Run geneta -h for a list of command line options. diff --git a/src/programs/Simulation/geneta/bg_hddm.cc b/src/programs/Simulation/geneta/bg_hddm.cc deleted file mode 100644 index 0b5bca7263..0000000000 --- a/src/programs/Simulation/geneta/bg_hddm.cc +++ /dev/null @@ -1,237 +0,0 @@ -#include -#include -#include -using namespace std; - -#include -#include - -#include -#include "bg_hddm.hpp" - -std::ofstream *hddmOutputFile = NULL; -hddm_s::ostream *hddmOutputStream = NULL; - -map PDG_to_GEANT_map; -map GEANT_to_PDG_map; -bool PDG_GEANT_maps_initialized = false; - -void InitializePDGGEANTmaps(void); -void AlignParticleTypes(Particle &part); - -//----------------- -// open_hddm_output -//----------------- -void open_hddm_output(string fname) -{ - // Open output file - hddmOutputFile = new std::ofstream(fname.c_str()); - if (! hddmOutputFile->is_open()) { - std::cerr << "Unable to open output file \"" << fname.c_str() - << "\" for writing." << std::endl; - exit(-3); - } - hddmOutputStream = new hddm_s::ostream(*hddmOutputFile); - - std::cerr << "Opened output file \"" << fname.c_str() - << "\" for writing." << std::endl; -} - -//----------------- -// close_hddm_output -//----------------- -void close_hddm_output(void) -{ - // Close output file - delete hddmOutputStream; - delete hddmOutputFile; - - std::cout << "Closed HDDM output file." << std::endl; -} - -//----------------- -// write_hddm_event -//----------------- -void write_hddm_event(Event &event) -{ - // User may specify either GEANT type or PDG type for each particle - // When one of the types is zero and the other isn't, the non-zero - // value is used to overwrite the zero value (if possible) os that - // both are set properly. - AlignParticleTypes(event.beam); - AlignParticleTypes(event.target); - - // physicsEvent - hddm_s::HDDM record; - hddm_s::PhysicsEventList pes = record.addPhysicsEvents(); - pes().setRunNo(event.runNo); - pes().setEventNo(event.eventNo); - - // reaction - hddm_s::ReactionList rs = pes().addReactions(); - rs().setType(event.reaction_type); - rs().setWeight(event.reaction_weight); - - // beam - hddm_s::BeamList bs = rs().addBeams(); - bs().setType(event.beam.type); - hddm_s::MomentumList bmoms = bs().addMomenta(); - bmoms().setPx(event.beam.p.Px()); - bmoms().setPy(event.beam.p.Py()); - bmoms().setPz(event.beam.p.Pz()); - bmoms().setE(event.beam.p.E()); - hddm_s::PropertiesList bpros = bs().addPropertiesList(); - bpros().setCharge(ParticleCharge(bs->type)); - bpros().setMass(ParticleMass(bs->type)); - - // target - hddm_s::TargetList ts = rs().addTargets(); - ts().setType(event.target.type); - hddm_s::MomentumList tmoms = ts().addMomenta(); - tmoms().setPx(event.target.p.Px()); - tmoms().setPy(event.target.p.Py()); - tmoms().setPz(event.target.p.Pz()); - tmoms().setE(event.target.p.E()); - hddm_s::PropertiesList tpros = ts().addPropertiesList(); - tpros().setCharge(ParticleCharge(ts->type)); - tpros().setMass(ParticleMass(ts->type)); - - // vertex - hddm_s::VertexList vs = rs().addVertices(); - hddm_s::OriginList os = vs().addOrigins(); - os().setT(0.0); - os().setVx(event.vertex.X()); - os().setVy(event.vertex.Y()); - os().setVz(event.vertex.Z()); - - // product - unsigned int Npart = event.intermediate.size() + event.final.size(); - hddm_s::ProductList ps = vs().addProducts(Npart); - - // Add intermediate particles (i.e. ones that GEANT does not track) - // These will have the "type" explicitly set to 0 to tell hdgeant - // to ignore them. They will, however, be kept in the list of thrown - // particles passed to the output data stream of hdgeant. - int nprod = 0; - for (unsigned int i=0; i < event.intermediate.size(); i++) { - AlignParticleTypes(event.intermediate[i]); - CopyParticleToProduct(nprod+1, event.intermediate[i], ps.end()); - ps(nprod).setType((Particle_t)0); - ++nprod; - } - - // Add final state particles (i.e. ones that GEANT does track) - for (unsigned int i=0; i < event.final.size(); i++) { - AlignParticleTypes(event.final[i]); - CopyParticleToProduct(nprod+1, event.final[i], ps.end()); - ++nprod; - } - - // Write event to output stream - *hddmOutputStream << record; -} - -//----------------- -// CopyParticleToProduct -//----------------- -void CopyParticleToProduct(int id, const Particle &part, PlistIter &prod) -{ - prod.decayVertex = part.decayVertex; - prod.id = id; - prod.mech = part.mech; - prod.parentid = part.parentid; - prod.pdgtype = part.pdgtype; - prod.type = part.type; - - // momentum - hddm_s::MomentumList pmoms = prod->addMomenta(); - pmoms().setPx(part.p.Px()); - pmoms().setPy(part.p.Py()); - pmoms().setPz(part.p.Pz()); - pmoms().setE(part.p.E()); - - // properties - hddm_s::PropertiesList ppros = prod->addPropertiesList(); - ppros().setCharge(ParticleCharge(prod.type)); - ppros().setMass(ParticleMass(prod.type)); -} - -//----------------- -// PDG_to_GEANT -//----------------- -Particle_t PDG_to_GEANT(int pdgtype) -{ - if (! PDG_GEANT_maps_initialized) - InitializePDGGEANTmaps(); - - map::iterator iter = PDG_to_GEANT_map.find(pdgtype); - if (iter == PDG_to_GEANT_map.end()) - pdgtype = 0; - - return PDG_to_GEANT_map[pdgtype]; -} - -//----------------- -// GEANT_to_PDG -//----------------- -int GEANT_to_PDG(Particle_t type) -{ - if (! PDG_GEANT_maps_initialized) - InitializePDGGEANTmaps(); - - map::iterator iter = GEANT_to_PDG_map.find(type); - if (iter == GEANT_to_PDG_map.end()) - type = Unknown; - - return GEANT_to_PDG_map[type]; -} - -//----------------- -// InitializePDGGEANTmap -//----------------- -void InitializePDGGEANTmaps(void) -{ - // Set values in GEANT_to_PDG_map first, then copy them into PDG_to_GEANT_map - GEANT_to_PDG_map[Unknown] = 0; - GEANT_to_PDG_map[Gamma] = 22; - GEANT_to_PDG_map[Positron] = -11; - GEANT_to_PDG_map[Electron] = 11; - GEANT_to_PDG_map[Neutrino] = 12; - GEANT_to_PDG_map[MuonPlus] = -13; - GEANT_to_PDG_map[MuonMinus] = 13; - GEANT_to_PDG_map[Pi0] = 111; - GEANT_to_PDG_map[PiPlus] = 211; - GEANT_to_PDG_map[PiMinus] = -211; - GEANT_to_PDG_map[KLong] = 130; - GEANT_to_PDG_map[KPlus] = 321; - GEANT_to_PDG_map[KMinus] = -321; - GEANT_to_PDG_map[Neutron] = 2112; - GEANT_to_PDG_map[Proton] = 2212; - GEANT_to_PDG_map[AntiProton]= -2212; - GEANT_to_PDG_map[KShort] = 310; - GEANT_to_PDG_map[Eta] = 221; - GEANT_to_PDG_map[Lambda] = 3122; - - // Copy values into PDG_to_GEANT_map - map::iterator iter = GEANT_to_PDG_map.begin(); - for (; iter != GEANT_to_PDG_map.end(); iter++) - PDG_to_GEANT_map[iter->second] = iter->first; - - PDG_GEANT_maps_initialized = true; -} - -//----------------- -// InitializePDGGEANTmap -//----------------- -void AlignParticleTypes(Particle &part) -{ - // If one of type or pdgtype is zero and the other isn't - // then use the non-zero value to set the zero one (if - // possible). - if (part.type == 0 && part.pdgtype != 0) { - part.type = PDG_to_GEANT(part.pdgtype); - } - else if (part.type != 0 && part.pdgtype == 0) { - part.pdgtype = GEANT_to_PDG(part.type); - } -} diff --git a/src/programs/Simulation/geneta/bg_hddm.h b/src/programs/Simulation/geneta/bg_hddm.h deleted file mode 100644 index c2f1b9208b..0000000000 --- a/src/programs/Simulation/geneta/bg_hddm.h +++ /dev/null @@ -1,54 +0,0 @@ -#include -#include -using std::string; -using std::vector; - -#include -#include - -#include "HDDM/hddm_s.hpp" - -class Particle{ - public: - Particle() : type(Unknown), pdgtype(0), parentid(0), mech(0), decayVertex(0) - { - p.SetXYZT(0,0,0,0); - } - - Particle_t type; // Note: Particle_t is an int as opposed to Particle which is a class - TLorentzVector p; - - // The following are not used for beam or target particles - int pdgtype; - int parentid; - int mech; - int decayVertex; -}; - -class Event{ - public: - Event() : runNo(0), eventNo(0), reaction_type(0), reaction_weight(0) - { - vertex.SetXYZ(0,0,0); - } - - int runNo; - uint64_t eventNo; - int reaction_type; // copied to HDDM, but not used (as far as I know) - int reaction_weight; // copied to HDDM, but not used (as far as I know) - TVector3 vertex; // Set this to 0,0,0 to have GEANT distribute it in target - Particle beam; - Particle target; - vector intermediate; // Not to be tracked by GEANT - vector final; // To be tracked by GEANT -}; - -typedef hddm_s::ProductList::iterator PlistIter; - -void open_hddm_output(string fname); -void close_hddm_output(void); -void write_hddm_event(Event &event); -void CopyParticleToProduct(int id, const Particle &part, PlistIter &prod); -Particle_t PDG_to_GEANT(int pdgtype); -int GEANT_to_PDG(Particle_t type); -void InitializePDGGEANTmap(void); diff --git a/src/programs/Simulation/geneta/c_cern.c b/src/programs/Simulation/geneta/c_cern.c deleted file mode 100644 index 7deacfade9..0000000000 --- a/src/programs/Simulation/geneta/c_cern.c +++ /dev/null @@ -1,9 +0,0 @@ - -#include "c_cern.h" - -/* Create data structures in global memory */ -GCBANK_t gcbank_; -PAWC_t pawc_; -int quest_[100]; -kinem1_t kinem1_; -kinem3_t kinem3_; \ No newline at end of file diff --git a/src/programs/Simulation/geneta/c_cern.h b/src/programs/Simulation/geneta/c_cern.h deleted file mode 100644 index 70198fb8b4..0000000000 --- a/src/programs/Simulation/geneta/c_cern.h +++ /dev/null @@ -1,46 +0,0 @@ -#define NWGEAN 9000000 -#define NWPAW 6000000 - -typedef struct{ - int GEANT[NWGEAN]; -}GCBANK_t; - -typedef struct{ - int PAW[NWPAW]; -}PAWC_t; - -typedef struct { - float EINI; - float TPI0; - float FIPI0G; - float EPI0SP; - float TRECSP; - float TKINRM; -} kinem1_t; - -typedef struct { - float EPI0LF; - float PPI0LF[3]; - float EG1LF; - float PG1LF[3]; - float EG2LF; - float PG2LF[3]; -} kinem3_t; - -#ifdef __cplusplus -extern "C" { -#endif - void gukine_(void); - void gzebra_(int *nwgean); - void hlimit_(int *nwpaw); - void gpaw_(int *nwgean, int *nwpaw); - void uginit_(void); - - extern GCBANK_t gcbank_; - extern PAWC_t pawc_; - extern int quest_[100]; - extern kinem1_t kinem1_; - extern kinem3_t kinem3_; -#ifdef __cplusplus -} -#endif diff --git a/src/programs/Simulation/geneta/cr_prt.F b/src/programs/Simulation/geneta/cr_prt.F deleted file mode 100644 index 597fd16f7f..0000000000 --- a/src/programs/Simulation/geneta/cr_prt.F +++ /dev/null @@ -1,105 +0,0 @@ -C -C 12/22/09 sross section with Lage/Sergey and 3 variable parameters -C -C f77 laget_eta.f -o laget -L $CERN/2004/lib -lpacklib -lmathlib -lkernlib -C - SUBROUTINE CRSEC6(egama,thpi0,sumall) -C -C program-laget_eta ! dsigma/dt(microbarn/Gev^2) -c Labels: o-omega contribution,r-rho meson,c-coulomb - implicit none - double precision meta, mn, ebeam - parameter(meta = 0.54775d0, mn = 0.938272d0) - real dgamma - real egama,sumall - double precision thpi0 - double precision s, s0, t,ao,ar,alpha,phi - common/spar_com/ s, s0, t,ao,ar,alpha,phi - double precision pi,co,cr,cc,w,wo,wr,wc - double precision wdomeg - double precision go,gr,fo,fr,fc - double precision par(3),dwidth -C - parameter(pi = 3.1416d0) -C PDG after 2004 -Ct parameter(dwidth = 0.51d0) -C PDG before 2004 - parameter(dwidth = 0.46d0) -C - integer n - double precision tmin, theta -C -C !I put here the phase from Cornell, Sergey -Ct phi=pi/3.d0 ! not correct, Ashot -Ct phi=1.0d0 -Ct phi=-0.35d0 -C - phi=0.0d0 -C - par(1) = dwidth ! magn. of Primakoff process - par(2) = 1.0d0 ! magn. of hadr. amplitude - par(3) = phi ! diff. of interf. phase angle -C - ebeam = egama -C -C do n=0,100 -C theta=n*0.03d0 -* thetal = theta / sqrt((mn+2.d0*ebeam)/mn) -C - theta = thpi0 -C - s0 = 1.0d0 - s = 2.d0*mn*ebeam + mn**2 - - co=0.063d0 !0.29*sqrt(6.44/137) - cr=0.0664d0 !0.81*sqrt(0.92/137) - - tmin = meta**4/(4.d0*ebeam**2) - t = -4.d0*ebeam**2*dsin(0.5d0*theta*pi/180.d0)**2-tmin - ao=0.44d0+0.9d0*t - ar=0.55d0+0.8d0*t - - if((ao.lt.0.0).OR.(ar.lt.0.0)) then - sumall = 0 - RETURN - endif - - go=dgamma(ao) !Euler Gamma functions - gr=dgamma(ar) !Euler Gamma functions -C the omega amplitude - fo= par(2)*20.0d0*co*ebeam**2*s**(ao-1.d0)*dsin(theta*pi/180.d0)* - &(pi*0.9d0/(go*dsin(pi*ao)))/(1.414d0*meta) - wo=fo**2 - fr= par(2)*20.0d0*cr*ebeam**2*s**(ar-1.d0)*dsin(theta*pi/180.d0)* - &(pi*0.8d0/(gr*dsin(pi*ar)))/(1.414d0*meta) - wr=fr**2 - - fc=-dsqrt((8.0d0*par(1))/(137.0d0*meta**3))*ebeam**2* - &dsin(theta*pi/180.0d0)/(t*50.0d0) - wc=fc**2 - w=pi*(wo+wr+wc+2.0d0*dcos(pi*(ar-ao))*fo*fr+ - &2*fc*(fo*dcos(pi*ao+par(3))+fr*dcos(pi*ar+par(3))))/ebeam**2 -C -C !to change to -c dsigma/domega drop out pi at front and ebeam**2 at end of -C this expression. -C -* from Ashot, calculation of d(sigma)/d(omega) -C - wdomeg = (ebeam*ebeam*w)/pi -C -C OPEN(2,FILE='laget_eta.dat') -C write(2,1) -t,w -C write(*,1) -t,w -C 1 format(x,7(E10.4,x)) -C -C enddo -C - sumall = SNGL(wdomeg/1000.0) -C - return - end - - - - diff --git a/src/programs/Simulation/geneta/eta_p_gen.dat b/src/programs/Simulation/geneta/eta_p_gen.dat deleted file mode 100644 index 28f87af277..0000000000 --- a/src/programs/Simulation/geneta/eta_p_gen.dat +++ /dev/null @@ -1,67 +0,0 @@ -C Imput data for the eta primakoff generator on proton 10/18/09 -C LIST -TRIGGERS 10368 ! represents 4 days of running -C DEBUG 1 2 1 -DEBUG 0 0 0 -SWIT 1 1 1 1 0 1 1 1 10 30 -CUTS 5*5.E-3 ! was 1.e-4 -C -C -C PKINE(1) => is the initial Electron beam energy in GeV = EINI -C PKINE(2) => -C PKINE(3) => -C PKINE(4) => -C PKINE(5) => -C PKINE(6) => -C PKINE(7) => -C PKINE(8) => -C PKINE(9) => is the upper limit of eta polar angle (deg.) -C PKINE(10) => -C sampling in azimutal angle isdone in (0-360) degrees -C First one here is IKINE => the type of the particle ( be careful ) -C -C -KINE 3 12.0 0.0 0.0 0.00 0.00 0.00 0.00 0.00 4.200 0.00 -C -C Fraction of Tagged Photon beam interval deltaE=(EGFR2-EGFR1)*Ebeam -C -EGFR 0.850 0.9500 -C -C Number of equivqlent Photons in Tagged beam per second -C in units of 10+7 eq. gama/sec -QEQU 7.2135 -C -C The total Run time of the experiment in (Hours) -TSAM 1080.0 -C -C the standard GEANT flags -C PRINT 'MATE' 'VOLU' 'TMED' -PAIR 1 -COMP 1 -PHOT 1 -PFIS 1 -MULS 1 -BREM 1 -LOSS 1 -DRAY 1 -ANNI 1 -MUNU 1 -HADR 1 -CKOV 1 -LABS 1 -SYNC 1 -C the GEANT time -TIME 100000. 10. -1 -C the run number and ? -RUNG 88 1 -C the initial random number seeds -RNDM 1654511046 251059678 -STOP -END - - - - - - - diff --git a/src/programs/Simulation/geneta/eta_prot_kin.F b/src/programs/Simulation/geneta/eta_prot_kin.F deleted file mode 100644 index 1d930c4e6e..0000000000 --- a/src/programs/Simulation/geneta/eta_prot_kin.F +++ /dev/null @@ -1,169 +0,0 @@ -C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -C -C - SUBROUTINE PR_KIN -C -C This program calculates all kinematic variabls for Real Prim. Exp. -C ETA Primakoff -C -C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - COMMON/KINEM1/EINI,TPI0,FIPI0G,EPI0SP,TRECSP,TKINRM - COMMON/KINEM2/PPREL(3) - COMMON/KINEM3/EPI0LF,PPI0LF(3),EG1LF,PG1LF(3),EG2LF,PG2LF(3) -C - COMMON/TMCAR1/FTPNOR(1:150,0:10000),tpi0ms(10000) -C - COMMON/TMCAR4/egammn,egammx,denest - COMMON/BRMST1/egamak -C - DIMENSION RNDM(2) -C - DOUBLE PRECISION egammx,egammn,denest -C - DOUBLE PRECISION C1,A1,A2,A3 - DOUBLE PRECISION BMASS,PI0MAS,TPI0DP,TRECDP,TKINRC,ENERRC - DOUBLE PRECISION PPI0DP,EPI0DP - DOUBLE PRECISION EGBEDP,DISCRI,U,ARECOI,TCONS1 -C - DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD,RADDEG,EMASS -C - PARAMETER (PI=3.14159265358979324) - PARAMETER (TWOPI=6.28318530717958648) - PARAMETER (PIBY2=1.57079632679489662) - PARAMETER (DEGRAD=0.0174532925199432958) - PARAMETER (RADDEG=57.2957795130823209) - PARAMETER (EMASS=0.0005109990615) -C -CC for pio exp. PARAMETER (PI0MAS=0.1349764d0) -C - PARAMETER (PI0MAS=0.54745d0) -C - U = 0.931502D0 -C -C He4 ARECOI = 4.00260D0 -C - ARECOI = 1.00726568D0 ! for Proton -C - BMASS = ARECOI*U -C - EINI = egamak -C - EGBEDP = DBLE(egamak) -C -C Neew Monte Carlo for teta pi0 -C selects the prod. angle vs. cross section - CALL ANGLSP(tpisel) -C - TPI0DP = DBLE(tpisel) ! in degrees -C - C1=(2.D0*EGBEDP*BMASS+PI0MAS*PI0MAS)/2.D0 - TCONS1=(EGBEDP+BMASS)**2 - A1=EGBEDP*EGBEDP*(DCOS(DEGRAD*TPI0DP))**2-TCONS1 - A2=2.D0*EGBEDP*C1*DCOS(DEGRAD*TPI0DP) - A3=C1*C1-PI0MAS*PI0MAS*(EGBEDP+BMASS)**2 -C - DISCRI = (A2*A2-4.D0*A1*A3) - IF(DISCRI.LE.0.D0)THEN - WRITE(6,*)'Discriminator under SQRT is LT than 0.' -C - ELSE - PPI0DP=(-A2-DSQRT(DISCRI))/(2.D0*A1) -C - EPI0DP=DSQRT(PPI0DP*PPI0DP+PI0MAS*PI0MAS) - TKINRC=EGBEDP-EPI0DP - ENERRC=BMASS+TKINRC - PMOMRC=DSQRT(ENERRC*ENERRC-BMASS*BMASS) - TRECDP=RADDEG*(DASIN((PPI0DP*DSIN(DEGRAD*TPI0DP))/PMOMRC)) -C - TPI0 = tpisel ! in degrees -C -C sampling the fipi0 in 0-360 degrees -C - CALL RANLUX(RNDM,2) -C - FIPI0R = 2.*3.14159265*RNDM(2) ! in radians - FIPI0G = 57.2957795*FIPI0R -C - EPI0LF=SNGL(EPI0DP) - EPI0SP=EPI0LF - PPI0 = SNGL(PPI0DP) - TRECSP=SNGL(TRECDP) - TKINRM=1000.*SNGL(TKINRC) ! T kin of Rec. Nuc. in MeV -C - PPI0LF(1)=PPI0*SIN(DEGRAD*TPI0)*COS(FIPI0R) - PPI0LF(2)=PPI0*SIN(DEGRAD*TPI0)*SIN(FIPI0R) - PPI0LF(3)=PPI0*COS(DEGRAD*TPI0) -C - ENDIF -C -C - CALL HF1(1,EINI,1.) - CALL HF1(2,TPI0,1.) - CALL HF1(3,FIPI0G,1.) - CALL HF1(4,EPI0LF,1.) - CALL HF1(5,TRECSP,1.) - CALL HF1(6,TKINRM,1.) -C -C - CALL ETA_CM -C -C - RETURN - END -C -C -C...................... -C -C -C........................................................................ -C - SUBROUTINE ANGLSP(tpisel) -C -C This subr. samples the theta ETA for Real Prim. Exp. -C........................................................................ -C - COMMON/TMCAR1/FTPNOR(1:150,0:10000),tpi0ms(10000) - COMMON/TMCAR4/egammn,egammx,denest - COMMON/BRMST1/egamak -C - DOUBLE PRECISION egammx,egammn,denest -C -C -C definition of initial g beam energy bin for theta pi0 sampling, new -C - igebin = 1 + IDINT((DBLE(egamak)-egammn)/denest) -C - if(igebin.GT.200)write(6,*)'? S. wrong in ANGLSP,igebin=',igebin -C -C Sampling of Theta pi0 angle according cross section*domega ****** -C - CALL RANLUX(URN,1) -C - k=0 - 1 k=k+1 -C - IF(k.GT.10000) go to 2 -C - IF(FTPNOR(igebin,k).LT.URN) go to 1 -C - tpisel = tpi0ms(k) ! selected teta pi0 angle in degrees -C - RETURN -C - 2 write(6,*)'Subr. ANGLSP**, The URN bigger than Max of FTPNOR ??' -C - RETURN - END -C - - - - - - - - diff --git a/src/programs/Simulation/geneta/eta_proton.F b/src/programs/Simulation/geneta/eta_proton.F deleted file mode 100644 index 78968689de..0000000000 --- a/src/programs/Simulation/geneta/eta_proton.F +++ /dev/null @@ -1,1045 +0,0 @@ -C -C************************************************************************** -C * -C-- Date: 10/18/09 * -C-- Author : A. Gasparian * -C * -C INTERACTEV VERSION OF * -C......GEANT SIMULATION PROG. FOR HALL D Real Promakoff Experiment * -C. GEANT VERSION 3.21 * -C. PROG. VERSION 1.01 * -C Eta Primakoff generator for Hall D project * -C * -C.************************************************************************* -C..... -C. -C -C**************************************************************************** -*-- Author :A. Gasparian * -*-- DATE :08/29/97 * -* * -* * -* * -C. To open FFREAD and HBOOK files * -* * -***************************************************************************** -C - SUBROUTINE UFILES -C - OPEN(UNIT=4,FILE='eta_p_gen.dat',STATUS='OLD') -C -C the file below is for Pawl to generate events in Matt's format -CDL open(unit=11, file='Prim_eta_Prt.dat', status='new') -C - RETURN - END -C. -C..... -C. -C -C$LIST ON -C.************************************************************************* -*-- Author :A. Gasparian * -*-- DATE :9/04/97 * -* * -C. * * -C. * * -C. * To initialise GEANT prog. and read data cards * -C. * * -* * -C.************************************************************************* -C - SUBROUTINE UGINIT -C. -C. - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCUNIT/LIN,LOUT,NUNITS,LUNITS(5) - INTEGER LIN,LOUT,NUNITS,LUNITS - COMMON/GCMAIL/CHMAIL - CHARACTER*132 CHMAIL -C - COMMON/GCLIST/NHSTA,NGET ,NSAVE,NSETS,NPRIN,NGEOM,NVIEW,NPLOT - + ,NSTAT,LHSTA(20),LGET (20),LSAVE(20),LSETS(20),LPRIN(20) - + ,LGEOM(20),LVIEW(20),LPLOT(20),LSTAT(20) -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - PARAMETER (KWBANK=99000,KWWORK=8200) - COMMON/GCBANK/NZEBRA,GVERSN,ZVERSN,IXSTOR,IXDIV,IXCONS,FENDQ(16) - + ,LMAIN,LR1,WS(KWBANK) - COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART - + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX - + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT -C - COMMON/PHBMEN/EGFRAC(2) - COMMON/EQUIPH/QEQUPH - COMMON/EQHORS/THOURS - COMMON/TMCAR4/egammn,egammx,denest - DOUBLE PRECISION egammx,egammn,denest -C - COMMON/TMCAR2/CRSSUM,CRSOME - COMMON/TMCAR3/YIELD - COMMON/TMCAR9/totpht -C - INTEGER t -C - DIMENSION PAR(8) -C -C Open user files -C - CALL UFILES -C -C Initialise GEANT -C - CALL GINIT -C - CALL FFKEY('TSAM',THOURS,1,'REAL') -C for 45 days on LH2 -Cn THOURS = 1080.000 -C Tagged beam equivalent Photon Number in sec - CALL FFKEY('QEQU',QEQUPH,1,'REAL') -C Tagged gamma accepted fractions - CALL FFKEY('EGFR',EGFRAC,2,'REAL') -C - CALL FFSET('LINP',4) - CALL GFFGO - CLOSE(4) -C -C rundom namber generater initialization -C - t = TIME() - CALL RLUXGO(4,t,0,0) -C -C -C -C -C........ Initalization of data structure to be used for the eta polar angle sampling -C vs. cross sections. -C - write(6,*)'?????????????????????????????? CALL YILINT ????' - CALL YILINT -C - write(6,*)'???????????????????????????? FINISH CALL YILINT ????' -C -C from 120708 -C120708 for the 30 cm He4 target -C N(He4) = 5.644x10^23 /cm^2 -C N(hour)= 3600*1.*E+7x5.644*E+23{1.E-6*YIELD in mb*Nphotons}*1.E-27 -C = 20.3184 -C -C121408 EVENTH= 20.3184*THOURS*YIELD -C Br. Ratio eta -- g+g 39.25+/- 0.31 % -C121408 EVETGG = EVENTH*0.3925 -C -C120708 for the 30 cm LH2 target, work below -C N(H) = 1.28x10^24 /cm^2 -C N(hour)= 3600*1.*E+7x12.8*E+23{1.E-6*YIELD in mb*Nphotons}*1.E-27 -C = 46.080 -C - EVENTH= 46.080*THOURS*YIELD -C Br. Ratio eta -- g+g 39.25+/- 0.31 % - EVETGG = EVENTH*0.3925 -C - write(6,*)'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>' - write(6,*)'>>>> Integral (Cr.Sect.*dteta) = ',CRSSUM,' mb/sr' - write(6,*)'>>>> Integral (Cr.Sect.*domega) = ',CRSOME/1.E+6,' mb' - write(6,*)'>>>> For Time= ',THOURS,' hours' -C write(6,*)'>>>> For 5.644 x 10^23 he4/cm^2 target ' - write(6,*)'>>>> For 12.8 x 10^23 proton/cm^2 target, (30 cm) ' - Eg1=SNGL(egammn) - Eg2=SNGL(egammx) - write(6,*)'>>>> For Eg int from ',Eg1,' to ',Eg2, ' GeV' -C write(6,*)'>>>> and for ',QEQUPH,' microA el. beam ' - write(6,*)'>>>> and for ',QEQUPH,' eq. ph. beam ' - write(6,*)'>>>> total photons = ', totpht,' x10^7' - write(6,*)'>>>> You must sample TOTAL ETA EVENT = ',EVENTH - write(6,*)'>>>> OR must sample TOTAL eta - g+g EVENT = ',EVETGG - write(6,*)'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>' -C -C - PRINT*,'------------ Calling GZINIT' - CALL GZINIT -C PRINT*,'------------ Calling GDINIT' -C CALL GDINIT - PRINT*,'------------ Calling GPART' - CALL GPART - PRINT*,'------------' -C -C Prints version number -C - WRITE(LOUT,1000) -C -C -C Geometry and materials description -C - CALL GMATE ! geant default materials #1-16 - -C -C **************** Defines tracking media parameters ********** -C. - NMED1 = 1 ! AIR, NOT OPTIC # 1 -C -C... Tracking medium parameters for detectors -C. -C !! negative value of parameters meens that -C even in case IGAUTO=0, automatic calculation -C still takes place - IFIELD = 0 - FIELDM = 0. - TMAXFD = 10. - STEMAX = 10. - DEEMAX = 0.1 ! FROM GEXAM1 - EPSIL = 0.001 - STMIN = 0.01 ! IN GEXAM8 = -0.01 -C. - ISVOL = 1 ! VOLUME IS SENSITIVE -C. - CALL GSTMED( 1,'DEFAULT MEDIUM AIR$ ' ,15 , 0 , IFIELD, - * FIELDM,TMAXFD,STEMAX,DEEMAX, EPSIL, STMIN, 0 , 0 ) -C...................................................................... -C -C. -C... PARAMETERS OF MOTHER VOLUME 'HALD' -C... Hall D is described as a 'BOX ' with half sizes =1320.x2610.x2700. cm^3 -C... hall D referense frame -C... OZ ALONG BEAM, OX HORIZONTAL(NON DISPERSION), OY- VERTICAL -C - PAR(1) = 500.000 - PAR(2) = 500.000 - PAR(3) = 2000.000 -C Temporarily Hall D is an air #1, not mag. -C - CALL GSVOLU( 'HALD','BOX ', 1,PAR,3,IVOL) ! HALL D -C -C Close geometry banks -C - CALL GGCLOS -C. -C........................................................ -C - CALL GLOOK('MATE',LPRIN,NPRIN,IM) - CALL GLOOK('TMED',LPRIN,NPRIN,IT) - CALL GLOOK('VOLU',LPRIN,NPRIN,IV) - IF(IM.NE.0)CALL GPRINT('MATE',0) - IF(IT.NE.0)CALL GPRINT('TMED',0) - IF(IV.NE.0)CALL GPRINT('VOLU',0) -C -C Energy loss and cross-sections initialisations -C - CALL GPHYSI -C -C -C Define histograms -C -CDL CALL UHINIT -C - 1000 FORMAT(/,'R. ETA Pr. VERS 0.01, :10/18/09, by A. Gasparian',/) -C - RETURN - END -C. -C.... -C. -C -C -C.************************************************************************* -* Author :A. Gasparian * -* date : 10/18/09 * -* * -*. Sampling of Real Primakoff Events * -* * -C.************************************************************************* -C. - SUBROUTINE YILINT -C -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - COMMON/PHBMEN/EGFRAC(2) - COMMON/EQUIPH/QEQUPH -C - COMMON/TMCAR1/FTPNOR(1:150,0:10000),tpi0ms(10000) -C - COMMON/TMCAR2/CRSSUM,CRSOME - COMMON/TMCAR3/YIELD - COMMON/TMCAR4/egammn,egammx,denest - COMMON/TMCAR9/totpht -C -C - DOUBLE PRECISION egammx,egammn,denest -C - DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD -C - PARAMETER (PI=3.141592653) - PARAMETER (TWOPI=6.2831853071) - PARAMETER (PIBY2=1.57079632679) - PARAMETER (DEGRAD=0.01745329251) -C - nenedv = 150 -C - egammx = DBLE(EGFRAC(2))*DBLE(PKINE(1)) - egammn = DBLE(EGFRAC(1))*DBLE(PKINE(1)) -C - denest = (egammx - egammn)/DBLE(nenedv) -C - YIELD = 0.000000 -C - do i = 1, nenedv -C - engamk = SNGL(egammn)+i*SNGL(denest)-SNGL(denest/2.D0) -C - CALL TOCRS2(engamk) -C -C -C from subr TOCRS2 we now have CRSOME = integr. crsec*domega in 0-? degree -C for the carrent g energy => engamk -C Now we have to calculate Number of Photons in the [(engamk-denest),engamk] -C see page #36 book #2 -C QEQUPH is the number of equivalent photons in second in units 1.E+7 -C -C - phnumb = QEQUPH*(DLOG(DBLE(engamk))-DLOG(DBLE(engamk-denest))) -C - totpht= totpht+phnumb -C - YIELD = YIELD+phnumb*CRSOME -C -C new - ienbin = i - CALL FSUMMC(ienbin,engamk) -C -C write(6,*)'?? in YILINT i = ',i,' engamk=',engamk -C - enddo -C -C - RETURN - END -C -C -C..... -C -C -C.************************************************************************* -* Author :A. Gasparian * -* date : 10/20/97 * -* * -*. For sampling of Real Primakoff Events * -* now for each event we prepareing unique FTPNOR(i) for Thetapi0 sampl.* -* * -C.************************************************************************* -C. - SUBROUTINE FSUMMC(ienbin,engamk) -C -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C -C - COMMON/TMCAR1/FTPNOR(1:150,0:10000),tpi0ms(10000) -C - DOUBLE PRECISION FTPROB(0:10000) - DOUBLE PRECISION tpi0mx,tpi0mn,dpi0st,tpi0k - DOUBLE PRECISION UPCOS,DNCOS,DEOMEG -C - DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD -C - PARAMETER (PI=3.141592653) - PARAMETER (TWOPI=6.2831853071) - PARAMETER (PIBY2=1.57079632679) - PARAMETER (DEGRAD=0.01745329251) -C -C - ntetdv = 10000 - tpi0mx = DBLE(PKINE(9)) ! degree - tpi0mn = 0.000000D0 ! degree -C - dpi0st = (tpi0mx - tpi0mn)/DBLE(ntetdv) -C - FTPROB(0) = 0.000000D0 -C - do i = 1, ntetdv -C - tpi0k = tpi0mn + DBLE(i)*dpi0st-dpi0st/2.D0 -C - tpi0ms(i) = SNGL(tpi0k) -C -C here, energy of photon comes from YILINT, for each bin -C - CALL CRSEC6(engamk,tpi0k,sumall) -C -C - UPCOS = DCOS(DEGRAD*tpi0k) - DNCOS = DCOS(DEGRAD*(tpi0k-dpi0st)) -C - DEOMEG=2.D0*PI*(DNCOS-UPCOS) -C - FTPROB(i) = FTPROB(i-1) + DBLE(sumall)*DEOMEG ! in mbarn -C - enddo -C - do i = 1, ntetdv -C - FTPNOR(ienbin,i) = SNGL(FTPROB(i)/FTPROB(ntetdv)) -C - enddo -C -C -C - RETURN - END -C -C -C..... -C -CC$LIST ON -C -C.************************************************************************* -* Author :A. Gasparian * -* date : 9/19/97 * -* * -*. Total sampling of Real Primakoff Events * -* * -C.************************************************************************* -C. - SUBROUTINE TOCRS2(engamk) -C -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C -C - COMMON/TMCAR1/FTPNOR(1:150,0:10000),tpi0ms(10000) -C - COMMON/TMCAR2/CRSSUM,CRSOME -C - DOUBLE PRECISION tpi0mx,tpi0mn,dpi0st,tpi0k - DOUBLE PRECISION UPCOS,DNCOS,DEOMEG -C - DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD -C - PARAMETER (PI=3.141592653) - PARAMETER (TWOPI=6.2831853071) - PARAMETER (PIBY2=1.57079632679) - PARAMETER (DEGRAD=0.01745329251) -C -C - ntetdv = 10000 - tpi0mx = DBLE(PKINE(9)) ! degree - tpi0mn = 0.000000D0 ! degree -C - dpi0st = (tpi0mx - tpi0mn)/DBLE(ntetdv) -C - CRSSUM = 0.000000 - CRSOME = 0.000000 -C - do i = 1, ntetdv -C - tpi0k = tpi0mn + DBLE(i)*dpi0st-dpi0st/2.D0 -C -C new total cross section subroutine, with variable Egamma -C - CALL CRSEC6(engamk,tpi0k,sumall) -C -C - CRSSUM = CRSSUM + sumall*SNGL(dpi0st) ! in milib -C -C here I add a term 1.D6 to the domega for accuracy, it will be taken -C in account in the call-ing subroutine -C - UPCOS = 1.D6*DCOS(DEGRAD*(tpi0k+dpi0st/2.D0)) - DNCOS = 1.D6*DCOS(DEGRAD*(tpi0k-dpi0st/2.D0)) -C - DEOMEG=2.D0*PI*(DNCOS-UPCOS) -C - CRSOME=CRSOME+sumall*SNGL(DEOMEG) ! in milibarn -C - enddo -C -C - RETURN - END -C -C -C..... -C -C -C$LIST OFF -C -C.************************************************************************* -*-- Author :A. Gasparian * -*-- DATE :9/02/97 * -* * -C * * -C *** To book Histograms for EVENT development * -C * * -* * -C.************************************************************************* -C - SUBROUTINE UHINIT -C - COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART - + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX - + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT -C - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCFLAX/BATCH, NOLOG - LOGICAL BATCH, NOLOG -C - COMMON/THARGT/THRPOS(3) -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - CHARACTER*6 COORDN(8) -C - CHARACTER*15 histfl -C - CHARACTER*2 subnam(100) - DATA subnam /'01','02','03','04','05','06','07','08','09','10', - +'11','12','13','14','15','16','17','18','19','20', - +'21','22','23','24','25','26','27','28','29','30', - +'31','32','33','34','35','36','37','38','39','40', - +'41','42','43','44','45','46','47','48','49','50', - +'51','52','53','54','55','56','57','58','59','60', - +'61','62','63','64','65','66','67','68','69','70', - +'71','72','73','74','75','76','77','78','79','80', - +'81','82','83','84','85','86','87','88','89','90', - +'91','92','93','94','95','96','97','98','99','XX'/ -C -C below are only for the reference -C - DATA COORDN/'X_g1 ', 'Y_g1 ','X_g2 ', 'Y_g2 ', - +'invmft', 'thetft', 'thetex', 'invmas'/ -C -Ct +'Tkirec','PL1G1X','PL1G1Y','PL1G2X','PL1G2Y','G1_reg','G2_reg', -Ct +'Eg1_LF','Eg2_LF','X_g1 ','Y_g1 ','Z_g1 ','X_g2 ','Y_g2 ', -Ct +'Z_g2 ','t_reco','efm_pi','Texppi','Fexppi', -Ct +'md#_g1','md#_g2','Psi_al','Psi_ex','Eg1_ex','Eg2_ex'/ -C - histfl='Gen_prt_'//subnam(IDRUN)//'.hist' -C - CALL HROPEN(1,'HBOOK',histfl,'N',1024,ISTAT) -C - IF(ISTAT.NE.0) GO TO 99 -C - CALL HBOOKN(101,'COOR. IN PL.',8,'//HBOOK',9950,COORDN) ! Ntupel #101 -C - - CALL HBOOK1(1,'Incident g-beam Energy BINS(GeV)$' - *,100,0.0,12.0, 0.0) - CALL HBOOK1(2,'Eta Polar Angle (deg.)$' - *,100,-0.1,3.9, 0.0) -C - CALL HBOOK1(21,'Eta Solid Angle (deg.)$' - *,100,-0.1,3.9, 0.0) -C - CALL HBOOK1(3,'Eta Azimutal Angle (deg.)$' - *,100,-10.0,370.0, 0.0) - CALL HBOOK1(4,'Eta Energy (GeV)$' - *,100,6.0,12.0, 0.0) - CALL HBOOK1(5,'Recoil Nucleus Polar Angle (deg.)$' - *,100,0.0,100.0, 0.0) - CALL HBOOK1(6,'Recoil Nucleus Kinetic Energy (MeV)$' - *,100,-0.1,19.9, 0.0) - CALL HBOOK1(7,'Two gamma Opening Angle (Degr.)$' - *,100,0.0,60.0, 0.0) -C - CALL HBOOK1(11,'X-position of the vertex on Target$' - *,400,-2.0,2.0, 0.0) - CALL HBOOK1(12,'Y-position of the vertex on Target$' - *,400,-2.0,2.0, 0.0) - ZCENTER =THRPOS(3)+20.00 - CALL HBOOK1(13,'Z-position of the vertex on Target$' - *,100,-(ZCENTER-50.0),(ZCENTER+50.0), 0.0) -C - CALL HBOOK1(31,'Random number gener $' - *,100,-3.0 ,3.0 , 0.0) -C - CALL HBOOK1(41,'Scattered-g1, PgX (GeV)$' - *,100,0.0,12.0, 0.0) - CALL HBOOK1(42,'Scattered-g1, PgY (GeV)$' - *,100,0.0,12.0, 0.0) - CALL HBOOK1(43,'Scattered-g1, PgZ (GeV)$' - *,100,0.0,12.0, 0.0) -C - CALL HBOOK1(44,'Scattered-g2, PgX (GeV)$' - *,100,0.0,12.0, 0.0) - CALL HBOOK1(45,'Scattered-g2, PgY (GeV)$' - *,100,0.0,12.0, 0.0) - CALL HBOOK1(46,'Scattered-g2, PgZ (GeV)$' - *,100,0.0,12.0, 0.0) -C - CALL HBIGBI(0,4) -C - 99 CONTINUE -C - RETURN - END -C. -C.......... -C. -C -C.************************************************************************ -*__ Author: A. Gasparian * -*-- DATE : 9/09/94 * -* * -C. * Routine to generate one hadronic interaction * -C. * * -C. * ==>Called by :GTHADR,GTNEUT * -C. * * -* * -C.************************************************************************ -C - SUBROUTINE GUHADR -C. -C. - COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA - + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO - + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH - + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF - + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR - + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN - + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR - + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA - + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU - + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1 - + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2 - + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3 - + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA -C. -C. -C. -C GHEISHA only if IHADR<3 (default) -C GHEISHA and HADRIN/NUCRIN if IHADR=3 -C - IF (IHADR.NE.4) THEN - CALL GHEISH - ELSE - CALL FLUFIN - ENDIF - END -C -C. -C..... -C. -C -C.*************************************************************************** -*__ Autor: A. Gasparian * -*-- DATE : 7/05/94 * -* * -C. * * -C. * Routine to compute Hadron inter-n probabilities * -C. * * -C. * ==>Called by : GTHADR,GTNEUT * -C. * * -* * -C.*************************************************************************** -C - SUBROUTINE GUPHAD -C. -C. - COMMON/GCPHYS/IPAIR,SPAIR,SLPAIR,ZINTPA,STEPPA - + ,ICOMP,SCOMP,SLCOMP,ZINTCO,STEPCO - + ,IPHOT,SPHOT,SLPHOT,ZINTPH,STEPPH - + ,IPFIS,SPFIS,SLPFIS,ZINTPF,STEPPF - + ,IDRAY,SDRAY,SLDRAY,ZINTDR,STEPDR - + ,IANNI,SANNI,SLANNI,ZINTAN,STEPAN - + ,IBREM,SBREM,SLBREM,ZINTBR,STEPBR - + ,IHADR,SHADR,SLHADR,ZINTHA,STEPHA - + ,IMUNU,SMUNU,SLMUNU,ZINTMU,STEPMU - + ,IDCAY,SDCAY,SLIFE ,SUMLIF,DPHYS1 - + ,ILOSS,SLOSS,SOLOSS,STLOSS,DPHYS2 - + ,IMULS,SMULS,SOMULS,STMULS,DPHYS3 - + ,IRAYL,SRAYL,SLRAYL,ZINTRA,STEPRA -C. - IF (IHADR.NE.4) THEN - CALL GPGHEI - ELSE - CALL FLDIST - ENDIF - END -C -C -C..... -C. -C -C.************************************************************************* -*____ Author :A. Gasparian * -*____ date : 8/23/94 * -* * -*. Generates Kinematics for primary track * -* * -C.************************************************************************* -C. - SUBROUTINE GUKINE -C. - COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART - + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX - + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT -C - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCFLAX/BATCH, NOLOG - LOGICAL BATCH, NOLOG -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - COMMON/KINEM1/EINI,TPI0,FIPI0G,EPI0SP,TRECSP,TKINRM - COMMON/KINEM2/PPREL(3) - COMMON/KINEM3/EPI0LF,PPI0LF(3),EG1LF,PG1LF(3),EG2LF,PG2LF(3) -C - COMMON/PHBMEN/EGFRAC(2) - COMMON/EQUIPH/QEQUPH -C - COMMON/BRMST1/egamak -C - DOUBLE PRECISION PI,TWOPI,PIBY2,DEGRAD,RADDEG,CLIGHT,BIG,EMASS - DOUBLE PRECISION EMMU,PMASS,AVO -C - PARAMETER (PI=3.141592653) - PARAMETER (TWOPI=6.2831853071) - PARAMETER (PIBY2=1.57079632679) - PARAMETER (DEGRAD=0.01745329251) - PARAMETER (RADDEG=57.2957795130) - PARAMETER (CLIGHT=29979245800.) - PARAMETER (BIG=10000000000.) - PARAMETER (EMASS=0.0005109990615) - PARAMETER (EMMU=0.105658387) - PARAMETER (PMASS=0.9382723128) - PARAMETER (AVO=0.60221367) -C -C - DIMENSION VERTEX(3),PLAB(3) - SAVE VERTEX,PLAB - DATA VERTEX/3*0./ - DATA PLAB /3*0./ -C -C -C Kinematics for Real eta Primakoff -C - IK=IKINE -C -C -C PKINE(1) => is the initial Electron beam energy in GeV -C PKINE(9) => is the Eta meson maximum Polar angle in degees -C First one here is IKINE => the type of the particle ( be careful ) -C -C sampling of photon energy egamak, for each event -C - CALL BRENER -C -C With the initial photon energy the eta polar angle will be sampled -C and all kinematical variables including the eta -> g+g decay channel -C will be calculated. -C - CALL PR_KIN -C -C -C Dave, here: EPI0LF,PPI0LF(3) are the eta energy and three momenta -C EG1LF,PG1LF(3) energy and three momenta of the 1th gamma -C EG2LF,PG2LF(3) energy and three momenta of the 2th gamma -C -C -C below are the X, Y and Z widths of the beam (are +/-) -C - xwidth = 0.0 - ywidth = 0.0 - zwidth = 0.0 -C -Cn CALL RANLUX(RNDM,2) -C - VERTEX(1) = 0.000 - VERTEX(2) = 0.000 - VERTEX(3) = 50.000 -C -Cn CALL RANLUX(RNDM,2) -C -Cn CALL HF1(11,VERTEX(1),1.) -Cn CALL HF1(12,VERTEX(2),1.) -Cn CALL HF1(13,VERTEX(3),1.) -C First Gamma from eta -> g + g -C - CALL GSVERT(VERTEX,0,0,0,0,NVTX) -C - CALL GSKINE(PG1LF, 1 ,NVTX,0,0,NT) -C -C Second Gamma from pi0 -> g + g -C - CALL GSVERT(VERTEX,NT,NT,0,0,NVTX) -C - CALL GSKINE(PG2LF, 1 ,NVTX,0,0,NT) -C - CALL HF1(41,PG1LF(1),1.) - CALL HF1(42,PG1LF(2),1.) - CALL HF1(43,PG1LF(3),1.) - CALL HF1(44,PG2LF(1),1.) - CALL HF1(45,PG2LF(2),1.) - CALL HF1(46,PG2LF(3),1.) -C ........................................................ -C writing events for Pawel like Matt, 10/20/2009 -C -C IDRUN is the run mumber from *.dat file - Id_run = IDRUN - loop = IEVENT - Npartl = 2 -C -CDL write(11,1)Id_run, loop, Npartl -CDL 1 format(I5,1x,I8,1x,I8) -C -C the 1th particle: first gama from eta --> g+g - -CDL write(11,6) -CDL 6 format('1', ' 1', 1x, '0.000') -CDL write(11,7)PG1LF(1),PG1LF(2),PG1LF(3), EG1LF -CDL 7 format(' 0',1x, F10.6,1x,F10.6,1x,F10.6, 1x, F10.6) -C -C the 2th particle: second decay g from eta-->g+g -C -CDL write(11,8) -CDL 8 format('2', ' 1', 1x, '0.000') -CDL write(11,9)PG2LF(1),PG2LF(2),PG2LF(3),EG2LF -CDL 9 format(' 0',1x, F10.6,1x,F10.6,1x,F10.6, 1x, F10.6) - -C ................................................... end of Matt -C *** Kinematics debug (controlled by ISWIT(1) ) -C - IF(IDEBUG.EQ.1) THEN - IF(ISWIT(1).EQ.1) THEN - CALL GPRINT('VERT',0) - CALL GPRINT('KINE',0) - ENDIF - ENDIF -C. -C. - RETURN - END -C -C. -C..... -C. -C -C.************************************************************************* -*____ Author :A. Gasparian * -*____ date : 10/21/97 * -* * -*. Samples gamma with energy according bremsstrahlung beam * -* assuming Bethe Gaitler form of Energy * -* * -C.************************************************************************* -C. - SUBROUTINE BRENER -C -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - COMMON/PHBMEN/EGFRAC(2) - COMMON/EQUIPH/QEQUPH -C - COMMON/TMCAR4/egammn,egammx,denest - COMMON/BRMST1/egamak -C - DOUBLE PRECISION egammx,egammn,denest -C -C PKINE(1) => is the initial Electron beam energy in GeV -C - CALL RANLUX(RTL,1) -C -C see page # 38 in the book #2 -C - DRL = DBLE(RTL) - egamak=SNGL(DEXP(DRL*(DLOG(egammx)-DLOG(egammn))+DLOG(egammn))) -C -C -C - RETURN - END -C -C. -C..... -C. -C -C.************************************************************************ -*____ Author :A. Gasparian * -*____ date : 8/23/94 * -* * -C. * * -C. * Routine to control tracking of one event * -C. * * -C. * Called by GRUN * -C. * * -*.************************************************************************ -C - SUBROUTINE GUTREV -C. - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD - COMMON/ANGL12/SNTEL,CSTEL,SNTHD,CSTHD - COMMON/ANGL13/SNTET,CSTET,SPMSET -C -C. -C. - CALL GTREVE -C. - RETURN - END -C. -C -C...... -C. -C.************************************************************************ -*____ Author :A. Gasparian * -*____ date : 7/12/94 * -* * -C. * * -C. * This routine called at the end of each tracking step * -C. * INWVOL is different from 0 when the track has reached * -C. * ISTOP is different from 0 if the track has stopped * -C. * * -C. * -C.************************************************************************ -C - SUBROUTINE GUSTEP -C - COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART - + ,JROTM ,JRUNG ,JSET ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX - + ,JVOLUM,JXYZ ,JGPAR ,JGPAR2,JSKLT - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCFLAX/BATCH, NOLOG - COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15), - +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15), - +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3) - LOGICAL BATCH, NOLOG -C - COMMON/GCTMED/NUMED,NATMED(5),ISVOL,IFIELD,FIELDM,TMAXFD,STEMAX - + ,DEEMAX,EPSIL,STMIN,CFIELD,PREC,IUPD,ISTPAR,NUMOLD - COMMON/GCTLIT/THRIND,PMIN,DP,DNDL,JMIN,ITCKOV,IMCKOV,NPCqOV - -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C -C - COMMON/GCSETS/IHSET,IHDET,ISET,IDET,IDTYPE,NVNAME,NUMBV(20) -C - INTEGER MXGKIN - PARAMETER (MXGKIN=100) - COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN), - + TOFD(MXGKIN),IFLGK(MXGKIN) - INTEGER MXPHOT - PARAMETER (MXPHOT=800) - COMMON/GCKIN2/NGPHOT,XPHOT(11,MXPHOT) - COMMON/GCKIN3/GPOS(3,MXGKIN) - INTEGER KCASE,NGKINE ,IFLGK - INTEGER NGPHOT - REAL GKIN,TOFD,GPOS -C - PARAMETER (MAXMEC=30) - COMMON/GCTRAK/VECT(7),GETOT,GEKIN,VOUT(7),NMEC,LMEC(MAXMEC) - + ,NAMEC(MAXMEC),NSTEP ,MAXNST,DESTEP,DESTEL,SAFETY,SLENG - + ,STEP ,SNEXT ,SFIELD,TOFG ,GEKRAT,UPWGHT,IGNEXT,INWVOL - + ,ISTOP ,IGAUTO,IEKBIN, ILOSL, IMULL,INGOTO,NLDOWN,NLEVIN - + ,NLVSAV,ISTORY -C - COMMON/MAGCUT/CUTMAG(10),MGNSTP -C - COMMON/GCNUM/NMATE ,NVOLUM,NROTM,NTMED,NTMULT,NTRACK,NPART - + ,NSTMAX,NVERTX,NHEAD,NBIT -C - CHARACTER*4 NAMES -C. - CALL GDCXYZ ! SHOWING THE TRECKS INTERACTIVLY -C. -Cn CALL ACC -C -C.......,,,,,,, -C. -C. Debug event -C -CT IF(IDEBUG.EQ.1) THEN -C -CT 50 CALL GDEBUG -C -CT IF(ISWIT(1).EQ.1) THEN -CT CALL GSXYZ -C -CT ENDIF -CT ENDIF -C -C - RETURN - END -C -C...... -C. -C -C.************************************************************************ -*____ Autor :A. Gasparian * -*____ data : 7/21/94 * -* * -* * -C.************************************************************************ -C - SUBROUTINE GUOUT -C - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD - COMMON/GCFLAX/BATCH, NOLOG - LOGICAL BATCH, NOLOG -C -C - RETURN - END -C. -C -C......... -C -C -C -C.************************************************************************** -*____ Author :A. Gasparian * -*____ date : 8/23/94 * -* * -C. * * -C. * Termination routine to print histograms and statistics * -C. * * -* * -C.************************************************************************** -C - SUBROUTINE UGLAST -C -C - COMMON/GCFLAG/IDEBUG,IDEMIN,IDEMAX,ITEST,IDRUN,IDEVT,IEORUN - + ,IEOTRI,IEVENT,ISWIT(10),IFINIT(20),NEVENT,NRNDM(2) -C - COMMON/ACCCAL/NHOLMC,NOUTMC - COMMON/ACCCA2/N1gpwo -C - COMMON/GCFLAX/BATCH, NOLOG - LOGICAL BATCH, NOLOG -C - CALL GLAST -C - CALL HROUT(0,ICYCLE,' ') - CALL HREND('HBOOK') -C -C for the file opened for the event generator - close(unit=11) -C -C - RETURN - END -C. -C...... -C. diff --git a/src/programs/Simulation/geneta/geneta.cc b/src/programs/Simulation/geneta/geneta.cc deleted file mode 100644 index 0c334bfe26..0000000000 --- a/src/programs/Simulation/geneta/geneta.cc +++ /dev/null @@ -1,168 +0,0 @@ - - -#include "bg_hddm.h" -#include "c_cern.h" - -#include -using namespace std; - -unsigned int Nevents_to_gen = 10368; // this must be changed in eta_p_gen.dat as well -bool use_interactive = false; -string output_fname="eta_primakoff.hddm"; - -void Usage(void); -void ParseCommandLineArgs(int narg, char *argv[]); - - -//------------------------ -// main -//------------------------ -int main(int narg, char *argv[]) -{ - - // Parse the command line arguments - ParseCommandLineArgs(narg, argv); - - // Initialize cernlib stuff - int nwgean=NWGEAN; - int nwpaw=-NWPAW; - quest_[9] = 65000; - if(use_interactive){ - gpaw_(&nwgean, &nwpaw); - }else{ - cout<<"Initializing. Please wait a moment ...."<g+g in center of mass -C - SUBROUTINE ETA_CM -C -C -C - COMMON/GCKINE/IKINE,PKINE(10),ITRA,ISTAK,IVERT,IPART,ITRTYP - + ,NAPART(5),AMASS,CHARGE,TLIFE,VERT(3),PVERT(4),IPAOLD -C - COMMON/KINEM1/EINI,TPI0,FIPI0G,EPI0SP,TRECSP,TKINRM - COMMON/KINEM2/PPREL(3) - COMMON/KINEM3/EPI0LF,PPI0LF(3),EG1LF,PG1LF(3),EG2LF,PG2LF(3) -C - COMMON/KING12/TG1CMG,FG1CMG - COMMON/KING23/PSIG12 -C -Cn COMMON/G1SAMP/CMG1MM(2) -C - DIMENSION PG1CM(3),PG2CM(3) - DIMENSION RNDM(2) -C - PARAMETER (PI=3.1415926) - PARAMETER (TWOPI=6.283185) - PARAMETER (PIBY2=1.57079632) - PARAMETER (DEGRAD=0.01745329) - PARAMETER (RADDEG=57.29577951) - PARAMETER (EMASS=0.00051099) -C - PARAMETER (EMPI0=0.54745) ! For eta experiment -C -C -C -C Eta -> g + g in Eta Cener Macc -C - EG1CM = EMPI0/2. - EG2CM = EMPI0/2. -C - PG1CF = EG1CM - PG2CF = EG2CM -C -C Random sampling of eta -> g + g decay in CM -C -C -C General formula for translation (0,1) to (a,b) is -C c=RNDM*(b-a)+a where RNDM from (0,1) and c will be in (a,b) -C -C TG1CM in (0,180 deg) and FG1CM in (0,180 deg),<= they are identical -C and because d(solid angle)= d(cos(Teta))*d(Fi) -C and COS(0)= +1 and COS(180)= -1. -C - TG1MIN= 0.00000 - TG1MAX= 180.00000 -C - CSMIN = COS(DEGRAD*TG1MIN) - CSMAX = COS(DEGRAD*TG1MAX) -C - CALL RANLUX(RNDM,2) -C - RANDCS= RNDM(1)*(CSMAX-CSMIN)+CSMIN - TG1CM = ACOS(RANDCS) -C - TG1CMG= RADDEG*TG1CM -C - FG1CM = PI*RNDM(2) -C - FG1CMG = RADDEG*FG1CM -C for first gama -C - PG1CM(1) = PG1CF*SIN(TG1CM)*COS(FG1CM) - PG1CM(2) = PG1CF*SIN(TG1CM)*SIN(FG1CM) - PG1CM(3) = PG1CF*COS(TG1CM) -C -C for second gamma -C - PG2CM(1) = - PG1CM(1) - PG2CM(2) = - PG1CM(2) - PG2CM(3) = - PG1CM(3) -C -C Lorentz Transformation to the Lab Frame -C -C ETA CM Parameters -C - GAMMA = EPI0LF/EMPI0 - BETAX = PPI0LF(1)/EPI0LF - BETAY = PPI0LF(2)/EPI0LF - BETAZ = PPI0LF(3)/EPI0LF -C -C For First Gamma -C - SCALAR= BETAX*PG1CM(1)+BETAY*PG1CM(2)+BETAZ*PG1CM(3) -C - EG1LF = GAMMA*(EG1CM + SCALAR) -C - TERM = GAMMA*(EG1CM+GAMMA*SCALAR/(GAMMA+1.)) -C - PG1LF(1) = PG1CM(1) + BETAX*TERM - PG1LF(2) = PG1CM(2) + BETAY*TERM - PG1LF(3) = PG1CM(3) + BETAZ*TERM -C -C For Second Gamma -C - SCALAR= BETAX*PG2CM(1)+BETAY*PG2CM(2)+BETAZ*PG2CM(3) -C - EG2LF = GAMMA*(EG2CM + SCALAR) -C - TERM = GAMMA*(EG2CM+GAMMA*SCALAR/(GAMMA+1.)) -C - PG2LF(1) = PG2CM(1) + BETAX*TERM - PG2LF(2) = PG2CM(2) + BETAY*TERM - PG2LF(3) = PG2CM(3) + BETAZ*TERM -C -C Opening Angle betwean g1 and g2 in Lab fram -C - PG1PG2 = PG1LF(1)*PG2LF(1)+PG1LF(2)*PG2LF(2)+PG1LF(3)*PG2LF(3) - CSPSI = PG1PG2/(EG1LF*EG2LF) - PSIG12 = RADDEG*ACOS(CSPSI) ! in degrees -C - CALL HF1(7,PSIG12,1.) -C - RETURN - END -C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/programs/Simulation/genp_pi0/Makefile b/src/programs/Simulation/genp_pi0/Makefile deleted file mode 100644 index 0b84cbf3fe..0000000000 --- a/src/programs/Simulation/genp_pi0/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -PACKAGES := -ADDITIONAL_MODULES = HDDM - - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/genp_pi0/bg_hddm.cc b/src/programs/Simulation/genp_pi0/bg_hddm.cc deleted file mode 100644 index 28782497c2..0000000000 --- a/src/programs/Simulation/genp_pi0/bg_hddm.cc +++ /dev/null @@ -1,132 +0,0 @@ -#include -#include -#include - -#include "HDDM/hddm_s.hpp" - -std::ofstream *fileOutputStream = NULL; -hddm_s::ostream *hddmOutputStream = NULL; - -typedef struct { - int geantid; - int mech; /* what do the values of this correspond to */ - int kfid; - int parent; - int firstdaughter; - int lastdaughter; -} keve_t; - -typedef struct { - float px; - float py; - float pz; - float en; -} peve_t; - -/*----------------- -// open_hddm_output_ -//-----------------*/ -void open_hddm_output(std::string outputfile) -{ - /* Open output file */ - fileOutputStream = new std::ofstream(outputfile.c_str()); - if (! fileOutputStream->is_open()) { - fprintf(stderr, "Unable to open output file \"%s\" for writing.\n", - outputfile.c_str()); - exit(-3); - } - hddmOutputStream = new hddm_s::ostream(*fileOutputStream); - printf("Opened HDDM file \"%s\" for writing ...\n", outputfile.c_str()); -} - -/*----------------- -// close_hddm_output_ -//-----------------*/ -void close_hddm_output(void) -{ - /* Close output file */ - delete hddmOutputStream; - delete fileOutputStream; - - printf("Closed HDDM output file\n"); -} - -/*----------------- -// write_hddm_event_ -//-----------------*/ -void write_hddm_event(int *iev, int *iproc, - keve_t *kin, peve_t *pin, - int *ntra, keve_t *keve, peve_t *peve) -{ - /* Loop over events */ - int i; - static int Nevents = 0; - static int Nevents_written = 0; - int runNumber=2; - float vertex[3]={0.0, 0.0, 65.0}; - - Nevents++; - - /* Start a new event */ - hddm_s::HDDM record; - hddm_s::PhysicsEventList pes = record.addPhysicsEvents(); - pes().setRunNo(runNumber); - pes().setEventNo(Nevents); - hddm_s::ReactionList rs = pes().addReactions(); - rs().setType(*iproc); - hddm_s::BeamList bs = rs().addBeams(); - bs().setType((Particle_t)kin[0].geantid); - hddm_s::MomentumList bmoms = bs().addMomenta(); - bmoms().setPx(pin[0].px); - bmoms().setPy(pin[0].py); - bmoms().setPz(pin[0].pz); - bmoms().setE(pin[0].en); - hddm_s::PropertiesList bpros = bs().addPropertiesList(); - bpros().setCharge(0.0); - bpros().setMass(0.0); - - hddm_s::TargetList ts = rs().addTargets(); - ts().setType((Particle_t)kin[1].geantid); - hddm_s::MomentumList tmoms = ts().addMomenta(); - tmoms().setPx(pin[1].px); - tmoms().setPy(pin[1].py); - tmoms().setPz(pin[1].pz); - tmoms().setE(pin[1].en); - hddm_s::PropertiesList tpros = ts().addPropertiesList(); - tpros().setCharge(+1); - tpros().setMass(0.938272); /* this should be derived from type ... */ - - hddm_s::VertexList vs = rs().addVertices(); - hddm_s::OriginList os = vs().addOrigins(); - hddm_s::ProductList ps = vs().addProducts(*ntra); - - os().setT(0.0); - os().setVx(vertex[0]); - os().setVy(vertex[1]); - os().setVz(vertex[2]); - - for (i=0; i < *ntra; i++) { - //double E2; - //if (keve[i].geantid == 0) - // continue; - - ps(i).setType((Particle_t)keve[i].geantid); - ps(i).setMech(keve[i].mech); - ps(i).setPdgtype(keve[i].kfid); - ps(i).setId(i+1); - ps(i).setParentid(keve[i].parent); - hddm_s::MomentumList pmoms = ps(i).addMomenta(); - pmoms().setPx(peve[i].px); - pmoms().setPy(peve[i].py); - pmoms().setPz(peve[i].pz); - pmoms().setE(peve[i].en); - } - - if (*ntra > 0) { - Nevents_written++; - *hddmOutputStream << record; - if (Nevents_written%10000 == 0) - printf("Wrote event %d events (%d generated)\n", - Nevents_written, Nevents); - } -} diff --git a/src/programs/Simulation/genp_pi0/bg_hddm.h b/src/programs/Simulation/genp_pi0/bg_hddm.h deleted file mode 100644 index e9922242f0..0000000000 --- a/src/programs/Simulation/genp_pi0/bg_hddm.h +++ /dev/null @@ -1,23 +0,0 @@ -#include - -typedef struct{ - int geantid; - int mech; /* what do the values of this correspond to */ - int kfid; - int parent; - int firstdaughter; - int lastdaughter; -}keve_t; - -typedef struct{ - float px; - float py; - float pz; - float en; -}peve_t; - - -void open_hddm_output(std::string outputfile); -void close_hddm_output(void); -void write_hddm_event(int *iev, int *iproc, keve_t *kin, peve_t *pin, int *ntra, keve_t *keve, peve_t *peve); - diff --git a/src/programs/Simulation/genp_pi0/cern.h b/src/programs/Simulation/genp_pi0/cern.h deleted file mode 100755 index f59e105b66..0000000000 --- a/src/programs/Simulation/genp_pi0/cern.h +++ /dev/null @@ -1,268 +0,0 @@ - - -#ifndef __CERN_H__ -#define __CERN_H__ - -#define real float -#define integer int -#define logical int - - -/* GEANT Particle types */ -enum geant_particles{ - ptype_none, - ptype_gamma, - ptype_positron, - ptype_electron, - ptype_neutrino, - ptype_muon_plus, - ptype_muon_minus, - ptype_pion_zero, - ptype_pion_plus, - ptype_pion_minus, - ptype_kaon_zero_long, - ptype_kaon_plus, - ptype_kaon_minus, - ptype_neutron, - ptype_proton, - ptype_antiproton, - ptype_kaon_zero_short, - ptype_eta, - - // The following are particle types not defined in GEANT - // This is a bit dangerous since GEANT has other particle - // types defined which will use these values - ptype_rho, - ptype_omega, - ptype_eta_prime -}; - -#define ELECTRON_MASS 0.00051100 -#define MUON_MASS 0.10566 -#define PI_CHARGED_MASS 0.13957 -#define PI_ZERO_MASS 0.13498 -#define KAON_CHARGED_MASS 0.49368 -#define KAON_ZERO_MASS 0.49767 -#define ETA_MASS 0.54745 -#define PROTON_MASS 0.93827 -#define NEUTRON_MASS 0.93957 -#define OMEGA_MASS 0.78194 -#define RHO_MASS 0.770 -#define ETA_PRIME_MASS 0.95778 -#define PHI_MASS 1.019413 -#define DEUTERON_MASS 1.877 -#define TRITON_MASS 2.1573 -#define LAMBDA_MASS 1.115683 -#define SIGMA_ZERO_MASS 1.192642 - - -/* Common Block Declarations */ -typedef struct { - integer jdigi, jdraw, jhead, jhits, jkine, jmate, jpart, jrotm, jrung, - jset, jstak, jgstat, jtmed, jtrack, jvertx, jvolum, jxyz, jgpar, - jgpar2, jsklt; -} gclink_t; -extern gclink_t gclink_; - -typedef struct { - integer nrecrz, nrget, nrsave, lrget[20], lrsave[20]; -} gcrz1_t; -extern gcrz1_t gcrz1_; - -typedef struct { - char rztags[32]; -} gcrz2_t; -extern gcrz2_t gcrz2_; - -typedef struct { - integer idebug, idemin, idemax, itest, idrun, idevt, ieorun, ieotri, - ievent, iswit[10], ifinit[20], nevent, nrndm[2]; -} gcflag_t; -extern gcflag_t gcflag_; - -typedef struct { - logical batch, nolog; -} gcflax_t; -extern gcflax_t gcflax_; - -typedef struct { - integer ikine; - real pkine[10]; - integer itra, istak, ivert, ipart, itrtyp, napart[5]; - real xamass, charge, tlife, vert[3], pvert[4]; - integer ipaold; -} gckine_t; -extern gckine_t gckine_; - -typedef struct { - integer ihset, ihdet, iset, idet, idtype, nvname, numbv[20]; -} gcsets_t; -extern gcsets_t gcsets_; - -typedef struct { - real timint, timend; - integer itime, igdate, igtime; -} gctime_t; -extern gctime_t gctime_; - -typedef struct { - real vect[7], getot, gekin, vout[7]; - integer nmec, lmec[30], namec[30], nstep, maxnst; - real destep, destel, safety, sleng, step, snext, sfield, tofg, gekrat, - upwght; - integer ignext, inwvol, istop, igauto, iekbin, ilsol, imull, ingoto, - nldown, nlevin, nlsav, istory; -} gctrak_t; -extern gctrak_t gctrak_; - -typedef struct { - real polar[3]; - integer namec1[30]; -} gctpol_t; -extern gctpol_t gctpol_; - -typedef struct { - integer kcase, ngkine; - real gkin[100][5], tofd[100]; - integer iflgk[100]; -} gcking_t; -extern gcking_t gcking_; - -typedef struct { - integer ngphot; - real xphot[800][11] ; -} gckin2_t; -extern gckin2_t gckin2_; - -typedef struct { - real gpos[100][3]; -} gckin3_t; -extern gckin3_t gckin3_; - -typedef struct { - integer np; - real tecm, amass[18]; - integer kgenev; -} genin_t; -extern genin_t genin_; - -typedef struct { - real pcm[18][5], wt; -} genout_t; -extern genout_t genout_; - -typedef struct { - integer nlevel; - char names[60]; - integer number[15]; - integer lvolum[15]; - integer lindex[15]; - integer inform,nlevmx; - integer nldev[15]; - integer linmx[15]; - real gtran[45]; - real grmat[150]; - real gonly[15]; - real glx[3]; -} gcvolu_t; -extern gcvolu_t gcvolu_; - -typedef struct { - int ipair; - real spair,slpair,zintpa,steppa; - int icomp; - real scomp,slcomp,zintco,stepco; - int iphot; - real sphot,slphot,zintph,stepph; - int ipfis; - real spfis,slpfis,zintpf,steppf; - int idray; - real sdray,sldray,zintdr,stepdr; - int ianni; - real sanni,slanni,zintan,stepan; - int ibrem; - real sbrem,slbrem,zintbr,stepbr; - int ihadr; - real shadr,slhadr,zintha,stepha; - int imunu; - real smunu,slmunu,zintmu,stepmu; - int idcay; - real sdcay,slife ,sumlif,dphys1; - int iloss; - real sloss,soloss,stloss,dphys2; - int imuls; - real smuls,somuls,stmuls,dphys3; - int irayl; - real srayl,slrayl,zintra,stepra; -} gcphys_t; -extern gcphys_t gcphys_; - - -/* Function declarations */ -#ifdef __cplusplus -extern "C" { -#endif -void hbname(int i,char *b,void *v,char *f); -void hbnamc(int i,char *b,char *v,char *f); -void hbook1(int n,char *N,int b,real m,real M,real v); -void hbook2(int n,char *N,int nx,real xm,real xM,int ny,real ym,real yM,real v); -void hbprof(int n,char *N,int nx,float xm,float xM,float ym,float yM,char *chopt); -void hbookn(int id,char *t,int NVAR,char *rz,int nw,char *tags); -void hbnt(int id,char *t,char *o); -void hlabel(int ID, int NLAB, char *CLAB, char*CHOPT); -void hcopy(int id1,int id2,char *ti); -int hropen(int lun,char *nam,char*fnam,char*stat,int stor,int istat); -void hlimit(int size); -void gzebra(int size); -void hrput(int id, char *file, char *opt); -void hf1(int id, real data, real weight); -void hf2(int id,real data1,real data2,real weight); -void hfill(int id,float data1,float data2,float weight); -void hdelet(int id); -void hrin( int id, int icycle , int iofset ); -void hfithn(int id, char *chfun, char *chopt, int np, real par[], - real step[], real pmin[], real pmax[], real sigpar[], real *chi2); -void hunpak(int histo,real contents[],char choice[], int num); -void hidopt( int id, char *chopt); -void hpak(int histo,real contents[]); -void hrget( int id, char *chfile, char *chopt); -void hldir(char dir[],char flag[]); -void hmdir(char dir[],char flag[]); -void hcdir(char dir[],char flag[]); -void hrout(int num, int icycle, char*opt); -void hrend(char*filename); -void hreset(int no, char* opt); -void hfn(int id, real data[]); -void hfnt(int id); -void hfntb(int id,char *chblok); -void hprnt(int id); -void grndmq(int iseed1,int iseed2,int iseq,char *chopt); -void gsxyz(void); -void gdxyz(int k); -void gsvolu(char *name,char *type, int media , real PAR[],int NPAR,int *IVOL); -void gspos(char *VOL ,int id, char *MOTH ,real x, real y, real z, int IROT,char *CHONLY); -void gsrotm(int id,real th1,real ph1,real th2,real ph2,real th3,real ph3); -void gsdetv(char *CHSET,char *CHDET,int IDTYPE,int NWHI,int NWDI,int *ISET,int *IDET); -void gstpar(int ITMED, char* CHPAR, float PARVAL); -void gdeca2(real XMO,real XM1,real XM2,real**PCM); -void gdeca3(real XMO,real XM1,real XM2,real XM3,real**PCM); -void gmate(void); -void gsmixt(int IMATE, char* NAMATE, float* A, float* Z,float DENS,int NLMAT, float* WMAT); -void gsmate(int IMATE, char* CHNAMA, float A, float Z, float DENS, float RADL, float ABSL, float* UBUF, int NWBUF); -void gfmate(int IMATE, char* CHNAMA, float* A, float* Z, float* DENS, float* RADL, float* ABSL, float* UBUF, int* NWBUF); -void gpmate(int IMATE); -void gstmed(int ITMED, char* NATMED, int NMAT, int ISVOL, int IFIELD, float FIELDM, float TMAXFD,float STEMAX, float DEEMAX, float EPSIL, float STMIN, float* UBUF, int NWBUF ); -void gptmed(int ITMED); -void gsatt(char *volu,char *attr,int ival); -void gprint(char *volu,int ival); -void ixupdwi(int ival); -void gsxyz(void); -void gdxyz(int ival); -void gsking(int ival); -void ffkey(char *KEY, void *VAR, int NVAR, char *TYPE); -void mninit(int a,int b, int c); -#ifdef __cplusplus -} -#endif - -#endif /* __CERN_H__ */ diff --git a/src/programs/Simulation/genp_pi0/genp_pi0.cc b/src/programs/Simulation/genp_pi0/genp_pi0.cc deleted file mode 100644 index 12a6706ac2..0000000000 --- a/src/programs/Simulation/genp_pi0/genp_pi0.cc +++ /dev/null @@ -1,1368 +0,0 @@ -// $Id: pi0_proton_photoprod.cc,v 1.6 2006/04/06 01:35:56 mikewood Exp $ -// Description: -// -// This generator photo-produces pi0s off of the proton. -// I'd don't recall the exact source of the cross-section tables -// so they may be completely wrong. - -#include -#include -#include -#include -using namespace std; - -#include - -#include "kinematics.h" -#include "cern.h" -#include "bg_hddm.h" - -char Name[] = "pi0 photoprod-proton"; -char Description[] = "pi0 photoproduction off the proton."; - -float BEAM_ENERGY = 9.0; -int Nmax = 100; - -typedef struct { - float theta; - float total; - float primakoff; - float nuclear; - float interference; -}cross_section_t; -#define N_pi0_H_4_5GeV 1001 -extern cross_section_t pi0_H_4_5GeV[N_pi0_H_4_5GeV]; - - -// Total integrals (used to decide which mechanism created pi0) -double It=0.0,Ip=0.0,In=0.0,Ii=0.0; - -double BREM_LO = 0.69167; -double BREM_HI = 0.75833; -#define cm 1.0 - -#define _DBG_ cerr<<__FILE__<<":"<<__LINE__<<" " - -void ParseCommandLineArguments(int narg, char *argv[]); -void Usage(void); -int Init(double Ebeam); -int GenerateEvent(int *Ninitial // Number of incident particles - ,mcparticle_t* initial // Array of incident particles - ,int *Nintermediary // Number of intermediary particles - ,mcparticle_t* intermediary // Intermediary particles array - ,int *Nfinal // Number of final state particles - ,mcparticle_t* final // Array of final state particles - ,int *production_mech // prod channel (specific to generator) - ,int *decay_mech); // decay channel (specific to generator) - - -//---------------------- -// main -//---------------------- -int main(int narg, char *argv[]) -{ - ParseCommandLineArguments(narg, argv); - - open_hddm_output("genp_pi0.hddm"); - - Init(9.0); - - for(int N=0; N keve; - vector peve; - - // Beam - kin[0].geantid = initial[0].type; - kin[0].mech = production_mech; - kin[0].kfid = 0; - kin[0].parent = 0; - kin[0].firstdaughter = 0; - kin[0].lastdaughter = 0; - pin[0].px = initial[0].v.x; - pin[0].py = initial[0].v.y; - pin[0].pz = initial[0].v.z; - pin[0].en = initial[0].v.E; - - // Target - kin[1].geantid = 14; - kin[1].mech = production_mech; - kin[1].kfid = 0; - kin[1].parent = 0; - kin[1].firstdaughter = 0; - kin[1].lastdaughter = 0; - pin[1].px = 0.0; - pin[1].py = 0.0; - pin[1].pz = 0.0; - pin[1].en = PROTON_MASS; - - keve.clear(); - peve.clear(); - for(int i=0; i=narg){ - cerr<<"Argument \""<total; - c->total = It; - Ip += c->primakoff; - c->primakoff = Ip; - In += c->nuclear; - c->nuclear = In; - Ii += c->interference; - c->interference = Ii; - } - // Next, normalize tables - c=pi0_H_4_5GeV; - for(int i=0;itheta /= 1000.0; //convert from mrad to rad for later - c->total /= It; - c->primakoff /= Ip; - c->nuclear /= In; - c->interference /= Ii; - } - - // Normalize three total integrals to total so we can generate - // them in the proper proportions - double Itotal = Ip + In + Ii; - Ip/=Itotal; - In/=Itotal; - Ii/=Itotal; - - return 0; -} - -//---------------------- -// GenerateEvent -//---------------------- -int GenerateEvent(int *Ninitial // Number of incident particles - ,mcparticle_t* initial // Array of incident particles - ,int *Nintermediary // Number of intermediary particles - ,mcparticle_t* intermediary // Intermediary particles array - ,int *Nfinal // Number of final state particles - ,mcparticle_t* final // Array of final state particles - ,int *production_mech // prod channel (specific to generator) - ,int *decay_mech) // decay channel (specific to generator) -{ - // Incident photon - *Ninitial = 1; - initial->type = ptype_gamma; - initial->v.E = BEAM_ENERGY; - - // sample vertex from a cylindrical target aligned with the beamline. - // for simplicity, let the radial distribution be exponential. - float beam_width = 0.2*cm; - float target_radius = 1.0*cm; - float target_length = 40.0*cm; - float r; - float k = log(2.0)/beam_width; - do{ - double s = ((double)random()/(double)RAND_MAX); - r = fabs(log(1.0-s)/k); - }while(r>target_radius); - double s = ((double)random()/(double)RAND_MAX); - double ss = ((double)random()/(double)RAND_MAX); - float vphi = 2.0*M_PI*s; - float z = ss*target_length - (target_length/2.0); - initial->x = r*cos(vphi); - initial->y = r*sin(vphi); - initial->z = z; - initial->v.x = 0.0; - initial->v.y = 0.0; - initial->v.z = initial->v.E; - - // Intermediary state particles (pi0) - // -- Determine production mechanism - s = ((double)random()/(double)RAND_MAX); - ss = ((double)random()/(double)RAND_MAX); - cross_section_t *c=pi0_H_4_5GeV; - int index; - double delta_cross; - if(s<=Ip){ - // Primakoff - for(index=0;indexprimakoff)break; - delta_cross = c->primakoff + c[1].primakoff; - *production_mech=0; - }else if(s<=(Ip+In)){ - // Nuclear Coherent - for(index=0;indexnuclear)break; - delta_cross = c->nuclear + c[1].nuclear; - *production_mech=1; - }else{ - // Interference - for(index=0;indexinterference)break; - delta_cross = c->interference + c[1].interference; - *production_mech=2; - } - double pi0_theta=c->theta+(c->theta+c[1].theta)*(ss-c->theta)/delta_cross; - double pi0_phi = 2.0*M_PI*((double)random()/(double)RAND_MAX); - - // Smear pi0 theta by +/-10^3 degrees to wash out some binning effects - pi0_theta += (M_PI/180.0)*0.005*(1.0 - 2.0*((double)random()/(double)RAND_MAX)); - - // Calculate pi0 momentum - double M_N = PROTON_MASS; - double Eg = initial->v.E; - double L = Eg/(Eg + M_N); - double K = (Eg*M_N + pow(PI_ZERO_MASS,2.0)/2.0)/(Eg + M_N); - double A = pow(L*cos(pi0_theta),2.0) - 1.0; - double B = 2.0*K*L*cos(pi0_theta); - double C = pow(K,2.0) - pow(PI_ZERO_MASS,2.0); - double pi0_p = ((-B) - sqrt(B*B - 4.0*A*C))/(2.0*A); - //double pi0_p = sqrt(pow(initial->v.E,2.0) - pow(PI_ZERO_MASS,2.0)); - intermediary->v.E = sqrt(pow(pi0_p,2.0) + pow(PI_ZERO_MASS,2.0)); - - *Nintermediary = 1; - intermediary->type = ptype_pion_zero; - double vertex_r = 0.5*cm*(-0.5 + ((double)random()/(double)RAND_MAX)); - double vertex_phi = 2.0*M_PI*((double)random()/(double)RAND_MAX); - intermediary->x = vertex_r*cos(vertex_phi); - intermediary->y = vertex_r*sin(vertex_phi); - intermediary->z = 65.0*cm + 30.0*cm*(-0.5 + ((double)random()/(double)RAND_MAX)); - - intermediary->v.x = pi0_p*sin(pi0_theta)*cos(pi0_phi); - intermediary->v.y = pi0_p*sin(pi0_theta)*sin(pi0_phi); - intermediary->v.z = pi0_p*cos(pi0_theta); - - // ------------ Final state photons --------------- - // Define decay photons in rest frame of pi0 - *Nfinal = 2; - final[0].type = ptype_gamma; - final[0].v.E = PI_ZERO_MASS/2.0; - final[0].x = intermediary->x; - final[0].y = intermediary->y; - final[0].z = intermediary->z; - - double phi = 2.0*M_PI*((double)random()/(double)RAND_MAX); - double theta = M_PI*((double)random()/(double)RAND_MAX); - - final[0].v.x = final[0].v.E*sin(theta)*cos(phi); - final[0].v.y = final[0].v.E*sin(theta)*sin(phi); - final[0].v.z = final[0].v.E*cos(theta); - - // second decay photon goes in opposite direction - final[1] = final[0]; - final[1].v.x = -final[0].v.x; - final[1].v.y = -final[0].v.y; - final[1].v.z = -final[0].v.z; - - // Boost photons into lab frame (http://rd11.web.cern.ch/RD11/rkb/PH14pp/node105.html) - for(int i=0;i<*Nfinal;i++){ - final[i].v.E = (final[i].v.E*intermediary->v.E - + final[i].v.x*intermediary->v.x - + final[i].v.y*intermediary->v.y - + final[i].v.z*intermediary->v.z)/PI_ZERO_MASS; - final[i].v.x += intermediary->v.x*(PI_ZERO_MASS/2.0 + final[i].v.E)/(intermediary->v.E + PI_ZERO_MASS); - final[i].v.y += intermediary->v.y*(PI_ZERO_MASS/2.0 + final[i].v.E)/(intermediary->v.E + PI_ZERO_MASS); - final[i].v.z += intermediary->v.z*(PI_ZERO_MASS/2.0 + final[i].v.E)/(intermediary->v.E + PI_ZERO_MASS); - } - - // Final state proton - vect4 fpi0 = vect4_add(final[0].v, final[1].v); - vect4 tgt = {PROTON_MASS, 0.0, 0.0, 0.0}; - vect4 iall = vect4_add(tgt, initial[0].v); - final[2].v = vect4_sub(iall, fpi0); - final[2].type = ptype_proton; - final[2].x = final[0].x; - final[2].y = final[0].y; - final[2].z = final[0].z; - (*Nfinal)++; - - // Only one decay mechanisim for this generator! - *decay_mech=0; - return 0; -} - -//============================================================================= -// Table of cross sections for pi0 production on Hydrogen with 4.5GeV photons -//============================================================================= -cross_section_t pi0_H_4_5GeV[N_pi0_H_4_5GeV] = -{ - {0.001, 1.92515e-06, 1.92051e-06, 2.7999e-12, 4.63777e-09}, - {0.114445, 0.0222486, 0.0221915, 3.66722e-08, 5.70548e-05}, - {0.227891, 0.0633747, 0.0631828, 1.45407e-07, 0.0001917}, - {0.341336, 0.0905145, 0.0901712, 3.26201e-07, 0.00034301}, - {0.454782, 0.0977022, 0.097227, 5.79042e-07, 0.000474546}, - {0.568227, 0.0927104, 0.0921323, 9.03913e-07, 0.000577164}, - {0.681672, 0.082875, 0.0822196, 1.30079e-06, 0.000654066}, - {0.795118, 0.0721751, 0.0714621, 1.76965e-06, 0.000711233}, - {0.908563, 0.0622731, 0.0615168, 2.31047e-06, 0.000754009}, - {1.02201, 0.0536825, 0.0528932, 2.92319e-06, 0.000786427}, - {1.13545, 0.0464321, 0.0456171, 3.6078e-06, 0.000811363}, - {1.2489, 0.0403772, 0.039542, 4.36423e-06, 0.000830831}, - {1.36234, 0.0353313, 0.0344799, 5.19244e-06, 0.00084625}, - {1.47579, 0.031117, 0.0302523, 6.09238e-06, 0.000858623}, - {1.58924, 0.0275813, 0.0267055, 7.06398e-06, 0.000868671}, - {1.70268, 0.0245982, 0.0237131, 8.10719e-06, 0.000876919}, - {1.81613, 0.022066, 0.021173, 9.22192e-06, 0.000883755}, - {1.92957, 0.0199032, 0.0190033, 1.04081e-05, 0.000889468}, - {2.04302, 0.0180446, 0.0171386, 1.16657e-05, 0.000894279}, - {2.15646, 0.0164379, 0.0155266, 1.29946e-05, 0.000898357}, - {2.26991, 0.0150413, 0.0141251, 1.43946e-05, 0.000901833}, - {2.38335, 0.0138208, 0.0129001, 1.58658e-05, 0.000904811}, - {2.4968, 0.0127487, 0.0118239, 1.74081e-05, 0.000907372}, - {2.61024, 0.0118025, 0.0108739, 1.90212e-05, 0.000909582}, - {2.72369, 0.0109638, 0.0100316, 2.07051e-05, 0.000911494}, - {2.83714, 0.0102171, 0.00928153, 2.24598e-05, 0.000913151}, - {2.95058, 0.00954987, 0.008611, 2.4285e-05, 0.000914589}, - {3.06403, 0.00895131, 0.0080093, 2.61807e-05, 0.000915836}, - {3.17747, 0.00841253, 0.00746747, 2.81467e-05, 0.000916918}, - {3.29092, 0.00792596, 0.00697792, 3.0183e-05, 0.000917855}, - {3.40436, 0.00748518, 0.00653423, 3.22893e-05, 0.000918663}, - {3.51781, 0.00708473, 0.0061309, 3.44655e-05, 0.000919358}, - {3.63125, 0.00671991, 0.00576325, 3.67116e-05, 0.000919952}, - {3.7447, 0.0063867, 0.00542721, 3.90272e-05, 0.000920455}, - {3.85814, 0.00608161, 0.00511932, 4.14124e-05, 0.000920876}, - {3.97159, 0.00580162, 0.00483653, 4.38669e-05, 0.000921224}, - {4.08503, 0.00554411, 0.00457621, 4.63906e-05, 0.000921506}, - {4.19848, 0.00530678, 0.00433607, 4.89833e-05, 0.000921726}, - {4.31193, 0.00508762, 0.00411408, 5.16448e-05, 0.000921891}, - {4.42537, 0.00488485, 0.00390848, 5.43749e-05, 0.000922004}, - {4.53882, 0.00469694, 0.00371769, 5.71736e-05, 0.000922071}, - {4.65226, 0.00452248, 0.00354035, 6.00405e-05, 0.000922094}, - {4.76571, 0.00436027, 0.00337522, 6.29755e-05, 0.000922077}, - {4.87915, 0.00420921, 0.00322121, 6.59785e-05, 0.000922021}, - {4.9926, 0.00406834, 0.00307736, 6.90491e-05, 0.000921931}, - {5.10604, 0.00393679, 0.00294279, 7.21873e-05, 0.000921807}, - {5.21949, 0.00381377, 0.00281673, 7.53928e-05, 0.000921653}, - {5.33293, 0.00369861, 0.00269847, 7.86653e-05, 0.000921469}, - {5.44638, 0.00359066, 0.0025874, 8.20048e-05, 0.000921258}, - {5.55982, 0.00348936, 0.00248293, 8.54109e-05, 0.00092102}, - {5.67327, 0.00339421, 0.00238457, 8.88834e-05, 0.000920757}, - {5.78672, 0.00330473, 0.00229184, 9.24221e-05, 0.00092047}, - {5.90016, 0.00322051, 0.00220432, 9.60268e-05, 0.000920161}, - {6.01361, 0.00314117, 0.00212164, 9.96972e-05, 0.00091983}, - {6.12705, 0.00306636, 0.00204344, 0.000103433, 0.000919478}, - {6.2405, 0.00299576, 0.00196942, 0.000107234, 0.000919106}, - {6.35394, 0.00292908, 0.00189926, 0.0001111, 0.000918715}, - {6.46739, 0.00286606, 0.00183272, 0.000115031, 0.000918304}, - {6.58083, 0.00280646, 0.00176955, 0.000119027, 0.000917876}, - {6.69428, 0.00275005, 0.00170953, 0.000123086, 0.000917431}, - {6.80772, 0.00269662, 0.00165245, 0.00012721, 0.000916968}, - {6.92117, 0.002646, 0.00159812, 0.000131397, 0.000916489}, - {7.03461, 0.00259801, 0.00154637, 0.000135648, 0.000915994}, - {7.14806, 0.00255248, 0.00149703, 0.000139962, 0.000915483}, - {7.26151, 0.00250927, 0.00144997, 0.000144338, 0.000914957}, - {7.37495, 0.00246824, 0.00140505, 0.000148777, 0.000914416}, - {7.4884, 0.00242927, 0.00136213, 0.000153279, 0.000913861}, - {7.60184, 0.00239223, 0.0013211, 0.000157842, 0.000913291}, - {7.71529, 0.00235703, 0.00128185, 0.000162467, 0.000912707}, - {7.82873, 0.00232355, 0.00124428, 0.000167154, 0.00091211}, - {7.94218, 0.0022917, 0.0012083, 0.000171901, 0.000911499}, - {8.05562, 0.0022614, 0.00117381, 0.000176709, 0.000910875}, - {8.16907, 0.00223256, 0.00114074, 0.000181578, 0.000910239}, - {8.28251, 0.00220511, 0.00110901, 0.000186507, 0.000909589}, - {8.39596, 0.00217897, 0.00107855, 0.000191496, 0.000908927}, - {8.50941, 0.00215408, 0.00104929, 0.000196544, 0.000908252}, - {8.62285, 0.00213038, 0.00102116, 0.000201651, 0.000907565}, - {8.7363, 0.00210781, 0.000994125, 0.000206817, 0.000906866}, - {8.84974, 0.00208631, 0.000968111, 0.000212041, 0.000906156}, - {8.96319, 0.00206583, 0.000943073, 0.000217324, 0.000905433}, - {9.07663, 0.00204633, 0.000918963, 0.000222664, 0.000904699}, - {9.19008, 0.00202775, 0.000895735, 0.000228062, 0.000903953}, - {9.30352, 0.00201006, 0.000873346, 0.000233517, 0.000903196}, - {9.41697, 0.00199321, 0.000851758, 0.000239028, 0.000902428}, - {9.53041, 0.00197718, 0.000830932, 0.000244596, 0.000901649}, - {9.64386, 0.00196191, 0.000810833, 0.00025022, 0.000900859}, - {9.7573, 0.00194739, 0.000791428, 0.0002559, 0.000900058}, - {9.87075, 0.00193356, 0.000772685, 0.000261634, 0.000899246}, - {9.9842, 0.00192042, 0.000754574, 0.000267424, 0.000898423}, - {10.0976, 0.00190793, 0.000737068, 0.000273268, 0.00089759}, - {10.2111, 0.00189605, 0.000720139, 0.000279166, 0.000896747}, - {10.3245, 0.00188477, 0.000703763, 0.000285118, 0.000895893}, - {10.438, 0.00187407, 0.000687917, 0.000291124, 0.000895028}, - {10.5514, 0.00186391, 0.000672577, 0.000297182, 0.000894154}, - {10.6649, 0.00185428, 0.000657722, 0.000303293, 0.000893269}, - {10.7783, 0.00184516, 0.000643332, 0.000309456, 0.000892374}, - {10.8918, 0.00183653, 0.000629388, 0.000315671, 0.000891469}, - {11.0052, 0.00182836, 0.000615872, 0.000321937, 0.000890555}, - {11.1186, 0.00182065, 0.000602766, 0.000328254, 0.00088963}, - {11.2321, 0.00181337, 0.000590054, 0.000334622, 0.000888695}, - {11.3455, 0.00180651, 0.00057772, 0.00034104, 0.000887751}, - {11.459, 0.00180006, 0.000565751, 0.000347507, 0.000886797}, - {11.5724, 0.00179399, 0.00055413, 0.000354024, 0.000885834}, - {11.6859, 0.0017883, 0.000542846, 0.00036059, 0.000884861}, - {11.7993, 0.00178297, 0.000531885, 0.000367204, 0.000883878}, - {11.9128, 0.00177799, 0.000521236, 0.000373866, 0.000882887}, - {12.0262, 0.00177335, 0.000510885, 0.000380576, 0.000881885}, - {12.1397, 0.00176903, 0.000500823, 0.000387332, 0.000880875}, - {12.2531, 0.00176503, 0.000491039, 0.000394136, 0.000879855}, - {12.3665, 0.00176133, 0.000481523, 0.000400986, 0.000878826}, - {12.48, 0.00175793, 0.000472264, 0.000407881, 0.000877788}, - {12.5934, 0.00175482, 0.000463255, 0.000414822, 0.00087674}, - {12.7069, 0.00175198, 0.000454485, 0.000421808, 0.000875684}, - {12.8203, 0.00174941, 0.000445947, 0.000428839, 0.000874619}, - {12.9338, 0.00174709, 0.000437633, 0.000435913, 0.000873545}, - {13.0472, 0.00174503, 0.000429535, 0.000443031, 0.000872462}, - {13.1607, 0.00174321, 0.000421645, 0.000450193, 0.00087137}, - {13.2741, 0.00174162, 0.000413956, 0.000457396, 0.000870269}, - {13.3876, 0.00174026, 0.000406462, 0.000464642, 0.00086916}, - {13.501, 0.00173913, 0.000399157, 0.00047193, 0.000868042}, - {13.6144, 0.00173821, 0.000392033, 0.000479259, 0.000866915}, - {13.7279, 0.00173749, 0.000385085, 0.000486629, 0.000865779}, - {13.8413, 0.00173698, 0.000378308, 0.000494039, 0.000864636}, - {13.9548, 0.00173667, 0.000371695, 0.000501488, 0.000863483}, - {14.0682, 0.00173654, 0.000365242, 0.000508978, 0.000862322}, - {14.1817, 0.0017366, 0.000358943, 0.000516506, 0.000861153}, - {14.2951, 0.00173684, 0.000352794, 0.000524072, 0.000859976}, - {14.4086, 0.00173726, 0.00034679, 0.000531676, 0.00085879}, - {14.522, 0.00173784, 0.000340926, 0.000539318, 0.000857596}, - {14.6355, 0.00173859, 0.000335198, 0.000546997, 0.000856394}, - {14.7489, 0.0017395, 0.000329603, 0.000554712, 0.000855183}, - {14.8623, 0.00174056, 0.000324135, 0.000562463, 0.000853964}, - {14.9758, 0.00174178, 0.000318791, 0.000570249, 0.000852738}, - {15.0892, 0.00174314, 0.000313568, 0.000578071, 0.000851503}, - {15.2027, 0.00174465, 0.000308461, 0.000585926, 0.00085026}, - {15.3161, 0.00174629, 0.000303468, 0.000593816, 0.00084901}, - {15.4296, 0.00174808, 0.000298585, 0.000601739, 0.000847751}, - {15.543, 0.00174999, 0.000293809, 0.000609695, 0.000846485}, - {15.6565, 0.00175203, 0.000289137, 0.000617684, 0.000845211}, - {15.7699, 0.0017542, 0.000284566, 0.000625704, 0.000843929}, - {15.8834, 0.00175649, 0.000280092, 0.000633756, 0.000842639}, - {15.9968, 0.00175889, 0.000275714, 0.000641839, 0.000841342}, - {16.1102, 0.00176142, 0.000271429, 0.000649952, 0.000840037}, - {16.2237, 0.00176405, 0.000267233, 0.000658095, 0.000838724}, - {16.3371, 0.0017668, 0.000263125, 0.000666267, 0.000837404}, - {16.4506, 0.00176965, 0.000259102, 0.000674468, 0.000836077}, - {16.564, 0.0017726, 0.000255162, 0.000682697, 0.000834742}, - {16.6775, 0.00177566, 0.000251302, 0.000690954, 0.000833399}, - {16.7909, 0.00177881, 0.000247521, 0.000699239, 0.000832049}, - {16.9044, 0.00178206, 0.000243817, 0.00070755, 0.000830692}, - {17.0178, 0.0017854, 0.000240186, 0.000715887, 0.000829328}, - {17.1313, 0.00178883, 0.000236628, 0.00072425, 0.000827956}, - {17.2447, 0.00179236, 0.00023314, 0.000732638, 0.000826577}, - {17.3581, 0.00179596, 0.000229721, 0.00074105, 0.000825191}, - {17.4716, 0.00179965, 0.000226369, 0.000749487, 0.000823798}, - {17.585, 0.00180343, 0.000223082, 0.000757947, 0.000822398}, - {17.6985, 0.00180728, 0.000219859, 0.000766431, 0.000820991}, - {17.8119, 0.00181121, 0.000216697, 0.000774936, 0.000819577}, - {17.9254, 0.00181522, 0.000213596, 0.000783464, 0.000818156}, - {18.0388, 0.00181929, 0.000210553, 0.000792013, 0.000816728}, - {18.1523, 0.00182344, 0.000207568, 0.000800583, 0.000815293}, - {18.2657, 0.00182766, 0.000204639, 0.000809173, 0.000813851}, - {18.3792, 0.00183195, 0.000201764, 0.000817783, 0.000812403}, - {18.4926, 0.0018363, 0.000198943, 0.000826413, 0.000810948}, - {18.606, 0.00184072, 0.000196174, 0.000835061, 0.000809486}, - {18.7195, 0.0018452, 0.000193455, 0.000843727, 0.000808018}, - {18.8329, 0.00184974, 0.000190786, 0.000852411, 0.000806543}, - {18.9464, 0.00185434, 0.000188165, 0.000861111, 0.000805062}, - {19.0598, 0.00185899, 0.000185591, 0.000869829, 0.000803574}, - {19.1733, 0.00186371, 0.000183064, 0.000878562, 0.00080208}, - {19.2867, 0.00186847, 0.000180581, 0.000887311, 0.000800579}, - {19.4002, 0.00187329, 0.000178142, 0.000896075, 0.000799072}, - {19.5136, 0.00187816, 0.000175747, 0.000904853, 0.000797559}, - {19.6271, 0.00188308, 0.000173393, 0.000913644, 0.000796039}, - {19.7405, 0.00188804, 0.00017108, 0.00092245, 0.000794513}, - {19.8539, 0.00189306, 0.000168807, 0.000931267, 0.000792981}, - {19.9674, 0.00189811, 0.000166574, 0.000940097, 0.000791443}, - {20.0808, 0.00190322, 0.000164378, 0.000948939, 0.000789899}, - {20.1943, 0.00190836, 0.000162221, 0.000957791, 0.000788349}, - {20.3077, 0.00191355, 0.000160099, 0.000966654, 0.000786793}, - {20.4212, 0.00191877, 0.000158014, 0.000975528, 0.000785231}, - {20.5346, 0.00192404, 0.000155963, 0.00098441, 0.000783663}, - {20.6481, 0.00192934, 0.000153947, 0.000993301, 0.000782089}, - {20.7615, 0.00193467, 0.000151964, 0.0010022, 0.000780509}, - {20.875, 0.00194005, 0.000150014, 0.00101111, 0.000778924}, - {20.9884, 0.00194545, 0.000148096, 0.00102002, 0.000777333}, - {21.1018, 0.00195089, 0.00014621, 0.00102894, 0.000775736}, - {21.2153, 0.00195636, 0.000144354, 0.00103787, 0.000774133}, - {21.3287, 0.00196186, 0.000142528, 0.0010468, 0.000772525}, - {21.4422, 0.00196739, 0.000140732, 0.00105574, 0.000770912}, - {21.5556, 0.00197294, 0.000138964, 0.00106469, 0.000769293}, - {21.6691, 0.00197852, 0.000137225, 0.00107363, 0.000767669}, - {21.7825, 0.00198413, 0.000135513, 0.00108258, 0.000766039}, - {21.896, 0.00198977, 0.000133828, 0.00109153, 0.000764404}, - {22.0094, 0.00199542, 0.00013217, 0.00110049, 0.000762763}, - {22.1229, 0.0020011, 0.000130538, 0.00110945, 0.000761117}, - {22.2363, 0.0020068, 0.000128931, 0.0011184, 0.000759467}, - {22.3497, 0.00201252, 0.00012735, 0.00112736, 0.000757811}, - {22.4632, 0.00201826, 0.000125792, 0.00113632, 0.000756149}, - {22.5766, 0.00202402, 0.000124259, 0.00114528, 0.000754483}, - {22.6901, 0.0020298, 0.000122749, 0.00115424, 0.000752812}, - {22.8035, 0.00203559, 0.000121262, 0.00116319, 0.000751136}, - {22.917, 0.0020414, 0.000119798, 0.00117214, 0.000749455}, - {23.0304, 0.00204722, 0.000118356, 0.0011811, 0.000747769}, - {23.1439, 0.00205306, 0.000116935, 0.00119004, 0.000746078}, - {23.2573, 0.0020589, 0.000115536, 0.00119899, 0.000744382}, - {23.3708, 0.00206477, 0.000114158, 0.00120793, 0.000742682}, - {23.4842, 0.00207064, 0.0001128, 0.00121686, 0.000740977}, - {23.5976, 0.00207652, 0.000111462, 0.00122579, 0.000739267}, - {23.7111, 0.00208241, 0.000110144, 0.00123471, 0.000737553}, - {23.8245, 0.00208831, 0.000108845, 0.00124363, 0.000735834}, - {23.938, 0.00209422, 0.000107565, 0.00125254, 0.000734111}, - {24.0514, 0.00210013, 0.000106304, 0.00126145, 0.000732383}, - {24.1649, 0.00210605, 0.000105061, 0.00127034, 0.000730651}, - {24.2783, 0.00211198, 0.000103835, 0.00127923, 0.000728914}, - {24.3918, 0.0021179, 0.000102628, 0.0012881, 0.000727173}, - {24.5052, 0.00212384, 0.000101437, 0.00129697, 0.000725428}, - {24.6187, 0.00212977, 0.000100264, 0.00130583, 0.000723679}, - {24.7321, 0.00213571, 9.91073e-05, 0.00131468, 0.000721925}, - {24.8455, 0.00214165, 9.79669e-05, 0.00132351, 0.000720168}, - {24.959, 0.00214758, 9.68425e-05, 0.00133234, 0.000718406}, - {25.0724, 0.00215352, 9.57339e-05, 0.00134115, 0.00071664}, - {25.1859, 0.00215946, 9.46407e-05, 0.00134995, 0.00071487}, - {25.2993, 0.00216539, 9.35627e-05, 0.00135873, 0.000713097}, - {25.4128, 0.00217132, 9.24997e-05, 0.00136751, 0.000711319}, - {25.5262, 0.00217725, 9.14513e-05, 0.00137626, 0.000709538}, - {25.6397, 0.00218318, 9.04173e-05, 0.00138501, 0.000707753}, - {25.7531, 0.00218909, 8.93975e-05, 0.00139373, 0.000705964}, - {25.8666, 0.00219501, 8.83915e-05, 0.00140245, 0.000704171}, - {25.98, 0.00220091, 8.73992e-05, 0.00141114, 0.000702375}, - {26.0934, 0.00220681, 8.64204e-05, 0.00141982, 0.000700575}, - {26.2069, 0.00221271, 8.54548e-05, 0.00142848, 0.000698772}, - {26.3203, 0.00221859, 8.45021e-05, 0.00143712, 0.000696965}, - {26.4338, 0.00222447, 8.35622e-05, 0.00144575, 0.000695154}, - {26.5472, 0.00223033, 8.26348e-05, 0.00145435, 0.000693341}, - {26.6607, 0.00223618, 8.17197e-05, 0.00146294, 0.000691523}, - {26.7741, 0.00224203, 8.08167e-05, 0.00147151, 0.000689703}, - {26.8876, 0.00224786, 7.99257e-05, 0.00148005, 0.000687879}, - {27.001, 0.00225368, 7.90464e-05, 0.00148858, 0.000686052}, - {27.1145, 0.00225949, 7.81786e-05, 0.00149708, 0.000684222}, - {27.2279, 0.00226528, 7.73221e-05, 0.00150557, 0.000682389}, - {27.3413, 0.00227106, 7.64768e-05, 0.00151403, 0.000680552}, - {27.4548, 0.00227682, 7.56424e-05, 0.00152246, 0.000678713}, - {27.5682, 0.00228257, 7.48188e-05, 0.00153088, 0.000676871}, - {27.6817, 0.0022883, 7.40058e-05, 0.00153927, 0.000675025}, - {27.7951, 0.00229401, 7.32033e-05, 0.00154763, 0.000673177}, - {27.9086, 0.00229971, 7.2411e-05, 0.00155598, 0.000671326}, - {28.022, 0.00230539, 7.16288e-05, 0.00156429, 0.000669472}, - {28.1355, 0.00231105, 7.08565e-05, 0.00157258, 0.000667616}, - {28.2489, 0.0023167, 7.00941e-05, 0.00158085, 0.000665756}, - {28.3624, 0.00232232, 6.93412e-05, 0.00158908, 0.000663894}, - {28.4758, 0.00232792, 6.85979e-05, 0.00159729, 0.00066203}, - {28.5892, 0.0023335, 6.78638e-05, 0.00160548, 0.000660163}, - {28.7027, 0.00233906, 6.7139e-05, 0.00161363, 0.000658293}, - {28.8161, 0.0023446, 6.64232e-05, 0.00162176, 0.000656421}, - {28.9296, 0.00235012, 6.57162e-05, 0.00162985, 0.000654547}, - {29.043, 0.00235561, 6.50181e-05, 0.00163792, 0.00065267}, - {29.1565, 0.00236108, 6.43285e-05, 0.00164596, 0.000650791}, - {29.2699, 0.00236652, 6.36474e-05, 0.00165397, 0.000648909}, - {29.3834, 0.00237194, 6.29747e-05, 0.00166194, 0.000647026}, - {29.4968, 0.00237734, 6.23103e-05, 0.00166989, 0.00064514}, - {29.6102, 0.00238271, 6.16539e-05, 0.0016778, 0.000643252}, - {29.7237, 0.00238805, 6.10055e-05, 0.00168569, 0.000641362}, - {29.8371, 0.00239337, 6.0365e-05, 0.00169354, 0.000639469}, - {29.9506, 0.00239866, 5.97322e-05, 0.00170135, 0.000637575}, - {30.064, 0.00240392, 5.91071e-05, 0.00170914, 0.000635679}, - {30.1775, 0.00240916, 5.84894e-05, 0.00171689, 0.000633781}, - {30.2909, 0.00241436, 5.78792e-05, 0.0017246, 0.000631882}, - {30.4044, 0.00241954, 5.72763e-05, 0.00173228, 0.00062998}, - {30.5178, 0.00242468, 5.66805e-05, 0.00173993, 0.000628077}, - {30.6313, 0.0024298, 5.60919e-05, 0.00174754, 0.000626171}, - {30.7447, 0.00243489, 5.55102e-05, 0.00175511, 0.000624265}, - {30.8581, 0.00243994, 5.49354e-05, 0.00176265, 0.000622356}, - {30.9716, 0.00244497, 5.43673e-05, 0.00177015, 0.000620446}, - {31.085, 0.00244996, 5.3806e-05, 0.00177762, 0.000618535}, - {31.1985, 0.00245492, 5.32512e-05, 0.00178504, 0.000616622}, - {31.3119, 0.00245984, 5.27029e-05, 0.00179243, 0.000614707}, - {31.4254, 0.00246473, 5.2161e-05, 0.00179978, 0.000612792}, - {31.5388, 0.00246959, 5.16254e-05, 0.00180709, 0.000610875}, - {31.6523, 0.00247442, 5.1096e-05, 0.00181437, 0.000608956}, - {31.7657, 0.00247921, 5.05727e-05, 0.0018216, 0.000607036}, - {31.8792, 0.00248396, 5.00555e-05, 0.00182879, 0.000605116}, - {31.9926, 0.00248868, 4.95442e-05, 0.00183595, 0.000603193}, - {32.106, 0.00249337, 4.90388e-05, 0.00184306, 0.00060127}, - {32.2195, 0.00249802, 4.85392e-05, 0.00185013, 0.000599346}, - {32.3329, 0.00250263, 4.80453e-05, 0.00185716, 0.000597421}, - {32.4464, 0.0025072, 4.7557e-05, 0.00186415, 0.000595495}, - {32.5598, 0.00251174, 4.70743e-05, 0.0018711, 0.000593567}, - {32.6733, 0.00251624, 4.6597e-05, 0.001878, 0.000591639}, - {32.7867, 0.0025207, 4.61252e-05, 0.00188486, 0.00058971}, - {32.9002, 0.00252512, 4.56586e-05, 0.00189168, 0.000587781}, - {33.0136, 0.0025295, 4.51973e-05, 0.00189846, 0.00058585}, - {33.1271, 0.00253385, 4.47412e-05, 0.00190519, 0.000583919}, - {33.2405, 0.00253815, 4.42902e-05, 0.00191187, 0.000581987}, - {33.3539, 0.00254241, 4.38442e-05, 0.00191852, 0.000580055}, - {33.4674, 0.00254664, 4.34033e-05, 0.00192511, 0.000578122}, - {33.5808, 0.00255082, 4.29672e-05, 0.00193167, 0.000576188}, - {33.6943, 0.00255496, 4.25359e-05, 0.00193817, 0.000574254}, - {33.8077, 0.00255906, 4.21094e-05, 0.00194463, 0.00057232}, - {33.9212, 0.00256312, 4.16877e-05, 0.00195105, 0.000570385}, - {34.0346, 0.00256714, 4.12706e-05, 0.00195742, 0.000568449}, - {34.1481, 0.00257111, 4.08581e-05, 0.00196374, 0.000566514}, - {34.2615, 0.00257504, 4.04501e-05, 0.00197001, 0.000564578}, - {34.375, 0.00257893, 4.00465e-05, 0.00197624, 0.000562642}, - {34.4884, 0.00258277, 3.96474e-05, 0.00198242, 0.000560706}, - {34.6018, 0.00258657, 3.92526e-05, 0.00198855, 0.000558769}, - {34.7153, 0.00259033, 3.88622e-05, 0.00199463, 0.000556833}, - {34.8287, 0.00259404, 3.84759e-05, 0.00200067, 0.000554896}, - {34.9422, 0.00259771, 3.80939e-05, 0.00200665, 0.00055296}, - {35.0556, 0.00260133, 3.7716e-05, 0.00201259, 0.000551023}, - {35.1691, 0.0026049, 3.73421e-05, 0.00201848, 0.000549087}, - {35.2825, 0.00260844, 3.69723e-05, 0.00202431, 0.000547151}, - {35.396, 0.00261192, 3.66065e-05, 0.0020301, 0.000545215}, - {35.5094, 0.00261536, 3.62445e-05, 0.00203584, 0.000543279}, - {35.6229, 0.00261875, 3.58865e-05, 0.00204152, 0.000541343}, - {35.7363, 0.0026221, 3.55323e-05, 0.00204716, 0.000539408}, - {35.8497, 0.0026254, 3.51818e-05, 0.00205274, 0.000537473}, - {35.9632, 0.00262865, 3.48351e-05, 0.00205828, 0.000535538}, - {36.0766, 0.00263185, 3.44921e-05, 0.00206376, 0.000533604}, - {36.1901, 0.00263501, 3.41527e-05, 0.00206919, 0.00053167}, - {36.3035, 0.00263812, 3.38169e-05, 0.00207456, 0.000529737}, - {36.417, 0.00264118, 3.34846e-05, 0.00207989, 0.000527804}, - {36.5304, 0.00264419, 3.31559e-05, 0.00208516, 0.000525872}, - {36.6439, 0.00264715, 3.28306e-05, 0.00209038, 0.00052394}, - {36.7573, 0.00265007, 3.25087e-05, 0.00209555, 0.00052201}, - {36.8708, 0.00265293, 3.21902e-05, 0.00210066, 0.000520079}, - {36.9842, 0.00265575, 3.1875e-05, 0.00210572, 0.00051815}, - {37.0976, 0.00265851, 3.15631e-05, 0.00211073, 0.000516221}, - {37.2111, 0.00266123, 3.12545e-05, 0.00211568, 0.000514294}, - {37.3245, 0.00266389, 3.09491e-05, 0.00212058, 0.000512367}, - {37.438, 0.00266651, 3.06468e-05, 0.00212542, 0.000510441}, - {37.5514, 0.00266908, 3.03477e-05, 0.00213021, 0.000508516}, - {37.6649, 0.00267159, 3.00517e-05, 0.00213495, 0.000506592}, - {37.7783, 0.00267405, 2.97587e-05, 0.00213963, 0.000504669}, - {37.8918, 0.00267647, 2.94688e-05, 0.00214425, 0.000502747}, - {38.0052, 0.00267883, 2.91819e-05, 0.00214882, 0.000500826}, - {38.1187, 0.00268114, 2.88979e-05, 0.00215334, 0.000498906}, - {38.2321, 0.0026834, 2.86168e-05, 0.00215779, 0.000496988}, - {38.3455, 0.00268561, 2.83386e-05, 0.0021622, 0.00049507}, - {38.459, 0.00268776, 2.80633e-05, 0.00216654, 0.000493154}, - {38.5724, 0.00268986, 2.77907e-05, 0.00217083, 0.000491239}, - {38.6859, 0.00269191, 2.7521e-05, 0.00217507, 0.000489326}, - {38.7993, 0.00269391, 2.7254e-05, 0.00217924, 0.000487414}, - {38.9128, 0.00269586, 2.69897e-05, 0.00218337, 0.000485503}, - {39.0262, 0.00269775, 2.67281e-05, 0.00218743, 0.000483594}, - {39.1397, 0.00269959, 2.64692e-05, 0.00219144, 0.000481687}, - {39.2531, 0.00270138, 2.62128e-05, 0.00219539, 0.00047978}, - {39.3666, 0.00270311, 2.59591e-05, 0.00219928, 0.000477876}, - {39.48, 0.00270479, 2.5708e-05, 0.00220311, 0.000475973}, - {39.5934, 0.00270642, 2.54593e-05, 0.00220689, 0.000474072}, - {39.7069, 0.002708, 2.52132e-05, 0.00221061, 0.000472172}, - {39.8203, 0.00270952, 2.49695e-05, 0.00221427, 0.000470274}, - {39.9338, 0.00271098, 2.47283e-05, 0.00221788, 0.000468378}, - {40.0472, 0.0027124, 2.44896e-05, 0.00222142, 0.000466484}, - {40.1607, 0.00271376, 2.42532e-05, 0.00222491, 0.000464591}, - {40.2741, 0.00271506, 2.40191e-05, 0.00222834, 0.0004627}, - {40.3876, 0.00271631, 2.37874e-05, 0.00223171, 0.000460811}, - {40.501, 0.00271751, 2.35581e-05, 0.00223503, 0.000458925}, - {40.6145, 0.00271865, 2.3331e-05, 0.00223828, 0.00045704}, - {40.7279, 0.00271974, 2.31061e-05, 0.00224148, 0.000455157}, - {40.8413, 0.00272078, 2.28835e-05, 0.00224462, 0.000453276}, - {40.9548, 0.00272176, 2.26631e-05, 0.0022477, 0.000451397}, - {41.0682, 0.00272268, 2.24449e-05, 0.00225072, 0.000449521}, - {41.1817, 0.00272355, 2.22289e-05, 0.00225368, 0.000447646}, - {41.2951, 0.00272437, 2.2015e-05, 0.00225658, 0.000445774}, - {41.4086, 0.00272513, 2.18032e-05, 0.00225942, 0.000443903}, - {41.522, 0.00272583, 2.15935e-05, 0.0022622, 0.000442036}, - {41.6355, 0.00272648, 2.13858e-05, 0.00226493, 0.00044017}, - {41.7489, 0.00272708, 2.11802e-05, 0.00226759, 0.000438307}, - {41.8624, 0.00272762, 2.09767e-05, 0.0022702, 0.000436446}, - {41.9758, 0.00272811, 2.07751e-05, 0.00227274, 0.000434587}, - {42.0892, 0.00272854, 2.05755e-05, 0.00227523, 0.000432731}, - {42.2027, 0.00272891, 2.03779e-05, 0.00227766, 0.000430877}, - {42.3161, 0.00272923, 2.01821e-05, 0.00228003, 0.000429026}, - {42.4296, 0.0027295, 1.99883e-05, 0.00228233, 0.000427177}, - {42.543, 0.00272971, 1.97964e-05, 0.00228458, 0.000425331}, - {42.6565, 0.00272987, 1.96064e-05, 0.00228677, 0.000423487}, - {42.7699, 0.00272997, 1.94182e-05, 0.0022889, 0.000421646}, - {42.8834, 0.00273001, 1.92319e-05, 0.00229097, 0.000419808}, - {42.9968, 0.00273, 1.90474e-05, 0.00229298, 0.000417972}, - {43.1103, 0.00272994, 1.88646e-05, 0.00229493, 0.000416139}, - {43.2237, 0.00272982, 1.86836e-05, 0.00229682, 0.000414309}, - {43.3371, 0.00272964, 1.85044e-05, 0.00229865, 0.000412482}, - {43.4506, 0.00272941, 1.8327e-05, 0.00230042, 0.000410657}, - {43.564, 0.00272912, 1.81512e-05, 0.00230214, 0.000408835}, - {43.6775, 0.00272878, 1.79771e-05, 0.00230379, 0.000407016}, - {43.7909, 0.00272838, 1.78048e-05, 0.00230538, 0.0004052}, - {43.9044, 0.00272793, 1.7634e-05, 0.00230691, 0.000403387}, - {44.0178, 0.00272743, 1.7465e-05, 0.00230839, 0.000401576}, - {44.1313, 0.00272687, 1.72975e-05, 0.0023098, 0.000399769}, - {44.2447, 0.00272625, 1.71317e-05, 0.00231115, 0.000397965}, - {44.3582, 0.00272558, 1.69675e-05, 0.00231245, 0.000396164}, - {44.4716, 0.00272485, 1.68048e-05, 0.00231368, 0.000394365}, - {44.585, 0.00272407, 1.66437e-05, 0.00231486, 0.00039257}, - {44.6985, 0.00272323, 1.64842e-05, 0.00231597, 0.000390778}, - {44.8119, 0.00272234, 1.63262e-05, 0.00231703, 0.000388989}, - {44.9254, 0.0027214, 1.61697e-05, 0.00231802, 0.000387204}, - {45.0388, 0.0027204, 1.60147e-05, 0.00231896, 0.000385421}, - {45.1523, 0.00271934, 1.58611e-05, 0.00231984, 0.000383642}, - {45.2657, 0.00271823, 1.57091e-05, 0.00232066, 0.000381866}, - {45.3792, 0.00271707, 1.55585e-05, 0.00232142, 0.000380093}, - {45.4926, 0.00271585, 1.54093e-05, 0.00232212, 0.000378324}, - {45.6061, 0.00271458, 1.52616e-05, 0.00232276, 0.000376558}, - {45.7195, 0.00271325, 1.51152e-05, 0.00232334, 0.000374795}, - {45.8329, 0.00271187, 1.49703e-05, 0.00232387, 0.000373036}, - {45.9464, 0.00271044, 1.48267e-05, 0.00232433, 0.00037128}, - {46.0598, 0.00270895, 1.46845e-05, 0.00232474, 0.000369528}, - {46.1733, 0.00270741, 1.45437e-05, 0.00232509, 0.000367779}, - {46.2867, 0.00270581, 1.44042e-05, 0.00232538, 0.000366033}, - {46.4002, 0.00270416, 1.4266e-05, 0.00232561, 0.000364292}, - {46.5136, 0.00270246, 1.41291e-05, 0.00232578, 0.000362553}, - {46.6271, 0.0027007, 1.39935e-05, 0.00232589, 0.000360818}, - {46.7405, 0.00269889, 1.38593e-05, 0.00232595, 0.000359087}, - {46.854, 0.00269703, 1.37262e-05, 0.00232595, 0.00035736}, - {46.9674, 0.00269512, 1.35945e-05, 0.00232589, 0.000355636}, - {47.0808, 0.00269315, 1.3464e-05, 0.00232577, 0.000353915}, - {47.1943, 0.00269113, 1.33347e-05, 0.00232559, 0.000352199}, - {47.3077, 0.00268905, 1.32066e-05, 0.00232536, 0.000350486}, - {47.4212, 0.00268693, 1.30798e-05, 0.00232507, 0.000348777}, - {47.5346, 0.00268475, 1.29541e-05, 0.00232472, 0.000347072}, - {47.6481, 0.00268252, 1.28296e-05, 0.00232432, 0.00034537}, - {47.7615, 0.00268023, 1.27063e-05, 0.00232385, 0.000343672}, - {47.875, 0.0026779, 1.25842e-05, 0.00232334, 0.000341978}, - {47.9884, 0.00267551, 1.24632e-05, 0.00232276, 0.000340288}, - {48.1019, 0.00267307, 1.23434e-05, 0.00232213, 0.000338602}, - {48.2153, 0.00267058, 1.22246e-05, 0.00232144, 0.00033692}, - {48.3287, 0.00266804, 1.2107e-05, 0.00232069, 0.000335241}, - {48.4422, 0.00266545, 1.19905e-05, 0.00231989, 0.000333567}, - {48.5556, 0.00266281, 1.18751e-05, 0.00231903, 0.000331896}, - {48.6691, 0.00266011, 1.17608e-05, 0.00231812, 0.00033023}, - {48.7825, 0.00265737, 1.16476e-05, 0.00231715, 0.000328568}, - {48.896, 0.00265457, 1.15354e-05, 0.00231613, 0.000326909}, - {49.0094, 0.00265172, 1.14242e-05, 0.00231505, 0.000325255}, - {49.1229, 0.00264883, 1.13142e-05, 0.00231391, 0.000323604}, - {49.2363, 0.00264588, 1.12051e-05, 0.00231272, 0.000321958}, - {49.3497, 0.00264289, 1.10971e-05, 0.00231147, 0.000320316}, - {49.4632, 0.00263984, 1.099e-05, 0.00231017, 0.000318678}, - {49.5766, 0.00263675, 1.0884e-05, 0.00230882, 0.000317044}, - {49.6901, 0.0026336, 1.0779e-05, 0.00230741, 0.000315414}, - {49.8035, 0.00263041, 1.06749e-05, 0.00230595, 0.000313789}, - {49.917, 0.00262717, 1.05719e-05, 0.00230443, 0.000312167}, - {50.0304, 0.00262388, 1.04697e-05, 0.00230286, 0.00031055}, - {50.1439, 0.00262054, 1.03686e-05, 0.00230124, 0.000308937}, - {50.2573, 0.00261716, 1.02684e-05, 0.00229956, 0.000307329}, - {50.3708, 0.00261372, 1.01691e-05, 0.00229783, 0.000305724}, - {50.4842, 0.00261024, 1.00708e-05, 0.00229604, 0.000304124}, - {50.5976, 0.00260671, 9.97333e-06, 0.00229421, 0.000302529}, - {50.7111, 0.00260313, 9.87681e-06, 0.00229232, 0.000300937}, - {50.8245, 0.00259951, 9.78119e-06, 0.00229038, 0.00029935}, - {50.938, 0.00259584, 9.68646e-06, 0.00228838, 0.000297767}, - {51.0514, 0.00259212, 9.59262e-06, 0.00228634, 0.000296189}, - {51.1649, 0.00258835, 9.49965e-06, 0.00228424, 0.000294615}, - {51.2783, 0.00258454, 9.40755e-06, 0.00228209, 0.000293045}, - {51.3918, 0.00258069, 9.31631e-06, 0.00227989, 0.00029148}, - {51.5052, 0.00257678, 9.22592e-06, 0.00227764, 0.000289919}, - {51.6187, 0.00257284, 9.13637e-06, 0.00227534, 0.000288363}, - {51.7321, 0.00256884, 9.04766e-06, 0.00227298, 0.000286811}, - {51.8455, 0.00256481, 8.95977e-06, 0.00227058, 0.000285264}, - {51.959, 0.00256072, 8.8727e-06, 0.00226813, 0.000283721}, - {52.0724, 0.0025566, 8.78645e-06, 0.00226563, 0.000282183}, - {52.1859, 0.00255242, 8.70099e-06, 0.00226307, 0.000280649}, - {52.2993, 0.00254821, 8.61633e-06, 0.00226047, 0.00027912}, - {52.4128, 0.00254395, 8.53247e-06, 0.00225782, 0.000277595}, - {52.5262, 0.00253965, 8.44938e-06, 0.00225512, 0.000276075}, - {52.6397, 0.0025353, 8.36706e-06, 0.00225237, 0.00027456}, - {52.7531, 0.00253091, 8.28551e-06, 0.00224958, 0.000273049}, - {52.8666, 0.00252648, 8.20472e-06, 0.00224673, 0.000271542}, - {52.98, 0.002522, 8.12469e-06, 0.00224384, 0.000270041}, - {53.0934, 0.00251749, 8.04539e-06, 0.0022409, 0.000268544}, - {53.2069, 0.00251293, 7.96684e-06, 0.00223791, 0.000267051}, - {53.3203, 0.00250833, 7.88901e-06, 0.00223488, 0.000265563}, - {53.4338, 0.00250369, 7.81192e-06, 0.00223179, 0.00026408}, - {53.5472, 0.002499, 7.73553e-06, 0.00222867, 0.000262602}, - {53.6607, 0.00249428, 7.65986e-06, 0.00222549, 0.000261128}, - {53.7741, 0.00248951, 7.5849e-06, 0.00222227, 0.000259659}, - {53.8876, 0.00248471, 7.51063e-06, 0.002219, 0.000258195}, - {54.001, 0.00247987, 7.43705e-06, 0.00221569, 0.000256735}, - {54.1145, 0.00247498, 7.36416e-06, 0.00221234, 0.00025528}, - {54.2279, 0.00247006, 7.29194e-06, 0.00220893, 0.00025383}, - {54.3413, 0.00246509, 7.2204e-06, 0.00220549, 0.000252385}, - {54.4548, 0.00246009, 7.14953e-06, 0.002202, 0.000250944}, - {54.5682, 0.00245505, 7.07931e-06, 0.00219846, 0.000249508}, - {54.6817, 0.00244997, 7.00975e-06, 0.00219488, 0.000248077}, - {54.7951, 0.00244485, 6.94083e-06, 0.00219126, 0.000246651}, - {54.9086, 0.0024397, 6.87256e-06, 0.0021876, 0.00024523}, - {55.022, 0.00243451, 6.80492e-06, 0.00218389, 0.000243813}, - {55.1355, 0.00242928, 6.73791e-06, 0.00218014, 0.000242401}, - {55.2489, 0.00242401, 6.67153e-06, 0.00217634, 0.000240994}, - {55.3624, 0.00241871, 6.60576e-06, 0.00217251, 0.000239592}, - {55.4758, 0.00241337, 6.54061e-06, 0.00216863, 0.000238195}, - {55.5892, 0.00240799, 6.47606e-06, 0.00216471, 0.000236802}, - {55.7027, 0.00240258, 6.41212e-06, 0.00216075, 0.000235415}, - {55.8161, 0.00239713, 6.34877e-06, 0.00215675, 0.000234032}, - {55.9296, 0.00239165, 6.28601e-06, 0.00215271, 0.000232654}, - {56.043, 0.00238613, 6.22384e-06, 0.00214863, 0.000231281}, - {56.1565, 0.00238058, 6.16225e-06, 0.00214451, 0.000229913}, - {56.2699, 0.002375, 6.10123e-06, 0.00214035, 0.00022855}, - {56.3834, 0.00236938, 6.04078e-06, 0.00213615, 0.000227192}, - {56.4968, 0.00236373, 5.98089e-06, 0.00213191, 0.000225838}, - {56.6103, 0.00235804, 5.92157e-06, 0.00212763, 0.00022449}, - {56.7237, 0.00235232, 5.86279e-06, 0.00212331, 0.000223146}, - {56.8371, 0.00234657, 5.80457e-06, 0.00211896, 0.000221808}, - {56.9506, 0.00234079, 5.74689e-06, 0.00211457, 0.000220474}, - {57.064, 0.00233497, 5.68975e-06, 0.00211014, 0.000219145}, - {57.1775, 0.00232913, 5.63314e-06, 0.00210567, 0.000217821}, - {57.2909, 0.00232325, 5.57706e-06, 0.00210117, 0.000216503}, - {57.4044, 0.00231734, 5.5215e-06, 0.00209663, 0.000215189}, - {57.5178, 0.0023114, 5.46647e-06, 0.00209205, 0.00021388}, - {57.6313, 0.00230543, 5.41195e-06, 0.00208744, 0.000212576}, - {57.7447, 0.00229943, 5.35793e-06, 0.00208279, 0.000211277}, - {57.8582, 0.0022934, 5.30443e-06, 0.00207811, 0.000209983}, - {57.9716, 0.00228734, 5.25142e-06, 0.00207339, 0.000208694}, - {58.085, 0.00228125, 5.19891e-06, 0.00206864, 0.00020741}, - {58.1985, 0.00227513, 5.14689e-06, 0.00206385, 0.00020613}, - {58.3119, 0.00226898, 5.09536e-06, 0.00205903, 0.000204856}, - {58.4254, 0.00226281, 5.04432e-06, 0.00205418, 0.000203587}, - {58.5388, 0.00225661, 4.99375e-06, 0.00204929, 0.000202323}, - {58.6523, 0.00225038, 4.94365e-06, 0.00204437, 0.000201064}, - {58.7657, 0.00224412, 4.89403e-06, 0.00203942, 0.00019981}, - {58.8792, 0.00223784, 4.84487e-06, 0.00203443, 0.00019856}, - {58.9926, 0.00223153, 4.79617e-06, 0.00202942, 0.000197316}, - {59.1061, 0.00222519, 4.74793e-06, 0.00202437, 0.000196077}, - {59.2195, 0.00221883, 4.70014e-06, 0.00201929, 0.000194843}, - {59.3329, 0.00221244, 4.6528e-06, 0.00201418, 0.000193614}, - {59.4464, 0.00220603, 4.6059e-06, 0.00200904, 0.000192389}, - {59.5598, 0.00219959, 4.55945e-06, 0.00200386, 0.00019117}, - {59.6733, 0.00219313, 4.51343e-06, 0.00199866, 0.000189956}, - {59.7867, 0.00218665, 4.46785e-06, 0.00199343, 0.000188747}, - {59.9002, 0.00218014, 4.42269e-06, 0.00198817, 0.000187543}, - {60.0136, 0.0021736, 4.37796e-06, 0.00198288, 0.000186344}, - {60.1271, 0.00216705, 4.33366e-06, 0.00197756, 0.000185149}, - {60.2405, 0.00216047, 4.28977e-06, 0.00197222, 0.00018396}, - {60.354, 0.00215387, 4.24629e-06, 0.00196684, 0.000182776}, - {60.4674, 0.00214724, 4.20322e-06, 0.00196144, 0.000181597}, - {60.5808, 0.0021406, 4.16056e-06, 0.00195601, 0.000180423}, - {60.6943, 0.00213393, 4.1183e-06, 0.00195056, 0.000179254}, - {60.8077, 0.00212724, 4.07644e-06, 0.00194507, 0.00017809}, - {60.9212, 0.00212053, 4.03498e-06, 0.00193957, 0.000176931}, - {61.0346, 0.0021138, 3.99391e-06, 0.00193403, 0.000175777}, - {61.1481, 0.00210705, 3.95323e-06, 0.00192847, 0.000174627}, - {61.2615, 0.00210028, 3.91293e-06, 0.00192289, 0.000173483}, - {61.375, 0.00209349, 3.87301e-06, 0.00191728, 0.000172344}, - {61.4884, 0.00208668, 3.83347e-06, 0.00191164, 0.00017121}, - {61.6019, 0.00207986, 3.79431e-06, 0.00190598, 0.000170081}, - {61.7153, 0.00207301, 3.75552e-06, 0.0019003, 0.000168957}, - {61.8287, 0.00206615, 3.71709e-06, 0.00189459, 0.000167838}, - {61.9422, 0.00205926, 3.67903e-06, 0.00188886, 0.000166723}, - {62.0556, 0.00205236, 3.64133e-06, 0.00188311, 0.000165614}, - {62.1691, 0.00204545, 3.60399e-06, 0.00187733, 0.00016451}, - {62.2825, 0.00203851, 3.567e-06, 0.00187154, 0.000163411}, - {62.396, 0.00203156, 3.53037e-06, 0.00186572, 0.000162317}, - {62.5094, 0.0020246, 3.49408e-06, 0.00185988, 0.000161227}, - {62.6229, 0.00201762, 3.45814e-06, 0.00185402, 0.000160143}, - {62.7363, 0.00201062, 3.42254e-06, 0.00184813, 0.000159064}, - {62.8498, 0.00200361, 3.38729e-06, 0.00184223, 0.000157989}, - {62.9632, 0.00199658, 3.35236e-06, 0.00183631, 0.00015692}, - {63.0766, 0.00198954, 3.31777e-06, 0.00183036, 0.000155855}, - {63.1901, 0.00198248, 3.28351e-06, 0.0018244, 0.000154796}, - {63.3035, 0.00197541, 3.24958e-06, 0.00181842, 0.000153741}, - {63.417, 0.00196833, 3.21597e-06, 0.00181242, 0.000152692}, - {63.5304, 0.00196123, 3.18268e-06, 0.0018064, 0.000151647}, - {63.6439, 0.00195412, 3.14972e-06, 0.00180036, 0.000150607}, - {63.7573, 0.001947, 3.11706e-06, 0.00179431, 0.000149572}, - {63.8708, 0.00193986, 3.08472e-06, 0.00178824, 0.000148542}, - {63.9842, 0.00193272, 3.05269e-06, 0.00178215, 0.000147517}, - {64.0977, 0.00192556, 3.02097e-06, 0.00177604, 0.000146497}, - {64.2111, 0.00191839, 2.98955e-06, 0.00176992, 0.000145482}, - {64.3245, 0.00191121, 2.95843e-06, 0.00176378, 0.000144472}, - {64.438, 0.00190402, 2.92761e-06, 0.00175763, 0.000143466}, - {64.5514, 0.00189682, 2.89709e-06, 0.00175146, 0.000142466}, - {64.6649, 0.00188961, 2.86686e-06, 0.00174527, 0.00014147}, - {64.7783, 0.00188239, 2.83693e-06, 0.00173907, 0.000140479}, - {64.8918, 0.00187516, 2.80728e-06, 0.00173286, 0.000139493}, - {65.0052, 0.00186792, 2.77791e-06, 0.00172663, 0.000138512}, - {65.1187, 0.00186067, 2.74883e-06, 0.00172039, 0.000137536}, - {65.2321, 0.00185341, 2.72003e-06, 0.00171413, 0.000136565}, - {65.3456, 0.00184615, 2.69151e-06, 0.00170786, 0.000135598}, - {65.459, 0.00183888, 2.66326e-06, 0.00170158, 0.000134637}, - {65.5724, 0.0018316, 2.63529e-06, 0.00169528, 0.00013368}, - {65.6859, 0.00182431, 2.60759e-06, 0.00168898, 0.000132728}, - {65.7993, 0.00181702, 2.58015e-06, 0.00168266, 0.00013178}, - {65.9128, 0.00180972, 2.55298e-06, 0.00167633, 0.000130838}, - {66.0262, 0.00180242, 2.52608e-06, 0.00166999, 0.0001299}, - {66.1397, 0.0017951, 2.49943e-06, 0.00166364, 0.000128967}, - {66.2531, 0.00178779, 2.47305e-06, 0.00165728, 0.000128039}, - {66.3666, 0.00178047, 2.44692e-06, 0.0016509, 0.000127116}, - {66.48, 0.00177314, 2.42104e-06, 0.00164452, 0.000126198}, - {66.5935, 0.00176581, 2.39542e-06, 0.00163813, 0.000125284}, - {66.7069, 0.00175847, 2.37005e-06, 0.00163173, 0.000124375}, - {66.8203, 0.00175113, 2.34492e-06, 0.00162532, 0.00012347}, - {66.9338, 0.00174379, 2.32004e-06, 0.0016189, 0.000122571}, - {67.0472, 0.00173644, 2.2954e-06, 0.00161247, 0.000121676}, - {67.1607, 0.00172909, 2.271e-06, 0.00160603, 0.000120786}, - {67.2741, 0.00172174, 2.24684e-06, 0.00159959, 0.0001199}, - {67.3876, 0.00171438, 2.22291e-06, 0.00159314, 0.00011902}, - {67.501, 0.00170703, 2.19922e-06, 0.00158668, 0.000118143}, - {67.6145, 0.00169967, 2.17576e-06, 0.00158022, 0.000117272}, - {67.7279, 0.00169231, 2.15254e-06, 0.00157375, 0.000116405}, - {67.8414, 0.00168494, 2.12953e-06, 0.00156727, 0.000115543}, - {67.9548, 0.00167758, 2.10676e-06, 0.00156079, 0.000114686}, - {68.0682, 0.00167022, 2.08421e-06, 0.0015543, 0.000113833}, - {68.1817, 0.00166285, 2.06188e-06, 0.00154781, 0.000112985}, - {68.2951, 0.00165549, 2.03977e-06, 0.00154131, 0.000112141}, - {68.4086, 0.00164812, 2.01788e-06, 0.0015348, 0.000111302}, - {68.522, 0.00164076, 1.9962e-06, 0.0015283, 0.000110468}, - {68.6355, 0.0016334, 1.97474e-06, 0.00152178, 0.000109638}, - {68.7489, 0.00162604, 1.95348e-06, 0.00151527, 0.000108813}, - {68.8624, 0.00161868, 1.93244e-06, 0.00150875, 0.000107992}, - {68.9758, 0.00161132, 1.91161e-06, 0.00150223, 0.000107176}, - {69.0892, 0.00160396, 1.89098e-06, 0.0014957, 0.000106364}, - {69.2027, 0.0015966, 1.87056e-06, 0.00148918, 0.000105557}, - {69.3161, 0.00158925, 1.85034e-06, 0.00148265, 0.000104755}, - {69.4296, 0.0015819, 1.83032e-06, 0.00147611, 0.000103957}, - {69.543, 0.00157456, 1.81049e-06, 0.00146958, 0.000103163}, - {69.6565, 0.00156721, 1.79087e-06, 0.00146305, 0.000102374}, - {69.7699, 0.00155987, 1.77144e-06, 0.00145651, 0.00010159}, - {69.8834, 0.00155254, 1.7522e-06, 0.00144997, 0.00010081}, - {69.9968, 0.0015452, 1.73316e-06, 0.00144344, 0.000100034}, - {70.1103, 0.00153788, 1.7143e-06, 0.0014369, 9.92628e-05}, - {70.2237, 0.00153055, 1.69563e-06, 0.00143036, 9.8496e-05}, - {70.3371, 0.00152323, 1.67715e-06, 0.00142382, 9.77336e-05}, - {70.4506, 0.00151592, 1.65885e-06, 0.00141729, 9.69757e-05}, - {70.564, 0.00150861, 1.64074e-06, 0.00141075, 9.62221e-05}, - {70.6775, 0.00150131, 1.62281e-06, 0.00140422, 9.54729e-05}, - {70.7909, 0.00149401, 1.60505e-06, 0.00139768, 9.47281e-05}, - {70.9044, 0.00148672, 1.58748e-06, 0.00139115, 9.39876e-05}, - {71.0178, 0.00147944, 1.57008e-06, 0.00138462, 9.32515e-05}, - {71.1313, 0.00147216, 1.55285e-06, 0.00137809, 9.25197e-05}, - {71.2447, 0.00146489, 1.5358e-06, 0.00137157, 9.17923e-05}, - {71.3582, 0.00145763, 1.51892e-06, 0.00136504, 9.10691e-05}, - {71.4716, 0.00145038, 1.50221e-06, 0.00135852, 9.03502e-05}, - {71.585, 0.00144313, 1.48567e-06, 0.00135201, 8.96356e-05}, - {71.6985, 0.00143589, 1.4693e-06, 0.00134549, 8.89253e-05}, - {71.8119, 0.00142866, 1.45309e-06, 0.00133898, 8.82192e-05}, - {71.9254, 0.00142143, 1.43704e-06, 0.00133248, 8.75174e-05}, - {72.0388, 0.00141422, 1.42116e-06, 0.00132598, 8.68198e-05}, - {72.1523, 0.00140701, 1.40543e-06, 0.00131948, 8.61264e-05}, - {72.2657, 0.00139982, 1.38987e-06, 0.00131299, 8.54372e-05}, - {72.3792, 0.00139263, 1.37446e-06, 0.0013065, 8.47522e-05}, - {72.4926, 0.00138545, 1.35921e-06, 0.00130002, 8.40714e-05}, - {72.6061, 0.00137828, 1.34412e-06, 0.00129354, 8.33948e-05}, - {72.7195, 0.00137112, 1.32917e-06, 0.00128707, 8.27223e-05}, - {72.8329, 0.00136398, 1.31438e-06, 0.00128061, 8.20539e-05}, - {72.9464, 0.00135684, 1.29974e-06, 0.00127415, 8.13897e-05}, - {73.0598, 0.00134971, 1.28525e-06, 0.0012677, 8.07295e-05}, - {73.1733, 0.0013426, 1.27091e-06, 0.00126125, 8.00735e-05}, - {73.2867, 0.00133549, 1.25672e-06, 0.00125482, 7.94216e-05}, - {73.4002, 0.0013284, 1.24266e-06, 0.00124838, 7.87737e-05}, - {73.5136, 0.00132132, 1.22876e-06, 0.00124196, 7.81298e-05}, - {73.6271, 0.00131425, 1.21499e-06, 0.00123554, 7.74901e-05}, - {73.7405, 0.00130719, 1.20137e-06, 0.00122914, 7.68543e-05}, - {73.854, 0.00130015, 1.18788e-06, 0.00122274, 7.62225e-05}, - {73.9674, 0.00129311, 1.17454e-06, 0.00121634, 7.55948e-05}, - {74.0808, 0.00128609, 1.16133e-06, 0.00120996, 7.4971e-05}, - {74.1943, 0.00127909, 1.14826e-06, 0.00120359, 7.43512e-05}, - {74.3077, 0.00127209, 1.13532e-06, 0.00119722, 7.37354e-05}, - {74.4212, 0.00126511, 1.12251e-06, 0.00119086, 7.31235e-05}, - {74.5346, 0.00125814, 1.10984e-06, 0.00118452, 7.25156e-05}, - {74.6481, 0.00125119, 1.0973e-06, 0.00117818, 7.19115e-05}, - {74.7615, 0.00124425, 1.08489e-06, 0.00117185, 7.13114e-05}, - {74.875, 0.00123732, 1.0726e-06, 0.00116554, 7.07151e-05}, - {74.9884, 0.00123041, 1.06045e-06, 0.00115923, 7.01227e-05}, - {75.1019, 0.00122351, 1.04842e-06, 0.00115293, 6.95342e-05}, - {75.2153, 0.00121663, 1.03651e-06, 0.00114665, 6.89495e-05}, - {75.3287, 0.00120976, 1.02473e-06, 0.00114037, 6.83686e-05}, - {75.4422, 0.00120291, 1.01307e-06, 0.00113411, 6.77916e-05}, - {75.5556, 0.00119607, 1.00153e-06, 0.00112785, 6.72183e-05}, - {75.6691, 0.00118925, 9.90109e-07, 0.00112161, 6.66489e-05}, - {75.7825, 0.00118244, 9.78809e-07, 0.00111538, 6.60832e-05}, - {75.896, 0.00117565, 9.67628e-07, 0.00110916, 6.55212e-05}, - {76.0094, 0.00116888, 9.56563e-07, 0.00110296, 6.4963e-05}, - {76.1229, 0.00116212, 9.45614e-07, 0.00109676, 6.44085e-05}, - {76.2363, 0.00115538, 9.34779e-07, 0.00109058, 6.38578e-05}, - {76.3498, 0.00114865, 9.24058e-07, 0.00108441, 6.33107e-05}, - {76.4632, 0.00114194, 9.13449e-07, 0.00107826, 6.27673e-05}, - {76.5766, 0.00113525, 9.02952e-07, 0.00107211, 6.22276e-05}, - {76.6901, 0.00112857, 8.92564e-07, 0.00106599, 6.16915e-05}, - {76.8035, 0.00112191, 8.82287e-07, 0.00105987, 6.11591e-05}, - {76.917, 0.00111527, 8.72117e-07, 0.00105377, 6.06302e-05}, - {77.0304, 0.00110864, 8.62054e-07, 0.00104768, 6.0105e-05}, - {77.1439, 0.00110204, 8.52098e-07, 0.0010416, 5.95834e-05}, - {77.2573, 0.00109545, 8.42247e-07, 0.00103554, 5.90654e-05}, - {77.3708, 0.00108888, 8.32499e-07, 0.00102949, 5.85509e-05}, - {77.4842, 0.00108232, 8.22855e-07, 0.00102346, 5.80399e-05}, - {77.5977, 0.00107579, 8.13313e-07, 0.00101744, 5.75325e-05}, - {77.7111, 0.00106927, 8.03873e-07, 0.00101144, 5.70286e-05}, - {77.8245, 0.00106277, 7.94532e-07, 0.00100545, 5.65282e-05}, - {77.938, 0.00105629, 7.85291e-07, 0.000999474, 5.60313e-05}, - {78.0514, 0.00104983, 7.76148e-07, 0.000993515, 5.55379e-05}, - {78.1649, 0.00104339, 7.67102e-07, 0.000987571, 5.50479e-05}, - {78.2783, 0.00103696, 7.58152e-07, 0.000981643, 5.45614e-05}, - {78.3918, 0.00103056, 7.49298e-07, 0.000975731, 5.40782e-05}, - {78.5052, 0.00102417, 7.40539e-07, 0.000969834, 5.35985e-05}, - {78.6187, 0.00101781, 7.31873e-07, 0.000963953, 5.31222e-05}, - {78.7321, 0.00101146, 7.233e-07, 0.000958089, 5.26492e-05}, - {78.8456, 0.00100513, 7.14819e-07, 0.00095224, 5.21797e-05}, - {78.959, 0.000998828, 7.06429e-07, 0.000946408, 5.17134e-05}, - {79.0724, 0.000992541, 6.98128e-07, 0.000940592, 5.12505e-05}, - {79.1859, 0.000986274, 6.89917e-07, 0.000934793, 5.0791e-05}, - {79.2993, 0.000980028, 6.81795e-07, 0.000929011, 5.03347e-05}, - {79.4128, 0.000973801, 6.73759e-07, 0.000923246, 4.98817e-05}, - {79.5262, 0.000967595, 6.65811e-07, 0.000917497, 4.94319e-05}, - {79.6397, 0.000961409, 6.57948e-07, 0.000911766, 4.89855e-05}, - {79.7531, 0.000955244, 6.5017e-07, 0.000906052, 4.85422e-05}, - {79.8666, 0.0009491, 6.42476e-07, 0.000900355, 4.81022e-05}, - {79.98, 0.000942977, 6.34865e-07, 0.000894676, 4.76654e-05}, - {80.0935, 0.000936874, 6.27337e-07, 0.000889015, 4.72318e-05}, - {80.2069, 0.000930793, 6.1989e-07, 0.000883371, 4.68014e-05}, - {80.3203, 0.000924732, 6.12525e-07, 0.000877746, 4.63742e-05}, - {80.4338, 0.000918693, 6.05239e-07, 0.000872138, 4.595e-05}, - {80.5472, 0.000912675, 5.98032e-07, 0.000866548, 4.55291e-05}, - {80.6607, 0.000906679, 5.90905e-07, 0.000860977, 4.51112e-05}, - {80.7741, 0.000900704, 5.83854e-07, 0.000855424, 4.46964e-05}, - {80.8876, 0.000894751, 5.76881e-07, 0.000849889, 4.42848e-05}, - {81.001, 0.000888819, 5.69984e-07, 0.000844373, 4.38762e-05}, - {81.1145, 0.00088291, 5.63163e-07, 0.000838876, 4.34706e-05}, - {81.2279, 0.000877022, 5.56416e-07, 0.000833397, 4.30681e-05}, - {81.3414, 0.000871156, 5.49743e-07, 0.000827938, 4.26686e-05}, - {81.4548, 0.000865312, 5.43143e-07, 0.000822497, 4.22721e-05}, - {81.5682, 0.000859491, 5.36616e-07, 0.000817075, 4.18787e-05}, - {81.6817, 0.000853691, 5.30161e-07, 0.000811673, 4.14882e-05}, - {81.7951, 0.000847914, 5.23776e-07, 0.00080629, 4.11006e-05}, - {81.9086, 0.000842159, 5.17462e-07, 0.000800926, 4.0716e-05}, - {82.022, 0.000836427, 5.11218e-07, 0.000795581, 4.03344e-05}, - {82.1355, 0.000830717, 5.05043e-07, 0.000790256, 3.99556e-05}, - {82.2489, 0.00082503, 4.98936e-07, 0.000784951, 3.95798e-05}, - {82.3624, 0.000819365, 4.92896e-07, 0.000779666, 3.92068e-05}, - {82.4758, 0.000813724, 4.86924e-07, 0.0007744, 3.88368e-05}, - {82.5893, 0.000808105, 4.81017e-07, 0.000769154, 3.84695e-05}, - {82.7027, 0.000802509, 4.75177e-07, 0.000763928, 3.81052e-05}, - {82.8161, 0.000796935, 4.69401e-07, 0.000758722, 3.77436e-05}, - {82.9296, 0.000791385, 4.6369e-07, 0.000753537, 3.73849e-05}, - {83.043, 0.000785858, 4.58042e-07, 0.000748371, 3.70289e-05}, - {83.1565, 0.000780354, 4.52457e-07, 0.000743226, 3.66757e-05}, - {83.2699, 0.000774873, 4.46935e-07, 0.000738101, 3.63253e-05}, - {83.3834, 0.000769415, 4.41474e-07, 0.000732996, 3.59777e-05}, - {83.4968, 0.000763981, 4.36074e-07, 0.000727912, 3.56328e-05}, - {83.6103, 0.00075857, 4.30735e-07, 0.000722848, 3.52906e-05}, - {83.7237, 0.000753182, 4.25456e-07, 0.000717805, 3.49511e-05}, - {83.8372, 0.000747818, 4.20236e-07, 0.000712783, 3.46143e-05}, - {83.9506, 0.000742477, 4.15075e-07, 0.000707782, 3.42802e-05}, - {84.064, 0.000737159, 4.09972e-07, 0.000702801, 3.39487e-05}, - {84.1775, 0.000731866, 4.04926e-07, 0.000697841, 3.36199e-05}, - {84.2909, 0.000726595, 3.99937e-07, 0.000692902, 3.32937e-05}, - {84.4044, 0.000721349, 3.95005e-07, 0.000687984, 3.29701e-05}, - {84.5178, 0.000716126, 3.90128e-07, 0.000683086, 3.26491e-05}, - {84.6313, 0.000710926, 3.85307e-07, 0.00067821, 3.23307e-05}, - {84.7447, 0.000705751, 3.8054e-07, 0.000673355, 3.20149e-05}, - {84.8582, 0.000700599, 3.75827e-07, 0.000668522, 3.17016e-05}, - {84.9716, 0.000695471, 3.71168e-07, 0.000663709, 3.13909e-05}, - {85.0851, 0.000690367, 3.66561e-07, 0.000658917, 3.10827e-05}, - {85.1985, 0.000685286, 3.62008e-07, 0.000654147, 3.0777e-05}, - {85.3119, 0.00068023, 3.57505e-07, 0.000649399, 3.04738e-05}, - {85.4254, 0.000675197, 3.53055e-07, 0.000644671, 3.01731e-05}, - {85.5388, 0.000670189, 3.48655e-07, 0.000639965, 2.98749e-05}, - {85.6523, 0.000665204, 3.44305e-07, 0.000635281, 2.95791e-05}, - {85.7657, 0.000660243, 3.40006e-07, 0.000630617, 2.92857e-05}, - {85.8792, 0.000655306, 3.35755e-07, 0.000625976, 2.89948e-05}, - {85.9926, 0.000650394, 3.31553e-07, 0.000621356, 2.87063e-05}, - {86.1061, 0.000645505, 3.274e-07, 0.000616757, 2.84201e-05}, - {86.2195, 0.00064064, 3.23294e-07, 0.00061218, 2.81364e-05}, - {86.333, 0.000635799, 3.19236e-07, 0.000607625, 2.7855e-05}, - {86.4464, 0.000630983, 3.15224e-07, 0.000603091, 2.7576e-05}, - {86.5598, 0.00062619, 3.11258e-07, 0.000598579, 2.72993e-05}, - {86.6733, 0.000621421, 3.07339e-07, 0.000594089, 2.70249e-05}, - {86.7867, 0.000616677, 3.03464e-07, 0.000589621, 2.67529e-05}, - {86.9002, 0.000611957, 2.99635e-07, 0.000585174, 2.64831e-05}, - {87.0136, 0.00060726, 2.9585e-07, 0.000580749, 2.62156e-05}, - {87.1271, 0.000602588, 2.92108e-07, 0.000576345, 2.59504e-05}, - {87.2405, 0.00059794, 2.88411e-07, 0.000571964, 2.56874e-05}, - {87.354, 0.000593316, 2.84756e-07, 0.000567604, 2.54266e-05}, - {87.4674, 0.000588716, 2.81143e-07, 0.000563266, 2.51681e-05}, - {87.5808, 0.00058414, 2.77573e-07, 0.00055895, 2.49118e-05}, - {87.6943, 0.000579588, 2.74045e-07, 0.000554656, 2.46577e-05}, - {87.8077, 0.00057506, 2.70558e-07, 0.000550383, 2.44058e-05}, - {87.9212, 0.000570556, 2.67111e-07, 0.000546133, 2.4156e-05}, - {88.0346, 0.000566076, 2.63705e-07, 0.000541904, 2.39084e-05}, - {88.1481, 0.00056162, 2.60339e-07, 0.000537697, 2.36629e-05}, - {88.2615, 0.000557189, 2.57012e-07, 0.000533512, 2.34196e-05}, - {88.375, 0.000552781, 2.53724e-07, 0.000529349, 2.31783e-05}, - {88.4884, 0.000548397, 2.50475e-07, 0.000525208, 2.29392e-05}, - {88.6019, 0.000544038, 2.47264e-07, 0.000521088, 2.27021e-05}, - {88.7153, 0.000539702, 2.44092e-07, 0.000516991, 2.24671e-05}, - {88.8287, 0.00053539, 2.40956e-07, 0.000512915, 2.22342e-05}, - {88.9422, 0.000531102, 2.37858e-07, 0.000508861, 2.20033e-05}, - {89.0556, 0.000526838, 2.34796e-07, 0.000504829, 2.17745e-05}, - {89.1691, 0.000522598, 2.3177e-07, 0.000500818, 2.15476e-05}, - {89.2825, 0.000518381, 2.28781e-07, 0.00049683, 2.13228e-05}, - {89.396, 0.000514189, 2.25827e-07, 0.000492863, 2.10999e-05}, - {89.5094, 0.00051002, 2.22908e-07, 0.000488918, 2.0879e-05}, - {89.6229, 0.000505875, 2.20023e-07, 0.000484995, 2.06601e-05}, - {89.7363, 0.000501754, 2.17173e-07, 0.000481094, 2.04432e-05}, - {89.8498, 0.000497657, 2.14357e-07, 0.000477214, 2.02281e-05}, - {89.9632, 0.000493583, 2.11575e-07, 0.000473356, 2.0015e-05}, - {90.0766, 0.000489533, 2.08826e-07, 0.00046952, 1.98038e-05}, - {90.1901, 0.000485506, 2.0611e-07, 0.000465706, 1.95945e-05}, - {90.3035, 0.000481504, 2.03426e-07, 0.000461913, 1.93871e-05}, - {90.417, 0.000477524, 2.00775e-07, 0.000458142, 1.91816e-05}, - {90.5304, 0.000473568, 1.98155e-07, 0.000454392, 1.89779e-05}, - {90.6439, 0.000469636, 1.95567e-07, 0.000450665, 1.8776e-05}, - {90.7573, 0.000465727, 1.9301e-07, 0.000446958, 1.8576e-05}, - {90.8708, 0.000461842, 1.90484e-07, 0.000443273, 1.83778e-05}, - {90.9842, 0.00045798, 1.87988e-07, 0.00043961, 1.81815e-05}, - {91.0977, 0.000454141, 1.85522e-07, 0.000435968, 1.79869e-05}, - {91.2111, 0.000450325, 1.83087e-07, 0.000432348, 1.77941e-05}, - {91.3245, 0.000446533, 1.8068e-07, 0.000428749, 1.7603e-05}, - {91.438, 0.000442764, 1.78303e-07, 0.000425172, 1.74137e-05}, - {91.5514, 0.000439018, 1.75955e-07, 0.000421616, 1.72262e-05}, - {91.6649, 0.000435295, 1.73635e-07, 0.000418081, 1.70404e-05}, - {91.7783, 0.000431595, 1.71344e-07, 0.000414568, 1.68563e-05}, - {91.8918, 0.000427919, 1.6908e-07, 0.000411076, 1.66739e-05}, - {92.0052, 0.000424265, 1.66844e-07, 0.000407605, 1.64932e-05}, - {92.1187, 0.000420634, 1.64635e-07, 0.000404155, 1.63142e-05}, - {92.2321, 0.000417026, 1.62453e-07, 0.000400727, 1.61368e-05}, - {92.3456, 0.000413441, 1.60298e-07, 0.000397319, 1.59611e-05}, - {92.459, 0.000409878, 1.5817e-07, 0.000393933, 1.57871e-05}, - {92.5724, 0.000406338, 1.56067e-07, 0.000390567, 1.56147e-05}, - {92.6859, 0.000402821, 1.5399e-07, 0.000387223, 1.54439e-05}, - {92.7993, 0.000399326, 1.51939e-07, 0.0003839, 1.52747e-05}, - {92.9128, 0.000395854, 1.49913e-07, 0.000380597, 1.51071e-05}, - {93.0262, 0.000392405, 1.47912e-07, 0.000377316, 1.49411e-05}, - {93.1397, 0.000388978, 1.45935e-07, 0.000374055, 1.47767e-05}, - {93.2531, 0.000385573, 1.43983e-07, 0.000370815, 1.46139e-05}, - {93.3666, 0.00038219, 1.42056e-07, 0.000367596, 1.44525e-05}, - {93.48, 0.00037883, 1.40152e-07, 0.000364397, 1.42928e-05}, - {93.5935, 0.000375492, 1.38271e-07, 0.000361219, 1.41345e-05}, - {93.7069, 0.000372176, 1.36414e-07, 0.000358061, 1.39778e-05}, - {93.8203, 0.000368882, 1.3458e-07, 0.000354925, 1.38226e-05}, - {93.9338, 0.00036561, 1.32769e-07, 0.000351808, 1.36688e-05}, - {94.0472, 0.00036236, 1.3098e-07, 0.000348712, 1.35166e-05}, - {94.1607, 0.000359131, 1.29214e-07, 0.000345636, 1.33658e-05}, - {94.2741, 0.000355925, 1.27469e-07, 0.000342581, 1.32164e-05}, - {94.3876, 0.00035274, 1.25747e-07, 0.000339546, 1.30686e-05}, - {94.501, 0.000349577, 1.24046e-07, 0.000336531, 1.29221e-05}, - {94.6145, 0.000346436, 1.22366e-07, 0.000333536, 1.27771e-05}, - {94.7279, 0.000343316, 1.20707e-07, 0.000330561, 1.26335e-05}, - {94.8414, 0.000340217, 1.1907e-07, 0.000327607, 1.24913e-05}, - {94.9548, 0.00033714, 1.17452e-07, 0.000324672, 1.23505e-05}, - {95.0682, 0.000334084, 1.15855e-07, 0.000321757, 1.2211e-05}, - {95.1817, 0.000331049, 1.14279e-07, 0.000318862, 1.2073e-05}, - {95.2951, 0.000328036, 1.12722e-07, 0.000315987, 1.19363e-05}, - {95.4086, 0.000325044, 1.11184e-07, 0.000313132, 1.18009e-05}, - {95.522, 0.000322072, 1.09666e-07, 0.000310296, 1.16669e-05}, - {95.6355, 0.000319122, 1.08168e-07, 0.00030748, 1.15342e-05}, - {95.7489, 0.000316192, 1.06688e-07, 0.000304683, 1.14028e-05}, - {95.8624, 0.000313284, 1.05227e-07, 0.000301906, 1.12727e-05}, - {95.9758, 0.000310396, 1.03785e-07, 0.000299148, 1.1144e-05}, - {96.0893, 0.000307528, 1.02361e-07, 0.000296409, 1.10165e-05}, - {96.2027, 0.000304681, 1.00955e-07, 0.00029369, 1.08903e-05}, - {96.3161, 0.000301855, 9.95669e-08, 0.00029099, 1.07653e-05}, - {96.4296, 0.000299049, 9.81966e-08, 0.000288309, 1.06416e-05}, - {96.543, 0.000296264, 9.68438e-08, 0.000285648, 1.05192e-05}, - {96.6565, 0.000293498, 9.55083e-08, 0.000283005, 1.03979e-05}, - {96.7699, 0.000290753, 9.41899e-08, 0.000280381, 1.02779e-05}, - {96.8834, 0.000288028, 9.28884e-08, 0.000277776, 1.01592e-05}, - {96.9968, 0.000285323, 9.16036e-08, 0.00027519, 1.00416e-05}, - {97.1103, 0.000282638, 9.03353e-08, 0.000272622, 9.92521e-06}, - {97.2237, 0.000279973, 8.90833e-08, 0.000270074, 9.81e-06}, - {97.3372, 0.000277327, 8.78474e-08, 0.000267543, 9.69598e-06}, - {97.4506, 0.000274701, 8.66275e-08, 0.000265032, 9.58312e-06}, - {97.564, 0.000272095, 8.54233e-08, 0.000262538, 9.47141e-06}, - {97.6775, 0.000269509, 8.42346e-08, 0.000260063, 9.36084e-06}, - {97.7909, 0.000266941, 8.30614e-08, 0.000257607, 9.25142e-06}, - {97.9044, 0.000264393, 8.19033e-08, 0.000255168, 9.14311e-06}, - {98.0178, 0.000261865, 8.07602e-08, 0.000252748, 9.03593e-06}, - {98.1313, 0.000259356, 7.9632e-08, 0.000250346, 8.92985e-06}, - {98.2447, 0.000256865, 7.85184e-08, 0.000247962, 8.82487e-06}, - {98.3582, 0.000254394, 7.74193e-08, 0.000245596, 8.72097e-06}, - {98.4716, 0.000251942, 7.63345e-08, 0.000243247, 8.61816e-06}, - {98.5851, 0.000249508, 7.52639e-08, 0.000240917, 8.51641e-06}, - {98.6985, 0.000247094, 7.42073e-08, 0.000238604, 8.41573e-06}, - {98.8119, 0.000244698, 7.31644e-08, 0.000236308, 8.3161e-06}, - {98.9254, 0.00024232, 7.21352e-08, 0.000234031, 8.21751e-06}, - {99.0388, 0.000239961, 7.11195e-08, 0.00023177, 8.11995e-06}, - {99.1523, 0.000237621, 7.01171e-08, 0.000229527, 8.02341e-06}, - {99.2657, 0.000235299, 6.91279e-08, 0.000227302, 7.9279e-06}, - {99.3792, 0.000232995, 6.81516e-08, 0.000225093, 7.83339e-06}, - {99.4926, 0.000230709, 6.71883e-08, 0.000222902, 7.73987e-06}, - {99.6061, 0.000228442, 6.62376e-08, 0.000220728, 7.64735e-06}, - {99.7195, 0.000226192, 6.52994e-08, 0.000218571, 7.5558e-06}, - {99.833, 0.00022396, 6.43736e-08, 0.000216431, 7.46523e-06}, - {99.9464, 0.000221746, 6.34601e-08, 0.000214307, 7.37562e-06}, - {100.06, 0.00021955, 6.25587e-08, 0.0002122, 7.28697e-06}, - {100.173, 0.000217371, 6.16692e-08, 0.00021011, 7.19926e-06}, - {100.287, 0.00021521, 6.07915e-08, 0.000208037, 7.11249e-06}, - {100.4, 0.000213067, 5.99254e-08, 0.00020598, 7.02665e-06}, - {100.514, 0.00021094, 5.90709e-08, 0.00020394, 6.94173e-06}, - {100.627, 0.000208831, 5.82278e-08, 0.000201915, 6.85772e-06}, - {100.741, 0.00020674, 5.73959e-08, 0.000199908, 6.77462e-06}, - {100.854, 0.000204665, 5.65751e-08, 0.000197916, 6.69241e-06}, - {100.967, 0.000202607, 5.57652e-08, 0.00019594, 6.6111e-06}, - {101.081, 0.000200566, 5.49662e-08, 0.000193981, 6.53066e-06}, - {101.194, 0.000198542, 5.41779e-08, 0.000192037, 6.4511e-06}, - {101.308, 0.000196535, 5.34001e-08, 0.000190109, 6.3724e-06}, - {101.421, 0.000194545, 5.26328e-08, 0.000188198, 6.29456e-06}, - {101.535, 0.000192571, 5.18758e-08, 0.000186301, 6.21756e-06}, - {101.648, 0.000190613, 5.11289e-08, 0.000184421, 6.14141e-06}, - {101.762, 0.000188672, 5.03921e-08, 0.000182555, 6.06609e-06}, - {101.875, 0.000186747, 4.96653e-08, 0.000180706, 5.9916e-06}, - {101.988, 0.000184838, 4.89483e-08, 0.000178871, 5.91792e-06}, - {102.102, 0.000182946, 4.82409e-08, 0.000177052, 5.84505e-06}, - {102.215, 0.000181069, 4.75431e-08, 0.000175249, 5.77299e-06}, - {102.329, 0.000179208, 4.68548e-08, 0.00017346, 5.70172e-06}, - {102.442, 0.000177363, 4.61758e-08, 0.000171686, 5.63125e-06}, - {102.556, 0.000175534, 4.5506e-08, 0.000169927, 5.56155e-06}, - {102.669, 0.000173721, 4.48453e-08, 0.000168183, 5.49262e-06}, - {102.783, 0.000171923, 4.41935e-08, 0.000166454, 5.42446e-06}, - {102.896, 0.00017014, 4.35507e-08, 0.00016474, 5.35706e-06}, - {103.009, 0.000168373, 4.29166e-08, 0.00016304, 5.29042e-06}, - {103.123, 0.000166622, 4.22912e-08, 0.000161355, 5.22451e-06}, - {103.236, 0.000164885, 4.16743e-08, 0.000159684, 5.15935e-06}, - {103.35, 0.000163163, 4.10659e-08, 0.000158027, 5.09491e-06}, - {103.463, 0.000161457, 4.04658e-08, 0.000156385, 5.0312e-06}, - {103.577, 0.000159765, 3.98739e-08, 0.000154757, 4.96821e-06}, - {103.69, 0.000158088, 3.92901e-08, 0.000153143, 4.90592e-06}, - {103.804, 0.000156426, 3.87144e-08, 0.000151543, 4.84434e-06}, - {103.917, 0.000154779, 3.81465e-08, 0.000149957, 4.78345e-06}, - {104.03, 0.000153146, 3.75865e-08, 0.000148385, 4.72326e-06}, - {104.144, 0.000151528, 3.70342e-08, 0.000146827, 4.66374e-06}, - {104.257, 0.000149924, 3.64896e-08, 0.000145282, 4.60491e-06}, - {104.371, 0.000148334, 3.59524e-08, 0.000143751, 4.54674e-06}, - {104.484, 0.000146759, 3.54227e-08, 0.000142234, 4.48924e-06}, - {104.598, 0.000145197, 3.49003e-08, 0.00014073, 4.43239e-06}, - {104.711, 0.00014365, 3.43852e-08, 0.000139239, 4.37619e-06}, - {104.825, 0.000142116, 3.38772e-08, 0.000137762, 4.32064e-06}, - {104.938, 0.000140597, 3.33763e-08, 0.000136298, 4.26572e-06}, - {105.051, 0.000139091, 3.28823e-08, 0.000134846, 4.21144e-06}, - {105.165, 0.000137598, 3.23952e-08, 0.000133408, 4.15778e-06}, - {105.278, 0.00013612, 3.19149e-08, 0.000131983, 4.10474e-06}, - {105.392, 0.000134655, 3.14413e-08, 0.000130571, 4.05231e-06}, - {105.505, 0.000133203, 3.09743e-08, 0.000129171, 4.00049e-06}, - {105.619, 0.000131764, 3.05138e-08, 0.000127784, 3.94927e-06}, - {105.732, 0.000130339, 3.00598e-08, 0.00012641, 3.89865e-06}, - {105.846, 0.000128927, 2.96122e-08, 0.000125049, 3.84861e-06}, - {105.959, 0.000127528, 2.91708e-08, 0.000123699, 3.79916e-06}, - {106.072, 0.000126141, 2.87356e-08, 0.000122362, 3.75028e-06}, - {106.186, 0.000124768, 2.83065e-08, 0.000121038, 3.70198e-06}, - {106.299, 0.000123407, 2.78835e-08, 0.000119725, 3.65424e-06}, - {106.413, 0.00012206, 2.74665e-08, 0.000118425, 3.60706e-06}, - {106.526, 0.000120724, 2.70553e-08, 0.000117137, 3.56043e-06}, - {106.64, 0.000119401, 2.66499e-08, 0.00011586, 3.51435e-06}, - {106.753, 0.000118091, 2.62503e-08, 0.000114596, 3.46882e-06}, - {106.867, 0.000116793, 2.58563e-08, 0.000113343, 3.42382e-06}, - {106.98, 0.000115507, 2.54678e-08, 0.000112102, 3.37935e-06}, - {107.093, 0.000114234, 2.50849e-08, 0.000110873, 3.33541e-06}, - {107.207, 0.000112972, 2.47075e-08, 0.000109655, 3.29199e-06}, - {107.32, 0.000111722, 2.43354e-08, 0.000108449, 3.24909e-06}, - {107.434, 0.000110485, 2.39686e-08, 0.000107254, 3.2067e-06}, - {107.547, 0.000109259, 2.3607e-08, 0.00010607, 3.16481e-06}, - {107.661, 0.000108045, 2.32505e-08, 0.000104898, 3.12342e-06}, - {107.774, 0.000106842, 2.28992e-08, 0.000103737, 3.08253e-06}, - {107.888, 0.000105651, 2.25529e-08, 0.000102587, 3.04212e-06}, - {108.001, 0.000104472, 2.22115e-08, 0.000101448, 3.0022e-06}, - {108.114, 0.000103304, 2.1875e-08, 0.000100319, 2.96276e-06}, - {108.228, 0.000102147, 2.15433e-08, 9.92018e-05, 2.92379e-06}, - {108.341, 0.000101002, 2.12164e-08, 9.80951e-05, 2.88529e-06}, - {108.455, 9.98672e-05, 2.08942e-08, 9.69991e-05, 2.84726e-06}, - {108.568, 9.87439e-05, 2.05766e-08, 9.59137e-05, 2.80968e-06}, - {108.682, 9.76316e-05, 2.02636e-08, 9.48388e-05, 2.77256e-06}, - {108.795, 9.65301e-05, 1.99551e-08, 9.37743e-05, 2.73589e-06}, - {108.909, 9.54395e-05, 1.96511e-08, 9.27202e-05, 2.69967e-06}, - {109.022, 9.43596e-05, 1.93514e-08, 9.16764e-05, 2.66388e-06}, - {109.135, 9.32904e-05, 1.9056e-08, 9.06428e-05, 2.62853e-06}, - {109.249, 9.22317e-05, 1.8765e-08, 8.96193e-05, 2.59361e-06}, - {109.362, 9.11835e-05, 1.84781e-08, 8.86059e-05, 2.55912e-06}, - {109.476, 9.01457e-05, 1.81954e-08, 8.76024e-05, 2.52505e-06}, - {109.589, 8.91182e-05, 1.79169e-08, 8.66089e-05, 2.49139e-06}, - {109.703, 8.8101e-05, 1.76423e-08, 8.56252e-05, 2.45815e-06}, - {109.816, 8.70939e-05, 1.73718e-08, 8.46512e-05, 2.42532e-06}, - {109.93, 8.60969e-05, 1.71051e-08, 8.36869e-05, 2.39289e-06}, - {110.043, 8.511e-05, 1.68424e-08, 8.27323e-05, 2.36086e-06}, - {110.156, 8.41329e-05, 1.65835e-08, 8.17871e-05, 2.32922e-06}, - {110.27, 8.31657e-05, 1.63284e-08, 8.08514e-05, 2.29798e-06}, - {110.383, 8.22083e-05, 1.6077e-08, 7.99251e-05, 2.26712e-06}, - {110.497, 8.12605e-05, 1.58293e-08, 7.90081e-05, 2.23664e-06}, - {110.61, 8.03224e-05, 1.55852e-08, 7.81003e-05, 2.20654e-06}, - {110.724, 7.93938e-05, 1.53447e-08, 7.72017e-05, 2.17682e-06}, - {110.837, 7.84747e-05, 1.51077e-08, 7.63121e-05, 2.14746e-06}, - {110.951, 7.7565e-05, 1.48742e-08, 7.54316e-05, 2.11848e-06}, - {111.064, 7.66645e-05, 1.46441e-08, 7.456e-05, 2.08985e-06}, - {111.177, 7.57733e-05, 1.44175e-08, 7.36973e-05, 2.06158e-06}, - {111.291, 7.48913e-05, 1.41941e-08, 7.28434e-05, 2.03366e-06}, - {111.404, 7.40183e-05, 1.39741e-08, 7.19982e-05, 2.0061e-06}, - {111.518, 7.31543e-05, 1.37573e-08, 7.11617e-05, 1.97888e-06}, - {111.631, 7.22993e-05, 1.35437e-08, 7.03338e-05, 1.952e-06}, - {111.745, 7.14531e-05, 1.33332e-08, 6.95143e-05, 1.92546e-06}, - {111.858, 7.06157e-05, 1.31259e-08, 6.87034e-05, 1.89926e-06}, - {111.972, 6.97871e-05, 1.29216e-08, 6.79008e-05, 1.87338e-06}, - {112.085, 6.8967e-05, 1.27204e-08, 6.71065e-05, 1.84783e-06}, - {112.199, 6.81555e-05, 1.25222e-08, 6.63204e-05, 1.82261e-06}, - {112.312, 6.73525e-05, 1.23269e-08, 6.55425e-05, 1.7977e-06}, - {112.425, 6.6558e-05, 1.21345e-08, 6.47727e-05, 1.77312e-06}, - {112.539, 6.57717e-05, 1.1945e-08, 6.4011e-05, 1.74884e-06}, - {112.652, 6.49938e-05, 1.17583e-08, 6.32572e-05, 1.72487e-06}, - {112.766, 6.42241e-05, 1.15744e-08, 6.25113e-05, 1.70121e-06}, - {112.879, 6.34624e-05, 1.13932e-08, 6.17732e-05, 1.67785e-06}, - {112.993, 6.27089e-05, 1.12147e-08, 6.10429e-05, 1.65479e-06}, - {113.106, 6.19634e-05, 1.1039e-08, 6.03203e-05, 1.63202e-06}, - {113.22, 6.12257e-05, 1.08658e-08, 5.96053e-05, 1.60955e-06}, - {113.333, 6.0496e-05, 1.06952e-08, 5.88979e-05, 1.58736e-06}, - {113.446, 5.9774e-05, 1.05272e-08, 5.8198e-05, 1.56546e-06} -}; diff --git a/src/programs/Simulation/genp_pi0/kinematics.c b/src/programs/Simulation/genp_pi0/kinematics.c deleted file mode 100644 index 2c1bf5993c..0000000000 --- a/src/programs/Simulation/genp_pi0/kinematics.c +++ /dev/null @@ -1,185 +0,0 @@ - -/****************************************************************/ -/* kinematics.c */ -/* */ -/* Some basic kinematics routines and tools */ -/* */ -/* D. Lawrence */ -/* 3/18/99 */ -/****************************************************************/ - - -#include -#include - - - -vect4 vect4_add(vect4 v1,vect4 v2) -{ - v1.E+=v2.E; - v1.x+=v2.x; - v1.y+=v2.y; - v1.z+=v2.z; - - return v1; -} - -vect4 vect4_sub(vect4 v1,vect4 v2) -{ - v1.E-=v2.E; - v1.x-=v2.x; - v1.y-=v2.y; - v1.z-=v2.z; - - return v1; -} - -double vect4_mul(vect4 v1,vect4 v2) -{ - v1.E*=v2.E; - v1.x*=v2.x; - v1.y*=v2.y; - v1.z*=v2.z; - - return v1.E - v1.x - v1.y - v1.z; -} - -double vect4_sq(vect4 v) -{ - return vect4_mul(v,v); -} - -vect4 vect4_boost(vect4 p,double beta) -{ - vect4 u; - double gamma=1.0/sqrt(1.0-(beta*beta)); - - u.E=(p.E*gamma) + (p.z*gamma*beta); - u.x=p.x; - u.y=p.y; - u.z=(p.E*gamma*beta) + (p.z*gamma); - - return u; -} - -double vect4_mag2(vect4 v) -{ - return (v.x*v.x) + (v.y*v.y) + (v.z*v.z); -} - -double vect4_mag(vect4 v) -{ - return sqrt(vect4_mag2(v)); -} - -double vect4_theta(vect4 v) -{ - return (180.0/M_PI)*acos(v.z/vect4_mag(v)); -} - -double vect4_phi(vect4 v) -{ - double phi; - - phi = atan2(v.y, v.x); - if(phi<0.0)phi = 2.0*M_PI + phi; - return (180.0/M_PI)*phi; -} - - -/*****************************************************/ -/* This enum is taken from cern.h since I don't want */ -/* to have this file #including anything other than */ -/* kinematics.h */ -/*****************************************************/ -/* GEANT Particle types */ -enum geant_particles{ - ptype_none, - ptype_gamma, - ptype_positron, - ptype_electron, - ptype_neutrino, - ptype_muon_plus, - ptype_muon_minus, - ptype_pion_zero, - ptype_pion_plus, - ptype_pion_minus, - ptype_kaon_zero_long, - ptype_kaon_plus, - ptype_kaon_minus, - ptype_neutron, - ptype_proton, - ptype_antiproton, - ptype_kaon_zero_short, - ptype_eta -}; - -char* part_type_str(int type) -{ - static char str[256]; - switch(type){ - - case ptype_gamma: - return "photon"; - break; - case ptype_positron: - return "positron"; - break; - case ptype_electron: - return "electron"; - break; - case ptype_neutrino: - return "neutrino"; - break; - case ptype_muon_plus: - return "mu+"; - break; - case ptype_muon_minus: - return "mu-"; - break; - case ptype_pion_zero: - return "pi0"; - break; - case ptype_pion_plus: - return "pi+"; - break; - case ptype_pion_minus: - return "pi-"; - break; - case ptype_neutron: - return "neutron"; - break; - case ptype_proton: - return "proton"; - break; - default: - sprintf(str,"%d",type); - return str; - } -} - -int chargeof(int type) -{ - if(type==ptype_none )return 0; - if(type==ptype_gamma )return 0; - if(type==ptype_positron )return 1; - if(type==ptype_electron )return -1; - if(type==ptype_neutrino )return 0; - if(type==ptype_muon_plus )return 1; - if(type==ptype_muon_minus )return -1; - if(type==ptype_pion_zero )return 0; - if(type==ptype_pion_plus )return 1; - if(type==ptype_pion_minus )return -1; - if(type==ptype_kaon_zero_long )return 0; - if(type==ptype_kaon_plus )return 1; - if(type==ptype_kaon_minus )return -1; - if(type==ptype_neutron )return 0; - if(type==ptype_proton )return 1; - if(type==ptype_antiproton )return -1; - if(type==ptype_kaon_zero_short)return 0; - if(type==ptype_eta )return 0; -} - - - - diff --git a/src/programs/Simulation/genp_pi0/kinematics.h b/src/programs/Simulation/genp_pi0/kinematics.h deleted file mode 100644 index 07bc46ce1c..0000000000 --- a/src/programs/Simulation/genp_pi0/kinematics.h +++ /dev/null @@ -1,62 +0,0 @@ - -/****************************************************************/ -/* kinematics.h */ -/* */ -/* Some basic kinematics routines and tools */ -/* */ -/* D. Lawrence */ -/* 3/18/99 */ -/****************************************************************/ - - -#include - - -#ifndef __KINEMATICS_H__ -#define __KINEMATICS_H__ - -/* vertex array */ -typedef struct{ - double x,y,z; -}myvertex_t; -extern myvertex_t myvertex_; - -/* four vector */ -typedef struct{ - double E; - double x,y,z; -}vect4; - -/* four vector with particle type and position */ -typedef struct{ - vect4 v; - double x,y,z; /* position */ - int type; /* GEANT MC particle type */ -}mcparticle_t; - - -/* Routines */ -#ifdef __cplusplus -extern "C" { -#endif -vect4 vect4_add(vect4 v1,vect4 v2); -vect4 vect4_sub(vect4 v1,vect4 v2); -double vect4_mul(vect4 v1,vect4 v2); -double vect4_sq(vect4 v); -vect4 vect4_boost(vect4 p,double beta); -vect4 vect3_cross(vect4 *a, vect4 *b); -vect4 vect3_cross_normalized(vect4 *a, vect4 *b); -char* part_type_str(int type); -int chargeof(int type); - -double vect4_mag2(vect4 v); -double vect4_mag(vect4 v); -double vect4_theta(vect4 v); -double vect4_phi(vect4 v); -#ifdef __cplusplus -} -#endif - -#endif /* __KINEMATICS_H__ */ - - diff --git a/src/programs/Simulation/genphoton/Makefile b/src/programs/Simulation/genphoton/Makefile deleted file mode 100644 index 2cbec4566b..0000000000 --- a/src/programs/Simulation/genphoton/Makefile +++ /dev/null @@ -1,5 +0,0 @@ - -PACKAGES += ROOT - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/genphoton/SConscript b/src/programs/Simulation/genphoton/SConscript deleted file mode 100644 index acaeb77be6..0000000000 --- a/src/programs/Simulation/genphoton/SConscript +++ /dev/null @@ -1,12 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddROOT(env) -sbms.executable(env) - - diff --git a/src/programs/Simulation/genphoton/genphoton.cc b/src/programs/Simulation/genphoton/genphoton.cc deleted file mode 100644 index 2bcf14e88c..0000000000 --- a/src/programs/Simulation/genphoton/genphoton.cc +++ /dev/null @@ -1,220 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -using namespace std; - -#include -#include - -//BCAL Geometry constants -const double BCAL_LENGTH = 390.; -const double BCAL_CENTER = 212.; -const double TARGET_CENTER = 65.; -const double BCAL_INNER_RAD = 64.3; - -unsigned int MAX_EVENTS=10000; -double P_MIN=0.100; -double P_MAX=6.000; -double PHI_MIN = 0.0; -double PHI_MAX = 2.0*M_PI; -double THETA_MIN = 0.0; -double THETA_MAX = M_PI; -double Z_MIN = BCAL_CENTER - BCAL_LENGTH/2.0; -double Z_MAX = BCAL_CENTER + BCAL_LENGTH/2.0; -bool IS_POSITIVE = true; -bool FILL_BCAL = false; - - -int RUN_NUMBER=100; -string OUTPUT_FILENAME="genphoton.ascii"; - -#define GAMMA_TYPE 1 - -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ _DBG_< photonXs; - photonX p; - - // Randomly sample the energy and angles of the pion - double mom = (double)random()/(double)RAND_MAX*(P_MAX-P_MIN) + P_MIN; - double phi = (double)random()/(double)RAND_MAX*(PHI_MAX-PHI_MIN) + PHI_MIN; - double theta; - if (!FILL_BCAL) { - theta = (double)random()/(double)RAND_MAX*(THETA_MAX-THETA_MIN) + THETA_MIN; - } else { - double z = (double)random()/(double)RAND_MAX*(Z_MAX-Z_MIN)+Z_MIN; - theta = atan2(BCAL_INNER_RAD,(z-TARGET_CENTER)); - } - - p.E = mom; - p.px = mom*sin(theta)*cos(phi); - p.py = mom*sin(theta)*sin(phi); - p.pz = mom*cos(theta); - photonXs.push_back(p); - - // Write event to file - unsigned int type = GAMMA_TYPE; - of< -#include -#include -#include -#include -#include -#include -using namespace std; - -double MUON_CHARGED_MASS = 0.10566; -unsigned int MAX_EVENTS=10000; -int NUM_TO_GEN=2; -double E_BEAM_MIN=4.0*MUON_CHARGED_MASS; -double E_BEAM_MAX=1.0; -int RUN_NUMBER=100; -string OUTPUT_FILENAME="genmuX.ascii"; - -#define GAMMA_TYPE 1 -#define MUON_PLUS_TYPE 5 -#define MUON_MINUS_TYPE 6 - -class muX{ - public: - double px,py,pz,E; // muX -}; - - -void ParseCommandLineArguments(int narg, char* argv[]); -void Usage(void); - - -//---------------------------- -// main -//---------------------------- -int main(int narg, char* argv[]) -{ - - // Parse the command line - ParseCommandLineArguments(narg, argv); - - // Open file for output - ofstream of(OUTPUT_FILENAME.c_str()); - if(!of.is_open()){ - cout<<"Unable to open \""< muXs; - for(int i=0; i2.0*M_PI)phi_muX-=2.0*M_PI; - //theta_muX += 2.0*(M_MUON_2 - theta_muX); - - muXs.push_back(p); - } - - // Write event to file - unsigned int type = MUON_PLUS_TYPE; - of< -#include -#include -#include -#include -#include -#include -using namespace std; - -#include -#include - -double PI_CHARGED_MASS = 0.139568; -double PROTON_MASS = 0.938; -double MESON_MASS = 0.770; -unsigned int MAX_EVENTS=10000; -int NUM_TO_GEN=2; -double E_BEAM_MIN=4.0*PI_CHARGED_MASS; -double E_BEAM_MAX=1.0; -int RUN_NUMBER=100; -string OUTPUT_FILENAME="genpiX.ascii"; -double gINTEGRAL_FRACTION; - -#define GAMMA_TYPE 1 -#define PI_PLUS_TYPE 8 -#define PI_MINUS_TYPE 9 - -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ _DBG_<2.0*M_PI)pi2_phi-=2.0*M_PI; - double pi_E = MESON_MASS/2.0; - double pi_mom = sqrt(pow(pi_E,2.0) - pow(PI_CHARGED_MASS,2.0)); - TLorentzVector pi1( pi_mom*sin(pi1_theta)*cos(pi1_phi) - , pi_mom*sin(pi1_theta)*sin(pi1_phi) - , pi_mom*cos(pi1_theta) - , pi_E); - TLorentzVector pi2( pi_mom*sin(pi2_theta)*cos(pi2_phi) - , pi_mom*sin(pi2_theta)*sin(pi2_phi) - , pi_mom*cos(pi2_theta) - , pi_E); - - // Boost the pions into the lab frame - TVector3 beta = (1.0/sqrt(rho_p.Mag2() + pow(MESON_MASS,2.0)))*rho_p; - pi1.Boost(beta); - pi2.Boost(beta); - - // Generate piXs - vector piXs; - - piX p; - p.E = pi1.E(); - p.px = pi1.Px(); - p.py = pi1.Py(); - p.pz = pi1.Pz(); - piXs.push_back(p); - - p.E = pi2.E(); - p.px = pi2.Px(); - p.py = pi2.Py(); - p.pz = pi2.Pz(); - piXs.push_back(p); - - // Write event to file - unsigned int type = PI_PLUS_TYPE; - of< -#include -#include -#include -#include -#include -#include -using namespace std; - -#include -#include - -double PI_CHARGED_MASS = 0.139568; -unsigned int MAX_EVENTS=10000; -double P_MIN=0.100; -double P_MAX=6.000; -double PHI_MIN = 0.0; -double PHI_MAX = 2.0*M_PI; -double THETA_MIN = 0.0; -double THETA_MAX = M_PI; -bool IS_POSITIVE = true; - -int RUN_NUMBER=100; -string OUTPUT_FILENAME="genpi.ascii"; - -#define GAMMA_TYPE 1 -#define PI_PLUS_TYPE 8 -#define PI_MINUS_TYPE 9 - -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ _DBG_< piXs; - piX p; - - // Randomly sample the energy and angles of the pion - double mom = (double)random()/(double)RAND_MAX*(P_MAX-P_MIN) + P_MIN; - double phi = (double)random()/(double)RAND_MAX*(PHI_MAX-PHI_MIN) + PHI_MIN; - double theta = (double)random()/(double)RAND_MAX*(THETA_MAX-THETA_MIN) + THETA_MIN; - - p.E = sqrt(mom*mom + PI_CHARGED_MASS*PI_CHARGED_MASS); - p.px = mom*sin(theta)*cos(phi); - p.py = mom*sin(theta)*sin(phi); - p.pz = mom*cos(theta); - piXs.push_back(p); - - // Write event to file - unsigned int type = PI_PLUS_TYPE; - of< -#include -#include -#include -#include -#include -#include -using namespace std; - -double PI_ZERO_MASS = 0.13497; -unsigned int MAX_EVENTS=10000; -int NUM_TO_GEN=1; -double E_BEAM_MIN=PI_ZERO_MASS; -double E_BEAM_MAX=1.0; -int RUN_NUMBER=100; -string OUTPUT_FILENAME="genpi0.ascii"; - -double FORCE_THETA = -1000.0; -double FORCE_PHI = -1000.0; -double THETA_PHOTON_MIN = 0.0; // minimum angle for photons in radians -double THETA_PHOTON_MAX = M_PI; // minimum angle for photons in radians - -#define GAMMA_TYPE 1 -#define PI_TYPE 7 - -class pi0{ - public: - double px,py,pz,E; // pi0 - double px1, py1, pz1, E1; // decay photon 1 - double px2, py2, pz2, E2; // decay photon 2 -}; - - -void ParseCommandLineArguments(int narg, char* argv[]); -void Usage(void); - - -//---------------------------- -// main -//---------------------------- -int main(int narg, char* argv[]) -{ - - // Parse the command line - ParseCommandLineArguments(narg, argv); - - // Open file for output - ofstream of(OUTPUT_FILENAME.c_str()); - if(!of.is_open()){ - cout<<"Unable to open \""< pi0s; - for(int i=0; i-1000.0)theta_pi0=FORCE_THETA; - if(FORCE_PHI>-1000.0)phi_pi0=FORCE_PHI; - pi0 p; - p.E = E_pi0; - p.px = p_pi0*sin(theta_pi0)*cos(phi_pi0); - p.py = p_pi0*sin(theta_pi0)*sin(phi_pi0); - p.pz = p_pi0*cos(theta_pi0); - - // 4-vectors of 2 decay photons in rest frame of pi0 - // where they are isotropic and back to back. - double phi = 2.0*M_PI*((double)random()/(double)RAND_MAX); - double theta = M_PI*((double)random()/(double)RAND_MAX); - - p.E1 = PI_ZERO_MASS/2.0; - p.px1 = p.E1*sin(theta)*cos(phi); - p.py1 = p.E1*sin(theta)*sin(phi); - p.pz1 = p.E1*cos(theta); - - p.E2 = p.E1; - p.px2 = -p.px1; - p.py2 = -p.py1; - p.pz2 = -p.pz1; - - // Boost photons into lab frame using 4-vector of pi0 - // (http://rd11.web.cern.ch/RD11/rkb/PH14pp/node105.html) - p.E1 = (p.E1*p.E + p.px1*p.px + p.py1*p.py + p.pz1*p.pz)/PI_ZERO_MASS; - p.px1 += p.px*(PI_ZERO_MASS/2.0 + p.E1)/(p.E + PI_ZERO_MASS); - p.py1 += p.py*(PI_ZERO_MASS/2.0 + p.E1)/(p.E + PI_ZERO_MASS); - p.pz1 += p.pz*(PI_ZERO_MASS/2.0 + p.E1)/(p.E + PI_ZERO_MASS); - - p.E2 = (p.E2*p.E + p.px2*p.px + p.py2*p.py + p.pz2*p.pz)/PI_ZERO_MASS; - p.px2 += p.px*(PI_ZERO_MASS/2.0 + p.E2)/(p.E + PI_ZERO_MASS); - p.py2 += p.py*(PI_ZERO_MASS/2.0 + p.E2)/(p.E + PI_ZERO_MASS); - p.pz2 += p.pz*(PI_ZERO_MASS/2.0 + p.E2)/(p.E + PI_ZERO_MASS); - - // Check that photons are within limits set by user - double gtheta1 = acos(p.pz1/p.E1); - double gtheta2 = acos(p.pz2/p.E2); - if(gtheta1THETA_PHOTON_MAX - || gtheta2THETA_PHOTON_MAX){ - i--; - continue; - } - - pi0s.push_back(p); - Etot -= E_pi0; // subtract this from beam energy available - } - - // Write event to file - of< - -void addint(double **uf, double **uc, double **res, int nf); -void airy(float x, float *ai, float *bi, float *aip, float *bip); -void amebsa(float **p, float y[], int ndim, float pb[], float *yb, - float ftol, float (*funk)(float []), int *iter, float temptr); -void amoeba(float **p, float y[], int ndim, float ftol, - float (*funk)(float []), int *iter); -float amotry(float **p, float y[], float psum[], int ndim, - float (*funk)(float []), int ihi, float fac); -float amotsa(float **p, float y[], float psum[], int ndim, float pb[], - float *yb, float (*funk)(float []), int ihi, float *yhi, float fac); -void anneal(float x[], float y[], int iorder[], int ncity); -double anorm2(double **a, int n); -void arcmak(unsigned long nfreq[], unsigned long nchh, unsigned long nradd, - arithcode *acode); -void arcode(unsigned long *ich, unsigned char **codep, unsigned long *lcode, - unsigned long *lcd, int isign, arithcode *acode); -void arcsum(unsigned long iin[], unsigned long iout[], unsigned long ja, - int nwk, unsigned long nrad, unsigned long nc); -void asolve(unsigned long n, double b[], double x[], int itrnsp); -void atimes(unsigned long n, double x[], double r[], int itrnsp); -void avevar(float data[], unsigned long n, float *ave, float *var); -void balanc(float **a, int n); -void banbks(float **a, unsigned long n, int m1, int m2, float **al, - unsigned long indx[], float b[]); -void bandec(float **a, unsigned long n, int m1, int m2, float **al, - unsigned long indx[], float *d); -void banmul(float **a, unsigned long n, int m1, int m2, float x[], float b[]); -void bcucof(float y[], float y1[], float y2[], float y12[], float d1, - float d2, float **c); -void bcuint(float y[], float y1[], float y2[], float y12[], - float x1l, float x1u, float x2l, float x2u, float x1, - float x2, float *ansy, float *ansy1, float *ansy2); -void beschb(double x, double *gam1, double *gam2, double *gampl, - double *gammi); -float bessi(int n, float x); -float bessi0(float x); -float bessi1(float x); -void bessik(float x, float xnu, float *ri, float *rk, float *rip, - float *rkp); -float bessj(int n, float x); -float bessj0(float x); -float bessj1(float x); -void bessjy(float x, float xnu, float *rj, float *ry, float *rjp, - float *ryp); -float bessk(int n, float x); -float bessk0(float x); -float bessk1(float x); -float bessy(int n, float x); -float bessy0(float x); -float bessy1(float x); -float beta(float z, float w); -float betacf(float a, float b, float x); -float betai(float a, float b, float x); -float bico(int n, int k); -void bksub(int ne, int nb, int jf, int k1, int k2, float ***c); -float bnldev(float pp, int n, long *idum); -float brent(float ax, float bx, float cx, - float (*f)(float), float tol, float *xmin); -void broydn(float x[], int n, int *check, - void (*vecfunc)(int, float [], float [])); -void bsstep(float y[], float dydx[], int nv, float *xx, float htry, - float eps, float yscal[], float *hdid, float *hnext, - void (*derivs)(float, float [], float [])); -void caldat(long julian, int *mm, int *id, int *iyyy); -void chder(float a, float b, float c[], float cder[], int n); -float chebev(float a, float b, float c[], int m, float x); -void chebft(float a, float b, float c[], int n, float (*func)(float)); -void chebpc(float c[], float d[], int n); -void chint(float a, float b, float c[], float cint[], int n); -float chixy(float bang); -void choldc(float **a, int n, float p[]); -void cholsl(float **a, int n, float p[], float b[], float x[]); -void chsone(float bins[], float ebins[], int nbins, int knstrn, - float *df, float *chsq, float *prob); -void chstwo(float bins1[], float bins2[], int nbins, int knstrn, - float *df, float *chsq, float *prob); -void cisi(float x, float *ci, float *si); -void cntab1(int **nn, int ni, int nj, float *chisq, - float *df, float *prob, float *cramrv, float *ccc); -void cntab2(int **nn, int ni, int nj, float *h, float *hx, float *hy, - float *hygx, float *hxgy, float *uygx, float *uxgy, float *uxy); -void convlv(float data[], unsigned long n, float respns[], unsigned long m, - int isign, float ans[]); -void copy(double **aout, double **ain, int n); -void correl(float data1[], float data2[], unsigned long n, float ans[]); -void cosft(float y[], int n, int isign); -void cosft1(float y[], int n); -void cosft2(float y[], int n, int isign); -void covsrt(float **covar, int ma, int ia[], int mfit); -void crank(unsigned long n, float w[], float *s); -void cyclic(float a[], float b[], float c[], float alpha, float beta, - float r[], float x[], unsigned long n); -void daub4(float a[], unsigned long n, int isign); -float dawson(float x); -float dbrent(float ax, float bx, float cx, - float (*f)(float), float (*df)(float), float tol, float *xmin); -void ddpoly(float c[], int nc, float x, float pd[], int nd); -int decchk(char string[], int n, char *ch); -void derivs(float x, float y[], float dydx[]); -float df1dim(float x); -void dfour1(double data[], unsigned long nn, int isign); -void dfpmin(float p[], int n, float gtol, int *iter, float *fret, - float (*func)(float []), void (*dfunc)(float [], float [])); -float dfridr(float (*func)(float), float x, float h, float *err); -void dftcor(float w, float delta, float a, float b, float endpts[], - float *corre, float *corim, float *corfac); -void dftint(float (*func)(float), float a, float b, float w, - float *cosint, float *sinint); -void difeq(int k, int k1, int k2, int jsf, int is1, int isf, - int indexv[], int ne, float **s, float **y); -void dlinmin(float p[], float xi[], int n, float *fret, - float (*func)(float []), void (*dfunc)(float [], float[])); -double dpythag(double a, double b); -void drealft(double data[], unsigned long n, int isign); -void dsprsax(double sa[], unsigned long ija[], double x[], double b[], - unsigned long n); -void dsprstx(double sa[], unsigned long ija[], double x[], double b[], - unsigned long n); -void dsvbksb(double **u, double w[], double **v, int m, int n, double b[], - double x[]); -void dsvdcmp(double **a, int m, int n, double w[], double **v); -void eclass(int nf[], int n, int lista[], int listb[], int m); -void eclazz(int nf[], int n, int (*equiv)(int, int)); -float ei(float x); -void eigsrt(float d[], float **v, int n); -float elle(float phi, float ak); -float ellf(float phi, float ak); -float ellpi(float phi, float en, float ak); -void elmhes(float **a, int n); -float erfcc(float x); -float erff(float x); -float erffc(float x); -void eulsum(float *sum, float term, int jterm, float wksp[]); -float evlmem(float fdt, float d[], int m, float xms); -float expdev(long *idum); -float expint(int n, float x); -float f1(float x); -float f1dim(float x); -float f2(float y); -float f3(float z); -float factln(int n); -float factrl(int n); -void fasper(float x[], float y[], unsigned long n, float ofac, float hifac, - float wk1[], float wk2[], unsigned long nwk, unsigned long *nout, - unsigned long *jmax, float *prob); -void fdjac(int n, float x[], float fvec[], float **df, - void (*vecfunc)(int, float [], float [])); -void fgauss(float x, float a[], float *y, float dyda[], int na); -void fill0(double **u, int n); -void fit(float x[], float y[], int ndata, float sig[], int mwt, - float *a, float *b, float *siga, float *sigb, float *chi2, float *q); -void fitexy(float x[], float y[], int ndat, float sigx[], float sigy[], - float *a, float *b, float *siga, float *sigb, float *chi2, float *q); -void fixrts(float d[], int m); -void fleg(float x, float pl[], int nl); -void flmoon(int n, int nph, long *jd, float *frac); -float fmin(float x[]); -void four1(float data[], unsigned long nn, int isign); -void fourew(FILE *file[5], int *na, int *nb, int *nc, int *nd); -void fourfs(FILE *file[5], unsigned long nn[], int ndim, int isign); -void fourn(float data[], unsigned long nn[], int ndim, int isign); -void fpoly(float x, float p[], int np); -void fred2(int n, float a, float b, float t[], float f[], float w[], - float (*g)(float), float (*ak)(float, float)); -float fredin(float x, int n, float a, float b, float t[], float f[], float w[], - float (*g)(float), float (*ak)(float, float)); -void frenel(float x, float *s, float *c); -void frprmn(float p[], int n, float ftol, int *iter, float *fret, - float (*func)(float []), void (*dfunc)(float [], float [])); -void ftest(float data1[], unsigned long n1, float data2[], unsigned long n2, - float *f, float *prob); -float gamdev(int ia, long *idum); -float gammln(float xx); -float gammp(float a, float x); -float gammq(float a, float x); -float gasdev(long *idum); -void gaucof(int n, float a[], float b[], float amu0, float x[], float w[]); -void gauher(float x[], float w[], int n); -void gaujac(float x[], float w[], int n, float alf, float bet); -void gaulag(float x[], float w[], int n, float alf); -void gauleg(float x1, float x2, float x[], float w[], int n); -void gaussj(float **a, int n, float **b, int m); -void gcf(float *gammcf, float a, float x, float *gln); -float golden(float ax, float bx, float cx, float (*f)(float), float tol, - float *xmin); -void gser(float *gamser, float a, float x, float *gln); -void hpsel(unsigned long m, unsigned long n, float arr[], float heap[]); -void hpsort(unsigned long n, float ra[]); -void hqr(float **a, int n, float wr[], float wi[]); -void hufapp(unsigned long index[], unsigned long nprob[], unsigned long n, - unsigned long i); -void hufdec(unsigned long *ich, unsigned char *code, unsigned long lcode, - unsigned long *nb, huffcode *hcode); -void hufenc(unsigned long ich, unsigned char **codep, unsigned long *lcode, - unsigned long *nb, huffcode *hcode); -void hufmak(unsigned long nfreq[], unsigned long nchin, unsigned long *ilong, - unsigned long *nlong, huffcode *hcode); -void hunt(float xx[], unsigned long n, float x, unsigned long *jlo); -void hypdrv(float s, float yy[], float dyyds[]); -fcomplex hypgeo(fcomplex a, fcomplex b, fcomplex c, fcomplex z); -void hypser(fcomplex a, fcomplex b, fcomplex c, fcomplex z, - fcomplex *series, fcomplex *deriv); -unsigned short icrc(unsigned short crc, unsigned char *bufptr, - unsigned long len, short jinit, int jrev); -unsigned short icrc1(unsigned short crc, unsigned char onech); -unsigned long igray(unsigned long n, int is); -void iindexx(unsigned long n, long arr[], unsigned long indx[]); -void indexx(unsigned long n, float arr[], unsigned long indx[]); -void interp(double **uf, double **uc, int nf); -int irbit1(unsigned long *iseed); -int irbit2(unsigned long *iseed); -void jacobi(float **a, int n, float d[], float **v, int *nrot); -void jacobn(float x, float y[], float dfdx[], float **dfdy, int n); -long julday(int mm, int id, int iyyy); -void kendl1(float data1[], float data2[], unsigned long n, float *tau, float *z, - float *prob); -void kendl2(float **tab, int i, int j, float *tau, float *z, float *prob); -void kermom(double w[], double y, int m); -void ks2d1s(float x1[], float y1[], unsigned long n1, - void (*quadvl)(float, float, float *, float *, float *, float *), - float *d1, float *prob); -void ks2d2s(float x1[], float y1[], unsigned long n1, float x2[], float y2[], - unsigned long n2, float *d, float *prob); -void ksone(float data[], unsigned long n, float (*func)(float), float *d, - float *prob); -void kstwo(float data1[], unsigned long n1, float data2[], unsigned long n2, - float *d, float *prob); -void laguer(fcomplex a[], int m, fcomplex *x, int *its); -void lfit(float x[], float y[], float sig[], int ndat, float a[], int ia[], - int ma, float **covar, float *chisq, void (*funcs)(float, float [], int)); -void linbcg(unsigned long n, double b[], double x[], int itol, double tol, - int itmax, int *iter, double *err); -void linmin(float p[], float xi[], int n, float *fret, - float (*func)(float [])); -void lnsrch(int n, float xold[], float fold, float g[], float p[], float x[], - float *f, float stpmax, int *check, float (*func)(float [])); -void load(float x1, float v[], float y[]); -void load1(float x1, float v1[], float y[]); -void load2(float x2, float v2[], float y[]); -void locate(float xx[], unsigned long n, float x, unsigned long *j); -void lop(double **out, double **u, int n); -void lubksb(float **a, int n, int *indx, float b[]); -void ludcmp(float **a, int n, int *indx, float *d); -void machar(int *ibeta, int *it, int *irnd, int *ngrd, - int *machep, int *negep, int *iexp, int *minexp, int *maxexp, - float *eps, float *epsneg, float *xmin, float *xmax); -void matadd(double **a, double **b, double **c, int n); -void matsub(double **a, double **b, double **c, int n); -void medfit(float x[], float y[], int ndata, float *a, float *b, float *abdev); -void memcof(float data[], int n, int m, float *xms, float d[]); -int metrop(float de, float t); -void mgfas(double **u, int n, int maxcyc); -void mglin(double **u, int n, int ncycle); -float midexp(float (*funk)(float), float aa, float bb, int n); -float midinf(float (*funk)(float), float aa, float bb, int n); -float midpnt(float (*func)(float), float a, float b, int n); -float midsql(float (*funk)(float), float aa, float bb, int n); -float midsqu(float (*funk)(float), float aa, float bb, int n); -void miser(float (*func)(float []), float regn[], int ndim, unsigned long npts, - float dith, float *ave, float *var); -void mmid(float y[], float dydx[], int nvar, float xs, float htot, - int nstep, float yout[], void (*derivs)(float, float[], float[])); -void mnbrak(float *ax, float *bx, float *cx, float *fa, float *fb, - float *fc, float (*func)(float)); -void mnewt(int ntrial, float x[], int n, float tolx, float tolf); -void moment(float data[], int n, float *ave, float *adev, float *sdev, - float *var, float *skew, float *curt); -void mp2dfr(unsigned char a[], unsigned char s[], int n, int *m); -void mpadd(unsigned char w[], unsigned char u[], unsigned char v[], int n); -void mpdiv(unsigned char q[], unsigned char r[], unsigned char u[], - unsigned char v[], int n, int m); -void mpinv(unsigned char u[], unsigned char v[], int n, int m); -void mplsh(unsigned char u[], int n); -void mpmov(unsigned char u[], unsigned char v[], int n); -void mpmul(unsigned char w[], unsigned char u[], unsigned char v[], int n, - int m); -void mpneg(unsigned char u[], int n); -void mppi(int n); -void mprove(float **a, float **alud, int n, int indx[], float b[], - float x[]); -void mpsad(unsigned char w[], unsigned char u[], int n, int iv); -void mpsdv(unsigned char w[], unsigned char u[], int n, int iv, int *ir); -void mpsmu(unsigned char w[], unsigned char u[], int n, int iv); -void mpsqrt(unsigned char w[], unsigned char u[], unsigned char v[], int n, - int m); -void mpsub(int *is, unsigned char w[], unsigned char u[], unsigned char v[], - int n); -void mrqcof(float x[], float y[], float sig[], int ndata, float a[], - int ia[], int ma, float **alpha, float beta[], float *chisq, - void (*funcs)(float, float [], float *, float [], int)); -void mrqmin(float x[], float y[], float sig[], int ndata, float a[], - int ia[], int ma, float **covar, float **alpha, float *chisq, - void (*funcs)(float, float [], float *, float [], int), float *alamda); -void newt(float x[], int n, int *check, - void (*vecfunc)(int, float [], float [])); -void odeint(float ystart[], int nvar, float x1, float x2, - float eps, float h1, float hmin, int *nok, int *nbad, - void (*derivs)(float, float [], float []), - void (*rkqs)(float [], float [], int, float *, float, float, - float [], float *, float *, void (*)(float, float [], float []))); -void orthog(int n, float anu[], float alpha[], float beta[], float a[], - float b[]); -void pade(double cof[], int n, float *resid); -void pccheb(float d[], float c[], int n); -void pcshft(float a, float b, float d[], int n); -void pearsn(float x[], float y[], unsigned long n, float *r, float *prob, - float *z); -void period(float x[], float y[], int n, float ofac, float hifac, - float px[], float py[], int np, int *nout, int *jmax, float *prob); -void piksr2(int n, float arr[], float brr[]); -void piksrt(int n, float arr[]); -void pinvs(int ie1, int ie2, int je1, int jsf, int jc1, int k, - float ***c, float **s); -float plgndr(int l, int m, float x); -float poidev(float xm, long *idum); -void polcoe(float x[], float y[], int n, float cof[]); -void polcof(float xa[], float ya[], int n, float cof[]); -void poldiv(float u[], int n, float v[], int nv, float q[], float r[]); -void polin2(float x1a[], float x2a[], float **ya, int m, int n, - float x1, float x2, float *y, float *dy); -void polint(float xa[], float ya[], int n, float x, float *y, float *dy); -void powell(float p[], float **xi, int n, float ftol, int *iter, float *fret, - float (*func)(float [])); -void predic(float data[], int ndata, float d[], int m, float future[], int nfut); -float probks(float alam); -void psdes(unsigned long *lword, unsigned long *irword); -void pwt(float a[], unsigned long n, int isign); -void pwtset(int n); -float pythag(float a, float b); -void pzextr(int iest, float xest, float yest[], float yz[], float dy[], - int nv); -float qgaus(float (*func)(float), float a, float b); -void qrdcmp(float **a, int n, float *c, float *d, int *sing); -float qromb(float (*func)(float), float a, float b); -float qromo(float (*func)(float), float a, float b, - float (*choose)(float (*)(float), float, float, int)); -void qroot(float p[], int n, float *b, float *c, float eps); -void qrsolv(float **a, int n, float c[], float d[], float b[]); -void qrupdt(float **r, float **qt, int n, float u[], float v[]); -float qsimp(float (*func)(float), float a, float b); -float qtrap(float (*func)(float), float a, float b); -float quad3d(float (*func)(float, float, float), float x1, float x2); -void quadct(float x, float y, float xx[], float yy[], unsigned long nn, - float *fa, float *fb, float *fc, float *fd); -void quadmx(float **a, int n); -void quadvl(float x, float y, float *fa, float *fb, float *fc, float *fd); -float ran0(long *idum); -float ran1(long *idum); -float ran2(long *idum); -float ran3(long *idum); -float ran4(long *idum); -void rank(unsigned long n, unsigned long indx[], unsigned long irank[]); -void ranpt(float pt[], float regn[], int n); -void ratint(float xa[], float ya[], int n, float x, float *y, float *dy); -void ratlsq(double (*fn)(double), double a, double b, int mm, int kk, - double cof[], double *dev); -double ratval(double x, double cof[], int mm, int kk); -float rc(float x, float y); -float rd(float x, float y, float z); -void realft(float data[], unsigned long n, int isign); -void rebin(float rc, int nd, float r[], float xin[], float xi[]); -void red(int iz1, int iz2, int jz1, int jz2, int jm1, int jm2, int jmf, - int ic1, int jc1, int jcf, int kc, float ***c, float **s); -void relax(double **u, double **rhs, int n); -void relax2(double **u, double **rhs, int n); -void resid(double **res, double **u, double **rhs, int n); -float revcst(float x[], float y[], int iorder[], int ncity, int n[]); -void reverse(int iorder[], int ncity, int n[]); -float rf(float x, float y, float z); -float rj(float x, float y, float z, float p); -void rk4(float y[], float dydx[], int n, float x, float h, float yout[], - void (*derivs)(float, float [], float [])); -void rkck(float y[], float dydx[], int n, float x, float h, - float yout[], float yerr[], void (*derivs)(float, float [], float [])); -void rkdumb(float vstart[], int nvar, float x1, float x2, int nstep, - void (*derivs)(float, float [], float [])); -void rkqs(float y[], float dydx[], int n, float *x, - float htry, float eps, float yscal[], float *hdid, float *hnext, - void (*derivs)(float, float [], float [])); -void rlft3(float ***data, float **speq, unsigned long nn1, - unsigned long nn2, unsigned long nn3, int isign); -float rofunc(float b); -void rotate(float **r, float **qt, int n, int i, float a, float b); -void rsolv(float **a, int n, float d[], float b[]); -void rstrct(double **uc, double **uf, int nc); -float rtbis(float (*func)(float), float x1, float x2, float xacc); -float rtflsp(float (*func)(float), float x1, float x2, float xacc); -float rtnewt(void (*funcd)(float, float *, float *), float x1, float x2, - float xacc); -float rtsafe(void (*funcd)(float, float *, float *), float x1, float x2, - float xacc); -float rtsec(float (*func)(float), float x1, float x2, float xacc); -void rzextr(int iest, float xest, float yest[], float yz[], float dy[], int nv); -void savgol(float c[], int np, int nl, int nr, int ld, int m); -void score(float xf, float y[], float f[]); -void scrsho(float (*fx)(float)); -float select(unsigned long k, unsigned long n, float arr[]); -float selip(unsigned long k, unsigned long n, float arr[]); -void shell(unsigned long n, float a[]); -void shoot(int n, float v[], float f[]); -void shootf(int n, float v[], float f[]); -void simp1(float **a, int mm, int ll[], int nll, int iabf, int *kp, - float *bmax); -void simp2(float **a, int m, int n, int *ip, int kp); -void simp3(float **a, int i1, int k1, int ip, int kp); -void simplx(float **a, int m, int n, int m1, int m2, int m3, int *icase, - int izrov[], int iposv[]); -void simpr(float y[], float dydx[], float dfdx[], float **dfdy, - int n, float xs, float htot, int nstep, float yout[], - void (*derivs)(float, float [], float [])); -void sinft(float y[], int n); -void slvsm2(double **u, double **rhs); -void slvsml(double **u, double **rhs); -void sncndn(float uu, float emmc, float *sn, float *cn, float *dn); -double snrm(unsigned long n, double sx[], int itol); -void sobseq(int *n, float x[]); -void solvde(int itmax, float conv, float slowc, float scalv[], - int indexv[], int ne, int nb, int m, float **y, float ***c, float **s); -void sor(double **a, double **b, double **c, double **d, double **e, - double **f, double **u, int jmax, double rjac); -void sort(unsigned long n, float arr[]); -void sort2(unsigned long n, float arr[], float brr[]); -void sort3(unsigned long n, float ra[], float rb[], float rc[]); -void spctrm(FILE *fp, float p[], int m, int k, int ovrlap); -void spear(float data1[], float data2[], unsigned long n, float *d, float *zd, - float *probd, float *rs, float *probrs); -void sphbes(int n, float x, float *sj, float *sy, float *sjp, float *syp); -void splie2(float x1a[], float x2a[], float **ya, int m, int n, float **y2a); -void splin2(float x1a[], float x2a[], float **ya, float **y2a, int m, int n, - float x1, float x2, float *y); -void spline(float x[], float y[], int n, float yp1, float ypn, float y2[]); -void splint(float xa[], float ya[], float y2a[], int n, float x, float *y); -void spread(float y, float yy[], unsigned long n, float x, int m); -void sprsax(float sa[], unsigned long ija[], float x[], float b[], - unsigned long n); -void sprsin(float **a, int n, float thresh, unsigned long nmax, float sa[], - unsigned long ija[]); -void sprspm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], - float sc[], unsigned long ijc[]); -void sprstm(float sa[], unsigned long ija[], float sb[], unsigned long ijb[], - float thresh, unsigned long nmax, float sc[], unsigned long ijc[]); -void sprstp(float sa[], unsigned long ija[], float sb[], unsigned long ijb[]); -void sprstx(float sa[], unsigned long ija[], float x[], float b[], - unsigned long n); -void stifbs(float y[], float dydx[], int nv, float *xx, - float htry, float eps, float yscal[], float *hdid, float *hnext, - void (*derivs)(float, float [], float [])); -void stiff(float y[], float dydx[], int n, float *x, - float htry, float eps, float yscal[], float *hdid, float *hnext, - void (*derivs)(float, float [], float [])); -void stoerm(float y[], float d2y[], int nv, float xs, - float htot, int nstep, float yout[], - void (*derivs)(float, float [], float [])); -void svbksb(float **u, float w[], float **v, int m, int n, float b[], - float x[]); -void svdcmp(float **a, int m, int n, float w[], float **v); -void svdfit(float x[], float y[], float sig[], int ndata, float a[], - int ma, float **u, float **v, float w[], float *chisq, - void (*funcs)(float, float [], int)); -void svdvar(float **v, int ma, float w[], float **cvm); -void toeplz(float r[], float x[], float y[], int n); -void tptest(float data1[], float data2[], unsigned long n, float *t, float *prob); -void tqli(float d[], float e[], int n, float **z); -float trapzd(float (*func)(float), float a, float b, int n); -void tred2(float **a, int n, float d[], float e[]); -void tridag(float a[], float b[], float c[], float r[], float u[], - unsigned long n); -float trncst(float x[], float y[], int iorder[], int ncity, int n[]); -void trnspt(int iorder[], int ncity, int n[]); -void ttest(float data1[], unsigned long n1, float data2[], unsigned long n2, - float *t, float *prob); -void tutest(float data1[], unsigned long n1, float data2[], unsigned long n2, - float *t, float *prob); -void twofft(float data1[], float data2[], float fft1[], float fft2[], - unsigned long n); -void vander(double x[], double w[], double q[], int n); -void vegas(float regn[], int ndim, float (*fxn)(float [], float), int init, - unsigned long ncall, int itmx, int nprn, float *tgral, float *sd, - float *chi2a); -void voltra(int n, int m, float t0, float h, float *t, float **f, - float (*g)(int, float), float (*ak)(int, int, float, float)); -void wt1(float a[], unsigned long n, int isign, - void (*wtstep)(float [], unsigned long, int)); -void wtn(float a[], unsigned long nn[], int ndim, int isign, - void (*wtstep)(float [], unsigned long, int)); -void wwghts(float wghts[], int n, float h, - void (*kermom)(double [], double ,int)); -int zbrac(float (*func)(float), float *x1, float *x2); -void zbrak(float (*fx)(float), float x1, float x2, int n, float xb1[], - float xb2[], int *nb); -float zbrent(float (*func)(float), float x1, float x2, float tol); -void zrhqr(float a[], int m, float rtr[], float rti[]); -float zriddr(float (*func)(float), float x1, float x2, float xacc); -void zroots(fcomplex a[], int m, fcomplex roots[], int polish); - -#endif /* _NR_H_ */ diff --git a/src/programs/Simulation/genpi/nrutil.c b/src/programs/Simulation/genpi/nrutil.c deleted file mode 100644 index 49cae58a85..0000000000 --- a/src/programs/Simulation/genpi/nrutil.c +++ /dev/null @@ -1,293 +0,0 @@ -/* CAUTION: This is the ANSI C (only) version of the Numerical Recipes - utility file nrutil.c. Do not confuse this file with the same-named - file nrutil.c that is supplied in the 'misc' subdirectory. - *That* file is the one from the book, and contains both ANSI and - traditional K&R versions, along with #ifdef macros to select the - correct version. *This* file contains only ANSI C. */ - -#include -#include -#include -#define NR_END 1 -#define FREE_ARG char* - -void nrerror(char error_text[]) -/* Numerical Recipes standard error handler */ -{ - fprintf(stderr,"Numerical Recipes run-time error...\n"); - fprintf(stderr,"%s\n",error_text); - fprintf(stderr,"...now exiting to system...\n"); - exit(1); -} - -float *vector(long nl, long nh) -/* allocate a float vector with subscript range v[nl..nh] */ -{ - float *v; - - v=(float *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(float))); - if (!v) nrerror("allocation failure in vector()"); - return v-nl+NR_END; -} - -int *ivector(long nl, long nh) -/* allocate an int vector with subscript range v[nl..nh] */ -{ - int *v; - - v=(int *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(int))); - if (!v) nrerror("allocation failure in ivector()"); - return v-nl+NR_END; -} - -unsigned char *cvector(long nl, long nh) -/* allocate an unsigned char vector with subscript range v[nl..nh] */ -{ - unsigned char *v; - - v=(unsigned char *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(unsigned char))); - if (!v) nrerror("allocation failure in cvector()"); - return v-nl+NR_END; -} - -unsigned long *lvector(long nl, long nh) -/* allocate an unsigned long vector with subscript range v[nl..nh] */ -{ - unsigned long *v; - - v=(unsigned long *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(long))); - if (!v) nrerror("allocation failure in lvector()"); - return v-nl+NR_END; -} - -double *dvector(long nl, long nh) -/* allocate a double vector with subscript range v[nl..nh] */ -{ - double *v; - - v=(double *)malloc((size_t) ((nh-nl+1+NR_END)*sizeof(double))); - if (!v) nrerror("allocation failure in dvector()"); - return v-nl+NR_END; -} - -float **matrix(long nrl, long nrh, long ncl, long nch) -/* allocate a float matrix with subscript range m[nrl..nrh][ncl..nch] */ -{ - long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; - float **m; - - /* allocate pointers to rows */ - m=(float **) malloc((size_t)((nrow+NR_END)*sizeof(float*))); - if (!m) nrerror("allocation failure 1 in matrix()"); - m += NR_END; - m -= nrl; - - /* allocate rows and set pointers to them */ - m[nrl]=(float *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(float))); - if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); - m[nrl] += NR_END; - m[nrl] -= ncl; - - for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; - - /* return pointer to array of pointers to rows */ - return m; -} - -double **dmatrix(long nrl, long nrh, long ncl, long nch) -/* allocate a double matrix with subscript range m[nrl..nrh][ncl..nch] */ -{ - long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; - double **m; - - /* allocate pointers to rows */ - m=(double **) malloc((size_t)((nrow+NR_END)*sizeof(double*))); - if (!m) nrerror("allocation failure 1 in matrix()"); - m += NR_END; - m -= nrl; - - /* allocate rows and set pointers to them */ - m[nrl]=(double *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(double))); - if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); - m[nrl] += NR_END; - m[nrl] -= ncl; - - for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; - - /* return pointer to array of pointers to rows */ - return m; -} - -int **imatrix(long nrl, long nrh, long ncl, long nch) -/* allocate a int matrix with subscript range m[nrl..nrh][ncl..nch] */ -{ - long i, nrow=nrh-nrl+1,ncol=nch-ncl+1; - int **m; - - /* allocate pointers to rows */ - m=(int **) malloc((size_t)((nrow+NR_END)*sizeof(int*))); - if (!m) nrerror("allocation failure 1 in matrix()"); - m += NR_END; - m -= nrl; - - - /* allocate rows and set pointers to them */ - m[nrl]=(int *) malloc((size_t)((nrow*ncol+NR_END)*sizeof(int))); - if (!m[nrl]) nrerror("allocation failure 2 in matrix()"); - m[nrl] += NR_END; - m[nrl] -= ncl; - - for(i=nrl+1;i<=nrh;i++) m[i]=m[i-1]+ncol; - - /* return pointer to array of pointers to rows */ - return m; -} - -float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, - long newrl, long newcl) -/* point a submatrix [newrl..][newcl..] to a[oldrl..oldrh][oldcl..oldch] */ -{ - long i,j,nrow=oldrh-oldrl+1,ncol=oldcl-newcl; - float **m; - - /* allocate array of pointers to rows */ - m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); - if (!m) nrerror("allocation failure in submatrix()"); - m += NR_END; - m -= newrl; - - /* set pointers to rows */ - for(i=oldrl,j=newrl;i<=oldrh;i++,j++) m[j]=a[i]+ncol; - - /* return pointer to array of pointers to rows */ - return m; -} - -float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch) -/* allocate a float matrix m[nrl..nrh][ncl..nch] that points to the matrix -declared in the standard C manner as a[nrow][ncol], where nrow=nrh-nrl+1 -and ncol=nch-ncl+1. The routine should be called with the address -&a[0][0] as the first argument. */ -{ - long i,j,nrow=nrh-nrl+1,ncol=nch-ncl+1; - float **m; - - /* allocate pointers to rows */ - m=(float **) malloc((size_t) ((nrow+NR_END)*sizeof(float*))); - if (!m) nrerror("allocation failure in convert_matrix()"); - m += NR_END; - m -= nrl; - - /* set pointers to rows */ - m[nrl]=a-ncl; - for(i=1,j=nrl+1;i (dmaxarg2) ?\ - (dmaxarg1) : (dmaxarg2)) - -static double dminarg1=0,dminarg2=0; -#define DMIN(a,b) (dminarg1=(a),dminarg2=(b),(dminarg1) < (dminarg2) ?\ - (dminarg1) : (dminarg2)) - -static float maxarg1=0,maxarg2=0; -#define FMAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\ - (maxarg1) : (maxarg2)) - -static float minarg1=0,minarg2=0; -#define FMIN(a,b) (minarg1=(a),minarg2=(b),(minarg1) < (minarg2) ?\ - (minarg1) : (minarg2)) - -static long lmaxarg1=0,lmaxarg2=0; -#define LMAX(a,b) (lmaxarg1=(a),lmaxarg2=(b),(lmaxarg1) > (lmaxarg2) ?\ - (lmaxarg1) : (lmaxarg2)) - -static long lminarg1=0,lminarg2=0; -#define LMIN(a,b) (lminarg1=(a),lminarg2=(b),(lminarg1) < (lminarg2) ?\ - (lminarg1) : (lminarg2)) - -static int imaxarg1=0,imaxarg2=0; -#define IMAX(a,b) (imaxarg1=(a),imaxarg2=(b),(imaxarg1) > (imaxarg2) ?\ - (imaxarg1) : (imaxarg2)) - -static int iminarg1=0,iminarg2=0; -#define IMIN(a,b) (iminarg1=(a),iminarg2=(b),(iminarg1) < (iminarg2) ?\ - (iminarg1) : (iminarg2)) - -#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a)) - -void nrerror(char error_text[]); -float *vector(long nl, long nh); -int *ivector(long nl, long nh); -unsigned char *cvector(long nl, long nh); -unsigned long *lvector(long nl, long nh); -double *dvector(long nl, long nh); -float **matrix(long nrl, long nrh, long ncl, long nch); -double **dmatrix(long nrl, long nrh, long ncl, long nch); -int **imatrix(long nrl, long nrh, long ncl, long nch); -float **submatrix(float **a, long oldrl, long oldrh, long oldcl, long oldch, - long newrl, long newcl); -float **convert_matrix(float *a, long nrl, long nrh, long ncl, long nch); -float ***f3tensor(long nrl, long nrh, long ncl, long nch, long ndl, long ndh); -void free_vector(float *v, long nl, long nh); -void free_ivector(int *v, long nl, long nh); -void free_cvector(unsigned char *v, long nl, long nh); -void free_lvector(unsigned long *v, long nl, long nh); -void free_dvector(double *v, long nl, long nh); -void free_matrix(float **m, long nrl, long nrh, long ncl, long nch); -void free_dmatrix(double **m, long nrl, long nrh, long ncl, long nch); -void free_imatrix(int **m, long nrl, long nrh, long ncl, long nch); -void free_submatrix(float **b, long nrl, long nrh, long ncl, long nch); -void free_convert_matrix(float **b, long nrl, long nrh, long ncl, long nch); -void free_f3tensor(float ***t, long nrl, long nrh, long ncl, long nch, - long ndl, long ndh); - -//inline void initialize_static_define_regs() -//{ -// sqrarg = 0; -// dsqrarg = 0; -// dmaxarg1 = dmaxarg2 = 0; -// dminarg1 = dminarg2 = 0; -// maxarg1 = maxarg2 = 0; -// minarg1 = minarg2 = 0; -// lmaxarg1 = lmaxarg2 = 0; -// lminarg1 = lminarg2 = 0; -// imaxarg1 = imaxarg2 = 0; -// iminarg1 = iminarg2 = 0; -//} - -#endif /* _NR_UTILS_H_ */ diff --git a/src/programs/Simulation/genpi/rtnewt.c b/src/programs/Simulation/genpi/rtnewt.c deleted file mode 100644 index 27fe9f7bd0..0000000000 --- a/src/programs/Simulation/genpi/rtnewt.c +++ /dev/null @@ -1,23 +0,0 @@ -#include -#define JMAX 20 - -double rtnewt(void (*funcd)(double, double *, double *), double x1, double x2, - double xacc) -{ - void nrerror(char error_text[]); - int j; - double df,dx,f,rtn; - - rtn=0.5*(x1+x2); - for (j=1;j<=JMAX;j++) { - (*funcd)(rtn,&f,&df); - dx=f/df; - rtn -= dx; - if ((x1-rtn)*(rtn-x2) < 0.0) - nrerror("Jumped out of brackets in rtnewt"); - if (fabs(dx) < xacc) return rtn; - } - nrerror("Maximum number of iterations exceeded in rtnewt"); - return 0.0; -} -#undef JMAX diff --git a/src/programs/Simulation/genpi/rtsafe.c b/src/programs/Simulation/genpi/rtsafe.c deleted file mode 100644 index cf9af2a17e..0000000000 --- a/src/programs/Simulation/genpi/rtsafe.c +++ /dev/null @@ -1,53 +0,0 @@ -#include -#define MAXIT 100 - -double rtsafe(void (*funcd)(double, double *, double *), double x1, double x2, - double xacc) -{ - void nrerror(char error_text[]); - int j; - double df,dx,dxold,f,fh,fl; - double temp,xh,xl,rts; - - (*funcd)(x1,&fl,&df); - (*funcd)(x2,&fh,&df); - if ((fl > 0.0 && fh > 0.0) || (fl < 0.0 && fh < 0.0)) - nrerror("Root must be bracketed in rtsafe"); - if (fl == 0.0) return x1; - if (fh == 0.0) return x2; - if (fl < 0.0) { - xl=x1; - xh=x2; - } else { - xh=x1; - xl=x2; - } - rts=0.5*(x1+x2); - dxold=fabs(x2-x1); - dx=dxold; - (*funcd)(rts,&f,&df); - for (j=1;j<=MAXIT;j++) { - if ((((rts-xh)*df-f)*((rts-xl)*df-f) > 0.0) - || (fabs(2.0*f) > fabs(dxold*df))) { - dxold=dx; - dx=0.5*(xh-xl); - rts=xl+dx; - if (xl == rts) return rts; - } else { - dxold=dx; - dx=f/df; - temp=rts; - rts -= dx; - if (temp == rts) return rts; - } - if (fabs(dx) < xacc) return rts; - (*funcd)(rts,&f,&df); - if (f < 0.0) - xl=rts; - else - xh=rts; - } - nrerror("Maximum number of iterations exceeded in rtsafe"); - return 0.0; -} -#undef MAXIT diff --git a/src/programs/Simulation/genpi/zbrent.c b/src/programs/Simulation/genpi/zbrent.c deleted file mode 100644 index 4ce4f637ba..0000000000 --- a/src/programs/Simulation/genpi/zbrent.c +++ /dev/null @@ -1,72 +0,0 @@ -#include -#define NRANSI -#include "nrutil.h" -#define ITMAX 100 -#define EPS 3.0e-8 - -double zbrent(double (*func)(double), double x1, double x2, double tol) -{ - int iter; - double a=x1,b=x2,c=x2,d=0,e=0,min1,min2; - double fa=(*func)(a),fb=(*func)(b),fc,p,q,r,s,tol1,xm; - - if ((fa > 0.0 && fb > 0.0) || (fa < 0.0 && fb < 0.0)) - nrerror("Root must be bracketed in zbrent"); - fc=fb; - for (iter=1;iter<=ITMAX;iter++) { - if ((fb > 0.0 && fc > 0.0) || (fb < 0.0 && fc < 0.0)) { - c=a; - fc=fa; - e=d=b-a; - } - if (fabs(fc) < fabs(fb)) { - a=b; - b=c; - c=a; - fa=fb; - fb=fc; - fc=fa; - } - tol1=2.0*EPS*fabs(b)+0.5*tol; - xm=0.5*(c-b); - if (fabs(xm) <= tol1 || fb == 0.0) return b; - if (fabs(e) >= tol1 && fabs(fa) > fabs(fb)) { - s=fb/fa; - if (a == c) { - p=2.0*xm*s; - q=1.0-s; - } else { - q=fa/fc; - r=fb/fc; - p=s*(2.0*xm*q*(q-r)-(b-a)*(r-1.0)); - q=(q-1.0)*(r-1.0)*(s-1.0); - } - if (p > 0.0) q = -q; - p=fabs(p); - min1=3.0*xm*q-fabs(tol1*q); - min2=fabs(e*q); - if (2.0*p < (min1 < min2 ? min1 : min2)) { - e=d; - d=p/q; - } else { - d=xm; - e=d; - } - } else { - d=xm; - e=d; - } - a=b; - fa=fb; - if (fabs(d) > tol1) - b += d; - else - b += SIGN(tol1,xm); - fb=(*func)(b); - } - nrerror("Maximum number of iterations exceeded in zbrent"); - return 0.0; -} -#undef ITMAX -#undef EPS -#undef NRANSI diff --git a/src/programs/Simulation/genr8/InputFiles/KstarKstar.input b/src/programs/Simulation/genr8/InputFiles/KstarKstar.input deleted file mode 100644 index d55009a0e8..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/KstarKstar.input +++ /dev/null @@ -1,91 +0,0 @@ -% Input key file for X-> omega + eta -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% ***Mass, Energy, and Momentum are in GeV's *** -% Any number of blank spaces (no tabs or returns) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 8 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X and Y -8 -% particle# child1# child2# parent# Id ndau mass width charge flag -% baryon decay - 0 * * * 14 0 0.938 0 +1 11 -% meson decay - 1 2 3 * 0 2 2.2 0.150 0 00 - 3 4 7 1 0 2 0.890 0.050 0 01 - 2 5 6 1 0 2 0.890 0.050 0 01 - 4 * * 3 11 0 0.494 0.000 +1 10 - 5 * * 2 12 0 0.494 0.000 -1 10 - 6 * * 2 8 0 0.140 0.000 +1 10 - 7 * * 3 9 0 0.140 0.000 -1 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -% flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/b1_pi.input b/src/programs/Simulation/genr8/InputFiles/b1_pi.input deleted file mode 100644 index c35c1299fc..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/b1_pi.input +++ /dev/null @@ -1,130 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> p X(1600) (All decays are isotropic) -% X -> pi+ pi- pi0 -% pi0->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% This file generates event for the following reaction -% -% gamma p -> p X(2000) -% | -% |-> b1(1235) pi- -% | -% |-> omega pi+ -% | -% |-> rho pi0 -% | |-> gamma gamma -% | -% |-> pi+ pi- -% -% -% Note that in the real world, omegas don't decay into rhos -% but it is implemeted that way here due to the limitations -% of the isobar model. -% -% Feb. 13, 2008 David Lawrence -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 9 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -12 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 2.000 0.100 +1 00 - 2 4 5 1 0 2 1.235 0.142 +1 00 - 3 * * 1 9 0 0.140 0.0 -1 11 - 4 6 7 2 0 2 0.783 0.009 0 00 - 5 * * 2 8 0 0.140 0.0 +1 11 - 6 8 9 4 0 2 0.776 0.150 0 00 - 7 10 11 4 7 2 0.135 0.0 0 00 - 8 * * 6 8 0 0.140 0.0 +1 11 - 9 * * 6 9 0 0.140 0.0 -1 11 -10 * * 7 1 0 0.0 0.0 0 11 -11 * * 7 1 0 0.0 0.0 0 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/eta1_p.input b/src/programs/Simulation/genr8/InputFiles/eta1_p.input deleted file mode 100644 index 399f410ddb..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/eta1_p.input +++ /dev/null @@ -1,105 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> eta pi+ pi+ pi- -% eta ->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 9.0 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -8 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 1.800 0.300 +1 00 - 2 4 5 1 0 2 1.260 0.250 +1 00 - 3 * * 1 9 0 0.140 0 -1 11 - 4 * * 2 8 0 0.140 0 +1 11 - 5 6 7 2 0 2 0.776 0.149 0 00 - 6 * * 5 8 0 0.140 0 +1 11 - 7 * * 5 9 0 0.140 0 -1 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/n_3pi.input b/src/programs/Simulation/genr8/InputFiles/n_3pi.input deleted file mode 100644 index 9b77d62b65..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/n_3pi.input +++ /dev/null @@ -1,104 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> pi+ rho0 -% rho0 -> pi+pi- -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% -% for data that is used as input to HDFast. -% -% modified March 22, 2004, gh -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 9.0 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -6 -% % particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 13 0 0.938 0.0 0 11 -% meson (X) decay - 1 2 3 * 0 2 1.600 0.1000 +1 00 - 2 4 5 1 0 2 0.770 0.1502 0 00 - 3 * * 1 8 0 0.140 0 +1 11 - 4 * * 2 8 0 0.140 0 +1 11 - 5 * * 2 9 0 0.140 0 -1 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/n_eta_pi+pi-pi+.input b/src/programs/Simulation/genr8/InputFiles/n_eta_pi+pi-pi+.input deleted file mode 100644 index bebbe74158..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/n_eta_pi+pi-pi+.input +++ /dev/null @@ -1,107 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> eta pi+ pi+ pi- -% eta ->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -10 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 13 0 0.938 0.0 0 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth +1 00 - 2 4 5 1 0 2 0.958 10.0 0 00 - 3 * * 1 8 0 0.140 0 +1 11 - 4 * * 2 9 0 0.140 0 -1 11 - 5 6 7 2 0 2 0.760 200.0 +1 00 - 6 * * 5 8 0 0.140 0 +1 11 - 7 8 9 5 17 2 0.540 10.0 0 01 - 8 * * 7 1 0 0 0 0 10 - 9 * * 7 1 0 0 0 0 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/n_omega_pi+.input b/src/programs/Simulation/genr8/InputFiles/n_omega_pi+.input deleted file mode 100644 index 7670668c46..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/n_omega_pi+.input +++ /dev/null @@ -1,109 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1800) (All decays are isotropic) -% X+ -> omega pi+ -% omega -> pi+ pi- pi0 -% pi0 ->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -% March 22, 2004, gh -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -10 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 13 0 0.938 0.0 0 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth +1 00 - 2 * * 1 8 0 0.140 0 +1 11 - 3 4 5 1 0 2 0.780 0.008 0 00 - 4 8 9 3 7 2 0.134 0 0 01 - 5 6 7 3 0 2 0.540 10.0 0 00 - 6 * * 5 8 0 0.140 0 +1 11 - 7 * * 5 9 0 0.140 0 -1 11 - 8 * * 4 1 0 0 0 0 10 - 9 * * 4 1 0 0 0 0 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/n_omega_pi0_pi+.input b/src/programs/Simulation/genr8/InputFiles/n_omega_pi0_pi+.input deleted file mode 100644 index a2a1b35527..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/n_omega_pi0_pi+.input +++ /dev/null @@ -1,112 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1800) (All decays are isotropic) -% X -> omega pi0 pi+ -% omega -> pi+ pi- pi0 -% pi0 ->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -14 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 13 0 0.938 0.0 0 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth +1 00 - 2 4 5 1 0 2 1.235 10.0 0 00 - 3 * * 1 8 0 0.140 0 +1 11 - 4 12 13 2 7 2 0.134 0 0 01 - 5 6 7 2 0 2 0.780 0.008 0 00 - 6 10 11 5 7 2 0.134 0 0 01 - 7 8 9 5 0 2 0.640 10.0 0 00 - 8 * * 7 8 0 0.140 0 +1 11 - 9 * * 7 9 0 0.140 0 -1 11 - 10 * * 6 1 0 0 0 0 10 - 11 * * 6 1 0 0 0 0 10 - 12 * * 4 1 0 0 0 0 10 - 13 * * 4 1 0 0 0 0 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/omegadelta2.input b/src/programs/Simulation/genr8/InputFiles/omegadelta2.input deleted file mode 100644 index f51a80f03b..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/omegadelta2.input +++ /dev/null @@ -1,107 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> omega Delta+ (All decays are isotropic) -% omega -> pi0 gamma -% Delta+ -> p pi0 -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -% modified June 21, 2001: ejb -% include decays of pi0-->gamma gamma -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -10 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag - 0 4 5 * 0 2 Xmass Xwidth +1 00 - 1 2 3 * 0 2 0.783 0.0084 0 00 - 2 6 7 1 7 2 0.139 0 0 01 - 3 * * 1 1 0 0.000 0 0 11 - 4 * * 0 14 0 0.938 0 +1 11 - 5 8 9 0 7 2 0.139 0 0 01 - 6 * * 2 1 0 0.000 0 0 11 - 7 * * 2 1 0 0.000 0 0 11 - 8 * * 5 1 0 0.000 0 0 11 - 9 * * 5 1 0 0.000 0 0 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/pKstarKstar.input b/src/programs/Simulation/genr8/InputFiles/pKstarKstar.input deleted file mode 100644 index a757e8acbd..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/pKstarKstar.input +++ /dev/null @@ -1,47 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> pi+ pi+ pi- -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass - 0 0 9.0 0 -% targetp.x targetp.y targetp.z targetMass - 0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -12 -% Create the particle list -% particle# 0 & 1 are always the Y (baryon system) & X (meson system) respectively -% -% part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 2.25 0.145 0 00 - 2 4 5 1 0 2 0.89166 0.0508 -1 00 - 3 8 9 1 0 2 0.89166 0.0508 +1 00 - 4 6 7 2 16 2 0.497648 0 0 00 - 5 * * 2 9 0 0.140 0 -1 11 - 6 * * 4 9 0 0.140 0 -1 11 - 7 * * 4 8 0 0.140 0 +1 11 - 8 10 11 3 16 2 0.497648 0 0 00 - 9 * * 3 8 0 0.140 0 +1 11 - 10 * * 8 9 0 0.140 0 -1 11 - 11 * * 8 8 0 0.140 0 +1 11 -!EOI -%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%% diff --git a/src/programs/Simulation/genr8/InputFiles/p_K-pi+pi-K+.input b/src/programs/Simulation/genr8/InputFiles/p_K-pi+pi-K+.input deleted file mode 100644 index 113443decc..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/p_K-pi+pi-K+.input +++ /dev/null @@ -1,104 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Ap_K-pi+pi-K+.ascii -n < p_K-pi+pi-K+.input -% -% Example: gamma p -> p X(1900) (All decays are isotropic) -% X -> K- pi+ pi- K+ -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -8 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth 0 00 - 2 4 5 1 0 2 1.270 10.0 -1 00 - 3 * * 1 11 0 0.494 0 +1 11 - 4 * * 2 12 0 0.494 0 -1 11 - 5 6 7 2 57 2 0.770 10.0 0 00 - 6 * * 5 8 0 0.140 0 +1 11 - 7 * * 5 9 0 0.140 0 -1 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/p_eta_pi0pi0.input b/src/programs/Simulation/genr8/InputFiles/p_eta_pi0pi0.input deleted file mode 100644 index d76dabf841..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/p_eta_pi0pi0.input +++ /dev/null @@ -1,110 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> p X(1600) (All decays are isotropic) -% X -> eta pi0 pi0 -% eta ->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -% gh 04.04.07 -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -12 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 1 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth 0 00 - 2 4 5 1 0 2 0.958 10.0 0 00 - 3 6 7 1 7 2 0.134 0 0 01 - 4 8 9 2 7 2 0.134 0 0 01 - 5 10 11 2 17 2 0.540 0 0 01 - 6 * * 3 1 0 0 0 0 10 - 7 * * 3 1 0 0 0 0 10 - 8 * * 4 1 0 0 0 0 10 - 9 * * 4 1 0 0 0 0 10 - 10 * * 5 1 0 0 0 0 10 - 11 * * 5 1 0 0 0 0 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/p_pi+pi-pi0.input b/src/programs/Simulation/genr8/InputFiles/p_pi+pi-pi0.input deleted file mode 100644 index 962aa75c40..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/p_pi+pi-pi0.input +++ /dev/null @@ -1,105 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> p X(1600) (All decays are isotropic) -% X -> pi+ pi- pi0 -% pi0->2gamma -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 9.0 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -8 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 1 11 -% meson (X) decay - 1 2 3 * 0 2 2.0 0.300 0 00 - 2 4 5 1 0 2 0.770 10.0 -1 00 - 3 * * 1 8 0 0.140 0 +1 11 - 4 * * 2 9 0 0.140 0 -1 11 - 5 6 7 2 7 2 0.134 0 0 01 - 6 * * 5 1 0 0 0 0 10 - 7 * * 5 1 0 0 0 0 10 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/pk+k-pi+pi-.input b/src/programs/Simulation/genr8/InputFiles/pk+k-pi+pi-.input deleted file mode 100644 index e5df9a9cf5..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/pk+k-pi+pi-.input +++ /dev/null @@ -1,43 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> pi+ pi+ pi- -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass - 0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass - 0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -8 -% Create the particle list -% particle# 0 & 1 are always the Y (baryon system) & X (meson system) respectively -% -% part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth 0 00 - 2 4 5 1 0 2 1.270 0.10 -1 00 - 3 * * 1 11 0 0.494 0 +1 11 - 4 * * 2 12 0 0.494 0 -1 11 - 5 6 7 2 57 2 0.770 0.15 0 00 - 6 * * 5 9 0 0.140 0 -1 11 - 7 * * 5 8 0 0.140 0 +1 11 -!EOI -%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%% diff --git a/src/programs/Simulation/genr8/InputFiles/rho.input b/src/programs/Simulation/genr8/InputFiles/rho.input deleted file mode 100644 index 70d3d46574..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/rho.input +++ /dev/null @@ -1,85 +0,0 @@ -% Any number of blank spaces (no tabs or returns) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%%%%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass -0 0 9 0 -% targetp.x targetp.y targetp.z targetMass -0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -4 -% -% particle# 0&1 are always the X&Y -%part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 0.77 0.150 0 00 - 2 * * 1 9 0 0.140 0 -1 11 - 3 * * 1 8 0 0.140 0 +1 11 -!EOI -%%%%%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%%%%%%%%%%%%%%% -% for narrow widths particles(stable to strong interactions) -% set width to zero (i.e. eta, pi's). -% -%flag 00 =isobar or resonace -%flag 01 = production particle that decays i.e. eta, pizero .. -%flag 11 = production particle that does not decay i.e. piplus,... -%flag 10 = final state particle not in production i.e. gamma -% -% -% Particle Id information defined in particleType.h -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% These constants are defined to be same as GEANT. -% See http://wwwcn.cern.ch/asdoc/geant/H2GEANTCONS300.html -% for more details. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% Unknown = 0, -% Gamma = 1, -% Positron = 2, -% Electron = 3, -% Neutrino = 4, -% MuonPlus = 5, -% MuonMinus = 6, -% Pi0 = 7, -% PiPlus = 8, -% PiMinus = 9, -% KLong = 10, -% KPlus = 11, -% KMinus = 12, -% Neutron = 13, -% Proton = 14, -% AntiProton = 15, -% KShort = 16, -% Eta = 17, -% Lambda = 18, -% SigmaPlus = 19, -% Sigma0 = 20, -% SigmaMinus = 21, -% Xi0 = 22, -% XiMinus = 23, -% OmegaMinus = 24, -% AntiNeutron = 25, -% AntiLambda = 26, -% AntiSigmaMinus = 27, -% AntiSigma0 = 28, -% AntiSigmaPlus = 29, -% AntiXi0 = 30, -% AntiXiPlus = 31, -% AntiOmegaPlus = 32, -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%%%% extra constants not defined by GEANT -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% Rho0 = 57, -% RhoPlus = 58, -% RhoMinus = 59, -% omega = 60, -% EtaPrime = 61, -% phiMeson = 62 -% -% - diff --git a/src/programs/Simulation/genr8/InputFiles/rhop.input b/src/programs/Simulation/genr8/InputFiles/rhop.input deleted file mode 100644 index e5df9a9cf5..0000000000 --- a/src/programs/Simulation/genr8/InputFiles/rhop.input +++ /dev/null @@ -1,43 +0,0 @@ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% genr8 input file usage: -% -% genr8 -M100 -Aoutput.ascii -n < reaction.input -% -% Example: gamma p -> n X(1600) (All decays are isotropic) -% X -> pi+ pi+ pi- -% -% hint: use "-n" flag to actually print the particle names in the -% the output for viewing/debuging, but remember not to use "-n" -% for data that is used as input to HDFast. -% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -% -% -% Any number of blank spaces ( NO TABS!!!) -% can be used between input values in an input line. -% -%%%%%%%%%%%%%%%%% Start Input Values %%%%%%%%%% -% beamp.x beamp.y beamp.z beamMass - 0 0 beamZ 0 -% targetp.x targetp.y targetp.z targetMass - 0 0 0 0.938 -% t-channelSlope - 5.0 -% number of particles needed to describe the isobar decay of X -8 -% Create the particle list -% particle# 0 & 1 are always the Y (baryon system) & X (meson system) respectively -% -% part# chld1# chld2# parent# Id nchild mass width charge flag -% baryon (Y) decay - 0 * * * 14 0 0.938 0.0 +1 11 -% meson (X) decay - 1 2 3 * 0 2 Xmass Xwidth 0 00 - 2 4 5 1 0 2 1.270 0.10 -1 00 - 3 * * 1 11 0 0.494 0 +1 11 - 4 * * 2 12 0 0.494 0 -1 11 - 5 6 7 2 57 2 0.770 0.15 0 00 - 6 * * 5 9 0 0.140 0 -1 11 - 7 * * 5 8 0 0.140 0 +1 11 -!EOI -%%%%%%%%%%%%%%%%% End Input Values %%%%%%%%%% diff --git a/src/programs/Simulation/genr8/Makefile b/src/programs/Simulation/genr8/Makefile deleted file mode 100644 index bb4d883598..0000000000 --- a/src/programs/Simulation/genr8/Makefile +++ /dev/null @@ -1,6 +0,0 @@ - -ADDITIONAL_MODULES = HDDM - - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/genr8/Makefile.orig b/src/programs/Simulation/genr8/Makefile.orig deleted file mode 100644 index fde0068e3a..0000000000 --- a/src/programs/Simulation/genr8/Makefile.orig +++ /dev/null @@ -1,33 +0,0 @@ -#! gnumake - -#--------------------------------------------------- -# The stripped down genr8 Makefile -#--------------------------------------------------- -# - -CFLAGS = -D_FILE_OFFSET_BITS=64 - -INCLUDE := -I. -I$(HALLD_HOME)/src/include -I$(HALLD_HOME)/src/libraries/include -CC = cc - -ifndef UNAME -UNAME = $(shell uname) -endif - -PROGRAM= genr8 - -genr8: genr8.o genkin.o - $(CC) $(CFLAGS) -o $@ $^ -lm - -genr8.o: genr8.c - $(CC) $(CFLAGS) -c -o genr8.o genr8.c $(INCLUDE) - -genkin.o: genkin.c - $(CC) $(CFLAGS) -c -o genkin.o genkin.c $(INCLUDE) - -clean: - @rm *.o - -install: genr8 - mv genr8 $(HALLD_HOME)/bin/$(UNAME) - diff --git a/src/programs/Simulation/genr8/SConscript b/src/programs/Simulation/genr8/SConscript deleted file mode 100644 index 29248d110a..0000000000 --- a/src/programs/Simulation/genr8/SConscript +++ /dev/null @@ -1,13 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -env.AppendUnique(LIBS='m') - -sbms.executable(env) - - diff --git a/src/programs/Simulation/genr8/genkin.c b/src/programs/Simulation/genr8/genkin.c deleted file mode 100644 index 0c7ddf58ac..0000000000 --- a/src/programs/Simulation/genr8/genkin.c +++ /dev/null @@ -1,339 +0,0 @@ - - /********************* - * - * kinematics.c - * - ********************** - * - * */ - -#include -#include -#include -#include -#include -#include -#include -#include - -#include - -/* -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -*/ - -#define RESTFRAME -1 -#define PARENTFRAME +1 - -double SQ(double x){ - double z; - - z = (x)*(x); - return (z); -} - -/************** - * DotProduct.c - ************** - */ -double DotProduct3(const vector3_t *p1, const vector3_t *p2) -{ - return(p1->x * p2->x + p1->y * p2->y + p1->z * p2->z); -} - -/**************** - * CrossProduct.c - **************** - */ -vector3_t CrossProduct3(const vector3_t *p1,const vector3_t *p2) -{ - vector3_t c; - - c.x = p1->y*p2->z - p1->z*p2->y; - c.y = -(p1->x*p2->z - p1->z*p2->x); - c.z = p1->x*p2->y - p1->y*p2->x; - - return c; -} - - -/******************* - * get_beta() - * - *******************/ -vector4_t get_beta(vector4_t *boost,int sign){ - - /* find beta 4vector where beta->t = gamma - * - */ - vector4_t beta; - - - beta.space.x = sign*(boost->space.x / boost->t); - beta.space.y = sign*(boost->space.y / boost->t); - beta.space.z = sign*(boost->space.z / boost->t); - /* gamma = E/m */ - - beta.t = (boost->t) / sqrt( (boost->t) * (boost->t) - - ( (boost->space.x) * (boost->space.x) + - (boost->space.y) * (boost->space.y) + - (boost->space.z) * (boost->space.z) )); - return beta; -} - -/*********** - * lorentz.c - *********** - */ - -vector4_t lorentz(const vector4_t *beta,const vector4_t *pin) -{ - vector4_t ret; - double d,c,c2; - d = DotProduct3(&(beta->space),&(pin->space)); - c = beta->t/(beta->t + 1.0); - c2 = c * d + pin->t; - ret.space.x = pin->space.x + beta->space.x * beta->t * c2; - ret.space.y = pin->space.y + beta->space.y * beta->t * c2; - ret.space.z = pin->space.z + beta->space.z * beta->t * c2; - ret.t = beta->t * (pin->t + d); - return(ret); -} -/************** - * CMmomentum.c - **************/ - -double CMmomentum(double cm_engy, double m1, double m2) -{ - double A,B,C,D,E; - - A = cm_engy*cm_engy; - B = (m1 + m2)*(m1 + m2); - C = (m1 - m2)*(m1-m2); - D = (A - B) * (A - C); - E = sqrt (D) / (2.0 * cm_engy); - return (E); - -} -/*********** - * energy.c - **********/ - -double energy(double mass, const vector3_t *p) -{ - double E,pmagsq; - pmagsq = SQ(p->x)+SQ(p->y)+SQ(p->z); - E = sqrt( mass*mass + pmagsq); - return(E); -} - - -/******** - * v3mag.c - ********/ - -double v3mag(const vector3_t *p) -{ - double mag; - mag = sqrt( (p->x)*(p->x) + - (p->y)*(p->y)+ - (p->z)*(p->z) ); - return(mag); -} - -/* - *********************** - * * - * Sum4vec() * - * * - *********************** - */ - - -vector4_t Sum4vec(vector4_t *vec4, int nvec4) -{ - int i; - vector4_t temp4; - - temp4.space.x=0; - temp4.space.y=0; - temp4.space.z=0; - temp4.t=0; - - for(i=0;ispace.x; - temp4.space.y += (vec4 +i)->space.y; - temp4.space.z += (vec4 +i)->space.z; - temp4.t += (vec4 +i)->t; - } - return temp4; -} - -/************************ - * - * eff_mass() - * - ************************/ -double eff_mass(vector4_t *v, int nparticles) -{ - int i; - double mass=-1; /* set to -1 for debugging */ - vector4_t vsum; - - /* - * initilize vsum to zero - */ - - vsum.t=0; vsum.space.x =0;vsum.space.y =0;vsum.space.z =0; - - /* - *Sum the nparticles four vectors - */ - for(i=0;ispace), &((vecp+1)->space)); - - *lambda = DotProduct3(&analyzer,&analyzer) / - ( (3.0/4.0)* SQ( SQ(eff_mass(vec,nvec))/9.0 - SQ(PIMASS))); - } /* end of else */ - return 1; -} -/* - *********************** - * * - * helicityAngles() * - * * - *********************** - */ - -int helicityAngles(vector4_t *vec,int nvec, - double *theta, double *phi) -{ - - int i; - vector3_t z,xhel,yhel,zhel,analyzer; - vector4_t vecp[3],beta,parent; - - /* define parent - */ - parent = Sum4vec(vec,nvec); - - /* define lab frame */ -// x.x=1; x.y=0; x.z=0; -// y.x=0; y.y=1; y.z=0; - z.x=0; z.y=0; z.z=1; - - /* define helicity frame */ - zhel = parent.space; - yhel = CrossProduct3(&z, &(parent.space)); - xhel = CrossProduct3(&yhel, &zhel);/* right handed */ - - /* Note that the helicity frame is invariant to the boost - * since zhel is along and yhel is normal to the boost. - */ - - /* - * Boost to the parent restframe - */ - - beta = get_beta(&parent,RESTFRAME); - for(i=0;ispace; /* 3momentum of the 1st particle */ - break; - case 3: - /* use the normal to the decay plane */ - analyzer = CrossProduct3(&(vecp->space), &((vecp+1)->space)); - break; - default: - fprintf(stderr,"Error(helicityAngles()):: to many decay particles\n"); - exit(-1); - } - - - - *theta = acos(DotProduct3(&analyzer,&zhel)/ - (v3mag(&analyzer) *v3mag(&zhel))); - *phi = atan2(DotProduct3(&analyzer,&yhel), - DotProduct3(&analyzer,&xhel)); - - return 1; - -} - - - -/* - *********************** - * * - * END OF FILE * - * * - *********************** - */ - - diff --git a/src/programs/Simulation/genr8/genkin.h b/src/programs/Simulation/genr8/genkin.h deleted file mode 100644 index fb95bd592e..0000000000 --- a/src/programs/Simulation/genr8/genkin.h +++ /dev/null @@ -1,93 +0,0 @@ -/* -* -* kinematics.h -* -*/ - -#ifndef kinematicsH -#define kinematicsH - - -/* type declarations */ - -typedef struct { float x,y,z; } vector3_t; -typedef struct { float t; vector3_t space; } vector4_t; -typedef struct { float rho,phi,z; } vector3cyl_t; - -typedef struct { vector3_t e,b; } fields_t; - -/* 3-vector routines */ -float vec3mag(vector3_t*); -float vec3magsq(vector3_t*); -float vec3dot(vector3_t*,vector3_t*); -vector3_t *vec3cross(vector3_t*,vector3_t*); -vector3_t *vec3norm(vector3_t*); -void vec3dir(vector3_t*,float*,float*); -void vec3dir_deg(vector3_t*,float*,float*); -float vec3cos_angle(vector3_t*,vector3_t*); -float vec3angle(vector3_t*,vector3_t*); -float vec3angle_deg(vector3_t*,vector3_t*); -vector3_t *vec3sum(int,vector3_t*[]); -vector3_t *vec3add(vector3_t*,vector3_t*); -vector3_t *vec3sub(int,vector3_t*[]); -vector3_t *vec3diff(vector3_t*,vector3_t*); -vector3_t *vec3mult(float,vector3_t*); -vector3_t *vec3div(float,vector3_t*); -vector3_t *vec3make(float,float,float); -vector3_t *vec3rotate(vector3_t*,float,int); - -/* 4-vector routines */ -float vec4dot(vector4_t*,vector4_t*); -float vec4mag(vector4_t*); -float vec4magsq(vector4_t*); -vector4_t *vec4sum(int,vector4_t*[]); -vector4_t *vec4add(vector4_t*,vector4_t*); -vector4_t *vec4sub(int,vector4_t*[]); -vector4_t *vec4diff(vector4_t*,vector4_t*); -vector4_t *vec4mult(float,vector4_t*); -vector4_t *vec4div(float,vector4_t*); -float effmass(int,vector4_t*[]); -void pairmass(int,vector4_t*[],float[]); -float mandel_s(int,vector4_t*[]); -float mandel_t(vector4_t*,vector4_t*); -float mandel_q(vector4_t*,vector4_t*); -vector4_t *vec4make(vector3_t*,float); - -/* lorentz routines */ -float beta2gamma(float); -float gamma2beta(float); -float p2gamma(vector4_t*); -float p2beta(vector4_t*); -vector4_t *vec4boost(vector3_t*,vector4_t*); -fields_t *fieldboost(vector3_t*,fields_t*); - -/* gottfried-jackson routines */ -float costheta_gj(vector4_t* v4ptr[]); -float costheta_gj_A(vector4_t v4[]); -float phi_ty(vector4_t*[]); -float phi_ty_deg(vector4_t*[]); -float phi_ty_A(vector4_t[]); -float phi_ty_deg_A(vector4_t[]); -void gottJackGuardFlag(int flag); - -/* constants */ -#ifndef PI -#define PI 3.1415927 -#endif - -#define PIMASS 139.6 - -/* kinematic routines */ -double SQ(double x); -double v3mag(const vector3_t *p); -double eff_mass(vector4_t *v, int nparticles); -int helicityAngles(vector4_t *vec,int nvec, - double *theta, double *phi); -int lambda3pi(vector4_t *vec,int nvec, double *lam); -vector4_t get_beta(vector4_t *boost,int sign); -vector4_t Sum4vec(vector4_t *vec4, int nvec4); -vector4_t lorentz(const vector4_t *beta,const vector4_t *pin); -double CMmomentum(double cm_engy, double m1, double m2); -double energy(double mass, const vector3_t *p); -#endif -/* end file */ diff --git a/src/programs/Simulation/genr8/genr8.c b/src/programs/Simulation/genr8/genr8.c deleted file mode 100644 index 5c21d74b0a..0000000000 --- a/src/programs/Simulation/genr8/genr8.c +++ /dev/null @@ -1,1316 +0,0 @@ - /******************************************************** - * - * Usage: genr8 < input.gen - * Use "genr8 -h" for help with options. - ******************************************************** - * * Generate t-channel - * genr8.c * monte carlo events. - * * - ******************************************************** - * - * created by: Paul M Eugenio - * Carnegie Mellon University - * 25-Mar-98 - * - * minor modifications to avoid infinite loop in n_omega_pi0_pi+ generator - * garth huber, 04.04.21 - ******************************************************** */ - -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#include -#include - -#define TRUE 1 -#define FALSE 0 -#define CONV (180.0/M_PI) -#define BUFSIZE 100000 -#define T_CUT 10.0 -#define RECOIL 0.938 - -#define RESTFRAME -1 -#define PARENTFRAME +1 - -#define PRODUCTION_PARTICLE 1 - - - - -/***********************/ -/* STRUCTURES */ -/***********************/ - - - -struct particleMC_t{ - int flag; - int nchildren; - int charge; - double mass; - double bookmass; - double width; - Particle_t particleID; - vector4_t p; - struct particleMC_t *parent, *child[2]; -} ; - - -/****************************************************************** - * GLOBAL VARIABLES - * NOTE: Please start the global name - * with one capital letter!!!!!! - * Use all lower case for local - * variable names. Thank You 8^) - **********************************************************************/ - -int Debug = 0; -int Nprinted =0; -int PrintProduction=0; -int PrintRecoil=0; -double MassHighBW; -int UseName=0; -int FIRST_EVENT=1; -int PrintFlag=10; -int WriteAscii=0; -int runNo=9000; -int NFinalParts=0; -unsigned int RandomSeed=0; -int UseCurrentTimeForRandomSeed = TRUE; -/***********************/ -/* Declarations */ -/***********************/ -/* - * These functions are coded after main(). - */ - - -double rawthresh(struct particleMC_t *Isobar); -void decay(struct particleMC_t *Isobar); -void boost2lab(struct particleMC_t *Isobar); -void boostFamily(vector4_t *beta,struct particleMC_t *Isobar); -void boost(vector4_t *beta,vector4_t *vec); -void printParticle(struct particleMC_t *Isobar); -vector4_t polarMake4v(double p, double theta, double phi, double mass); -double randm(double low, double high); -void printProduction(FILE *fp,struct particleMC_t *Isobar); -void printFinal(FILE *fp,struct particleMC_t *Isobar); -void printp2ascii(FILE *fp,struct particleMC_t *Isobar); -void setMass(struct particleMC_t *Isobar); -void initMass(struct particleMC_t *Isobar); -char *ParticleType(Particle_t p); -void checkFamily(struct particleMC_t *Isobar); -int setChildrenMass(struct particleMC_t *Isobar); -void printFamily(struct particleMC_t *Isobar); -void lorentzFactor(double *lf,struct particleMC_t *Isobar); - -/* - *********************** - * * - * PrintUsage() * - * * - *********************** - */ - -void PrintUsage(char *processName) -{ - - fprintf(stderr,"%s usage: [-A] < infile \n",processName); - fprintf(stderr,"\t-d debug flag\n"); - fprintf(stderr,"\t-n Use a particle name and not its ID number (ascii only) \n"); - fprintf(stderr,"\t-M Process first max events\n"); - fprintf(stderr,"\t-l Determine the lorentz factor with this many number of events (default is 10000)\n"); - fprintf(stderr,"\t-r default runNo is 9000. \n"); - /*fprintf(stderr,"\t-o The output file \n");*/ - fprintf(stderr,"\t-P save flag= 11 & 01 events(default saves 11 & 10 events) \n"); - /* fprintf(stderr,"\t-R Save recoiling baryon information. \n"); */ - - fprintf(stderr,"\t-A Save in ascii format. \n"); - fprintf(stderr,"\t-s Set random number seed to . \n"); - fprintf(stderr,"\t (default is to set using current time + pid) \n"); - fprintf(stderr,"\t-h Print this help message\n\n"); - -} - - -/* - *********************** - * * - * Main() * - * * - *********************** - */ - -int main(int argc,char **argv) -{ - char *argptr,*token,line[2056]; - int i,npart=0,ngenerated=0,naccepted=0, imassc, imassc2; - int nv4,max=10,part=0,chld1=-1,chld2=-1,prnt=-1,lfevents=10000; - FILE *fout=stdout; - struct particleMC_t particle[20],beam,target,CM; - //struct particleMC_t recoil; - struct particleMC_t *X,*Y; - vector4_t beta,v4[2]; - // vector4_t initBeam4; - double t,expt_max,expt,expt_min,sqrt_s,t_min=0; - double CMenergy, t_max,slope=5.0; - double X_momentum, X_energy,xmass,ymass; - // double X_threshold ; - double costheta,theta,phi,lf,lfmax=0; - int isacomment=TRUE,haveChildren=TRUE; - - Y= &(particle[0]); - Y->parent = &CM; - Y->nchildren = 0; - Y->bookmass = 0; - X= &(particle[1]); - X->parent = &CM; - X->nchildren = 0; - X->bookmass = 0; - // recoil.parent = &CM; - CM.child[0]= X; - CM.child[1]= Y; - /* CM.child[1]= &recoil; */ - - if (argc == 1){ - PrintUsage(argv[0]); - exit (0); - } - else { - - /* - * Read command line options. - */ - - for (i=1; i 1)) { - argptr++; - switch (*argptr) { - case 'd': - Debug =1; - break; - case 'h': - PrintUsage(argv[0]); - exit(0); - break; - case 'n': - UseName =1; - break; - case 'A': - WriteAscii=1; - fout = fopen(++argptr,"w"); - fprintf(stderr,"Opening file %s for output. \n",argptr); - break; - case 'R': - fprintf(stderr,"Printing recoil information.\n"); - PrintRecoil=1; - break; - case 'P': - fprintf(stderr,"Printing eta and pizeros and not gammas.\n"); - PrintProduction=1; - break; - case 'l': - lfevents = atoi(++argptr); - fprintf(stderr,"Using %d events to determine the lorentz factor\n",lfevents); - break; - case 'M': - max = atoi(++argptr); - fprintf(stderr,"Maximum number of events: %d\n",max); - break; - case 'r': - runNo = atoi(++argptr); - fprintf(stderr,"Using runNo: %d\n",runNo); - break; - case 's': - RandomSeed = atoi(++argptr); - UseCurrentTimeForRandomSeed = FALSE; - break; - default: - fprintf(stderr,"Unrecognized argument -%s\n\n",argptr); - PrintUsage(argv[0]); - exit(-1); - break; - - } - } - } - } - - /* - * Seed the random number generator. - */ - if(UseCurrentTimeForRandomSeed){ - RandomSeed=time(NULL); - RandomSeed += getpid(); - } - printf("Setting random number seed to: %d\n",RandomSeed); - srand48(RandomSeed); - - /* - * Now read the input.gen file - * from the stdin. - * - * - * Any line starting with a "%" - * is a comment line and is ignored. - * - * - */ - - -/* Fill particle information */ - - isacomment=TRUE; - while(isacomment==TRUE){ - char *pline; - pline = fgets(line,sizeof(line),stdin); - if (pline!=NULL){ - token=strtok(line," "); - if(!(*token == '%')) - isacomment=FALSE; - } - } /* get beam information */ - beam.p.space.x = atof(token); - token=strtok(NULL," "); - beam.p.space.y = atof(token); - token=strtok(NULL," "); - beam.p.space.z = atof(token); - token=strtok(NULL," "); - beam.mass = atof(token); - fprintf(stderr,"Reading: \tbeamp.x \tbeamp.y \tbeamp.z \tbeamMass\n"); - fprintf(stderr,"Found: \t\t%lf \t%lf \t%lf \t%lf \n", - beam.p.space.x, beam.p.space.y, beam.p.space.z, beam.mass); - - - isacomment=TRUE; - while(isacomment==TRUE){ - char *pline; - pline = fgets(line,sizeof(line),stdin); - if (pline!=NULL){ - token=strtok(line," "); - if(!(*token == '%')) - isacomment=FALSE; - } - } /* get target information */ - target.p.space.x = atof(token); - token=strtok(NULL," "); - target.p.space.y = atof(token); - token=strtok(NULL," "); - target.p.space.z = atof(token); - token=strtok(NULL," "); - target.mass = atof(token); - fprintf(stderr,"Reading: \ttargetp.x \ttargetp.y \ttargetp.z \ttargetMass\n"); - fprintf(stderr,"Found: \t\t%lf \t%lf \t%lf \t%lf \n", - target.p.space.x, target.p.space.y, target.p.space.z, target.mass); - - - isacomment=TRUE; - while(isacomment==TRUE){ - char *pline; - pline = fgets(line,sizeof(line),stdin); - if (pline!=NULL){ - token=strtok(line," "); - if(!(*token == '%')) - isacomment=FALSE; - } - } - /* get the t-channel slope */ - slope=atof(token); - fprintf(stderr,"Reading: t-channelSlope\n"); - fprintf(stderr,"Found: \t%lf \n",slope); - - isacomment=TRUE; - while(isacomment==TRUE){ - char *pline; - pline = fgets(line,sizeof(line),stdin); - if (pline!=NULL){ - token=strtok(line," "); - if(!(*token == '%')) - isacomment=FALSE; - } - } /* get the number of particles to read in below */ - npart = atoi(token); - fprintf(stderr,"Reading: number of particles need to describe the decay\n"); - fprintf(stderr,"Found: \t%d \n",npart); - - /* - * read all particles needed - * to decsribe an isobar decay - * of the resonance (X) - */ - - fprintf(stderr,"Reading: \tpart# \tchld1# \tchld2# \tprnt# \tId \tnchld \tmass \t\twidth \t\tchrg \tflag \n"); - - for(i=0;i0 ){ - fprintf(stderr, - "If a particle has children then it must point to them!\n"); - exit(-1); - } - } - token=strtok(NULL," "); - if(!(*token == '*')) - particle[part].bookmass = atof(token); - else{ /* get a list of the particle that need a mass generated */ - fprintf(stderr,"Every Particle needs a mass\n"); - exit(-1); - } - token=strtok(NULL," "); - if(!(*token == '*')){ - particle[part].width = atof(token); - - } - else {/* for a fixed mass use a zero width */ - fprintf(stderr,"Every Particle needs a width\n"); - exit(-1); - } - token=strtok(NULL," "); - if(!(*token == '*')) - particle[part].charge = atoi(token); - token=strtok(NULL," "); - if(!(*token == '*')){ - particle[part].flag = atoi(token); - if(PrintProduction==1){ - if(particle[part].flag==11 || particle[part].flag==01) - NFinalParts++; - }else{ - if(particle[part].flag==11 || particle[part].flag==10) - NFinalParts++; - } - } - /* flag 00 = isobar or resonace - * flag 01 = production particle that decays i.e. eta, pizero .. - * flag 11 = production particle that does not decay i.e. piplus,... - * flag 10 = final state particle not in production i.e. gamma - */ - fprintf(stderr, - "Found: \t\t%d \t%d \t%d \t%d \t%d \t%d \t%lf \t%lf \t%d \t%d\n", - part,chld1,chld2,prnt,particle[part].particleID,particle[part].nchildren,particle[part].bookmass,particle[part].width,particle[part].charge,particle[part].flag); - } - isacomment=TRUE; - while(isacomment==TRUE){ - char *pline; - pline = fgets(line,sizeof(line),stdin); - if (pline!=NULL){ - token=strtok(line," "); - if(!(*token == '%')) - isacomment=FALSE; - } - } - if(!(*token == '!')){ - fprintf(stderr,"Failed to find EOI---- Check Input File\n"); - exit(-1); - } - - checkFamily(X); - fprintf(stderr,"Found EOI---- Input File appears Fine.\n"); - - /* We are now done reading the input information */ - - /* - * The beam and target are in the lab frame. - * Put them in the overall center of momentum (CM) frame - * and calculate |t| & recoil angles. - */ - - if(X->nchildren == 0) X->mass = X->bookmass; - if(Y->nchildren == 0) Y->mass = Y->bookmass; - - target.p.t = energy(target.mass,&(target.p.space)); - beam.p.t = energy(beam.mass,&(beam.p.space)); - //initBeam4.t= beam.p.t; initBeam4.space.x= beam.p.space.x; - //initBeam4.space.y= beam.p.space.y; initBeam4.space.z= beam.p.space.z; - sqrt_s = sqrt( SQ(beam.mass) +SQ(target.mass) + 2.0*beam.p.t * target.p.t); - /*MassHighBW = sqrt_s - recoil.mass; */ - MassHighBW = sqrt_s; /* see do loop below */ - - v4[0]= beam.p; - v4[1]= target.p; - nv4=2; - - CM.mass = sqrt_s; - CM.p = Sum4vec(v4,nv4); - beta = get_beta(&(CM.p),RESTFRAME); - boost(&beta,&(beam.p)); - boost(&beta,&(target.p)); - - initMass(X); - initMass(Y); - CMenergy = beam.p.t + target.p.t; - - while(naccepted width<0)) - do{/*use BreitWigner--phasespace distribution */ - initMass(X); - setMass(X); - - /* - * set the children mass to the book mass or - * distribute the by a Breit-Wigner. If the isobar - * mass is unknown it's mass remains unknow at this time. - */ - - if(Debug) fprintf(stderr,"looping over nchildren = %d \n",X->nchildren); - for(i=0;inchildren;i++) - { - if(Debug) fprintf(stderr,"calling setChildrenMass X... %d \n",i); -l1: imassc=setChildrenMass(X->child[i]); - if (Debug) fprintf(stderr,"Return from setChildrenMass X... %d %d \n",i,imassc); - - /* if the daughters of child[i] are more massive than child[i], generate masses */ - if (imassc!=0) { - if (Debug) fprintf(stderr,"Need new masses for X %d %d %f \n",i,imassc,(X->child[i])->mass); - imassc2=imassc2+1; - if (imassc2<1000) - goto l1; - else - goto l0; - } - } - }while((X->mass > MassHighBW) || ( X->nchildren==0 ? FALSE : - (X->mass < ( (X->child[0])->mass + (X->child[1])->mass))) ); - - else{/* there's an error.. */ - fprintf(stderr,"Cannot use a negative width!\n"); - exit(-1); - } - /* - * Now do loop it for Y - */ - if(!(Y->width<0)) - do{/*use BreitWigner--phasespace distribution */ - initMass(Y); - setMass(Y); - - /* - * set the children mass to the book mass or - * distribute the by a Breit-Wigner. If the isobar - * mass is unknown it's mass remains unknown at this time. - */ - - for(i=0;inchildren;i++) - { - if (Debug) fprintf(stderr,"calling setChildrenMass Y... %d \n",i); -l2: imassc=setChildrenMass(Y->child[i]); - if (Debug) fprintf(stderr,"Return from setChildrenMass Y... %d %d \n",i,imassc); - - /* if the daughters of child[i] are more massive than child[i], generate masses */ - if (imassc!=0) { - if (Debug) fprintf(stderr,"Need new masses for Y %d %d %f \n",i,imassc,(Y->child[i])->mass); - goto l2; } - } - }while((Y->mass > MassHighBW) || ( Y->nchildren==0 ? FALSE : - (Y->mass < ( (Y->child[0])->mass + (Y->child[1])->mass)) ) ); - else{/* there's an error.. */ - fprintf(stderr,"Cannot use a negative width!\n"); - exit(-1); - } - }while(sqrt_s < X->mass + Y->mass); - /* - xmass=rawthresh(X); - ymass=rawthresh(Y); - * - * fprintf(stderr," xmass= %lf ymass= %lf X->mass= %lf Y->mass= %lf\n", - * xmass,ymass, X->mass , Y->mass); - */ - xmass = X->mass; - ymass = Y->mass; - - //X_threshold = 0; - X_momentum = CMmomentum( CMenergy, X->mass, Y->mass); - X_energy = sqrt( (X->mass)*(X->mass) + X_momentum*X_momentum); - - if(Y->nchildren ==0){ - - t_min = -( SQ( (SQ(beam.mass) -SQ(xmass) -SQ(target.mass) +SQ(ymass))/(2.0*sqrt_s)) - -SQ(v3mag(&(beam.p.space)) - X_momentum )); - t_max = -( SQ( (SQ(beam.mass) -SQ(xmass) -SQ(target.mass) +SQ(ymass))/(2.0*sqrt_s)) - -SQ(v3mag(&(beam.p.space)) + X_momentum )); - /* - *fprintf(stderr, - "beam.mass= %lf xmass= %lf target.mass=%lf ymass= %lf sqrt_s= %lf beam.p= %lf X->p= %lf X_momentum= %lf\n", - beam.mass,xmass,target.mass,ymass,sqrt_s, - v3mag(&(beam.p.space)),v3mag(&(X->p.space)), X_momentum); - */ - - /*fprintf(stderr,"t_min: %lf t_max: %lf\n", t_min,t_max); - */ - } else{ /* it's some baryon pseudo t process */ - - t_min = -( SQ( (SQ(beam.mass) -SQ(xmass) -SQ(target.mass) +SQ(ymass))/(2.0*sqrt_s)) - -SQ(v3mag(&(beam.p.space)) - X_momentum )); - t_max = -( SQ( (SQ(beam.mass) -SQ(xmass) -SQ(target.mass) +SQ(ymass))/(2.0*sqrt_s)) - -SQ(v3mag(&(beam.p.space)) + X_momentum )); - - } - expt_max = exp(-slope * t_max); - expt_min = exp(-slope * t_min); - - do{ - - expt = randm(expt_max,expt_min); - - t= -log(expt)/slope; - costheta = ( beam.p.t * X_energy - - 0.5*(t + (beam.mass)*(beam.mass) + (X->mass)*(X->mass)) - )/( v3mag(&(beam.p.space))*X_momentum ) ; - - }while(fabs(costheta)>1.0 ); - - theta = acos(costheta); - phi = randm(-1*M_PI,M_PI); - - X->p = polarMake4v(X_momentum,theta,phi,X->mass); - Y->p=polarMake4v(X_momentum,(M_PI-theta),(M_PI+phi),Y->mass); - - /* - * Now decay X -> children -> grandchildren -> and so forth - * - * Note: all particles are generated in their parent's rest frame. - */ - - /* - if(Debug) - fprintf(stderr,"before decay\n"); - if(Debug) - printFamily(X); - */ - - decay(X); - decay(Y); - if(Debug) { - fprintf(stderr,"X after decay\n"); - printFamily(X); - fprintf(stderr,"Y after decay\n"); - printFamily(Y); - } - - - /* - * Compute Lorentz Factor (used for phasespace weighting) - */ - lf=v3mag(&(X->p.space)); - lorentzFactor(&lf,X); - lorentzFactor(&lf,Y); - if (Debug) fprintf(stderr,"lorentz factor information: %f ... %f ... \n",lf,lfmax); - if(lfevents-->0){ - lfmax = lf >lfmax ? lf : lfmax; /* find the largest value */ - if( (lfevents % 10) == 0 ) { - if ( lfevents <= 100 || (lfevents % 1000) == 0 ) - fprintf(stderr,"Calculating Lorentz Factor: %d \r",lfevents); - } - } - else{ - - if (Debug) fprintf(stderr," inside loop: lorentz factor information: %f ... %f ... \n",lf,lfmax); - /* - * Now generate the events weighted by phasespace - * (the maximum Lorentz factor). - * - * Since each particle is in its parent's rest frame, - * it must be boosted through each parent's -> parent's-> ... - * rest frame to the lab frame. - */ - /* - fprintf(stderr,"expt_min: %lf \t expt_max: %lf\n",expt_min,expt_max); - fprintf(stderr,"t_min: %lf \t t: %lf \t t_max: %lf\n",t_min,t,t_max); - */ - ngenerated++; - /* fprintf(stderr,"ngen: %d \tlf: %lf \tlfmax: %lf\n",ngenerated,lf,lfmax);*/ - if(lf > randm(0.0,lfmax) ){ /* phasespace distribution */ - - naccepted++; - boost2lab(X); - boost2lab(Y); - /*initBeam4; use lab frame beam */ - /* - * We have a complete event. Now save it! - */ - - if(Debug) { - fprintf(stderr,"X after boost2lab\n"); - printFamily(X); - fprintf(stderr,"Y after boost2lab\n"); - printFamily(Y); - } - - Nprinted =0; - /* event header information - fprintf(fout,"RunNo %d EventNo %d\n",runNo,naccepted);*/ - fprintf(fout,"%d %d %d\n",runNo,naccepted, NFinalParts); - - /* - * Print out the production - * or the final state particles. - * - if(WriteEsr) - WriteItape(&CM,&initBeam4); - * Remove old BNL-E852 dependence - */ - - if(PrintProduction){ - if(X->nchildren==0) - printp2ascii(fout,X); - else - printProduction(fout,X); - if(Y->nchildren==0) - printp2ascii(fout,Y); - else - printProduction(fout,Y); - } - else{ - if(X->nchildren==0) - printp2ascii(fout,X); - else - printFinal(fout,X); - if(Y->nchildren==0 && Y->flag/10 == 1 ) - printp2ascii(fout,Y); - else - printFinal(fout,Y); - } - - - } - if(!(ngenerated % 100)) { - if( ngenerated <= 1000 || !(ngenerated % 10000)) - fprintf(stderr,"Events generated: %d Events accepted: %d \r", - ngenerated,naccepted); - } - if(Debug) fprintf(stderr,"End of event\n"); - } /* end of else{ */ - }/* end of while */ - - fprintf(stderr, - "Max Lorentz Factor:%lf Events generated:%d Events accepted:%d\n\n", - lfmax,ngenerated,naccepted); - /* - * Close the output file. - */ - fflush(fout); - fclose(fout); - - return 0; -}/* end of main */ - - -/******************** - * - * checkFamily() - * Testing the input file. - * - * If I have children - * then I should be - * my children's - * parent. - *******************/ -void checkFamily(struct particleMC_t *Isobar) -{ - int i; - - for(i=0;inchildren; i++){ - if(Isobar->nchildren != 2){ - fprintf(stderr,"Error in input file: Sorry, only 0 or 2 children are allowed.\n"); - exit(-1); - } - if(Isobar != Isobar->child[i]->parent){ - fprintf(stderr,"Error in input file: Parent to children mismatch\n"); - exit(-1); - } - checkFamily(Isobar->child[i]); - } - -} - - - -/******************** - * - * setChildrenMass() - * - * Sets all children masses - * to bookmass or to a - * Breit-Wigner mass - *********************/ - -int setChildrenMass(struct particleMC_t *Isobar) -{ - int i, imassc=0; - -/* fprintf(stderr,"In setChildrenMass ... %f \n",Isobar->mass); -*/ - - initMass(Isobar); - setMass(Isobar); - for(i=0;i < Isobar->nchildren;i++){ - if (Debug) fprintf(stderr,"In loop ... %d %d %f \n",i,Isobar->nchildren,(Isobar->child[i])->mass); - - /* Generate masses of all of the daughters */ -l3: imassc=setChildrenMass(Isobar->child[i]); - - if (imassc!=0) { - if (Debug) fprintf(stderr,"Need new masses for Isobar %d %d %f \n",i,imassc,(Isobar->child[i])->mass); - goto l3; } - } - - if(Isobar->nchildren !=0) - { - if((Isobar->mass) < ((Isobar->child[0])->mass)+((Isobar->child[1])->mass)) - { - - /* If the daughters are more massive than the parent, set the return code and exit */ - if (Debug) fprintf(stderr,"final call ... \n"); - - /* setChildrenMass(Isobar); */ - imassc=imassc+1; - if (Debug) fprintf(stderr," %f %f %f \n",Isobar->mass,(Isobar->child[0])->mass,(Isobar->child[1])->mass); - } else {imassc=0;} - } - - if (Debug) fprintf(stderr,"Leaving setChildrenMass ... %f %d \n",Isobar->mass,imassc); - - return imassc; -} - - - - -/******************** - * - * setMass() - * - * Sets the particle mass - * using a - * Breit-Wigner distribution. - *********************/ - -void setMass(struct particleMC_t *Isobar) -{ - double n,height,thresH2,lowtail,hightail,hcut,lcut; - - if(Isobar->width > 0){ - - lowtail = rawthresh(Isobar); - - - - thresH2 = - Isobar == (Isobar->parent)->child[0] ? /* is the 1st child me? */ - rawthresh((Isobar->parent)->child[1]) : /* if true */ - rawthresh((Isobar->parent)->child[0]) ;/* if false */ - /* - hightail = ((Isobar->parent)->mass); - */ - hightail = (Isobar->parent->mass) - thresH2 ; - - - /* cut off the tails */ - hcut= Isobar->bookmass + 4.0*Isobar->width ; - lcut= Isobar->bookmass - 4.0*Isobar->width ; - - if(hightail> hcut) - hightail=hcut; - if(lowtail < lcut) - lowtail= lcut; - - - do{ - n=randm(0.0,0.9999); - Isobar->mass = randm( lowtail , hightail); - - height= SQ((Isobar->bookmass)*(Isobar->width))/ - ( SQ(SQ(Isobar->bookmass) - SQ(Isobar->mass)) + - SQ((Isobar->bookmass) * (Isobar->width) )); - }while(n > height ); - /* - fprintf(stderr,"bookmass is %lf: low: %lf high: %lf bwmass: %lf\n", - Isobar->bookmass, lowtail,hightail,Isobar->mass); - */ - } -} -/******************** - * - * initMass() - * - * Sets the particle mass - * to bookmass or UNKNOWN - * - *********************/ - -void initMass(struct particleMC_t *Isobar) -{ - int i; - - for(i=0;inchildren;i++){ - if(Isobar->child[i]->width == 0.0) - Isobar->child[i]->mass = Isobar->child[i]->bookmass; - else - Isobar->child[i]->mass = -1.0; /* UNKNOWN */ - initMass(Isobar->child[i]); - } -} -/******************** - * - * rawthresh() - * - * Calculates the mass - * threshold for the - * isobar. - *******************/ - -double rawthresh(struct particleMC_t *Isobar) -{ - int i; - double rmassThresh=0.0; - - if(Isobar->nchildren){ - for(i=0; i < Isobar->nchildren;i++){ - if (Isobar->child[i]->mass <0)/* it is not known now */ - rmassThresh += rawthresh(Isobar->child[i]); - else /* it is known now */ - rmassThresh += Isobar->child[i]->mass; - } - }else{ - rmassThresh=Isobar->mass; - if(Isobar->mass <0){ /* error */ - fprintf(stderr,"Error!: Isobar->mass <0 for Isobar with no children\nExit\n"); - exit(-1); - } - } - return rmassThresh; -} - - -/********************************** - * - * decay(Isobar) - * - * Decay the isobar into its children - * and then repeat to decay each - * child isobar. - *************************************/ - -void decay(struct particleMC_t *Isobar) -{ - int i; - double breakup_p,theta,phi; - - - - if(Isobar->nchildren>0) - { - breakup_p = CMmomentum(Isobar->mass, - Isobar->child[0]->mass, - Isobar->child[1]->mass); - theta = acos(randm(-0.9999, 0.9999)); - phi = randm(-1*M_PI,M_PI); - Isobar->child[0]->p = - polarMake4v(breakup_p,theta,phi,Isobar->child[0]->mass); - Isobar->child[1]->p = - polarMake4v(breakup_p,(M_PI - theta),(M_PI + phi),Isobar->child[1]->mass); - for(i=0;inchildren;i++) - decay(Isobar->child[i]); - } -} - - -/******************************** - * - * lorentzFactor() - * - * Returns the multiplication of - * all of the break-up momenta. - * - *********************************/ - -void lorentzFactor(double *lf,struct particleMC_t *Isobar) -{ - int i; - - if(!(Isobar->nchildren == 0 )){ - *lf *= v3mag(&(Isobar->child[0]->p.space)); - for(i=0;inchildren;i++) - lorentzFactor(lf,Isobar->child[i]); - } - -} - - -/******************************** - * - * boost2lab() - * - * o Starting w/ final state particles - * boost to parent's frame. - * - * o Then boost parent & children to - * parent's parent's frame and repeat - * to the lab frame. - * - *********************************/ -void boost2lab(struct particleMC_t *Isobar) -{ - int i; - vector4_t beta; - - for(i=0;inchildren;i++) - - boost2lab(Isobar->child[i]); - - beta = get_beta(&(Isobar->parent->p),PARENTFRAME);/* see kinematics.c */ - boostFamily(&beta,Isobar); -} - -/******************************** - * - * boostFamily() - * - * Boost particle and all children, - * children's children, ... - * - *********************************/ -void boostFamily(vector4_t *beta,struct particleMC_t *Isobar) -{ - int j; - boost(beta,&(Isobar->p)); - for(j=0;jnchildren;j++) - boostFamily(beta, Isobar->child[j]); -} - -/******************************** - * - * boost() - * - * Boost a four vector. - * - *********************************/ -void boost(vector4_t *beta,vector4_t *vec) -{ - vector4_t temp; - - temp = lorentz(beta,vec);/* see kinematics.c */ - vec->t = temp.t; - vec->space.x = temp.space.x; - vec->space.y = temp.space.y; - vec->space.z = temp.space.z; -} - -/******************************** - * - * printProduction() - * - * Print out production particles. - *******************************/ -void printProduction(FILE *fp,struct particleMC_t *Isobar) -{ - int i; - - for(i=0;inchildren;i++){ - if((Isobar->child[i]->flag%10 ) == 1) - printp2ascii(fp,Isobar->child[i]); - printProduction(fp,Isobar->child[i]); - } -} - -/******************************** - * - * printFinal() - * - * Print out final state particles - *******************************/ -void printFinal(FILE *fp,struct particleMC_t *Isobar) -{ - int i; - - for(i=0;inchildren;i++){ - if((Isobar->child[i]->flag/10 ) == 1) - printp2ascii(fp,Isobar->child[i]); - printFinal(fp,Isobar->child[i]); - } -} - -/******************************** - * - * printp2ascii() - * - *******************************/ -void printp2ascii(FILE *fp,struct particleMC_t *Isobar) -{ - Nprinted++; - if(UseName) - fprintf(fp,"%d %s %lf\n",Nprinted,ParticleType(Isobar->particleID),Isobar->mass); - else - fprintf(fp,"%d %d %lf\n",Nprinted,Isobar->particleID,Isobar->mass); - - fprintf(fp," %d %lf %lf %lf %lf\n",Isobar->charge, - Isobar->p.space.x, - Isobar->p.space.y, - Isobar->p.space.z, - Isobar->p.t); - -} - -/******************************** - * - * printFamily() - * - *******************************/ -void printFamily(struct particleMC_t *Isobar) -{ - int j; - printParticle(Isobar); - for(j=0;jnchildren;j++) - printFamily(Isobar->child[j]); -} - - - -/******************************** - * - * printParticle() - * - *******************************/ -void printParticle(struct particleMC_t *Isobar) -{ - fprintf(stderr,"Particle ID %s with %d children\n", - ParticleType(Isobar->particleID),Isobar->nchildren); - fprintf(stderr,"four momentum (E,p): %lf %lf %lf %lf\n\n", - Isobar->p.t, - Isobar->p.space.x, - Isobar->p.space.y, - Isobar->p.space.z); -} - -/****************************************************** - * - * polarMake4v() - * - * make a four vector given (p,theta,phi) and it's mass - ********************************************************/ -vector4_t polarMake4v(double p, double theta, double phi, double mass) -{ - vector4_t temp; - - temp.t = sqrt( SQ(mass) + SQ(p)); - temp.space.z = p*cos(theta); - temp.space.x = p*sin(theta)*cos(phi); - temp.space.y = p*sin(theta)*sin(phi); - - return temp; -} - -/******************************** - * - * randm(double low, double high) - * - *******************************/ -double randm(double low, double high) -{ - /* Seed the random number generator using: - * int now = time(NULL); - * srand48(now); - */ - return ((high - low) * drand48() + low); -} - -#if 0 -char *ParticleType(Particle_t p) -{ - static char ret[20]; - switch (p) { - case Unknown: - strcpy(ret,"unknown"); - break; - case Gamma: - strcpy(ret,"gamma"); - break; - case Positron: - strcpy(ret,"positron"); - break; - case Electron: - strcpy(ret,"electron"); - break; - case Neutrino: - strcpy(ret,"neutrino"); - break; - case MuonPlus: - strcpy(ret,"mu+"); - break; - case MuonMinus: - strcpy(ret,"mu-"); - break; - case Pi0: - strcpy(ret,"pi0"); - break; - case PiPlus: - strcpy(ret,"pi+"); - break; - case PiMinus: - strcpy(ret,"pi-"); - break; - case KLong: - strcpy(ret,"KL"); - break; - case KPlus: - strcpy(ret,"K+"); - break; - case KMinus: - strcpy(ret,"K-"); - break; - case Neutron: - strcpy(ret,"neutron"); - break; - case Proton: - strcpy(ret,"proton"); - break; - case AntiProton: - strcpy(ret,"pbar"); - break; - case KShort: - strcpy(ret,"Ks"); - break; - case Eta: - strcpy(ret,"eta"); - break; - case Lambda: - strcpy(ret,"lambda"); - break; - case SigmaPlus: - strcpy(ret,"sigma+"); - break; - case Sigma0: - strcpy(ret,"sigma0"); - break; - case SigmaMinus: - strcpy(ret,"sigma-"); - break; - case Xi0: - strcpy(ret,"Xi0"); - break; - case XiMinus: - strcpy(ret,"Xi-"); - break; - case OmegaMinus: - strcpy(ret,"omega-"); - break; - case AntiNeutron: - strcpy(ret,"nbar"); - break; - - case AntiLambda: - strcpy(ret,"lambdabar"); - break; - case AntiSigmaMinus: - strcpy(ret,"sigmabar-"); - break; - case AntiSigma0: - strcpy(ret,"sigmabar0"); - break; - case AntiSigmaPlus: - strcpy(ret,"sigmabar+"); - break; - case AntiXi0: - strcpy(ret,"Xibar0"); - break; - case AntiXiPlus: - strcpy(ret,"Xibar+"); - break; - case AntiOmegaPlus: - strcpy(ret,"omegabar+"); - break; - case Rho0: - strcpy(ret,"rho0"); - break; - case RhoPlus: - strcpy(ret,"rho+"); - break; - case RhoMinus: - strcpy(ret,"rho;"); - break; - case omega: - strcpy(ret,"omega"); - break; - case EtaPrime: - strcpy(ret,"etaprime"); - break; - case phiMeson: - strcpy(ret,"phi"); - break; - default: - sprintf(ret,"type(%d)",(int)p); - break; - } - return(ret); -} - -#endif -/* - *********************** - * * - * END OF FILE * - * * - *********************** - */ - - - - diff --git a/src/programs/Simulation/genr8_2_hddm/Makefile b/src/programs/Simulation/genr8_2_hddm/Makefile deleted file mode 100644 index 253a8fd329..0000000000 --- a/src/programs/Simulation/genr8_2_hddm/Makefile +++ /dev/null @@ -1,7 +0,0 @@ - -PACKAGES = ROOT - -ADDITIONAL_MODULES = HDDM - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/genr8_2_hddm/SConscript b/src/programs/Simulation/genr8_2_hddm/SConscript deleted file mode 100644 index 9a5264c0f7..0000000000 --- a/src/programs/Simulation/genr8_2_hddm/SConscript +++ /dev/null @@ -1,13 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddROOT(env) -sbms.AddHDDM(env) -sbms.executable(env) - - diff --git a/src/programs/Simulation/genr8_2_hddm/genr8_2_hddm.cc b/src/programs/Simulation/genr8_2_hddm/genr8_2_hddm.cc deleted file mode 100644 index 53f0a02cd1..0000000000 --- a/src/programs/Simulation/genr8_2_hddm/genr8_2_hddm.cc +++ /dev/null @@ -1,385 +0,0 @@ -#include -#include -#include -#include -#include -using namespace std; - -#include "HDDM/hddm_s.hpp" -#include "particleType.h" - -char *INPUT_FILE=NULL; -string OUTPUT_FILE("output.hddm"); - -void ParseCommandLineArguments(int narg,char *argv[]); -int Str2GeantParticleID(char *str); -void Usage(void); -double randm(double, double); - -float vertex[4] = {0.0, 0.0, 65.0, 65.0}; -Particle_t targetType = Proton; -Particle_t beamType = Gamma; -bool FIXED_BEAM_MOMENTUM = false; -float BEAM_MOMENTUM = 8.5; -float BEAM_MOMENTUM_SIGMA = 0.005; -int USER_RUNNUMBER = 0; - -#include -TRandom *rnd; - -#define SQR(X) ((X)*(X)) - -time_t now; - -//------------------------------- -// main -//------------------------------- -int main(int narg, char *argv[]) -{ - ParseCommandLineArguments(narg,argv); - - if (!INPUT_FILE) { - std::cerr << "No input file!" << std::endl; - } - - // Create the random generator - rnd = new TRandom(); - - // Open input file - ifstream *infile = new ifstream(INPUT_FILE); - if (! infile->is_open()) { - std::cerr << "Unable to open file \"" << INPUT_FILE << "\" for reading." - << std::endl; - exit(-2); - } - - // Open output file - - std::ofstream *outfile = new ofstream(OUTPUT_FILE.c_str()); - if (! outfile->is_open()) { - std::cerr << "Unable to open output file \"" << OUTPUT_FILE - << "\" for writing." << std::endl; - exit(-3); - } - hddm_s::ostream *outstream = new hddm_s::ostream(*outfile); - - // Loop over events - int Nevents = 0; - while (! infile->eof()) { - int runNumber=0, eventNumber=0, nParticles=0; - *infile >> runNumber >> eventNumber >> nParticles; - if (runNumber == 0 && eventNumber == 0 && nParticles == 0) - break; - - if(USER_RUNNUMBER != 0) runNumber = USER_RUNNUMBER; - - // Start a new event - hddm_s::HDDM record; - hddm_s::PhysicsEventList pes = record.addPhysicsEvents(); - pes().setRunNo(runNumber); - pes().setEventNo(eventNumber); - hddm_s::ReactionList rs = pes().addReactions(); - hddm_s::TargetList ts = rs().addTargets(); - ts().setType(targetType); - hddm_s::PropertiesList tpros = ts().addPropertiesList(); - tpros().setCharge(ParticleCharge(targetType)); - tpros().setMass(ParticleMass(targetType)); - hddm_s::MomentumList tmoms = ts().addMomenta(); - tmoms().setPx(0); - tmoms().setPy(0); - tmoms().setPz(0); - tmoms().setE(ParticleMass(targetType)); - hddm_s::BeamList bs = rs().addBeams(); - bs().setType(beamType); - hddm_s::PropertiesList bpros = bs().addPropertiesList(); - bpros().setCharge(ParticleCharge(beamType)); - bpros().setMass(ParticleMass(beamType)); - hddm_s::MomentumList bmoms = bs().addMomenta(); - bmoms().setPx(-tmoms().getPx()); - bmoms().setPy(-tmoms().getPy()); - bmoms().setPz(-tmoms().getPz()); - bmoms().setE(-tmoms().getE()); - hddm_s::VertexList vs = rs().addVertices(); - hddm_s::OriginList os = vs().addOrigins(); - hddm_s::ProductList ps = vs().addProducts(nParticles); - - os().setT(0.0); - os().setVx(vertex[0]); - os().setVy(vertex[1]); - - if (vertex[2] < vertex[3]) { - os().setVz(randm(vertex[2],vertex[3])); - } - else { - os().setVz(vertex[2]); - } - - for (int i=0; i < nParticles; i++) { - int N, charge, type; - char typestr[256]; - float mass, px, py, pz, E; - *infile >> N >> typestr >> mass; - *infile >> charge >> px >> py >> pz >> E; - - type = Str2GeantParticleID(typestr); - if (type < 0) - type = atoi(typestr); - - ps(i).setType((Particle_t)type); - ps(i).setPdgtype(PDGtype((Particle_t)type)); - ps(i).setId(i+1); /* unique value for this particle within the event */ - ps(i).setParentid(0); /* All internally generated particles have no parent */ - ps(i).setMech(0); /* maybe this should be set to something? */ - hddm_s::MomentumList pmoms = ps(i).addMomenta(); - pmoms().setPx(px); - pmoms().setPy(py); - pmoms().setPz(pz); - pmoms().setE(E); - bmoms().setPx(bmoms().getPx() + px); - bmoms().setPy(bmoms().getPy() + py); - bmoms().setPz(bmoms().getPz() + pz); - bmoms().setE(bmoms().getE() + E); - } - - // If a specific beam momentum was specified, overwrite - // the calculated momentum with it. - if (FIXED_BEAM_MOMENTUM) { - float p = BEAM_MOMENTUM; - if (BEAM_MOMENTUM_SIGMA!=0.0) { - float delta_p = BEAM_MOMENTUM_SIGMA*rnd->Gaus(); - p += delta_p; - } - bmoms().setPx(0.0); - bmoms().setPy(0.0); - bmoms().setPz(p); - } - - bmoms().setE(sqrt(SQR(bpros().getMass()) + SQR(bmoms().getPx()) + - SQR(bmoms().getPy()) + SQR(bmoms().getPz()))); - - if (nParticles > 0) { - *outstream << record; - if (eventNumber%1000 == 0) { - std::cout << "Wrote event " << eventNumber << "\r"; - std::cout.flush(); - } - Nevents++; - } - } - - // Close input file - delete infile; - - // Close output file - delete outstream; - delete outfile; - - std::cout << "Wrote " << Nevents << " events to " << OUTPUT_FILE - << std::endl; - - return 0; -} - -//------------------------------- -// ParseCommandLineArguments -//------------------------------- -void ParseCommandLineArguments(int narg,char *argv[]) -{ - if (narg < 2) { - Usage(); - exit(0); - } - - for(int i=1; i < narg; i++) { - if (argv[i][0]=='-') { - char *ptr = &argv[i][1]; - switch(*ptr) { - case 'V': - sscanf(&ptr[1], "%f %f %f %f", &vertex[0], &vertex[1], - &vertex[2], &vertex[3]); - if (vertex[2] > vertex[3]) { - std::cerr << "Invalid parameter: z_min > z_max" << std::endl; - exit(-1); - } - break; - case 'b': - beamType = (Particle_t)Str2GeantParticleID(&ptr[1]); - break; - case 't': - targetType = (Particle_t)Str2GeantParticleID(&ptr[1]); - break; - case 'P': - FIXED_BEAM_MOMENTUM = true; - BEAM_MOMENTUM = atof(&ptr[1]); - break; - case 's': - BEAM_MOMENTUM_SIGMA = atof(&ptr[1])/1000.0; - break; - case 'r': - USER_RUNNUMBER = atof(&ptr[1]); - break; - default: - std::cerr << "Unknown option \"" << argv[i] << "\"" << std::endl; - Usage(); - exit(-1); - } - } - else { - INPUT_FILE = argv[i]; - } - } - - // Determine output filename from input filename - OUTPUT_FILE = INPUT_FILE; - size_t pos = OUTPUT_FILE.find_last_of("."); - if (pos != string::npos) OUTPUT_FILE.erase(pos); - OUTPUT_FILE += ".hddm"; - - if (FIXED_BEAM_MOMENTUM) { - std::cout << std::endl; - std::cout << "Using fixed beam: " << ParticleType(beamType) - << " P = " << BEAM_MOMENTUM - << " +/- " << BEAM_MOMENTUM_SIGMA << " GeV" << std::endl; - std::cout << std::endl; - } -} - -//------------------------------- -// Usage -//------------------------------- -void Usage(void) -{ - std::cout << std::endl; - std::cout << "Usage:" << std::endl; - std::cout << " genr8_2_hddm [options] file.ascii" << std::endl; - std::cout << std::endl; - std::cout << "Convert an ascii file of events generated by genr8 into HDDM" - << std::endl; - std::cout << "for use as input to hdgeant." << std::endl; - std::cout << std::endl; - std::cout << " options:" << std::endl; - std::cout << std::endl; - std::cout << " -r# " - "Set the run number (overiding what's in input file)" << std::endl; - std::cout << " -V\"x y z_min z_max\" set the vertex " - "for the interaction." << std::endl; - std::cout << " (default: x=" << vertex[0] - << " y=" << vertex[1] << " z_min=" << vertex[2] - << " z_max=" << vertex[3] << ")" << std::endl; - std::cout << " -b\"beam_particle_name\" " - "set the beam particle type [gamma]." << std::endl; - std::cout << " -t\"target_particle_name\" " - "set the target particle type [proton]." << std::endl; - std::cout << " -P# " - "Set the incident particle momentum in GeV." << std::endl; - std::cout << " " - "(default: calculate from momentum of" << std::endl; - std::cout << " " - "final state particles.)" << std::endl; - std::cout << " -s# " - "Set the momentum resolution of the beam" << std::endl; - std::cout << " in MeV. [5MeV]." - " (Only used if -P option" << std::endl; - std::cout << " is present.)" - << std::endl; - std::cout << " -h " - "print this usage statement." << std::endl; - std::cout << std::endl; -} - -//------------------------------- -// Str2GeantParticleID -//------------------------------- -int Str2GeantParticleID(char *str) -{ - if (strcmp(str, "unknown") == 0 || strcmp(str, "Unknown") == 0) - return Unknown; - if (strcmp(str, "gamma") == 0 || strcmp(str, "Gamma") == 0) - return Gamma; - if (strcmp(str, "positron") == 0 || strcmp(str, "Positron") == 0) - return Positron; - if (strcmp(str, "electron") == 0 || strcmp(str, "Electron") == 0) - return Electron; - if (strcmp(str, "neutrino") == 0 || strcmp(str, "Neutrino") == 0) - return Neutrino; - if (strcmp(str, "mu+") == 0 || strcmp(str, "Mu+") == 0) - return MuonPlus; - if (strcmp(str, "mu-") == 0 || strcmp(str, "Mu-") == 0) - return MuonMinus; - if (strcmp(str, "pi0") == 0 || strcmp(str, "Pi0") == 0) - return Pi0; - if (strcmp(str, "pi+") == 0 || strcmp(str, "Pi+") == 0) - return PiPlus; - if (strcmp(str, "pi-") == 0 || strcmp(str, "Pi-") == 0) - return PiMinus; - if (strcmp(str, "KL") == 0) - return KLong; - if (strcmp(str, "K+") == 0) - return KPlus; - if (strcmp(str, "K-") == 0) - return KMinus; - if (strcmp(str, "neutron") == 0 || strcmp(str, "Neutron") == 0) - return Neutron; - if (strcmp(str, "proton") == 0 || strcmp(str, "Proton") == 0) - return Proton; - if (strcmp(str, "pbar") == 0 || strcmp(str, "Pbar") == 0) - return AntiProton; - if (strcmp(str, "Ks") == 0) - return KShort; - if (strcmp(str, "eta") == 0 || strcmp(str, "Eta") == 0) - return Eta; - if (strcmp(str, "lambda") == 0 || strcmp(str, "Lambda") == 0) - return Lambda; - if (strcmp(str, "sigma+") == 0 || strcmp(str, "Sigma+") == 0) - return SigmaPlus; - if (strcmp(str, "sigma0") == 0 || strcmp(str, "Sigma0") == 0) - return Sigma0; - if (strcmp(str, "sigma-") == 0 || strcmp(str, "Sigma-") == 0) - return SigmaMinus; - if (strcmp(str, "Xi0") == 0) - return Xi0; - if (strcmp(str, "Xi-") == 0) - return XiMinus; - if (strcmp(str, "omega-") == 0 || strcmp(str, "Omega-") == 0) - return OmegaMinus; - if (strcmp(str, "nbar") == 0 || strcmp(str, "Nbar") == 0) - return AntiNeutron; - if (strcmp(str, "lambdabar") == 0 || strcmp(str, "Lambdabar") == 0) - return AntiLambda; - if (strcmp(str, "sigmabar-") == 0) - return AntiSigmaMinus; - if (strcmp(str, "sigmabar0") == 0 || strcmp(str, "Sigmabar0") == 0) - return AntiSigma0; - if (strcmp(str, "sigmabar+") == 0 || strcmp(str, "Sigmabar+") == 0) - return AntiSigmaPlus; - if (strcmp(str, "Xibar0") == 0) - return AntiXi0; - if (strcmp(str, "Xibar+") == 0) - return AntiXiPlus; - if (strcmp(str, "omegabar+") == 0 || strcmp(str, "Omegabar+") == 0) - return AntiOmegaPlus; - if (strcmp(str, "rho0") == 0 || strcmp(str, "Rho0") == 0) - return Rho0; - if (strcmp(str, "rho+") == 0 || strcmp(str, "Rho+") == 0) - return RhoPlus; - if (strcmp(str, "rho") == 0 || strcmp(str, "Rho") == 0) - return RhoMinus; - if (strcmp(str, "omega") == 0 || strcmp(str, "Omega") == 0) - return omega; - if (strcmp(str, "etaprime") == 0 || strcmp(str, "Etaprime") == 0) - return EtaPrime; - if (strcmp(str, "phi") == 0 || strcmp(str, "Phi") == 0) - return phiMeson; - if (!strcmp(str, "Pb208")) - return Pb208; - - return -1; -} - -/**************************/ -/* Random generator */ -/*------------------------*/ -double randm(double low, double high) -{ - return ((high - low) * rnd->Rndm() + low); -} diff --git a/src/programs/Simulation/gxtwist/Makefile b/src/programs/Simulation/gxtwist/Makefile deleted file mode 100644 index 0db9a52419..0000000000 --- a/src/programs/Simulation/gxtwist/Makefile +++ /dev/null @@ -1,19 +0,0 @@ -# Default makefile for gxtwist -# this just invokes make in the gelhad directory and -# then make with Makefile.bms in this directory. - -DIRS += gelhad hdds - -.PHONY: all install clean pristine relink env current_dir - -.PHONY: $(DIRS) - -all install clean pristine relink env: $(DIRS) current_dir - -$(DIRS): - if test ! -d gelhad ; then ln -s $(HALLD_HOME)/src/programs/Simulation/HDGeant/gelhad . ; fi - $(MAKE) -C $@ $(MAKECMDGOALS) - -current_dir: - $(MAKE) -f Makefile.bms $(MAKECMDGOALS) - diff --git a/src/programs/Simulation/gxtwist/Makefile.bms b/src/programs/Simulation/gxtwist/Makefile.bms deleted file mode 100644 index 27405044cd..0000000000 --- a/src/programs/Simulation/gxtwist/Makefile.bms +++ /dev/null @@ -1,12 +0,0 @@ - -PACKAGES := CERNLIB:JANA:CURL -MISC_LIBS = -L/sw/lib -lXm -L/usr/X11R6/lib -lXt -lgelhad -lhitutil -rdynamic -#FFLAGS = -Wno-globals -CFLAGS += -g -I$(HALLD_MY)/src/libraries/HDDM -I$(HALLD_HOME)/src/libraries/HDDM -ADDITIONAL_MODULES += HDDM HDGEOMETRY -FFLAGS += -g -DCERNLIB_MOTIF - - - -include $(HALLD_HOME)/src/BMS/Makefile.bin - diff --git a/src/programs/Simulation/gxtwist/README.txt b/src/programs/Simulation/gxtwist/README.txt deleted file mode 100644 index 4726fb0de8..0000000000 --- a/src/programs/Simulation/gxtwist/README.txt +++ /dev/null @@ -1,86 +0,0 @@ - - Build Note for GXtwist - Richard Jones - January 25, 2006 - -GXtwist is the GEANT3-based simulation program for the GlueX tagging -spectrometer and associated electron beam line. The geometry is defined -in a xml document (HDDS-1.0 schema) and translated into a Geant3 volume -description using the tool hdds-geant. This document is intended as a -quick-start guide for building and using the hdds tools. For more -information and for discussion of features and bugs, please go to -http://portal.gluex.org and look for "forums". - -1) Since you are reading this, you have already done the first step. - From your svn working source directory you typed: - - halld> svn checkout https://halldsvn.jlab.org/repos/trunk/sim-recon/src - - To build the gxtwist executable you also need to check out the hdds - module. The following line places this at a level parallel with src. - - halld> svn checkout https://halldsvn.jlab.org/repos/trunk/hdds - -2) Download the xerces-c xml library from xml.apache.org and unpack - it somewhere on your system or GlueX working area. Getting the sources - and doing the build yourself (next step) makes sure that you have a - working installation for your configuration. - -3) Build the xerces xml library for your system. - - This is pretty simple. The instructions are found on the xml.apache.org - web site. There are just three steps: define XERCESCROOT to point to the - base directory where you unpacked xerces-c, then runConfigure and gmake. - The result is a shared library in the directory xerces-c/lib. - -4) Somewhere, preferably at the top of your working source directory you - should make a script called setup that sets up some environment - variables that are needed to locate the CERN libraries on your system. - What that looks like depends on your shell, but for tcsh it looks like: - - halld> cat setup - ... - setenv CERN - setenv CERN_LEVEL - setenv CERN_ROOT ${CERN}/${CERN_LEVEL} - ... - - For the bash or ksh shells you should use the export command instead of - setenv. You will need to source this file before every session, (or - invoke it with the . operator for ksh or bash). - -5) Now go to gxtwist and build the interactive version. - - halld> cd ../gxtwist - halld> make gxtwist++ - - Now find the start of the long string of errors that was just produced by - make, and find out what you did wrong in steps 1..5. Iterate until the - package builds without errors. - -6) Start up interactive Geant and plot the detector. - - halld> ./gxtwist++ - ... lots of output - GEANT> next; dcut hill y 0 1 10 .01 .01 - -7) Install the field map in your working directory and generate events - - The field map is not stored in svn as a part of the code repository - because it is too large (over 200MB). Before you can start tracking - particles through the tagger you need to fetch a copy of the file - taggerBfield-XXX.map into your working directory. There are two - varieties of the field map, one with the quadrupole magnet on and - one with it off. They are available at the following web address. - - http://zeus.phys.uconn.edu/halld/tagger/simulation/taggerBfield-quad.map - http://zeus.phys.uconn.edu/halld/tagger/simulation/taggerBfield-noquad.map - -Now you are on your way. If you ever want to fiddle with the geometry, -you need to know where to find it. The hdds description of the tagger -is in the hdds directory inside this folder, not in the upper-level hdds -project in svn. It is checked out automatically when you check out gxtwist. - -Richard Jones -Storrs, Connecticut -richard.t.jones@uconn.edu diff --git a/src/programs/Simulation/gxtwist/beamgen.F b/src/programs/Simulation/gxtwist/beamgen.F deleted file mode 100644 index e48ecdb543..0000000000 --- a/src/programs/Simulation/gxtwist/beamgen.F +++ /dev/null @@ -1,227 +0,0 @@ - subroutine beamgen(t0) - real t0 ! beam bucket, ns -* -* Generates a single beam photon according to the coherent bremsstrahlung -* model in cobrems.F using beam energy and primary coherent edge energies -* specified by the user. The photon begins its lifetime inside the radiator -* (WARNING: at z=0 is assumed in the code below, different from HDGeant) -* and is tracked by the simulation from there forward. -* -* To enable beam motion spreading, define the beam box size below (cm) -* #define BEAM_BOX_SIZE 5 - -#include "geant321/gcunit.inc" -#include "geant321/gcflag.inc" -#include "geant321/gckine.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcscan.inc" -#include "geant321/gcomis.inc" -#include "geant321/gctrak.inc" -#include "cobrems.inc" - - real vertex(4),plab(5),pbeam - real rhom,phim - real rhop,phip - real rhoc,phic - integer nvert,nt - real rndm(20) - -c freqMaximum = probability density cutoff for coherent/incoherent -c bremsstrahlung generator, defined on the measure [dx dphi dy] where -c x = E_gamma/E_end_point -c phi = azimuthal angle (radians) -c y = a normalized polar angle parameter defined by the relation -c dy = theta0^2 dtheta^2 / (theta0^2 + theta^2)^2 with 0<=y<=1. -c The probability is for a single electron, so the scale is that of -c the target thickness (radiation lengths) divided by 2pi. A good -c choice for freqMaximum is the target thickness in radiation lengths. -c A warning is printed in the simulation output log each time a value -c freq > freqMaximum is generated; a few ppm of these is no problem. - real xMinimum,freqMaximum,beamStartZ,Theta02 - common /coherentGen/xMinimum,freqMaximum,beamStartZ,Theta02 - data xMinimum/0.01/ - data freqMaximum/2.0e-4/ - data beamStartZ/0.0/ - data Theta02/1.8/ - - save /coherentGen/ - real RadiatorPos,RadiatorSize - parameter (RadiatorPos=0.0) - parameter (RadiatorSize=5.0) - - integer nProfileBins - parameter (nProfileBins=500) - real freqProfile(nProfileBins) - real freqIntegral(nProfileBins) - common /freqTables/freqProfile,freqIntegral - data freqProfile/nProfileBins*0/ - data freqIntegral/nProfileBins*0/ - save /freqTables/ - real Wincoh - parameter (Wincoh=0.1) - - integer nubuf - real ubuf(10) - - logical hexist - external hexist - common /genstate/ppol,rndm - save /genstate/ - - 10 call GRNDM(rndm,7) - phim = rndm(1)*TWOPI - rhom = mospread*sqrt(-2*log(rndm(2))) - thxMosaic = rhom*cos(phim) - thyMosaic = rhom*sin(phim) - phib = rndm(3)*TWOPI - rhob = sqrt(-2*log(rndm(4))) - thxBeam = (emitx/spot)*rhob*cos(phib) - thyBeam = (emity/spot)*rhob*sin(phib) - phis = rndm(5)*TWOPI - varMS = sigma2MS(t*rndm(6)) - rhos = sqrt(-2*varMS*log(rndm(7))) - thxMS = rhos*cos(phis) - thyMS = rhos*sin(phis) - cos45 = 1/sqrt(2d0) - rotate(1,1) = 0 - rotate(1,2) = cos45 !point (1,0,0) along beam - rotate(1,3) = -cos45 !point (0,1,1) vertically - rotate(2,1) = 0 - rotate(2,2) = cos45 - rotate(2,3) = cos45 - rotate(3,1) = 1 - rotate(3,2) = 0 - rotate(3,3) = 0 - call rotmat(rotate,thxBeam+thxMS-thx-thxMosaic,0d0,0d0) - call rotmat(rotate,0d0,thyBeam+thyMS-thy-thyMosaic,0d0) - if (freqIntegral(nProfileBins).eq.0) then - x1 = 1 - x0 = xMinimum**(1./nProfileBins) - freqProfile(1) = dNcdxdp((x0+x1)/2,TWOPI/4) - freqIntegral(1) = freqProfile(1)*(x1-x0) - do ip=2,nProfileBins - x1 = x0 - x0 = xMinimum**(ip*1./nProfileBins) - freqProfile(ip) = dNcdxdp((x0+x1)/2,TWOPI/4) - freqIntegral(ip) = freqIntegral(ip-1) - + +freqProfile(ip)*(x1-x0) - enddo - endif - do i=1,1000000000 - call GRNDM(rndm,5) - if (rndm(1).gt.1/(Wincoh+1)) then !try coherent generation - f = freqIntegral(nProfileBins)*rndm(2) - do ip=1,nProfileBins - if (f.le.freqIntegral(ip)) then - x0 = xMinimum**((ip-1.)/nProfileBins) - x1 = xMinimum**((ip*1.)/nProfileBins) - if (ip.gt.1) then - f0 = freqIntegral(ip-1) - else - f0 = 0 - endif - f1 = freqIntegral(ip) - fp = freqProfile(ip) - x = (x0*(f1-f)+x1*(f-f0))/(f1-f0) - go to 4 - endif - enddo - 4 continue - phi = rndm(3)*TWOPI - freq = dNcdxdp(x,phi) - f = freq*rndm(4) - do iq=1,q2points - if (f.le.q2weight(iq)) then - theta2 = q2theta2(iq) - goto 5 - endif - enddo - 5 continue - freq = freq*freqIntegral(nProfileBins)/fp - freq = freq*TWOPI - ppol = polarization(x,theta2) - else !try incoherent generation - x = xMinimum**rndm(2) - phi = rndm(3)*TWOPI - theta2 = Theta02*rndm(4)/(1-rndm(4)+1e-30) - freq = dNidxdt2(x,theta2) - freq = freq*(Theta02+theta2)**2/Theta02 - freq = freq*x*(-log(xMinimum)) - freq = freq*Wincoh - ppol = 0 - endif - if (freq.gt.freqMaximum) then - print *, 'Warning from beamgen: freq=',freq, - + ' is greater than freqMaximum=',freqMaximum - endif - if (freq.ge.freqMaximum*rndm(5)) then - goto 50 - endif - enddo - print *, 'Error in beamgen:', - + ' photon beam generator failed, giving up!' - stop - -50 continue - -#if DEBUG_CB_BEAM_GENERATOR - print *, 'success after',i,' attempts' - if (.not.hexist(20)) then - call hbnt(20,'coherent generator state',' ') - call hbnt(21,'incoherent generator state',' ') - call hbname(20,'genstate',ppol,'ppol:r') - call hbname(20,'genstate',rndm(1),'varndm(5):r') - call hbname(21,'genstate',ppol,'ppol:r') - call hbname(21,'genstate',rndm(1),'varndm(5):r') - endif - if (ppol.eq.0) then - call hfnt(21) - else - call hfnt(20) - endif -#endif - - call GRNDM(rndm,2) - phip = rndm(1)*TWOPI - rhop = sqrt(-2*log(rndm(2))) - pbeam = E+Erms*rhop*cos(phip) - theta = sqrt(theta2)*(me/E) - thetaX = thxBeam+thxMS+theta*cos(phi) - thetaY = thyBeam+thyMS+theta*sin(phi) - plab(5) = pbeam*x - plab(1) = plab(5)*thetaX - plab(2) = plab(5)*thetaY - plab(3) = sqrt(plab(5)**2-plab(1)**2-plab(2)**2) - plab(4) = plab(5) - call GRNDM(rndm,2) - phic = rndm(1)*TWOPI - rhoc = spot*sqrt(-2*log(rndm(2))) - vertex(1) = (rhoc*cos(phic)-D*thxBeam)*100 ! project back to the radiator - vertex(2) = (rhoc*sin(phic)-D*thyBeam)*100 - if ((abs(vertex(1)).gt.RadiatorSize/2).or. - + (abs(vertex(2)).gt.RadiatorSize/2)) go to 10 - vertex(3) = RadiatorPos - - ubuf(1) = ppol - ubuf(2) = plab(1) - ubuf(3) = plab(2) - ubuf(4) = plab(3) - ubuf(5) = plab(4) - ubuf(6) = plab(5) - nubuf = 6 -#if defined BEAM_BOX_SIZE - call GRNDM(rndm,2) - ubuf(2) = rndm(1)*BEAM_BOX_SIZE - ubuf(3) = rndm(2)*BEAM_BOX_SIZE - vertex(1) = vertex(1) + ubuf(2) - vertex(2) = vertex(2) + ubuf(3) - nubuf = 3 -#endif - TOFG = t0 - call GSVERT(vertex,0,0,ubuf,nubuf,nvert) - call GSKINE(plab,1,nvert,0,0,nt) ! push the beam photon on the stack - plab(1) = pbeam*thxBeam-plab(1) - plab(2) = pbeam*thyBeam-plab(2) - plab(3) = pbeam-plab(3) - call GSKINE(plab,3,nvert,0,0,nt) ! push the post-brems electron as well - end diff --git a/src/programs/Simulation/gxtwist/bfld.f b/src/programs/Simulation/gxtwist/bfld.f deleted file mode 100644 index 3af076e201..0000000000 --- a/src/programs/Simulation/gxtwist/bfld.f +++ /dev/null @@ -1,11 +0,0 @@ - real function bfld(i,x,y,z) - real x,y,z - integer i - real r(3),F(3) - r(1) = x - r(2) = y - r(3) = z - call gmedia(r,numed) - call gufld(r,F) - bfld = F(i) - end diff --git a/src/programs/Simulation/gxtwist/bfld.sl b/src/programs/Simulation/gxtwist/bfld.sl deleted file mode 100755 index 090527e2bc5dd9df3c9a5fa31728158a5fa1f652..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 493779 zcmeI%4RlrIo$v7{Zv-(*UJ8m9+oMH`6^}_k2v(*9I6xEvhJad2k0CiB!IK=CoG5sU zqJb%=$E=&ydOPjXH85~z*=5(%ncEjTb+xc$hT?MWrJeRR>C~3?Iy0eAm(JMMQKq@S z|K86IJAr$z_pWv4Wv%aK?fu{X=Xv(CpXak*&dK4C)Y?@gB_%Fe%3PTXvZ>B3RN?*y zD}$uhY6j>n&PsnWt4d)F)dppjSFKe~)pRmL))_$MXQ}V6aSm~y_sqQbLN=2*x=7juV z<)2i=M|CS%|IbdSpCy3E)8_w^3H9GmKBUX=sz2V|BhmG@`TVB|?f**oeX;p`*w>qr z&1cl-6*{k7?aL;d-|ndB`rCM}QT>j6;q|xt&;0QgY`*_-LjJ=Ec_Nkv`{|YUG}f zvYiiQl(uDhGTSG>drwPOMvdEZD!*9i*7j^$+HLC#LVIT>+t$^xBkkJLxgD8q z*Q*oeb}01pW;3oWm(F(PTqexg)2-QDuWQM-bk{naJ)d^Ho!zcgW%p-#y7E2B(+~Ex z2gkJs#|2r-)=alf*_&?d+F>nwGdeP}Q`5u$HzO(#86Y;PWRf*XQ*YE$U14Az%Ki<@$p7L!bYR zk0U<5X7$%N_m0mmogL2WJ&IPI@c9is-sr*^6{*X z%k-Vs`nyeWlD==RwDy1|Zmq>SeV0_MRQ*DWs;{%C`b~wu?LRwt|Ru!i;jqFm>{$taMPaIIYVyU{ndf@A- zb_2`H3;k9&I>T2^*>|Gvbn%IVD))UqKSLc1^qv>nnvj(Ek%98=^D(+3&((p6@oi2IKncKU-H! zRTW(!HB?MZv-p!@YNo|g)?@0s8wOHC8%ECgDW@hE-O*E}0~^k%s#soHNWD3ndedCh z_hvyZ>tE{hmw}tQ@BR9orTKO^-DuJAh19YB-N&3kOy2(Cj%B(}f~tWB-0{>8Y|6(| z#}bVeP8y8L2U5pIC)+{0Do(FanRPjLT$e}scOP;2vNLxMZZ985jcn-nq`K|c6ZNet zRY*l`ZVK8A{cqb`G8l}>AGB-I>F;SIgLaaKC!PLt+aFGy8h&l~#E(z^?9`rDQ+wWA z)>m=Z`q0is97AaOwx+MpbrZ%HU|lWDTd78Y!fHFgQ4nIyvf2KchRtR|LcQ!f%&a zqeJC3dfU_7{T0v=N6i0-{Lg$u*Q1y^Syo{U?>|yLaQC@yhBG`l^($kAgEqnEgL2&< z<(CHMJo615YuBzWcI}F($-~Pg4_EBfwfgCa;fnnhj}C7cu?jbQ##R%R*@Ak0S#lEWImMY!b!>N}q7)mhsGEMX2_G5C z#h#BGuUP173!C2B_x-7l|EV6Xa9EPb=P5S6F(R?a#6^ z6=p5dcHs7s!jzTTDfv-hsTKDJO-dj6M7UEjb?@!!_2@53hmYu$GBmezc-9&<8-DGT zpNG%Qxn)!LUZy6)FBO;CxC=|yYJ2qOr9tzOSAH2adu4d)-szgb@d|4YOn>*x;qoOz zb8kKU*GgX*I%oq}cBom~;!@j|EwwQg-ah)v_m{kV^zD+urjf#|yHzw?VUsGHEbg8; z)b^=!!>JD?X;JUE{{7`;RL8xn1+(6l-P22eoS- zJGbnR?KSRt?etS>GYf#wz=0WSXkb2!;n%!sZ*}vKjADH>Hjk&n)&9YD1 zX$rwsZ@Gb$vqyFFl&w2k*l!iXkJko`M2UzuJiw<#R5eVgoPaNCZqduwXp&VSYjE}Z+9G_7x0$AiTw;aCTPu|Aei z*`fQ?&v5xw#oe=q)_&^TQ0m<9mUH!mpkd>#|9U33eNx9Tzi8^{dZ z`|-4WBJ1JX^>x5znh~z_4Oke*4y>} zRz=Y0ptawyIo{}!(V&w%cK!T#MOL*zYkg_dbKk!-=stg4c-V%`2d%-Hf%0Vo<*8Ge z(byLNeJiTgZQB14{iau(Wvy;6Ru;;iJg`T%+wR#HlqWR!(cpAzQ1m4ioWlE$U1w#johgIg75lv!N)Icy}4|rJJ;Ek%(raKW^&oK z@%5>uru9vUn-VK>ec84|cP^i>A4e0N-8=g7iQqTWgnl&DUN)1M(3gG@4FA8Y>WLG- z=iJG9eXeOq)Ca+DQZ>~JllmLY9=$}cg!@q&`+tjs{$651009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~ z0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY** z5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0 z009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{ z1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009ILKmY**5I_I{1Q0*~0R#|0009IL zKmY**5I_I{1Q0*~0R#|0009L4y$O_Pz>QiH?{#jf;?0T^m#B@!_+rPsn`M%3bl{Q7 z3z}c7EZ%6|;=AY9E?l!}Q{#%}hV_k!RSk{JiDWXFXsmBqome`*VbT1W#cL9c>zfmI zH8ihjXiPNKH?B_I5cRR5wt8W*CfL>n+XdR*5|rGMtX;7n*k4dxr;-IVwZV3QZ5J#G zwu^1MuqIivvZh+)+NykIZS@juZ?SEvrn)-V>MYt<ALE!ftss;*J3w(3D!^}lMN z^{_fPD%jRWBfWSWRq?;nda)7w|2X%=^F-%}%A@{9JT-gvj3^t;RcRO~DSpOI4?c!aHYOxNYxS{|2b$IDA=YFj9 zms)K(a$^{yt-T}4wW(5kN^PbnzJ8U;6hEi6LhE5|>^jXX4ePI0`%9Hi(^{r=uFj__ zH(TpWt<$w$p>?nNv;Dmq&J0DT_#TDHS}(U;%kM@TwCZ%hlljcfe7M)vl5Yw3w&i@$j;wY%yF0ZFcEiT)DpA8+ctE(#bfnvR zTDmeW*_zMw^y>U!2)fdkTDm%0HR!FqstPu(xvs8Ew>s|5&wn-%Q~%>Xtj3sKC^X?`n25Moz~87 z#=Epe?aKB3v-NJ3Sv&i_7PV`MwfmUb*gDU*vv*|FZhNeqy-#hm_pJ42UQxSV?b~?m z)oJf>TdiHRSUX#GX^q-_Rc<W)*(1cD6pOHEI_OT!VkzPUsiA7Pjow8nv^}4O`zA z)P$Spyr1^%Y~1$U)z&|VwM+Q@&njAf=5L=>N7Qb^UBdQD!bdwcYBx=vKht_EgK_)n zvHd@awVSDSGu1A7X;|B6d|!&So1=Df{uk|@i?y@Qy}4>P-#YS(^=IqXwA!_>dD!Ri z2DLljbA_OdjpN%|Z63D1u68beey%DC$}Jw#YVEDR;O0}i9d?jk5p{y%Q^l zcE7K7@iV>CSLwd$`>+tTv(N9~oWAZW4^+A#zi%OGXVI>0w2b@*%~u1q=ilyOGqHQd zo{e~a`}H8*VU>P~`it^-w0DOsW&W)8jtKK`$KC~D9-iTpT>vd*{wmwE9p+&}dxpb2 zY-rDFn1>biOon-Q$JnzM<~ED)84Gj!))YQVVeTIkd*HQ{1#gJ(*$DHny*&eA9(Ejk zH!BMsICrl2x2xiu-KVych2O4%?_ptXZ;V)b^u^W&fD{$6=vto;o4=D7N47xlMybGTHw(%1zW^NwEX8qXycssCiGe!A7` z_kp2D~!P1T~x-LCqC{PzUyFLzDK55)3&t$ttl zj<@U6s(fxNzhC*hSl*+2ek^}Td37v*O!>lC{`<=7V)>_)-xkY1qkLH`|AO+BvHYO& zHL?7Um9LHE&ne#!%fF$#IhKD%`Q5Snxblz1@|Tt07t6n=ye*dhjn&8ef2G`htEuz; zrFuo?WA)LyQ`LGqhR^2<_D5T=RJp6w{*>DPk#f6!bCn<1Q|YokzfpPO(ert&^2e3i ztK8ZzQQi?7-%{n-SYEGuQ0=4prAfKdZvglER<#zsk6WSM)pVCXJYGb9|HdEab6Y4)dA%9xAJ^ywd8}H!>_0KAgK3{D9 z-CiH5893D7rTDR3HdD(^4ns0!j7}Qvg{A5WUJfO+FF~|-$y$-vzfM} zYi-G9)7!do-Ra(ZOHbal_T+o>eeLaPxg%Na(&?4@u_?W_VPkVT?d-5@Ca>daRMVDA zZ_DPkwq(=6pJVBkzMU#ftx2zHs$Z8%FHfy*Xw*S=-gH}ESJy6=+qyl|noric;IBDf zXk+uc?YW-TOgf)S2Y>dZ(<@@`vCy zxQ=8^t&ZvFY*(KPTqdvDh1P0ovgQ_xt;w22?*3%WV%M3hsdL$F?Yex)nkCUdqmkD} zLl*{T{x+H|uHTmx?r7<5%VwPJ)of?ZrB~k5Sii1eg(`b8+w3Csgug7LJGm&ymjBo6iNO?aKGqXt U)43g)Zk;L+&;=WNJLnnvpDY$@*8l(j diff --git a/src/programs/Simulation/gxtwist/bintree.c b/src/programs/Simulation/gxtwist/bintree.c deleted file mode 100644 index 48d6507868..0000000000 --- a/src/programs/Simulation/gxtwist/bintree.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * bintree.c - library for managing binary tree of hits pointers - * - * version 1.0 -Richard Jones July 16, 2001 - */ - -#include -#include -#include - -void** getTwig(binTree_t** tree, int mark) -{ - binTree_t* node = *tree; - if (node == 0) - { - node = *tree = malloc(sizeof(binTree_t)); - node->mark = mark; - node->left = 0; - node->right = 0; - node->this = 0; - return &node->this; - } - else if (mark == node->mark) - { - return &node->this; - } - else if (mark < node->mark) - { - return getTwig(&node->left, mark); - } - else - { - assert (node->mark >= 0); - return getTwig(&node->right, mark); - } -} - -void* pickTwig(binTree_t** tree) -{ - binTree_t* node = *tree; - if (node == 0) - { - return 0; - } - else if (node->left) - { - return pickTwig(&node->left); - } - else - { - void* twig = node->this; - *tree = node->right; - free(node); - return twig; - } -} diff --git a/src/programs/Simulation/gxtwist/bintree.h b/src/programs/Simulation/gxtwist/bintree.h deleted file mode 100644 index 1ed059e07f..0000000000 --- a/src/programs/Simulation/gxtwist/bintree.h +++ /dev/null @@ -1,9 +0,0 @@ -typedef struct hitTree_s { - int mark; - struct hitTree_s* left; - struct hitTree_s* right; - void* this; -} binTree_t; - -void** getTwig(binTree_t** tree, int mark); -void* pickTwig(binTree_t** tree); diff --git a/src/programs/Simulation/gxtwist/cobrems.F b/src/programs/Simulation/gxtwist/cobrems.F deleted file mode 100644 index badc5d1e08..0000000000 --- a/src/programs/Simulation/gxtwist/cobrems.F +++ /dev/null @@ -1,674 +0,0 @@ -C This program calculates the spectrum of bremsstrahlung radiation from a -C crystal radiator. The formalism is that described in the following paper. -C W. Kaune, G. Miller, W. Oliver, R.W. Williams, and K.K. Young, -C -C "Inclusive cross sections for pion and proton production by photons -C using collimated coherent bremsstrahlung", Phys Rev D, vol 11, -C no 3 (1975) pp. 478-494. -C -C Author: Richard Jones 8-July-1997 -C -#define vector real - - Subroutine cobrems(Emax,Epeak,emitmr,radt,dist,coldiam,polar) - real Emax,Epeak,emitmr,radt,dist,coldiam - integer polar - include 'cobrems.inc' - integer i - real c - dpi=acos(-1d0) - me=5.1099891e-4 !electron mass (GeV) - alpha=7.2973525698e-3 !fine structure constant - hbarc=1.973269718e-16 !Planck's constant * speed of light (GeV m) - Z=6 !atomic number of diamond -c Z=14 !atomic number of silicon - a=3.5668e-10 !dimension of diamond unit cell (m) -c a=5.43e-10 !dimension of silicon unit cell (m) - Aphonon=0.40e9 !phonon-free recoil constant (GeV**-2) - betaFF=111*Z**(-1/3.)/me !cutoff for atomic form-factor (/GeV) - mospread=20e-6 !crystal r.m.s. mosaic spread - E=Emax !electron beam energy (GeV) - Erms=6.0e-4 !electron beam energy rms spread (GeV) - emit=emitmr !electron beam emittance (m r) - spot=0.0005 !electron beam spot size at collimator (m) - D=dist !distance from radiator to collimator (m) - t=radt !thickness of radiator (m) - collim=coldiam !collimator diameter (m) - -c spot = spot * 1e-6 -c emit = emit * 1e-6 -c t = t * 1e-6 -c mospread = mospread * 1e-6 - - thx=-0.0300/E !rotation of crystal about x (first) - thy=0.050 !rotation of crystal about y (second) -C-- require Epeak < Emax - if (Epeak.ge.Emax) then - return - endif -C-- decide if you want total or polarized flux - unpolar=(polar.eq.0) -C-- approximate calculation of angle from primary edge energy - edge=Epeak !desired position of primary edge - qtotal=9.8e-6 !Qtot for dominant lattice vector - qlong=edge/(E-edge)*me**2/(2*E) - thx=-qlong/qtotal -c thx=48e-6 !special values for NA59 setup -c thy=35e-6 !special values for NA59 setup -C-- PDG formula for radiation length, converted to meters - c=alpha*Z - radlen=4*nsites*alpha**3*(hbarc/(a*me))**2/a - + *( (Z**2)*(log(184.15*Z**(-1/3.)) - + -(c**2)*(1/(1+c**2) + 0.20206 - 0.0369*(c**2) - + + 0.0083*(c**4) - 0.002*(c**6))) - + + Z*log(1194*Z**(-2/3))) -C-- Schiff formula for radiation length, converted to meters -c zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) -c radlen=4*nsites*alpha**3*(hbarc/(a*me))**2/a -c + *Z*(Z+zeta)*log(183*Z**(-1/3.)) -C-- use either one formula or the other from above - radlen=1/radlen - write(6,*) - write(6,1000) - 1000 format('Initialization for coherent bremsstralung calculation') - write(6,1010) E - 1010 format(' electron beam energy:',f12.3,'GeV') - write(6,1012) emit*1e9 - 1012 format(' electron beam emittance:',f12.3,'mm.urad') - write(6,1020) 'diamond',t*1e6 - 1020 format(' radiator crystal: ',a10,', thickness',f8.0,'um') - write(6,1030) radlen*1e2,mospread*1e6 - 1030 format(' radiation length:',f8.1,'cm, mosaic spread:',f8.1,'urad') - write(6,1040) collim/(2*D)*(E/me) - 1040 format(' photon beam collimator half-angle:',f12.3,'(m/E)') - write(6,1045) colDiam*1e2 - 1045 format(' Collimator diameter:',f8.3,'cm') - write(6,1050) thx*1e3,thy*1e3 - 1050 format(' crystal orientation: theta-x',f10.3,'mrad', - + /' theta-y',f10.3,'mrad') - -C define the unit cell of the radiator crystal - ucell(1,1)=0 - ucell(2,1)=0 - ucell(3,1)=0 - do i=1,3 - ucell(1,1+i)=ucell(1,1)+0.5 - ucell(2,1+i)=ucell(2,1)+0.5 - ucell(3,1+i)=ucell(3,1)+0.5 - ucell(i,1+i)=ucell(i,1+i)-0.5 - enddo - ucell(1,5)=0.25 - ucell(2,5)=0.25 - ucell(3,5)=0.25 - do i=1,3 - ucell(1,5+i)=ucell(1,5)+0.5 - ucell(2,5+i)=ucell(2,5)+0.5 - ucell(3,5+i)=ucell(3,5)+0.5 - ucell(i,5+i)=ucell(i,5+i)-0.5 - enddo -C define the crystal->lab rotation matrix - rotate(1,1)=1 - rotate(1,2)=0 - rotate(1,3)=0 - rotate(2,1)=0 - rotate(2,2)=1 - rotate(2,3)=0 - rotate(3,1)=0 - rotate(3,2)=0 - rotate(3,3)=1 - call rotmat(rotate,0d0,dpi/2,0d0) !point (1,0,0) along beam - call rotmat(rotate,0d0,0d0,dpi/4) !point (0,1,1) vertically - call rotmat(rotate,-thx,0d0,0d0) !the goniometer-x rotation - call rotmat(rotate,0d0,-thy,0d0) !the goniometer-y rotation - write(6,2000) (rotate(1,j),j=1,3) - write(6,2000) (rotate(2,j),j=1,3) - write(6,2000) (rotate(3,j),j=1,3) -2000 format(3f12.6) - end - - real function cohrat(x) - real x - include 'cobrems.inc' - real yc,yi - yc=dNcdx(x) - yi=dNidx(x) - cohrat=(yc+yi)/(yi+1e-30) - end - - real function dNtdx(x) - real x - include 'cobrems.inc' - dNtdx=dNcdx(x)+dNidx(x) - end - - real function dNtdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - dNtdx3=dNcdx(x)+dNidx(x) - end - - real function dNtdk(k) - real k - include 'cobrems.inc' - dNtdk=dNtdx(k/E)/E - end - - real function dNcdx(x) - real x - include 'cobrems.inc' - real phi - phi=REAL(dpi/4) - dNcdx=REAL(2*dpi*dNcdxdp(x,phi)) - end - - real function dNcdx3(x,dRadCol,diamCol) - real x,dRadCol,diamCol - include 'cobrems.inc' - real phi - if (dRadCol.gt.0) D=dRadCol - if (diamCol.gt.0) collim=diamCol - if (diamCol.lt.0) collim=-2*D*diamCol*me/E - phi=REAL(dpi/4) - dNcdx3=REAL(2*dpi*dNcdxdp(x,phi)) - end - - real function dNcdxdp(x,phi) - real x,phi - include 'cobrems.inc' - integer h,k,l - double precision ReS,ImS,S2 - double precision q2,qT2,q(3),qdota - real xmax,theta2,FF,sum - integer hmin,kmin,lmin - real q3min - integer i - real sigma0 - sigma0=REAL(16*dpi*t*Z**2*alpha**3*E*(hbarc/a**2)*(hbarc/a/me)**4) - q2points=0 - q3min=1 - sum=0 - do h=-4,4 ! can replace with 0,0 for cpu speed-up if crystal alignment is "reasonable" - do k=-10,10 - do l=-10,10 -c do k=-2,-2 -c do l=-2,-2 - if (h/2*2.eq.h) then - if (k/2*2.ne.k) then - goto 10 - elseif (l/2*2.ne.l) then - goto 10 - elseif ((h+k+l)/4*4.ne.h+k+l) then - goto 10 - endif - elseif (k/2*2.eq.k) then - goto 10 - elseif (l/2*2.eq.l) then - goto 10 - endif - ReS=0 - ImS=0 - do i=1,nsites - qdota=2*dpi*(h*ucell(1,i) + k*ucell(2,i) + l*ucell(3,i)) - ReS=ReS+cos(qdota) - ImS=ImS+sin(qdota) - enddo - S2=ReS**2+ImS**2 - if (S2.lt.1e-4) then - goto 10 - endif - qnorm=REAL(2*dpi*hbarc/a) - q(1)=qnorm*(rotate(1,1)*h + rotate(1,2)*k + rotate(1,3)*l) - q(2)=qnorm*(rotate(2,1)*h + rotate(2,2)*k + rotate(2,3)*l) - q(3)=qnorm*(rotate(3,1)*h + rotate(3,2)*k + rotate(3,3)*l) - q2=q(1)**2+q(2)**2+q(3)**2 - qT2=q(1)**2+q(2)**2 - xmax=REAL(2*E*q(3)) - xmax=xmax/(xmax+me**2) - if ((x.gt.xmax).or.(xmax.gt.1)) then - goto 10 - else -c write(6,*) h,k,l,S2 -c write(6,*) q2,xmax - endif - if (q(3).lt.q3min) then - q3min=REAL(q(3)) - hmin=h - kmin=k - lmin=l - endif - theta2=(1-x)*xmax/(x*(1-xmax)) - 1 - FF=REAL(1/(1+q2*betaFF**2)) - sum=REAL(sum+sigma0*qT2*S2*exp(-Aphonon*q2) - + * (FF*betaFF**2)**2 - + * ((1-x)/(x*(1+theta2))**2) - + * ((1+(1-x)**2) - + - 8*(theta2/(1+theta2)**2)*(1-x)*cos(phi)**2) - + * acceptance(theta2) - + * polarization(x,theta2,phi)) -C comment out the preceding line to disable polarization -RTJ - q2points=q2points+1 - q2theta2(q2points)=theta2 - q2weight(q2points)=sum -10 continue - enddo - enddo - enddo - dNcdxdp=sum -c if (q3min.lt.1) write(6,*) hmin,kmin,lmin,' best plane at',x - end - - real function dNidx(x) - real x - include 'cobrems.inc' - integer iter,niter - real theta2 !numerical integration over d(theta**2) over [0,inf] - real u,du !is transformed by u=1/(1+theta**2) to d(u) over [0,1] - niter=50 - dNidx=0 - if (x.gt.1) then - return - endif - du=1./niter - do iter=1,niter - u=(iter-0.5)/niter - theta2=(1-u)/u - dNidx=dNidx+dNidxdt2(x,theta2)*du/u**2 - enddo -c write(6,*) dNidx - end - -C In the following paper, a closed form is given for the integral that -C is being performed analytically by dNidx. I include this second form -C here in case some time it might be useful as a cross check. -C -C "Coherent bremsstrahlung in crystals as a tool for producing high -C energy photon beams to be used in photoproduction experiments at -C CERN SPS", Nucl. Instr. Meth. 204 (1983) pp.299-310. -C -C Note: in this paper they have swapped subscripts for coherent and -C incoherent intensities. This is not very helpful to the reader! -C -C The result is some 15% lower radiation rate than the result of dNidx. -C I take the latter to be more detailed (because it gives a more -C realistic behaviour at the endpoint and agrees better with the PDG -C radiation length for carbon). Most of this deficiency is remedied -C by simply replacing Z**2 in the cross section with Z*(Z+zeta) as -C recommended by Kaune et.al., and followed by the PDG in their fit -C to radiation lengths. -C -C WARNING -C dNidx and dNBidx give the incoherent radiation rate for crystalline -C radiators. If you take the incoherent radiation formulae here and -C integrate them you will NOT obtain the radiation length for amorphous -C radiators; it will be overestimated by some 15%. The reason is that -C the part of the integral in q-space that is covered by the discrete -C sum has been subtracted to avoid double-counting with the coherent -C part. If you were to spin the crystal fast enough, the coherent -C spectrum would average out to yield the remaining 15% with a spectral -C shape resembling the Bethe-Heitler result. - - real function dNBidx(x) - real x - include 'cobrems.inc' - real psiC1,psiC2 - real AoverB2,Tfact - real zeta - AoverB2=Aphonon/betaFF**2 - Tfact=-(1+AoverB2)*exp(AoverB2)*EXPINT(AoverB2) - psiC1=2*(2*log(betaFF*me)+Tfact+2) - psiC2=psiC1-2/3. - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - dNBidx=nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + * (psiC1*(1+(1-x)**2) - psiC2*(1-x)*2/3.) - end - - real function dNidxdt2(x,theta2) - real x,theta2 - include 'cobrems.inc' - real MSchiff,delta,zeta - delta=1.02 - zeta=log(1440*Z**(-2/3.))/log(183*Z**(-1/3.)) - MSchiff=1/(((me*x)/(2*E*(1-x)))**2 + 1/(betaFF*me*(1+theta2))**2) - dNidxdt2=2*nsites*t*Z*(Z+zeta)*alpha**3*(hbarc/(a*me))**2/(a*x) - + *( ((1+(1-x)**2)-4*theta2*(1-x)/(1+theta2)**2)/(1+theta2)**2 - + *(log(MSchiff) - 2*delta*Z/(Z+zeta)) - + + 16*theta2*(1-x)/(1+theta2)**4 - (2-x)**2/(1+theta2)**2 ) - + * acceptance(theta2) -c write(6,*) dNidxdt2 - end - - real function rpara(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rpara=0.5*((1+1-x)**2)*(1+theta2)**2 - + -8*theta2*(1-x)*cos(phi)**2 - + -8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function rortho(x,theta2,phi) - real x,theta2,phi - include 'cobrems.inc' - rortho=0.5*x**2*(1+theta2)**2 - + +8*theta2**2*(1-x)*cos(phi)**2*sin(phi)**2 - end - - real function polarization(x,theta2,phi) - real x,theta2,phi - real Npara,Nperp - real paverage - include 'cobrems.inc' - if (unpolar) then - polarization=1 - return - endif - -c This formula was taken from Eq. A5 of Kaune, Miller, et.al. -c PhysRevD.11.479, but it has been averaged over phi already. -c 8/30/2017 - replacing this with the full phi-dependent -c expression below, based on Eq. A4. -c paverage=2*(1-x)/((1+theta2)**2*((1-x)**2+1) - 4*theta2*(1-x)) - - Npara = 0.5*(2-x)**2*(1+theta2)**2 - 8*theta2*(1-x)*cos(phi)**2 - - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 - Nperp = 0.5*x**2*(1+theta2)**2 + - + 8*theta2**2*(1-x)*(cos(phi)*sin(phi))**2 - polarization = (Npara - Nperp) / (Npara + Nperp) - end - - real function acceptance2(theta2,phi,xshift,yshift) - real theta2,phi,xshift,yshift - include 'cobrems.inc' - real xc,yc - real theta - theta=sqrt(theta2)*me/E - xc=D*tan(theta)*cos(phi)+xshift - yc=D*tan(theta)*sin(phi)+yshift - acceptance2 = acceptance((atan2(sqrt(xc**2+yc**2),D)*(E/me))**2) - end - - real function acceptance(theta2) - real theta2 - include 'cobrems.inc' - vector sig(4) - real u,var0,varMS,thetaC - real pu,du2,u0,u1,u2 - integer iter,niter - real theta -Comment out the following lines to enable collimation -RTJ - acceptance=1 - return -Comment out the preceding lines to enable collimation -RTJ - acceptance=0 - niter=50 - theta=sqrt(theta2) - thetaC=collim/(2*D)*(E/me) - var0=(spot/D*(E/me))**2 - varMS=sigma2MS(t)*(E/me)**2 - sig(1)=sqrt(var0) - sig(2)=sqrt(varMS) - if (theta.lt.thetaC) then - u1=thetaC-theta - if (u1**2/(var0+varMS).gt.20) then - acceptance=1 - return - endif - do iter=1,niter - u=u1*(iter-0.5)/niter - u2=u**2 - du2=2*u*u1/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=acceptance + pu*du2 - enddo - endif - u0=abs(theta-thetaC) - u1=abs(theta+thetaC) - do iter=1,niter - u=u0+(u1-u0)*(iter-0.5)/niter - u2=u**2 - du2=2*u*(u1-u0)/niter - if (varMS/var0.gt.1e-4) then - pu=(EXPINT(u2/(2*(var0+varMS)))-EXPINT(u2/(2*var0))) - + /(2*varMS) - else - pu=exp(-u2/(2*var0))/(2*var0) - endif - acceptance=REAL(acceptance + pu*du2/dpi - + * atan2(sqrt((theta2-(thetaC-u)**2)*((thetaC+u)**2-theta2)), - + theta2-thetaC**2+u2)) - enddo - end - - subroutine rotmat(matrix,thx,thy,thz) - double precision matrix(3,3),thx,thy,thz -C Matrix(out) = Rx(thx) Ry(thy) Rz(thz) Matrix(in) -C with rotations understood in the passive sense - double precision x,y,z - double precision sint,cost - integer i - if (thz.ne.0) then - sint=sin(thz) - cost=cos(thz) - do i=1,3 - x=matrix(1,i) - y=matrix(2,i) - matrix(1,i)=cost*x+sint*y - matrix(2,i)=-sint*x+cost*y - enddo - endif - if (thy.ne.0) then - sint=-sin(thy) - cost=cos(thy) - do i=1,3 - x=matrix(1,i) - z=matrix(3,i) - matrix(1,i)=cost*x+sint*z - matrix(3,i)=-sint*x+cost*z - enddo - endif - if (thx.ne.0) then - sint=sin(thx) - cost=cos(thx) - do i=1,3 - y=matrix(2,i) - z=matrix(3,i) - matrix(2,i)=cost*y+sint*z - matrix(3,i)=-sint*y+cost*z - enddo - endif - end - - subroutine convol(nbins) - integer nbins - include 'cobrems.inc' - vector hisx(10000),hisy(10000),sig(4) - real norm(10000),result(10000) - real x,x0,x1,dx - real alph,dalph - real var0,varMS - real term - integer i,ii,j - x0=hisx(1) - x1=hisx(nbins) - var0=(mospread**2+(emit/spot)**2) - varMS=sigma2MS(t) - sig(3)=sqrt(var0)*E/me - sig(4)=sqrt(varMS)*E/me -C--Here we have to guess which characteristic angle alph inside the crystal -C is dominantly responsible for the coherent photons in this bin in x. -C I just use the smallest of the two angles, but this does not work when -C both angles are small, and you have to be more clever -- BEWARE!!! -C--In any case, fine-tuning below the mosaic spread limit makes no sense. - alph=REAL(min(abs(thx),abs(thy))) - if (alph.eq.0) then - alph=REAL(max(abs(thx),abs(thy))) - else - alph=max(alph,mospread) - endif - - do j=1,nbins - norm(j)=0 - result(j)=0 - do i=-nbins,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - norm(j)=norm(j)+term - enddo - enddo - -c write(6,*) norm - - do i=-nbins,nbins - if (i.lt.1) then - ii=1-i - else - ii=i - endif - do j=1,nbins - dx=(x1-x0)*(j-i)/nbins - x=x0+(x1-x0)*(j-0.5)/nbins - dalph=dx*alph/(x*(1-x)) - if (varMS/var0.gt.1e-4) then - term=REAL(dalph/varMS - + *(ERF(dalph/sqrt(2*(var0+varMS))) - ERF(dalph/sqrt(2*var0))) - + + sqrt(2/dpi)/varMS - + *(exp(-dalph**2/(2*(var0+varMS)))*sqrt(var0+varMS) - + -exp(-dalph**2/(2*var0))*sqrt(var0))) - else - term=REAL(exp(-dalph**2/(2*var0))/sqrt(2*dpi*var0)) - endif - term=term*alph/x - result(ii)=result(ii)+term*hisy(j)/norm(j) - enddo - enddo - - do i=1,nbins - if (abs(result(i)).gt.1e-35) then - hisy(i)=result(i) - else - hisy(i)=0 - endif - enddo - end - - real function sigma2MS(tt) - real tt -C--Chose one of the available implementations of this function below. -c Some formulas, although valid for a reasonable range of target thickness, -c can go negative for extremely small target thicknesses. Here I protect -c against these unusual cases by taking the absolute value. [rtj] - sigma2MS=abs(sigma2MS_Geant(tt)) - end - - real function sigma2MS_Kaune(tt) - real tt - include 'cobrems.inc' -C--Multiple scattering formula of Kaune et.al. -c with a correction factor from a multiple-scattering calculation -c taking into account the atomic and nuclear form factors for carbon. - -c--Note by RTJ, Oct. 13, 2008: -c I think this formula overestimates multiple scattering in thin targets -c like these diamond radiators, because it scales simply like sqrt(tt). -c Although the leading behavior is sqrt(tt/radlen), it should increase -c faster than that because of the 1/theta**2 tail of the Rutherford -c distribution that makes the central gaussian region swell with increasing -c number of scattering events. For comparison, I include below the PDG -c formula (sigma2MS), the Moliere formula used in the Geant3 simulation -c of gaussian multiple scattering (sigma2MS_Geant), and a Moliere fit for -c thin targets taken from reference Phys.Rev. vol.3 no.2, (1958), p.647 -c (sigma2MS_Hanson). The latter two separate the gaussian part from the -c tails in different ways, but both agree that the central part is much -c more narrow than the formulation by Kaune et.al. below. - - carboncor=4.2/4.6 - sigma2MS_Kaune=REAL(8*dpi*nsites*alpha**2*Z**2 - + *tt*(hbarc/(E*a))**2/a - + *log(183*Z**(-1/3.)) - + *carboncor) - end - - real function sigma2MS_pdg(tt) - real tt - include 'cobrems.inc' -C--The PDG formula instead (with beta=1, charge=1) -c This formula is said to be within 11% for t > 1e-3 rad.len. - sigma2MS_pdg=(13.6e-3/E)**2*(tt/radlen) - + *(1+0.038*log(tt/radlen))**2 - end - - real function sigma2MS_Geant(tt) - real tt - include 'cobrems.inc' -C--Geant3 formula for the rms multiple-scattering angle -c This formula is based on the theory of Moliere scattering. It contains -c a cutoff parameter F that is used for the fractional integral of the -c scattering probability distribution that is included in computing the -c rms. This is needed because the complete distribution of scattering -c angles connects smoothly from a central gaussian (small-angle -c multiple-scattering regime) to a 1/theta^2 tail (large-angle Rutherford -c scattering regime) through the so-called plural scattering region. - F=0.98 ! probability cutoff in definition of sigma2MS - density=3.534 ! g/cm^3 - chi2cc=(0.39612e-2)**2*(Z*(Z+1))*(density/12) ! GeV^2/m - chi2c=chi2cc*(tt/E**2) - rBohr=0.52917721e-10 ! m - chi2alpha=1.13*(hbarc/(E*rBohr*0.885))**2 - + *Z**(2/3.)*(1+3.34*(alpha*Z)**2) - omega0=chi2c/(1.167*chi2alpha) ! mean number of scatters - gnu=omega0/(2*(1-F)) - sigma2MS_Geant=chi2c/(1+F**2)*((1+gnu)/gnu*log(1+gnu)-1) - end - - real function sigma2MS_Hanson(tt) - real tt - include 'cobrems.inc' -C--Formulation of the rms projected angle attributed to Hanson et.al. -c in reference Phys.Rev. vol.3 no.2, (1958), p.647. This is just Moliere -c theory used to give the 1/e angular width of the scattering distribution. -c In the paper, though, they compare it with experiment for a variety of -c metal foils down to 1e-4 rad.len. in thickness, and show excellent -c agreement with the gaussian approximation out to 4 sigma or so. I -c like this paper because of the excellent agreement between the theory -c and experimental data. - density=3.534 ! g/cm^3 - ttingcm=tt*100*density - Atomicweight=12.01 - EinMeV=E*1000 - theta2max=0.157*Z*(Z+1)/Atomicweight*(ttingcm/EinMeV**2) - theta2screen=theta2max*Atomicweight*(1+3.35*(Z*alpha)**2) - + /(7800*(Z+1)*Z**(1/3.)*ttingcm) - BminuslogB=log(theta2max/theta2screen)-0.154 - Blast=1 - do i=1,999 - B=BminuslogB+log(Blast) - if (B.lt.1.2) then - B=1.21 - goto 10 - elseif (abs(B-Blast).gt.1e-6) then - Blast=B - else - goto 10 - endif - enddo - 10 continue - sigma2MS_Hanson=theta2max*(B-1.2)/2 - end diff --git a/src/programs/Simulation/gxtwist/cobrems.inc b/src/programs/Simulation/gxtwist/cobrems.inc deleted file mode 100644 index b690f0abf3..0000000000 --- a/src/programs/Simulation/gxtwist/cobrems.inc +++ /dev/null @@ -1,16 +0,0 @@ -C units: length in m; energy,momentum,mass in GeV; angles in radians - common /cophys/dpi,me,alpha,hbarc - real me,alpha,hbarc - double precision dpi - integer nsites - parameter (nsites=8) - common /cotarg/Z,a,radlen,Aphonon,mospread,betaFF,ucell(3,nsites) - real Z,a,radlen,Aphonon,mospread,betaFF,ucell - common /cosetup/thx,thy,rotate(3,3),E,Erms,emit,spot,D,t,collim - double precision thx,thy,rotate - real E,Erms,emit,spot,D,t,collim - common /coQ2list/q2points,q2theta2(1000),q2weight(1000) - integer q2points - real q2theta2,q2weight - common /coselect/unpolar - logical unpolar diff --git a/src/programs/Simulation/gxtwist/control.in b/src/programs/Simulation/gxtwist/control.in deleted file mode 100644 index 26a1c01ecf..0000000000 --- a/src/programs/Simulation/gxtwist/control.in +++ /dev/null @@ -1,209 +0,0 @@ -c This is the control file for the GEANT simulation. Parameters defined -c in this file control the kind and extent of simulation that is performed. -c The full list of options is given in section BASE-40 of the GEANT manual. -c -c In addition, some new cards have been defined to set up the input source -c for the simulation. Three kinds of simulation runs are available, selected -c by which of the following three "cards" are present below. -c 1. Input from Monte Carlo generator (card INFILE) -c 2. Built-in coherent bremsstrahlung source (card BEAM) -c 3. Built-in single-track event generator (card KINE) -c The order of the list is significant, that is if INFILE is present then the -c BEAM and KINE cards are ignored, otherwise if BEAM is present then KINE is -c ignored. For example, the 3-card sequence: -c INFILE 'phi-1680.hddm' -c SKIP 25 -c TRIG 100 -c instructs HDGeant to open ./phi-1680.hddm, skip the first 25 events and then -c process the following 100 input events and stop. If the end of the file is -c reached before the event count specified in card TRIG is exhausted then the -c processing will stop at the end of file. -TRIG 10000 -cINFILE 'rhop.hddm' -cBEAM 12. 9. -RUNG 9999 - -c Commenting out the following line will disable simulated hits output. -OUTFILE 'hdgeant.hddm' - -c The following card enables single-track generation (for testing). -c For a single-particle gun, set the momentum (GeV/c), direction -c theta,phi (degrees) and vertex position (cm), and for the particle -c type insert the Geant particle type code plus 100 (eg. 101=gamma, -c 103=electron, 107=pi0, 108=pi+, 109=pi-, 114=proton). If you use -c the particle code but do not add 100 then theta,phi are ignored -c and the particle direction is generated randomly over 4pi sr. -c For a listing of the Geant particle types, see the following URL. -c http://wwwasdoc.web.cern.ch/wwwasdoc/geant_html3/node72.html -c The meaning of the arguments to KINE are as follows. -c - particle = GEANT particle type of primary track + 100 -c - momentum = initial track momentum, central value (GeV/c) -c - theta = initial track polar angle, central value (degrees) -c - phi = initial track azimuthal angle, central value (degrees) -c - delta_momentum = spread in initial track momentum, full width (GeV/c) -c - delta_theta = spread in initial track polar angle, full width (degrees) -c - delta_phi = spread in initial track azimuthal angle, full width (degrees) -c -c particle momentum theta phi delta_momentum delta_theta delta_phi -KINE 103 12.0 0. 0. 0. 0. 360. - -c The SCAP card determines the vertex position for the particle gun. It -c supports the following three arguments, all of which default to 0. -c -c vertex_x vertex_y vertex_z -SCAP 0. 0. 0. - -c If you specify a non-zero value for vertex_x and/or vertex_y above then -c all tracks will emerge from the given point. If you leave them at zero, -c you have the option of specifying the HALO card which causes the simulation -c to generate events with a transverse profile modeled after the 12 GeV -c electron beam. The argument only argument to HALO is fhalo, the fraction -c of the beam that lies in the halo region surrounding the core gaussian. -c The nominal value taken from CASA technical note JLAB-TN-06-048 is 5e-5. -c This card is only effective for electron beam simulations with gxtwist. -c -c fhalo -HALO 1e-2 - -c The following lines control the rate (GHz) of background beam photons -c that are overlayed on each event in the simulation, in addition to the -c particles produced by the standard generation mechanism. BGGATE expects -c two values in ns, which define the window around the trigger time that -c background beam photons are overlaid on the simulation. The value you -c should enter for BGRATE depends on many details of the photon beam: the -c endpoint energy, the low-energy cutoff to be used in generating beam -c photons, the location of coherent edge, the electron beam spot size and -c emittance at the primary collimator, the electron beam current, etc. To -c find the setting that is right for you, follow these steps in order. -c 1) Check the BEAM card above that it has correct values for the electron -c beam energy (field 1) and the low-energy cutoff that you want to use -c in your simulation (field 3). Remember these values. -c 2) Open a new tab in a web browser and enter the following URL, -c http://zeus.phys.uconn.edu/halld/cobrems/ratetool.cgi which displays -c a form containing many fields describing the electron beam and the -c photon beamline. Enter the correct values in all fields in the -c left-most column of parameters. The right column of parameters -c defines the windows over which the tool will compute integrals of -c the beam rate. Set the "end-point" window to span the full range -c from your beamEmin (see step 1 above) to the electron beam endpoint, -c Then click the Plot Spectrum button. After a few seconds, the form will -c respond with a few plots and rate numbers in bold text. Record the -c value given for the "end-point rate". This is your BGRATE value. -c 3) Enter your BGRATE value found in step 2 after BGRATE in the line -c below, and remove any characters before the BGRATE keyword. You are -c now ready to go. If you ever change anything in the beamline geometry -c eg. the collimator diameter, the coherent edge position, or the value -c of beamEmin, do not forget to come back and change your BGRATE. -cBGGATE -200. 200. -cBGRATE 4.80 - -c The above cards BGRATE, BGGATE normally cause the simulation to add -c accidental tagger hits to the simulated output record, in addition to -c adding these beam photons to the list of particles to be tracked through -c the detector. If you want the accidental tagger hits to be added to the -c simulated output record but you do not want to track the background -c beam photons, remove the comment in front of BGTAGONLY below. -c NOTICE: If you turn on BGTAGONLY then you might as well raise the -c minimum energy of beam photons being generated to the lower bound of -c the tagger energy range you are interested in, which might be 3 GeV for -c low-intensity running, 7 GeV for high-intensity running, or even 8 GeV -c if you are only interested in the region of the coherent peak. This -c minimum is the third field of the BEAM card above. Remember that if -c you change beamEmin, you also need to change BGRATE to match, as -c described above. -cBGTAGONLY 1 - -c The following card seeds the random number generator so it must be unique -c for each run. There are two ways to specify the random see for a run. -c 1. One argument, must be an integer in the range [1,215] -c 2. Two arguments, must be a pair of positive Integer*4 numbers -c In the first case, one of a limited set of prepared starting seeds is -c chosen from a list. These seeds have been certified to produce random -c sequences that do not repeat within the first 10^9 or so random numbers. -c For cases where more choices are needed, the two-argument form gives -c access to a total of 2^62 choices, with no guarantees about closed loops. -RNDM 121 - -c The following line controls the cutoffs for tracking of particles. -c CUTS cutgam cutele cutneu cuthad cutmuo bcute bcutm dcute dcutm ppcutm tofmax -c - cutgam = Cut for gammas (0.001 GeV) -c - cutele = Cut for electrons (0.001 GeV) -c - cutneu = Cut for neutral hadrons (0.01 GeV) -c - cuthad = Cut for charged hadrons (0.01 GeV) -c - cutmuo = Cut for muons (0.01 GeV) -c - bcute = Cut for electron brems. (CUTGAM) -c - bcutm = Cut for muon brems. (CUTGAM) -c - dcute = Cut for electron delta-rays. (10 TeV) -c - dcutm = Cut for muon delta-rays. (10 TeV) -c - ppcutm = Cut for e+e- pairs by muons. (0.01 GeV) -c - tofmax = Time of flight cut (1.E+10 sec) -c - gcuts = 5 user words (0.) -CUTS 1e-4 1e-4 1e-3 1e-3 1e-4 - -c The following line controls a set of generic flags that are used to -c control aspects of the simulation generally related to debugging. -c For normal debugging runs these should be left at zero (or omitted). -c At present the following functionality is defined (assumes debug on). -c SWIT(2) = 0 turns off trajectory tracing -c = 2 turns on step-by-step trace during tracking (verbose!) -c = 3 turns on trajectory plotting after tracking is done -c = 4 turns on step-by-step plotting during tracking -c SWIT(3) = 1 stores track trajectories for plotting after tracking is done -c SWIT(4) = 0 trace trajectories of all particle types -c = 3 trace only charged particle trajectories -SWIT 0 0 0 0 0 0 0 0 0 0 - -c The following card enables the GelHad package (from BaBar) -c on/off ecut scale mode thresh -GELH 1 0.2 1.0 4 0.160 - -c The following card selects the hadronic physics package -c HADR 0 no hadronic interactions -c HADR 1 GHEISHA only (default) -c HADR 2 GHEISHA only, with no generation of secondaries -c HADR 3 FLUKA (with GHEISHA for neutrons below 20MeV) -c HADR 4 FLUKA (with MICAP for neutrons below 20MeV) -HADR 4 - -c The following cards are needed if optical photons are being -c being generated and tracked in the simulation. The CKOV directive -c enables Cerenkov generation in materials for which the refractive -c index table has been specified. The LABS card enables absorption -c of optical photons. The ABAN directive controls a special feature -c of Geant which allows it to "abandon" tracking of charged particles -c once their remaining range drops below the distance to the next -c discrete interaction or geometric boundary. Particles abandoned -c during tracking are stopped immediately and dump all remaining energy -c where they lie. The remaining energy is dumped in the correct volume -c so this is OK in most cases, but it can cut into the yield of -c Cerenkov photons (eg. in a lead glass calorimeter) at the end of -c a particle track. If this might be important, set ABAN to 0. -CKOV 1 -LABS 1 - -c The following card prevents GEANT tracking code from abandoning the -c tracking of particles near the end of their range, once it determines -c that their fate is just to stop (i.e. electrons and protons). This -c behaviour is normal in most cases, but in the case of Cerenkov light -c generation it leads to an underestimate for the yields. -c ABAN 1 abandon stopping tracks (default) -c ABAN 0 do not abandon stopping tracks -ABAN 0 - -c The following card sets up the simulation to perform debugging on -c a subset of the simulated events. -c DEBUG first last step -c - first (int) = event number of first event to debug -c - last (int) = event number of last event to debug -c - step (int) = only debug one event every step events -DEBUG 1 10 1000 - -c The following card can be used to turn off generation of secondary -c particles in the simulation, ordinarily it should be 0 (or omitted). -NOSECONDARIES 0 - -c The following card tells the simulation to store particle trajectories -c in the output file. This output can be verbose, use with caution. -TRAJECTORIES 0 - -END diff --git a/src/programs/Simulation/gxtwist/dbug.kumac b/src/programs/Simulation/gxtwist/dbug.kumac deleted file mode 100644 index dec0245816..0000000000 --- a/src/programs/Simulation/gxtwist/dbug.kumac +++ /dev/null @@ -1,52 +0,0 @@ -MACRO dbug key=help - if ([key] = help) then - message 'Usage: dbug [-] [ [-] [...]]' - message 'where is one of the following:' - message '1) none - disables all debugging options' - message '2) printout - enables step-by-step debug printout during tracking' - message '3) store - stores step-by-step track coordinates during tracking' - message '4) plot - plots the tracks on the current drawing view' - message '5) plotnow - plots at every step instead of at end of track' - message '6) neutrals - renders neutral tracks visible during plotting' - exitm - endif - while [1] <> ' ' do - case [1] in - (none) - switch 1 0 - switch 2 0 - switch 3 0 - debug off - (-none) - message 'This is meaningless!' - (printout) - switch 2 2 - debug on - (-printout) - switch 2 0 - (store) - switch 3 1 - debug on - (-store) - switch 3 0 - (plot) - switch 3 1 - switch 2 3 - debug on - (-plot) - switch 2 0 - (plotnow) - switch 2 4 - debug on - (-plotnow) - switch 2 0 - (neutrals) - switch 4 0 - debug on - (-neutrals) - switch 4 3 - switch 2 3 - endcase - shift - endwhile -RETURN diff --git a/src/programs/Simulation/gxtwist/geant3.h b/src/programs/Simulation/gxtwist/geant3.h deleted file mode 100644 index b014c1ac87..0000000000 --- a/src/programs/Simulation/gxtwist/geant3.h +++ /dev/null @@ -1,29 +0,0 @@ -void gsvert_(float vert[3], int* ntbeam, int* nttarg, - float ubuf[], int* nubuf, int* nvtx); - -void gfvert_(int* nvtx, float vert[3], int* ntbeam, int* nttarg, - float* tofg, float ubuf[], int* nubuf); - -void gskine_(float plab[3], Particle_t* ipart, int* nv, - float ubuf[], int* nubuf, int* nt); - -void gfkine_(int* itra, float vert[3], float pvert[3], Particle_t* ipart, - int* nvert, float ubuf[], int* nubuf); - -void grndm_(float v[], int* len); - -/* convenience interface function for gmtod_ and gdtom_ */ - -#define transformCoord(xin,sin,xout,sout) \ - transformcoord_(xin,sin,xout,sout,strlen(sin),strlen(sout)) - - -/* Type declarations to avoid "implicit function declaration" errors */ -void transformcoord_(float* xin, char* sin, float* xout, char* sout, int, int); -int getsector_(void); -int getlayer_(void); -int getmodule_(void); -int getrow_(void); -int getcolumn_(void); -int getplane_(void); -int getring_(void); diff --git a/src/programs/Simulation/gxtwist/getwebfile.c b/src/programs/Simulation/gxtwist/getwebfile.c deleted file mode 100644 index 27f21c1047..0000000000 --- a/src/programs/Simulation/gxtwist/getwebfile.c +++ /dev/null @@ -1,124 +0,0 @@ - -#include -#include -#include -#include - -static int getwebfile_printprogress(void *clientp, double dltotal, double dlnow, double ultotal, double ulnow); - -/*---------------- -/* getwebfile -/*----------------*/ -int getwebfile(const char *url) -{ - FILE *f; - CURL *curl; - int ungzip = 0; - - /* Check if file is already here */ - const char *fname = url; - const char *ptr; - do{ - ptr = strstr(fname, "/"); - if(ptr)fname=&ptr[1]; - }while(ptr!=NULL); - f = fopen(fname,"r"); - if(f){ - /* File already exists. Do nothing. */ - fclose(f); - printf("Using local file \"%s\"\n", fname); - }else{ - /* File does not exist. Try downloading. */ - printf("No local file: \"%s\".\nAttempting download from %s \n", fname, url); - - /* This should be done globally when there is only one thread */ - curl_global_init(CURL_GLOBAL_ALL); - - /* File does not exist. Try obtaining from URL */ - curl = curl_easy_init(); - - /* Setup the options for the download */ - f = fopen(fname,"w"); - curl_easy_setopt(curl, CURLOPT_VERBOSE, 0); - curl_easy_setopt(curl, CURLOPT_URL, url); - curl_easy_setopt(curl, CURLOPT_WRITEDATA, f); - curl_easy_setopt(curl, CURLOPT_NOPROGRESS, 0); - curl_easy_setopt(curl, CURLOPT_PROGRESSFUNCTION, getwebfile_printprogress); - - /* Download the file */ - curl_easy_perform(curl); - - /* Close CURL */ - curl_easy_cleanup(curl); - - /* Close the downloaded file */ - printf("\n"); - fclose(f); - - /* This should be done at program exit when there is only one thread */ - curl_global_cleanup(); - - /* Set flag to automatically ungzip if this is a gzipped file */ - ungzip = 1; - } - - /* If the file is gzipped (and has a .gz suffix) then unzip it */ - if(strlen(fname)>3 && !strcmp(&fname[strlen(fname)-3], ".gz")){ - char *uncompressed_fname = strdup(fname); - char cmd[256]; - - uncompressed_fname[strlen(uncompressed_fname)-3] = 0; /* cut off ".gz" suffix */ - - /* Check if the uncompressed file already exists. Only uncompress if either */ - /* it doesn't exist or was just now (re)downloaded. */ - f = fopen(uncompressed_fname,"r"); - if(!f){ - ungzip = 1; - }else{ - if(ungzip){ - printf("Un-gzipped version (\"%s\") already exists. Overwriting with\n", uncompressed_fname); - printf("file just downloaded (\"%s\")\n", fname); - }else{ - printf("Using existing un-gzipped file \"%s\"\n", uncompressed_fname); - } - fclose(f); - } - - /* Ungzip the file, explicitly giving it's uncompressed filename */ - if(ungzip){ - sprintf(cmd, "gzip -cd %s > %s", fname, uncompressed_fname); - printf("The file \"%s\" appears to be gzipped. Attempting to uncompress with:\n", fname); - printf(" %s\n", cmd); - system(cmd); - } - - /* free memory allocated for uncompressed filename */ - free(uncompressed_fname); - } - - return 0; -} - -/*---------------- -/* getwebfile_printprogress -/*----------------*/ -int getwebfile_printprogress(void *clientp, double dltotal, double dlnow, double ultotal, double ulnow) -{ - printf(" %dkB \r", (unsigned long)(dlnow/1024.0)); - fflush(stdout); -} - - -#if 0 -/* For testing */ -int _main(int narg, char *argv[]) -{ - - const char *url = "http://zeus.phys.uconn.edu/halld/tagger/simulation/taggerBfield-quad-map.gz"; - - getwebfile(url); - - return 0; -} -#endif - diff --git a/src/programs/Simulation/gxtwist/gltrac.F b/src/programs/Simulation/gxtwist/gltrac.F deleted file mode 100644 index 7fc7211ce9..0000000000 --- a/src/programs/Simulation/gxtwist/gltrac.F +++ /dev/null @@ -1,241 +0,0 @@ -* -* $Id: gltrac.F,v 1.1 2006/04/15 04:38:38 jonesrt Exp $ -* -* $Log: gltrac.F,v $ -* Revision 1.1 2006/04/15 04:38:38 jonesrt -* gltrac.F, gsstak.F -* - replacements for geant321 library functions that enable stacking of -* secondaries with repeat counts and saving of ISTORY on the stack, -* both for the purposes of enabling cascaded simulations. [rtj] -* gustep.F -* - new code to support electron beam dump simulations with a two-level -* cascade to enhance the statistics of dump-related backgrounds. [rtj] -* taggerCoords2.xls -* - updates to the dimensions of the building and electron beam dump. [rtj] -* hdds/Spectrometer.xml, hdds/TaggerArea.xml -* - new geometry description including the electron beam dump attached -* by a corridor to the tagger building. [rtj] -* hdds/Makefile hdds/ElectronDump.xml -* - added new document to describe the electron beam dump geometry [rtj] -* gxtwist, gxtwist++, hdgeant [deleted] -* - binary files removed from repository [rtj] -* -* Revision 1.1.1.1 1995/10/24 10:21:41 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 13/12/94 15.36.22 by S.Giani -*-- Author : - SUBROUTINE GLTRAC -C. -C. ****************************************************************** -C. * * -C. * SUBR. GLTRAC * -C. * * -C. * Extracts next track from stack JSTAK and prepares commons * -C. * /GCTRAK/, /GCKINE/ and /GCVOLU/ * -C. * * -C. * Called by : GTREVE * -C. * Authors : R.Brun, F.Bruyant * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gcnum.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcvolu.inc" - DIMENSION RNDM(5) -#if !defined(CERNLIB_SINGLE) - DOUBLE PRECISION P2,GETOTD,GEKIND - DOUBLE PRECISION PXD,PYD,PZD,ONE,HNORM,DAMASS,PP -#endif - PARAMETER (ONE=1) -C. -C. ------------------------------------------------------------------ - -*** Modification introduced March 26, 2006 -*** There is a "user word" UPWGHT that is associated with each particle -*** on the temporary stack. In the standard usage this word is a priority -*** that is used to select the order in which particles are tracked, in -*** conjunction with the SORD control card. In this modification I change -*** the meaning of UPWGHT to represent a repeat count for the stacked -*** particle. That is, each time a particle is retrieved from the stack -*** its value of UPWGHT on the stack is decremented and it is removed from -*** the stack only when its UPWGHT reaches zero. This behaviour is useful -*** in implementing an importance sampling scheme. Note that the default -*** value of UPWGHT is 1 so this modification has no effect unless user -*** code in gustep() or elsewhere overwrites its value. The SORD card -*** will have no effect if USE_UPWGHT_AS_REPEAT_COUNT is in effect. -*** richard.t.jones@uconn.edu - -* -* *** Extract next track from stack JSTAK -* -#ifndef USE_UPWGHT_AS_REPEAT_COUNT - IF(ISTORD.EQ.1) THEN -* -* *** User ordering of tracks if requested - CALL GSTORD - ENDIF -#endif - ISTAK = IQ(JSTAK+1) - IQ(JSTAK+1) = ISTAK -1 - JST = JSTAK +NWSTAK*IQ(JSTAK+1) +3 -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - IF (Q(JST+12).GT.1) THEN - IQ(JSTAK+1) = ISTAK - ENDIF -#endif - ITRA = IQ(JST+1) - IF (ITRA.LT.0) THEN - ITRA = -ITRA - ELSE -* -* This is a new track. We set to zero the stack number and -* update the vertex number - ISTAK = 0 - JK=LQ(JKINE-ITRA) - IVERT=Q(JK+6) - ENDIF - IPART = IQ(JST+2) - DO 60 I = 1,3 - VERT(I) = Q(JST+3+I) - PVERT(I) = Q(JST+6+I) - 60 CONTINUE - TOFG = Q(JST+10) - SAFETY = Q(JST+11) - UPWGHT = Q(JST+12) -#ifdef USE_UPWGHT_AS_REPEAT_COUNT -* print *, 'pop stacked track',istak,', copy',int(Q(JST+12)), -* + ', generation',IQ(JST+3) - Q(JST+12) = Q(JST+12)-1 - UPWGHT = 1 -#endif -* -* *** Prepare tracking parameters -* - VECT(1) = VERT(1) - VECT(2) = VERT(2) - VECT(3) = VERT(3) - PXD = PVERT(1) - PYD = PVERT(2) - PZD = PVERT(3) - P2 = PXD**2+PYD**2+PZD**2 - IF(P2.GT.0.) THEN - PP = SQRT(P2) - HNORM = ONE/PP - VECT(4) = PVERT(1)*HNORM - VECT(5) = PVERT(2)*HNORM - VECT(6) = PVERT(3)*HNORM - VECT(7) = PP - ELSE - VECT(4) = 0. - VECT(5) = 0. - VECT(6) = 1. - VECT(7) = 0. - ENDIF -* -* ** Reload Particle characteristics, if needed -* - IF (IPART.NE.IPAOLD) THEN - JPA = LQ(JPART-IPART) - DO 90 I = 1,5 - NAPART(I) = IQ(JPA+I) - 90 CONTINUE - ITRTYP = Q(JPA+6) - AMASS = Q(JPA+7) - CHARGE = Q(JPA+8) - TLIFE = Q(JPA+9) - IUPD = 0 - IPAOLD = IPART - ENDIF -* - DAMASS = AMASS - GETOTD = SQRT(P2+DAMASS**2) - GEKIND = GETOTD - DAMASS - GETOT = GETOTD - GEKIN = GEKIND -* - IF (ITRTYP.EQ.7) THEN -* -* *** Cerenkov photon. Retrieve polarisation - JPO = LQ(JSTAK-1)+(ISTAK-1)*3 - POLAR(1) = Q(JPO+1) - POLAR(2) = Q(JPO+2) - POLAR(3) = Q(JPO+3) - ELSE - CALL GEKBIN - ENDIF -* - SLENG = 0. - NSTEP = 0 - NTMSTO = NTMSTO +1 - NTMULT = NTMSTO -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - ISTORY = IQ(JST+3) -#else - ISTORY = 0 -#endif -* -* ** Initialize interaction probabilities -* - IF (ITRTYP.EQ.1) THEN -* Gammas - CALL GRNDM(RNDM,5) - ZINTPA = -LOG(RNDM(1)) - ZINTCO = -LOG(RNDM(2)) - ZINTPH = -LOG(RNDM(3)) - ZINTPF = -LOG(RNDM(4)) - ZINTRA = -LOG(RNDM(5)) - ELSE IF (ITRTYP.EQ.2) THEN -* Electrons - CALL GRNDM(RNDM,3) - ZINTBR = -LOG(RNDM(1)) - ZINTDR = -LOG(RNDM(2)) - ZINTAN = -LOG(RNDM(3)) - ELSE IF (ITRTYP.EQ.3) THEN -* Neutral hadrons - CALL GRNDM(RNDM,2) - SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1)) - ZINTHA = -LOG(RNDM(2)) - ELSE IF (ITRTYP.EQ.4) THEN -* Charged hadrons - CALL GRNDM(RNDM,3) - SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1)) - ZINTHA = -LOG(RNDM(2)) - ZINTDR = -LOG(RNDM(3)) - ELSE IF (ITRTYP.EQ.5) THEN -* Muons - CALL GRNDM(RNDM,5) - SUMLIF = -CLIGHT*TLIFE*LOG(RNDM(1)) - ZINTBR = -LOG(RNDM(2)) - ZINTPA = -LOG(RNDM(3)) - ZINTDR = -LOG(RNDM(4)) - ZINTMU = -LOG(RNDM(5)) - ELSE IF (ITRTYP.EQ.7) THEN -* Cerenkov photons - CALL GRNDM(RNDM,1) - ZINTLA = -LOG(RNDM(1)) - ELSE IF (ITRTYP.EQ.8) THEN -* Ions - CALL GRNDM(RNDM,2) - ZINTHA = -LOG(RNDM(1)) - ZINTDR = -LOG(RNDM(2)) - ENDIF -* -* * Prepare common /GCVOLU/ and structure JGPAR, if needed -* - IF (NJTMAX.LE.0) THEN - IF (GONLY(NLEVEL).EQ.0.) NLEVEL=0 - CALL GMEDIA (VECT, NUMED) - ENDIF - INFROM = 0 -* END GLTRAC - END - diff --git a/src/programs/Simulation/gxtwist/goptimize.F b/src/programs/Simulation/gxtwist/goptimize.F deleted file mode 100644 index 94bb26c874..0000000000 --- a/src/programs/Simulation/gxtwist/goptimize.F +++ /dev/null @@ -1,27 +0,0 @@ -* -* Goptimize - do any Geant3 geometry/tracking optimizations -* -* The actual definitions of the materials, tracking media and volume -* tree are found in the file hddsGeant3.f which is generated automatically -* from the HDDS xml geometry database by the translator hdds-geant. -* -* NOTE: It is tempting to put Geant geometry and tracking optimization -* commands into hddsGeant3.f at the point where the geometry is -* being defined. DO NOT DO THAT. Put them here in this file. -* -* This routine is part of the HDGeant simulation package -* -* Author: Richard Jones -* University of Connecticut -* July 5, 2001 -*------------------------------------ - - subroutine Goptimize - -c User optimizations go here -c such as: gsnext, gunear, gsord, -c tracking medium parameter modifications, -c graphical attributes of volumes, -c etc... - - end diff --git a/src/programs/Simulation/gxtwist/gpairg.F b/src/programs/Simulation/gxtwist/gpairg.F deleted file mode 100644 index 50dbea0ef2..0000000000 --- a/src/programs/Simulation/gxtwist/gpairg.F +++ /dev/null @@ -1,328 +0,0 @@ -*---------------------------------------------------------------- -* Modified by R.T. Jones, C.S. Gauthier to include Bethe-Heitler -* muon-pair production by photons, weighted by (emmu/emass)**2 -* for purposes of photon beam collimator simulation. -* -* Chris.S.Gauthier@uconn.edu -* Richard.T.Jones@uconn.edu -* Hall D Collaboration -* June 25, 2002 -*---------------------------------------------------------------- -* -* $Id: gpairg.F,v 1.1 2006/04/15 04:38:38 jonesrt Exp $ -* -* $Log: gpairg.F,v $ -* Revision 1.1 2006/04/15 04:38:38 jonesrt -* gltrac.F, gsstak.F -* - replacements for geant321 library functions that enable stacking of -* secondaries with repeat counts and saving of ISTORY on the stack, -* both for the purposes of enabling cascaded simulations. [rtj] -* gustep.F -* - new code to support electron beam dump simulations with a two-level -* cascade to enhance the statistics of dump-related backgrounds. [rtj] -* taggerCoords2.xls -* - updates to the dimensions of the building and electron beam dump. [rtj] -* hdds/Spectrometer.xml, hdds/TaggerArea.xml -* - new geometry description including the electron beam dump attached -* by a corridor to the tagger building. [rtj] -* hdds/Makefile hdds/ElectronDump.xml -* - added new document to describe the electron beam dump geometry [rtj] -* gxtwist, gxtwist++, hdgeant [deleted] -* - binary files removed from repository [rtj] -* -* Revision 1.2 2002/07/10 14:57:18 jonesrt -* - fixed wierd problem with g77 compiler that wanted to interpret "slash star" -* in a fortran comment line as a comment indicator a-la-c (complained about -* unterminated comment) so I just removed the asterisk - rtj. -* - corrected the statistics printout from gelh_last() -rtj. -* - changed confusing use of VSCAN (card SCAP) to define the origin for single -* particle generation; now gukine.F uses PKINE (card KINE) for both origin -* and direction of single-particle generator, with the following format: -* KINE kind energy theta phi vertex(1) vertex(2) vertex(3) -* - fixed gelh_outp() to remove the BaBar-dependent code so that it correctly -* updates the photo-hadronic statistics that get reported at gelh_last() -rtj. -* - updated gelhad/Makefile to follow the above changes -rtj. -* -* Revision 1.1 2002/06/28 19:01:03 jonesrt -* Major revision 1.1 -Richard Jones, Chris Gauthier, University of Connecticut -* -* 1. Added hadronic interactions for photons with the Gelhad package -* http://www.slac.stanford.edu/BFROOT/www/Computing/Offline/Simulation/gelhad.html -* Routines affected are: -* - uginit.F : added new card GELH to set up gelhad parameters and -* call to gelh_vrfy() to print out their values. -* - uglast.F : added call to gelh_last() to print out summary info. -* - gtgama.F : Gelhad replacement for standard Geant routine that adds -* simulation of hadronic photoproduction processes. -* - gelhad/ : contains a number of new functions (Fortran) and includes -* to support the hadronic photoproduction simulation. -* -* 2. Added muon-pair production by stealing every (Melectron/Mmuon)**2 pair -* production events and trying to convert to muon pairs. The deficit in -* e+/e- events resulting from this theft is negligible. The angular -* distribution of muon pairs is generated using the general Geant method -* in gpairg.F with the electron mass replaced by the muon mass. -* Routines affected are: -* - gpairg.F : added a switch to replace e+/e- with mu+/mu- in a small -* fraction of the pair-production vertices. -* -* Revision 1.5 1998/02/09 15:59:47 japost -* Fixed a problem on AIX 4 xlf, caused by max(double,float). -* -* Revision 1.4 1998/02/06 16:46:57 japost -* Fix a wrong parenthesis. -* -* Revision 1.3 1998/02/06 16:22:24 japost -* Protected a square root from a negative argument. -* This root was added there in previous changes, and not deleted from its -* old position. In its old position it was protected from being negative, but in -* its new position it was not. -* -* Deleted the same square root from its old position, as it was redundant. -* -* Revision 1.2 1996/03/13 12:03:24 ravndal -* Tranverse momentum conservation -* -* Revision 1.1.1.1 1995/10/24 10:21:28 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 21/02/95 11.53.59 by S.Giani -*-- Author : -#if defined(CERNLIB_HPUX) -$OPTIMIZE OFF -#endif - SUBROUTINE GPAIRG -C. -C. ****************************************************************** -C. * * -C. * Simulates e+e- pair production by photons. * -C. * * -C. * The secondary electron energies are sampled using the * -C. * Coulomb corrected BETHE-HEITLER cross-sections.For this the * -C. * modified version of the random number techniques of * -C. * BUTCHER and MESSEL (NUCL.PHYS,20(1960),15) are employed. * -C. * * -C. * NOTE : * -C. * (1) Effects due to the breakdown of the BORN approximation at * -C. * low energies are ignored. * -C. * (2) The differential cross-section implicitly takes account * -C. * of pair production in both nuclear and atomic electron * -C. * fields. However, triplet production is not generated. * -C. * * -C. * ==>Called by : GTGAMA * -C. * Authors G.Patrick, L.Urban ********* * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gconsp.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcking.inc" -#include "geant321/gcphys.inc" -#include "geant321/gccuts.inc" - - DIMENSION NTYPEL(2) - DIMENSION RNDM(2) - LOGICAL ROTATE - PARAMETER (ONE=1,ONETHR=ONE/3,EMAS2=2*EMASS) -c -c Here we take over the standard Geant3 e+e- pair production cross section -c as a good approximation to the total l+l- lepton pair production cross -c section. The only change is to convert a fraction (emmu/emass)**2 from -c electron to muon pairs, if allowed by energy conservation. -c - real xsratio - parameter (xsratio=(emass/emmu)**2) - real mlepton - integer lepton - call grndm(rndm,1) - if (rndm(1).lt.xsratio) then - lepton = 5 - mlepton = EMMU - else - lepton = 2 - mlepton = EMASS - endif -C. -C. ------------------------------------------------------------------ -C. -C If not enough energy : no pair production -C - EGAM = VECT(7) - IF (EGAM.LT.mlepton*2) GO TO 999 -C - KCASE = NAMEC(6) - IF(IPAIR.NE.1) THEN - ISTOP = 2 - NGKINE = 0 - DESTEP = DESTEP + EGAM - VECT(7)= 0. - GEKIN = 0. - GETOT = 0. - GO TO 999 - ENDIF -C -C For low energy photons approximate the electron energy by -C sampling from a uniform distribution in the interval -C EMASS -> EGAM/2. -C - IF (EGAM.LE.mlepton*4)THEN - CALL GRNDM(RNDM,1) - EEL1 = mlepton + (RNDM(1)*(0.5*EGAM - mlepton)) - X=EEL1/EGAM - GO TO 20 - ENDIF -C - Z3=Q(JPROB+2) - F=8.*Q(JPROB+3) - IF(EGAM.GT.mlepton*10) F=F+8.*Q(JPROB+4) - X0=mlepton/EGAM - DX=0.5-X0 - DMIN=544.*X0/Z3 - DMIN2=DMIN*DMIN - IF(DMIN.LE.1.)THEN - F10=42.392-7.796*DMIN+1.961*DMIN2-F - F20=41.405-5.828*DMIN+0.8945*DMIN2-F - ELSE - F10=42.24-8.368*LOG(DMIN+0.952)-F - F20=F10 - ENDIF -C -C Calculate limit for screening variable,DELTA, to ensure -C that screening rejection functions always remain -C positive. -C - DMAX=EXP((42.24-F)/8.368)-0.952 -C -C Differential cross-section factors which form -C the coefficients of the screening functions. -C - DSIG1=DX*DX*F10/3. - DSIG2=0.5*F20 - BPAR = DSIG1 / (DSIG1 + DSIG2) -C -C Decide which screening rejection function to use and -C sample the electron/photon fractional energy BR. -C - 10 CALL GRNDM(RNDM,2) - IF(RNDM(1).LT.BPAR)THEN - X=0.5-DX*RNDM(2)**ONETHR - IREJ=1 - ELSE - X=X0+DX*RNDM(2) - IREJ = 2 - ENDIF -C -C Calculate DELTA ensuring positivity. -C - D=0.25*DMIN/(X*(1.-X)) - IF(D.GE.DMAX) GOTO 10 - D2=D*D -C -C Calculate F1 and F2 functions using approximations. -C F10 and F20 are the F1 and F2 functions calculated for the -C DELTA=DELTA minimum. -C - IF(D.LE.1.)THEN - F1=42.392-7.796*D+1.961*D2-F - F2=41.405-5.828*D+0.8945*D2-F - ELSE - F1=42.24-8.368*LOG(D+0.952)-F - F2=F1 - ENDIF - IF(IREJ.NE.2)THEN - SCREJ=F1/F10 - ELSE - SCREJ=F2/F20 - ENDIF -C -C Accept or reject on basis of random variate. -C - CALL GRNDM(RNDM,1) - IF(RNDM(1).GT.SCREJ) GOTO 10 - EEL1=X*EGAM -C -C Successful sampling of first electron energy. -C -C Select charges randomly. -C - 20 NTYPEL(1) = lepton - CALL GRNDM(RNDM,2) - IF (RNDM(1).GT.0.5) NTYPEL(1) = lepton+1 - NTYPEL(2) = 2*lepton+1 - NTYPEL(1) -C -C Generate electron decay angles with respect to a Z-axis -C defined along the parent photon. -C PHI is generated isotropically and THETA is assigned -C a universal angular distribution -C - EMASS1 = mlepton - THETA = GBTETH(EEL1, EMASS1, X)*mlepton/EEL1 - SINTH = SIN(THETA) - COSTH = COS(THETA) - PHI = TWOPI*RNDM(2) - COSPHI = COS(PHI) - SINPHI = SIN(PHI) - -C -C Rotate tracks into GEANT system -C - CALL GFANG(VECT(4),COSAL,SINAL,COSBT,SINBT,ROTATE) -C -C Polar co-ordinates to momentum components. -C - NGKINE = 0 - TEL1 = EEL1 - mlepton - PEL1 = SQRT(MAX((EEL1+REAL(mlepton))*TEL1,0.)) - IF(TEL1.GT.CUTELE) THEN - NGKINE = NGKINE + 1 - GKIN(1,NGKINE) = PEL1 * SINTH * COSPHI - GKIN(2,NGKINE) = PEL1 * SINTH * SINPHI - GKIN(3,NGKINE) = PEL1 * COSTH - GKIN(4,NGKINE) = EEL1 - GKIN(5,NGKINE) = NTYPEL(1) - TOFD(NGKINE)=0. - GPOS(1,NGKINE) = VECT(1) - GPOS(2,NGKINE) = VECT(2) - GPOS(3,NGKINE) = VECT(3) - IF(ROTATE) - + CALL GDROT(GKIN(1,NGKINE),COSAL,SINAL,COSBT,SINBT) - ELSE - DESTEP = DESTEP + TEL1 - IF(NTYPEL(1).EQ.2) CALL GANNI2 - ENDIF -C -C Momentum vector of second electron. Recoil momentum of -C target nucleus/electron ignored. -C - EEL2=EGAM-EEL1 - TEL2=EEL2-mlepton - IF(TEL2.GT.CUTELE) THEN - PEL2 = SQRT((EEL2+mlepton)*TEL2) - NGKINE = NGKINE + 1 - SINTH=SINTH*PEL1/PEL2 - COSTH=SQRT(MAX(0.,1.-SINTH**2)) - GKIN(1,NGKINE)=-PEL2*SINTH*COSPHI - GKIN(2,NGKINE)=-PEL2*SINTH*SINPHI - GKIN(3,NGKINE)=PEL2*COSTH - GKIN(4,NGKINE)=EEL2 - GKIN(5,NGKINE) = NTYPEL(2) - TOFD(NGKINE)=0. - GPOS(1,NGKINE) = VECT(1) - GPOS(2,NGKINE) = VECT(2) - GPOS(3,NGKINE) = VECT(3) - IF(ROTATE) - + CALL GDROT(GKIN(1,NGKINE),COSAL,SINAL,COSBT,SINBT) - ELSE - DESTEP = DESTEP + TEL2 - IF(NTYPEL(2).EQ.2) CALL GANNI2 - ENDIF - ISTOP = 1 - IF(NGKINE.EQ.0) ISTOP = 2 - 999 END -#if defined(CERNLIB_HPUX) -$OPTIMIZE ON -#endif diff --git a/src/programs/Simulation/gxtwist/gsstak.F b/src/programs/Simulation/gxtwist/gsstak.F deleted file mode 100644 index b600909209..0000000000 --- a/src/programs/Simulation/gxtwist/gsstak.F +++ /dev/null @@ -1,138 +0,0 @@ -* -* $Id: gsstak.F,v 1.1 2006/04/15 04:38:38 jonesrt Exp $ -* -* $Log: gsstak.F,v $ -* Revision 1.1 2006/04/15 04:38:38 jonesrt -* gltrac.F, gsstak.F -* - replacements for geant321 library functions that enable stacking of -* secondaries with repeat counts and saving of ISTORY on the stack, -* both for the purposes of enabling cascaded simulations. [rtj] -* gustep.F -* - new code to support electron beam dump simulations with a two-level -* cascade to enhance the statistics of dump-related backgrounds. [rtj] -* taggerCoords2.xls -* - updates to the dimensions of the building and electron beam dump. [rtj] -* hdds/Spectrometer.xml, hdds/TaggerArea.xml -* - new geometry description including the electron beam dump attached -* by a corridor to the tagger building. [rtj] -* hdds/Makefile hdds/ElectronDump.xml -* - added new document to describe the electron beam dump geometry [rtj] -* gxtwist, gxtwist++, hdgeant [deleted] -* - binary files removed from repository [rtj] -* -* Revision 1.1.1.1 1995/10/24 10:21:43 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.23 by S.Giani -*-- Author : - SUBROUTINE GSSTAK (IFLAG) -C. -C. ****************************************************************** -C. * * -C. * SUBR. GSSTAK (IFLAG) * -C. * * -C. * Stores in auxiliary stack JSTAK the particle currently * -C. * described in common /GCKINE/. * -C. * * -C. * On request, creates also an entry in structure JKINE : * -C. * IFLAG = * -C. * 0 : No entry in JKINE structure required (user) * -C. * 1 : New entry in JVERTX / JKINE structures required (user) * -C. * <0 : New entry in JKINE structure at vertex -IFLAG (user) * -C. * 2 : Entry in JKINE structure exists already (from GTREVE) * -C. * * -C. * Called by : GSKING, GTREVE * -C. * Author : S.Banerjee, F.Bruyant * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gckine.inc" -#include "geant321/gcjloc.inc" -#include "geant321/gcmzfo.inc" -#include "geant321/gcnum.inc" -#include "geant321/gcstak.inc" -#include "geant321/gctrak.inc" -#if defined(CERNLIB_USRJMP) -#include "geant321/gcjump.inc" -#endif -* - COMMON/VTXKIN/NVTX,ITR - DIMENSION UBUF(1) - DATA UBUF/0./ -C. -C. ------------------------------------------------------------------ -* - IF (IPART.LE.0.OR.IPART.GT.NPART) THEN - PRINT *, ' GSSTAK - Unknown particle code, skip track ', IPART - GO TO 999 - ENDIF -* -* *** Give control to user for track selection -* -#if !defined(CERNLIB_USRJMP) - CALL GUSKIP(ISKIP) -#endif -#if defined(CERNLIB_USRJMP) - CALL JUMPT1(JUSKIP,ISKIP) -#endif - IF (ISKIP.NE.0) GO TO 999 -* -* *** Check if an entry in JKINE structure is required -* - IF (IFLAG.EQ.1) THEN - CALL GSVERT (VERT, ITRA, 0, UBUF, 0, NVTX) - CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR) - ELSE IF (IFLAG.LT.0) THEN - NVTX = -IFLAG - CALL GSKINE (PVERT, IPART, NVTX, UBUF, 0, ITR) - ELSE - IF (IFLAG.EQ.0) THEN -* Store -ITRA in stack for a track without entry in JKINE - ITR = -ITRA - ELSE - ITR = ITRA - ENDIF - ENDIF -* -* *** Store information in stack -* - IF (JSTAK.EQ.0) THEN - NDBOOK = NTSTKP*NWSTAK +3 - NDPUSH = NTSTKS*NWSTAK - CALL MZBOOK (IXCONS,JSTAK,JSTAK,1,'STAK', 0,0,NDBOOK, IOSTAK,3) - IQ(JSTAK+2) = NTSTKP - ELSE IF (IQ(JSTAK+1).EQ.IQ(JSTAK+2)) THEN - CALL MZPUSH (IXCONS, JSTAK, 0, NDPUSH, 'I') - IQ(JSTAK+2) = IQ(JSTAK+2) +NTSTKS - ENDIF -* - JST = JSTAK +IQ(JSTAK+1)*NWSTAK +3 - IQ(JSTAK+1) = IQ(JSTAK+1) +1 - IF (IQ(JSTAK+3).EQ.0) IQ(JSTAK+3) = IQ(JSTAK+1) - IF (IQ(JSTAK+1).GT.NSTMAX) NSTMAX = IQ(JSTAK+1) -* - IQ(JST+1) = ITR - IQ(JST+2) = IPART -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - IQ(JST+3) = ISTORY -#else - IQ(JST+3) = 0 -#endif - DO 90 I = 1,3 - Q(JST+3+I) = VERT(I) - Q(JST+6+I) = PVERT(I) - 90 CONTINUE - Q(JST+10) = TOFG - Q(JST+11) = SAFETY - Q(JST+12) = UPWGHT -* -#ifdef USE_UPWGHT_AS_REPEAT_COUNT - NALIVE = NALIVE + UPWGHT -#else - NALIVE = NALIVE +1 -#endif -* END GSSTAK - 999 END diff --git a/src/programs/Simulation/gxtwist/guhadr.F b/src/programs/Simulation/gxtwist/guhadr.F deleted file mode 100644 index 59affb04a0..0000000000 --- a/src/programs/Simulation/gxtwist/guhadr.F +++ /dev/null @@ -1,136 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.2 2001/07/15 07:31:36 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:46 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:46 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/03 07/10/94 18.41.50 by S.Giani -*-- Author : - SUBROUTINE GUHADR -C. -C. ****************************************************************** -C. * * -C. * User routine to generate one hadronic interaction * -C. * * -C. * ==>Called by : GTHADR,GTNEUT * -C. * * -C. ****************************************************************** -C. -*======================================================================* -* * -* An interface with a part of the FLUKA shower code is available in * -* GEANT 3.21. The following conditions and warnings must be taken * -* into account when using the FLUKA routines. * -* * -*======================================================================* -*======================================================================* -* * -* FFFF L U U K K AA * -* F L U U K K A A * -* FFF L U U KK AAAA * -* F L U U K K A A * -* F LLLL UU K K A A * -* * -* (C) Copyright of the authors * -* * -* A. Fasso'*, A. Ferrari#, J. Ranft$, P.R. Sala# * -* * -* *: CERN, #: INFN -Milan, $: CERN/Frascati * -* * -* (e-mail: FERRARIA@CERNVM.CERN.CH) * -* * -*======================================================================* -* * -* - All the rights concerning FLUKA or parts of it are only of the * -* authors and are independent from those of the GEANT code * -* * -* - FLUKA [1-6] is a standalone code capable of simulating the inter-* -* action and transport of all components of EM and hadronic cas- * -* cades up to several TeV. However, only cross sections and * -* models for hadronic elastic and inelastic interactions (end 1992 * -* status) are included in this GEANT version. * -* * -* - The most recent FLUKA model [4,6] for nucleon and pion interac- * -* tions in the intermediate energy range is not fully implemented * -* in GEANT. Only a simplified version, limited to p and n below * -* 250 MeV, is available in GEANT 3.21. A coarser model is used for * -* other projectiles in this energy range. However the implemented * -* parts should be adequate for most detector simulations and sim- * -* ilar applications for which GEANT is generally used. Their accu- * -* racy could be insufficient for some nuclear physics studies or * -* demanding simulations at low energies, where the more sophistic- * -* ated models [4,6] could be required. * -* * -* - The performances of GEANT-FLUKA are therefore not representative * -* of those of FLUKA standalone and should be referenced as such * -* rather than simply GEANT or FLUKA. * -* * -* - The authors reserve the right of publishing about the physical * -* models developed for FLUKA. Running the FLUKA routines in isol- * -* ation for benchmarks (or equivalent use) is not permitted, * -* except after consultations or in collaboration with the authors. * -* * -* - The FLUKA routines are supposed to be included and used in * -* GEANT only. Any other use must be authorized by the authors. * -* * -* - References: at least reference [5] should be always quoted when * -* reporting results obtained with GEANT-FLUKA * -* * -* [1] A. Fasso', A. Ferrari, J. Ranft, P. R. Sala, G. R. Stevenson and * -* J. M. Zazula, "FLUKA92", presented at the workshop on "Simulat- * -* ing Accelerator Radiation Environment", SARE, Santa Fe, 11-15 * -* january (1993), Proceedings in press. * -* * -* [2] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, Proc. MC93 Int. Conf. * -* on Monte-Carlo Simulation in High-Energy and Nuclear Physics, * -* Tallahassee, Florida, 22-26 february (1993), World Scientific, * -* p. 88 (1994). * -* * -* [3] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, ibidem, p. 100 (1994) * -* * -* [4] A. Ferrari and P.R. Sala, ibidem, p. 277 (1994). * -* * -* [5] A. Fasso', A. Ferrari, J. Ranft and P.R. Sala, "FLUKA: present * -* status and future developments", presented at the IV Int. Conf. * -* on Calorimetry in High Energy Physics, La Biodola (Elba), * -* September 19-25 1993, Proceedings in press. * -* * -* [6] A. Fasso', A. Ferrari, J. Ranft, and P.R. Sala, "FLUKA: Perf- * -* ormances and Applications in the Intermediate Energy Range", * -* presented at the "Specialists' Meeting on Shielding Aspects of * -* Accelerators, Targets & Irradiation Facilities", Arlington, * -* April 28-29 1994, Proceedings in press. * -* * -*======================================================================* -C -#include "geant321/gcphys.inc" -C. -C. ------------------------------------------------------------------ -C. -C GHEISHA only if IHADR<3 (default) -C FLUKA (with GHEISHA for neutrons below 20MeV) if IHADR=3 -C FLUKA (with MICAP for neutrons below 20MEV) if IHADR>3 -C - IF (IHADR.LT.3) THEN - CALL GHEISH - ELSE IF (IHADR.EQ.3) THEN - CALL FLUFIN - ELSE - CALL GFMFIN - ENDIF - END diff --git a/src/programs/Simulation/gxtwist/gukine.F b/src/programs/Simulation/gxtwist/gukine.F deleted file mode 100644 index d536c99172..0000000000 --- a/src/programs/Simulation/gxtwist/gukine.F +++ /dev/null @@ -1,168 +0,0 @@ -* -* $Id$ -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* - -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUKINE -* -************************************************************************ -* * -* Generates Kinematics for primary tracks * -* * -************************************************************************ -* -#include "geant321/gcunit.inc" -#include "geant321/gcflag.inc" -#include "geant321/gckine.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcscan.inc" -#include "geant321/gcomis.inc" -#include "cobrems.inc" -#include "halo.inc" -* - DIMENSION VERTEX(4),PLAB(5) - DIMENSION RNDM(20) - -#if 0 - real tgen - real unif01(100) - integer i,j - character*20 pname - integer nubuf - real ubuf(99) -#endif - - integer idhalo - parameter (idhalo=9876) - real haloxy - external haloxy - logical hexist - external hexist -* -* ----------------------------------------------------------------- -* - UPWGHT = 1 - ISTORY = 0 - - ev = IDEVT - do i=1,10 - ev = ev/10. - if (ev.lt.10) goto 2 - enddo - 2 if (int(ev).eq.ev) then - write(LOUT,*) IDEVT," events simulated" - endif -* -* Try input from MonteCarlo generator first -* - itry = nextInput() - if (itry .eq. 0) then - itry = loadInput() - elseif (itry .ne. 9) then - ieorun = 1 - ieotri = 1 - return -* -* Try coherent bremsstrahlung beam generation next -* - elseif (E.gt.0) then - call beamgen(0.) - call storeInput(IDRUN,IDEVT,1); -* -* If all else fails, do automatic single-track generation -* - else - TOFG=0 - VERTEX(1)=VSCAN(1) - VERTEX(2)=VSCAN(2) - VERTEX(3)=VSCAN(3) - IF (IKINE.GT.100) THEN - IK=IKINE-100 - CALL GRNDM(RNDM,3) - PABS=PKINE(1)+PKINE(4)*(RNDM(1)-0.5) - THETA=(PKINE(2)+PKINE(5)*(RNDM(2)-0.5))*DEGRAD - PHI=(PKINE(3)+PKINE(6)*(RNDM(3)-0.5))*DEGRAD - ELSE - IK=IKINE - CALL GRNDM(RNDM,2) - PABS=PKINE(1) - THETA=PI*RNDM(1) - PHI=TWOPI*RNDM(2) - ENDIF - PLAB(1) = PABS*SIN(THETA)*COS(PHI) - PLAB(2) = PABS*SIN(THETA)*SIN(PHI) - PLAB(3) = PABS*COS(THETA) -* -* If the incident track is on the z axis then simulate the actual -* electron beam profile, including a central gaussian and a halo -* modeled according to CASA technical note JLAB-TN-06-048. -* - if (vertex(1).eq.0 .and. vertex(2).eq.0 .and. - + plab(1).eq.0 .and. plab(2).eq.0) then - if (.not.hexist(idhalo)) then - call hbook2(idhalo-1,'halo work histogram', - + 150,-1.5,1.5,150,-1.5,1.5,0.) - call hbook2(idhalo,'beam y vs x', - + 150,-1.5,1.5,150,-1.5,1.5,0.) - call hbook2(idhalo+1,'beam px vs x', - + 150,-1.5,1.5,150,-3.0,3.0,0.) - call hbook2(idhalo+2,'beam py vs y', - + 150,-1.5,1.5,150,-3.0,3.0,0.) - call hbook2(idhalo+3,'beam py versus px', - + 150,-3.0,3.0,150,-3.0,3.0,0.) - do ix=1,150 - x = (ix-75.5)/50. - do iy=1,150 - y = (iy-75.5)/50. - call hfill(idhalo-1,x,y,haloxy(x*1e-2,y*1e-2,1)) - enddo - enddo - endif - call grndm(rndm,1) - if (rndm(1).lt.fhalo/0.52) then - call hrndm2(idhalo-1,vertex(1),vertex(2)) - call grndm(rndm,2) - phig = rndm(1)*TWOPI - rhog = sqrt(-2*log(rndm(2))) - plab(1) = plab(3)*(0.2*rhog*cos(phig)-vertex(1))/8000. - plab(2) = plab(3)*(0.1*rhog*sin(phig)-vertex(2))/4000. - else - call grndm(rndm,4) - phig = rndm(1)*TWOPI - rhog = sqrt(-2*log(rndm(2))) - thetaX = (emitx/spot)*rhog*cos(phig) - thetaY = (emity/spot)*rhog*sin(phig) - phig = rndm(3)*TWOPI - rhog = sqrt(-2*log(rndm(4))) - vertex(1) = (spot*rhog*cos(phig)-thetaX*D)*1e2 - vertex(2) = (spot*rhog*sin(phig)-thetaY*D)*1e2 - plab(1) = plab(3)*thetaX - plab(2) = plab(3)*thetaY - endif - call hfill(idhalo,vertex(1),vertex(2),1.) - call hfill(idhalo+1,vertex(1),plab(1)*1e3,1.) - call hfill(idhalo+2,vertex(2),plab(2)*1e3,1.) - call hfill(idhalo+3,plab(1)*1e3,plab(2)*1e3,1.) - endif - - CALL GSVERT(VERTEX,0,0,0.0,0,NVERT) - CALL GSKINE(PLAB,IK,NVERT,0,0,NT) - - call storeInput(IDRUN,IDEVT,NT); - - endif -* -* Kinematic debug (controled by ISWIT(1)) -* - IF(IDEBUG.EQ.1.AND.ISWIT(1).EQ.1) THEN - CALL GPRINT('VERT',0) - CALL GPRINT('KINE',0) - ENDIF -* - END diff --git a/src/programs/Simulation/gxtwist/guout.F b/src/programs/Simulation/gxtwist/guout.F deleted file mode 100644 index d0c92a2ea3..0000000000 --- a/src/programs/Simulation/gxtwist/guout.F +++ /dev/null @@ -1,40 +0,0 @@ -* -* $Id$ -* -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUOUT -* -C. ****************************************************************** -C. * * -C. * User routine called at the end of each event. * -C. * * -C. ****************************************************************** -C. -C. -#include "geant321/gcomis.inc" -C. ------------------------------------------------------------------ -C. - - integer iskip - integer nseen - call gelh_outp(iskip) - nseen = loadOutput(); - -#ifdef DISABLE_OUTPUT - if (0.gt.1) then -#elif WRITE_ONLY_IF_SOMETHING_WAS_SEEN - if (iseen.gt.0) then -#else - if (iseen.ge.0) then -#endif - call flushOutput(); - endif - - END diff --git a/src/programs/Simulation/gxtwist/guphad.F b/src/programs/Simulation/gxtwist/guphad.F deleted file mode 100644 index 18d60fb5a9..0000000000 --- a/src/programs/Simulation/gxtwist/guphad.F +++ /dev/null @@ -1,136 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.2 2001/07/15 07:31:37 jonesrt -* HDGeant now supportskinematic input from Monte Carlo generators -* via the routines in hddmInput.c -rtj -* -* Revision 1.1 2001/07/10 18:05:47 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:46 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/03 07/10/94 18.38.33 by S.Giani -*-- Author : - SUBROUTINE GUPHAD -C. -C. ****************************************************************** -C. * * -C. * User routine to compute Hadron. inter. probabilities * -C. * * -C. * ==>Called by : GTHADR,GTNEUT * -C. * * -C. ****************************************************************** -C. -*======================================================================* -* * -* An interface with a part of the FLUKA shower code is available in * -* GEANT 3.21. The following conditions and warnings must be taken * -* into account when using the FLUKA routines. * -* * -*======================================================================* -*======================================================================* -* * -* FFFF L U U K K AA * -* F L U U K K A A * -* FFF L U U KK AAAA * -* F L U U K K A A * -* F LLLL UU K K A A * -* * -* (C) Copyright of the authors * -* * -* A. Fasso'*, A. Ferrari#, J. Ranft$, P.R. Sala# * -* * -* *: CERN, #: INFN -Milan, $: CERN/Frascati * -* * -* (e-mail: FERRARIA@CERNVM.CERN.CH) * -* * -*======================================================================* -* * -* - All the rights concerning FLUKA or parts of it are only of the * -* authors and are independent from those of the GEANT code * -* * -* - FLUKA [1-6] is a standalone code capable of simulating the inter-* -* action and transport of all components of EM and hadronic cas- * -* cades up to several TeV. However, only cross sections and * -* models for hadronic elastic and inelastic interactions (end 1992 * -* status) are included in this GEANT version. * -* * -* - The most recent FLUKA model [4,6] for nucleon and pion interac- * -* tions in the intermediate energy range is not fully implemented * -* in GEANT. Only a simplified version, limited to p and n below * -* 250 MeV, is available in GEANT 3.21. A coarser model is used for * -* other projectiles in this energy range. However the implemented * -* parts should be adequate for most detector simulations and sim- * -* ilar applications for which GEANT is generally used. Their accu- * -* racy could be insufficient for some nuclear physics studies or * -* demanding simulations at low energies, where the more sophistic- * -* ated models [4,6] could be required. * -* * -* - The performances of GEANT-FLUKA are therefore not representative * -* of those of FLUKA standalone and should be referenced as such * -* rather than simply GEANT or FLUKA. * -* * -* - The authors reserve the right of publishing about the physical * -* models developed for FLUKA. Running the FLUKA routines in isol- * -* ation for benchmarks (or equivalent use) is not permitted, * -* except after consultations or in collaboration with the authors. * -* * -* - The FLUKA routines are supposed to be included and used in * -* GEANT only. Any other use must be authorized by the authors. * -* * -* - References: at least reference [5] should be always quoted when * -* reporting results obtained with GEANT-FLUKA * -* * -* [1] A. Fasso', A. Ferrari, J. Ranft, P. R. Sala, G. R. Stevenson and * -* J. M. Zazula, "FLUKA92", presented at the workshop on "Simulat- * -* ing Accelerator Radiation Environment", SARE, Santa Fe, 11-15 * -* january (1993), Proceedings in press. * -* * -* [2] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, Proc. MC93 Int. Conf. * -* on Monte-Carlo Simulation in High-Energy and Nuclear Physics, * -* Tallahassee, Florida, 22-26 february (1993), World Scientific, * -* p. 88 (1994). * -* * -* [3] P.A. Aarnio, A. Fasso', A. Ferrari, J.-H. Moehring, J. Ranft, * -* P.R. Sala, G.R. Stevenson and J.M. Zazula, ibidem, p. 100 (1994) * -* * -* [4] A. Ferrari and P.R. Sala, ibidem, p. 277 (1994). * -* * -* [5] A. Fasso', A. Ferrari, J. Ranft and P.R. Sala, "FLUKA: present * -* status and future developments", presented at the IV Int. Conf. * -* on Calorimetry in High Energy Physics, La Biodola (Elba), * -* September 19-25 1993, Proceedings in press. * -* * -* [6] A. Fasso', A. Ferrari, J. Ranft, and P.R. Sala, "FLUKA: Perf- * -* ormances and Applications in the Intermediate Energy Range", * -* presented at the "Specialists' Meeting on Shielding Aspects of * -* Accelerators, Targets & Irradiation Facilities", Arlington, * -* April 28-29 1994, Proceedings in press. * -* * -*======================================================================* -C -#include "geant321/gcphys.inc" -C. -C. ------------------------------------------------------------------ -C. -C GPGHEI for GHEISHA -C FLDIST for FLUKA (with GHEISHA for neutrons below 20MeV) -C GFMDIS for FLUKA (with MICAP for neutrons below 20MeV) -C - IF (IHADR.LT.3) THEN - CALL GPGHEI - ELSE IF (IHADR.EQ.3) THEN - CALL FLDIST - ELSE - CALL GFMDIS - ENDIF - END diff --git a/src/programs/Simulation/gxtwist/gustep.F b/src/programs/Simulation/gxtwist/gustep.F deleted file mode 100644 index 9c5287c9bb..0000000000 --- a/src/programs/Simulation/gxtwist/gustep.F +++ /dev/null @@ -1,252 +0,0 @@ -* -* $Id$ -* -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE GUSTEP -* -************************************************************************ -* * -* User routine called at the end of each tracking step * -* MEC is the mechanism origin of the step * -* INWVOL is different from 0 when the track has reached * -* a volume boundary * -* ISTOP is different from 0 if the track has stopped * -* * -************************************************************************ -* -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gcomis.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gctmed.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcflag.inc" -#include "geant321/gcnum.inc" -#include "hdtrackparams.inc" -* -* ----------------------------------------------------------------- -* - character*4 cnames(15) - equivalence (NAMES(1),cnames(1)) - character*4 chfrom - save chfrom - data chfrom/'NULL'/ - - real vertx(3),tofgx,ubuf(99) - integer ntbeamx,nttargx,nubuf - - integer ptype - real xin(4),xout(4),pin(5),pout(5),dEsum,x0(4),p0(5),p1(5),ppol - common /nt1/ ptype,xin,xout,pin,pout,dEsum,x0,p0,p1,ppol - character*180 ntform - parameter (ntform='kind:i,xin(4):r,xout(4):r,' - + //'pin(5):r,pout(5):r,dEsum:r,' - + //'x0(4):r,p0(5):r,p1(5):r,ppol:r') - - logical hexist - external hexist - - if (.not.hexist(1)) then - call hbnt(1,'microscope hits',' ') - call hbname(1,'hits',ptype,ntform) - call hbnt(2,'fixed array hits',' ') - call hbname(2,'hits',ptype,ntform) - call hbnt(3,'endpoint array hits',' ') - call hbname(3,'hits',ptype,ntform) - call hbnt(4,'microscope readout hits',' ') - call hbname(4,'hits',ptype,ntform) - call hbnt(5,'DET7 pseudovolume hits',' ') - call hbname(5,'hits',ptype,ntform) - call hbnt(6,'DET8 pseudovolume hits',' ') - call hbname(6,'hits',ptype,ntform) - endif - - CALL GDEBUG - -*#define GENERATE_BUT_DO_NOT_TRACK 1 -#if GENERATE_BUT_DO_NOT_TRACK - istop = 1 - return -#endif - -* Implement an importance-sampling cascade scheme -#if TUNL_BACKSTREAMING_CASCADE_FACTOR - if (INWVOL.eq.1.and.NSTEP.gt.0) then - if (ISTORY.lt.2.and. - + NLEVEL.ge.2.and.cnames(2).eq.'AREA'.and. - + .not.(NLEVEL.ge.3.and.cnames(3).eq.'TUNL')) then - if (chfrom.eq.'TUNL') then - isave = ISTORY - ISTORY = 2 - call replicate(TUNL_BACKSTREAMING_CASCADE_FACTOR) -* ISTORY = isave - endif - elseif (ISTORY.eq.0.and.cnames(NLEVEL).eq.'TUNL') then - if (chfrom.eq.'EDHS') then - ISTORY = 1 - call replicate(EDHS_BACKSTREAMING_CASCADE_FACTOR) -* ISTORY = 0 - endif - endif - elseif (INWVOL.eq.2) then - if ((NLEVEL.ge.2.and.cnames(2).eq.'TUNL').or. - + (NLEVEL.ge.3.and.cnames(3).eq.'TUNL')) then - if ((NLEVEL.ge.3.and.cnames(3).eq.'EDHS').or. - + (NLEVEL.ge.4.and.cnames(4).eq.'EDHS')) then - chfrom = 'EDHS' - else - chfrom = 'TUNL' - endif - else - chfrom = cnames(NLEVEL) - endif - else - chfrom = cnames(NLEVEL) - endif -#endif - -* Place any secondaries generated during this step onto the stack - - if (nosecondaries.eq.0) then - do i=1,NGKINE - itypa = GKIN(5,i) - if (itypa.ne.4) call GSKING(i) - enddo - endif - -* Stop wimpy charged particles that are taking forever to range out - - if ((NSTEP.ge.9999).and.(CHARGE.ne.0)) then - DESTEP = GEKIN - ISTOP = 1 - endif - -* Stop at exit from the tagger area - -c if (NLEVEL.eq.1) then -c STOP = 1 -c endif - -* If not a sensitive volume then exit here - -c if (NTMULT.eq.1.and.NSTEP.eq.0) then - if (NSTEP.eq.0) then - x0(1) = VECT(1) - x0(2) = VECT(2) - x0(3) = VECT(3) - x0(4) = TOFG - p0(1) = VECT(4) - p0(2) = VECT(5) - p0(3) = VECT(6) - p0(4) = GETOT - p0(5) = VECT(7) - call gfvert(1,vertx,ntbeamx,nttargx,tofgx,ubuf,nubuf) - ppol = ubuf(1) - p1(1) = ubuf(2) - p1(2) = ubuf(3) - p1(3) = ubuf(4) - p1(4) = ubuf(5) - p1(5) = ubuf(6) - elseif (ISVOL.eq.0) then - return - endif - -* Inside sensitive medium: accumulate info about track segment - - if (ISTOP.ne.0) then ! particle stops - continue - elseif (INWVOL.eq.2) then ! particle exits current volume - continue - elseif (INWVOL.eq.1) then ! particle enters new volume - ptype = ipart - xin(1) = VECT(1) - xin(2) = VECT(2) - xin(3) = VECT(3) - xin(4) = TOFG - pin(1) = VECT(4) - pin(2) = VECT(5) - pin(3) = VECT(6) - pin(4) = GETOT - pin(5) = VECT(7) - dEsum = 0 - return - else - dEsum = dEsum + DESTEP - return - endif - -* At end of track segment in sensitive medium: register hit - - dEsum = dEsum + DESTEP - xout(1) = VECT(1) - xout(2) = VECT(2) - xout(3) = VECT(3) - xout(4) = TOFG - pout(1) = VECT(4) - pout(2) = VECT(5) - pout(3) = VECT(6) - pout(4) = GETOT - pout(5) = VECT(7) - if (CNAMES(NLEVEL).eq.'MSFI') then - call hfnt(1) - elseif (CNAMES(NLEVEL)(1:2).eq.'FX') then - call hfnt(2) - elseif (CNAMES(NLEVEL)(1:4).eq.'ENDP') then - call hfnt(3) - elseif (CNAMES(NLEVEL)(1:4).eq.'MSRO') then - call hfnt(4) - elseif (CNAMES(NLEVEL)(1:4).eq.'DET7') then - call hfnt(5) - elseif (CNAMES(NLEVEL)(1:4).eq.'DET8') then - call hfnt(6) - elseif (CNAMES(NLEVEL).eq.'XTAL') then - x0(1) = VECT(1) - x0(2) = VECT(2) - x0(3) = VECT(3) - x0(4) = TOFG - p0(1) = VECT(4) - p0(2) = VECT(5) - p0(3) = VECT(6) - p0(4) = GETOT - p0(5) = VECT(7) - call gfvert(1,vertx,ntbeamx,nttargx,tofgx,ubuf,nubuf) - ppol = ubuf(1) - p1(1) = ubuf(2)/ubuf(6) - p1(2) = ubuf(3)/ubuf(6) - p1(3) = ubuf(4)/ubuf(6) - p1(4) = ubuf(5) - p1(5) = ubuf(6) - endif - END - - subroutine replicate(count) - integer count - real psave(3),xsave(3),wsave - integer i -#undef CERNLIB_GEANT321_GCKINE_INC -#undef CERNLIB_GEANT321_GCTRAK_INC -#include "geant321/gckine.inc" -#include "geant321/gctrak.inc" - if (count.le.1) return - do i=1,3 - xsave(i) = VERT(i) - psave(i) = PVERT(i) - VERT(i) = VECT(i) - PVERT(i) = VECT(i+3)*VECT(7) - enddo - wsave = UPWGHT - UPWGHT = count-1 - call GSSTAK(0) - UPWGHT = wsave - do i=1,3 - VERT(i) = xsave(i) - PVERT(i) = psave(i) - enddo - end diff --git a/src/programs/Simulation/gxtwist/guxcs.F b/src/programs/Simulation/gxtwist/guxcs.F deleted file mode 100644 index 31efca8982..0000000000 --- a/src/programs/Simulation/gxtwist/guxcs.F +++ /dev/null @@ -1,29 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.1 2001/07/10 18:05:48 jonesrt -* imported several of the gu*.F user subroutines for Hall D customization -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:47 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/04 06/12/94 16.09.54 by S.Ravndal -*-- Author : S.Ravndal 06/12/94 - SUBROUTINE GUXCS -* -* User routine to declare addresses of FORTRAN routines -* and COMMONs which may be invoked from COMIS routines. -* Called by GXCS -* -#include "geant321/gcomis.inc" -* -* DIMENSION P(1) -* -* - END diff --git a/src/programs/Simulation/gxtwist/gxcs.F b/src/programs/Simulation/gxtwist/gxcs.F deleted file mode 100644 index d979df0c93..0000000000 --- a/src/programs/Simulation/gxtwist/gxcs.F +++ /dev/null @@ -1,126 +0,0 @@ -#define CERNLIB_COMIS true -* -* June 12, 2000 -rtj -* Modified calls to csext so that arg1 (string) is not too long -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.1 2001/07/08 06:24:33 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.3 2001/03/07 00:42:19 radphi -* Changes made by jonesrt@zeus -* several geometry fixes, LGD gain improvement -rtj -* -* Revision 1.2 1998/07/02 03:55:41 radphi -* Changes made by kurylov@jlabs4 -* Small improvements to geometry, corrections to materials, hits definitions -AAK -* -* Revision 1.1.1.1 1995/10/24 10:21:49 cernlib -* Geant -* -* -#include "geant321/pilot.h" -#if defined(CERNLIB_COMIS) -*CMZ : 20/06/95 09.32.44 by S.Ravndal -*-- Author : - SUBROUTINE GXCS -C. -C. ****************************************************************** -C. * * -C. * To initialize the COMIS package * -C. * To declare addresses of FORTRAN routines and COMMONs * -C. * which may be invoked from COMIS routines * -C. * (one can call CSOMAP instead) * -C. * * -C. ****************************************************************** -#include "geant321/gcbank.inc" -#include "geant321/gcmate.inc" -#include "geant321/gctmed.inc" -#include "geant321/gcvolu.inc" -#include "geant321/gcflag.inc" -#include "geant321/gctrak.inc" -#include "geant321/gckine.inc" -#include "geant321/gcking.inc" -#include "geant321/gccuts.inc" -#include "geant321/gclist.inc" -#include "geant321/gcnum.inc" -#include "geant321/gconst.inc" -#include "geant321/gcphys.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcdraw.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gcomis.inc" -#include "geant321/gcsets.inc" - - DIMENSION P(1) -* - EXTERNAL GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS - EXTERNAL GSVERT,GSKINE,GSKING,GOPEN,GFIN,GCLOSE - EXTERNAL GFOUT - EXTERNAL GMATE,GSMATE,GSMIXT,GSTMED,GSTPAR,GPART,GPHYSI - EXTERNAL GFMATE,GPIONS - EXTERNAL GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP - EXTERNAL GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM - EXTERNAL GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT - EXTERNAL GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG - EXTERNAL GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD - EXTERNAL GDOPEN,GDCLOS,GDRAW,GDRAWC,GDSCAL,GDMAN,GDCOL - EXTERNAL GDELET,GDAXIS,GDRAWT - EXTERNAL GSCANK,GSCANU,GSCANO - EXTERNAL UGLAST -* -C. -C. ------------------------------------------------------------------ -C. - CALL PAWCS -* - CALL CSCOM('GCLINK,GCBANK,GCCUTS,GCFLAG,GCKINE,GCLIST#' - +, JDIGI,NZEBRA,CUTGAM,IDEBUG,IKINE,NHSTA,P,P,P,P) - CALL CSCOM('GCMATE,GCNUM,GCONST,GCPHYS,GCTMED,GCTRAK#' - +, NMAT,NMATE,PI,IPAIR,NUMED,VECT,P,P,P,P) - CALL CSCOM('GCUNIT,GCVOLU,GCDRAW,GCKING,GCMULO#',LIN,NLEVEL,NUMNOD - +, KCASE,SINMUL,P,P,P,P,P) -* - CALL CSEXT('GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS#' - +, GINIT,GZINIT,GDINIT,GPRINT,GPSETS,GXCLOS,P,P,P,P) - CALL CSEXT( - +'GSVERT,GSKINE,GSKING,GFIN,GOPEN,GCLOSE,GFOUT#', - + GSVERT,GSKINE,GSKING,GFIN,GOPEN,GCLOSE,GFOUT, - + P,P,P) - CALL CSEXT('GMATE,GSMATE,GFMATE,GSMIXT,GSTMED,GSTPAR,GPART#' - +, GMATE,GSMATE,GFMATE,GSMIXT,GSTMED,GSTPAR,GPART,P,P,P) - CALL CSEXT('GPIONS,GPHYSI#' - +, GPIONS,GPHYSI,P,P,P,P,P,P,P,P) - CALL CSEXT('GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP#' - +, GTRIG,GTRIGI,GTRIGC,GTREVE,GIDROP,P,P,P,P,P) - CALL CSEXT('GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM#' - +, GSVOLU,GSPOS,GSPOSP,GSDVN,GSDVS,GGCLOS,GOPTIM - +, P,P,P) - CALL CSEXT('GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT#' - +, GSROTM,GSORD,GSDET,GSDETH,GSDETV,GSATT,P,P,P,P) - CALL CSEXT('GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG#' - +, GPLMAT,GSAHIT,GSCHIT,GSDIGI,GSXYZ,GDEBUG,P,P,P,P) - CALL CSEXT('GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD#' - +, GPCXYZ,GDCXYZ,GDXYZ,GDAHIT,GDCHIT,GDHITS,GDHEAD - +, P,P,P) - CALL CSEXT('GDOPEN,GDCLOS,GDELET,GDRAW,GDRAWC,GDAXIS,GDSCAL#' - +, GDOPEN,GDCLOS,GDELET,GDRAW,GDRAWC,GDAXIS,GDSCAL - +, P,P,P) - CALL CSEXT('GDMAN,GDCOL#' - +, GDMAN,GDCOL,P,P,P,P,P,P,P,P) - CALL CSEXT('GDRAWT#',GDRAWT,P,P,P,P,P,P,P,P,P) - CALL CSEXT('GSCANK,GSCANU,GSCANO,GBRSGE#',GSCANK,GSCANU,GSCANO, - + GBRSGE,P,P,P,P,P,P) - CALL CSEXT('UGLAST#',UGLAST,P,P - +, P,P,P,P,P,P,P) -* - CALL GUXCS -* - END - -#endif diff --git a/src/programs/Simulation/gxtwist/gxint.F b/src/programs/Simulation/gxtwist/gxint.F deleted file mode 100644 index 74e9e8f9dd..0000000000 --- a/src/programs/Simulation/gxtwist/gxint.F +++ /dev/null @@ -1,75 +0,0 @@ -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.2 2004/03/15 16:32:27 jonesrt -* -gxint.F : increased the size of the pawc area to accomodate larger -* 2d histograms (without ZFATAL crashes) [rtj] -* -hitCDC.c : enclosed the sections relevant to barrel cathode strips in a -* conditional CATHODE_STRIPS_IN_CDC after they were removed from -* the CDC geometry definition by C. Meyer [rtj] -* -* Revision 1.1 2001/07/08 06:24:34 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.2 1997/01/07 10:25:42 cernlib -* Remove #ifdef CERNLIB_MAIN; this shall be done via Imakefile. -* -* Revision 1.1.1.1 1995/10/24 10:21:50 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.33 by S.Giani -*-- Author : - SUBROUTINE GXINT -* -* GEANT main program. To link with the MOTIF user interface -* the routine GPAWPP(NWGEAN,NWPAW) should be called, whereas -* the routine GPAW(NWGEAN,NWPAW) gives access to the basic -* graphics version. -* -#if !defined(CERNLIB_IBM) - PARAMETER (NWGEAN=8000000,NWPAW=2000000) -#endif -#if defined(CERNLIB_IBM) - PARAMETER (NWGEAN=1000000,NWPAW=500000) -#endif - COMMON/GCBANK/GEANT(NWGEAN) - COMMON/PAWC/PAW(NWPAW) -#if defined(CERNLIB_HPUX) - ON REAL UNDERFLOW IGNORE -#endif -* -#if defined(CERNLIB_IBM) - CALL INITC - CALL ERRSET(151,999,-1) -#endif -#if (defined(CERNLIB_MOTIF))&&(!defined(CERNLIB_IBM)) - CALL GPAWPP(NWGEAN,NWPAW) -#endif -#if !defined(CERNLIB_MOTIF)||defined(CERNLIB_IBM) - CALL GPAW(NWGEAN,NWPAW) -#endif -* - END - SUBROUTINE QNEXT - END -#if !defined(CERNLIB_CZ) - SUBROUTINE CZOPEN - END - SUBROUTINE CZTCP - END - SUBROUTINE CZCLOS - END - SUBROUTINE CZPUTA - END -#endif -#if defined(CERNLIB_IBM) - FUNCTION IOSCLR() - IOSCLR=0 - END -#endif diff --git a/src/programs/Simulation/gxtwist/gxphys.F b/src/programs/Simulation/gxtwist/gxphys.F deleted file mode 100644 index 97dff57bc6..0000000000 --- a/src/programs/Simulation/gxtwist/gxphys.F +++ /dev/null @@ -1,196 +0,0 @@ -* -* Jan 17, 2001 -rtj -* Fixed a typo in the setting of the flag ITCKOV (was ICKOV) -* -* $Id$ -* -* $Log$ -* Revision 1.1 2006/01/24 21:49:49 jonesrt -* Initial revision -* -* Revision 1.1 2001/07/08 06:24:34 jonesrt -* First release of the Geant3 geometry package for Hall D based on hdds. -rtj -* -* Revision 1.1 2001/06/25 14:05:32 radphi -* Changes made by jonesrt@hector -* added gxphys.F to the regular distribution -rtj -* -* Revision 1.1.1.1 1995/10/24 10:21:50 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 12/06/95 15.03.22 by S.Ravndal -*-- Author : - SUBROUTINE GXPHYS -C. -C. ****************************************************************** -C. * * -C. * Physics parameters control commands * -C. * * -C. * Author: R.Brun ********** * -C. * * -C. ****************************************************************** -C. -#include "geant321/gcbank.inc" -#include "geant321/gcphys.inc" -#include "geant321/gccuts.inc" -#include "geant321/gconsp.inc" -#include "geant321/gcunit.inc" -#include "geant321/gctrak.inc" -#include "geant321/gcmulo.inc" -#include "geant321/gctmed.inc" - DIMENSION UCUTS(10),ULCUTS(10) - EQUIVALENCE(UCUTS(1),CUTGAM) - DIMENSION MECA(5,13) - EQUIVALENCE (MECA(1,1),IPAIR) - CHARACTER*6 CUTNAM(10) - CHARACTER*4 CEN(10) - CHARACTER*32 CHPATL - CHARACTER*(*) CHNUMB - PARAMETER (CHNUMB='1234567890') - DATA CUTNAM/'CUTGAM','CUTELE','CUTNEU','CUTHAD','CUTMUO', - + 'BCUTE' ,'BCUTM' ,'DCUTE' ,'DCUTM' ,'PPCUTM'/ -C. -C. ------------------------------------------------------------------ -C. - CALL KUPATL(CHPATL,NPAR) -* - IF(CHPATL.EQ.'ANNI')THEN - CALL KUGETI(IANNI) -* - ELSEIF(CHPATL.EQ.'AUTO')THEN - CALL KUGETI(IGAUTO) -* - ELSEIF(CHPATL.EQ.'BREM')THEN - CALL KUGETI(IBREM) -* - ELSEIF(CHPATL.EQ.'CKOV')THEN - CALL KUGETI(ITCKOV) -* - ELSEIF(CHPATL.EQ.'COMP')THEN - CALL KUGETI(ICOMP) -* - ELSEIF(CHPATL.EQ.'DCAY')THEN - CALL KUGETI(IDCAY) -* - ELSEIF(CHPATL.EQ.'DRAY')THEN - CALL KUGETI(IDRAY) -* - ELSEIF(CHPATL.EQ.'ERAN')THEN - CALL KUGETR(EKMIN) - CALL KUGETR(EKMAX) - CALL KUGETI(NEKBIN) - NEKBIN=MIN(NEKBIN,199) -* - ELSEIF(CHPATL.EQ.'HADR')THEN - CALL KUGETI(IHADR) -* - ELSEIF(CHPATL.EQ.'LABS')THEN - CALL KUGETI(ILABS) -* - ELSEIF(CHPATL.EQ.'LOSS')THEN - CALL KUGETI(ILOSS) - IF(ILOSS.EQ.2.OR.ILOSS.EQ.0)THEN - IDRAY=0 - ELSE - IDRAY=1 - ENDIF -* - ELSEIF(CHPATL.EQ.'MULS')THEN - CALL KUGETI(IMULS) -* - ELSEIF(CHPATL.EQ.'MUNU')THEN - CALL KUGETI(IMUNU) -* - ELSEIF(CHPATL.EQ.'PAIR')THEN - CALL KUGETI(IPAIR) -* - ELSEIF(CHPATL.EQ.'PFIS')THEN - CALL KUGETI(IPFIS) -* - ELSEIF(CHPATL.EQ.'PHOT')THEN - CALL KUGETI(IPHOT) -* - ELSEIF(CHPATL.EQ.'RAYL')THEN - CALL KUGETI(IRAYL) -* - ELSEIF(CHPATL.EQ.'STRA')THEN - CALL KUGETI(ISTRA) -* - ELSEIF(CHPATL.EQ.'SYNC')THEN - CALL KUGETI(ISYNC) -* - ELSEIF(CHPATL.EQ.'CUTS')THEN - IF(NPAR.LE.0)THEN - WRITE(LOUT,10000) -10000 FORMAT(/,' Current PHYSICS parameters:',/) - DO 10 I=1,10 - CALL GEVKEV(UCUTS(I),ULCUTS(I),CEN(I)) - WRITE(LOUT,10100)CUTNAM(I),ULCUTS(I),CEN(I) -10100 FORMAT(5X,A,' = ',F7.2,1X,A) - 10 CONTINUE - GO TO 999 - ENDIF - CALL KUGETR(CUTGAM) - CALL KUGETR(CUTELE) - CALL KUGETR(CUTHAD) - CALL KUGETR(CUTNEU) - CALL KUGETR(CUTMUO) - CALL KUGETR(BCUTE) - CALL KUGETR(BCUTM) - CALL KUGETR(DCUTE) - CALL KUGETR(DCUTM) - CALL KUGETR(PPCUTM) - CALL KUGETR(TOFMAX) - CALL KUGETR(GCUTS(1)) - IF(BCUTE.LE.0.)BCUTE=CUTGAM - IF(BCUTM.LE.0.)BCUTM=CUTGAM - IF(DCUTE.LE.0.)DCUTE=CUTELE - IF(DCUTM.LE.0.)DCUTM=CUTELE - IF(PPCUTM.LT.4.*EMASS)PPCUTM=4.*EMASS -* - ELSEIF(CHPATL.EQ.'DRPRT')THEN - CALL KUGETI(IPART) - CALL KUGETI(IMATE) - CALL KUGETR(STEP) - CALL KUGETI(NPOINT) - CALL GDRPRT(IPART,IMATE,STEP,NPOINT) -* - ELSEIF(CHPATL.EQ.'PHYSI')THEN - IF(JTMED.GT.0)THEN - DO 30 I=1,IQ(JTMED-2) - JTM=LQ(JTMED-I) - IF(JTM.LE.0)GO TO 30 - IF(IQ(JTM-2).EQ.0)THEN - CALL MZPUSH(IXCONS,JTM,10,0,'I') - GO TO 30 - ENDIF - DO 20 J=1,10 - JTMI=LQ(JTM-J) - IF(JTMI.GT.0)THEN - CALL MZDROP(IXCONS,JTMI,' ') - ENDIF - 20 CONTINUE - 30 CONTINUE - CALL UCOPY(CUTGAM,Q(JTMED+1),10) - DO 40 I=1,13 - Q(JTMED+10+I)=MECA(1,I) - 40 CONTINUE - ENDIF - IF(JMATE.LE.0)GO TO 999 - DO 60 I=1,IQ(JMATE-2) - JMA=LQ(JMATE-I) - IF(JMA.LE.0)GO TO 60 - DO 50 J=1,IQ(JMA-2) - IF(J.EQ.4.OR.J.EQ.5)GO TO 60 - JM=LQ(JMA-J) - IF(JM.LE.0)GO TO 50 - CALL MZDROP(IXCONS,JM,'L') - 50 CONTINUE - 60 CONTINUE - CALL MZGARB (IXCONS, 0) - CALL GPHYSI - ENDIF -* - 999 END diff --git a/src/programs/Simulation/gxtwist/gxtwist++.cc b/src/programs/Simulation/gxtwist/gxtwist++.cc deleted file mode 100644 index f0aadc0338..0000000000 --- a/src/programs/Simulation/gxtwist/gxtwist++.cc +++ /dev/null @@ -1,11 +0,0 @@ -extern "C" int gxint_(void); -extern "C" int getwebfile(const char *url); - -int main(int narg, char *argv[]) -{ - // Make sure magnetic field file exists in local directory - getwebfile("http://zeus.phys.uconn.edu/halld/tagger/simulation/TOSCA_tagger_dipole-15000G.map.gz"); - getwebfile("http://zeus.phys.uconn.edu/halld/tagger/simulation/TOSCA_tagger_quadrupole-nominal.map.gz"); - return gxint_(); -} - diff --git a/src/programs/Simulation/gxtwist/gxtwist.cc b/src/programs/Simulation/gxtwist/gxtwist.cc deleted file mode 100644 index d9892f2b48..0000000000 --- a/src/programs/Simulation/gxtwist/gxtwist.cc +++ /dev/null @@ -1,14 +0,0 @@ - - -extern "C" int gxtwist_(void); -extern "C" int getwebfile(const char *url); - -int main(int narg, char *argv[]) -{ - // Make sure magnetic field file exists in local directory - getwebfile("http://zeus.phys.uconn.edu/halld/tagger/simulation/TOSCA_tagger_dipole-15000G.map.gz"); - getwebfile("http://zeus.phys.uconn.edu/halld/tagger/simulation/TOSCA_tagger_quadrupole-nominal.map.gz"); - - return gxtwist_(); -} - diff --git a/src/programs/Simulation/gxtwist/gxtwist_f.F b/src/programs/Simulation/gxtwist/gxtwist_f.F deleted file mode 100644 index 365d5622df..0000000000 --- a/src/programs/Simulation/gxtwist/gxtwist_f.F +++ /dev/null @@ -1,29 +0,0 @@ - SUBROUTINE GXTWIST - - implicit none - real q,hq - integer ispace,hspace - parameter (ispace=2000000) - parameter (hspace=5000000) - common /gcbank/ q(ispace) - common /pawc/ hq(hspace) - real secmax - parameter (secmax=300000.) - -C---- Initialization of HBOOK, ZEBRA, clock - call GZEBRA(ispace) - call HLIMIT(-hspace) - call TIMEST(secmax) - -C---- Initialization of GEANT - call HPLINT(0) - call UGINIT - -C---- Simulation - call GRUN - -C---- Termination ---- - CALL UGLAST - WRITE(0,999) - 999 FORMAT(//,' ***** Normal exit from Hall D GEANT *****',//) - END diff --git a/src/programs/Simulation/gxtwist/halo.F b/src/programs/Simulation/gxtwist/halo.F deleted file mode 100644 index ca3764acce..0000000000 --- a/src/programs/Simulation/gxtwist/halo.F +++ /dev/null @@ -1,69 +0,0 @@ - block data halo - include 'halo.inc' - data hparX/2.95e1,4.19,-2.40e5,3.53e6,-1.5e-4,1.13e-3, - + 1.93e2,-4.54e2,-1.59e6,3.53e6,-3.78e-4,1.13e-3, - + 5.95e2,-1.92e3,-4.97e6,3.52e6,-6.75e-4,1.13e-3/ - data hparY/1.58e1,-1.06e3,-2.26e5,7.06e6,-1.06e-3,5.67e-4, - + 5.27e1,-7.48e2,-6.21e5,7.06e6,-1.17e-3,5.66e-4, - + 2.14e2,-6.97e2,-2.10e6,7.06e6,-1.33e-3,5.66e-4/ - end - - real function halox(x,ns) ! halo fits from JLAB-TN-06-048 - real x - integer ns - include 'halo.inc' - halox = (hparX(1,ns)+hparX(2,ns)*x+hparX(3,ns)*x**2) - + +hparX(4,ns)*exp(-0.5*((x-hparX(5,ns))/hparX(6,ns))**2) - halox = max(halox,0.) - end - - real function haloy(y,ns) ! halo fits from JLAB-TN-06-048 - real y - integer ns - include 'halo.inc' - haloy = (hparY(1,ns)+hparY(2,ns)*y+hparY(3,ns)*y**2) - + +hparY(4,ns)*exp(-0.5*((y-hparY(5,ns))/hparY(6,ns))**2) - haloy = max(haloy,0.) - end - - real function haloxy(x,y,ns) ! 2D model by R.T. Jones - real x,y - integer ns - real a,b ! Note regarding halo normalization: - real rr0,p0 ! 52% of the integral of this halo - parameter (a=1.1e-3) ! intensity function lies outside the - parameter (b=0.55e-3) ! nominal 5-sigma ellipse that is often - parameter (rr0=15.) ! used to define the boundary of the halo. - parameter (p0=1.e-3) ! For example, to generate a 100ppm halo - real c0(3),c1,c2 ! beyond the (5a,5b) ellipse boundary, - data c0/2.5,15.,48./ ! sample one halo event for every 5.2e3 - parameter (c1=0) ! events in the central gaussian. - parameter (c2=-1/1.3e-4) - real r,rr,theta - real p,f - r=sqrt(x**2+y**2) - rr=sqrt((x/a)**2+(y/b)**2) - theta=atan2(y/b,x/a) - p=1+p0*(rr*exp(-rr/rr0))**6 - f=c0(ns)*(1+c1*r+c2*r**2) - haloxy=((f/b)*(cos(theta)**2)**p+(f/(2*a))*(sin(theta)**2)**p) - + *sqrt(a**2+b**2) ! + 1e6*exp(-0.5*rr**2) - haloxy = max(haloxy,0.) - end - - real function haloc(x,y) ! cut function occludes the central ellipse - real x,y - haloc=1 - if ((x/1.1e-3)**2+(y/0.55e-3)**2.lt.25) then - haloc=0 - endif - end - - subroutine hmake2(idin,idout,n) ! 2D random point generator - integer idin,idout,n - real x,y - do i=1,n - call hrndm2(idin,x,y) - call hfill(idout,x,y,1.) - enddo - end diff --git a/src/programs/Simulation/gxtwist/halo.inc b/src/programs/Simulation/gxtwist/halo.inc deleted file mode 100644 index 5d907042ae..0000000000 --- a/src/programs/Simulation/gxtwist/halo.inc +++ /dev/null @@ -1,4 +0,0 @@ - real hparX,hparY - common /halofits/ hparX(6,3),hparY(6,3) - real fhalo - common /halopars/fhalo diff --git a/src/programs/Simulation/gxtwist/hddmInput.c b/src/programs/Simulation/gxtwist/hddmInput.c deleted file mode 100644 index 5cea9d560f..0000000000 --- a/src/programs/Simulation/gxtwist/hddmInput.c +++ /dev/null @@ -1,271 +0,0 @@ -/* - * hddmInput - functions to handle Monte Carlo generator input to HDGeant - * through the standard hddm i/o mechanism. - * - * Interface: - * openInput(filename) - open input stream to file - * skipInput(count) - skip next events on open input file - * nextInput() - advance to next event on open input stream - * loadInput() - push current input event to Geant kine structures - * storeInput() - pop current input event from Geant kine structures - * closeInput() - close currently open input stream - * - * Richard Jones - * University of Connecticut - * July 13, 2001 - * - * Usage Notes: - * 1) Most Monte Carlo generators do not care where the vertex is placed - * inside the target, and specify only the final-state particles' - * momenta. In this case the vertex position has to be randomized by - * the simulation within the beam/target overlap volume. If the vertex - * position from the generator is (0,0,0) then the simulation vertex is - * generated uniformly inside the cylinder specified by TARGET_LENGTH, - * BEAM_DIAMETER, and TARGET_CENTER defined below. - * - * Revision history: - * > Dec 15, 2004 - Richard Jones - * Changed former behaviour of simulation to overwrite the vertex - * coordinates from the input record, if the simulation decides to - * override the input values. At present this happens whenever the - * input record specifies 0,0,0 for the vertex, but in the future it - * may be decided to let the simulator determine the vertex position - * in other cases. Since it is not part of the simulation proper, the - * decision was made to store this information in the reaction tag. - */ - -#define TARGET_LENGTH 0 -#define BEAM_DIAMETER 0.2 -#define TARGET_CENTER 0 - - -#include -#include -#include - -#include -#include - -mc_s_iostream_t* thisInputStream = 0; -mc_s_HDDM_t* thisInputEvent = 0; - -int openInput (char* filename) -{ - thisInputStream = open_mc_s_HDDM(filename); - return (thisInputStream == 0); -} - -int skipInput (int count) -{ - int* buff = (int*) malloc(1000000); - while (thisInputStream && (count > 0)) - { - int ret = fread(buff, sizeof(int), 1, thisInputStream->fd); - if (ret == 1) - { - int nw = *buff; - ret = fread(buff, sizeof(int), nw, thisInputStream->fd); - --count; - } - else - { - break; - } - } - free(buff); - return count; -} - -int nextInput () -{ - if (thisInputStream == 0) - { - return 9; /* input stream was never opened */ - } - else if (thisInputEvent) - { - flush_mc_s_HDDM(thisInputEvent, 0); - } - thisInputEvent = read_mc_s_HDDM(thisInputStream); - return (thisInputEvent == 0); -} - -int loadInput () -{ - mc_s_Reactions_t* reacts; - int reactCount, ir; - - reacts = thisInputEvent->physicsEvents->in[0].reactions; - reactCount = reacts->mult; - for (ir = 0; ir < reactCount; ir++) - { - mc_s_Vertices_t* verts; - int vertCount, iv; - mc_s_Reaction_t* react = &reacts->in[ir]; - verts = react->vertices; - vertCount = verts->mult; - for (iv = 0; iv < vertCount; iv++) - { - float v[3]; - int ntbeam = 0; - int nttarg = 0; - int nubuf = 0; - float ubuf; - int nvtx; - mc_s_Products_t* prods; - int prodCount, ip; - mc_s_Vertex_t* vert = &verts->in[iv]; - v[0] = vert->origin->vx; - v[1] = vert->origin->vy; - v[2] = vert->origin->vz; - if ((v[0] == 0) && (v[1] == 0) && (v[2] == 0)) - { - v[0] = 1; - v[1] = 1; - v[2] = TARGET_CENTER; - while (v[0]*v[0] + v[1]*v[1] > 0.25) - { - int len = 3; - grndm_(v,&len); - v[0] -= 0.5; - v[1] -= 0.5; - v[2] -= 0.5; - } - v[0] *= BEAM_DIAMETER; - v[1] *= BEAM_DIAMETER; - v[2] *= TARGET_LENGTH; - v[2] += TARGET_CENTER; - vert->origin->vx = v[0]; - vert->origin->vy = v[1]; - vert->origin->vz = v[2]; - } - gsvert_(v, &ntbeam, &nttarg, &ubuf, &nubuf, &nvtx); - prods = vert->products; - prodCount = prods->mult; - for (ip = 0; ip < prodCount; ip++) - { - int ntrk; - float p[3]; - Particle_t kind; - mc_s_Product_t* prod = &prods->in[ip]; - kind = prod->type; - p[0] = prod->momentum->px; - p[1] = prod->momentum->py; - p[2] = prod->momentum->pz; - if (prod->decayVertex == 0) - { - gskine_(p, &kind, &nvtx, &ubuf, &nubuf, &ntrk); - } - } - } - } - return 0; -} - -int storeInput (int runNo, int eventNo, int ntracks) -{ - mc_s_PhysicsEvents_t* pes; - mc_s_Reactions_t* rs; - mc_s_Vertices_t* vs; - mc_s_Origin_t* or; - mc_s_Products_t* ps; - int nvtx, ntbeam, nttarg, itra, nubuf; - float vert[3], plab[3], tofg, ubuf[10]; - Particle_t kind; - - if (thisInputEvent) - { - flush_mc_s_HDDM(thisInputEvent, 0); - } - thisInputEvent = make_mc_s_HDDM(); - thisInputEvent->physicsEvents = pes = make_mc_s_PhysicsEvents(1); - pes->mult = 1; - pes->in[0].reactions = rs = make_mc_s_Reactions(1); - rs->mult = 1; - rs->in[0].vertices = vs = make_mc_s_Vertices(99); - vs->mult = 0; - for (itra = 1; itra <= ntracks; itra++) - { - gfkine_(&itra,vert,plab,&kind,&nvtx,ubuf,&nubuf); - if (nvtx < 1) - { - return 1; - } - else - { - vs->mult = (nvtx < vs->mult)? vs->mult : nvtx; - } - gfvert_(&nvtx,vert,&ntbeam,&nttarg,&tofg,ubuf,&nubuf); - or = vs->in[nvtx-1].origin; - ps = vs->in[nvtx-1].products; - if (or == HDDM_NULL) - { - or = make_mc_s_Origin(); - vs->in[nvtx-1].origin = or; - or->vx = vert[0]; - or->vy = vert[1]; - or->vz = vert[2]; - or->t = tofg; - } - if (ps == HDDM_NULL) - { - ps = make_mc_s_Products(ntracks); - vs->in[nvtx-1].products = ps; - ps->mult = 0; - } - ps->in[ps->mult].type = kind; - ps->in[ps->mult].momentum = make_mc_s_Momentum(); - ps->in[ps->mult].momentum->px = plab[0]; - ps->in[ps->mult].momentum->py = plab[1]; - ps->in[ps->mult].momentum->pz = plab[2]; - ps->in[ps->mult].momentum->E = plab[3]; - ps->mult++; - } - pes->in[0].runNo = runNo; - pes->in[0].eventNo = eventNo; - return 0; -} - -int closeInput () -{ - if (thisInputStream) - { - close_mc_s_HDDM(thisInputStream); - thisInputStream = 0; - } - return 0; -} - - -/* entry points from Fortran */ - -int openinput_ (char* filename) -{ - int retcode = openInput(strtok(filename," ")); - return retcode; -} - -int skipinput_ (int* count) -{ - return skipInput(*count); -} - -int nextinput_ () -{ - return nextInput(); -} - -int loadinput_ () -{ - return loadInput(); -} - -int storeinput_ (int* runNo, int* eventNo, int* ntracks) -{ - return storeInput(*runNo,*eventNo,*ntracks); -} - -int closeinput_ () -{ - return closeInput(); -} diff --git a/src/programs/Simulation/gxtwist/hddmOutput.c b/src/programs/Simulation/gxtwist/hddmOutput.c deleted file mode 100644 index de60b0082b..0000000000 --- a/src/programs/Simulation/gxtwist/hddmOutput.c +++ /dev/null @@ -1,98 +0,0 @@ -/* - * hddmOutput - functions to handle output of simulation results from HDGeant - * through the standard hddm i/o mechanism. - * - * Interface: - * openOutput(filename) - open output stream to file - * loadOutput() - load output event from hit structures - * flushOutput() - flush current event structure to output stream - * closeOutput() - close currently open output stream - * - * Richard Jones - * University of Connecticut - * July 13, 2001 - */ - -#include -#include -#include - -#include -#include - -#include "memcheck.h" - -mc_s_iostream_t* thisOutputStream = 0; -mc_s_HDDM_t* thisOutputEvent = 0; -extern mc_s_HDDM_t* thisInputEvent; - -int openOutput (char* filename) -{ - thisOutputStream = init_mc_s_HDDM(filename); - return (thisOutputStream == 0); -} - -int flushOutput () -{ - if (thisOutputEvent != 0) - { - flush_mc_s_HDDM(thisOutputEvent, thisOutputStream); - thisOutputEvent = 0; - } - checkpoint(); - return 0; -} - -int closeOutput () -{ - if (thisOutputStream) - { - close_mc_s_HDDM(thisOutputStream); - thisOutputStream = 0; - } - return 0; -} - -int loadOutput () -{ - int packages_hit=0; - - if (thisOutputEvent) - { - flush_mc_s_HDDM(thisOutputEvent, 0); - } - - thisOutputEvent = thisInputEvent; - thisInputEvent = 0; - if (thisOutputEvent == 0) - { - static int eventNo = 0; - thisOutputEvent = make_mc_s_HDDM(); - thisOutputEvent->physicsEvents = make_mc_s_PhysicsEvents(1); - thisOutputEvent->physicsEvents->in[0].eventNo = ++eventNo; - } - return packages_hit; -} - -/* entry points from Fortran */ - -int openoutput_ (char* filename) -{ - int retcode = openOutput(strtok(filename," ")); - return retcode; -} - -int flushoutput_ () -{ - return flushOutput(); -} - -int loadoutput_ () -{ - return loadOutput(); -} - -int closeoutput_ () -{ - return closeOutput(); -} diff --git a/src/programs/Simulation/gxtwist/hddmOutput.h b/src/programs/Simulation/gxtwist/hddmOutput.h deleted file mode 100644 index 1c5df71706..0000000000 --- a/src/programs/Simulation/gxtwist/hddmOutput.h +++ /dev/null @@ -1,10 +0,0 @@ -#if 0 -s_CentralDC_t* pickCentralDC (void); -s_ForwardDC_t* pickForwardDC (void); -s_StartCntr_t* pickStartCntr (void); -s_BarrelEMcal_t* pickBarrelEMcal (void); -s_Cerenkov_t* pickCerenkov (void); -s_ForwardTOF_t* pickForwardTOF (void); -s_ForwardEMcal_t* pickForwardEMcal (void); -s_UpstreamEMveto_t* pickUpstreamEMveto (void); -#endif diff --git a/src/programs/Simulation/gxtwist/hddm_s.c b/src/programs/Simulation/gxtwist/hddm_s.c deleted file mode 100644 index ced59c51c4..0000000000 --- a/src/programs/Simulation/gxtwist/hddm_s.c +++ /dev/null @@ -1,1157 +0,0 @@ -/* - * hddm_s.c - DO NOT EDIT THIS FILE - * - * This file was generated automatically by hddm-c from the file - * hddm/mc.xml - * This c file contains the i/o interface to the c structures - * described in the data model (from hddm/mc.xml). - * Any program that needs access to the data described in the model - * can compile this source file, and make use of the input/output - * services provided. - * - * The hddm data model tool set was written by - * Richard Jones, University of Connecticut. - * - * For more information see the following web site - * - * http://zeus.phys.uconn.edu/halld/datamodel/doc - */ - -int hddm_nullTarget=0; -#define HDDM_NULL (void*)&hddm_nullTarget - -#include "hddm_s.h" - - -s_HDDM_t* make_s_HDDM() -{ - int size = sizeof(s_HDDM_t); - s_HDDM_t* p = (s_HDDM_t*)MALLOC(size,"s_HDDM_t"); - p->physicsEvents = (s_PhysicsEvents_t*)&hddm_nullTarget; - return p; -} - -s_PhysicsEvents_t* make_s_PhysicsEvents(int n) -{ - int i; - int rep = (n > 1) ? n-1 : 0; - int size = sizeof(s_PhysicsEvents_t) + rep * sizeof(s_PhysicsEvent_t); - s_PhysicsEvents_t* p = (s_PhysicsEvents_t*)MALLOC(size,"s_PhysicsEvents_t"); - p->mult = 0; - for (i=0; iin[i]; - pp->eventNo = 0; - pp->runNo = 0; - pp->reactions = (s_Reactions_t*)&hddm_nullTarget; - } - return p; -} - -s_Reactions_t* make_s_Reactions(int n) -{ - int i; - int rep = (n > 1) ? n-1 : 0; - int size = sizeof(s_Reactions_t) + rep * sizeof(s_Reaction_t); - s_Reactions_t* p = (s_Reactions_t*)MALLOC(size,"s_Reactions_t"); - p->mult = 0; - for (i=0; iin[i]; - pp->type = 0; - pp->weight = 0; - pp->beam = (s_Beam_t*)&hddm_nullTarget; - pp->target = (s_Target_t*)&hddm_nullTarget; - pp->vertices = (s_Vertices_t*)&hddm_nullTarget; - } - return p; -} - -s_Beam_t* make_s_Beam() -{ - int size = sizeof(s_Beam_t); - s_Beam_t* p = (s_Beam_t*)MALLOC(size,"s_Beam_t"); - p->type = 0; - p->momentum = (s_Momentum_t*)&hddm_nullTarget; - p->properties = (s_Properties_t*)&hddm_nullTarget; - return p; -} - -s_Momentum_t* make_s_Momentum() -{ - int size = sizeof(s_Momentum_t); - s_Momentum_t* p = (s_Momentum_t*)MALLOC(size,"s_Momentum_t"); - p->E = 0; - p->px = 0; - p->py = 0; - p->pz = 0; - return p; -} - -s_Properties_t* make_s_Properties() -{ - int size = sizeof(s_Properties_t); - s_Properties_t* p = (s_Properties_t*)MALLOC(size,"s_Properties_t"); - p->charge = 0; - p->mass = 0; - return p; -} - -s_Target_t* make_s_Target() -{ - int size = sizeof(s_Target_t); - s_Target_t* p = (s_Target_t*)MALLOC(size,"s_Target_t"); - p->type = 0; - p->momentum = (s_Momentum_t*)&hddm_nullTarget; - p->properties = (s_Properties_t*)&hddm_nullTarget; - return p; -} - -s_Vertices_t* make_s_Vertices(int n) -{ - int i; - int rep = (n > 1) ? n-1 : 0; - int size = sizeof(s_Vertices_t) + rep * sizeof(s_Vertex_t); - s_Vertices_t* p = (s_Vertices_t*)MALLOC(size,"s_Vertices_t"); - p->mult = 0; - for (i=0; iin[i]; - pp->products = (s_Products_t*)&hddm_nullTarget; - pp->origin = (s_Origin_t*)&hddm_nullTarget; - } - return p; -} - -s_Products_t* make_s_Products(int n) -{ - int i; - int rep = (n > 1) ? n-1 : 0; - int size = sizeof(s_Products_t) + rep * sizeof(s_Product_t); - s_Products_t* p = (s_Products_t*)MALLOC(size,"s_Products_t"); - p->mult = 0; - for (i=0; iin[i]; - pp->decayVertex = 0; - pp->type = 0; - pp->momentum = (s_Momentum_t*)&hddm_nullTarget; - pp->properties = (s_Properties_t*)&hddm_nullTarget; - } - return p; -} - -s_Origin_t* make_s_Origin() -{ - int size = sizeof(s_Origin_t); - s_Origin_t* p = (s_Origin_t*)MALLOC(size,"s_Origin_t"); - p->t = 0; - p->vx = 0; - p->vy = 0; - p->vz = 0; - return p; -} - -char HDDM_s_DocumentString[] = -"\n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -" \n" -"\n" -; - - -static s_HDDM_t* unpack_s_HDDM(XDR* xdrs, popNode* pop) -{ - s_HDDM_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_HDDM(); - { - int p; - void* (*ptr) = (void**) &this1->physicsEvents; - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_PhysicsEvents_t* unpack_s_PhysicsEvents(XDR* xdrs, popNode* pop) -{ - s_PhysicsEvents_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - int m; - unsigned int mult; - xdr_u_int(xdrs,&mult); - this1 = make_s_PhysicsEvents(mult); - this1->mult = mult; - for (m = 0; m < mult; m++ ) - { - int p; - void* (*ptr) = (void**) &this1->in[m].reactions; - xdr_int(xdrs,&this1->in[m].eventNo); - xdr_int(xdrs,&this1->in[m].runNo); - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Reactions_t* unpack_s_Reactions(XDR* xdrs, popNode* pop) -{ - s_Reactions_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - int m; - unsigned int mult; - xdr_u_int(xdrs,&mult); - this1 = make_s_Reactions(mult); - this1->mult = mult; - for (m = 0; m < mult; m++ ) - { - int p; - void* (*ptr) = (void**) &this1->in[m].beam; - xdr_int(xdrs,&this1->in[m].type); - xdr_float(xdrs,&this1->in[m].weight); - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Beam_t* unpack_s_Beam(XDR* xdrs, popNode* pop) -{ - s_Beam_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_Beam(); - { - int p; - void* (*ptr) = (void**) &this1->momentum; - xdr_int(xdrs,(int*)&this1->type); - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Momentum_t* unpack_s_Momentum(XDR* xdrs, popNode* pop) -{ - s_Momentum_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_Momentum(); - { - xdr_float(xdrs,&this1->E); - xdr_float(xdrs,&this1->px); - xdr_float(xdrs,&this1->py); - xdr_float(xdrs,&this1->pz); - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Properties_t* unpack_s_Properties(XDR* xdrs, popNode* pop) -{ - s_Properties_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_Properties(); - { - xdr_int(xdrs,&this1->charge); - xdr_float(xdrs,&this1->mass); - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Target_t* unpack_s_Target(XDR* xdrs, popNode* pop) -{ - s_Target_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_Target(); - { - int p; - void* (*ptr) = (void**) &this1->momentum; - xdr_int(xdrs,(int*)&this1->type); - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Vertices_t* unpack_s_Vertices(XDR* xdrs, popNode* pop) -{ - s_Vertices_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - int m; - unsigned int mult; - xdr_u_int(xdrs,&mult); - this1 = make_s_Vertices(mult); - this1->mult = mult; - for (m = 0; m < mult; m++ ) - { - int p; - void* (*ptr) = (void**) &this1->in[m].products; - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Products_t* unpack_s_Products(XDR* xdrs, popNode* pop) -{ - s_Products_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - int m; - unsigned int mult; - xdr_u_int(xdrs,&mult); - this1 = make_s_Products(mult); - this1->mult = mult; - for (m = 0; m < mult; m++ ) - { - int p; - void* (*ptr) = (void**) &this1->in[m].momentum; - xdr_int(xdrs,&this1->in[m].decayVertex); - xdr_int(xdrs,(int*)&this1->in[m].type); - for (p = 0; p < pop->popListLength; p++) - { - popNode* pnode = pop->popList[p]; - if (pnode) - { - int kid = pnode->inParent; - ptr[kid] = pnode->unpacker(xdrs,pnode); - } - else - { - unsigned int skip; - xdr_u_int(xdrs,&skip); - xdr_setpos(xdrs,xdr_getpos(xdrs)+skip); - } - } - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -static s_Origin_t* unpack_s_Origin(XDR* xdrs, popNode* pop) -{ - s_Origin_t* this1 = HDDM_NULL; - unsigned int size; - if (! xdr_u_int(xdrs,&size)) - { - return this1; - } - else if (size > 0) - { - int start = xdr_getpos(xdrs); - this1 = make_s_Origin(); - { - xdr_float(xdrs,&this1->t); - xdr_float(xdrs,&this1->vx); - xdr_float(xdrs,&this1->vy); - xdr_float(xdrs,&this1->vz); - } - xdr_setpos(xdrs,start+size); - } - return this1; -} - -s_HDDM_t* read_s_HDDM(s_iostream_t* fp) -{ - s_HDDM_t* nextEvent = unpack_s_HDDM(fp->xdrs,fp->popTop); - return (nextEvent == HDDM_NULL)? 0 : nextEvent; -} - -static int pack_s_HDDM(XDR* xdrs, s_HDDM_t* this1); -static int pack_s_PhysicsEvents(XDR* xdrs, s_PhysicsEvents_t* this1); -static int pack_s_Reactions(XDR* xdrs, s_Reactions_t* this1); -static int pack_s_Beam(XDR* xdrs, s_Beam_t* this1); -static int pack_s_Momentum(XDR* xdrs, s_Momentum_t* this1); -static int pack_s_Properties(XDR* xdrs, s_Properties_t* this1); -static int pack_s_Target(XDR* xdrs, s_Target_t* this1); -static int pack_s_Vertices(XDR* xdrs, s_Vertices_t* this1); -static int pack_s_Products(XDR* xdrs, s_Products_t* this1); -static int pack_s_Origin(XDR* xdrs, s_Origin_t* this1); - -static int pack_s_HDDM(XDR* xdrs, s_HDDM_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - if (this1->physicsEvents != (s_PhysicsEvents_t*)&hddm_nullTarget) - { - pack_s_PhysicsEvents(xdrs,this1->physicsEvents); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_PhysicsEvents(XDR* xdrs, s_PhysicsEvents_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - xdr_u_int(xdrs,&this1->mult); - for (m = 0; m < this1->mult; m++) - { - xdr_int(xdrs,&this1->in[m].eventNo); - xdr_int(xdrs,&this1->in[m].runNo); - if (this1->in[m].reactions != (s_Reactions_t*)&hddm_nullTarget) - { - pack_s_Reactions(xdrs,this1->in[m].reactions); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Reactions(XDR* xdrs, s_Reactions_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - xdr_u_int(xdrs,&this1->mult); - for (m = 0; m < this1->mult; m++) - { - xdr_int(xdrs,&this1->in[m].type); - xdr_float(xdrs,&this1->in[m].weight); - if (this1->in[m].beam != (s_Beam_t*)&hddm_nullTarget) - { - pack_s_Beam(xdrs,this1->in[m].beam); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->in[m].target != (s_Target_t*)&hddm_nullTarget) - { - pack_s_Target(xdrs,this1->in[m].target); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->in[m].vertices != (s_Vertices_t*)&hddm_nullTarget) - { - pack_s_Vertices(xdrs,this1->in[m].vertices); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Beam(XDR* xdrs, s_Beam_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - xdr_int(xdrs,(int*)&this1->type); - if (this1->momentum != (s_Momentum_t*)&hddm_nullTarget) - { - pack_s_Momentum(xdrs,this1->momentum); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->properties != (s_Properties_t*)&hddm_nullTarget) - { - pack_s_Properties(xdrs,this1->properties); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Momentum(XDR* xdrs, s_Momentum_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - xdr_float(xdrs,&this1->E); - xdr_float(xdrs,&this1->px); - xdr_float(xdrs,&this1->py); - xdr_float(xdrs,&this1->pz); - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Properties(XDR* xdrs, s_Properties_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - xdr_int(xdrs,&this1->charge); - xdr_float(xdrs,&this1->mass); - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Target(XDR* xdrs, s_Target_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - xdr_int(xdrs,(int*)&this1->type); - if (this1->momentum != (s_Momentum_t*)&hddm_nullTarget) - { - pack_s_Momentum(xdrs,this1->momentum); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->properties != (s_Properties_t*)&hddm_nullTarget) - { - pack_s_Properties(xdrs,this1->properties); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Vertices(XDR* xdrs, s_Vertices_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - xdr_u_int(xdrs,&this1->mult); - for (m = 0; m < this1->mult; m++) - { - if (this1->in[m].products != (s_Products_t*)&hddm_nullTarget) - { - pack_s_Products(xdrs,this1->in[m].products); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->in[m].origin != (s_Origin_t*)&hddm_nullTarget) - { - pack_s_Origin(xdrs,this1->in[m].origin); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Products(XDR* xdrs, s_Products_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - xdr_u_int(xdrs,&this1->mult); - for (m = 0; m < this1->mult; m++) - { - xdr_int(xdrs,&this1->in[m].decayVertex); - xdr_int(xdrs,(int*)&this1->in[m].type); - if (this1->in[m].momentum != (s_Momentum_t*)&hddm_nullTarget) - { - pack_s_Momentum(xdrs,this1->in[m].momentum); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - if (this1->in[m].properties != (s_Properties_t*)&hddm_nullTarget) - { - pack_s_Properties(xdrs,this1->in[m].properties); - } - else - { - int zero=0; - xdr_int(xdrs,&zero); - } - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -static int pack_s_Origin(XDR* xdrs, s_Origin_t* this1) -{ - int m; - unsigned int size=0; - int base,start,end; - base = xdr_getpos(xdrs); - xdr_u_int(xdrs,&size); - start = xdr_getpos(xdrs); - - m = 0; /* avoid warnings from -Wall */ - { - xdr_float(xdrs,&this1->t); - xdr_float(xdrs,&this1->vx); - xdr_float(xdrs,&this1->vy); - xdr_float(xdrs,&this1->vz); - } - FREE(this1); - end = xdr_getpos(xdrs); - xdr_setpos(xdrs,base); - size = end-start; - xdr_u_int(xdrs,&size); - xdr_setpos(xdrs,end); - return size; -} - -int flush_s_HDDM(s_HDDM_t* this1,s_iostream_t* fp) -{ - if (this1 == 0) - { - return 0; - } - else if (fp == 0) - { - XDR* xdrs = (XDR*)malloc(sizeof(XDR)); - int max_buffer_size = 1000000; - char* dump = (char*)malloc(max_buffer_size); - xdrmem_create(xdrs,dump,max_buffer_size,XDR_ENCODE); - pack_s_HDDM(xdrs,this1); - xdr_destroy(xdrs); - free(xdrs); - free(dump); - return 0; - } - else if (fp->iomode == HDDM_STREAM_OUTPUT) - { - pack_s_HDDM(fp->xdrs,this1); - return 0; - } - return 0; -} - -static int getTag(char* d, char* tag) -{ - int level; - char* token; - char line[500]; - strncpy(line,d,500); - line[499] = 0; - level = index(line,'<')-line; - if (level < 500 && - (token = strtok(line+level+1," >"))) - { - strncpy(tag,token,500); - return level/2; - } - return -1; -} - -static char* getEndTag(char* d, char* tag) -{ - char line[500]; - char endTag[510]; - strncpy(line,d,500); - line[499] = 0; - if (strstr(strtok(line,"\n"),"/>") == 0) - { - sprintf(endTag,"",tag); - } - else - { - strcpy(endTag,"/>"); - } - return strstr(d,endTag); -} - -static void collide(char* tag) - { - fprintf(stderr,"HDDM Error: "); - fprintf(stderr,"input template model for tag "); - fprintf(stderr,"%s does not match c code.", tag); - fprintf(stderr,"\nPlease recompile.\n"); - exit(9); - } - -static popNode* matches(char* b, char* c) -{ - char btag[500]; - char ctag[500]; - int blevel, clevel; - int ptrSeqNo = 0; - blevel = getTag(b,btag); - while ((clevel = getTag(c,ctag)) == blevel) - { - if ((clevel == blevel) && (strcmp(ctag,btag) == 0)) - { - popNode* this1 = (popNode*)malloc(sizeof(popNode)); - int len = index(c+1,'\n') - c; - if (strncmp(c,b,len) != 0) - { - collide(btag); - } - if (strcmp(btag,"HDDM") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_HDDM; - } - else if (strcmp(btag,"physicsEvent") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_PhysicsEvents; - } - else if (strcmp(btag,"reaction") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Reactions; - } - else if (strcmp(btag,"beam") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Beam; - } - else if (strcmp(btag,"momentum") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Momentum; - } - else if (strcmp(btag,"properties") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Properties; - } - else if (strcmp(btag,"target") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Target; - } - else if (strcmp(btag,"vertex") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Vertices; - } - else if (strcmp(btag,"product") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Products; - } - else if (strcmp(btag,"origin") == 0) - { - this1->unpacker = (void*(*)(XDR*,popNode*))unpack_s_Origin; - } - else - { - collide(btag); - } - this1->inParent = ptrSeqNo; - this1->popListLength = 0; - c = index(c+1,'\n'); - b = index(b+1,'\n'); - while (getTag(b,btag) > blevel) - { - this1->popList[this1->popListLength++] = matches(b,c); - if (this1->popListLength > 99) - { - fprintf(stderr,"hddm error - posList overflow.\n"); - fprintf(stderr,"Increase MAX_POPLIST_LENGTH and recompile.\n"); - exit(9); - } - b = getEndTag(b,btag); - b = index(b+1,'\n'); - } - return this1; - } - else - { - c = getEndTag(c,ctag); - c = index(c+1,'\n'); - ++ptrSeqNo; - } - } - return 0; -} - -s_iostream_t* open_s_HDDM(char* filename) -{ - s_iostream_t* fp = (s_iostream_t*)malloc(sizeof(s_iostream_t)); - char* p; - char* head; - if (filename) - { - fp->fd = fopen(filename,"r"); - } - else - { - fp->fd = fdopen(0,"r"); - } - if (fp->fd == 0) - { - free(fp); - return 0; - } - fp->iomode = HDDM_STREAM_INPUT; - head = (char*)malloc(1000000); - *head = 0; - for (p = head; - strstr(head,"") == 0; - p += strlen(p)) - { - if (p-head < 999000) - { - fgets(p,1000,fp->fd); - } - else - { - break; - } - } - fp->popTop = matches(head,HDDM_s_DocumentString); - free(head); - if (fp->popTop == 0) - { - fprintf(stderr,"HDDM Error: "); - fprintf(stderr,"input template model "); - fprintf(stderr,"does not match c code."); - fprintf(stderr," Please recompile.\n"); - exit(9); - } - fp->filename = (char*)malloc(strlen(filename) + 1); - strcpy(fp->filename,filename); - fp->xdrs = (XDR*)malloc(sizeof(XDR)); - xdrstdio_create(fp->xdrs,fp->fd,XDR_DECODE); - return fp; -} - -s_iostream_t* init_s_HDDM(char* filename) -{ - int len; - char* head; - s_iostream_t* fp = (s_iostream_t*)malloc(sizeof(s_iostream_t)); - if (filename) - { - fp->fd = fopen(filename,"w"); - } - else - { - fp->fd = fdopen(1,"w"); - } - if (fp->fd == 0) - { - free(fp); - return 0; - } - fp->iomode = HDDM_STREAM_OUTPUT; - len = strlen(HDDM_s_DocumentString); - head = (char*)malloc(len+1); - strcpy(head,HDDM_s_DocumentString); - if (fwrite(head,1,len,fp->fd) != len) - { - fprintf(stderr,"HDDM Error: "); - fprintf(stderr,"error writing to "); - fprintf(stderr,"output file %s\n",filename); - exit(9); - } - fp->filename = (char*)malloc(strlen(filename) + 1); - strcpy(fp->filename,filename); - fp->popTop = 0; - fp->xdrs = (XDR*)malloc(sizeof(XDR)); - xdrstdio_create(fp->xdrs,fp->fd,XDR_ENCODE); - free(head); - return fp; -} - -void popaway(popNode* p) -{ - if (p) - { - int n; - for (n = 0; n < p->popListLength; n++) - { - popaway(p->popList[n]); - } - free(p); - } -} - -void close_s_HDDM(s_iostream_t* fp) -{ - xdr_destroy(fp->xdrs); - free(fp->xdrs); - fclose(fp->fd); - free(fp->filename); - popaway(fp->popTop); - free(fp); -} diff --git a/src/programs/Simulation/gxtwist/hddm_s.h b/src/programs/Simulation/gxtwist/hddm_s.h deleted file mode 100644 index 94d38837b4..0000000000 --- a/src/programs/Simulation/gxtwist/hddm_s.h +++ /dev/null @@ -1,234 +0,0 @@ -/* - * hddm_s.h - DO NOT EDIT THIS FILE - * - * This file was generated automatically by hddm-c from the file - * hddm/mc.xml - * This header file defines the c structures that hold the data - * described in the data model (from hddm/mc.xml). - * Any program that needs access to the data described in the model - * can include this header file, and make use of the input/output - * services provided in hddm_s.c - * - * The hddm data model tool set was written by - * Richard Jones, University of Connecticut. - * - * For more information see the following web site - * - * http://zeus.phys.uconn.edu/halld/datamodel/doc - * - */ - -#include -#include -#include -#include -#include -#include - -#define MALLOC(N,S) malloc(N) -#define FREE(P) free(P) - -#ifndef SAW_s_Momentum_t -#define SAW_s_Momentum_t - -typedef struct { - float E; - float px; - float py; - float pz; -} s_Momentum_t; -#endif /* s_Momentum_t */ - -#ifndef SAW_s_Properties_t -#define SAW_s_Properties_t - -typedef struct { - int charge; - float mass; -} s_Properties_t; -#endif /* s_Properties_t */ - -#ifndef SAW_s_Beam_t -#define SAW_s_Beam_t - -typedef struct { - Particle_t type; - s_Momentum_t* momentum; - s_Properties_t* properties; -} s_Beam_t; -#endif /* s_Beam_t */ - -#ifndef SAW_s_Target_t -#define SAW_s_Target_t - -typedef struct { - Particle_t type; - s_Momentum_t* momentum; - s_Properties_t* properties; -} s_Target_t; -#endif /* s_Target_t */ - -#ifndef SAW_s_Product_t -#define SAW_s_Product_t - -typedef struct { - int decayVertex; - Particle_t type; - s_Momentum_t* momentum; - s_Properties_t* properties; -} s_Product_t; - -typedef struct { - unsigned int mult; - s_Product_t in[1]; -} s_Products_t; -#endif /* s_Product_t */ - -#ifndef SAW_s_Origin_t -#define SAW_s_Origin_t - -typedef struct { - float t; - float vx; - float vy; - float vz; -} s_Origin_t; -#endif /* s_Origin_t */ - -#ifndef SAW_s_Vertex_t -#define SAW_s_Vertex_t - -typedef struct { - s_Products_t* products; - s_Origin_t* origin; -} s_Vertex_t; - -typedef struct { - unsigned int mult; - s_Vertex_t in[1]; -} s_Vertices_t; -#endif /* s_Vertex_t */ - -#ifndef SAW_s_Reaction_t -#define SAW_s_Reaction_t - -typedef struct { - int type; - float weight; - s_Beam_t* beam; - s_Target_t* target; - s_Vertices_t* vertices; -} s_Reaction_t; - -typedef struct { - unsigned int mult; - s_Reaction_t in[1]; -} s_Reactions_t; -#endif /* s_Reaction_t */ - -#ifndef SAW_s_PhysicsEvent_t -#define SAW_s_PhysicsEvent_t - -typedef struct { - int eventNo; - int runNo; - s_Reactions_t* reactions; -} s_PhysicsEvent_t; - -typedef struct { - unsigned int mult; - s_PhysicsEvent_t in[1]; -} s_PhysicsEvents_t; -#endif /* s_PhysicsEvent_t */ - -#ifndef SAW_s_HDDM_t -#define SAW_s_HDDM_t - -typedef struct { - s_PhysicsEvents_t* physicsEvents; -} s_HDDM_t; -#endif /* s_HDDM_t */ - -#ifdef __cplusplus -extern "C" { -#endif - -s_HDDM_t* make_s_HDDM(); - -s_PhysicsEvents_t* make_s_PhysicsEvents(int n); - -s_Reactions_t* make_s_Reactions(int n); - -s_Beam_t* make_s_Beam(); - -s_Momentum_t* make_s_Momentum(); - -s_Properties_t* make_s_Properties(); - -s_Target_t* make_s_Target(); - -s_Vertices_t* make_s_Vertices(int n); - -s_Products_t* make_s_Products(int n); - -s_Origin_t* make_s_Origin(); - -#ifdef __cplusplus -} -#endif - -#ifndef s_DocumentString -#define s_DocumentString - -extern char HDDM_s_DocumentString[]; - -#ifdef INLINE_PREPEND_UNDERSCORES -#define inline __inline -#endif - -#endif /* s_DocumentString */ - -#ifndef HDDM_STREAM_INPUT -#define HDDM_STREAM_INPUT -91 -#define HDDM_STREAM_OUTPUT -92 - -struct popNode_s { - void* (*unpacker)(XDR*, struct popNode_s*); - int inParent; - int popListLength; - struct popNode_s* popList[99]; -}; -typedef struct popNode_s popNode; - -typedef struct { - FILE* fd; - int iomode; - char* filename; - XDR* xdrs; - popNode* popTop; -} s_iostream_t; - -#endif /* HDDM_STREAM_INPUT */ - -#ifdef __cplusplus -extern "C" { -#endif - -s_HDDM_t* read_s_HDDM(s_iostream_t* fp); - -int flush_s_HDDM(s_HDDM_t* this1,s_iostream_t* fp); - -s_iostream_t* open_s_HDDM(char* filename); - -s_iostream_t* init_s_HDDM(char* filename); - -void close_s_HDDM(s_iostream_t* fp); - -#ifdef __cplusplus -} -#endif - -#if !defined HDDM_NULL -extern int hddm_nullTarget; -# define HDDM_NULL (void*)&hddm_nullTarget -#endif diff --git a/src/programs/Simulation/gxtwist/hdds/ElectronDump.xml b/src/programs/Simulation/gxtwist/hdds/ElectronDump.xml deleted file mode 100644 index c8040d49a6..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/ElectronDump.xml +++ /dev/null @@ -1,343 +0,0 @@ - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - diff --git a/src/programs/Simulation/gxtwist/hdds/FocalPlane.xml b/src/programs/Simulation/gxtwist/hdds/FocalPlane.xml deleted file mode 100644 index 5e72d52d8e..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/FocalPlane.xml +++ /dev/null @@ -1,886 +0,0 @@ - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - diff --git a/src/programs/Simulation/gxtwist/hdds/HDDS-1_1.xsd b/src/programs/Simulation/gxtwist/hdds/HDDS-1_1.xsd deleted file mode 100644 index 755cd8dbca..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/HDDS-1_1.xsd +++ /dev/null @@ -1,2673 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/programs/Simulation/gxtwist/hdds/Makefile b/src/programs/Simulation/gxtwist/hdds/Makefile deleted file mode 100644 index 4ab7358320..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/Makefile +++ /dev/null @@ -1,23 +0,0 @@ -OS_RELEASE = $(shell $(HALLD_HOME)/src/BMS/osrelease.pl) - -HDDS_GEANT = $(HDDS_HOME)/$(OS_RELEASE)/bin/hdds-geant - -HDDS_SCHEMA = HDDS-1_1.xsd - -XML_SOURCE = TaggerArea.xml FocalPlane.xml Materials.xml \ - Regions.xml Spectrometer.xml ElectronDump.xml - -hddsGeant3_tagger.F: $(XML_SOURCE) $(HDDS_SCHEMA) $(HDDS_GEANT) - $(HDDS_GEANT) TaggerArea.xml >$@ - cp $@ ../ - -$(HDDS_GEANT): - @echo "Application hdds-geant has not yet been built." - @echo "You must run \"make\" in the primary hdds area first." - -$(HDDS_SCHEMA): - cp $(HDDS_HOME)/$(HDDS_SCHEMA) . - -clean: - rm -f *.F *.o core *.depend - diff --git a/src/programs/Simulation/gxtwist/hdds/Materials.xml b/src/programs/Simulation/gxtwist/hdds/Materials.xml deleted file mode 100644 index aad49a0b73..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/Materials.xml +++ /dev/null @@ -1,839 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/programs/Simulation/gxtwist/hdds/Regions.xml b/src/programs/Simulation/gxtwist/hdds/Regions.xml deleted file mode 100644 index c4a744e480..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/Regions.xml +++ /dev/null @@ -1,73 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/programs/Simulation/gxtwist/hdds/Spectrometer.xml b/src/programs/Simulation/gxtwist/hdds/Spectrometer.xml deleted file mode 100644 index 5c63a1a314..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/Spectrometer.xml +++ /dev/null @@ -1,238 +0,0 @@ - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - diff --git a/src/programs/Simulation/gxtwist/hdds/TaggerArea.xml b/src/programs/Simulation/gxtwist/hdds/TaggerArea.xml deleted file mode 100644 index 3192fa65b1..0000000000 --- a/src/programs/Simulation/gxtwist/hdds/TaggerArea.xml +++ /dev/null @@ -1,277 +0,0 @@ - - - - - - - -]> - - - - - &Material_s; - - - &Regions_s; - - - &Spectrometer_s; - &FocalPlane_s; - &ElectronDump_s; - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- diff --git a/src/programs/Simulation/gxtwist/hdtrackparams.inc b/src/programs/Simulation/gxtwist/hdtrackparams.inc deleted file mode 100644 index 4a29df1e02..0000000000 --- a/src/programs/Simulation/gxtwist/hdtrackparams.inc +++ /dev/null @@ -1,4 +0,0 @@ - - real bfield - integer nosecondaries - common /hdtrackparams/ bfield, nosecondaries diff --git a/src/programs/Simulation/gxtwist/memcheck.c b/src/programs/Simulation/gxtwist/memcheck.c deleted file mode 100644 index 5a333af9b7..0000000000 --- a/src/programs/Simulation/gxtwist/memcheck.c +++ /dev/null @@ -1,156 +0,0 @@ -/* - * memcheck - a simple memory management checking tool - * - * Typically the management of a memory structure is restricted to - * a limited segment of code. General malloc/free memory leak - * tools can be found that will trap every call to malloc or free. - * Often it is simpler just to insert some checkpoint calls around - * the relevant calls, and just study the behavior in that region. - * This is the purpose of the memcheck routines. - * - * Richard Jones - July 18, 2000 - * University of Connecticut - * - * - * Instructions: - * ------------- - * 1) After each relevant malloc, insert a call to checkin(pointer) as - * p = malloc(n); // old code - * checkin(p,string); // user string helps trace memory leaks - * or the following more compact form will have the same effect - * p = checkin(malloc(size_t),string); - * - * 2) Before each relevant free, insert a call to checkout(pointer) as - * checkout(p); // new insertion - * free(p); // old code - * - * 3) Any time you think the memory balance should be zero do checkpoint() - * checkpoint(); // look for leaks - * - * - * Programmer's Notes: - * ------------------- - * 1) The "bintree" binary tree package is used to store the allocation - * tables. - */ - -#include -#include -#include -#include - -#include - -typedef struct { - void* addr; - int count; - char* tag; -} memblock_t; - -binTree_t* memcheckTree = 0; -int* addressRef = 0; -int nodeCount = 0; - -void* checkin (void* p, char* tag) -{ - int mark = (int*)p - addressRef; - void** twig = getTwig(&memcheckTree, mark); - if (*twig == 0) - { - memblock_t *blk = *twig = malloc(sizeof(memblock_t)); - if (tag) - { - blk->tag = malloc(strlen(tag)+1); - strcpy(blk->tag,tag); - } - else - { - blk->tag = malloc(7); - strcpy(blk->tag,"(null)"); - } - blk->count = 1; - blk->addr = p; - nodeCount++; - } - else if (((memblock_t*) *twig)->count == 0) - { - memblock_t *blk = *twig; - if (blk->tag) - { - free(blk->tag); - } - if (tag) - { - blk->tag = malloc(strlen(tag)+1); - strcpy(blk->tag,tag); - } - else - { - blk->tag = malloc(7); - strcpy(blk->tag,"(null)"); - } - blk->count = 1; - blk->addr = p; - } - else - { - memblock_t *blk = *twig; - fprintf(stderr,"memcheck report:"); - fprintf(stderr," reallocation of allocated memory block\n"); - fprintf(stderr," original tag was %s\n",blk->tag); - fprintf(stderr," second tag was %s\n",tag); - assert (1 == 0); - } - return p; -} - -void* checkout (void* p) -{ - int mark = (int*)p - addressRef; - void** twig = getTwig(&memcheckTree, mark); - if (*twig == 0) - { - fprintf(stderr,"memcheck report:"); - fprintf(stderr," attempt to free unallocated memory block\n"); -// assert (1 == 0); - } - else if (((memblock_t*) *twig)->count < 1) - { - memblock_t *blk = *twig; - fprintf(stderr,"memcheck report:"); - fprintf(stderr," attempt to refree freed memory block\n"); - fprintf(stderr," tag was %s\n",blk->tag); - assert (1 == 0); - } - else - { - memblock_t *blk = *twig; - blk->count = 0; - } - return p; -} - -void checkpoint () -{ - memblock_t* node; - int abort = 0; - while (node = pickTwig(&memcheckTree)) - { - if (node->count > 0) - { - fprintf(stderr,"memcheck report:"); - fprintf(stderr," checkpoint found allocated memory block\n"); - fprintf(stderr," tag was %s\n",node->tag); - ++abort; - } - nodeCount--; - free(node->tag); - free(node); - } - if (abort) - { - fprintf(stderr," quitting because of above error%s.\n", - ((abort == 1) ? "" : "s")); - exit(1); - } -} diff --git a/src/programs/Simulation/gxtwist/memcheck.h b/src/programs/Simulation/gxtwist/memcheck.h deleted file mode 100644 index decc2735af..0000000000 --- a/src/programs/Simulation/gxtwist/memcheck.h +++ /dev/null @@ -1,3 +0,0 @@ -void* checkin(void* p, char* tag); -void* checkout(void* p); -void checkpoint(); diff --git a/src/programs/Simulation/gxtwist/nt.inc b/src/programs/Simulation/gxtwist/nt.inc deleted file mode 100644 index ca244937ea..0000000000 --- a/src/programs/Simulation/gxtwist/nt.inc +++ /dev/null @@ -1,27 +0,0 @@ -********************************************************* -* * -* This file was generated by HUWFUN. * -* * -********************************************************* -* -* Ntuple Id: 2 -* Ntuple Title: fixed array hits -* Creation: 18/01/2006 22.04.20 -* -********************************************************* -* - LOGICAL CHAIN - CHARACTER*128 CFILE - INTEGER IDNEVT,NCHEVT,ICHEVT - REAL OBS(13) -* - COMMON /PAWIDN/ IDNEVT,OBS - COMMON /PAWCHN/ CHAIN, NCHEVT, ICHEVT - COMMON /PAWCHC/ CFILE -* -*-- Ntuple Variable Declarations -* - REAL xin(4),xout(4),pin(5),pout(5),dEsum - INTEGER kind -* - COMMON /PAWCR4/ kind,xin,xout,pin,pout,dEsum diff --git a/src/programs/Simulation/gxtwist/ray.kumac b/src/programs/Simulation/gxtwist/ray.kumac deleted file mode 100644 index f4d7d688c4..0000000000 --- a/src/programs/Simulation/gxtwist/ray.kumac +++ /dev/null @@ -1,50 +0,0 @@ -MACRO draw vol=hall the=30 phi=20 psi=0 x0=10 y0=10 sx=5 sy=5 gif=halld.gif - pict/create def - draw [vol] [the] [phi] [psi] [x0] [y0] [sx] [sy] - pict/print [gif] 600 600 - pict/delete def -RETURN - -MACRO init prec=0 fill=30 box=5.5 boy=-4 boz=100 - message 'Initialization of Hall D drawing macros' - message 'Below you will be prompted for some input.' - message 'To the first prompt, type HALL' - message 'and to the following three answer 10000.' - next - dopt rayt on - dopt mapp [prec] - dopt proj pers - persp hall 2000 - satt * fill [fill] - dopt user on - satt iyok colo 4 - satt iyup colo 4 - satt iydn colo 4 - satt lgbl colo 3 - satt cdsi colo 5 - satt cdso colo 5 - satt cylw colo 2 - satt vrtx colo 7 - satt fdcc colo 7 - satt fdca colo 6 - satt cere colo 5 - satt bcam colo 3 - satt ftof colo 6 - satt stra colo 6 - satt wall colo 3 - satt iyok lsty 3 - satt iyup lsty 3 - satt iydn lsty 3 - satt lgbl lsty 6 - satt wall lsty 4 - satt ftof lsty 2 - satt fdcc lsty 4 - satt fdca lsty 2 - satt lgbl lsty 4 - satt cere lsty 4 - satt bcam lsty 3 - valcut [box] [boy] [boz] - editv 1 hall - editv 0 - tim -RETURN diff --git a/src/programs/Simulation/gxtwist/seer.kumac b/src/programs/Simulation/gxtwist/seer.kumac deleted file mode 100644 index 8259ef2b68..0000000000 --- a/src/programs/Simulation/gxtwist/seer.kumac +++ /dev/null @@ -1,94 +0,0 @@ -macro cleancolor - dopt hide on - dopt shad on - dopt edge off - satt * seen 0 -* exec seer#show vol=tunl col=1 -* exec seer#show vol=area col=1 - exec seer#show vol=pxtu col=2 - exec seer#show vol=pitu col=2 - exec seer#show vol=fxch col=7 - exec seer#show vol=edut col=3 - exec seer#show vol=vbxf col=2 - exec seer#show vol=vbb1 col=3 - exec seer#show vol=vbb2 col=3 - exec seer#show vol=vbb3 col=3 - exec seer#show vol=vbb4 col=3 - exec seer#show vol=vbb5 col=3 - exec seer#show vol=vbw1 col=3 - exec seer#show vol=vbw2 col=3 - exec seer#show vol=vbw3 col=3 - exec seer#show vol=vbw4 col=3 - exec seer#show vol=vbw5 col=3 - exec seer#show vol=vbf1 col=3 - exec seer#show vol=vbf2 col=3 - exec seer#show vol=vbf3 col=3 - exec seer#show vol=vbf4 col=3 - exec seer#show vol=vbf5 col=3 - exec seer#show vol=shoe col=4 - exec seer#show vol=yokc col=4 - exec seer#show vol=yok1 col=4 - exec seer#show vol=yok2 col=4 - exec seer#show vol=quad col=6 - exec seer#show vol=quav col=2 - exec seer#show vol=goni col=3 - exec seer#show vol=vbe1 col=3 - exec seer#show vol=vbx1 col=1 - exec seer#show vol=pxho col=0 - exec seer#show vol=msfi col=6 - exec seer#show vol=mscp col=5 - exec seer#show vol=vbw3 col=3 - exec seer#show vol=vbw4 col=3 - exec seer#show vol=vbw5 col=3 - exec seer#show vol=vbf1 col=3 - exec seer#show vol=vbf2 col=3 - exec seer#show vol=vbf3 col=3 - exec seer#show vol=vbf4 col=3 - exec seer#show vol=vbf5 col=3 - exec seer#show vol=shoe col=4 - exec seer#show vol=yokc col=4 - exec seer#show vol=yok1 col=4 - exec seer#show vol=yok2 col=4 - exec seer#show vol=quad col=6 - exec seer#show vol=quap col=2 - exec seer#show vol=goni col=3 - exec seer#show vol=vbe1 col=3 - exec seer#show vol=vbx1 col=1 - exec seer#show vol=pxho col=0 - exec seer#show vol=msfi col=6 - exec seer#show vol=mscp col=5 - next - exec wc#draw hill 35 130 0 2 18 .018 .018 - message wc#draw hill 35 130 0 2 18 .018 .018 -return - -macro vb0 - satt * seen 0 - dopt hide on - dopt shad on - do i=1,4 - exec seer#vb seg=[i] - enddo - next - exec wc#draw site 110 110 0 10 10 .01 .01 - exec wc#pick o - next - exec wc#draw site 110 110 0 10 10 .1 .1 -return - -macro vb seg=1 -* exec seer#show vol=vbs[seg] col=1 - exec seer#show vol=vbw[seg] col=2 - exec seer#show vol=vbb[seg] col=3 -* exec seer#show vol=vbf[seg] col=5 - if (([seg].eq.1).or.([seg].eq.4)) then - exec seer#show vol=vbx[seg] col=6 fil=0 - exec seer#show vol=vbe[seg] col=7 - endif -return - -macro show vol col=1 fil=7 - satt [vol] seen 1 - satt [vol] colo [col] - satt [vol] fill [fil] -return diff --git a/src/programs/Simulation/gxtwist/taggerCoords.txt b/src/programs/Simulation/gxtwist/taggerCoords.txt deleted file mode 100644 index abee5c8e38..0000000000 --- a/src/programs/Simulation/gxtwist/taggerCoords.txt +++ /dev/null @@ -1,52 +0,0 @@ -=head1 Tagger Magnetic Field Map - - Subject: magnetic field map - From: "Guangliang Yang" - Date: Tue, 27 Sep 2005 15:52:57 +0100 - To: "Richard Jones" - CC: - -Please download the magnetic field map from - http:/nuclear.gla.ac.uk/~yang/Tagger/. - -There are two field maps, one with the quadrupole turned on and one with it -removed. Which is which is seen from the name of the file. - -The coordinate system I used is the same as you required. The origin is at the radiator position, the z axis is along the incoming main electron beam, the y axis is perpendicular to the tagger mid plane, and the x axis is opposite to the electron beam bending. The magnetic field map covers a range of x: -340 to 10 cm, step: 1cm; y: 0 to 1.5 cm , step: 0.1cm; z -10 to 1600cm, step 1cm. - -The straight line focal plane can be defined by two points (-70.663, 423.7086) and (-239.8134, 1388.486) . (units cm.) - -The co-ords for the first magnet pole shoe: - - X= 28.60552 Y= 1.5 Z= 304.86853 - X= -17.34935 Y= 1.5 Z= 300.11956 - X= -3.01983 Y= 1.5 Z= 610.90074 - X= -48.97470 Y= 1.5 Z= 606.15177 - -The co-ords for the second magnet pole shoe: - - X= -16.42643 Y= 1.5 Z= 653.28350 - X= -62.30180 Y= 1.5 Z= 647.81969 - X= -52.81217 Y= 1.5 Z= 958.78629 - X= -98.68754 Y= 1.5 Z= 953.32248 - -The co-ords for the vacuum chamber: - - X= 30.25178 Y=+- 3.8 Z= 303.53067 - X= -18.68722 Y=+- 3.8 Z= 298.47332 - X= -25.98418 Y=+- 3.8 Z= 369.08453 - X= -68.22507 Y=+- 3.8 Z= 418.49763 - X= -258.26128 Y=+- 3.8 Z= 1502.39221 - X= -205.65216 Y=+- 3.8 Z= 1511.60084 - X= -73.71934 Y=+- 3.8 Z= 957.80529 - X= -51.50141 Y=+- 3.8 Z= 960.45148 - X= -14.75792 Y=+- 3.8 Z= 651.97178 - X= -1.68197 Y=+- 3.8 Z= 612.54698 - X= 30.25178 Y=+- 3.8 Z= 303.53067 - -The co-ords for the vacuum chamber are based on the current design. Further modification is needed for the high energy end. Once I finish the modification, I will give you the new co-ords for this part. - -If you need any further information, please let me know. - - Regards - Yang diff --git a/src/programs/Simulation/gxtwist/taggerCoords2.txt b/src/programs/Simulation/gxtwist/taggerCoords2.txt deleted file mode 100644 index abe7d84373..0000000000 --- a/src/programs/Simulation/gxtwist/taggerCoords2.txt +++ /dev/null @@ -1,57 +0,0 @@ -=head1 Tagger Magnetic Field Map - - Subject: Co-ords for the tagger - From: "Guangliang Yang" - Date: Fri, 23 Dec 2005 00:50:30 -0000 - To: "Richard Jones" - CC: - -Recently I had modified the tagger vacuum system. At the high energy end, a curved window is used. Please see the attached picture curved_vbox_end.tif - -The following are the co-ord for the tagger magnets and the vacuum chamber. (by connecting all the points in series by using straight lines or arcs, you can get the magnets and vacuum chamber sketch.) - -The co-ords for the first magnet pole shoe: - - X= 27.94725 Y= +-1.5 Z= 305.40349 - X= -16.81438 Y= +-1.5 Z= 300.77783 - X= -3.55479 Y= +-1.5 Z= 610.24242 - X= -48.31642 Y= +-1.5 Z= 605.61679 - X= 27.94725 Y= +-1.5 Z= 305.40349 - -The co-ords for the second magnet pole shoe: - - X= -17.09296 Y= +-1.5 Z= 653.80816 - X= -61.77715 Y= +-1.5 Z= 648.48622 - X= -53.33682 Y= +-1.5 Z= 958.11976 - X= -98.02102 Y= +-1.5 Z= 952.79783 - X= -17.09296 Y= +-1.5 Z= 653.80816 - - -The above magnet parameters are for magnets with a 3 cm gap. ( in my previous email the magnets co-ords is based on a 2cm gap tosca calculation) - - -The co-ords for the vacuum chamber: - - X= 29.59349 Y=+- 3.8 Z= 304.6563 - X= -18.15224 Y=+- 3.8 Z= 299.13159 - X= -25.29826 Y=+- 3.8 Z= 368.28216 - X= -66.46648 Y=+- 3.8 Z= 408.45884 - - X= -244.06346 Y=+- 3.8 Z= 1421.41258 - X= -230.06929 Y=+- 3.8 Z= 1537.47241 - -(the above two points should be connected by using a arc, where its centre is at -450.09833, +-3.8, 1456.29632, and the radius for the arc is 2020cm.) - - X= -212.54711 Y=+- 3.8 Z= 1540.5432 - X= -73.57978 Y=+- 3.8 Z= 957.21941 - X= -52.02475 Y=+- 3.8 Z= 959.78664 - X= -15.42608 Y=+- 3.8 Z= 652.49608 - X= -2.21693 Y=+- 3.8 Z= 611.88870 - X= 29.59349 Y=+- 3.8 Z= 304.6563 - -The straight line focal plane can be defined by two points (-70.663, 423.7086) and (-239.8134, 1388.486) . (units cm.) - -The distance between the thin window defined by using above co-ords and the straight line focal plane is ~2 cm. - - Regards - Yang diff --git a/src/programs/Simulation/gxtwist/taggerCoords2.xls b/src/programs/Simulation/gxtwist/taggerCoords2.xls deleted file mode 100644 index dc60f49dc9274e65fb3f2328dbee74f1e5fbc9dd..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 48640 zcmeHw31A$>nQqN!G#W{^TfVVu$!$xvBwLboSU#~mlE$|U#x@wtVaw83QqYAYpWzTT zgoNb?aVK*s=xmFtGcTF{inyi_?f#4f35=8a+Rfy4(F<<2Oh%jGo5sSLjLeDlg{@U z_zlp=^>?I!+!z`%nyvPfeJ|(RL--k1>gOt~?utBuPo;i=`wZ2mMk}?sv$dn8zs+3N z+mjqH|H@aB@X!(>4;Bn>StzDLfMuzOx&hx~)D+=woP3U#&o4{q2jz2_8mFFk`w}&M z>DJOksHIT*)NowNT`r$9<#P-^L+U=M^HYJ;szUWGlpns}qcnJ2*`Y?&uR2wW>QaB* z+?zq|-ROpp`yf?<`(3!oko(xXVm@|mab%jxR+E*QSvs?%vZSPDN5#@J%ALd+6~&Pm z@DbB|`KNDAww>uOG*jiMBDYX=jUNxvL{+9@YG$xh0GnNOp_-%Wl-fa7=9ms=cJhpJ z0i02>)CSC~nhCyll*e~~O0}xMAF6um%`v@|=9s=3D^#Ug;wPph@Y564JS11FaEUHZ zb74C!QKx>2u2We^duztjEwta7>YCz6p1KvS!QVACFRBS>Q>ES*HsxD?SSH~#T!Fvt zWW76_CY7oDvEam-sr>(Bcu1KP&%PXe&eeK&GYGFZ2E6hZ@HxkT=VpX+R1UGL9OtLY zl<;YWLU9#GO7rQ$X&RZ}1*nz@9+J`-@DL@gAbyM{W+r&3ATBw<@(LALBM2`j05l!G zbKkzW88=m=LhKxMmB^cd7Y5)t`=AGu55ifKm!_N2=OVw}TsX*h^p=B~qW?vi;4_p8 zz)4B-c?^B-JcfRDX3|fI5-5?T^mePpUm7fL!y{5SRbI?=`$>b_`bmS^@}|LU`vLr8;fN|2${ObP*rBL=j~j}}_xPb4 z`BpUxY=3IkVLXJ2nua^PZw6pvLCl&AK#wC>r{ZSLybf3X^` za(5D%uXgvgwse_&T`fIHf}d>H;K7#m_GG`=(w}U(4B<-%e_skk_$x9QEda|B*dqvW z9zkO3Tl6|>+5 zR4lHFf6sn~AT9}enDz__-rvrWERdfK~^;A=nb z1Go?7fw^SQAe6Yjl8N5_&i2k8CLofNQ&wpnEc>WZ<%1o`fuuROuNPu;_6!bCkUd>( z=B}jK+S}8UY#mG@alqU&Kp|StFs+s5zK&#n((FWO;^WT&vub_=hT6r8>gy}bxmESm ziz?09`3(!I>lQDlud6g$dfH6TGW%QFI`<5SrkDgeR<5h5t7+}7t}v^p+1~!P&YqS* z1kTVdOYKee4|cYC(kY9Y_nzgu511`|ef_=rJG)y3J9~T3i}&;mfa#WQD5tG=Uyn|} zP3<>Dsq#zIin0eyt#O!wqsX$#gJro&?P_T~+uYaE)rC??NXMUOpnaV^K#Kgqj?UJz z5&aM3!xi-Q4|dQ@_Lsq)l3h@1e{TbA-0rOJQln)z4T){w zBUAxF51NpA05&BmsuWX5_QNtILsX}&4Z5(+?qJzO1JI?*bfXb+18$9@w!b)!EDhJp;ELiEym+n%&yL!BwBT_1EdD~4`_d5 z4)&Tp)a5Xe-F>ER;EFPsMd!d^OHV6$bboKR4QH*>U>0QqW_PD%8{Xw$*|IT^ufKOd zcM$eQxR35mf?9j~l4#n&)()83?#^9M0Y!gyMwWI zJSm;nCV=57txifS!NTkk;=Z)g^Xt+^XrgWU2OV7o$fE^C#a@yggkZ*Yx@aL8E_U_q zWsib1@1cT$ljwm_wxz$NJ4putjdk_zGxu@m>gt4FYttHGDOZ{8$zBwPrvSxGEqjw) zW+K@R33`$}XZND7nsT*vwxZYT-&^;%+53p@($Ce;q6}+iNx@|+t zuB{zsr_yVB_Y7=E_N3C=Hq<6y^`3NHAYC6w*Cx={eC7S=dS8B18;7e?Q{{E~v_RUG zsCipc!bh-q+cu_C5;kvJ*%Jip57gMo5fcNgRzWimv~*+ebdq&jJ3N`Iy0&(t*lFI@ z3G6K%YQ1{~0q~Vibf%K4wm_Nfsp_k?_^Yql5~#jv%c?G4bszOrTUMs06P+IP+nPbZ zm-aSpW3!(fq$zr;d}H$(AG=5g^8NT5o3}N4@i(vB(&oj7G>4d!Hjr*_=}VDoUg<~2 zG|;7#OM_?2VVKiR(}XZ)Wmj^qX_j&{Ztb97;E>-bJ&%DTBDet#&j^7Bd;8&eJA2>~ zhzUKcvuB{Qjl(n|T62C7Y!4Xa%Mf6it=(>?wY_lT=9P^VCI)RkHcAL|b^FV;b0SY1 z6)F%{*d>`9fM2oWG_xFoQqSPK6(FAj6&QUfvWYluuf&vQi})oO&fo;mcMtT#P3wWr zC6LlEd-t05K?FmAqFUCmO08vh$W9MmC4!{t5{SC~GP>R@rPwYqfI(Uv;(&s=4T4g- zYO@n~D+1;0$j)D|c3`k#jvwE#%9$J*sT6t;yA|P`fx&cere)S)Gn4Wuw+)5r@m*2)84bh_8D3jZ9WL#s%RE8ilzj^P_YeLG3jNr2@RC#ICj8S z&O17$@HX!;;gWpi0(q&ivw6=pgnG@reSHWWPzkdKsKK_$;yZ(S#UfYY+pf_0IMFN}m6Ig|LcYD$;0`2$&wmGMm8(Dmp6Dnu09pSu_$` z5$T!I+jM16K1RNSp*&dP*kV9&eq_O-A`05ZHno-Lc8)A0$F5#^TIPJsE=p`i)30vn zL&&D*vY^lcH>ZIN6zz$u9geO{oV?ZC+uOCL8%rp? zfdX4kKB3u6bA0u9DCjsoOro{p#!#r8b(e4C!1yqrr}ut1ii1NS@`EvZq@`jii^&TT z^z|lIa|XDwupa>}=U0HYrQGzedK9Z)xqu-SP`Baxc6>jNnCnH%z!w6z1VeQx#-1`v zbs2r0gYPwn1lD5_Z5ZF-Y^9#Y9PJr=n;4TyFgu%vg|#}6ya(U+;=6vlQVS3|--GXa z@jVax*MZiT@qG`z*K!;L%{Zor&7fI?B@z>~YGL&AL1P14;EAAd8kBhkf{xvoF?NDh zA1q-2G=M_sN3#XKN3;215U?-Uxw;At>=#vB+2f++D15eI-H^Y>;*;ydG4=NCzkg=q zu1za;2z-vf=gQ|HfefLHbIrmcDYT$2M9w1-(t;rBu#~ypnPOgvqHKRC{`a`fiGx|BF8P!~=#4F-pr27}{HgRwUU@xg(o!Qjl(U~ued zFgW)#7#w{X3{F1{hL9l*hLG0>dq>6z#V19$bSjDz+ngzWPvnLHI~76-1GJqABgK}} zC8NHQIlhuHyJQxuj<#c{AI$vMx6XfUY5e?f9w7AFO1-&4=ZBGMD1G(r!AS#g4Ixj) zPlgviIl0!-HFA74Vo059Tr+K7&qY#$wrHqD7tLw-;P-2!27ReZBMUSQ_0fl3c;}oa z`|TP+Bmdsp4!m@NUBgQw3w_E^>+U`AiIQiD(CTpAIfp$4y= z_q$gP35^JJXQ)4vtZX~=!c*-UUK$ah0l{By`R3(PgPJ$g6V)d@)X+CdYGnIpWDAYT zn|^uV$k@Yn4bph@q}P5k?ap;}4KIysq49d*1Bo||Tpnl3u?43C51tZYk4g^kPgg^a zoH%qk%`4&m4kGc>9C#7YMfx#4x{!1T^GDFd;x0%+c0WF z3@ZVBIkmwy)85(-!(ZjVHmA#9w%Ak-aC$k*LF)XfBd=@Rxf*v^MafCj!42ofbS#at z7-|=NeA99*SB}cjoS`<_#iHUKN2$6Nb&?y<2{)a3IiXI@ zz2(lv@Z723WE}J@oH%v^P8^f*azb5P+FyRz(K)OYgS`kRjwZp0qeNYcI^b9|U92Ul zN|2%s3hwyPD;J(sYH>ah8Xm1?h3QZ&Wi^GMR4GQGbDHiMs@Q)nNFfM!iiNGP6r+@R z0V(rDN?N8yLMe~5K6&Q)CpHMJ90y6%ih5{KtbPBv^^&f_kAPObODkr@q!{Jk_&Hr# zl-@R9&tl7>VQe=czi7GHx>FDwnHY^wjQoHY`6335 zN0Xu$yrOC<%92}`6wH4(TP47OMJ_p_PscY4&p^tr?OYVjR|zzNg&H9%q6?Avo9}w= zAAdBxHO^^LNEZUjL@O+g3a~gzSaj+5H9g)zkwX+Y4jpp7@SR`&?79sX2%WH|1DkfX`o=wl|Kp~k8NHfC4}Sg_T2N~p0wMTv$J zH3L;N8ip!{(%o<>jU6f1_<@!hM9&rtGKMj*(S$VX@Xf-p#czd=n>Eg&a$>Z3IA&|S zm#A)__=$0mf-#T54V>b$8SNN~aR!@nl3-NUp?FlqDFgDhz4K(Jb^b+hg-xNM;W@M% zyZgy6I2A=0T{6uF{Y@vLSrnF$lL6K0HU|cz`hNWM4bfND$B9wY3_?}{wAmIV1ftLv z&i~c?oi`muq2sj8Pa=1g?q9^r_{%_qP0S@Mgwz{j`pXWTGKfmk!0Tw004{4geF#j2 zl^CEI+?XoDvnh2GQuwJ_`1nn6mZX9VW#W^n06L_Gx4&8RM9CF#Oz*WSIP!QLi>N}6 zPT2rEu4kfF1*sY^d}5qM3`h-Cy?wZm1s#F5sJJoj8 zfbVH)vs$Pg4IKw3!r?MECk7(TFtM=84TnJF6}1V3!$;PD9V{{&p(6|7&cY8vWgV%( zZ`kpXa)IX_VP^?mVU;KK=yBmw)$;H-^-oeL?kQSCd_+wGAr=h(4l2tAgYULZ!Uoe< z0$-QRQ)*irPf1S3z3p$gUcy-)S5)+@F9JcrVa=C2>oe?GpEIi?$9nzBnbqY4W;xVH z5Jt2?7$b`yjLszpqxyp|&J=<$Mw>wxn?4BRfDnYy0|#Lose&+$3qcr`&eC8ssZjyF z&q9BYG9fZ+|1Yz_L zK^Q%*7e<%H%K%h6KU&m#&lTMn;1ffyyz%Na%i?sEdIlJ>_Q@QE>lKFj$>ZJghw}6c zkXC4@8%xiue`|J~%xd&}&Z(j2b9aBP=xE_RdOk-RHPrsEp7V|E8x~6qJv(!1=-Jti zn&;ntIHIZ2f(^CIc=f5DetMJC&~q)PhMsF(_L&g4f>=W`DANR23Z zsi~YAQOGev{ch@x58l@BNf`v9h%BlR)^Nupql$={hrb&9qF&fHOf~-e+izOZ;yE_^To_v4^-80!AD zqr!8u^gNW&u#1CjZm6d&|M%SWM>P({xAQT0G+?;VvQSTky6%l#x;Pk# zBLBkgy!pr0i=;(pi-!8d+y}qA^1+bQU{vVV;QF?qZu!~6W2Q~l^JV%4%&*B60(&}~8#(GTAUzEt;qf;SO3hte}Fj8#Qhoxi|LXpX6b6qkUgErUTbSkQ5gAPWh za1=OmP)@^R_(dP0Q@KddOEZ)m3!IbHosS&dYV6n&XH1gK5EIVIO29i=5sfMzp$v_S zPHc)#P{xLZDZ}77s6y5H>h`AP2pk%*LFH-#P%TKprEi!jpb{R-~pLRp+a`;qhwLI2N$ePn zrOYbh3A9xlp_Ph9CZZC;Ms#!h&PGO<8B9d8=%W}NyXs;f<5$=Cl)A=?x@aeCr}3gL zx1Ht%+esIq(psK*e$lk%?Qz9QY)rJgl>ob(myiRm>ac4ZRXA>F?sPDEWCfdUyy%9q zb4;3|5oeudu{E+Y%FgD=Ec-*yG!F!6+0n9SRrqUAnUIorf=JB1plQ-Te)s!twEuE< z5onHw1wh}h6V6@Ge6uFdrY+r~zUGZMv-&(>r%GscwEYP%m_mH&o-jdV*F9kgpp^ZF zUw{6(qo3=K}xX+&b4~T_C#r7_H2d|(|kRf(=JBvdSK(UtH{^0CqbAZQR^fKQ-lU0CnYovq&~mp zSL5cNay&Sh1WvGEF%HC>){5fT9J&~aNzc1xSDfbt@`fjYnRE@nb46nhEs@{qT2;%C2o`ipGCT6hxJ51o$g zeA<4*J+Pnn*S++-k)L|r$nmBqduGRu4Kpn|M_Yxi3nM$67tMt3wFMj}41DF4KbnVM zDnTVML<^8UNvaWHLwj|1v1y9n&}~-_!=(^6zjVpYFW<2WII7U;pvv*=GnVdY)9dB> z;fgG+RQio6P$kD5j!^|LP&PV8DR-nQgi*L7RUxF*Bb6@CkxKs^2Tbfmj6B(k%B}QX zG&R+Wrb2jkNSP|V2$jI=p|}DL88fCrb`B{>3Tw>20@>4bb`i44#Z=obvV(Eah(3t1 zuGjA&&duoerUA#X{T`?3=~7HfNij{Na6CN^y4p@W>lCng*QmjF;KZR23-fUJ9XgC@ zBFlu2e75Gs@0^Z8s69`YqJWd|cyjb` z&~!XGJ%Q`Vi(tfssh(H_BQ8{rthx2M=kC}Wr!7iPET%|!65x1pQ5IZ+rzg@S7NPC6 zC+7@?Hn`48m$f)0Yq7}cc=BS`28T!+o}CTj%1TdOY>VP}@?v4%>Bq&w{*OD}y8HZ} zO|`hHBmLNAUpKRG?t1d#6x;N2G+fit-kbK|47PmypnW!%wjCE*LNh?>`AIuJ)ibaa zG_fE`pFP#nF7(;xGAJhF)U)TsSuCGEn~jK%pwGr~G)g-@n=8Q%!Fm!v>i#Ng{`0r3 z1tvHkI+|i+IBk!%f^AS5T(-{!L7&ftuIRH_E#EdvfX&PRE6D&W%>bK~ z0X91Wj7zjZUdl7TDl)+4WPr`h0ISRZ!}gvuy44wASmH`6SCau&n*mmr0al*@Ha`Qb zAp>kd1{l}tg8EyO0k${;Y)J;#@(i#Q0T>5s(-%9KGVD6BgNb}Y9eDT`Km6Bc=`}Ev zGj^aK)b3oz4l>NpGy7wQ8G_4kA2S5kU8yhtxEThBLnnfWVAMm28wSi298MT8Q*dm4 z;aUN4?&MZqIJHr4ZQCO~;PsR~p=D`Gll`PfaBPM=B$i^=B$(yvqTCf445TS$OwPwDPR)=3kMP?#7cl49R|!2 zS$5vhaNgph8&L?ASO_k{N`OgD_zD0_mxzvKiu%-;pG2k}?6IhX%wYhva%_oadnJN0 zbr>)^CDCk=$O!{xi$s^Smu zUl=eOM(laKHsaQ*dHbFjiF#ZFa5k;?I5Pv}HhaG;(}#V}yDjHe6&>2UFu zms>u3>t%o1ZIN$j{TR#=kHGN3Uzqp{VyukecQ!J@%+M2mPJYWW>Z&ZIt1{7*6GmY2 z3Et(h&W$T@W4FGeD~1tewkn)3qD;hh{6LwA|M=72I(pyaxfW4~A8^IjW+IZiVMJLf zj6ep%2z0$v7?Fzf%E7h{Bg($ETe1btxybj2`&)ly*um~_Gjy6*~~`>qgo>A3F-G0 z`xf`W9_4r6a|D;uY;y#cJBtHux^L--L=X{-+6B1od#>Pc-1l6;@wGLJ#_qeZ$x`sk z;=X6W1{|$;+_&h5?t8A!eKQ6Ky6;M~uj{@m(TuM9uJpL?$-u;}!A{W)e%^yg5c1v<9VuNDakZoci4U%a?Bu0TQxA;z*22)^`^ZMDe3g&oFYWxnSD z^HMzNe6CG93ZV|>rMR0X+&K;$YmQLex}A?cep2@+i-g62L!%a0qyy(u2*<)^RZ)eO z_U0Z3K2Lca_&lEjp9eE`9r!$$aiO|$=?T~0`KPlWDEtGvRSgwhix1m@i{OYRJ>5!6 zk&oJx5CxzC@6(JLp9X+1pn;l{25LkDj$4K;0jGNM)o(vGlN@37T(^&-0lH;Ah|%$b zUaYDSp`89*BSN($H-7)gC+Aq$vakEMD-`5ILyA1ETdqNe;-X0tmX+u)-7d8Pi(Q$z z6cu#rE>#N!R7jV?G$GZcY9Y3E>$MQu@vs6lCrdzKC zgGK6z`@eR1wEb#m2W#t`9nv)L5p?Uduu#{n*Fs4S!Fm!vs^+{z>4#se111c?bn7+9 za4ZTMN^|R2a%1zPF6f$Woz+rq9ZY)NdY#X$bH|yxqE{zw^tw-8zxEqj+1hZ;v_D$4 z?r7Srivytl@VoVT!R0hNRySc|r@!;cp;xmDfeX0l)>%zFNJKE|PVTz(`GUi7>v)g> z96RsYx9x%P^_GIa7Pnr_E^g_5=5gzyAG-DV9=ART55~AM==^a=n2d(t2-g5rxQ~e% zKzg!t9d3hbK>lQP`fu)Q`~D-7L3#;D=c>d4v_Wy6l7~bMDHG+a%k6J`r%PT&6J0>z zGX_j#dx5WyqO7NnlHCQ0UZ358tFPb$saq$mxqjaAf;iuNB)$TZJu89Po#QJOk>o;r zxNSvW!Doe7Q0e4Sf-o)vYKx&H|D3OK;>YyfWVeHK+%Vn1C4Szz!Mw z&<~EVR(HH?5Sgi_t-bvNg|~EB7&OphXH$1zO+GY#)4%s5uQ_qODT@yqvLhtDFr|p7 zT7wiH8Qt@%H{(0P*Mc-89Ihia2u4JLGBPoME!&qiRCX3cTqr8!q?;-P_rR=$;<&OH zJDf_DMvBR>Pld<}sBj^0XcaCLm#*cEo z2b+G8@a=RhG&S)4^LIsi77j$g?VxLs#l#ZwiJ#ER5{lq@)I}+N7ukk;JYPNpPGUd% z(TtnE`~hHsMp7+xEZt(88e2*p?k!I7&6WZKFxjVGODuY8hHk0wd$tr>#@A8>DqA)a zE*6P7szk*&7yE|I#ptWdvr9y=D&H zsN-XI<0a6E9%)Fc9@QqVxtLU&zO7AyJKo#~*)oeIaR-y|myyJ6so>Ih) zg%;A4V25dy=BZoU7}> z07OKBQYqUMC`+lQ!Lqc3kO%|yGjEvFuHDvaDKbxHA-I(QT|Hhn5|Y^{+zuKW*7d?= zxmN7(C*qu>sNor`1PRkB!AE3qxm!QpZHU)*ZkqoMtpufRDjhiOMVZB z_;R@wV1?Wi$P4EbWVYBu7_`msX!T+I8heE4GtpWT5sq>z*4Ukd%+EWE73IBhOXfNI>+^Y8AuN&>W3rA}AqZ~G?h?erPVIPFY zNEL#^elWM%5v#pFRz>mKW=1IP5LwC3%G581vutUVOq`X2+_+FT9>$mvu*?n>vB;LMy7`nTY;KFDb)SJcuu zB{(yuS?C3S3r^<;Ijw?0WZ;zG%$!D~FSBQ4YW)Oy9Y?EDSZ-L&DllREv=*g)gAR9_ z)9H}D8-1=|nU?v)0&Kg$U+|g@EHQBG_CWRu;?DYu;Lc6My$ZNPsCn)SO&a@V;7u*dk~F!Rq)rqrC!kd`UF36WK~xS^W3?5&-?(r&PU7P$XkHsM(FH#z^OIw?QGf~O=2?6CQ(1E_!*MVEDo~v=?2dE z;<%klPB$><;mFX)@F)CB6b~Uta?d)n$HuF6*spVO4>hii*b3YZ5F?NNsXG^U z3h>c=KHLS@-t*BJxmc5ru!E5_k7!8@@Sbm*;Gq2YPMB@`|Hac2j&R_`9r{(i|IGZ= zxd@!-S`c9JBIi88h=2fLwf?OK?7zerc?MR&bLr6xu$&Aq>ONSPdoEYsKq?m=zE_l&?O_jlG#X6 zlRA%ECaFVC8`xV6^|KQ%zozGolVqPbyBei(^0@#oWBTh|r+n~WT-P8^{!{DOQo}j5 z9!1J~YMtE(2fm)^-I4RBZlR&iEI2gunT76O|M~Xc-~9=pktK5bPpx}tus6G>)+v<^ z$|(((f%JKW7k6zPcClSrX+&7OU#svj?LgiUY3(N z2PF1capuv%8C=DeJWQ{U3aR;$M@MJyNgC*t(Oi*gxN!BvHCO(A1vL_(L2-MpECF!s z7%|7QP~k3g#dzwlxs$C1K9Kqv;p z?{W|lueJh5A?Z%Jxo&VELxlWaKEW48O+$G-?PSc?->1~cLrVSnN~ON^iNEDgzEQn^ zKEfAAeE_eEYQbEW^U6V_Th#zIq3g*5d40Dl6qyiu4qZQM8|RMhi=%SzGATWqq~rd} zzBtO^heMeT)bzIlcfOljdU|`9pfBKs3amp1HY)qBkTP>4|B=-U*?TaL?olTGPod4S zHL?bdqY65x$9E0jo3LtF&zc#o6`@dDC@TwhxGfY4hazp+Z3;=}XC#~*j)rr>v2boE zFPtA96&}s9;jAzYpN?q@VHTBzWgcaq!#Nq@>`*i^loN@^B5{=sXm-qu#>||ySYB>h z9)eLRNX)>CpuuIGiog{Mfy9=wD1X^N3jXJe=Ef7YY+l{eSiQEn zIgowK1Au>yYaj*`SW6uu47-0or4E=*JPPl`xF&SWtLWAXK z<9Pvj$7X;rrVW;3EE|L|h7H2xxkG>kpN$5~aqTq-35r)W6_cI6O1c64ei zNU4i%iPN`4@y3qq;H43SJN~K04#SI#|)zmNi~B$3SzO9dqNmUY9`0p;d8;9^uPofLuQn#rp!d&7B3g zWFgnFm+K@xcjSTK)5bCmT;YD$JibkYq z@Q^U|qqp<60o!5$alCl$uXjU{nI z;D5GL9H9)^OT~twp9B`GU$EE4@FOlI{wwRD!B11wX(ysxDBSjO^i(kys7hX+36M|(~Fd^o9Ovus)_9Z`?`7@9o zMf?2d@sls!IDTK88--<$HbMytNU&PPo{RUqfjQ)&Fst~z6`CexH5HE4*x#V2?uDmvE7ajQ}((s;m5F*Y%S(*z5b+TEdVjMyGWQL1eW zTB1@t{L}kS|1S3KP$tndJRM(PVvh@BP}GaS>t#sBz?K(HmBc>ac`(0 z+NF?&7#SXvT5Ly#O9m#DWC(9+v{^^;N1u&z)g{EOvUD27-wH{?7o^bY>U3ADQJyKr zS%&O4;>dtnNXgZ9Tbz-aj0^>1ieCr|sGcbI^@-~j@EQ=?FR)3*V+C@K(9-Lq>ul_N z)d=)f^BKXeS51kXLponGV(SzTT8x|zM3=X8w!dqm&$ADq$0NG|wb`@(WpYpUr~Z?k z7d>)#I$u-)r9$B{CS-|LA_-@Vkoau^2)VYzH<9rC%v>PM#joC{-ah#Fqle-qEGX;f zM3rz|MPjDP(r9TPjGL=u{eme*%y{VpK53RyMCy>$D^gE^-VAjC@>r5_w1M>xT@pKW zky1k~QnFBtXb5?1XdIdVL!Y`1*W$f#o@SD_TcV1U0EM_jB!!|xOwok@Z7+% zizcOCU^rvr4}=t6#(=ybF}qF<4yhCU?JasJgqoo`^MRPr{9kKF+3 zcz=OIT_f@m;cFQTb=W4tnT4TFvWf6@2(+jsA%c^(9wK}xLZ!mk`$qY5r+^4v9N;Cw zHzl}|FcdV@#WoR6RSYc6YDx4v7S+&7A;L`+t{(X|f=b00b;1d!g9yS?FA?qrbcyg4 z1qSxCX?1b#W2p1-$+n*^lDxY2f#-YfI|;@JYiB2iO-kEa61;MAl0$n6?G?1;La0Fd z4Gm|h;;%|$@GS!_Wxi#=P#;2B>es|KUI2zqHk4`WaFK{-dPqz~9!WSscno~{#4~+F zOd)a!&_0W3@d32U>!DTZUTkqaP5o50;`gW2Dfm19C%aMo1MKuH^>6TIbJW>TLsI?@ z$}{>Iz~P+&aw%YD23Sc3SZM~>tPHT(8DM1@U|bar@=}ojHYWp2KfoGB4z3WMr9uw2 zSP)-T23U0l*t`s|nhdbo46wQku=)%zJw5jG+>oK1oDiAT#(6_f-o+VU41R;< z7%&E5$7g^s%n6obKof+m$N-B6VC*2YKSQ>$(pSO_BPFwnS-Vjj126hG-YgQbbYZts zvM_s$>sT>_cpbtFUyqp~J?0~zMntr51Iy&PTXHE4UC7dtfSJB-38Wx0k#6T@dhZh9 zNW8a3enU4t1w__8EO@z+PP^Z~M%55SGg$VbTy6WP=^Gfvxnagej5loD{M0gtA zRTodA8|o^X2)!ltqS!=mBn2s)9S|ZFJ|aNslVpycNQI9`g%G*dCPMd%V}3S~IX00c zLS&AQ2#|uvV{br|Lz^JUTtAUHJ|bM{Gt|{K5&Clj53IEb&-D?R>mvfBJ|dNVB6EF2 z<_eLI*+e)%7}z(JYh{DO4K#a zCkani+pCf%O#l&`HTDvj=OZ#th+G3qoB0SaXO2SjkhPoD2Nra=efo&03x5C4aS|QSL)qkA3qTyjt8Mjfp?ZP9&m1?l@ zyzkyn{lgV8JcafV;yGfM5RRlGb)8L!p@4y17h0M+Aru-qQ>3Z$5dl&V`N36Z9Buwn z4y38~6RGnNsS_ffvWYOZFywI^rKuMpW2)}?^zT0R6OpFgM+k^PsQMR6Yk&LrE0AWs zpHRJzP`wbk-X_F=#X#_=rI~NH&C5b$zK;lyf{3=Vw?L%9Ph`H2$b2DkgH41HkfCjcpc6Nx$8hk{66hw-)w=MnI)8nDC1%4t8J|Yc5#5armYp5LxIa!V|h~~I2cgA&LOgWp65^p#yeJV>DGeh@0~?C8G&}~%-mg2RJ_b63G>HHy zi0G*dJ0^}ldOIf1dAdXv3z5&DDv2;OH84rhM0lC`2X+5gz(<8y`qPM8{!sK_u=cvcgAX zg%J6iO(ZTv&asKaZ6ew=y~2U5LxRdvc^YbjS#uZCc=Jaz_)01 zt@WvEt&a$h`qZ_~Ph_o+$XX$Cw@ri{*-#&}iLA4U%oIu1`G^21h-m9t07P) zd_>j>k$Y?+^bGiKmuw>IeUhyA5dl)4Bv``t5?SvfvR;UM#U?^mW2p0NA{%TX2Skz$ zLL{ClNjLsgq@KmH`UTlaJ(qIOj-%G!dQ*88n97YsP-6*}SFx!)nhmyOQ+ad@un@0v z$@w!r3E?Kh34A6J*i`Nm9Qpnqsez-zcu=YjoBQMoA@$k=(O2zml4*Yl5@|$+K zxwEyS1^)&3y564T09+!=6yV<2+1lSb(7SukT)DqB*`@9G<8MwWzyEQhz3S9FrtAG4UA}DL<1ul7}3Cp21Yb6qJa?&q-o&Y=KtXzfA7aP zR8KAV*fp5{SHATn&i`M>trv@wZ1v<57j9CSjJpkYK5owcIdA7eGw1zWNSlP)Sr51j zzqvl}H172EfPSoA;Wa~r`o$XfDL6BI7lR0v5@hY6t+TJU3#$gCzqh4z&z^2`SMPoy zv%9yorOWK=YUxQzda$LvJ=t%z^e0=?D4-wQ zhz3S9FrtAG4UA}DL<1ul7}3Cp21Yb6qJh7E4e%K}C%~L@bGD1kCD`1jpYijVKIi&* zxH&oIoSo0}`K+Gve$Mg7;^s4d&hsbWo`{=seXa)_hkFX{LflhvPs3e=o0IM7xJ}$M zaL>eDg1Z#=EZnnkm*FnQU4eTJ?zy-taaZB4#yt;r4Q_6l=YIBj-1BjBqc-&6ue_COCARDi zVw)p(iM{`85_XR`ve1sq7(bP=iyVT&HwqJSN2#tIq&Zq=iXEF z$;bPv1-tvCE}4y%HlwWJW}2O diff --git a/src/programs/Simulation/gxtwist/tagger_building.ppt b/src/programs/Simulation/gxtwist/tagger_building.ppt deleted file mode 100644 index 988e8ce70f9ac55110f86dc04413beb230a6d729..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 282110 zcmeFY`9G9j{6AbtGCV?sWH(9(Z%MX6LKBLj$o?+L7Q;vkW2UlZACgLDitHi#Ze$&i zA^SR(OR}4>jA6{&*ZcGR-jBz<`~&w7_dFiw@^sC0&UMatE$5u)>ot93ftfF*=Vy=n zKR$X#IF7K`+(%CQU+!~)SoYZezQKP4{GQGJ@4x@^uO#@L6j-FeA_EpESindA|Ih!2 zXW(CH(M_L*BS*d_sX6p=nfxB1V3khl+IPJuKl;A~edI`Pz>y<+up>vzb-x}RXdgQQ z1D`*_3L39y3=BH!I@`Xwu*#T2a&$|64FLq=6O zP9QS+<9v{0s`n9Kw3=ImEV1+kEXSz-b_ej1R8un}XUzLm`lk-EI-FSZ)~ zQBOH(l8n;LUz0A6cE8xlZ3Syu{Go2Apwb%Tw!RaIS*+Y&@S>ZnT#XAdS7dH5bz=%D znu!J%PNPp&9C!^wqIFRu*utglf210?=59*RvIO3dOZ>F(Mw%}K+vSg992)j+ zBXvm&;m|@EN!!H*#v2EPKl;f0#j4GTB=RA&(5aZO_EXvly!ULv>S+e)QNNRYUP%!N zv7(zYau0lqSsWLt#uped(xVxvsE|o#j1T^%fd6o1>H?fCxU^U_@E|i3c)<2x6YO7z zdwZc`LpA3g2HhEgO9(pMQ!?EPUskwnqZU;6v7dPBR}gxlC^pI7-Rx%LvOGV%KxXUh zrSE((>kke;U%J4-z)rm2;}I{g6Q09CM|h2`lt=-FI1!lcl`Pl4h@bFv1u;|-C^_{f zGH{I2{a0d)%Da)9yd-)I8qx9jE~MWnKCbwSw#cNjcwUrvZ7~U6ECP8$4Zjj|BLXPA zkyhvf$;jQu(W4o!8sHV|_@_S~=2Q2QguP%Gz#<$3%)rU;Q<<^KiQ(16uxKp}H3hs9k|S{Y830NhMzO zx0<$84fXi*`djt~cBo^U&GVn^<8v#wpWt7Y#CPqVpG&z7u)Q4{-tJgF4c;{y)F?~V zO&8O0(nKP6(MVu>wS8_UR;|2z1P66fJC8gvgGOZvy>Yw42~!{ zuA@AzbLucd=rAKP*gQ7a+_16JxUo}h4K;~Z+eo?XHtjL%{A9mvFDZ5_2u32Gg!@2g zI30jWiZW74aJO&el_gl6BE~E8F z+4g%cW~v{L;nL5Iavf0-ZsHsDc@lV(ayFr1x(&lyll(!Kml?Au(ww2RO8TG>5<0`( zB7B4(Ea9a~sGRtj0Bi4PI<^<-8+C}b_SZR(n)w_i&S={F>9<&pk9ENc?s?71y<`iL z6DAd39YSVK&kDaRKQl%+R&}uy%9dqX{EN`q6>8q#aps0)!gP>+oVy9l<>82933((u z1Z}NJn=@Ule|aZ$%>UKFNi0u|$rT;sV@SPZP~PTJGgk!V*mM%ui5$p**i1?bbfDL5 z$lL`hp{bT3&M5QsAKJ2wFDRpPI4PhtHsA8T0Im&C|5FCWLdbd|W7cfwQJ2 zN!-@2%s|=jUO>7Z92=PKTY-#rFEo6SOs7-mp>oRy z+WNzA?Wh}4-SQ?{hC43)dXd*zl-*E4MA0M+MTlU~`Glq_>%S8Y~HW9vu+ zJUh)tPm3mWPruB7JbhPRmzat_F!YfVtIfwxzuD&w_e_F=EDg7!P~L?jSnJ8bF?P0cXmKDdnt9qCL3BsxZwKDm4m`Q6 zCA+M3d}m#F=a`~?G?kfDV%2nkaC|59^Cr^}FD-_O0gYaE*8ipc83xJuB%D=Eg5#mE zi*?SJ+gDX6HfOgnE!dD}`#E_RP}Ny`Vi#$+JPv>)91dj*1cZw*UJRCEZ`cvCKmzjv3C=n;{+Z6P$J4L3Zwi`WygMH%(HCfykz|B}78&l2Eyb8j zn+5MK{-7eB-#N0EgyGbpVGd6qfy4c^mTE(m6OO2{@fN>g(3HPO7uB+xrHhW`ILN}y z@3H`|lg-=^q9o~B1V!aZN(;D1>#FJjTP--gB`rx55kFzbG9VvHvp+8eC(&0_VyMnN zI>n1rDQBU1~O&7%mzLM9^tIKnX&|0+JC>NpRK|jY3Sfr(qZB{+o{u z_hMl!y^oz?pOnS4oB?Qk7V7Z&i`d=%Fd50(DtErxd|%)N2vgi8YX`97Y@*o8aOt4` zEbBKEalG?d>`&tRI|ulMPPf3z#JC0wqiBqKK_!KvBK%?NS*?bLGX(X(61@&3e0ZBW zp^-0w+WNX)>tV8yESmgh;f2NJ&-=J)*>8X7I*)9ozlRfp(A<&C*T?yO5!=G|865L; z9CYK2m)QZbaL(z{IZ3)Sic*u!Y3#?@QzTdlYRo1?U+mf^) z)vVVgotI@cgv(WH)aso6f)B(_n-$+AaEn{rU&CPwzj|1uMgq{c=Hmv3#>gj$n7abv zg-dcmj(tjUl)?$?t7d_z%zzAKw6>?^`vmn@v00}J2TJeU_t_!J*e6LQu09Ag0nXC$ zaXbai@xH@BfO^l4gL)78TR*g^svOSzbqwz`VcXiXe#`ygD75L3v<2efXy4%XO`>GT z^F+kmJr^`r^j+yI7Wt2S?$%JwzW#eRnn@H7c@`~VS0nu=_{%m2|LVvORB-laHAKzD zSq{G2iPS68-<4%(zi+y->xu-hpr;aP!O6Wr1Eqa(Ydl92<1*k0uq(S>v(ARBL>V^R zedE3R#<}f4%k982-vnPk1yo+`ehFI6Xc0h4H)4}k9;dxwy7o=O`ln%k5%2yYga*~j z2Gw|$Gvt;txaMsyc9gG{Qg4bp75oTsA>r0qa4x))ddRn%ZoJNd=24$R&$RZnoaO-4 zz61he<3`Sdo2kmV9g?%?i&*AV-?VD~bZLuWWJ)G6B_cN*>MYD4VPkibpz)KE$gh6* zO;i&59SO@b9%5TTzp|}ye_NwsGig)1!!{y54#rMO=Z0f`leYM36E=sN$>4A$T5vki zXkfTS<9w8m&sEy~wT&-)f|$e7rSiwtg4^-6WP*3ISH%3bt?GkI`sYGwq|PZGni|B9 zo@wwthB=LNM>iKmKm&ysq^U2E{nZoe%H!}2aK8{0vzye(1INGtsKuGJ|4Kci5b_(c z;-QT!dnBp_UJ^HTldul~NoA6TFP2mZ$?d|WpI1(TR;w`$5+=Kvw?u1GemIbPl%KiX zx(qPeTC5{Y0n!cxCh?@&Afd$cQ5^|xF0>|{CVU8%9VxlkU|e}yP!h-E1`?#5dEMv2 zA7P}9sy=Sw4I_Tiv_X=zGpjpCEmH91A#lTN0Vq*=+z?~99R;%;3}b%D6Gr9#x3g1q z0@fa5q&7}(@u1S)6G#*7%$w7fL1!d5cX$IYFNP`u_tu6LQ806`ra4$M60BJO)^q@C z4uLfhLSW7M|94GvB=yFRvru{zte31r+G@v%p9Xh8N%b>gQd1(thQ-Q9_=D-yTk*NqQ$_^1&o8D&o8ujqZ*7vJ~vtuOqn@;%2@3(Ji zMLTD4MJC=5i<3Az%|#8}p4mJVt<-PWA}T$69WA1JwSo7sKwHD#w3c!yy~y_xx|f*} zZ4>-wq?}?UBrt-HHQV^3kMf5~1z(5pQN`NI`IV$UUcVY1bUO2tk*bkExMU0D-jTJ1 z>-WQMh24r|DO{Jm0XcP2u;pZ>v7wPcqX2*Q&za3o*SmWXZQ{}P{8)L8R_t|$sG6LH zb4|zmMCLNDNHIm*Pzw>8w$TIpa;dCYXKC~6VpjVRV4tn`Be9X1dE4CV+R7duJc; zE2f&ysz_U35^wEJU2Gv3UbfN>PrJ0%N-(%=Jsu&f;N8k2#VUe{;&Usw*=8Q%cpg=I z4?%o(1uwRs;v_kI&&Wf9_0U6zb<5*C>#oOX{3&YFZ%x=8)J50>kF)s9tGvYAt0#$B zFmXJustHPgSw(xYr<9G^yOZs-2g&vc%A^?uy|$EN)>-Pnobm-FatC>dIcK9f71Uc? z-Y(Dfn`**LJJAf9PjLr6ZqUikI8Y}CP}R4IkX5Jf?$ zpAjMQCj4(^@un~%hnlFzQQsr#6&1oSOx{s7JlEiEGpf(PD3V|!BPDTG zw`4MEuRgCFDLi+oO({CvIODCpH0x!}DL=>@q-}#gEk;{GSQ-%3D$J-_!ox)GN zE*7PE!teOpKW$`wE-B3GJ%Pt6Z9dT%{1ehuH=ey7J+f93@sPXp*kh4Fnn>HRJU@xH zXVD*w9p5HOO{**y+%;OvP0vFVy?-}d9wTTHh*Mao5C+AmEi7@N|4699xZIlS&ba! zF6DTv*mf~Geq7U4yv;K@mEYOmTc3n?byBB%x3pf=!xN>)=hT9xWTGSZ*^%%0RQVn& zw~0mD@)K_Kgk$ty?VX#0M)OJK7&h=#-idgBj4IKlbC>=k+Jqlr*uXuH;&?36cKqCY zP_!R^$&Z@O8*#7B6*XoyKvXS5Y*CzZuHNBSjy zZ+Or>(M;aH6N)O=w?|IMA4=_ea-`~w$C_?Lsa{{oZv4DGxUZ;NfiVp%D)|k`EF6X} zW$swxM}p-uD)IcfZ_Vujv$KZppv+ew)P~;%E8i+cwB^?-68OpT-j%0*mfM9ySDA{g z*=AP`pUABIZR*9{f5RhRJ<2_&q7Srw>yKXK>sRl8^ngg=EkAl%+!zeYE42siV{6TAT!0tUeKC-RVr+tIwy&!ZLi^ZC2@ zK^?vR)&@VEEOlCHPHL6k`Xo=dNXtn99s$UgDCVW;lhKx;9BayLccMl4ZMGqmvHXit z=1Za;pv10=_33A=g^d;=zNKDA7a}sfUypu96ci0>3^axBIZzzzzahRHiat(g%D!er zF+Jda{IRKW_gz!`HEW8sXfYxe(ihl=9|-(yx2)p@*>SAU-Y>R;glgOg+gz&mQV!)) zl9Vx{SQQp*WM^N$KS&4rD7LTnv0$T6L^^Zlu;NzqK^xjDCJ4*mn_U4zwEdq?L$x5ZB}cowxM1S;0kXoS?Y8{eWHa+RKVEZAnl z?|kEORMY=btH-KsGSQrO$>?YlzrXaK>lvVLj(C5R`lh&KSD-D5e;^>Vf-ar29PDK! zH60NIA2CZmPOU1=-M!c*S|>4X6g?6!RY~P9S*r7J32>}b<#70Put$G7St?c5wWqH`vAg+>f|aH zpYK$js;lF-a9;}usCZE~ZfEbP6#a3$yzac6sAE9%_hCDmua&8ca&e3w>(GY&vR_ZqY&FF{G?k9D_%|lFuxv5gyZ`bwODExua zK8BOwduQfOv;{;L@)HdmUe_G)lbE~Qw$wLJ_rKlPf6`mL%Q1B{`jG!XYWMo;DfPj% z*Oy+69xYWGyj3mu7+h|?xIGt@8aDXGtv+1zdJpp0IPcB6e{}YjoI0|UkO5O?@U{lu zW1qZQpKEPBcX_7d_$4FkmUANPmZl+Wf|TqKZxO($<&mN;*#6b$0x97wdS>{bjFY@V!M|$nS;7 z$iD>0)RQ zQg>vfOU>bT2zRH)-zmwul}91)o!z^l+~L6!gxD&Rao9xeIA4|Pxc9_}U0rDPFbQ*C^eOT4uX4)Z?r2ub z`k0dOhlH=0e-adov&6KF30jlJQDSyDz2c`h#bT#^e?Lgfbc~ln#l>P&|5(jCEepFIhP6S-KGRu^e4DT-Q+0Xvea4cVajj>U5`t7pJmi-rk*UO|qUH>hl+@i|nut zQn*UIVeq#elF-)}!+uyP)@Cd&J;}|rEt?*=#&8SF1;~?ADe&3@Sq*<;lEW|EON<0B zcbd=0cVMh|wkyn`<{7hkg)gz#qYss}_bqdsy7c_c3Dhk#OpBJZcMlN$VbfU+g%8VB zfFzAE&RJ2qiIi~{FQ%m?9V@1#^yQis((Z=U>>X)hB58wTEuMcZ{!&4z)Pd-O!Rwkx zdmI={sEC@h-v-NI*#86;tmC+94Q@32RcXq5w|RkkKIUCC3unXaywlgo-HG1)YUHkn zJ1}fgSvF`=S~hM{>Ig$S$I+$b68>x2)Ku)kzUYJdAjNA1QoI-bqj=B!NAbR?j2MYz zUd9nP*HVSoQlnUN##pMcNlWKNYn5P8kngv!c%A~a5MF~4Gu~gOrNnkX;1VF&6!iu? zZn1KS@D;vd1NIuMcbUl;E8Ozd`c1yxhq^SQza^XkrF5}BiPc`kii7ks=FR5m|KYt2 zL!yjAqCOMnGl}ze`9hxlV6OHYE9Pso`GHnFy!#^MwPB05R-+M1mXvY7V~oIO0-3T^@b}L zlfCRK>wdq;yEUUlGewS*l#*s*%+lWz8ub&07J)pHywjiK$Y-Z}L$yN6(id&MEv7%q zSX4v;IzCRAq>`FiJpkH*17je-nvV}3s{B9{3GDbdH6@MIgOn5>quPk2Ne()-A}^vy6pFE!T%oaMDGYU5I0$_OpZ;y zpL>t^$V5I^RG9|q6nFK4m=Gg>nlYB|w0p2QF4w@^&-s!3Hs{CO{g2MC*75_T+#8zV z95!7z6$qTAwkfAY%V-v-?(5`dzZzAjIOI@RbfH7A>_`O)?#NUN&Kvmf19ZMxP?ek2jP+<|K~6&!jb)=juZ6^&l4)VjM!^GQxsI7sQRE3Gmo$^M)#;B7i@8?3AA#EflQp z4c7Mt>xbUkFg!&KN=mr_a{?4va2X&kcd2bndW6>xOHwy<;6vVvUNL?VLzS}OrUv0s z!VyJHx;st*F94SzROrp7%VLbD0qc?sryZTSoj^;d=jMLA*u7Ti$$JY<0Zv3*iOnJv zN+{^v;$pyON%mmxM}|;`H=XP=7M&N*PgwDIZtf+Od-)!cIMs_|mTasFM{2GoOy1H& zhJbe6cp_1_R(@!Pf?85^@Xs?jwD?2Yyzwp%fdd8xjVwTVKT+@yEIU#b{5vuh0`mrVXh$sb zgD(&OPFOm~VCVh?3piov;Dlv>6Xpi0oPW5AnO<_;#SbIGfOr>790k8JVz2KS;)#Y> zz^ih6bxBltoA&L({3UrNnwWIuvnr=`FcHsj5z z`RqP!AOhMMi+F>>IKk42Get2V>C>z@_4TobVVJ zOma|8-NFr6g2C{f``~n{rLGv5n=J(6y0bwV2$Bzq-cprC>T$M&swJM(Pd=Yfn~i4Tl9eHufcOJoiAdt2|Gb@fMU!07!O)wBX`x!9YKueNEbi zG{;I(eBuX6!`4BiOf|MM3~do7%&6PkwVkjM1sTZ65 z1BGadYP6~wPEPn&RAC(y3wrPgM#N>9gC=Dzr{YY~ldFz$SOr)(f?u5xwpf7-fv?Nc za9p5iIG;Y0Cdw`wNL*SrUYG9(V}47aI0J6sC7e!|X*f5K!qpczl*Y;|8{on1g45-W zum)>z`s`;(2cSdq1Kp`SXruC=JM{zIF$Q$Ui1r}d2*e`3WBy0-S#3Rq%O;Gh?+Tc;2eyotcLx=PFuF8Oo{=zgJMzJ8;>Tc0%L-SStt-6vD^d@so(dY2!~a}{{xgt| zKUa8=7g87H%51?PGMdtofNpPLkc2NcG)WPvHV^vwI@q6nZVA^${M?ePE&aL00bVvF zkvyprh8S}&3BqD9mYM7eaD#lLF4*7aV1J*3{S5(S%?-+0C7;QXp`QVxqecJ}3mrFf zlG_K%vH|PnV61}-xIelD4*0DvAPP2s06EOBsRxD$6<}Tl79@5N(NrnI>3L&4S(wiL z${?iQ9)&$ND%4028#@>JfiCwlzMmdW31fyUd?MVv^l$q9GZo5WS0t}(3Ppk*0h&Q=6Yw60Cq&1wtrgoFCz0VLS|6y-k_Sma)#`3#_@T^^|(b23te!sbnlV(NcpIFC__Yw zjQy$v;m5g(W2?il8E3w%M6?(FVNt< zK!Y~}mB1fV0yvZ&Lmlo8Q7gNkMT6rqNH}8L>cv0s>IS72T;l&(sgG;Kh7Wcb#>-&H z=u3{9omtB^z@{2wQ@`MUX5xR|MSRTDfOMp&bfoZYARfkPe9~|lRMVrmuczaL{k7PS z*WoxUm^Oi3z=)tU(hlm=>y0&O_rT-~6EHagvOhzW;H1c*B>{v0!~S#QP-f#$9|h7+ zf#kVG0l{C=GXQ&S3p?iOcze>rnM}bbyt&y z1mm?}s}17&pAR%%R>P!DDb01g;V7)QGb70ih|fBAE?{FdI*0)S6RJ6?8A`Aa>onu<&F)+ z={~FE-+ir^3HxN^M7JKZv;Rgvt4iH-rjaWl(P<71s2sbAybT~uye zGLgUaul~n}$;hj?iS)b0vaUC@@ay?^ljriASzhhQZ=Ds(h>o?g3u`}Df4oh8`!A$A z@LHwp!ZQU6tV)sWLgUrl9Ek?rzStQZ~K(Icwu6?_6(1?kSn`j zdg?$9bwQp0l#ZxeGRb#Nx|BeUv7(+!NK4yVw>-HkVIn8Chd+&++0k( zvAM0`ZwlS}V5lf#{v`Fr_xdYl(xaVjZ*Ta9L=BjAUuK_ar!jpQ&fAnUY{nP7ncIw8 z!{nRwMf7C%!VDz{^LcCQB6~5Ua`nXgJh>3vJxZ1*NN)+}g1-?0aG`f!i?!f#GD5 zk@LOO!yt8L`g7ZjzHhi@)6Fj?!L*v@H`0WF(>*R?hS?jgydxEI=TuP2ZBbU9i^gqoyw=Bnhs zE}31dgnymtn%({Vuig0ywmxxidr#$x?niqZA6BE_Q z;_)^6Bme6`zkf0{XCH0;gSu4hzyIM=FW`p!cptKG?Mr|Gr?vkgH^JuVenY|D`MO>1 zf#3eMjrISmtz*Zr72jxO{ES4`9rxbK!7Qz;f?F!Rp&4ZFmt6i_o3*)717orN2;Fx? z@f?>^p)dY8nR(;7n{*d<6h@GmSb8f9L2Zn$9n}lTx{^@2E>r?1N=^`L&S&P zc|+{Qj86IPwc0fRw`vU7b3#|NXQtY=EX@X;SlxcBcbd7lv8@%_K_fp{kDfj1KR3I_Og}ffmKhZ# zH!-Fn&(Xr&Lj9ni_H1?U8}9k+)Z6M9A^S0^$ob+r#`1=6=lQh&3wQ5`d3v?Q$I*jj&&of}ZO<&-e=W!wx=Cc)J*%WW?b_GhVy z2>C4>;vCYG;WY2kG`{8ZZTmd_YbQGWVBp*mWJ)BFff-45U-EXuyHC^E1eexmcAfsv zeWgVO%dMpy5l^MG2j0dB=+56!%nH}HUe&JWwP>E*H)vY#;)|;<>(ff5H~G7@XbJB^ zigPbp+d1KM-xUC6-rBT1f1cAMM&7 z(e?2^=j;ecTRnoLlpap}C4X-uK)F*y!d~0ieWu!In$R$KHG*k4K-6`)vqHihd;mk@ zF4_zE-gRAv9K!E;8+8A9KvTE~QXc9q;xv~I>uK?hX@H~{hh77$=If_5;@C3!#mfGn zxfs%-@}O$*2TueN@bh$`O&5%S<0Ml)*zh=p4ix~uTuz+8$D`gfxg;_@dkz404CBhC zV^7l&eg8_sX8wcYjO_Of&Fk+qk${SeDFfA{NS-l!+dV8pO^!*VnTJ!r8fa7C4 z&%bw;4Q*tGJDj$Q;t!{)m3KcPpluqZHlc|*@{x(?{>UZ0_J4i}yS`tJeTiLq|Idq0 zWXOQK?mw3|1x1FFq19Jbsnqg+$&72AK2Uw30~JcqXeq$+m~1GH#cjk5F%mn*JwB0y zA1mT0alf`#AU-sNiv{CU2gag=t@I*w!)NuGBmpWmxA7zhPa|Bpx?9it2nj$UpXuv| zsQH)KxSAzEMZAm4i98O)Xv9nf=2a0u|I;iwp(>5{@5!Oa*Q?l(%mTX-(8oeFU z$J0*$^Do{=2+u7h(|Hz*tHE@z=wbub^)BASoKY}kPchJ=UJ{|OP0_e`@6aut53PTW zJP?Gl5k)cHyE?3;yMJ1kcVqmbHM#?bud6y(P2(Nb0I9a)JV5R6+|+70fRJ)|v3t zb`ftFFU1(;?_B{am!=)!Y5%ukwe~#_+D+BcquARJZ@DC^$7n!R6~Zx+S)T-zjFB*J z(%PSDp8JahiPksMw^+z+i&w?{!d*DgoABSXxma_Eb%L@KJRzaj4D-N4m}x6=E1|&z z6^8zDMR5;b79)mwMbl-RSa`k(UohY7uUh-;`qfLnO|QGKxba>8=7v|rFMPqNK*&8E zT=hM|bC2(ixs-(y=7JN1=9LIEy-3&06~*rBNMJ*0t&99{xsFw}NsAVfd)MjkV6h;}DQ9bf zi)Tdu{L;xi5_yH2N(togMd%tp7b+O52FBty+++1TkJ)+6Qc2EljOUR*x{=m*%(8+ zOaI>DqxvTf7^*{3NtA2TkOnU_{|q^^=#^wV1-GHP4q3h8!?&ro>5C27Dy%3HbBAz7 ze)R0yHpsDiC4Bo4&A}!1-<(oz?+}by9FNnr&8p?svqdwut;cDckvl)gyy>Juk%EXA z$f<(r%2|x>%h?-ASOo2cZ|3X~#H%`^w~JCG+I_sWmejt-_a zROXxf`!YXT43#OLg0AWkc<413>I8)5@BqShxS03;{A$=Z;qap&eA0#0M`>oB*FxHC z@i1-OeO3rhi@`M2!BrW`)8bWqpM;$)|MJI&8o#jnL80vSG>F}e04>VGUnaVrn zR{FAVr-B41C8udd_e&KN-jqKKwJGvJ;#fLxwDJUNri%y45 z2eeRMRuM@W;%TIzny}uU8YO_#?$-^n=AnQXzXo0m^?33KP0MdB!)tzdYgb~gQc_ZZvw(PqBlMav^=SPx=r}axV4}+TYkDxqY?Bdp{z4ZvWxpW+q z5?5mGbBCndb31yGqI6W*JX#8o;+y~P^%nBBm^bi-+n%&2ds*>e`lhNDEs=Y^OXXt2 zL;loJJouWq6aa5zVbI!k7E`R}J7NT7D8A9yqFBI8=sHp=cP8&NDf!)Dy=em@5gKPG zzZNO=p<4QC`CM8^KT9>*H4}9jm#pg+;^r|T?rk%1Htj5qcx?$OAsPE8a`{~H4WOQERdz31Oc`z;bC2OdVC zEBa3}`-0M|=%ns=HN_Z4>yF8*_>1D~4uQ?11K>-YRmG|B^lBV5_kCIlSC86Z{4ekrAM%mw0EI2fVjKE% z=v8q!`Rt~oy&qua_6Q+?`ae40FVG(L?je;z7!JpL#k+%PyYD!ge!R;ENCZ&4Yr@BO?w$UH1SY(Zein$7|J=c4UDKi=xd`*hes2RakbgljXczbI>M5`1 zscHCtijYww2&~QP1)NFHspDHT4!tH`jK4OYjYHD6JDXK zCg1Fu$>cn{KDB;RJ#DHJ3;t%&JtVOKMupQd-iU5lTu_#QH>GRF!<0RqV|*-~k$_yX zT}rh@L5jX+{!4HymYg((i7Bh&>k2bH_1!ayiP=$aee;J7P0;W0Uk-F09XfbAEU?*A!wm@hv+u)ZEYJ~Lbj{EGgU3Em$SvqZ;b55 z?8)(euxabGyCtr_wdA0(%JX(gzd7{8K1+4g?Clh>IrNnF2={@EE8W7E5YfSPaK)95 z@Fhfn=!Ppj(U- zY@P%5^fQQz#^!lofBr+a#^%q!o_+z*?Xh`L*q{H<-LZKn>}e*5?vKqY!v6e+9*)hc z!JcM;$YE?=2lnSb^zYcbA?)c_5Iq^2H-r8854n%cTfv@YgXr1VyglqscF5hChc&BI zRSC6$y_tt~t5kIf|Nl_KDpgCO{6EyRO4XIv8rbW>?*GI~Hv6Brs#m@uxhTB(i6frO zY|-zvn9<@nPe66)_abJr_|6lSUK3Xt0x-85^J=cFc_sw!|AqRY4n(~8@-I}8MG&3B zZ-EHQ{Z>~$d@=4Xy14YWey_@`mfU$l=^EJLtd`<=!fY7!6Xl~)Z`y3__p-&#%}*ln z_7l&$O?J<+LkCE&MVT4kypml*MF)wD#} zUK#lGr#(SNX4?jhVg|dJ0J}`pM&%l1f5trKWQnWKw6q;#P35*}b7pfFb>YYtwl7dJ z{;B)dwdDXHshts`Zp2+cJN9YJ!dc=5GeX>pq}bEzf?wqxG6Mg;jOTvPg=pjANo>;q zUn55OfWF7fr0~Chtot8{ClAZ^HI}oocU$wYk zaaCnA?c=p1C_#Pg0>xW<#o43IFag&3;u|Vr2LQ6NKR0jcvr%hI`JW4p}cM+T)OD`afXwy*`;51BlMi{7EJjP)SS>h zIzPPzMkZ*+GVi{A=bW5mJi*@KHer~ZK1*{u{d7@SuEB8K^xOx+yXH-Qe=OiK1Mv1fmeze8)~I$4AuAPwO0P<9g(At!)weZ82InJ_5I>y6lsJz zac236zLDO@wVuYG!-k(!JlFJm3gP%;6ZX|>M^L&G*8=S)Y=F+9RNaxHr{faK-q`x? zG3EYki*HIWf;~fHq1sLtA2xiI4?)xqPE?;0Rr{cZa2{DLVMC`M2%F7jH6#Ur(;*&HwZbBBgk1Ox_fAP9%E7Z+$AWzM%i~ z*Dl&^sBN)zz?a#d(2(WbSpUjfc<4-pxW7#$b%&`{<+pCKDFUa@jQy#vpRkVE@{6Ag zc_vO8nb@xv9(B4<;%V`GVs(hLF>!32=b9d7#fRNK)PqSSCb}j1E{=O&4Sf~*#p`26 zq9lC6%pr6ws!L_m`MLP_L}|)n!kpbxLifmuxU^03yazHPD`TY~gG}BDFsdEboZDmZ zk4pM!H2~dW^`9hl68dTTb@OHZN%MLPDf>J0|(8d zJFT=Qc(}3sXZNDPO7%LAwUgd~ts-i=VtMKChLiik{DZW$3xSTMOnon}g>|n&v!>rq zeX(x!cjmR89{dXU)iH8VVmDHoXva9DJknie{S3Ap44gX58B*A<4nARr!nS*a{BpFt zEO}xAMt25VKQVs3j&PS`Z^VsRha_x2y_1Tf*jycF%~}#E<>S&Q^LJadpfibfT5M@fC$Hqfyxh z!&P|h;avB9U$2w9xqIm5>R~#p@S6)s*p4emPw2o4Jix2aw&bL$vr;$uy}d%a2lzZc z9~gdX)E$-EC~-xNUngvb2;Yshx=pUUMn4<7W~Ej*G2r-&uxeexam|U*Y=ghi+SZM7F*PO9)9A*&EVX* zLkC@;r24?_(GKK;1y*U1!^$IC(oSY>(~h#%pJ|)LB+*BgH7{yo zbDL&%KRncQ$+R9YDP|*}@?%~^BgccAfQUelt4<)33{J)vZY<70u z?%v(^?m6$?yXR?tkirL#3ltk~t_h-W8?QW*qvEO3$8nyoT4%f0nozL^K*Ij-=wpCLP;C|LDs68>Jr;YSoH(y3yBXo->lQtZA=N`OB% z9>6M3ME5@BM)6j1MMhsegr^kz9Fcg+(LVo+iu-axgjI(LAuCk~W)|J}zbdQy6uy(R z1pex#SfZ^$N6Sq2te&4Kz0PhVS$Q*#l3dFMbwRAzBo&pkV)^$NElq<5Xb-~w~E4y$!a)H9BgF<^m z4o44k9YShWUJ_H>`AD*Z)=n`1KS;?pO75`}jJ_bZ_h3+ga5*<}p+?4m!Rf^^`{{T( zXuR!b*RgDU)giVq0NNxQh%(8&0|W!xmgZg6_5ak?{K*}}PstKH*kw3@IQf`?HbE!7 zS&L+>>TuUun}pu3!yv95W-Aw2D{iMFtcrV@PsqHO%a6)ixUsKXH!ckEh@6?~?;41qyi;s-CA|ow;kvqYi)k2i zic*A|q9)pBnw}h`Q!^vAz`$21kN51EaDO^Bv8H6t>b|{ni77cI4ki8oNo^~gpau^o zg~ZTNwg={S55u8%i5$UkYDo9P8Wn5dzPShcygJC7b%@vMp24_cIeE5#)W$&@W{+_l zvObL|AekdA+67yR)#LeReSFz6h+2@U-cNX%4?*@@C*a=YHa*=iZd5 zswUDxhtJ{>{)+IaJ3K+D`@CdqLCX&`qFLvi=LyAE7ugVV-(Ni#PViZ^rU@Qu;z_IC z^qYrjL2Z#4V92g6y>t90y#HAqdhk-r5MB)ACv^l?y_GE@?LxIT&8C404c=1xC?pfp zo&MSy-?9hzzQ@Z{u`*(R4X<;gD%9Yx^0jy2i1)vh>n+7eX!{8)ejn}ikCaGlO3qBnV$y2BA@DaYginvhIH|GP80LYf@Eq4$W1HZZ5Yi zfnU7+xB-5@OIa(BJ0!bmtRkP27tRtTbE`nnO}$;=-YM+SD|GD!fWBL};RrYR^O%6W zi$azCfa$>7CK>mJ^ysjjK6-qaJO=lQo=}i>7RaYWdE8)@$I7sWX=EvaYOCWeAdb zI*~~wVf(>)zCn0)0Q400u=~q%`R->y__73ewr@h{Po-{lJjS3~k^pjH00dK&<4$AT zUVO-W5A-vgepOs{jl?1j`A{!e)ZQW~_r!WG{WMlVJm4?4Ic(-VZ?nsggdxfgf3nM$ zd{I0Q+SFcQ@u9%`TqLT(T&QO}ZO%VR&}s0_FuF-jthJ#di~{m-LIy5 zCHg^%jjUBlVd91hUfaVsXJu?WF&aQ}T7KWjxtvTDuvwOWMN9?lANwp%y}I7}xgEyM zbw!+SDr4ks?j=q>_G}R3F>B*pDJ8}h4+C(ihgPbc+W6ew^^z&Xt)2G{Cl1`~{)Kxy zd5ek7Rqegci-*PDRX`aCYer$p#A_lT>0i`?!$m7SuE36{C;M^EXF?^ur_-Zg8Mwe} zKGr$9PJ z&3iI|`$VLQTAKO+zoYW)Sl)+Y0 z`S;*bq==!3wY{NgAbQk!%8C;HFKU;Ut5~Frrbuy^x(Wujg0%oojlg__nQ@=IJj-RA+0N z_xZ(aG`jvT>~ArwWo9JgcNy99zCDHe0!y(-@9vn(=5MPM`Ad zN9;J)eFMUA*vW;|wdX6xD;cLS!)n=q*r{t?@cFQQznetdLep;0vbu}L!gt58Ha}v& z?~F{bL8F@w`v`6G#jIEBd{}4E?P|DmV`H)XWO)zKLRYZe;O83pj~2+*qCYd-#t*+$ zm0A3Ga?4)_O-ZGQY!UH{I>EDZhPLWBf7@*FIDWgeW*#xrnENkgM~wJ*i+KR)GQU>r zwL(5{IQ7`Vov8wFvO6jMqZEQer+%20Z4AFawjLB*1GBeo!=}ShM%HG-S`G?W1mHg@ z+L*?on3SCl6ahZa-u1|j&4RI0)x0ySnNu%UE{^>CL#?%)$4x&aMZF&0==FVa#L7*n z+($Ou2b^kH++IMfc6#~zn!$-_oE-2{D zA=g7qLp~i6Ap(Jn^bTT5?#H*2`bm!Sjuq1W8A8UQ+iVjP^AoZcZd^9LkQEEa%B*^M z+c+rei>Ptd!+S>0l3stfA^OJUHq$NEmqI@^^VYW2xz;+O7x+9=h|8&g@bUG%Ez3%u z&vt=V5{nL=M}1)MejN;1DB}uU-Mo&MFW4$g9oCN!wC_gTI39Aw0F`SVDj)LUNkbza zn^?!1NI&mzYP!UIN6-4<-})(4yPi6f+P=6UF`_=c?*dI7!`Sm?yBw$dL{L4_-@7(E za2h>T66XcpM%TzEIZhc1dZwZ-l5xry^UXsS>tkbuuX{B`^}<={>Vh-d+bpu5>589z zam5*dBkk4;6z?5rPk_H%X~2n2TI+pb_y}{fl*z$>N!@F!Id8DN}qW_G{ra%=atx%RdG=yd8 zxfN$ZO_R0fUPJivQ(;QLN%%=R2J)9y5C7gL%or*z9R8QlenQyRK4Hx&|Bf3%c@Pb- z3zjm;c*&=>aF3~BGIKYdhvNY3-j7 zwU{|HjUYeDX~X{x{))ik0@T%+po>OVbO6+&r@~eG*BDp4o&DHGz$LN^bsPvC-Q&B1 z9R23>3p;y)(|S!SXM4pG_wB6p3J#*{As)!Zv8LVy4kx#ozWt4p+jmAJF^SX5-O!z> zjPUPm359{je=z?1)z}I1fwaWIzhW8YapWSu5q;F0)2#(JcuKqMI3)bcnwgq7! ` z!xETu(6L2dHMc)@g1vI9Or^ivDz>rn-(u8Eqp;48y@U(~+eu_Qvcs3Hor7XR`Fz(m z_(=Ol+{qMxbiu1q#{5qDMehwZ@7uJjfCye9Y|_e5xA61HGwr$DXc#+XZ=dDlR<#!T z6@i*^q`W=voLGs>I_dg8JYkLz?hactJ@o?w&E*JLSX5z$;%b{s>`wz0;)&7F*j=P9e62_oEShlq@PX=FNWJHC-64m4iO~k*w}p1OPUDfw9@Qb+uK6o|XNubeUB3 zJ4Dg|EBfSb>C^GIs~rVN-oD|db^6D_gBn~|PlhoqSy`@qxF9wLef;1wPXD-jlgvG? zK4bI4iKSl6%VdD}`~l@Q$n6I^vepQg+fn%vn${~psXTkSYA9X%kPoIGV-Qf~AwnEY z`O^yE6Z4d7hSj9_f5q1}<=Go-$8dH)k4SOo5;k*BJ#wde@=vB?ZX#7gn$y6W*pY*2n6FvgWqy&zBJw^aWhdO9qd;raT<^}nM;>t;Wa zHvrxO&okQ>?`*w@DEQwUM}5^N@v-`qNavy1Cd1yKFOV+zhDE$m&h1r=m@?kFZU)!5 zcGh*L3P(9>?1ig4Zl-_NT8d$x`Df;pt+t?NU)0m%>FwxIw1SsF1L{?h*O(@$7=GWU zaRb2tZeJ!Yl6qmj1P4RbhLPJQL($eW=Z+E{NebHW( zdNO06?JIsQJVdJ5WWN!MFK}bf7HA-4Ym!m^Ei#kfK)YGH@aD_pASTwT52IZ#xnWqK zECR|m#w&k-@!9%jqMz@i9DPp{YAS)5*j>CW3epsRnqP@D@sJ7n6Z7`yxXM#RIQdB4 z)=}DlzFUxPV8eeF`F9uA$uaLF7y^PvlDj)||Nkz&r8#q~*#Kpo%y-xnsK)mmpRMwB*=9^%N9UM)YO<@1Ro z4)tI_in!DliW0ZM-l*&OkSvt3(--h?Yh3%6V{6gb8v(S4IRsGMxBBNkZb%@LB0e#4 zqu#zNVtX z8@Reg8@3tIwDM6a+y8&G2xUVOl}*?j19hX~_6`uBVpyy-Gv#f}}e+ zp8e}#f9}&uB=z(1iR%UR9PbNwBiy=cW7wCSpp zn6Hud>N-Vf#S^RFFotEF8`0S0BNbyt$kp+Yhlh8AtfrP*sK<%_b7R!W7>Th&Y2<&a zm6^8UIqcC>&Jhx6<{6xms{vZ^jS)T6%OvJQSlkM8U$9s5?BlP<&;Nh-pu`3_B~Zx$ zfY3D~bJEAyYzymNOI5KqU@909+ViwZ4pVZhW4~~Gm{Ji;k$gI?xHm>*I<~-2b5YjPiYHo60>rhb%Q18L{| zN-kN$^oR7WAqn7lhg;s*l{1%nqdj||)acz0b$hPw40CRS4}*=&Gq|gh7L(^`->Qvu}j7?WPbf z+dr$T&h$IzpEwD9(;r$h0^(vM3lzW)=-I;hH9YZ|IK{5tLZ0%gxK<@&G&vzqwd>z= zxEDU%N!5Ss^m%dm-_^je^q1ii@!?sp+2H>s%L3Zt8Yj;aQkEqfdLALP`6ef|s;MTr z_Rm@fp5C%u6G&Iiw8_QIJylo7BSh^r60_^05cGo+)-b*reN|q^40&a{hn~DYnhAf; zt<*9_o7vl6_r+8hEVHeji|M zJf9%yqwhHc++$vz4I-m2!49DNbQ}IU;yBm8CPSTHUN?(8GCEjt^Dbsc@PmbFs)m;$ zyj~;~E3*actQ6jnR^(3?{>I1p6?yrrSLQE8ocAvBdqS&DXy0BPBi8*VbJG6cM2DA$ z@vxF_>I?j?oT0$7FBz6X`!87X;~Sc>Qhdz3zkSgqaJ3$K>a2AN5*@^^FUCLQq`ezN}WaHoE<{jMey; zq!AXL3LC*?h28eW-+x0LAHWRY*R;zlXuvUf{qW6ajICqnZ!xks-n%riD&aTJvZ~6J zUMHpA+wAu#1NU4oCJ$(RsR;=B-paar(I%rz@XgA~Q6^|~%Ajep?Mug&VQF9JSNP;) z+J+m%H4!B=aMsJKYF?h!XTU4cQ;UBy33>Xdt2TH$FxJaI%9yI56T%%Q`xl0_&m8li z8eP}PN4I#NdVw&2lH?yr9ovUy>Np83Z*WU1BFsCRIAbAcGi|&q0SC6WZan9)3nM#s zDB^(~HRf-j<>>3B-w&-E#$p#xb(&;_-8s` zrthhCZ_yg)*6cUX;5195bneLebO*)BUP0xs-Y=+v9<%kL4CEiCU$8%YLVJLnN;Ir+ zrhYfw^iKud*1qt99~)HezP(!@W&xAGevWpPa6rbc$3Ou=leyu#g}ui))x9>w0dzKZ z1@3{kF$={>)`655mzycFv1g#j;;sFw1GyrGR5;ho!d>LDq7ID=v$FoR{z}V>HSO#z zk}kemVZLL*&p7tl*2zPakk|i)bbtu%QGI{IJjC}LKUIjY#G!xi)+Y1j0DZRrABLCd>@h6v%>+=X@|*cl zDPiJPrj2vQRYK!TU+uz-6kg;e} z*29x;EWWBP3OicU@{?&j1>SCu2$YIcY#woWX-zTSHvX0$ zBa1v!_YWp#tmx`5=cqw3o5JvR_44$;+9CZsT|dzOm6T$)N9F23H|@5z|IOg&qc7G% z-fV*$*a0B~pK2Bex&cTGR#uSlJO^^|{`p0C3c8(&HzQ)dqT z!m4A~ypg}KLC0{5XjRV93cB7tEqAfo5mEX5e)v0m*C{hGNasIgF5PQhd1u zbQ*i4HsbSXq-yhzOL)s3Bdbv%EQLa!ZYp?vulq>XRt4WHF`0+{l?sA>kavelO_%%J zsQfZ@UvPp$VbU{0yECcw_(}OG?F=GMdtTneGxGieFr7KsS)a)0jm0Qv)d?@evE*OW2icjDGK7|0x!Rvs zWhc#@8vy8);ypdO4f6F4`wY2i)IAZuv8(pjkax;A1FdscJd0Li%EqS{NPShiZTDtd zeF2~xW`oot$T=2u@lNYWm!}4g&G4HEeoqeO=zaVGcQ?0A;Z~o77r3KjL^$&Op~9rZ z67}-T$OY4n^y@PtVX1g~8?ef`-e(Bheelm-2L!0wCPHt^=#Y86Qg@E{lU$I6peC2r zq*?yMgU84VHtJB3Z&OD^m+itHIv2UC?XLJTRd0*a)l~&1PY!vHmOE39q&uhdr~D&d zLVeDFy_#evCvith?4o}*-Ob#>adkBj&Qe?~lew|HsX+Z7p=qVRPk(NHtTtHgJA7gd zZ8?a|S#iE&fk5lp;{K7XRi>OiXTxW0$%}vQn4x@LP7ZE-_>VF5r10M}{I>dwKliXt ztKr3EKSB}$XouRe>A|*tymdb0goFjsT=i+ecNl*Z>flEvGVGq_u2x)m>(9N_bQx{tf;+J;k$RA}>^j|#gqH#w|zNn^4bhRY}5In1@mE8$a)FhEcP0Dkq|Zj(mEYP&Lj?m+85z};Ore+Qp?-?pfe^-gtC_R9wH4XaD{U6VXT>-xm?> z6D*`ktNMKw&VJ3%x_e6x5L#U~EA8L+%Z!p-hygRaJ<}9hZV%7Rb{ew$o0zD%+Yakg zUGD94dycO7ss+(KmwC3eCJbs$IoR{mH+#DX2Enr9?luYMRb@MeC8TUg9#-ya9BL3Q zmfdvrM6`F5q%VOqz+{c~PEk^(@+!_*2T|0sqY{dj9^!N6Ox)fJOJP;sptgv#R~8!+ z0I9>&%)H^OInvXKtD1*;(I*}nPbXhsi{MA;-xVb_Mj}<8W@@6PoEwu)haZLLybw&M z`n|YMFI7;k>l2Fp#+2fp$P&^ZgLAmDW2NdYc zbYd3|s`5Ae^VhYvwaVgU)`u=odj`X{XwPGDl2VL;t3k^@sEPGNIq=# zvCBkOU&{G8m~r6~+j5^f_Yd`LW*H^^4`I4R|6W*nx07v))?#YRL@BD9TUfT7RTfrw zx!HY~q2tbX?F(aj5hBI6q9n~uytjI5Dw5QuA?Cl(|FL9)*p(qMMP$WZ&xqg-r(L)JlWf)luCu%9Bu82 zN|~`R^>a?yIaq|HO^TjWSe+-?eS7#K&45y$+z?Yc%)7%5E&1&7f}MHFdb9VGee|WU|E4=Lg5j8CzmcCuH?TpYOH*8-%8GDfhb}Y~ySSTfvTKVh+&LpI7 zdK$br(R5;OG1J6)Dt7u^`Am~fn5tmPM3=($Sgra6 z1-c#88PMTpl1`?w56O;M8Fro1uG|s=reQ1FB4<@G4J_*2MW1sp;9Quw*}F8*FMDH9 z21;j9V~h)-ow&@%TMNyeyuJ4ko80uodJLA*s!fl3r1OSjvp6CYt7GrFUN}>^C*(=2 zi^e!T7Yn~$jwI&#w8oA*;DLYu&zx;BmH*Ib)|UM!a`I-@>D^G!G{>`=U*Q$Er%Nvk zZBdHO4J{a-e5EGoBRalV4e&R$>CyoUPr{nB-_@v548SdiIfs}jsV0XL);iB;8VdRf zY7D6s4((fYeLVquE75hGDOV9S@2yXk3y_Usr43Y)5XSuwcsmRaf|FHO0%+#O& zf4l?W$b^d}W$CCCX9^l7sk$^fJy#?cE&kGLZ?zL$u=-4Eezhs<*&3A_(|pnCo8WDl z)BALUwJ|((iD^^GAEofiI1aNQ(tX@QGRS)p>iO_a0%9prc!n{}OVI4oYhd*5{}|<& z*&9Qpg;u1tqKc^htq(dwAJA>Nbv|V4EUR}I9u+UV)!g&H^+P=}|9xhPPIo__ z0yV2d2*|os8Qy%%-Mw`-Bq(!#0bANx*6yc3S2n`y)%QkoF=Dy|znX`e1v|~hz87sq zbo%?5ba?WIzado%tnem^?9;wXF-i82wS*th!dvHp60#@7@qj8~SCM*jCo6l?6=9@r zC^Mw4;I`-K8_U!`hHv5z1Ie1KT(uXS3G%_xZ6(mOqvdnq_2~f=5YTg^$=WR&HvM*6 z_GA`=uEPz{dvqTTa*JTV*zI*mUat4s)@ngmfZlgovPSR`n%$lX=u_016=heH9V?Sqx z1AI1we^UO!?`malAtx`VM>4(EREy@(Y_I=$3&UW;?z0AR2PM?^>|!dDhuc+Ll<}-+ zDT5628!SR%0 zFsI(~)c-N6?)+Ykbl}O@fEc8olQes->JGk=61bB0(0#?1-<;dOdfQ;Z-nNLla!41u ze;d0nANJY$ANLwEZV9Z$$RmwMe7w4bi(7j4XgL&moG_bI59;54ax6s1-xLoodUT@7 zqtiJZtX;_#u=jPxQNtXv$6G?i)a#iyPw1s*LM=P}ba@HZdc=R(YS5U3y!f=9jTldmDl(jCg5|Em=NM*X~@IZvZJ~Y({KL&Ni-1q>!Aq$S-@C4>B>CJd+fW}VL zTS7EOT$^9g<<6*XiiQ1NGGZx=e5iz+Lss#bQ`2UY1+O_OWYY;g2&ywM=y58u&&>n-=V5_@kYZwFP?7?sKP2GSQzp z0FmL8!EFPTjXXs}BjX|c%MQz06N?L(n?60jmJR?JMkH6MLdh}zAvX5}wyB?F`P|^BO zQNI&Ws7R;&@Y3}B_-z92$rF-+O+U3Qa; z8q(}Uq1s2x)lfOh(>0>rO4EP_-uip>n*^!!{G27989`|#<$bxVL?mCQe#6cjY^UU} zr9TS0pLuNu=g-EBZ7VUvfV38`3u~C~@kR|qsytj9W{nmm03G7`f$?69oTW;sepiA2 zrZfvD%rh0KXWUB#@)ZPXKzH7q1wWy$kb-++aZ$C4=EZ#N>+a8;o~cLt9AtKFezeb2 z^K_q2UVu8|N+eJ&C4UAB&RBCxUJfk&c^62x4hVa6%iGDqj;dv8td)*fvU2f{Ig=G! z9fv$1xZZw~XOSMX#A^8KT2KP=CQzUL$!5H=J6>@Jgm&)4gfMG$M*iFH%sE1I2I5&E ztlNv!l$Z<@cLbk$H~WR|u?Dl9;=h`(WmC|K*T!ey>xB5y*< zs*^#P^M(mxbs{#8XAlEM$r*}sMg?!$3zg2Tmh7}ddPToaR1rcej&a;&ho%%J>RdS- zy+&{#%)31x-EQPcSSDCwkeMK}#hIKgarF~87MtGU=;i)bPe{OmMuLS&U@7Yi;PHJ4C#@w63 z%?*+KqUFgb^`yfs70K3Fehdj3ElDn)KBwNDb^P$%(F+qpX{!V9N!#INy5@#Cr?hVqF z+ZS|triC?b(dWt{|3pTco}x_G)L89p-MB=vCZwq$R?=rcmvO8#9ohdju{h_YX=2o5)}UQ%=;9#}=iEV7>9SmoJblBlJfxkpKzE_hZjOM4H=7A{Nk`YsZb z(D7UkKXOI7Op|HwQ$L$W{?YdjNikOYKnQeS>Z~b{wHUvhvP;+v3RB}z>B+~`_gr@Z z)JmMu>^HL7bu9LO3Pm;MbP|?jIg*8N!sHH%f5!yOtHma> zx3H&Yq|4h>9!A@Nt6Yk}i=oB7bb0l*-&|s{$M;*!VI}80`|~mlS6ut;2yAE83Dw-! zc>>c^kFWQ|?gL0GqSHx`Vy)q6OV3kt^|uaB1&wo`#<)oc1n94XZ;up8;UuE&AcZ|6 z8tTrIV%%Xa$@kdKyy83S{VmXN1|#fM_fPBXs;x(@}eK z40ZBfcn&$!WNm+N9;gP|V#Pg8Y!+1=oq!?^>#_S5B~o}U;deVHtJEq*ExC77Vrbi` z)1vI+AKv zdzf$r-q8rK=OAm>X&?tBIKejvR>E+l3bnmvMZ0GqutD6Qu)wG`R=8`}BK56G$`#ox z6PM;smg0|K#;NPUlNYzqJiGpmpF_Wf-X>J*2idSf>Z}Yfa-%~Su`Sa&%K1|umhJKR zHg{2vDIrbym%g(hyY!EaYJ>vW3@7cy3WPu@`!=vEdOH@wL&wrHwymaFx`Q~UCtR9C ztl)LC?U{!WGrn<^o6}w>@MHZ!ncfj|$5-8mm6@99>}| zbsR3?aR-#p8Lo5G9OZnzJ+AIk^ey#n*D5^(@Tfl1V-k#TEJEMTkr|7X_q&xmV0A;i zTUA|?9hdJ{8vQuS#P#%IFsrA8tAEIcmb5>!U@quy(GHZ|YSZs8#$gIP*n5Y8Fdvp* za=gx2_DoczpEO1@kVDAec`Z?;qFH6r#HJ8qt*}_DJomBJfAA*x2EP zn4;`bx*hui#sT*fTx(V4H!{Fzw?*d&w9`T_@A&fwct1*sd}$rc8AO}XHJmcu+f54_ zB_-7-5A1u+0PwyI_o;s0t_~B=v#(M=oaw`-P5rS83`@4};W#r*cLo#TAIc*z=OYY1>3S3sDDVPa65wjO6u@cC@f-6?G^A)t8g)enhey|72r+SlU!JnJ6C zHo3-8qw^`YwRx%e2;hFW%e>mc@AoIya3y)6VH@shnuDnb<2h=|Qd7v7g=|$#(A&=V zm5a?^P-DXC|NPP_Ao|tod;+n{1t^+uHDjfgGzLJ>t+$AsmotFK&gO&e#&E3!CQXlS_3g{P;iQ`kf&)CxrAP1!UZ_gpe zKX3)2V-4VQJ-ooNKs%_u*>fS%tuC?;GburDnTbK2e) zhvU&V>hZW6kU?vX>=o&xK!W_KLqZ=0F4{ZT#9^_5=Gb0fcxw?LFi8c(GOKx3@YzH$ zNCKC$=W==>VlsrpszZ_8FbH}ZBCBrPir^PRQJDY z2O#yy3hJ-2!TeX9OFzLgM&g>6)#0`&BmasWEm$Ld{Azas9KgQTMX2Un2Y#Zr-Q^$o zrCIUyU+T?N)iP`AX8}~Nb3~QJUC$-+E`3kQHO8UL%DX(a;-i0e>7zVDs!lSerE6E@ zBk~u;YVNHuL~ph4PF!^=f%10#P-954T3;1}t<&B1Rn5tHYlFuvGm7+<8Clr<9d2Ar zV>zjKMpEbDH*?s>2{)>(nHh4ap@1tg@c1joGvkrt@25hM4@5y8;XTX7rXNXHy4^(y ze3r&hnk2--!&?b$kLEMka|$GIxn8L5eJRNxbKdudFB#;eoBVo zHfHNa1LM&D<2S9dU?EKn6uXRXOu9@^bkKy0*BXn1lE4E!H`d%T4=eA8?+&Qef)(BY z=LiU#SwdwX%)(x}ejYYZC|4xWzG3#n$pB^Jy$SpDtPIAw9~h5!fm?>CqNDPt;^*YL zNF_#J6aO8L4=aJ0<{mh5OQJfH zxL8y_Q0RevkULF8^@3 zbsB1tKSJse*x9v;I)gFI&paf_S7eKcK5q~pz!p0aYI$tcuDr$-w=^~37)U5=m)3D~ zd=-!2Qpp?MF-Lt+qix6NP;CcnUz?)aT?G=hvkNO$ubvm{b4LBfjnWCo z91Qw}!6WgvCJohYYIi!`P}ytY|Lg;A2PF{S>BsQza@ zj=_m9zB^STe01sgB$U;@;CAfp74Ek8A(nhI<)V8_;D;COufO(H6wL+eZeFeeC+tay z%0vH~{>T5H7x?wk4q&5O-jb}5ouh)`fjJ68lhYoJdw;npN(=k^(&B+|WYW_|mWKZs zp$eAJZW?P8W5HeicQ|1hODCUO!5Uh6FUX+ZZ7*TT>E1@^kBs1+%6>c~Vd+JSR**eR zik?0$YDUO5{b&8D`V(9XkOUXaL`Nm$8Hu8axktt^FCU(XW;SJ4XE35R9%xBsGDH)S zA1R@aO>WKOdJN?HlU0JulZ!Cmb~TKn>=^25_ud;kGWz{#=B(wX;PVMc4*6CkNXu3( zr#EWgyJ+s`6P~IpwOcRph164XlgwX3GvwLQ%u@hQqiK)Z&q9k@i90)G5o(f;M8N|A zf!@qP<^_l<`Amjo0ys@Z2%vpK7->oYx|U{)`(`*U!q>fG-~hI!aj-sZv_)^Ct=K&y3rM%L|C#vRoP z=mojXR7HhQczbT^*?^J%QeUC{71C>qyieCIECVE&FKPXh$Tg=4HW)ea?1w)fFvzz1 zK0$i>mnNCI4__x#WsLkWBM&2Mn5a# z#x)FDZc*gbKV!n4wXnM8sFE>7&NN%^0-n(feeO_a^<1Hd<3bwK7bqtizZv-gSB4_B z5J~NWZLxnoIW?}1U$TU0G{y8WUiiF6UkplUBY_PUeu302`_b?4AI{|+WHT)0;Yy+A zLhw(l;G4Ty@MjMW8v&mK=_C8mUD=}LVoFD3mZGz>e%#j}w0614i^-H6UtIjxr7~m4 z!4|CwZ4h)mmB0z$nV^rzdSGTk`PB$iI#o99aKe;$*m1^W8&TGoQzxnBZK%r_p6VUG zMCxTQIs^{3$FrIrP3WTja+yPjw+yiR);i}&?zp`L5bDo+rv$%O_^);G%1+9!s5$rM zoMfu7lhyEHi!xcz>ANh2hSg5 zK`&B?`*t6IMafJv;(3>S&T>21=SX`x*Y9Le^C|QTwj%X8RZDk3gZltVBz|h=WO`e0 zoNHvW2#SMUCONi2!m6u^F^q;bH}JphJSv<K4|6Z7eZ|hf!3p}X^_IWdYc`G1rvGnL|r`(HflMAzdfS1C8bWHg^ z4KneSyE1|_t$_#3H8nOrwny{PDe_@BOHbCF6N8emrkXB>d`x%>?UcyKFdInx@1!r1^c0872n0Wag4&}i?m28 zQ8AZsBSF!j7k(-7GNbV^lo5@oJoWT=N*BWnQl>oLQa}%|0Wd~7rUt-pV`E9zIe-(0 zXFoh0QLb*aleodejv8cjtlaC!b35F)1%oo)mqqHaFQ8C*e?DO)X zGtwFosiBNqvaqL3_UvtWk*P50LAjuW!U6o@iTm_kT1J1OTz4>jFS90(*vF39YSGR- zK0vxBlm;prou+3$8jf%kGth8-*(T){`}}-= ztimba_!{`t*2FXOz;nH}LRb@7PMn!+yr(Ru;lH!sEL|Z0aGg?q9O(wNNh^D=0+aUxxs$zd?u~=|% z#5Hm_a??~eW6ytTnf3~#VoW&o;Y_UC3Y0ao*G ze3g3{JZ#<2=>RzQzZEKYp7*-ZYjsbUpm5H~MauU(ZcMcmCD;k7!({0W$-`>O8~>`uVN({S2~5&{6d)MZn>(B)y> ziA7>k1eRf`=f2F-jCc~(?rIB_*+1B>8ReCQnkmjE9O z`J%W9%BZc479BIs*>F+XSICs!K_N*_cyE_-PkXMZIK=nd$kFga)Bw>SD!oSFEWAP{ z2P}_#KhnmzWu;!b5~UsAWYlM8vpI2H=ih2MFw%QT+Fz^n!t!qrh6gM1*PA!J?hlS) zq?+igqg|y{PR59j0dNxocb)|3lhUE~l(*t^G4V3&c-K~ws zX>BVhrVQe8w(#cVpae~dj)?6wT#phMsrj7h*q_>0A8+y9pac8uznbWpt4hU99Ds7< zEr%$<#kXCGm_Zi#GM1~fOvRzK!~-o|rm>$yDxTia)6wNfC!BP|97|(p#?$LF-CgFPy z_VM|?co9r8GncllP~kaN+;RR~@q?B`f~wYERb{c$3)Lf>SGGP+URIQ>6VCWQ0NOw$ zze(*1l5F~spq~0ENN3XBgA0)q(-P8lG)4yg~?h%i(vKV0!G{ zoUl_uZSSy9&HGe%%G(atdZ8+Y%@SVlW(i%rIYK{g0nAmG2_vw+dI&we2?FW9tq|sW zp9x!#GyIb<+oL_0L7wJsi=5#vz* zTPIY(@R^XdcZAN~OrbZVZy=;^sJB!g*|W8fw&PrS_Y3R2AB4A&-we=AJ(_6hG}SzHljWPTCe&RmDz>%!E`HQ}vHPFOX-RfI{IO7L3=!YT{XF>JK( zWM+g=Au}9)hY6M8w+i+l3x&Ixb;4!jyMz;&qrxua4F4poM*f>HJCn;l8aczi3jL9P zBXrK}6PhDuc)d^y`FtUrnIO;@#qc0V7k(o`gG_6oJ#vQY39llrD2&a7g?EwHg7kD0 z)*~Mwe4be(oI}p=Hdq(pxs0$Z^D{gH_qBwlG6RLS$X^f!W!N)OzF4^H^%KsLyrFQ= z^I#o?=M;d8a%-&o!Zq(#pM-q|!=msQ^0Gq3bSF}rSb&tAZNHx@HFy7@Z%JFChdbZO8@0+jqhjp z9~h@-jBN5y_;lgP^gON)o+30!j~41Z#AkAx;Yr;6jPvow2;04(!iSh&hWiVvkxz#5 z9RuSW-T%Qu_cK03Sd9EP-(K&ckLCmn|L7xm&pN@|sYXGvyTWj-;N^#Si{PacokKjA zsv4}1oZ%;e&5>^l+)S+x&^|B2+X6n4CkotoD11erQ)*%0c^X3i&xZe~KAZg;o-@~5 zE6mSq6yAYrB7CPKGdcgyhHq|)Fd#Elcq8+sFarPIFRaRZE-c9$66R(OLqA~t`@bLh z!U37RLhsBDp<8B)&=H>1F0(>-9=??}nb|^Xj6Vdvw*l}9_ZE6&y2E#u)7R}3-iP=L z;M;x&u1SDLWOl)~k`q2#=m6>IkQoDUhYBylH`O=OS9l7;KN6N^c0yiuL;tlK;_nnj zWj+=LbMd=mrV3p%;nhrk$XiajRtxhW&2PgsDYF{lQaQW^@m|l27lvd; za^#^86pL0Ac8yo%$iAL5&YHUILQ=die= zAuXfe9b@5LIseasvR@!9&MXxcW>#?jv$P6_Ivfu7kA(h4slo>bIOC| zy)Tq;Z-~~7Sn?ffqCmq+|{;M!{pNFye2cZHy%kz#12^jz5-cG^6 z_)CPeH&3Vt<8(D|ickl~?u)`;i2sWB3#8>2p*`Rh-X)=-N9{cW>3IUuQ_))j^O1Q% zEtrQi!0@xe>)u7k%VnV(TY|Fd^3hdNmf@AyFI!`(mF+Yj@uLlB3hIVXQCFSDS` z-hnvpK%AKnXD&QDCwvF2)AkFKU|u%?@;Ju(9_o>m8MVI#-VC9+H%)lagYVv(4rMtL z=4TXt8r0=9?J0acpgbo+-p32Ay>UWEY!{PZ4mJbkU9*LWFdv%= z^ToHJTxNNjggM?P!d#61jWEMI1JAxJjPqC<%lUs?&`3=T%5Vv(@xff!55E??mFye* zE7>D>H`xXL&q-(F;2+5b@L#=PzEr)Sl4=mlg7M{13?CTuV2+-GXSu2A!ANROuuN(} zusA-qF3k69!Lw_?I-zAAUQKYb`~W6&t3`tQJTm2H+l8^bC5IK-cR<< z2KqaCll*l_4;b)bKj{T;^V{BG|GgC12fmlO;6H=>u76)D6j({~7{H|iQ|SCN@M@}2 zpf!!dfI9`Mke*54@zk_{M9+t{+ zED8!;WGaDY0Ceo^t1k#Y3~Ja2mf<4@Ap?oPxO=g1j7scLFAkKzk3J$r|9ei z@DF~nSNNxYsV4*`B4@Zzpda#Rpp{oWK=uh4ZXPIyyn8_Nh6YFvgW(wg(&K+WurKv- zU=@82fR6^IlOBFxQ0nghwHJn!;4`H6A9PY)umJM!U~cj|%=d8J8q9*<*S|<w5}*D`HqX-}dzL zzHR9?zK_zaeV@SZE_^1tZzNp9eU;#2m_@Zyyv^rPm3xf6eerVFa~7p;x-2Kx^f=e_Fbj z|9#|&e@B`<6J?@dt^Xmnzj;Wgn!d#C3NW0@-!)C&#E>+5CiR&|)7|~F-`>*yAYF^I z!8%g#rQZ>(H0_U-N`J)d|1J~8q&Eq)KfO^%clA$%{g>bOWI_**1Y^ zt>E}f;rTR+lT)|#{4>+_{cor1LYklPPfb7VpN?T;{Rh(H{QJ^l{Cm@*{Cm=G`ai`m z!GAq1_|SiU@QmU9{pk_@gYe9QY4(ns zF!t`6kd|8hS&)|5X_hwJ6Yx8kY|d7#?EfcyO`vu+*MBJehJPdSw*EQk%KqVGYu5jz zSIEDa&b|E$VXjL1&_Bc6)yK`Piu>1k75w{bg;F>CMN_x@#ZtHZ#Z!0THz%w@ z;L~JM4$|4MQz z{N{wQ=il=eN&O1%z3qP_#okYIz!k|~{2!4`SpVVVm;SR!vN4>MDjLX#_lE<&Co2X> zhig<|SnAaP*}RK!Jyz_ewxR-ZF3(>XBqrUkf~udLck-f|@YD$%cFA z{Z&$}pp0mal$ClsK>Pis7)_NGX^vD`Y@KQ%_MzvgFUDgk>1;frJ{ixamWz|^nXGsh z&PPi#^|n)8C7+0jS|(mhO=GyL){56u$!6_e%7^g_3fUI>N|_Pgp^PFQuj&s@dG#LY z;;IGXe=8n_GkivQj%>jwz2j??w~#aZsY1F@r}i2Xcm= zQ=cWB7S)Z9R7q#xj@;Rm6q3;|s#I_tg=_#bTwPI+H&brMyDDenWGmoo{0ilB(iwpA zSftF0laGOU59MdKasxQ&g3VP<#K&>@VfSxQNap*HvL}9CIfa+Cvg^j&jjx$&ISKL zebQ`kd7_-SEb%z}mKHxqlo3~97{len)rm0tM#L2fc5hA?d&Y%euHbI31b6;)z5z@l)gsHxo%$xw^O{;fOPkGh7_rg=-vfdm^`Zh-@z7n8n$`ERzh1Y2*wS5lO~2CN@u26FZa4y!aQS_eZi>E$&OipbT&h9`q&i zibe7M;-Z(VBtA>Jmw=mzapb*3E6JXTwlBmV5+y~_>HS4+>RyqXxR>DfqTB+0TcLh( zJ!PHytg_y1q^xxtE34u60}NyLU6otAzrydYa&wnGCnwCWt-orV>_SH*!^9uhCHugCk%K#`kYXHa}%783WlpI z2arFfY;xH<@$3N7`?Wj}`6u$*?oyd-Ei$}E{sQ?K`GWgEet?|eEaeRHn6k&Mtt`d7 z7gEYQ1>mxjY`7whtvF6j*dS$;Ggukz41?d{%A3wmWf+FB`wA*?rx5%WhIs5bIblcT zH=X112loIc;9%4sLAkbV@yRTZ)?+erD;X{W3we>s5rC}f{@xH7?+s*u0n+*mh;ZL-+4d$gU^DeE5IFr*K!6EQQEmNr3?41baB&4FU}uNOZPKw>}2?`@(gl@zxglWUn#95X?5Hzs;Pe^2$NChm&)k>{19hxn7qWT&w* z4`m;3%N?B?au4Tsxxe!pe5X14ytm*RybIq!E@ipnQ&u@Ld^e`@A$;eXol?pcj9*z< z=R68+x}LK1-{E%44^mW)XbN*-VstEmPMY#V7r9XFnH>ar5-N}MDEX_Ij zV|l3ybyZ&(1J@8J-~LW*cy>VhV#^%tUwsG<+?HyKUIq70`*-UxcX$fW5N*RIeqKVQ4p4HB&1MjV& zG;=B`jUoTfI#H#b^Eg~N@g?{_KRo+^+}2@jEa(4&@?`f@c@~UUi`?Dv2QHoi%lq6f z#?%w858^7yA=iX=Kcei$be)qIxIf9u;acmSg}6EY-;(!2ygd+ahbt;u z@&8MZ|MT+uaIJxSZo>cnf_L7Rcer_#k07n2-+xtJ0&||l9AEShzw}@D<^Q}t=eg`z zL6{o_nJy>HE$I871#^|z?$1zm>=`-#v$QI3zoNVkYlVf}{WIL(VE%Ch;;=mDln*P5 zBFZ+Xm-TKjct=r)Q%ISG;kV@x5O1V=Ssn^yG~WFd+5s!`oN!hb#Uan7lnQXY@0L&& zz_Td)jy%-84%bEbO=ugVVLmj`Wpz&9=>fN_veV60wzy%K_vN&!(lBo;p-hCdjfOeU zFsS=C+<@|$n_C&+-jVxb{2$~uT$rms-H&xy8_oGYD4tFD#Gey+#T$t{;{8O6G1T#yhBWeL=(ePV)j~c3Dyjk6J;R|OG8e2S=!o)Qt|~cA6)kmZ6Qu8cy>;BMm!1ePQp6u8%Xo_ ziASKmSQ+Gmv$AO?D#@3`{BYfcvGtF{^IUjF{3;QJt2C^+io!FpU>(EiASYd{&bmPP zb%(NeSRk+U!{3S@Ce9w)jP&ig+-Q5f5PeqVT^h9*4R(onUQ= z{2IE+8d5Q`2P`ScN2GfR@>5jWeOo4bwnJeG&{ckg^x^?O2kjKsB=QQk4D>amv$5CJ zW%3(zPrBn?kjU>J!-u6X@~u*>#CuXZnkNFDC<-FKd(u0J7bTi^FkDCaJVABBH9y?zjt4f|DrV);QF#o_6X(dLhlXrstUaw9E3u zhfk3!a_Mj8c944`XSf0Mb7)rs#-)-n`AKA0hA|1(+|o_=j70X589peL<{|BTY@TmT1k*a7~HqJI16l3BG-mQuf2Vf$VSIm2W#2 zD)HrV%Q)q~Wqg`U_IifME?5>rDkzY%|bER3xM@#G7J`(xGVz{kz4tZ_qo|}+N%s<1$xb`nfH4?W( zDqn`rie&HlOYyD57I7Kb!v?%qBs&UkLErJZNcOeQ%9EW#@^bQ{DDQF>%ikbpc(VKl z`Js}7@s4syEFXp&$rX@Sl%I>2mC5b_!=^lvv-2@8{?REbYX-|XUAH-Y84~k0SL-BF4 ze*}1eSUExdKbj}{i@m770o+a;%k3#Ggno4!?g0hVP+U;ecs}^es~YkAs*U@171R?> zT0QQh;5VtBg5T4)_s~{t9&fESi?@K^7HX?_OSKBdW4N{2HvT;PzM!^@vwL&G{#Se7 z9c4w4wokm(UDefhG6+g$Tw!M5c5Z|PK|#{8WI+%RLdok^SrnF_U*2|x4Obx&%=-5Gdvys zHc~x&EW$q{e;fa7#DK$z1_{R*{M^LYCVOo{*c5T^a5JN27<6iDg?C1h!zab}Knv$Z zuIr`5cFyC&zT{uqGV1;Rq&19hXfqLCqg@KDgANnt<@I-9Y*=4vw9vPJZkm3}Q1l3vaNgD5gyr6pi2pQaekv-gO(0(~<3d>EU) zNk1^oQ1JKdp&vBbNMqY|_1lJ}>tbwdIQxwbqcR0AR!5Gaw<7 zZ{wf6N*lt?VVJ#E8*cM+6Tdn7lzmZ)5%D4ImX)P}wsNXA*{ZI=m>cJ9rMA^z)>e5> zgSH~)8#K_k{9H@0f7McLsGC<>$y&N4k7>zcV4JjF_H3=Cs1Oon@4N^wlY|m zfcM53RvyqcX|2WC{UpsK&fn6CgXX7(Z2A43cEoC`orC!j?Y=dJ9Rsu-4_d7?nE&X* z-aARtY#1}`8a2kZ03Wk9VbE?ogjM?tE+_Wq{2qSVhWW@Ac4Y$Ef}GbO<81J{T4eVl zTi|*apGd$vDwABWHxrm&=KKrtgow`)$H^n$RmFLd2J4~HwDL|}3UUxRe@VL~jz3U4 zY5zmpFL|i%x0h)jN}5#j?SEI-8ruqhI*?;_*t`MI102E8Gk(tZKpBe zLS}~K0nhoy@K+)}7~Wz0B+b`y{#zI{1LI>x7?onWia1$K_A9HEMc&6p#jd7oDRxn4 zz;K>j?5v2(sbzisp6D^`Hjj*9cQEBKWqAzx_c3J97~4XZnhROo4D0y^v%V*Ib-hQc zm|3iDhxPm~ny00{Pp(?h`$<{z4P|yxCF*t^Opvv{gZ`YQcQEZN=!IP0cyq2j-j> zS|jvjpixKLT0hZOMSOzxw2sgYBIca$1NGI{Ry9ehKa(!7vMFdX?xSy5{1~7)`L4zH z0Zq6i)(kq=0*~am7T-tIFO=H1DQK8=WWV43bhp?(o^G`GF@#EF;KBhIWf6$Vud0dO_bRN#+pjv_Cbg~y`9qDo z3>EVCCaAA_1JpM_vyAax>f0htQMY=U3i*5&l&jtWMT7O??0VOe`wsm6eYZEUVErj8 zpR(i_{TM}=C_1n0y_av?dIlSy%f3L#& z_haf!m)~>YZN=)oGme_uZcJ-aZcK*#D$U<#usU?CVrg;9^I%)aw4q) z9?dnYoKARF@?IQNWpToA5noE`n{p#*uxL*-Dt0oZsnouBqS(rm^2M@J;C%a~3{UDQ z;wnkYQki;C;(nE2P!R}*~^mrU%NS}w7th>s;KP5nM$ zVJdhj9ZQ{^03P3s6L4Ddgreelm4v^h=?R{Qcg6Qj+ZW$M#BatgO&b%xK*WChv9y}; zUyArf9IkRVu81g)thgFgHpO|8r*oewedBt77iHX%Dk+i&bgS4JRoln9;{G3uSyJ_A z%zP2oj!`4^V+zAqV7PZ=N4Pt9CxsVBhK0ei{z15Uq)3bl-k>pGS51%kLL4tPwoldK zvE4;HFIKI(I2OF4_J$`Jhr(k(KZ(3-v-(xiSRQDH322(u4p%TzB`xma;oL}JX-ukc z_}j=u{fdac(u*1&OZrQkuaNYa-qGtCLnZwt&O1x`PL1?&hOLAC6X&I*{6EC{uUF^^ zX-w*b@r|S}wUZ)qHGKl|`51qfLJrLv^m(%@ZEwO@YJ0N@g?ufKPBhEX1tR7gOZimS zwSDFZ3g%8Y-=p1t{)C3D*^*{9=c6>x;_t3Cu$pTyH^F&zZJ>xNvi`EJEfO*3xl&Hf zNpis2N1(sT`33_0-FZZ_#}Lqv<@|NxintYNWY=W(95hvb_0!QY@jO_D{^@T+t3}ND z5%ivj&!Lfi9_r@98lrA~lF~xNDav2{ItpkdaNb6V6LBBqo;O~BJax|JD_@9sqq5E0 zuPlT14&y&6Q>8U8Lp@#UA8=k#>OWLhU9Xv1)`K;9WxZ}HXd8@FZ@Dwolh9sZe66}) zTH~_O{Z?H7dKQddQ76C}CEU*~g~6+ua|_p#*6K&xPPn9qIUj@36Ii1rZY z+wpE#qlecyzu?*6HN|)VGTH%sxt>lcX(i%Cc(4r(3P) z+c4I|_T~GC?>gJYk15)2+B&;|cEFb7`r2d>H`T`2&uHMwZD^TxId;7;7Pa1fTmv6g z6_0f9s_Ek1o>%9)->GXrn?+sjo>pgpb_)9*6~?gMigSJp@!M8rc$XFE>*gr~*>@e* zviz*f@lHx>X}-WaoRb*V4_?NZ&I3GMYHLq-ZsRFp?S!Z9@T#d>JXihDi>M!XmDP=6 ztqJE(vA#iy`iW<%J3UYGkGIwLJzIq}K^4_3FPQ`S*r)_WQ2%Wk_-+(8xu=vIzc2Ysan3!aply(9?vvinx%_^<{ZnbID<^D5y`OtQ ztg|X&zTF93Dq(*3`qx_k8JXG>`;$BYgX?JWGo4;do4<|XE zsojm*pF_;kkOz)Sin!GXc54yM<(^J|v`w_p$O@;n~EqK!p#SN412 zT=s`*Ou|wAP?hn&+!O{e_kvHm+^b3Uagu$VxX)8veBS-v);op6$5`9)SE+4Th_x+? zOKr>ItZkVlwJqzgwq+ZsZP~_nS%9U!m=!Jdbwf-=wimmyS2f&S`?KAT`3g*c< z->qGj=H(S@rdG-VpQ%#TNX?S`TIyR(H5eP@yqY!u))r`!EKOS|*vZb)lKzGrRA zz2u~bInR>Xma_@5M@el<&bv!(%jT?YSzT&d?jx7&56LkR&nKVQ{dyOOSlJ@~m$pzY5N;XfPIn=nm@%`o4%cwzD_h%XqBNFU!1{$=Fd}WSS{h6K#7vdiQ=C7m&lGW6eU#Z(?+L!1xu z3Vtu!k;XRUx4ZTv0&``YXA%lywGPQ`!_5`_=|q zt))CQ&UO(j2n_%@i@`Ptz$PZbk>0 z-K4n?&PUQlBA!Vdb1f|kzh}mGQwo0X^p_@gxQ8(-+|A(Lefh8NA`k4{B+uSU z3OM@+=+;=IlWno%+oY@QNNdSBZ%knB;1x309zkHPlJj>7_(iNHXKel%`N!p-ae(0v z`^?X!*SWXctZ+Yej(rS%uKBNX&$4~tA;y950E2rG=D!{yE!efUwhNILZC(~)E{K&y z2{Ky5X=IjNn}F{e=dH+28~lro+at-ZP(Lv~gA@i`HB#K+Wh(ToNNcADY3_6*O`KOr zL-G1LJjGs(C)&&L1bZf&z*y(;vq`l4HYf0XMFM7RCH4Ee90 z47Kx5hFUg3}^3oL(-a`hqv2fFw9l=!sqPP_<@KyuZ0uD^;E)@ zoOld=Je=QCTS-`!!&4>ejO{A>z6d@w! zJdr?dNCEPreGx-_%K0&z1MMZ8Y4f@#|8sfWvw&d^tBYnzuWtx7VRcY5Ru{GQd7UJ_ zSFBFj8yX?v??Ti4%b^uM=yYxy7OG9tE_{IbWxMKi4c}n>$Lw&Jn)~Y>D@ss zJ*anDdZ$ni@To_mylgZRa!D9pfY!iRGur9(LB~Dt$2#t{MWD}A2Nm&CPze~zW;_Xj zmV92Qu78d_BgJ?mY30O_o}eFvM?0tSEYP)O{168HsT{n^S%i;EW4FhhN%)e8`?GqW zJqEou&g&v`xh6to|5` z&PLt8SW;8Ee}7^3FIKvLvCd%(<25<>Cp%NB54qpl^C7stmqLfU0imBHzqp^giJ`kN zcOQ!JvqO-J#rghF3K5?SHTQ3ZU~YwTg5CnJ9W>K-Bz;%T8=+l3Xyt#yuJ4Kub30f3 zbo8w>x3im-&pN4m*7--!Y!Uy0M*DfFr!=?I(@#=bL4B*#^6My-q`93+ep^Yqsju?D z8?T&`=623`3lwOtWGf$e2bC2f=KPd03VzSZa4$v$t$xmv)h19MsJ_=ih4vKZ-BoCB zjZ$;n*($WhIA5nidu@-J?VeDfJ;(Vq7210$?(detFG;x?FS!nW9_mB(-0p%OmvToQ zcZW;4D%0>4XC;RADCaw*xt*`@I_IJ^x5Ig1X>R8+R+m(j=5~hRxpo%}^AC;jUfaPZ zB!9^hb{Tw4nvYPNYicRTZDRa{YJuOL+Q3;S=?QW^TO9ySfX&jmX@ba=sDLi`3Fv!hXQPvTS#-%?9>h%x97Jv0KStXC2mS*u2G}pq zPGBEuAK)|eQh-lUhX8v~M}|)Bo&Ybqy90D~cLnI;?nJKy_$TTb;1l#}fF0;HhHmc1 z0lEkH2=xfC9ra{*-Q5)_=o=sh^%K~H`b!w#W(y2-H%4L5{}&%J zS7>&Ct8}BlHTvO0Y%s3}_`tkD*9W*s zvjW_r>jLD`wG3;_+W}UacLKa`-U_hF{Ee;*aF4Edh~?(}0L#n=0hR{H3$Vm2pmQvK zh)lDfz#_Adz(TWd6c+qf6p^qsD9aZM{7e^{XW8fE<6MBH0>3scAEXXX0=E7J;5D5!rZQ0Ng9);F@U`yEB2kZpz}pa7c!C;~ZV{`Yq|dzMGz z?f;5p0mcX{MPmh)pm7q$`-=li@G}EU^cSH?0T!ak0T!Ss0p_EBFr@n#0jB!%0=(nT z3NX!|gQh>k41e}R%tG%z#C!hC05b!;hh_zMm$g$kW}rC?bN%T7=K0eCWccp{m>*zj zfCU2SXraJA(4s#;roa@2H9=XnD6pD+#`_PkO2W#ASi#QaQ7mWY$+3)`^U?sb0xXfR zm|b5!G9O|QyY__)3mE3J^2m6Id8~{$=1PEaoX*OSV;U;6`0J*E+3Ov`TUM4>^mT1vcQA@lO#-hhzT4)xz=Xw^?vRbtRCn1 zoYm`xSsi~UK(7D?1zu;*r{A%kVIO-=aD2w_DSK}0W!S@>BfA-PvF8fM&WHGCfY$(?AkmEy!3IZJh zeDDa?vu9{NvI4Ys*9Ya%s=#EN;Bas~_k2tY5Eo#=BN)&6CmiD*Vyr-nGe*MO0^tCo z1L)4E0MvO)KyyY)crySA@CL&OhT#}H!x)BQ)fvJtIDp~|k}wdX00RUi0a6IU-LaA#QUdK5mPcUp_+a zI7bQSN%z;QL^|m8A~1j4A>!ymA~63lBvMX)2ecvem65yj6A^QMhJxPMm-I^HBdSR2 z<`rWlh549wsc*bRn;M|&(A4NDt)Fd8M;Ub}%wKa}g+gv*3A)b+N%KdXU(@c2_y;Y{ z+^1E7{0_#mwb~-i)Y_U;w0WMMeqw} zoRAulc415V6o$2UoFB$xMZ6Wyx0mB=`_KFT=lu`z+|YTy9QsxCw>amoiSb{Q<5x$Y ziZ}`#WBswS|Ksi4*O~h>!}#?UzaiQSUYN=fpZhP1d_Pn=YX2-``Fl}4AN1+l`q$9w zBIaCGVEm}GG9${%nIF57GS&zE|Nj1c)KSEopGA$O@wICHR`jF~-iS~7S(4uXKlhhV z7K{h6_RkpBz677Mw^`c+#+O#1R{nNW(+6$tno-B&JOecp@kG?gAB=`b<6A@gF02Y8 z@;%T}|F6<`-!0U~FQ|0>v%LQ-??21?&+`61FK=6GWR=o=SlgdWAzN9mp)O%oOjk|O8HzfjbZvKDZh2Qu|m@B;QS*=pXR83 z!#J-aQ-1&7^|hdvqwg{*>)(i&^Wr+>w-(hy<~3>U6z6#q^2Iri(_=+kQUA^G^wS1t zFPt_S>W2!@Ki+Kgk@D3zm#=S{KG__m50$jEyPAK~n~RupSFZ(YvGi0E>m^LkFDmgL z=a-~cGeO_Cu~|p&C}PgrNZQ=J^>OAn9dyDt=jQ}@_-{qUoG;ZuXD>(ZVD8hOhxRn% zCnUY*%X&$(P`IcGYulQc&q!JeuHMS5E$IV~R6lWMsz*fsbB%h&*`?+>ur?{z`Buf? z8>&9;B58h@^Ehd3HRr#nVOR^T-ggeG=f&|j&rzlMXmyV>Nd_AC>%qjyjd_FR*qA7jTQ> zV&GfLxO}}os;N${3iG)-Zst_P;GMzw(|EAtn>x|yhBF*k+nwBKIi+?S48}s+Qhjed2jSn zv!m|E?$8t7ccCg`KI&Siwx=TS=iu@zw~|mUI3L>M7z%sI3=| zV68gm_d_=1VTH6eZn;~~MGcd>`{hqpIL-&UkMGYvJ3Y_Fe-tK$^cB5Osa)(4DB`N6;H?GMWTh4CuWeF2dp` z3+Ck&F2Mi(ACu!S_Fy3!@Nv8V0BEDUXvm@u3N}j5xb9EPn|8AS00000000000H<{T z0Qfur08Txm0n^3V06)9{0091Y+O)lQcvR)qxSeFO6B0<7wx^^_NJyDJlLV64GXw+$ z=|zgtl_niUnu;hzKt!b+z#|A~P((n$0seT5-kFsozWKmT>sL2hQ00{@SXMn`rmcpvCP=N>-=2@|84^N zJ1#0JF6s}ctwvOI)ZI#>aC*$$e=%a9HBnLC=%~B@{s#a4|4|CIF(w-R990G4W(<}G zpNop3&*9&5bum%H3jS~pD=6{a^P`bJ+(#qq!wOD#dIwH;c=`#?uf-=kSl?eU|5N6@ zQltMHev!Z5Qzv+e9JyMM+mHN+@Pol!o`d)KDbF!c9`YH;x#!4#2uF@8 zIYnEAZ-xA|B7ZHEw?dS+ z0_s~L>RSTsSt8oA1lqeow08ycXRYYZT2D_=KXOmeUgT~?F<#D(@wO{6c)2`-w_y>_ zFXY<7k-Z`xxu7VXJW~9lCs@qiA98*%w+GoO964F!BkPKJej?uy^B?(6(RJb1A)o6< zPA=y5AzO>N{mA*kk%J;1IU>sI0PX7_@;elt@^lsLMeZZ|gFI3=@>r3NJh7OUXXJ^Z zeDogxbk4 zJvo=BC+7|fC+FV3?bb!fEp$?DgW3*=TQ!h*N(|Vn@U0rN!j4?z|83hnB6P6ELlE~I zxo#+q+JgL0C_0y?N9VQ*{YCl6J%l3<5&6h3gsPGwj|$nzk;jH|h37(kvB)pZ9TF-N z<(1|32-VN!`szb_*pVL+`N(xcA<>^uZaCy8|15OA#)i-tYCrNWF+Y%ZiSobHs^)&G zasQAPYutb2w}c~475T^$G@c*GV>F&0$YZoz;kl4sEb@zUr)p)Qyt3T4G;SaAV&TZ2 zihSfRMR~`deaA%pF)cOsC(&Ny3!*>Be+fs93v)hl)o>~~a@BDC`#e?TBd3MAJY<(} zY z@|HT6=dTp~L0$(r_Z)e zxVZcSuHpIb2%iFuf4k=vH?VsYIr1IXtK`TxT>SkZ-*9~@{8Px^De{5c$3%I@@-6O@ zqP~;))rBJmMLu%a&E+B2b#r~lb=?bvFNFM8MgFT$-Y8MtD5!6^sBd__MY!IxI6vOQ z^Aq{Do98$31>wji-JFkn$j!?$@_sij&&d1T8-;I#{Cy&SACz}Yly?m3J1Ocr3GF#4 z+H(@xdrY+VSiauF`PWnT&WyKsa4Ou-|1_94Kf26p7z!ZVC#3c48CUjSY&{0HE7P3*{h%R_)0JWTjZ;O~V03A`?g9r>l|>?4*@M_@)fvx#sc>%s79Qm69_LIOlPWJl1VRqz<2zzbdQNrH_{z3R1;BRV+_L>?5 zv*H>A@A=NS0fC~}0ReWat0>m$qU{Szn-r__v0Gh}V#j#?`?2rD*#3ck$3_Q+K_JU1 z7T2)YF|L0@ApdX2zKU*CeR(*P-y3%;HM*iGDH%+nY+uQ~OqQBZR7BRPkPyQlCbLws zCB{S{%S2g9NcMFKW$f9rPI#EC!&qm3pWl1E|Ga;kx$f&Yp64w0c0Tw0ob%M7mpA=p z<>_6){*3(XzWBAnLq;|U+#D(be={_(wLDn7-ubWQl6(DFNOK!$`(M^sgt2_P8UMO2 z^E!#htx^)z(|)^XmJpA-y;GP7w*`7O-1=3|Aoxz@P(8V~4c<%FP<3~TMQc6;0QRLW z#%SBAGIz;v!i)FrMxIY~ET;Gqp0lcG;EZQps&RjM_B92>)&a!fI4lsI49b4|8zPl- zO4;{C$ulm5gxo#5EIzv&!9M(web_Yo@XIaf7h5ah%lqvgzvM4%EF{MRw(oIe5?KUl z5UB3Nc_vx%*xjqqphB++0JcGy-!ruqxVL^SupW!F`z?GxFxxnP>i*lX;?~s@XPHx} zdjYCfBn%m=cP#;HG>2GYL5)K1tF4`oUCm5A)r7i)Kc-H1SaW+drC|&}-M;|Tx=0vG zj79Zze@!L9<9bQN-sP=Vy^fLOt!uvn35ofphvOr5sf#6Wv#AKT!=Aslch|cl6ZxO0 z2>z|)=z1$%rW`nn5lT>&@J;^oABC)`(j}XxGqiv2cCG&S^9G=D?hlh-jJOFEtR}!X z&Z;wl|3rr;3Swp%r}V6+z@OWCh=fP>#Z0Yzcgvb+!syRUG)eUBNQw>MoI{{`y?{Yq z&0+yusf!G=8(asBmr9i|2DzlyD+tPRFCB*h>p2u^FQi8l_zVG!tet1sKf#05kfvc1 zz9os$7i5J+f=>|~T3;_H5XF=fh_ZaAsD+>sxv<8QCA?o{$8eva&2}JE`sNW##g1_z z#XgJ=V;oDs+5s?uO1tg!UeG|z5B>h2y>n}Jb5TJ{l;h#*zh$$-=P2DQi_pRil1S7whOjo}S>Z#Gjz;}N1 zHk9)RSE3^_+x;BSqjGlJi0peVV7sdPETN^ZBhwEPVff?L%1SP~fJa59JFIQ{P0mT( zYy8F2R1Cw-$-g6fuF2l^?w3IWuD=ckt8AwQCZg&CwK0U5TgX2;zPxivq}mV zhZ66qvvS(&0P5EH$y=j*JIwpwP%NBzd+mc2GC}YZdxpXMv#fl!AJ8N9X*=XmIX1R+**Fa^0UGfO@&qtSPwoxPb=NzUn!)%HK9DYvm}bL*Etf=uAG4 z>APn*_NH%t&GlDxTNVGbfz}+(fZI`{cLjzsEMB ziTT4K$+z8gQq$St>F?N>C$@zC&)0bZ-uQ=hdq@N+$_l^CcT-{%C^3`ibzmoYnEZ9(~hIZ$QUpKu2^`)27@@ro76fyh@r~c5TCJ1jmcFNTrv&T|KJz z%}p1L-IGF;hSg)56!~dl!H-`5*NG&3Ux#9FdwK{!k9akXN{;J+mDv1|V}@SBATDDN zJYjL`7`F8e;b;ODbXNrm?Pdwq06X!6ct>Q48Q+5hmue5UPTrOt(786C(@D4y#%saw zAH*685}id5cwG`5ipEVXKO=+srXdm*dYnaFjwFzDI|Y~JOHi|+xYX5-?dxPoL0Soc z>o-}oo1iA0-xF72&C0!fm}OabmGV!ykhvF?{uCM|4W`}WnsvJ&v|RTrJeJwZ ziNylU*{xaE6iayx zCtD&xlVrL~1s&~S=P96ZRB`bdV}R5|5(c%DOf0B7i(`k|NOfm_?Tol{jgD^OyN5Z# zXPMl~GHFzh7jgmsZ_xB4D4|r#QAMBv3hS*h0bg1OzEp0Cnh)Be5%WpB9QoMn2c!gx zI(!*JUAsL(g51`Fj@)|FfvB`AS`kpPIDWr3&v(6CG;7^T*uj&clSTp$xmve+H(Xx| zn~X`=)}=2P_U>T9v4R*Wc?JBXGe=Bgp(kQrLM3XXbd=Dl{sDka3~~lMHV|E~_efO1{+kD;BA6~>7_kwt zv>W8prjgnwWM9i2&Griv)A&896l2h?Ng8WUq^ic85+j(p*k&cTJgYvmmd>;TSA8WCZv8bMLBDwy|7j}{8Qb}hhn6k>3-ZGVnx?7`_#Wd@0axHd=tJe*>X77 z#>1e+ezxuE{+8ppp&sHbS8^Qy-&`+1IY#}B3~5trF?oelAx2iVF}GJHB8($;?B5q*FDr)oWaAE3Ccw<)cGR$vNvx@X<~v~PUa7kx?ufp9+12(`>A%h7C=aDAfOd< z&hi7bu)UeoX4yjna!q}&;Fq9%f$npxo#fy%u5~_w{$Mpe-fAakbK$gmJh*o9=h>Oo_9>x{J}@^>%*ku^M!xpzL1Px z?l+A${FEyDiZuCBMqaDW$|CCO%MH8FCTFfZQ93BLCKgCqu~d0+SYDs`;^_Xh(4B*` z+AYYb);H;5IPF-bYKOWczypEDwM_D>&b@s6<-gPUYL-8nLS zqUB~xvskojW3=wBQs{m47XO&jV$O2fX4t)@yYHV)7U;F)iz&;!HE}k65e6N-b65j< z-@m$!dA5bpWR&bJRuUP0zU0!i1KYQLnZ7!_ZJ#9y|Mco<*x7M})FBPoaff;Fm3%`P znfJj5MD3iSh0k4YvN^ZeY?eH|dgJFQnLHpWS~+cs^m2dG3B0|Sr(YSVXvHXgZWN|V0CF!AGN;I>j=s!jAw;x}66!~Y* z8l*)iM!h_+{bbB-F|sLkPwB0?stHq>{4Y;;4&0Y&IT|B66$HJc@;prRzMQ#Ui-DMk z?3_tGL_=}`Co)YFLz#9yPd&J%{%|Zf##_u*&Mo>eMMz^mC|(Zl;YqS*O|LyQPKZ7s ztZ|%eBs8rMBUwRzBPn~uyXRbwnPI+Bp`nPztyAFWPZY=Bh%z}e7^U2E=}>RfIU6&> zT*z%9-yWq1Ss@>@a?5q)h;H|%S@8MC~<`zaPFW|I49E_&58Ox8tgzoob;R9;eEI7i?7xcOOg z{THX3@-7akh&?y}dm$sgU;bduNppGgV==lhcc{c?G0&^T$IR;vt_im=#3aECF}f^1 zYUf;K+ScBddog=UyDE&t4DLHWJSKL^-Pz}q?9k83KKq}QL&i}%N?S+#0w0}PHj3F_ z>IdFyyIejZrg?wNH_073_^ajd?<>C^4+ynB9;$75+&}uuxL7NGxp zccl&GcORj;L~e?4KH9@7iE~e{#w`~*${s4^l>>kHPV(k1OS@E0PFMOreQc(4qfRK$ zQRiyiuE68d<^EqE?*WD3NQ{{n%}n~~AK}vfDKG1oWl$IzBmW#KJu-bNrbM>!#m=7l zsx2pD2F1uG*gb0+Es%mmSd6EbmF#gd?5;KAa)`ei4dhPe(S()X-=Ua?p{7GqI6Icgr064FqgFOGWig8eEQYqg!A6R^>w+94;Dt8!6Faqf`qu<2s9Z*j=5R)5xStwEV#t!EFv zg!F6m)h@^k)&4u_lNlmvVptH;H#n@nu;6_&Og zqYIX@K0c1U)e}!tAvN*ECvvWan@hep@USQZf1qT@lKw2fTQ$TwW=~P1ny9>kZ*j*n zY818a-MqAzl$f`ZZRY7F$h~L(`Cbn`dtk5mdGnV;cT)Dg zV5K;(_SSkRQ#CWkz>!_Ma%cYH#E(9y+J;=skTEN-MeUTv+_4+_4po)GjVt|qp~28M zZx@Y~aL8@{dEwfcT&v(R%ar-Nx5dA&tMTsWG;U~4{OcR6CFS~tm{|@l3MEf#z~d42 zV>i%WoThR3+)?tyx5WOB#Lh=zSiK=ha;^Hm=WaeH714dA*XnkkoIgm1Jc~JX>`*-cm-)DbY}_TmfV9 z56gU)DCdb%N=9oBs47^dC+7G-bHmCRwlcr@*4~B3J{o_ju#Dv0Uyvv=-1PJFTDY+M zWZ{V_f@0>I2hWNBO&)CDBs{F!(3o;&e++2+aTMQj!^m*-FNE+==@9hd!>K#&69K>f z$d3Q~bH;Gwk9_^;&efgrQolcUeV}-bKl0t>Oxu~}2OUT!*A9gu@~om?o+qX9$2Ug< zFUQ=pFAU#`BF&1)p|#P)A-Pc>U!CRZicj`G?LY5-q~{dw{B7&`a?g#L<*@e zo2;l-8kH3N?n)AQFVb`2YJ#-yN*HY;NM5kJ?3~NPN)n8oE7*)lHGx`(9ft!v;}s|qPy4?xdOnqQ@c%>B{-o?>NG{jyS+2R& z*3VrMWees-A>>_?xvvRluulc`L5*a_k3R?dLtoDSo7+{V7eGmQmU5dZxz`Zhu}3(w zVXtsxeyy7XYc|o@t&MPu@2j8=Q42o4f5i6tm~c(w%=gxx!5c43x0;#=PqJ6NzNgzU zYnlv>XN5M}Q`ZYEdsD1kdlf;T9fDz*G~S^un;EM}W2&f#Nf+v@9O3qkf*y0!)U7db z_;}V4ybx0$!6KMqdezj_M=R>SevVr#T+mlxM`Lg5G9e`57v*X2R;OO_ef%!T%p*Lb zATnL@2iy6~5OVcdldwJ0@o(9ARheI1F@5?KrSXP9L#CH2c*j-Z;opel1c zRp*NW%Fh=iU0yHr2pWPMSWsUjy|x0V^cOIsYK>(A_5%>L!;Sx9pm6(h|CZ>Eb*xEs zHaq_H(n1E=m3J#PTACGRktmHJ1^^}Cwy*Xz77g51m~4ePclK%cQw3S{MZO&618;$EcW243&>H|L5{jS0G4uL%)5u`Oc$_)0=Us7A4E)^VUj}Qn2Dk>Y_M#} zGQchL1FBC+i?oJXEbZx?DpK)eb z{uO&WsS+CXrl-(U)IycdIy)X)qrDAf<&PQ?61O1;{uKaLQqr}k!=zVW_(pD(dL0hG zcxI2^269L^&y;0JeR8h7a2o=OI=U*~IZe@U!RfPp>!;<6mBJ z;#{0{zk%qGK}WTKs?}aCu*#;OQr4JH4L`g}kpzZ+axdWHjp(rm=}*nem({>9RQIQ5-sQ@J#80+U zF`t?_>u(pPz9cN{MgxuK>9FnFHN3I!!=GKCOvszDhJqzBgSsYSBddVihZZRn_Q1J z?h5-KbRr8vCom8?fq~G;|4@u~;CuG;A_37zSP6*eq=TT0^JN@Z!V`7C2b3HE&xEX{Z@X79yhKd)Cv%7>xafGzFdN8K0n!t~KEBgP^gpXc=&X0B2{M?jA4Z69>G=VoLcf13Bf5_yJOZPi=MGQOWEJ&yIH`wu zr|ExLaojHvbU5<{82^k0Yt8WXpcGgS5Di_+MKQ$zKrV>JyipRxWP(U`=0j2Dc`&Y- z3&u5res0GZx`J^PD|slZ91Q(dgD`hB*uWcXU?bqw+Y~~@UIR;b4g%#g+Z&f4q7#u7zki_PNh5}fRjW6 zC3*WL8!TJ01ohE4ZW6d~p5VecH<83ebfF`5-)H5KF!gqtgbi41%m#tO)g2wJB zI2@IF+aGgZ9)Mx@EG5yJ$^x)F6h#|>)A9hEmP|-Bm<t5^dPhLk5{j8uLHi0Vvt5J-GgIoVlEIJ(dApS=`2t1*VbHbR zlW>@W$SPl|#_7B4_zffD?;I~+49{;QsmE-=1mH_jK-;lE=V>y}!qwHgvIQY~3_9%~36Mbv z#;bg%siT9Y$a~en4y=Q~9V(WcNISZ0k_Aq2{hbYARuDMF@lB*{5LNx3aFM|!hl7A6 zR299H02l=W_)Mr{W^>gIrEZ|kXroU=fF)&y%Hv9=;s-}A#>!6zbNzP zN2~kn+%IDm^>|qas|N^cn>j2{@8O0_oM@|Wl&wpGfFiQ~8iO+d|H6uOQB4B_%FAaS z1928$L|Hp_SQ1FG;NlKF<%e3#vEs(hrqSW(I1exrK=n0?W9FaKIV%@>Wcjj;EVyni zy3Bo`0l5u|jxA_FY(WF^88jgKKm#(>#^uS2is8koO+n5(*KXzpE}9#t5V*OZ_KO7h z$^;xV`2|d%#v}=j&dMS318~&dbD)?|%)?0pNl+zNfWv+t;5E)x2_M(N8t%?GSw)oA z(^xTt+U!#NHE|R#!t5Hy~&XS!(CuM&Vv0A0yVEtju9jWbnBwz zyJ@>-{f^E0MY12qvLBm-KaSm6I{yyFB&C2x$>GxJaoVxJ3=sm9=@rX$yfGUU4wgdjMe!t|H;steoKN0vPZu7iKwta!|s)skK*<%TiEW3(s;xPlrwpqDbMo zx@KL22-3LzuFZ*Hf~qtt1`M2noXI^k@PlWxrxCFuLlrmy1juaBQSg9#w*5=Cy=l1p z%dIajwu+A~yYA<)oHppb+hL&ihV^D0?yU-{z3lKIR23%r(!PzPcqN|%>p7lK53(~# zY*r2xrT>o)`Pe4r-UkbJ>K9;7o!N>=2O%Na66#`ZYPAn z?Syb|)|;D}FCDI|(HT!^EFvx3Karusq4VA;Gv<1f8X5dN!KM5=Dait^XC-% zyfg&&Sr=ZI6iE-Lug^GFzxRjC;mK!r2@?e2=R8Hm=>txaAAB$?msU3%TtahpGR>4f z;FYSuR-Kf+Ka9cSnfHM+Ot;RRCFI=6VyFqA-0fLp%5T{MtG}W3<6y9$npUL7J=G%` zjHdwtLx+y6#4rKpyrSaa1JqFJwW#?W9ae%A_msh0S*v-aM2mUC>>A_0_o%7ugNR@Z zLYeh-kE@J;*_|yt?-=;ckn(NXes+ddP5D>2!IUCBiEFCo4@l4$8php-!xCjMS_h?y>vlke zThhU>7|va~wVnHDG^_fYwm}4TZrqO>W~>!O|&kgL5j+(~Kop zx4OP9kneA(IfmN~{qUufNWU12?3`pwhjzeU2YnBTZfB2R6gggWnBG!%hPT*7Z4s4x z0kNZJIEv{L2L|r01CWWTvQxFrNyE(Y?oYEdnO$y)>yUk?op*K23uc(>SN@T1hV3&n zl|jR^g4#EAS?3%&PRfBNsYt$lmNYTj)S-M`z2q4=+n4;GYHQc*#0zg7fi1tm^G!qmiQ}Mi&4QUM{J$gneer082LpqC= ziEflw4~owB>wYkW_+c|i&wLLW3Ty_F%S&ZE8IxXtK3SJuq4Cyr{_-2H#B!91M5ziZ zJ1$#0E}bOS$V!q{m~+UtD_Uz90Pea(RdmT9*7tyJBqIoPBcoj(paGhT7L~NTVv6?2 zPbcIH>;3gl?O66ZFzFcPMP(?q6MKy077PNb8iQ{l^#|z3H*2QWBXb%}l_>tjOSF5v zaG<$Z=_XQQAVr0llxWP;7JXDO2P!M66PGz^=i?>yAp$+@>zGdJcd5SOR z9lJS3rMHZ&i3fTpiy1_fe9qk`I1Qc#eV$W~&*d70js>YW57EWlpkePhM`y^;O@d5bNM>)S(2w9QSim0whHU!+7|#5e{o~kD?*;_{BEww{P3mEw%yukbi=l zQll|f8yL9+L5Tj<$Yj(eVI9x2(fT@{FvC{V;oSEn`R+=SUzGo0&HlFCPK!`!3 z87z!U`B-H6pmqCP@vKbvmhU~l&hobT&+sj|(=YpR;b z)luzi=-J+%(qh37Q+YY#E)eMHykeKM+QJL+GiaZ6{{6w`z60KUc(7h0yxQTT%KYIY z?jT$N+Utk~O~5$hbw^&e0%GWsa+`W;Rdu5dR1U#!=bmCk&)wOkbZYB|n#%ZXk+wC4 zgW&i5dl>Zn#eOUFIWJda@M4!h9?|H@e#$NPZU|5DR@Y;m?C$|)^U_y_ueSxSByhjP zwyK4{^T9Z!o=k%I=BaVh^YikJ&gG@Fkx(ZE*YTs(on>P?T6#<;7zN70&8TO2|8fSX zA6}iiSoym(b=lATi$#LV@Sm7*za^mJgfMBl!f?^YciwuvDj_$m!*hxu?ufF0QHrnB z;BVOUGsV1WX6v*0SMc(=Dyu=3IQ?Ps;9GXLtE#gcNzzYiU{LR zgt+>vl)hmXfe;4Dlcnk6f|&2v#O%|^wK}EEI;_nCkpvU%7c?=t`;lwc2WeBGItwYR z+C`SpZ?jEztoR16?O5|(e%uo>xpk+Hi(Hs#BhiMDxm=wMMJ#N?ppC?t*LfZK3^U{; zI6|qjfq&O=7O1e~dHZNSyhCUplO4%j(dC_|L2&!^&@ZPBV2Y=nt3Ue7_p>~Aj;*8+ zx8;k0r1a7w~ggtZSN?09@P7$Ig13Mk|iMm%N1AZ@W*gTe#ZE7tOMG6 zirzK|cEiH@40uGjWxyTg&Cvw;P^-ynjo-sMwqKHHuDUJNUBkUQ8WgLeJ0>u7sN2j5 z^2nbQX;wnE7E3B(Zp@E*7UAZ1^$hav&IIS>)PF^-)QCgK*Hv1{;muJNz`J`nI<5Z^ z37kKxpSC}Pmzgs)jEFb=`)I3b{rR_W)G~0PK5SOp!{E$SN{Bm7^EGfeo>k)`o(f)F zFF;Vo3YOfVdlhYR7&mLn%4mfdFMh5cu$3IQ9k*sVHuN`b~ z&E!P3u^y9g4w(qG7-0y`&N|@L^;cgfKOFV%yjm)BC3lBP3ePn(pES(1eSc=w8x4F( zw%E;we8W8JXd{zgP|HaZeh9Pedvu#l8!2BgzmK_rMdQCB&{9yz-8xqOW^T$g$p17k zhxE{a%tyxl7H-Fv-qoKALyZl&`T+}h#!Cx1+K)r*)0-%&Vca2RqVlh4Ie5`YSLcEB z^6Ln&o7JOlvC*?y!+{-R-1=J2H083!x$Occ)0OVQtCRRT}wqob(wgsWsO9o8FvRF|mu52t#SAE5N<8W^29i zB$8voTTU=5}3a=^b2 z2?2q$TLIC0NpyN(kZgao>UU1g@Ltz=O{#&E*M1o-Ymrrr)d+rB-j#Ac?pVRT;5_qp zGM<(YuICri#?i!M+?K>En-Hz?L&m-jJ2;kRoWK21L%`3dgFkLH7Xsve1X2Itb(CdB zpTj=XB3uEXeQHNX3A;KX6g34njMRAuP~#3^fK!Lqe@&YG!2EsBW_94; zFW$3-U+Qfnt(j<`C|+|f@0B|^%_mvxcIRKMd&noCfV<1z|vM|G9r|75U-E?dHuOuMog&bdCp6TYsx)3EV9<@!m6NEe3x zsO(1%WAB9>Elo;(O$F;q2^j;Y(51t^VD_?{=R|SjR17Vle!?({TaJ0psAOqCDNwow z*%3!=r9a(`+^dx-T~p{3iLHL}lT*uv6%nX$14Z0)+Xb)5h=o0Ti2UD<1qpS5P{#pO zWv;N^w+G%PlcPtsw#on!j99UX`qx=HzJ|T8XEo*wEFU)(Ht-wyTjMuHJ7lWu>_y^y zaW{f|*$ZY_IT<91Rv81BiIYIk)xVdAf|-z^^I2v?h2;&GK|Mkuxc{o`%Jk#Bl6EX> zFq<6J{yEX3{aPCHrAU}1?QFHJSoxnG^RcrrdGFY(m9a_#ZX@LGAU>gIYFXF?vV_f5c{*hBsvv>Tb2RKG+kqSYdEQFoaBk08L}P|=f}x!I4U@-L5NHq854%|~smT4j z3m3rEe{g1XbNH1ni|iqtzt~GPxKNoy?!NPeU@+s#H}bfvwXTIm&Xuts7s6k|Lc1Pa zHa66JEx7Uk?0?QR7%QrivVPc;Z#i5=Quo3mvi|MptB;i?OFIVDTkvDtUEJWUcR_R{ zApr=IhO8S0O1y?K0zBr{)-eY$Ri}p^UOVO3rEjv*F`6~@pKpj7IgT$iUIe!o6O^$t ze>`kHiS|gpCx^+t=kv963S<0MXvIJ5HCL}0_G3Ou-$bUYNZjRq010)m;Kzrk6KKFU zN~FBO=7J0akkWY#OOZ-Rs?uyccETg$Qi9dtWih|c zR}vm+y3%R){>$9Z(O#BEtoS>b@iXR)1i}4wXh0$FCUEMy4V#!Ynh5Hu!L{|Zk7H!7 zIoke9YMSfejIlIzwon?&Xq777$(`i0=4KlQ=kyHU?y4U%d`2@s$xO%D*CoQn27dvO zKG%`%6`&>!tvJaFS_okTZ%X(vNGSz%RGrVh4Xp#)R8q;Oeo&rOKh$I18oS}M>WNjI zeNpudxy7N0Kd*y>xGzUW#jX`sx&R!DXQ9qJI*e{7ZA?y)GDtmL9@68c`wqos{Th-3 zvnGpN+sI|wTb*B-yvtOpFN1A5PDzHXUxvNIiP)|uFMEU^)lFb3D*&oz<#yZHSYD0r zh?^`T>+YhNF>Pq5VbneajE{Ah;fEdsBE~`h>SK-q9{QH|wXhVY2@Zk-VbYg^Ts4pXjhL@Dx`0#t z4#%af$W{qhRoqbw`j_T@j1-6ybzFFtSkLjHEYt7R5+S)}d-7OJj0AoMK@S{q=(hN6~;$f;6)%0jU4?CB0m5snRR+ zta|5Y(%6~BI2SyjRf{3Jc@}E(xvHVz-YGM8tsyVNcOhqr2ns`V!^oj2pt__9cie~w z;e2Zc4`QeH?g%Z3C^MjeWbkA1=Eia+|JZiT#p4G!)9oCuaj*V6$Cf&j8MHvMjeA3Y z$_>`eE~3;w%x&Gb1z7B}R_Ot_?(t7p?DJL?ka`PJ5v_**tNV<_zG%JnzdDeLY<2lx zT_F}5)%xgvbs!bpiv3^R7c4fW_0|9CKq|I1BN(nO9cOQB{L|fj0V>^LZ`}CP-3_Ef z9E^>Bxjz6YD+lAoU+(@O6$jR}xk!u+E7ba^fbeU#-~{c526TbE)=YRMI+c24vuD-n zJ#*)1g5FKRA&lSzxk*ELft<~O|Ej{?uRqk3@N|oBQ5txa!4m>o}TAXol7&<;m zKJhJKZZd#-B>~%%{d^P0n{>0JPew7#QC>D^Odo1U{1=7=_Dm8;qjmxhOocDevP~ebq$ck z>FY6TgBt}khB((Bz=jd%DD~MSgtFes?n&?THd1>2X}OX&kK5AHehoV(zPZ>)5j>w*97PeHN@FrJ zODM@>oZ7QvNLhr;eR4OWq=Lfu?1gNd;eA)*_@f(m<%?0vLKMcaofoR$n`xupCOZ5S zz=1rvzVjresIabTSqcrzRmK7pkAf!BDvtrwmwuY8{fqau@rw#*AjJN(AFZRvzQ?05 zS{f5mp@tFmb+$3`h4Q<6@1|_-M>mALqen%O1!l(g9Ig08o>kz+QbO>{XjMf-@L=bm z)$6J%g>-PpU8)s3Vf}r7((g?zN>X2X9$@Vc$qA+CgHO$@eO~V}0c3t*R(Jw(3zyYt z{U6o`ZB@B-ufMAeniV@Nvi(!XRx9v-XXcEtB`+|^s2U7t=~dRlv3?`?kJUM<_-a&9Nt_AI6iT9%kM*U~e z9x3x;g2P4gIf5vSC^B)ku|E)Q-KbT&wZ}-P9<9`HP_(}`N1fQRM(vLyYvJ!BZ-q zaj%XdSO$G_OxCN07AX{+?%@CDT6d7PF_~EUv$oiYKwtA(JV*~6a>epd3v;4r?|w5Q zGu$D}uy<|K6n|h*lM0u@;QsiJFF1R;bW@TJ)_>Pc!hT!B&~D6#1LQH3Zq-;1lheK| zoawMkV{XwV#|Ek0!-@vYEbwLvu1D_jQ{OT_aZ1V9R_x;QqKt7=_-|L5z4=(r81(hvE z?Yk>@d)c@rYud?MkUmF?9@<=Sv~QGwAMbV$isM;87qvp23+1;&zpj8vdw%T+1)M&Eb!A^<*W_dYSMu zFGy6Jj&gVu=L#R)d9toOrakO4c9VIZBjymo(Uq|&>v_uCG-ck~idj4uuE{*U)m{7* zC(H7wn?7Gv2%!F~yL?zusHaphg87dGq&d19M}ht%T;jTDeiwQ!Uo~ewuY9n(;36Lv zt+a!`Ug?~S+(kqEd7O$(-gMlyQzkmRb%q9&R2pBCsVokt`r56?@W(Y9b?U$4=FLi0 z{j80XuE~4T<3K4N3T0FGPAGbE1ZF(gyyEYPjvA=OF7O%CV zd~r11(>wg;A@%qC<{W;!ADlZC`BN z`xP7Jm%@^9b$(@F{e|LwmvzF!xw$pyEB2zqVvk10S)Fd!=N@!h=DtOxBAc%()B2sm zR_k|hYDZ>9AV$kY#3wua%(xYX3YJgy>)K5H^5C6}SA68mIT_K1p36(0P<~hXeVt%g zdjjjD9(`kS_T|WK*XL@oq^!bwz;harvLj9%5h2XA(c9bJA|;e?l?Odftg=q@goaf* zhjD_((XH{g_uD$oIfkibiv|O@{-&8DxBuR`S<%?tBkYVeDpL)__IwSAQXJJ!;C}Xu zp?g_{-b5<)7+cwjQV3epj-G)@?#@+?JM8ar|CF~_S?cBWbFA?T?akY^kkz|s<=ipK z$$?{EC5ds`_ z37I8H6Mef`<0;2_(2<|TJB~*R%{A`v%Ud?s*w1NU&>`VpAsZa|w|-fW>7DRg&(i$y zrfrX&vTNJdDqbC%F)%YUQ?*GHjl!&_MiK?SPI+M`V_Cy(eKgHGopA1w_mpV)!eigTM4wZmWvN(+@&=+O2r>n9+{DA9X6wCbXSFdQ9XCWPNh^L8 zEnTs3x3Q~$)b=wX`zgD$2t#;e2LMx^89B*Db_r7G%47}ht6e(#~?vS5ny!?>5f z7wsFf4)w^4WTcoiW-~d~#h*_ZRSkw1$_Qt8r`aSdRb7L%R#tuGn#)8r9=j8KzkXTW z#LmKb_`Y??j*rVC1GoF{e`GH>qwB$| z%BH!#h4g}UMz}>Zi~Ojja}1U$pcHcPDZkz(R#pDAAa6T=nOt~#9=M}Dx4P~8Gu@+< zM6=7BB;StbRyzR=pXU-CN>9}P5qbib9N>L;($vflrYt$;GB@5VsP>%QbeO~!L>v84 zbP{A27y7uj6H9|v^X{-?IYC0IG1SWi@$N445J7`DXi z?nv!5Ud;Zh#CAq)>awF!HVZ*F*>8#6bdoumo2SZdfLg&^E)-TbH zuZsZ4v{sg}wx}HP;mS(7=bRTLFD;#&r2zuP;V;>xDk>2Kiu&MohF&xyf7dVLKIT1{ z*+pNOOZ?|GNurDIIZ4?ofxm^EXz%?p!4LLuU0jv61M8-=jyW6F$iX0Sr1^%V)MD}s z!X`~JDO5)=Hr&mHV64{fAg_Z*ZDiFPLqea`X3U|PqjU4d+(R@9^JR%lavP(S^*co< z1kGnOK4tBLbM8*gXr{3op`EJ#p~Pn#5jfFzJxT8V65!6H49`4$VXf>4=Q;)%&h0gZmTUez71>1l7uMym-t)ZYH}gUJ8pUgR(TtpapL<78QPu}*d>vRn(pkvx*Vz-gj(z?jA`xbtS*nlSA& ztOxFqlnS>_8bh{jh{5*?k6U&UNqLTZ{C&f+GVfGM^S zD|y9uvUhd0Agr1a<$V#v^5-FNIQhSRL4Kf|9#j3-G5ksoL~wYfDgz}g7Nc=Ed#&B0 z--Ynb`_n(#6GE)FBF4`)5`NdIYgqJp92dO$8?LE02vr!3#t!Zz7f|X11*NL2?OzFe z@+%xw{bV!;b+R>y=6Tb&yUr<(PVLV&&YTC+U4nj90O7Cdc!jU>d4~MQqk_t{JTjSO z4cX9{yConwpVDF`mR^?a_!B`Z*(Z&{+P~Uvl=*{FlALLneO3|G(?-)+I&|$~#u$LTs+9nW|$^$BeGhftNtMm<39>?^q7x$x0sTf$o=F2 z=-)-+FCM@7m+dsCdXDnIuE2;O^d`cMS9=DeQ-fcrb%or2YVeq}| zek813<86ER&pTTGjip}UXZ4Ejw49Jbx~m*i(U>FkXnub7DaXjB`P)eIpUnD((vbJ0 zQW;EwhVfsmcT}tR!M&TW+|a~Gip?gI4-XF8Zp4HoT%bqcy4G(lr?)?1T6E3a&1@cH| zbzNlUkk_96mdyxE)cGH|LdtOBz5j%0n*VmB2+fRV4u{}@1W4MCw?dR^H&?|!wBOIU z-exm*MFVkl4L_tFd3=rK_>BoAK^mz2kml!VfxO*%55r=m^;%bxtN9bECr}Ti053-* z1fNR)-THjI3?=CjMJ3F>hhbR#5qX+xA=u5@%}f8G%C@+VAxn&Zq;LH#wa=+dPpDc+ zrEIxr5Y8tI8*gUmtgorc6tV}cfQmsSr289kF80Q4T!md^{jLOFUkk4w?9rWjb9A|( zbQA`z5rm;K-VqbGuX2V))Z)nmpX5qvtoz3eT<-OtN-(E4#M*g&DP;=+FY_yz9rfz@ zuvT~d@nEETxgEu*y<$QQPwsb{*o>=2QsQvgg}Jz>>MVoqNcWat{9WijAMl!usw&FL z!aXv=xXpg$ohK(5o9&k*QljyD+e@=H^w0e;?BG_NNb6S?zwbkFSLHev`)0Xv@r7z^ ziO!z{&}H?TS$i;cQZnIQ-%fVdU+odJ5~a3?8bAEs4t_XgJl-#&4OZ#zPp&2(Y#mx0 z(NC-@-wX;ZHKNb0(XXsrbiO+Ne@MCts3zaHts;VhBPdeRtspJZOd8||Q;{x_7U|B3 z#8estBqvfzODi#D0;4t>=^7vn8w}Rp{^vVqXYbx~c6Q$9*>m6bb?4<|x7sgn9T5}J z9Nx1Lv}dO5sQVf3?66tlwn_AJ`i>0V;F2#svbO4kwOD2xHSz}vd@o_26>toOITsIY zq|ea%c3p$dT46Lc>Z-%F^iNim0Jc4~oJ$~URJKTaD@`Xe&G7m1W^bJ=4IXL)kcB;^ z!!|yt@qx9$hBjq?&alr>g)cR@1|}S4`aVM4iuWGct*oASeG-taUC9b-;txJ&C-;5d z@3y39rP&dGo)oY;G&I+RTHQQXTuEqKSK_pV*2(@T^O;0s`y6#l`e?v1j&cKzqFJ|& zgrsBz7HS=qRIY)}!+J5ZmiM7cKHwk6cW!Gg+!#i=eveLRQe6rMK#(YBynsY5%B$_= zxyJYC_10Fimt;@p&i%+owE{c1vU*o_S?V~hwO;Bae!yG#B-D{Qf*Y;pC5EjNW**Hx zi1NS$;M`@p`gIRl^Ew>AE2H%4mtW$5H@S;VaI6M`SwlX1EH0T9E zOim!xioHmrlfF|M_Q*Sz<=4qDEQwwdvo#6}>EW@97}-)vMZptk;FPnO&cV z8b4XJTWCLQeTY)s)^zFynoWNr#0HOsj24up}HCeaoDq=bE?o(hEBik+~M`RBBELBbkAEwMVpQDZ{) zJQNvg292nJ6*fD1(D=(SX=N6hQf6fKd*82#b0{glf-FSYTU z2@3GD>mS9W%ojn|Z!=4?Fp2^>!fzMd?nuJWyU=mQ$6qmwM<2cRX!Lmjz~sic{r(vz z`xXuI{jV{2l`M$o>EyL%6^uA;jq}i1pu5)7VE!Va(P>qkS>UG1ZPJ5d9?Uk~(KYXD z27-RPpKiV8w0=X1e^l`Ta%qmahSQVBHNeQR)2=b}Gd<>Eob7Q>AY!hQgWjm*rO6AI zW9t_}7{!bphd3XE)z!4CHYJTcg3?FyTDn?7at~C1W12=7a7=tQUD;bS%OO^9Sg{^T z2hed)!DB7sJao^l2%%d)$2u~G8^zM?O5DDn+u(dlxG7}nDInM=5n`sm1D)dA z`!|N{{$hnFu4sBXczoZLn2hGIR!G?TIkT6u&y91%&(b#l=+)Dk39Q3x^T;=C)|~UA zC5Dge+#+-e^)qIgGTbFmquR94do1^b%135q#-|aXfcJ5gMLl})PtqQ-qm}owN}EGj z@!aaHYA-y5R$c;`>)XD?o<4#<5gp@zn_P{ANYW>Xz+Q4PFEyJZpl=D8R~m$={XJZZ zKIUZJR%{Y-A(q)ABxXh&KSjok3ns_!c@eGNfewf*-Kybm$2+3bcMUoO$#v`y{WGDN zt$$H~M9Dw`|8>ur`=Gxo+O~&t>6Ca$^pzQ|`yc2-w*5_~Ib+V4*&>X!`8Guh`cVd31W;Z_2G9j}G#K z9gq32c#{JrR~Odh5dP)&8#l`nTUGaArP5n(9=_jR!o8tw^Da@>k>ye0AF_Ps<9D0y z(Q)38o}>pG;cgPT9v!E3tpW)g^H!Olc92fQ;q^??aoZDclvoTHxBrBxKDOX*nNEZM znfdQn^^a@29$DRdL&>Lhc?+C6h5PEKWF0cD#hBkGqg(XB422`Y>+4FjJ$b4*D$#ac zH?#St?~RbOhcAVw_ixPe#F4C8p)8rCAcd(p@fd4dz3Qb^BK?y6W5b_+Ln5Kt9JNFFS2L4X8oeH>d1qzSp-v?N z=a|7Uvt7I;0s%!@n&%14L$(JPWEr0Pv3XxrD=G+QtPXZ;+=Q@c?rHsf30^#Q^(mvcfX zcaSCVR;`2}2@=8ZFN8s7yS4jfFu>rIzV01l1SCOvT^7##%c-->Mn%e4H6#P1eQW zd4#lfYWP|!6YH%-yrSd7*ptH6FI=}-njb>2=AOxJs$?1sokgz1euI#-vXE(qz@@W+ zdC|1J3M_l5p7b3TWgT6hT>;T*1mB}qeP|H z_>t2fr(vE$*G;|Hv0YXzmot4zr;-AxU5Ookzs5Q|U;nImyqag(yZe2Y`qa@QDd5hY zjeB^3{uz8X5-_EDD4=WiBESfE`tT3XWCL>M;@Q)h*smNui#j%wOn>Y=v*oXm*cOhe zMz-e7!taArN_6cO0Y0||qH2sjZC)QRG}==zQcUy9$SboaSXvMC2GthZN5t~+J7>o3 zLS|C@LG`ioHb)SipfhvSE6(~?N`P$2i`GW(ob@4Z_i(i;VAI(AEk|!Yo#iXL?TS`F za$S0_fQ@+uXFQ?qlH1#Z@oF~T-f5Paz1dRa(-nsKE6MTXip?Y`+iRGgmOcJ<$)|3A zJ1gPp0nts%0NVC$h@nFOwDSO}3vmAb{Vf(UEqAiHr|~`t=v@OZ9bJ#UwA(;`PO8sk z^>WkHaa{SyQSV+XMCRS|?6_(LboMs=>lgFhzNv?C`+L72%)5uP=XL1T&>q*vSvT}S z9dT`WMzKRnmhp^dd$+3g%;7?;KDNH_0G|He1aQssTpDFY9 zY$YDZiX+b5*+#$`R@hRlH~8~0Q7JvCp&;*=Lfq;;Hn%6=m-k3e{xtkmv!D<@FcOcj zaS)KdN3|P~cjkbg@e;bxL$n4|&_&T)F6|)XIWLu+4F0_B?sH?n#51|C)O0=k)#kfK zjZDgswh`6+4y@MAc}6^-3({6lI0@=;K4fmz*obYh5o;Q`Ke!V{FT!S;KPiCxz^ouJ zaZa~M&5igVm0q3c;;!38eLMFsaADsR=lCDUwa11PKkF{pv{a5cy6Uy#?f7RKpnQ}h zk?$&-G`)E>dxCm-Dnvqt>@!NY7Hdx#_+$ca{%;5vH7g%3vD40;()ciOL#(B>(47&_ zjh$m0W=oqLn`zT23DAJFAutJKrSg!=<=g|Z2qy3B4%iD^da%6uI$3&DJoBeJz!!Mb zXQbbJ74z~5McZ6QtCyEG-!;uZYk;KD)N4PqvtW_hqR1n7HC@ zFBYcBQLMJ@e7-T7EL2xJx)u)b2@w2vJ#Bl;@_&LdYR~=+HJ2AYNxC;N-SuXXX1-~Z?pivbMbSw@FpN$Jn@wa0JDH|RuY3Pv%y z$9WF51W-@EewPeH{!Lm_PK9R{ZAI(?Qz)5A{db#yFaJyDeZV0C=G+bY^fZ0Ga9mtr z_}_b)*=7D3wCMDP;2hu|3pi68F?s^_u+FS7xQwoq-iJJlBN~rcS{L|Jn2u~+p5PDT zT8g$xP#EDth!;trU7z;ISkWNOmK9Az2-YErI+`+uGrYGZw!M{#u(%ua>geUi9B!lp&2f0~gp7jtWzrT3 zdBV{Qcm;IQwK>?F7(fQjbIYz_3%DxE8n|wvr$1AM?>M3ZL_8k6AQ_Wu0#vi0HB<

wmn1`IuMDgPY6q3Z4Zutl}y=-L^acH%PiS;3Nd(9D~&|B{PZHw(rp1Axq!JL|iU z9DS|3Y(><)o_{voa)G(I>lxx2Q292!zshk~I>fMb*{x+D17@g4wFt!Z^n&tO1nT-c zy-5L%r~Bw8RZl)mXyX4}(eUP}gzdYi*y|!}b^V&qm|=1UZknU#?591k;9JaQbZuQ9 zwlS>L0cm$tgirS5v`TL``JGCp7YFw4(B+Nsh zd@&nwdb{6!ac%%Sf%cw8uTnMV$EmD%H)_H^5JeRM!#1SJoE$ykpDff@>Sn{(6Qag} zWLK8D`Sf=x?ILzjG1nsmas|0b(dXh;r!w`SAdD0AIC8VP9g%+uwRfKz$ExD#1c@&x3FiHNA`LsT zt1ZXbF?$gd({TVrY)SwROfNahjuEs1OWSHo5S>HLf={Kp1?R%XPzG)PAdMPn|LlaV zPB*8(Uig>IN)r(KGKWx{=Rk(QSZpvd0N+_v=MT8J2mS&sV8fYHhAxPz4Yb=cl21`v ztRyU!!dWbDk2gJ)D8}1UlnKp6boP{V!jVA(K{lh?otpXeYjzC4VTCt!&m_}o3ifVh z@*7!c#!ydv&vhjzV_8Nm(;GZ_sy1FhV0zlblJ}l}bAH9k(@FU>8a>(DA>bUNFqfXJ z7q(X+7u`yE7F=nzecrIgR%UVf<0%IGQ~b`@4pDU-wfTCj2US7&te8X8nzI4Z17oQ5 z;I57BQ|&n$%C*!}`E4&%7q$lz1FlV%Sd=CPy1pEQrg@g9tNwPH;YOSZ6q8JgX30}v zPr~{5qS_hDEE%i^3LwLulT-i6bt_^H3B+*@0vCGUZt2V9MewDetektXPGfm1ZxjXy z(^C32&<|%UA>Zw)PEL6KNm)a+ahG^>h<=bYrP6wv;*Im`UORsVSxzVO^bP;HLJM1S zs>eLmF6d&o_a+;`Z+i}TJcBOCI(Du;xAp{v)<3Mk2Zyf~RjJ^w&E&T0KtCM7!3skJ z`+Z<(y$M`d8}sOl7dQHX828h2?+8Sgq&!6mno-`yc(apIGdbgby1HDM>nxxrqX1dw zV{K~th5a}NpS7Y;dOYACQ=mV_uvYf(C6`;d3@H|`M|$x>DHcmgO;mN(^=2*l1sd0b zjjgj8zcibR+L%huFY6GiJwqH-2wV#iBCp$+Az)dj!(_W+P8B?GhEwyceC9qF5d8Pk z`wf;UkkdbNqmr>uYp5Z8zLV?yKOq#^ zFQP2X52}L>l4JG)%z7$nW94m4t8j2a(<0$jf!}ZI;ePufpe~X6hNxwr>(ocMUj%&Q z)cjlmpO;GL9PhR#u3S3+17>@+;q5~`Hv8Z;BKI{Hg*jC8!=e7yi?VVBa8j#OjBG!{ zQ*p%)du)ik;ET$}*i!0Je++fsZtU!mhk)8}gmx7rzID_1$#w_qvJcs=p6VPDz`T1E zRrR?(@ZS`$sp<6}VPa|xx z>5;xw9WvR`IsAc`Ae>B+F7>Z2Fcszfje0XCvH84_fk0Iv=$qwR#Ac)ItD~ID|m~7NOHDCCQgj~lBp&F&88ENtIlWR zf7T8S$|^31Z=WeGhGX4=S@OW*!{(x61=-XHrB8~-yqGGwino+U0L&bhC%>zLji~IT zQ21Z*i0@3e1i@@>;fTVD-_V15i1Rt!w<~`g;)D6YcU6YP@ejo9*zHqa-} ziKh1FR_Kz-ITPzuXG-Rkb^% zm>B|Vu@xWSyQ10h^4RdqP4s1N%e%gr(K@Q$M3=Sw`}J-5lpbj7!^A6#5f9a+Bwvi< zv8LG2e;vjcQD7m1&bet*n3S!JbLbX?!ZBjMHtqiOkW}{UQ?c=QgxSKeFILPKta+#8 z#a0E@8Jm3k1gnYmD>Q|-nl{bO|B8M{N}FTF54c0+)PsH>{eCTA_DN*0q~V9?2$I5CUc~b)c*pdXV>_GsadOQ+5-_{{EywKfNC8ZN2mCdv2&c}Z*CR*i zKmOj|cg)ZaLO{5Q@a&Y846xVYjfRJJwcrbY;{6lu6UGI$N^;v!X63bFzo`ecMyl~h zkR&(AV3$ksAf4yCQJ4%xx7$^36=%o9EiK&FK?b#PzVs(%N2FSbgq;Sq#3r`RKP|?A z+IHeahC`aHIxYP;=W1Xe;tt^t<3iByvrDy!68{*ys8&v#J6|Vbh2Tpe^FX2wkd?c} z?+aNg=EP-|NcX+&lBB#p&4f0mO_58KJP-l|7>_3QGP%3BitJZ;?kql>NE+ zs08T#dDjN@F5xE>$7w*QGGw^$qE=*mm+mm*tAFkd@#?1YCZ4yP8#y|8?>-;*?Ak4B4V(7{3{p}pr@xhs zM<=d@+F!69I6w|=u2M=Z0W%xlxaO*+U&gfZ$~Uc)h~RQVFCT$TiNEhP)M+Cd%Q7h` zwSa)YSH&t+OP^xFc7dnHcDs$5%vmf)tI<^!5@1`~DZG&g)y}0=qDbHNCc3j_=*EJG zHeQ%I<$0Z|RshDQ>(B8s4K@JZSz;%n?_CZNAsSQP9r#2a9rf4c-O-~l*HnXjc=O;-ongLo)s1;|`6dRE zdu_cXuzvxvTm3(9G;<&K(}18Qkx;X(QEVUEj`)epa2c;&rcR z^mXQuZbr0Mp(2!pj@a(9y+)2IS6^Lb?59Id<~z&FsTg5$q1V7`TRhB1je}bFmr-E< zx2BkX%;&9xJ>e$AoiUS#gUyOXEo?$fvkvm7zpB}Uqn1K+U^YG(M{R^(7iwAAvv;@) zTr<0NFL`sPphQ7^a==*k+F_wl;Rux^fqedb6sj;09yNLk!R_d5sY}V9Qz7-t-BgA9 z1z@f!jh?Kn7irMJlYZpx&lX1Yassj-FD@81B0nJ;0`)5c$v}8~%3VyT!4D&!GLFC` zlRMIxb_VB0GA?%mlVta@e~`2EGaG(TKCSK8gSD)IoDp`gc!T@QKe^G(?U`!AeAZjW$ZF3rz1-|}zpW(~}4gTujVlyA!B=NQGL-!YQLeUy^>fGf> zG|B?_(-`SEuD>aLUZO(*l+Y6OfRHa6jt$HP^-_i#HbeYPpz_x#R54jY zP zEmX2Z5rYUQ^5j4_ttWJ&_=F4i*)g!bxRP6) zqHoVhQ?rdoR5~*hy~P9e;vd+fLiQc#Ldh*u^FFFe3%&A+O9vEu^B@clOqRj2RFWls zMUh)zA@!P;t8NK=o@rrCM z40+gJ$w>k|8k0H^6P@Fwbv?XDHZi&fW#o6Vsf|3oz5>{n^~IZ20N$yqg5A{3wFAU3 znDy;%gmp%w)7-n~9^WPA1a8`u_po~VQ-)rZ&wQxJ5V)OOE|YA7;EsJJ9Ca@#SjNVF zKD}tIU_u#TXW}HzV6>q^)ZEBotGI031fG)lVJ=LRWv1S@coYlzAQsc~p~xA61z8$X zG{-+-LH+(=`TJ)nS$U#c2y>MvTk~5yn?i_mgag~G3h_DhWyKxL+sEJayu=>$G+l;O zX88GSfjl!XOlh3Vpr;6{^T%$cq$oFqF!+5K-{I`QBrd-Rtsk0JOriaoYmp#D2adwYHsQubLpY0q)h=t5poV~ht&XTk3 zLJ`vZ|sb|Q#Mr$xSxmzp_O&j~I_S6I}8nrs^qR6IVKZAUPp)=t-y zcSDLr2-sjPhKmAzT}n%-3Vmu(F#qL_7VYii25!T$163j)Gm8T4cV#6Et?tCDQg!0X zR)V(Gw^PK&AqLZT2Td$ftHlQy#7xy~M@LLBCU5LMwFi)PTqwNU1B1iz8Y}j?nBuJw zgmE^ykE_QGClqmKZ`5e)%h@gXW?fSexamoG^X4WgJ3<6r%b>D6(kP=<3I2Voy=Rvt z(Y^(Nwn!v+!6J43wir`OJIJ9Om8QgE=JqyYVEj(5X;a9A#O1C(NK=aLK2R6tPq1fR zX%0*9Bw6zZs(@XYv4kemD@(ddsI*AXO#v@;oHW>tadPQUUhae9 zJzh^Zd4v~s-^A+>ANd!V?znWM$3Xf)#Qd@3#fZyrnJVaRvsB`t?U`y!4WU%gQhma& zm5|6`TMisLR`C|!5wWe&@v~OXR3v@TC)mmFrDvp1HoUy3zn7`?iTj41;&4XK%~g8$ zQMuOht+i!$Wi+$0B18~8PP)&l$SLgc*W($n%bS-O`Vax*hcD0|i_;5qa*ERHCXdS< z?U@G4BVTzV#swonl3cFgp(l69B4KCpH?yjE*i`GXNynBkA+DDt{Q8cqi}zhlXBzYi zc0^JA{%#Ii=-C3lou7y7Eu&;7%a z3GpgaVgfUpexP`PhF>p$@W$RJ>3$ChtTw_H`Q&kLu=`~6eI7~Yk(agxjka;EN}g+ELscTuR_C4z1pqyi{bF{N0%W%HVtlLV zwhcFRzdOAu_{*URulb{fIDfxs&iRLiRf3FMw?}0)AG?=J6|F2v4em~W5O&6e+2ry> z*YlglSCMI}FTGv_LZ+^(!ad3j5J!)5vK{mHEfw|=YRW95#jo!>ZEuy%I`c10*hdCHv5^-Y==BH zJNsfnbcHMucMY0MSpHUx>he#DcjUC5I}ng7VTG^w?9~{)9;MAl2F6~I`sqY_f9O>Z zm4YSyIR+q6I$G54);Fn^Xy!butQZVHx%b^HwrR5O_zBnw3G&VUJ4>l9f-Y8nrz=|d zI2@~vD=*30>V9KN=D?YVohq7{78C9zE&Qv=gjJ#ZwWbXNL-P&PhEE-X>&x1MV>d~` za-??0c_G*x{o)SoKtE=ywS5I8MWlXIKx`m4KO8?;>=DgPPRkZ~dC@TrMcb#ejg!O& zRpogfK-05UXw&+Cl?Oo9km7?kSri-e+&>w53S2u@!>XepBl?*&MNm*ukWG1>t4*=6 zSlz5D%(ubtl})+w#LQ#;<#uK?GuVCeeMZT_*)f0ePhxk$#6=xQf z>>~Yh{~%;KA3SD1&#S~aj~Ug@l*uo;D*bRL0NQet;JW}@>q=Uy{iTJJJ)9rIUT%{5 z>BSzKVL0G%_MnaY2hSrYvl^81l?mg3x2ckXg8K9TU7 zmZ2UevSE08jwWIS<^XOg2gDR?GsXF5MT25s5|MBxD0Zf%oRgq{;9lNs&VXVxi+c__ z`{sUkKZ3N?$ zWW7g1om=O5@6-jXzW!yIO-uA|D4qcHz9No#%&^0vdo>L#yQj6xm zmG?jvE!6)wJ>R1( z?a%GQg;BE&Yp2`xC|+Y}-IW;xd8e zj4j;iFCY&3x(I-&f33j_T%%G$8y3Q{sK1o4PU3?4ff@Sypz)1H4tf3PJyyg;rt71)H>3sQKWaJPBVf^~~;6iPuP z`+kw%k4ZMu6jR7YOY%q_O-5e>A=?YobLE;;mr4- z{U_mNrlI0ol=scqfulWKk&^!Jnm0o3K9_qG8u*xg3*rd)PY>zedFfz*g}IBbU}SFk zWw`$5TXQ}DQC$z!&ezOTIKDWC$&sa>spQW|x%F>d?J~i+{Kzk>z~94{WtUOMmyyWD z**Jw#*(1CFBiT>0$zBIGXk&HgR<=t)XG`u2fc>Cx+~ z8kg`ApKSYr;_K&aH4{CTR+aa~7sFTR`>DSX+?M-;i_y;VBLZz1MZBxsMSSt>Gt(%|23K|QGDEv1~ zo*nmPk#5kh2H;jzoBxAXS^Qk^w>I&ogp{puMT7LaJF4gJe3gyTV!q33s{OXsj&yuO zr^Sg-ozCrO%AqgkB6p}YzmP4%6ANH@P8ALMF zxpb3`vUszo8`kX9TCUBCry!5lKXZ7G&W>r5e;1M?ACPzaIE@= zj}oS=&)?^O4~=@IYj0Pm6Pt5sd;H%bB`lHq+VueRSVpq3-%ni;>eE&S$++H?zF{#4&HYX8#L&~?@Hmm$8ef~G+ z^e8DskC#_TDss^&*o{Wx-H)WlcmCkD1wQgh$9(9jYLT1!Z+--?y;2mNxsdK(F>Guc zN%MVSs-0)B_nA|^$QzpQVLdamN3XLZo%U%lg7!c12=DjJ=3;%VMbP=ydv=QujrI%g z-Rh$ofk|LAX`=p|{XZ1#sz4JalZENo`%7c909819G&}Y`ibQBlH{&e7Q&rktVry9BhEDdVK$ha`9pk=JKFg$xsi&vp}qGnX2UeA zS;*$-aY2%A8gv!6>=GfuhjVZ$WXF5I=@Q7Pp5K>(iLNdq5 zVeS#4kes~G8*3U=dx70XmGF8x>@adMI(tnns*D(xcK}C~zDLcMs^p~z( zh5)DPcxh=Hzzd!)+EONq^)nRn>rb8oj!!=fNU`H44nsHw$EY~pN0yi!yWaV@|qd{LDdt{!8~ z-w96ki;<+lG_2ALZ0D?X>qJ}d|JBy#mXjUotnb4r2aFDdJoZ0EW@4kF#^>rOZ=%2d zoX;=MD)DCXvRdbRPx=JN>oJO!8IO)%v$%E8zMp9;9-Hae(|gSK9%lzY=-<*;1%@)` zWgZO-qUL^t^W>9qe_%_OQkX?< zhP#PLU}ke_d^tB6@$B>(|IH zduZ}X3(ee)CS8Knl%%Dahh?l>{e`udhf>XodDTmAd?DZZrEHN!L{&|vvyXd5dkQUq zPIHmY5$U zW;jfll1bvhb69lvv~zJH|rH&d#>#@RrtZ@8-oppiigk7uH`Dj zYb-E9-A-hgP-8KeAoZos^AwVJ`Umz2qr<9{8RmX@H7DnlK>AeDs}9@xPu1kL41oh+ zk%Vd|*X)!u@_NWkeCg#bUGi-_Amp>6!@)n-bDoW<_M-IZHY8(fv7(+Bd8_nI=U0KT zu511xAz8Y6pY_wqvdDm>7|Du_p1@JO=^$TOAd+vPj7vU?!DOIP@*^mTLCQ2U?D@~W zT`9Pi27|q$5OvGhEo7uDgQNlv+jKJKf84{fAm-t$Dc|*<%!lYE`+mN=vj#~2s2_lX z!XffvlLCI*t>f!|m___%>Y>kj^e~r}n1eVK`7G_?rSbd8AJw;@qJ5b#35yTyId_CS zI@#v8|3XobPYG<$vu4{?_<-dxQP#^vX`u$dzKvCE#oy7 zijrdnW*7?`yzQEulg);4C(RCmGkYLKvJW52+%5~+)A?Q!XpA1+%yW?)6on4>8&n?s z{b=|na2QH6bpzF7?Pi`iJehmR@3S|JRb2Bx**xhtgMdw|S9$$Oz4R^fWSX1Icp;e5_>VR9+zUjXMvS%G};m zkc_@`N%`pxFRU|C^x@+ry#uymUf-g*&uQs=mPFd#gtY=%4eKoTSF|pZqd3fB#kK|_ z4#H2&UcND+yx{hgJ=Avu*%yBmoX}!}%V%ySe)ubrY5qE`Xl*5C+87D968_$2NM?g4 z$I$Yg`A3!{T>(6kdq?^aD`xpkAtAOZ;?2=Fy}wp>wTUu`x9~A&>c!9Y*mVg%8pHwb zRp3-n>SFTCowrrt4G0@H#h|*$MkxKXznNw6$+C zXNKhsXOt0i+Z^?AN|2?_kn8Z@++&KE=D;)AaEc)K!y5+{yxnt6TeT_)Gs>;YPNR{R z@gN((L}8O!2E}t`VMoN~ER$MdAyhoPA?We<*a!_8$I4lZ2Hjji9rKjLBcj54j8jiD z?AhVX8Z9gxGn2}#E0YDM>6e_2r*tS|=4xWs^)nQC*#J*s6V(TkdS$IC%wZg~q0qv$ zkImS%Xc2jUvq~LXqVFIyu`*cZ#>I_UE$b*}pLc#Bw;#B(f^(Ff-BEyA)iqK{9-1f- z$tl4RVGK)OlU|NPr!Npg-^S39&W}GfTsdpdl6cxHkqP$tB}?S*H?Ch3js`OrBkvu* z@&`zOhmRTJxG=GCt{F@5duhLde&3AyfPm1Ku%rP#Zjy|17;%grStzu^l>HbG*{MW! zz#jVo4Xf7;AN{>&*ySD+m9La)_p}XY9OWF(zo1TR=thJYGd!0m8IjF1%1R$|-tmYj zYfSZs)}5?~7Ey&(8bsE~W|)zOb9mGLEPmsiF#lFGF-dg<8AYr`il3pW!)I5+Hc970 zOsEL8Goxs=vnS=J%spQ}lQVmQ}j;zkC{l5Kd*VK1pf71qf=de`MAgL-+%b@4)q*QBu6u-#|vrLRY)U^si z#6L1~`^FY4Ktugmj%HP+;>g6Cpg{Ssm&Ha}Z&}_AY~=l+;Vh((bZNKxPII`cE z05+tgPg@a!qJ+sVeC%0ugeMWw5A`Et47@Y8Uk@PpD6t=v1iOFZfuJYlQw$-DWH9F6dq+rkQ<=aJG zr+TPJES?*^z6z5*0oz1Mc){7T)FkEpIg1%OB6LR3FXc0XLu=XWG-^y zlSnn8iLzybtKM#|Ys6^m46Ubxo1I0r_3^Kx<~4SI@=*fWm7P(b4Fh5M9df)PwFd(X zn+>?_B_1o)yuSFE6Ss1g0`A4YV<^YI!_0o)0c%vSwQQ1~?PhQL8l}+kDi!Eu><_!W z?B%s)YI%w35w5w|&T;6(a?(TvdQJnN342`@A|oaFWLnW}dqx_-pW2=w^OL%He7yr{ zJKcMKbS}cht#Lw<+mYU_>DCY==V>U{@V53a8)f{KAhkqJ3PLSzq;`6^S8b$lydzhB z`yN!l5R3iOL|tiE3Jv|$`m}SecAWo9{Yaqn9lOfDm%~cRZO@ViEPwlja=~kq7%0j8 zmY$hhoyx=rsa9CAm~H)EVQHy0J?sW`K?oV!kp?HjUL~G@aY*)z5;uP;z{m+lRbTB9 zSXHa0ce#JiA+bJ~{i7r#Ir@(WxnMcBRREt|qU{CqxUyp%)$^a#Nv(d5thW;(uhtyl z=jLDv+{80PsG6x&jodU{;IfE)ZUV}Xoc3@n&7iH8| zxP~cdLgnaVd)$(TSepZqA^b@pEj%ViU-Vdc+!W7$;)a}_9 zrqM%KMpbx}20-h`JH4=E?^{BVvlcKV9anD5u)_9+Ao+%N4{p}j$E?=?yS-S zYdns4%xV-`yap-h7WLl1ONT55v8ck;HTa{KB|&#bm*bj{I(<`oAi6GUQI+}bXAimJ z{42}oQpE}VlFe`TN*r99uO7>xQ1@Pe!4(&zh(Fuem&g0gY;>lwHv1Nhn}jmd@gKtJ zW)Y)*Cf}#6^P|tB{Ul`Y%T-G4e$g-6{bT}Z`SO4JK0QaoKety<2rHtQMC>V9-#ggJ zazZ32`(uy4g7B8Y4i>o6 zEwIr?R@sdDoQu1e^llkT=Q+1yO>=L>n&h&_#_j#rl;VF2PNP&*$-FOA^q2!87wQ*k z?XCS->88dvH66;7iNB_->so%ek-xc6sjH;$bECe*yk~uh^VUFc)KDeq%1)1_RIt%B zn-(qhWLOHo{MKom3jR$?G7{giM3}5OHYt=lT;y#JjvKI=`#rL~!-#*@n&9!wVpUT1 zwviizLC8lxaXq7F``Ob{h4Q1#=kjY7P4_N)c?*s4KXY(?R2@%ChBD~nOjYSH<2`@H ztf_WX-F*M0gpuCgG?O*db%;qS6DAy;=_Q_`gY=hJb3l_5ALc*R;X^aSq@L?6 z8{EzPCURRF=})h%a|rmM5F6KjHwmlr^O)y^D}T5|FNtuWx7D#tkM7hwQ`pn+$rQk~ z3@)BBKRRR=ch9;~cbU6hGDUyc{$K8n^pvhI6J9amDg$1iK&$6Ivne|(0?7vdkr1TlN9S}lQ-r&&t|*e7K>xD6M1uz(a4Zi!h||&`oKvgTsE_ll61NqU5v^mNnkkLY}>*ujqr8v5R16`4OtoA2H$=u;9vQIYi`mYKd z`}8L=*;e5~*(P6;b|j@*X!Jk{duRXItSQy=RzK>h<~9xICUjVxP(6gGZl7WI>CW?R z?FOD(p>8Kc0oK^>s_za+GIoDXA^MY+2ExTkk6;=^)%*2VQMsRGEms}psE~yEe3g%2 z`MWh9Kd3hISMMsbln*jQloF#{Z#`)f6S^_%5*pFiwf#mR_MaD{71OT+1yFBuGhDZq z^_?=;vOMDuy8AyjBOa-ZeSb?FHT;#^p)QHYN)-SRM?^r%G8D#t5)j=v=0r-wi^_sA zS@^DsxpF@T5JHZvhw)OPSF*4-SzZ3*HWh3YE~a#8i!8vn z`HU{{<+uIdQ}&kUvRs`jad;gDAy9Sev0nAJ}v zS3okZ@;(l^`C5je_>FTd^2T~DYuC5(&*i)byU?Guj5NjzRBuj#s?H}V2D=x zlJuw%3hW-53i!mJ1R)jzo*q&zjhFx`B^mWU?+af5;clzT6FS!~V7wG3x}l~UBl35& zmkR@_&0#rj0`Fcvx=Zg>My#pY?d|#||Hs7(i4+(%VH~Rc$_l9wUB$>TRKHzQO6X@j z3i&jvl%O$V+6swubu&0X8L=lt$}pZV>5z1uXzPK@E;CTt#VP#&6 zq$TQhpFz63Ge8zbE}e~uca9g;zBP{B&3SXt=iFmq<_QSFTUIBHacs2Tv@KWr-5kYu z_N+G5joR?uSri+CL3iaMer=D4W$-3VP?vGQC=KK9%%KpM9m7Rr5mBR&= zS@~Zuu~?kL?_-U1He>CP{8PC7kBo5O&6|E=x7ID959L1{3E*P#R2Wejt3>(C;`Fi} z@Au|%v()Kx(E1ly4@`k<7=|`mZ4lDqkrnYL`fm@@`yW|P!$Y5SF$D#wfhp7K$^j^o zP-TstrT3rH_wPrG*BVRTtX%8pFy;EBcEc?Jd*c@vpp?0N;{GhjN+0PzZxZ?2q8lb& z82JP1`Rgd0Q%GQoFR$qEAhBqT-BImmaWh6JqMxTUfa_S=@A8D=$&%6SQ@*}a<(t>w z?JN9~innLzCqLJ1Xk0%Ac)GN3LPbJsRSZLcmsZx19@xk{ak^z%A(YJ8K{CnB59=Bv zyYoYCanfYt!l)smXsx1^8}8jDkpVth`uHM5$2wRF+%Ukx;{CjN;t9 zUGZth<@2*Few=l~$D+M%P^ju9@P=kQ>2sL(`r9yy3*PSDh+sFbv(YYdEvhm0^2-0w z^wm*qJx{!)KxqR9DaDEer$BKl?xesMC{o;|SaH{sQrumNwLmEaN^y4!Qe27#2?P%W z4TR+7_s)AcCwuQ7chBD0y)*Nf+1Z)BMGaIZhdyDKffY&4<(`V=K#1J(tmf5_rvO42 zR@zCK(a`yjDuQlmAw-64@QgNCns$hUP92puiG;eMZz!nIdEQE-3|LoUnpqFPz30Z5 zr-#k^{6$6mIT3<-fiaxH4WsjaR$Hz^Ts}9C(WvlvO6a_S2;->22(ul5JhiAnAlqc=^}ZM3geBz zqQl95;EX2T2R^j>*h=-{H=dzf3xm#^>plQN3YgDghBjaB@b>XXaCX;clAah-CEO?F9@O*!E z9C@UW-z6`dSbp@i8Zqm-b#qjG;+*Y1Pc3-?fI6=}KQJ>{ubh;P63J;O>KAX| zJ#xt(+8T%~;u7lYgnw+0a5T%G1h$lG2Jg+8&WqgD!O3E-7gS3gPM#bzM&| zHGw=^pLvxX92j4w<1K7-Y%&E9ZfQ;_Hz_!7mnGfxQF6+YBXyQz71hMP5*-m7l4hw1 z9w~P~cKs{h@+7L(}f z;v$$evEY2IuJuB$)W0i_(k5%V!8;G=CtK&Wj_fURw9fSzq}z~g8kH2#;9i)8iV^JMKmAq@jAflFL2 z{cH8n0e;&Yh+iu2Z~v0oO#x54GHDNG$q>@T)`$_r=qlUHh;-ucBSfZ(9b%hcnHIxW z*V_R^Ng<*K-QBfW?p!#1P>{Wv)2brhFhH6-+%+R~Xh~MRdG(YXEok*avMj5UOjBsS z{F6|n6wStz5&v=o{eUHI`q^^)b3*k7Rw53Q)bxD{R?{CMLl67+iec< zxr4#9JaF3zx%w728~y0|Kc#}TWkTq1+aEc@@2)$!S|!H`5&l0x>AGQKIb0}du8d$v zh;ZFx2R@3j8$Ft^A??ew`5;y|s|hC*vF@rjEt8zJ6e>W!f1QF(eVO9+PCejQ^XlNA zah5&o!lg$NTp9DG_=#BoJ`YNz;QNL*byb@nhVy+Qqh3O4=jXfdW5%qH30>csV;2mp zlF|S-sL7>6(%JR*Q;rK~;}8afTP=8!^da zW*3mDDpXJP=hbzh)U&qoaB|Jc6PzyyUXk6-ZK!QQ%~tr8PUt=3{l5nRZ((TC!c5(7 zPqI@+{Jo1F{ew*=qr>zXg7VI<%1O+Q#s*yw|+gk@et3+RgZp=;Ca+oTa zR|uNX%dArb?N1#r)DauLS|#Lv;{3Ij;2INX0tW(9(Ylk^>1_7Ole+ zF~joITp4bhz4(Kw5b3zD+kaKk)g4=_-nP2~<0W=72D#2d>;k)AaqfqyQW6brvx^A0 zMO;q8eS?RGBoyd28O&wKfxMQSg{*-amNWlN-?(y4#|uJl+>JI+>(xDV^$_Ay%T z!ae1qT;uD>e#@TPJJ2*2A89z=G%7X!ynfZRR+|Nvv>1c0F9VkUF;x+);b~Bhfc+eM z8`MEgT^)HBb$w@e4v&{j4W6_g7Y6!2I&iBoP_tBaKA_g$P@eR3+tttUP0Vfsa(ASO z$e6JN{Q-ln+g7Y!ORq*?Qbkno;{~jdD5t7>9t|t(u>ff^{5hFUH&%V<==;JcX)zM z2iLsRz=s2(&_ms&m)_B@l-s&pe_rG%-Gvfo2^4xz&8FDi5=9-47wHa5EoI`BIX=Bj zQ@VDRby4OjNng*W){uqEMxjHrqHbz-W=GCgqK^NW>u&gZSH2(B{+#Y9X9Tf2cPr1o zNSIw?xj*kJY#O7DxqLP?Ov*!MhpXl0*D#-{>2Dq$pY>j1@Ga2I|8>lrZsJ{giY;8y zqyv$4B7`$fvnVu&!=5jf>ZqS=*S=*x`g>+J`xOGs`8CL;NdY6d$#`4*Gw(9TOi?Q8 z!0yfKv~XQK^@N6i?O?q^+NvMPEYhx@cz>1wm)|i`+1+ejFjv1!3_w3Ly{|tS6$E0e z&bdP~gyotI^FHH{9bg${QX2Zg>{qHhQ#9P`rdIFy>63DTo0?3|7Vh0QU>TN{B8@vY z5(!-@+y*5oqh>Q7e|Xq@J`Fn z%??>fPsN?|7HJ0Q=7U{XY0CM!1|{6FT=sB=)KGYmNQ2Jtliuh78Pxe&4iR$(AdN&= zXU?wE)n0mW@;(&OjS)@CIHWd^{64-7*}?+9X%)ZQK;5)0-;bAOrcZkA2HpBs^s#-A znniBeLIiVIM;8BNc;JmqV7Py~oDq+d{T$6gi6Ysc6e-WryTuah5cIRg~(>#@a^ z2L9deehpmx5}~|fZto!st^NBg#rg1~?#pc~iHDJ8r>6kMf%uoFPnJwc&KdUIo;RJ({q+ZFrvdde%StSkco=G-j zK84NsaVp5x3y+gJIs^e`L)9vYuaNaVFN?y=x&ICc5Fq$SoL>X{=>3Md)ngV+{M(H! ziu6sTXiARxmE?^UAyy#`#t-~7*R zfhss}FY0c5Isa8^Mm+pMhRATZEy@T-Gic;Xl>s&Cp_%X_jGJtpmW73m1@|H=cjyJdDrmVW;G8F_$Ir(Lq}s6|O) z-&wW>ZwuW7@7GuBn}@_+^1fer+1hSJm@zb`T;u`q!pnuv5SZsh#f885$5!1zv8xmt z>#B5Lu;8Z%+Gjf_fxB$ERwTpN4&K7G-x>j}cS>^do2S5oI;$9Hz3B>UY@r)F9ir^Y#>N zw`wOPlz7P|aL+mLM)F(_9e>LkJ@vw9s3HM6SkZsy@atA~@PS)SS!QUc=h?Z(Aoxow z*I?DT)zHN`@frHqmyc3nm_~6;_3X5K+XfBh?X(k^7$@s%NLIwLj{Iv3t^DH~rYNz$ zI@=%6;IFNmn3`L^P(E1HF4Ytj%c=S~QLBHiPxtPr6`pH!*7*W?OgW2m*K0SU!P0Z+ z(1Yj6CvUWPI7Lw*W4A@Yv-1!AQXfgHBld=RzTDY5q%uy9?d1o`gfnhi#oU7X8*06` zR)?I)!BS;jYN2>CcFnEKlZVVWugfInxy}ee(PS;=%FO=(`aGx42R+0!58QJyK3_wZELbz3?9uWWqZ?byZ5o}WYq+p(0Ib^{`>u#QWmI#NiP$=CZUFqM zFsVUGQC4p^<=?mlX(-r7)z_rx_UscGBnPJa`e?|{jUjF&}MQqkPC806!E5o-e_a3OMCw0=^jw@`B(O+dqP;x

c+3-1!9`39_1xNjywMN5^jwbz^ z5V@qnVL^$Z`>ZtWCySl-K%ZngZu(KOEM$g{W_NVKmIzYcSgvFDbKQbBH;iN|)p^RR zY>j`>j48HY%TTz+)n$~|*1^7BdcgDD55Mn5;pF$A^wHn=o5Xtk9QPXU*OH!}L&Ca})C)lP!YGCZC%W zfiwD{F!^YKD(zz)H0F1-?ePZAhD|&<%$elBT`!;X{wG~O@UKH&7wpH`hp0GojwuK1 zhBg&5s)l?)0~eAXex(<#AQn;zsScG$imOk(HjGA3`36Mh*9x#JN-0BN)lquaQey~I zU${<3@?M2R;QdRVc3%tIo>!4+0*2xvoZcZF4_P{PHB>lfnI~Wu+;p?9Yxv@*MI{ag z{4Ew7g`H;)*2*ZJq%vg5u;Zz23NzEaAfOXAe@0sJil$G2oQfcdSMa<23vz-{X4a)o zk3R=er84*Y^8eBOvJ-*XFhx9YyPgbTv~MKmEW)&hYOkZAeqt+s6HB%Jo91wJ{xNsR zd7ICkht40g#A{zI073CB{M!G8W-4{{2KfMdmibQ{kW*j$YYKv*6=W|dCF%LpZdCfn zt_APcLy3J*Fty89+`JpumsL4?y18GAR7Ua!xNq+_tZ(ia!$5;E2iiXLvK&Pr&UZGA zFVmZotx$Qe``*u0l#f7wB#EI%5(hDxnOm+&Q9xg z1-!3$71fq9+{k~_5b&vuZ!xBJuS4WC-flzSQ5!v)R<^|p zOMSs{-6LuQqJh_S;fE4;E|s+{>*A1SqjMrSPl)4oxj!4pO47P96#Rz1Cr;9N7@MrA zew0R4m_*x1C@CMiI&jCuw7)i_Z{0(=V?cy>1%hsh&e(+IT`=8|u`*TC_&6STrOu7q z3Nv0Shm~0QlOA!g^9@oSqugn{yz0l|I0W7@9SXd`8}(Ai;8_hy^d%R9+dXw6|I5KW z`BjDRFUxR?#!3#?zXnv?Cr($$!4vvUP0I$?8AsKLAbP;j`v)hT5SggDCvf7QWJju^ zlN+j<{TCn5BwdeR`d@zW>#4IqibCDri&=NE%^6$!iCTAkxrk6}E{potXKJqiExhoX zEjY1MZo)XMWy)-LX_Vcc{4GS8VbNr8R@mH1ZY>_@z)goN7T zY1;YlYYCSnRVGkXJdjhOs#Vvi*K^~~wiHF}Lii;r1TbY|)a6LJ`dYN&^^_u3C2^RqZtExF6fb6Lr$gUqy00aYv2apilVc0W2$$EN4)S=_&Vp15E}0D{ez6m|_x?MA z_1`#U%;9}GIgI!He``5@DO2`8D*;zIJ1IaigPnYTaY+uVHr5i1FY$JV_FTgT*f;{`t# zU3Gu^4Kroi1H{mkNTPoJox;;u>=p7Y^mzjVf@KWGc7-(#PfxD_)Cim#}X{zGV7`2dv)BlI59l~yFFojJChVa3{{ zD22hKQI5rp{_sWHviJ})otQ5BUZNPvN{xoHf;@OofR2Pybj{)gLo zY0AiEdAPpUvwyXtw}Ss|-X~>rWw+u;@L&%za#QsPs(Q!dge?u*Fz_`U+?kQ|U~UIU zHvY_oK4k$SV_3tbK6kkj$Zpao^MyikoVTE}E4Qh|qJOP^D#}4=-5Q{((k$DicX%zo zyGNp+V0DBz|90QQlpnND)4~{mt>^%P^?r7WTmP$Se%^DyKPW)WQ|o9<2dD`O9S-{s zISlKR#+V~lCN7bld=Tyr4o1Yv$u2Lr0-vSF1W}o{zms7|IUC;WOApv(Mvxxv_Jzaz zH(K;aU&9@BH6f@EXx7i2t*$?7jS|Ctyb|bKyErrZV^t_yYc)f|ilODZF#OK&ujg;k zQt%g+m>k(7yrS9;*Ozb@y3%{AsYLcSLFYf6 zlv>v0+61ew%{-Xm?c3c}?E~nDALR%*30UYa8Q%G(o5$VoF21#G`}VY~HM2&YN;O1G ztTJruwrrAh4>RwVu@~EFJiC}_7T2NDDRv$__G3_*yB>7CKX}-G^xfSSI-ehhuNum` zwL5S1+)@BG)5X8V9>~U#sYRb%qOp+xnC<-X!MQ{|Cr?JGGHqX{;6Kx>Q1JsV{ z;UKqJV+tCrUti6oxRnRLQpRu~-ZJEpSpGMjKElP1=TSMhGfKwJ^!$AHOFefFdnWnK z%?G9ROtEK8Dr;OePGg_G;Bjx3H;Qsd;>mRD3;{J!Jebs2t5|`I_E+6sTA|J7d6k7b zu5qpA=v0Fj@(P0;JJ~-@Q_Nm($9awDISw+u@cLk$*Qn+-q>3_6`TO6!Y%^z|?l7tP z>Wi;@+qHHY6;`p_{6*lF+`fa9Vf%zzYnanr9mJ8<{bePk8)GHjhI(4xj2^{Vbuk?` zV<9~^HKD-wrMVqjOYIn3ZH3ESAu-hg>JZVtNrZ@>$!V_}%*yyC7;RT=u6WVi=aG}+ zw4z$_BEMBG*a648!^uv+MY*zEt7DUe#1mRuyk4!Wydjg6PFxan*UTSv%b zP&8%TjoH&P!7(H_T_He03;d5=z!<-*iE>h!e0p|@9aLlg_(5`#HyiEU|m+{V{ z05Q`ieJ(3IZdoSJVmn!}p9+lBG>hDSph9{juYIZS_O%^n8w!CIP*i*AF>p-LFjwJC$eKV1^ZahmboQ+&Fo zb*{uH6F@iDhF6OG0x;ajdm<&$it45){h{KI(6`j$7wscfhh$(L$-NP-IF$V<#R8}I z@<&G0#>bbaNf?tJ_JkJaO}F#b;g+0CMgMpMXVTxSy8oKT(N*k&dO!z)MpJ%y!Q8*y z_z3*WALjRhRt{Hulh0%@%0id5<`{(S6yOwgkzRd|0UQ41KG1$-_X34WiqIL$JM;cq zPsTAB$H*G-SoR(heD6F)RDb{vFER~`_8Q_q`QQzFZBG5N?u`3} zcoY%mvkW|ZA zDl}%DC&fzEy7%VmfBu$xL-&5@ChdZ^QT$eax_M6=&|O^6qdF2FDEC)vME5LguTxWr0SlgPl-fefH3q> z$GWiK!rwlD@CcV~jfVhj{6;|MR3n^k5TiGyzlpYcP;@@w9Jl;QMga62=28zEkGOl> zQQECBSg@3Jm(6|WWtMiAT>$MJDnaz#Wrxb(h0V#p6~iiHOYdIC?6av(pe)t~@Z8oo zCv7S{R!poAB(qjt%!q9h$27UIi0<=OaEr<=jEcuW!GddS?uFG=Jn8LfrbEw^Re4i` z)d>;AC|zest^*ikg**s`hO6Zh2Ng{;LRkfACQ;(twfh9l4pyA0(8(b6(Gl*V>=yjd zk+=)$%YsbMW#tw7y0v1_{1aF4Fs*z|TseZ7ir4=<&NBUCuc^<2?ozL$YdCBt<6uYj zFK-&|uA-k^9RV7u@Gwfsi4S|C_@VBSRv#6@(NcEJZA-KOJJ9eHU5c`0%K0A?md8P_ z&?cDPZc5v~#sa6bcMj_JxAiCcf)Z;gP@8}y8@G&$ty$A8=+)?T)vPHioc@ykk70#G zeNS3rnq*ITB$+Jh(24J3SNeh_E-sY<)n>Cuhzl`t(9lf(>2aZn3a1GoUGa}m%(>26 z8j4~LK#l9H=~MWPrt9K+C!s3w2Z|ND;nkU)KRGGx5UWk~{=aki<%J+AMy(m(InxpJO(sbNN;`xQ2s91^K zf!Znz`;L76>`wF*Wh7KdUwB1B9Nm6HeNB&A3Y+f`+MtKufwCOPPk9WLL+=Jiy6%xy z9#sghm81KAZN*Y1Qu~V^?ff9($5N|ao5#Hiy*g3nbFEGI;ksdk^>=|3K9=f-P{(~& zMvMeNE(e>$PqO|G8ma>2wS;eYzi0DXzFH7MHBom?%8u8wCQa}kzqw(39T+C}dw*i+ zeF5C_*TDE=w1aSggkZH>=qF%++(4-ff7E&HIRmZcR=IXi80EZ9qS3rOrI+6WeN0Z} zbc^jyGyR*7>Q`|%EqPr@p%fyPK9p5|^pjZkat_kQ? z+;kj8;i(h*;aCDJPj8t!$zGUY!}#q`R4 z?=${-K_*6<(DQBG%SVi4M__ow>3}udyb95@D5ZYKSJ?UT<$e#lGiBH8O2VJ)-rM(n zVoq~at6haW`>(vaO$oy?X%?Pi2*jux1L&pUm z1g?f8YQ;4|VIb!M!~vb1ae7AIqLVXxGS`*$^pd`%o_frh zlhuk$ZrieM#0W?tc6Le@#&3^ky_G-gEKJgpV5AFf`Zjy!sL8wo*Y(c=g4XSX%j(;I z#$N`9aU?G&##QtGVmOmh53MyWoL6+_-^OU9SQiMhK4P4r=rebSj?Ljsh?F7hkFa}WZTxTl9P<=?&&Pn_RN_GtB`va(YrFQC=G>3|THLC|XbZ3%-m+y6 zr~Qo|ZkA}3?j00=xJQ`R*lnauIGP;A<$!QY(-cKxTB`E!nXxNXoRAwip50Z~1Iq8?_zg^jExSiG;hA z?`H_H<=Y#N`G)bqKWGI&KC;GUAGe#96pjimq+Z_oaJbHO0bcI6c!gV7aBce>GI`Vn z8_q(dj%xJ5SH0k0)$&@i#oM8=Wny!xZYL53A zQR*kdZ*1gacLzVoBQjF4Hf||f#F4uI!&c)>^Tfe$}9T7{buk6mV zoiMf&#_2m7baVSajQ>^{HZNFpcB*~b!$4ERQmn4;zXf82$YEl&N-fnj%@ZckoKBZF zWb+5C$@(-z92|(R@hd={YpJQ z>(!76W;^=o9iw{PXY@R&2}41SguZ1&-0FSygo}o6!0OHbOKA;+b%n6hBS!d4pZadw zqef&-17?i~?{+tge6W(Ytf_FVB&saoZ;(J!N@Medr=Z#2RNs1$&*d%-KRp(ZeJoUW zlm*2`-+InF+LyRqUV`38i0#*k&VRVI5ZlLP2~ml}Op4Z2_88;WgikIxmz*>j@g5Y< z{ZivDkm)t*dkaT*Fn`<4-$G+1af^^b~Hcy2F0* z5HzVx;3`{Cs|Hj*q5u^z_$m$-IF_<*w#582BZ??uhL8UIR#v<;)b$&HGbrGVqb1NE ze7?B%yctH>0(?6voGaE@R^CHSY&xr+SbhXF5lqehip%x+-t?$PsVOJGk`br2$$pj4 z%G_j#0l!m!>@PpHzUf^9i?wmzzsxb;ikkWjVd z?Ayf1`_$=3R9YhE%aU0owk>uaHpO`)uah6F zUbQAzI2s7}PAG@+xm)|2CGs4q+>vz(kW&eNG1A-QG%oCQ3a zs)rkV%3~R>Lxx3X@s8Y*`w(~==TWP<%k9-82u5U{T@Z4bPSNz2y(2DpLswp6LjD?Aer!E`-Qf=~xWpA>Q!%(yTdQfKn0wJZS zB~2Afy@~{!sl@)n#w)TIMma3ky?t^|&(MU_6#J$vquN{9{f}eK2}>#>67r1)^OOC+hxZGnwDipMGtU5O;O_xcJ++di@rkELyPZ?xv(jVZO@j z>47EZz{($)`goNyBhn>r3BZa4IROW%1S5!N3F`%*#YFF2az^Al8lQPNq(_ zzdBftk+xcq8%OFXqrB$@sgrQI38FGo9@Alzf?TodL%_Sb*oK8n>(6%zkB&6S2#5`G z3b`thJ4>4;PeAyhEzkh2;2kCTzh^d0<6QE zJWA^1xNZw%C+;`}dki#d7#iP=t6%8u0#G!bOz#1?Q${BxUtp`lsQ2YxV|xsupWMI5 zMST6f_-yazsnza-Q4se11~}^mdxPBg4LW`wtggPg>BtKrV&t1_xYALqcstb~d?jIB z`*f$fd*g8p{K`<|!H(i)TE~QqLm*(Xc!33q5Mx}XzqB_C2Y)AB>E6BcSpT`P*;&%+IZ^e&0z{_o>BhI7Jb@Vm`@?qx#y3p! zAdGtde%P3(62~w-8NTq->1%57ySG7iVby2(Doo)=N<#2%JgJbRq@N4R(~3u*&OhQK zw?^pTf8mMBvm4DSN1w`?{$v<7%axW?y=VICT~)%7E-}#IZq}%bgf4Gk0E|919=A8A z7qfSQ@LFc$T6pLaDZcHkeaaT;V5`9b2{la)tEsl%5yJ_&KH*wOcvlRwyfxR#Arr`> zJ@p3p;~qa>V0+c6zzi=EO9ofo|Gs7_iu1rR!WnF@!3x9 z-ZLhK`}|-vp0fDzeEI5gz!P}LJGN1Yri>84Re+6009M`tN;uEZ$@UI#qdW@Ax}bWS z73vBO7%oXj6&QHa!-+z1e$(ZLF<#m4k`+${Q6nvkixd4uG&bl1n&P60Kq0$CwLRXN z)d9P&sL+G}7|63*qw-0SfCeQtbC$3(juvYe(Y0Fud?y@w_MmlbrEgs;1)t(cB@4YMP{@6K7&Qs7s$1>%Z@_!>|9=&Jj~?C1JbI)pTZT6`wERdK z_xvMF;7VgxK)T>`k!Q}U0sazh%KfJkAA=+8x#-E?DFjm;Fn6)NrKG@f)_d_T z{xdU8S!BuM$B$WuK3%dhQjjYWywHu`ykR)qm5jOVsJ%zQ1FUL&!g}&DDkdf;Wu`!vam#JaVabHE1Skd^xyaK6NUuSvX z@>o~9PirvpXBc_m7j)d5$4S$Xy|*^x`{Jf&1VZj>^kXnfXdsqDiGj1v#8YR z)RC;{&FeoS*rBJ9i(kIjM@P$G5PY`?EU?^~en4rfSb0owjcfq9iBM7+gl_eO0Bl$y z=jCUKDx>mr(EpvKT#6_n6%V5le@oH`JKaYm78CQ^TZe(89y%tt%A+wA;@s?_>|Y*2 za-AF)&@FEPgt%i@;kB42Ud;G;%>~gf?+D2h(Ag2_G9n>tIZ-j}Ah9*G}XVg3p)`*s!xKY4xX7@ZBGaDE)!@sJrzN-0jU2T10 zf_Gvuu+s75t|9KqQD4o`P~O{d(GqrzvdPN?W}}q4#WKbkJ}gdDJVcrIGe~CavQ?qd z`XdS9BHqONSIUNfpRy4CJ&0O%%EwnF4{_+&6EF;f3dn;-h5iCA8!MbB`%}HUPovs{ zw7mvOLdIO5ow$x7&8W@CoJLj>)(WqPf?oN+W?ln>Lh%@^i&4zHce(R?sBmR9AB?L6G{c@rv;3g4#|AM|tr?>;a zf+k^v*XV9X1ir(|YyJ}P_jUL?n-6s(3Fw~5b>+ugJTgS*gK5RjRAQT%OWT(hz zS3E?>X#C&iM)*c49B*9UOnZU10m&00KV2CH8P8<{Pa@M=>XDO5_mlPLhW6!qd{+Ua zK(#ysECfn^^&=FPYun%n%iTWIY0KMX<9eYV1PR}R5aMRHcML>|u0UhQL%clpJpDXA z;Ibl2=|)%iyg+v4@n*Tv@h)FyjoJE@BcafQTbdIQ`A`48GtW_@SKs;(4-x^8*kA!n zHL2ljW8Zgod-bmZ49k-Yk|t*C43b)A!hT(?B38e$y5gGCWBxoA~6$Z)SsMArV(_uh~ z@&X@1vQt8nvSLDuCB0jVk!hu913B-^;xYL>VD)QjIXVXHNu2at#9Rz9C>&PI&VVW^ zwv>m3V5aiGq^NrnInO&2!wr+6yzsPz0A21W2FaXVHku0DgiMv`hv6Cl+wP}Gt~#{( zyA4mn4bPt*f>j=Ww(Z?Vjen?on8v7t=W64ah-ME$Gsg`?*-PO*K%AWxs3w=+9f=}^ z$oC^t6oMR0f*ikfCscPQOcy0o%hG)7ax@8<;>jlA5#ZXv=iu65z0k>wuLeWj3;&dd zT;;L#K#*yx_S5H4YtdOL8)>_2Hy?IcdWIQ-UXO!{AY-7S+hQbE06vx(%X{eX)C&{W z`CX1ieS_}SZm;7LS2i2SomO>&ED&&^+?(x$G~blZW%GzL` zg-w~Dgpn|mNan9*GWvT;=+m<&dt9F^0MeG9fI=XQ zDM!!Kf*)x{MBy1IrOnfDZ&Amy9Yof z2K8YxEen$7N}V1+XgLuo;b~8Sdj+sfa;LaLIPJe*8E`x@YdOZ-AzN=)8FSFHGtWKX z<6=9^)7zuxi22DF-v0NTZL^M?w7ZrT|viK}<@CS7jS{UeB)( zLYly*pyZ4Xe@;Y%Gs-Ia(?oLFXc|Ic@G=xmk7!m!u`Okb3qzlx%3t@q7?bWFlYV?v zXnj@q>AJxBL=x{rwtt2A^@-!daHq z2b5xnH=q5U{e@9WFQK*zZ z@>75AQppko8@QpFS+EFDu3K~i&Jk5E_28(ppwsC!TT@yy|bO#+8qzY~~i<^D9Xf2Q$uYf@&=YN2M6{*YzE4^*qk#5zqD<1cN(IPT-vikoF#V48;V zMHcj44<{@00eoCcqXARR|BdE3`Nu!RpfjAi&+vat`N)eFQpyecO1D&U3+b3oX|)A4 zB;r&SmdQxgilNv`U{4@{o;%cZEfIa~Wfrv*FP+~b*sK+iONM(h7}ndyTR^)KPn^-KCTgFpmCAmLhN{;7Y09^$M1fsP_VOVo{@Aj zM!$xRm7@=H*X_%Gc84FZH*FxAkiz4EYjN_3kM=8ilFi!JX}OP7zJ7#Z#cpuN++KzF zz-pJ*QWR6M0PR)Eajgl%u_UTw^Gb$YHY1(@#ap$1n4mVB{xtayD2Pukn-1<$TB0pP z{g}zp{hKFjYqwbt`WO{sg0XppAmK%j%m+j)1hCw*?LmtFgu;@lWngZ*-PFmQNed~R zb!$A?J%BMY$e7vFtG{+ve`wBCPAniR9prZn@mG!u`VWAF{2WGlF}*kSQIg*F zFS1e?hC9RO9hXIz2mi6Vyz_T{fdij>x{cVhp4ji#EZ{y2Q;_DoTy_uHnDoGybVeBK z;o~Y?g)Fj(G_V5-0c@<_6jg2*Vh?**?Am1 z(}+!_7XkgI(z+*Wle*aJ6{rh^{hml$#gVZ$(UZuO`QRYh1*Mj|R-6Ebx!iX`{7kx7 zfwN73TjIUeFiZQOG%JHsdqZ8xQ;B+>9BB}obJH}H?T%=zK+>BiJ7tYoFJvzfAPuBqG z-SiWO!01&isFK%s4x2q;*Sd{8X{(^24;dpLTH@0ixUD9`S$K5cc>jHMNak(%0%3(Z z7R^p6m>5&`#|f47YFWr=br*!^h|HViNWj~oSw7Xu`kuIrYPA?r^ADpI9?``F5!({` zj;R?Rvy-C<1mJ*7@0fB?@1b&0|4O7xLK968$Nxayq7}^IBbXWCa8Dd0fa~3X>y3%W z^>$r8ijv8ZM83db;E1dkG-nkVN^6k`_6#@foC!FU<`0Io*6|)6#oOGI8c_ET*O_qQ z0jvF=Ov~=Fg!tr5#dYV4@#P;XGXb@(SjZfb*J5_r0^)yQm|GIMc^TR)e2v9}jQuN| zG{tw#>hD$NFse*1weEpIGCnY8+^mxFdQdicP>w@igt58O;}A8|A`q4_k@ml}teWw~ zD0PpGfqMFoX^47cDw`c7twty_=o%o!{9jsEI;8;Xa>3YKIL$y27!x8mDbo9?kE6!?)=N*_PnirT*Oq#D$VjiQK*ykOpl$)ylt ze?w*aeDF=|425!Jtujdz?b8{u?_4TIu{q2uN{yeKp3IPc=U3s2{XZ;SbyyVL+qQwl z3s68LBt%3>6%deEN>NhjMoOBc8&+vSmImntY3XJa=~^1e6<9hJmfZg4{axQ5XNaAh zIp?W)p8Gy$&MuuUXEYa|JWAeL-Y=MvLy1r6#WWKwmm+H=-J2*oJL4Nl_Z!4-tR}no6T}gsjqH{%Lj6GGAwa=QC5dunmBL}7%Z!%g<9S?u$q8sRUGI|xEg7MA`Kol zf`k%`ZZRna3N%s*C7azQsXDNmTzPKp&n2PhaF6ibfhCLj_{;R8%dTk&31bI_EFQ7j zW1oFB9q0n}%Q>=yW~eoic5jucc!fYz8$-1@AFCoLc;7XK&=+U?ZZ2Z^O*QH9`*^bc zx0}}4KZ7zO*KayvmnElat_?ao5-R0vY)?~eAmc-R-_deA@_I*0lXmU*Tv5TlXJvE+ zT1UENmaadNIoKX<+@w%#{VlIWqvY+Hm&_RWdgwMy{3I9QH!1O6prKYM@zKq0)_s0m z%JYOt&LN5b)u+GB5-A=^{?%3qdrNs9zs6qqe1iT6)mBj9RJfBl%Y8-II;zF%-tO|~1?MaV(P(uT)C2fyOR1H^?d|(;;sdJbC?XhH!EuG^T@0K7+yjYB` z0vJQ(X9F5&GlL~nPd{A@=RF01&zF>z>^+fm9{DS@|2Y%rIlbkro`CVD9l9yb5`_-X zLC&@3%z$?pkLOa+t#kFsbM(t~P(5eC$$%^$^|0a`C-><7oLNjd()~HrFV^RZ*i|g% zq6tiClA@=X3gTqtc0m)WXyLPI^HhInSg@8)XU()a zn%iq8K-KirOv^S(!(X$ka7EGo9a_k1yj|WiWns^>$lKqxtZId7ji)SjMc$#RIn8M2 zfOA1b@a&})b*Gq;>dx!V@M#n1or2cWkd@m7Wz%YqYZC?z<>Fy>oMIDuiqk19dtRJ5 zX)HU9oDOo*ykgV2;XfXWjaMk>e0h?vyC+Zi;Ng`IPiCh0o?6?Cc<^8RTOaTv>rdJWx*>4n^*u#53*y4j1jxu3=f&Q{;-czpxVuaz2xfc!}euyMDXsj1-}V8;(fz z2P;x{3M+B^iSdUhdUU3(-s~*RPha^nu7h^5EASB!oo#1f*)hEhIvb0)<Q;3bFZ7(k!YI?)wH}@uL!M_v8!Z z?kK1iM;&oRDPd*gJ>`cFnpC|fv&nR*l89?jft_Eum>w!aoCYEWrdgR^a1#6#LvQ8p zf^N%F)|esVZzX^d3g$$7ITJbWo&p>vB~uuEcmCY-zg(4cpD2^e7U?MNT)zYQK=bh0 zL$>ZbFoZJvQtGH^h=Y^60~mj z)WMWL^G-R|dv$+3kZ8|&&HSEON~z* zndGIdrps|Cy5;5OYyGoP)cE+BOXk`5KkC~ri*7`)+`abaHtd&csN}P5x(D~|GwEi5NWBc8wByUiW_@_xiU=NGr1 zELd)vhFJyIvNN|=9XUCjY6CmhXx662Ew<3AS0_ll^wSW!I2>_f^-t^1!MAh-)q)vF zY^-Js54Hp+*BlsTqW83>1zpr8!dk*#53h9z;a(mpOpLZDzrJUskXKOq?5LpD?PE)= z&p+<SVy{;0xN?4MW3hvPCi>H@gBqVIlE-v($&1r!`lHLIZ$7mMW$^A% zk8wZEgnW*lVT|CPJ&gQ%wr=!}*tI))&|`N;vtz0X zGd7oi5{Wsz!j`HkjbkO_&^1ugWux@|XDW?61a4sn@ksywNY{U*4P1{H{GM zZs9wT9QN{c#a)%?F7>wpZK+3jKTX!k6d-F6-Q{1=j7{(M%_Sby2Cp_KL06-DqPnxc zGVx`rF6r#V^<41v@|;!aaP44K{Iwj4Z@s(V_f~tQ<>oqB7Y*TwEte24d)+(pPLi>i z=e3^nch9DOfs>^-#SH&XMB9taTQ9e> zh3|wBCLW{z6PGae-2CD%(i(v{yRCegcWMe4x zkWp)xkpvF|S@&AC4K6VEe~9nE%y<3Jz?6-O_c@sP5buT=L|!Aw zc%-|c0@49M3_P^-gbn-Q)6)~J|3`;;4g7fXy6P*t>c`pLc^nf;tUut#+ie9c7d7ob z^%~E_@$L15!FZ|GZxBmpTnBFq01R>dcM$#G!I9$RK|DNn109Kh{lviJf_M#rc=KdX zxmP%B4%$Hnt)_kSb%VL1q*Cy3Ae-;vi>?em^#0xg!O8!Y71#-hXeyL)A9x_C8DMiX zWJ8E$TgXlE(6BT0`0vgDnn=y%W5G;L$0BT`!9EG8xvDPLAUUdML9_&!MHqXEa!%TX zCc=sY^38rBo90*1vA2*cy9YgXo9>F< z>OdxD`%+;g*(V&!I6zL?AX9CGw8yDqb$y zQg5SK8B_dO7!B@EI56MtYnE#s!7Z2w)w}KG@R?*!FXvP&QC{%dkgGDQ5jX**8 zF+Q|pL^88*@Eg(;gw{V(l)zksw*p`j05wN%a6^Q2!nkXM)fmhg?etY#Cd?*et&6vH zKr&D$A5UWxE;P%?`iZ8?lNyE(egmzqb-?a31txmtF4$Ki3C4ASC=I}7*ehj$CNq$2 z5CHs-#5wo0V2-vGu;yPLK=CdLP*~P_92je$%(Vx~To0hk)&H-|wSsj3G#ZEX1{a6b z8PE>oWd{~wI+6e??7^Ne2DCYL#q~2LfdeQ+(RDbWodc$S5Hxaim$ptsj`&&#AUc5J zmxvo|cek7a zD?cc6esQ6tz&C|wl`N`DX>BBg-t~ualZ_Mrk}5y!oEBrTIbaT;z=AxdKr%jG;9GVVBRSt>IpJzVhNvQ!TSNF5EiVZ6tYNg}imXgjmT6y=t?rB5QP}FQn z8Nh|`X+slKzjNEx23l9W06tc**(IxNqa#yxeC2|hUpx>VfYcMe5WH<(t;8b%Dik`f zt86y75ZUoX65|3;Ls0-Vlr;miMhYw)P_w%LH9Khk?6uk8lBtcpiVowDGAZ*v`Up5D z7dQt3#FZa>(;U`5jJv|_EFLK7)Ht?Eg$*wKDuuKE4hQlydim!Mw`xh8rMmf~hwbT+ zx=+u-bo2N86tOxg{MhfVDE1csV-sIS4EQZR2nd%YeIc|%q2&BwO*}9pN9$c-%;WTP z3d~CB?yw;AncB}IPQxR5MB ztH8~w_wx5Z?%cGdka$+V%8{y#J^yY0P?J$bJiR1B@jzL_3g!gh`;Y%Sp-|@3UoDc< zwUbYbA(Tg+gE4Xdh(zHJFvP(r|ATut{9ZY7U`#d#_yO1O2VCP5;2NKRft~>aEOcuzi*MK-4q?AFbiLd|Z4A z17Q0Ophl*7U;(c@Oa)LX*pf)AJ60OTSNc6yN&h>%J}e$5DYF-i z?}bXAm*L!p;Q-MAknCndLyBgjyFdf%BpJ{NJD?LOCn$HE4T=AV7N8iUfWcS*qqP7= ziv~gk^dnK8lme*zst3w01(R^VmlDZVqZKr8%-2XUUkzABq3$j%<~jhTnWs1F`4mrE zVFzXm{04XciQEM);sA*346qI3ifMC{&`1IW5Rb%x&#eH}TLG#^emr>1K7b2ddR3z#;lxMlC-;&lgOS)Am;xyF|JZgmpodxesw2YkB=uCN zh>iQp&fEm!Pg5jCQk0*;SatGsAkqcY&HG-xyaI40CNE9n5&+JO5Wm5#yg7cxEcr6B z8Zl5Sskb?cNs#mmdK3Izy+#}$u89L%-?=#esRz{U;J$T;WWv&L<77Tb0H)>N94EaQ z8_Xwu$x2e}XL9dl z%7FNMfM5*$EzNUnE3}yXIe19uY-y~zyJ`5Tg|4-c@QXv0);r43xIi)3LTDiO;p4?% zkqrwrfHtv;MGbs?Go*aZyh9Ahaw)o?c5j;i9yTks|NUB!aL(&qnQ$(S`6JICkrtx|d|3+!I`lv=00WF$ z>;^ZvcSw;&>_gB%{$mGPj5%;+I3N`AFI-GuNb9{?9v;~>M;6U1ncOgd1%$O|tW*8l zj-nXhkn1Xx-jEvVSJufp2K~I3KY@GTD(ivT1@yoULoMfCYsBsk(FTFw&_7apyXb zV+<$Nk$1~cGj?2QK+_hx^WN;Wp4sakHQ#6SZy!AUbnrCdT+jNT3h00>@m(b8aUJP# zh;h0x7x>#oq`aTcNm)lbwonnWr5)6KLh(%5We}6F_Y)KE2oP+JKhLKrO|N4YF;Aha z$<2`|%@n&*zjmdr97z6J@Zf~f0M7m!aQ5q7@1b*_g+F!O$Jo{p(%-LG>#bP-fJj$B zq#JCd9TC2EXzSUP!SUSmO0dYu|6lnVRd&wv$H`sSZ(yg!JG&F~>kbA~6?OtP64Jti z{&%Tbf*~`jLg~0q;1x8@1Ay+O^8n(XECvB&8peR<8v~{d24W!@@a(`>r<{9`*l*1W znLtAOV8KiRQ<|SWPuk9^&6dR21MDA=Ze#CF%O6x+Ww&MzBdDe3Qf(C1VYKqQ9_g9i zZQ%Xd$V;`5Ikb=oA`V&;2gByX2XL$-_x~)2JU;cr8RySUJ|!FB_Q$1mbXKxYH5JjN z+Cdjn0RJdEib(+W6XimNy!rtz{Z0EEd;_~^Nb-IHk>Q8POgE>_G~ZjOPi?dnZ19nB zMEh?eyk~O{cK$y$8AZsdIdZV@cR4b*LVgIa`32gAxS|Y466SzB+!+|D>HA3E;OoBn z+mI2c>f$~B=dl>!k}4{h^fw#XYMG4wqOrSD8834r-OT~wBqt?uDRBm9jkeAM?Kd42 zx6vG5z_>Utc8OC4a*o&%o0A=bHvcQzlFB4qAehGxf@dR$;$#11f|llTAg29haZdY9 z6g7W}|2@5j(ECr$q;JOy3ksbH2tJ197fqiiP+^-BigO^`gON%p{t-$E0ahw9EB7&q zwZ%D#wWvR_#W|~QG9Y%FT5+FB4*CU)bJp)+J~U||p0N6*7EUK^aDoNX{56JkRwVSx zY_npTw))fjG3$eH%_nDpxpJ~k%ce!1e(f00-hGOB@0X^nB9o?Vho7F-LQLym5<$f| zi6E4IXK_x28HQP<%r-({Lw8C=W=3=&_>cK+>nbmqvvB%E{+8cprIzNXK>8@6yyzbr z43@_47sojex56>o2h7cl0l4|0|J$ONHAw^;(!?e{S+yV$?8*~X-@(Z9S6LY613z!=&l!J z^KJ^Bt+zA*-_V(k8juDHIDXC0K5B@x`5^1Aaa9tNMBwd53roh3_KpK4pdyV=h@Z+O za*HC1%uXXIi$q?)irv;tPC`xd&pW^IU5O{_pLAIdg*EUjq!ka@E z!{^kX-;G2%YmZczW2g9Rq}6!zr&dDftf)VB5s_o$m0L1(&uK#_!YL-DicB#+bisqj zp9-9v`M$#Uzr^lPrwa?z2U*-Cu)3k?n~ICI{VpsPiNHKLltHl-*C|K;u06Rbd5Uyr zqgDSMhpHp%zt=lNyMvu$Zw%iKR5k@p-DCx8@h(BC*k@>T4TGBqg5V8wfC)MG)XC~q zs-{`ZH!I_dTDUTNXn6QZ71-bCdicw+e4-r-a7D!8Q+G~ zZ3B8o8a#PqAH#vILC-=9F{tiarawe|CO^ML(ij^h>?6s%tZ z`!$YOaMbYPp#PkdEq_49yFoDq(1%lpbq78i5KXJaSo^uZ=Z z=%n{^@b%#1rx4JFm-WUvsbH@E_-|(M2lDt{=?8Mo3S4pruKPp{%)LT85WbUOhIuQz zc|@2#jbYq2@v2o2zz3kfMAQHi0eCp~XaaTEF#sNv5@=QjnhA_y-2J5hOfWmSlyUutHtgMIE=NYJJ9|5VTX-<#~yh)-z{MCVxx2Kr`%d0M8D} z3gH{OB6We>(_0_UB=fpJm0iGoSL}|^oaXqMNR#g?-~2=d&^;I_nHh6yV}I!CKpX)z zpicxkGlYz2gvVY)!5;^7I)q%2W?Y^h1dt#;N-`Neic#qzn|X2GQe1wvssT&hqp#;;8ls`E-OTl#;hrL%Mg-?b)LVDDG5CqiCM$CDTHF2@?~f!rOr z>+#KB*Be|>3jH>(ps!qfIp)!mSkPsNjM_+w_kvZB>ONpUN&D=pK?fN%Uu85U+<5}t z`*w6jp!2J~xT2_=?sfb8eT7T?>;D1!i{3f(N8loBS6>rVcLM)>3AN_W(PN@B(Le&j zv*)miG!VbkGiat(&T&}g56nCJQB!=D<%$}b!{O^ZlNslXxCILx>xt za*oxzd$N-SPfP_RyA$?|JaJXLs$Q>~ri+mgiBed;K{2Hu=DJ?Sll9~wA5h%&M7NFHs*e_KJg)JGeUK(?}y0x zE08if$3@nWo7>Dx+WIavgn91n(4GLBB!6|TtL@S=F;SOFhroTU0p0ai8_{mpdme9; zAFFP(xz%H=jTNVqifipdCI>|I>_7Tzmr--|9h6*EQKctF=rK(_wE1iwpqT~Y8@=p@7-{h@BsyAq_%i{SF_Y8+FL zU+JItXVj8*#7or*XCg{m9>O!qa*QUD`PmFDHhMGJpVXG1dy(9#C5oq+MtuiE9DN9e zHkS?%5&PCxWU5rfcuHe+KxUqF->I#l!@e#G7hjq|=-$dGuNYQy4y%bCR440y)2&Px ziN-F2c{W?V>vPA!421*VjyOTl-z`qlwf?198c{>owdc)+AHSAxZ@iDYZDBF;T9Erw zsf19%aKFGkq5f}kmRA0h$~3WMyafFd;oZ1RVga#qv|{@DW^*_<`q>2|DZDkmZ755T zc+>3T%PBVqNjKfPgcv71*`aqScOqIG>G#Xu8H*2~`vhC1sG!Red4R2pwj)*4)%dUZGVZaEuFH0-595Tv^cE}%vpNjVk`b`O{dg?!nrlSI=_a0xwmNO%%Hl(jOzGn z(S1;BH6!(0JDi&%E}c72am3Qgd&FpU;E!cj5mGc7`$q7qqyn7z#{SoQvDNtR6}#cv zNWjqJn(R(99SvOrXJ>M<7GFu8`2pe2choyHjb)S8Vwkmc-{f2?Mr6igH9P4q1uPg)SKC*Fcj>AG%h_J@)1Rp69 zPoQ`*y!W`)6-E1CZ@by%fmA+NIb1Udd^(x}W}5rii!nnQVJTJzST~SikhDL^TInmS z(C<@>kvy+`zr5CCF}4ijhC5L)l3*LONQYss5A2xW;hU>-f=H}oB@(23UjMxNvebKULW|+{C7$}*n#0H zt8*K=NKjb`1N&uJwUUE*kdVQa^V`?8hNun^bB7eA)$1|frc&^m}H`sEw z2wP^S*WbOkrRCbNLx{wtKa*4mwerfwePKe~x>t=nJ13i@?x9de`O@s7nG4^Ni=Xz_ z`qM&>{Nj|mmSs=bu(T4;XnfpJv&@Em50W+!c>+rYGr^?a$qEIQ5K4W%>@(mg{EAH; z1%?s|(2jmTTv0@f(*hau25Ey$c10OuuCLOfZt!$77u9|_mVy=?7v&O)kd{S`8@IGQ z$ZxcbSD$a%5^6VDx`)#pvD~A&;mGF7DRzUGF&=~OJc`H-k{V9rF{e`wku>`1%s03g zHP3_2Pg%Qgm#n7*-gNe2~Nc^SCT^OP6SbG(H zKMkwT%tWcYVw)vMcs0%8%p%NYC=yF&HZ1xV**o2@Y1JxAdR`)QN~A4$NjfO`)SV#w zeHTRgT>pYMGbWrn?fc0#o_QpgT(ODiPO!~fJ`H;Osh%vcukA)=yo6yPwQ%QDaD((P zXmub~AT9i&F>9v800vSvv!7SJFc&a)oD(=Dat?f$Z9FAX%oZDg_LRF5q>OE;IGlr& zjXyr%WyA9C?R6uJDeU7aJ9qFppOc)j!O=RISCrQz%kA)7hytUw!Z2Ub{p^&fkl8;qvE6z*4BrNS(h3&k-46SJjFELtnRZQBTiM>~L+gEMbv%pj-J-&r=Wj?r?61#-(ajt|sr& z`LgPzp+p^jLLW!?*V4ezyR=lw!92&Tt5fvN*x5(bOt8Rb3A6WI9tZEosN&vBxWAbU z=yv2)Kljq~*OtIs7Fl$IHCX;FrcZ~?ntT@K=~P<(in`Z@8H^3%1}B-s^wAIM1_HZ| z*-KxQ=9T>KPg&$3>QP(HRit_euo9AfuVOnNe>|WrL)&v!58o0;>mYzxpSiw5RRc9VauX8!T&a?4b3>2Z_(Z<6UyXvZqP?0P8&64|QwFPu%m{pYy4f9=^w_lO{GL1I>>Hw2^ zYRAUv`@?Tby}10N z=d;WU3VYV81B+EwVdg)(O2Yr%qEyysI%6=i40z}0>^}k#lpk~_(hi(`Y=lBE)uwfIdgovaDLXMGurq&J~`M6AQLp+=|C9+Ip zgVd0Er9PPd&J-#3_c({Ytq>1>Pp{n!0%7V$QnTj7lSt((f-k-{bv(4I8 zuA$u?PoNE@4jhX3Q>&YQ$)?F)dQ?-WD9=Go1Gaw^n&^i^QEhonUfFc8z%j4**#eXH zlpEqz*<5=rMpAaGW@Wd%g$o*a|1lp*c7r|O6>M%(3pX&3!-?+E;~KvC;|9G*6L44i zk=gM<%GYDzNp$UX;h56KG{~AGpZ*#@wKDAOk0%`p3ME=H`PWP#U(8kBGLYVcsHdmN zov5P(sVuq?kCrZE-d?6`UjKFc6-*_pLRguTK9*V?2)#>72^DusLr?Vx0xTHsWFS^= z4V3%T9+<0JSwtH)r=D@RmwuY+ifT@LGm+sx`5t*#6buAIUN3s~oTag})Fl%M_Zbwf zdy#kUDE6%oU|Hg=a+jN^+sGZ1C?Fi9ss`O5#vmv>#}4>Q{3Hwn?e#!NEqe^B=GwwH zOxIf#PIM7|Xm#4rt@w4V^Qk~Fo6=^Dp)^m;na!E%g%>^8)jC1#c028`ildd&VaSB9 zcFqsI`2KNp=buJUjp3UAwYj>wIq{CouX}e)sE5rsjx(NC+qw!01_bpwR=2QsH@57b zG1ttm`3be8rge6$i(}$h?}$GJMf;aG`UNb>-3BH5 zm$&+**UrAwzMnt7155AOqqZumTjyu<__}_*&(fyfR^k(VKhw93AsE_qgcqiHpE~sc z$J+M~Y{+M+0#aQ)&r5xwzYH4oFB$qP*N8W*=Ihpt*-oM_c)x`Y!{XdV1Xh3(g`~Rr zo;OQ?e;IV_U$XV@uMw_UVe8fd*iK?j=tpi2jnTS}agITrr9F{?|B{T90C$@d?E@RO z3#<`99_e)_tXU^fCn6)^Lt}BSV~@tr&(ip$;N6mGmonbpV^XqnSF_Zm>92US)}2UY zoqP>Add4Im1@4h7G;oY;wVucFj7j$TQ;xhI9@BIiv7R5M2%$9m0zXPI0_ z<-f&MI+AN;zc}8r478cY$DM&pPUzM}hBu&Tpxt!Ly;Mh}a`J@E@y0F2qr`ocqbg}z}U=;+KtL(X4kic{78Mkcm z^lkNN0=J29{A3vjAX4KaDrif{0v5jis52^W4e)aDzK2SJM-0Qx+f zv)9cUaOis?LmSR5CEdVIP_CP}Fnv)4eF#m+dPpEz&xi|1>Pxt1qCOuD4bBASpcc9l z6q7P3$y{YA=)Ffq$Tw!m)5e#7i@tPKzpDY3pvl@-xKg4v%r64Us=O1G?xw?6W?B(Ch$LI&&N8iF(a45hCMrP%BCMtkH*oHjz-`4D$N=H zTct|yM2r3|l1}|5O-KU2MNWvy?Im9enED;1m zu(SopBrcCwy)exFa4c=$Z2v=d{lUFar#L1Up+Zpo@{V!ad3u$c1m?E!`^%4u9t$xq z+r(j&i)Q27%o$A!=Cjq^2?#?x71H5B!Dus#0VX~4O5Rs_PxQcW58s^-Gz+yq9T@=~ z@KOgspJUjE)4J1)y&aN(l&p6kNTA<7Xx`myxR#)lt9+%&$Ylc8fX(rqRzuKm)`%!i z5kd7c;GQfw#N#W?qWW}ZPGd*B8T=sSU~9fR!7Dm{;G;U`5}0e+9;=1w2ZU_(2GLUlwDWrB*?y$=4!Gc{%*PK>arnYj z@(`L{8otOykyZLtVcz{y8jU>Lzi%F8ozkdZ8eM)4OIcZ=@+7zaA{Gb_o2q9abbTU( zX9TB+Qd@yYN#4;kO$qbk2i{GLq{I#9s$v_?*#6I~hIWB^!&-T|wSU97_3OrQ+9ex5 zjeaX2?sD=PY|me>*su{BQrMGHT=GgOJKXBQdZf44)h(O8-Q%j(PuUalZ&Gr<&`MnL z>>O|x{NT_gYq_;`k-}BIBbw{Ru76L0mJ*2~ypdch!uIk=ngl(WBHo(EMka1_yqjZ^ zlsA36sM`i+Da}dX4%1IKnP%GXTooQ>oThqF1!jB&{lFrzgPR!jGh^N;5q2e~9&=2=8ZXPFZ2X%X zinA!^VnkDd!M{ss;zf3tUrL%+@$ESg531MPW$$hf1yuokSCz(k2iKgsPS#t-W{W3( zK7k#rk7;eF@>Zn@dIp!Oc}~_Flsi^gx(CT4G9;UyZe_KH(|QD5IcdMyo$Dj0>u%yn z{*=3?z9GU?l{@ODuKlL{6Sbz>h2FzuQS;7KmJ&9P*t;u8V#s9oa>OR$P$PP`1be9A z!)O!U9&xmD=s#59!UC6A*WF0SJe(tJR~PMjq)~F90+rL(vN!{4J(BB2CBJPBWA1H~ ztL1J{djuCel1Q7pRFo|lNxq;aE3H%oazhG_69Y}{ACct{MptPQcjk*kw=8+KvosNX zlD7Pv*;95wEr->`?81~{jaQ`7SEYQ4S)wZ*E&flT zk~;*~32b>?zob?R#kuY+M~?VfW_$v0<%rq{Vxv2Z5)lf53-f|GEs)^UZIz+Ac~j zq}%%dv{XbHmy^s|yrPy5@c!OY!nEj<+(TY-A5ZNXi3|`N^`j!khoSDgs9c$?ffVB0 z`7e*?)BE8=uWSr9y|5Ek7J5hsnZ9=Esjnl{R<9I5a_5ic&dEvZZrb-5_aE7U zrAvpy}M4 z-Dk?s^N#NKjZLAOtOFoJXofu5NOF6=`}W_9zi<5CKv^4nT8}bd%noAxPf~MfPe5%s zx^5liyTHxceoed|b-xjAWgg-L)eUX3%IzUsb6F^bh9wn&dm+ zdCqhD)8x!^eO&=<6V3eUNbiN*TYupnV1=i_4Rar87lDabCFT12H52t&=heH+QdN)$ zi7su9zs>dMHCm7b+j@MgvhGO!`G{WJqCL?)CaAWJlC=4iJlyqm**ce(@FOTS+L>;h z`v=}JK-DO>(dT{X!j2)P`QTuh=bULLxVSSRI_NH%_lKjTBbxUdJ?(YAcUoCbyhV^% z<}m$;EE{WtDxksmyJs?ZPd((`?hUDBcu&)aHQrIE;Q{`UY`rzI(!05)@XQeJz&Kn) z(3}=O@Ps#(2E{DgU*Mc2?}tv0dHa*O<3fWt$ArgIgU{3KW#(m-sw_FU*oOTR&T0ft zo0FF1)_n$oU}rTi8$gR{a1LI3;lGetQq~8@#T`7zVZOP1W`8)0;y`3t0sl5d*27yT z<)A?}-WgfEhI}8?K4T&!Q*qeDp{=;zARDy&Qjs|NW&_#itXr$r1`Rgpw85)fiY=;~ zB|6`G5O=OL`Y~>LTSTIHrv2sl{)=hG-#Di0#Kxazw? zKW`8o*^Sw{wd$7SzurH*oIK$VTJsM=j!K%4)AyR5eK6-YZkYYOd1s|JwdSmD=I+X% zp0T52#lWn{kfXX&ZFhnf>nLJqF;6(2`w;qfDWm@rqnUNg1k1v?sa_jWx%y%tPHTdT^0vKm3s@Xj|+3LIc{mO*^E~PH>NnV|j$v_z9c+0%JvP zaPCM(MOFR12_op<=&b*Kup))Ccsu#$FMm~2%i?ul8*|5V?LB3411T!<^n#qRO);Kp zxXN!K&{5RbJbHGedGdJXw~=Q?IY7)cq8sk3)>>Gtern;WZV zEm%_KUOU=2_srI?*ex64aS8zxbz2tCnlsK`uLkq)L!T&CY8ov%L^rk`*;axY@6B$7 zlbt_^4jMgVo40dT?7yD8VSS()c3xt{GHtj%q}sV@{CMWii+8Lx`CAFH zKRal!p*xphZJS1YlP7AagGR!3p?~42IERk#+0ZEgNCk81jA+iaYCFj%9d#S2MpFv8 z%W^Ju`CAso1}u)khB(ItvuX1`FQf78ap*W_`jzE6lRfM7cm3QARp3SQPzy517UALb zQ*DCJcpGbuk{)LBhC0JGfi$Iju{P1VYO2^idd@D*fb9JpK6@`6UVI{XbYG+q zUXRT>&%!FN4#=LU`@_@G4&V$s8D_ucud_)^nNB3P5+xi_>0k9@;eZ^OshSKvD(FZF z-#!*^MAEY21_$-ECqP?kZxTsGwW09b+DKPaUmt1TkDyP~ShrgpxLA7(0@I5x!+Bt{ zNzEBP4pJk$J4DB>{0E|uwOe--36Z0x_;CCP(!PDvQ@X=0Skuv}1lhm$kz}%GS%TQ) zx_CB)HavfkJAuoz4+@Sl#L$ZO$Kd)hvPt42x4hvO5$7OB^ESyjwAd8s>^nE{cyrOS zBU9hr`{drL(21L+B5{`lwjmu=f_KkkKSrN& zSk+wEYgdy)b|iP>%CgBIZD-(T0W|OHp{?fg#`CzySKGnzUC@@VIkf6xjK7byG<{Rc zLcvJUx4z?|zs#w2^AP7V=lJQQWX7jRNOP- zOMiR83vY9o(mw{`%kZ=VBJ)HDs;rXm^*!>w9<Y<>O`w;0xg?z7G|PT1ldx(%9Nu|l~ioHN55k4=*sF5fhe zn9K|Qv6M;VtOrG>EpuqZLGn<2Q~v9jhdwED^TZXd!yHicMD+UbvX0-MW%Wyg3s;-O z%vljcdlNseX~kb+=sc+UPR!N^lfvXFA)LVJ%{ljt=$KjUBomor(K*T{SsByc0k_w% zY;%Iezq}%rp?|CXu{24@n&v)9F*%)I&)X}~id`1&Ya}u-1$A+*h-v*6Q=2f~64>zC zQo-&2IN`sEwvax)$Qs;T9J9+HOQN5&+|tZ#mMB&8S}8#^z2cr})o5B-m(IWKahSJN zn^nPR63Teu)mrVZE>v)KQ&PP*fO3t%r~ISe#^3BbFHrBdn5A21yw%K}yWhFA4$oP& zNoG)vb(*`D?C7E9lFkwPx9_yW+0*GxM6dG73g0+|Q+*9B-htzh^_dCxM^(_l<`k|M z2XSc|uZQHY9q8-NH;VTkF^m+q?)&j58Kp4;c!PGTS=kty$ zFH(V}yIbn7J#sz)=@x@YXesg!OBtKz*vAXo)Th3*(Xw&$Wo94y5%v-}N9-`)&aCzn zRUpHyc?EeYp6%4h0GlK3UlMP@Y)$?!;VD*Vt>*FTAYb@D8FsghKX|We0c4FY7bopP zZMg}1X4OUYh%MjcLWYih#S5tbKEp%tu&qDXNB>IjPy1H`-Qu&s=fAKw(8p1Gx$R1l zYb7UhR6a}_SwIEQau;z~`L(^5IQh4yu`5c+U)IyM+Zj1~1E&!yd{-qXmuLKB+jvL^Dfd5< z$fdE~n(K1yI=BO|*jl$P*6K)-mEwTtwe=}e^#_36g#3f0Cv_{s+5%7Ky|}&E4?R)LLJT1qmo%U{RHTKr|l`j>jq&Eh?3N9TN2O~@X5c#_We%z;T=YukVgrX zZxcB=<=w|5x3WC$-uS>UDEU?+QC|KX-+elsC-TXURyt)a%-dTomQTiBajY0Ys_^-< zgmWDqFE3rMnQBuhC8J~iJFkQt?^F%)EAMpFeQcoWm(-sYH_G;jX-Xa=)p_`m z75Dbix4C&%Lq3Z|x8)HUqaItO1G3n{>8-=WY4H&Dobm&hdLs{hYns#Nlf$bW>LSl( z{pf^F|MDMFqPpRMyG4gvSkbfl^N7+M&tvv-O`#{b7_i3jaJ|%P+0i3IM_|!8R6uO0 zGmC|DyQ1vQA(IyARSP@v>p~%@!~CW^G?i~BM}_g;Y5KI|q25z+sE#fZGJS1%*_*#a zh_cOT_b1*VI@c(>YY6Rp9(ZWZIi zhwo%JX?T#{7d)y|IB(3)0PwqWAHzJj$J=v8ByVJUTH-W(E|Gu9cu>Z=CQV=`M@@^I z^RCGq!HaLVt~sv6YbFNnnyPfIt;y)*DjaGK5<*B)>E2b-A|ZXYHbn#M+?o!ZF;=j? zKex7_7(>Rl2VTe7KV)$2K8Z3ns)}E=Nj$di@O1xEmJ`yI#`X`u@32}J=B6ji3`nn}TVCnoiZ(#lr9h?DMb=EJ zX>Ct>ZQ_sgI4pUDMP9z}>*;;2yuSM6l&mibe*||s&bE{O=IQf@mlBtR@?=838{o~W z=HRg>Eu^xou6<|3)LP%sGp#c(OP)3eM_tFsCP7a|9-qNsc~6j&;by#n5G$5P$NoH2qwuw%al)k2W{8Iq{g6? z4r-^XatLq7fh`v z>-e8VA6>!a?$=hLl5Qiv_Wkh}&nd$0xqU|*Wrq=Hb~AWd!vm{%=2|5_-2`tpSPy5j zBodb^obr=OumgS>qi)wiayFN|cqNLE;4y69gVlKADW`4h;v5(0Bh~2^UnI__Q#;n# zErZ(s*6Ef>8I(x@D(w9h34L<9WfwV{OEr$1%BpXWl>^@7xQ)-*Q}Y1g1wzNCNfDRr zn6-Ln5qZfPIIF??ILBvpg84rITb##QC6U>-o<;xycAGUl%;F@z-})J2mDo3Y=i;;C z$)d_uRt#F;(%JS(#a6?ejTv``+H#tmP(5!m3r03fsrC?6?HbK|JCmDB>&>i_kl^2v z+c=tIipG2}>s#U?1FpSsN^|`GIJ)k5w%+ewtx@4c)hddrT`fiJk)n2uQngBIZ>rRm z_|Ouoh}GI!s%q6%D@KgergkO7jGb5sk^Fpr|K0Pt_rC6V&V8P9?>Xl=@3%`aP{QES zmi@dfOY1b8SPW!PY9O=4ktO$1;e5M0B21AKKSjg;S+^chwH%>GN|c@5TfYTK9NS)A zOW(bSh`m~JS~AF|#_SgaBV;UVaf1nQwjXm5i? zxCZZ!zSKZJ|1g(NeR9x?ka(D@by~T}O1G3qzl|P>x7|N^W}KE1$@^~WqBDJN?|(kR zZhsHqhJY)2+3o*NT?55+Bx*_=`F40BM63^>v<4Sgf9XIl{>!ISd^xCo>akhy|F(@( zNIClKER~+PqT)7b%Q`e4i+G6S3lOt~-Mc{d#dCN&MDGS~h#36(LZ4IkUAVxJmGx(l zuIPS?7Au0kQoq3|_x4}-BCG5i3UNCJT?FLRzigvE54ZUGrD#ACVw`mzEOLC-PEBO% z>qKQ09ZM)9=V6&06BtJ#zIA4Ms`Phy>3UkGkPVD%PBGx1=M5WRbdd=y>RI(`wDK2ahOq>K9Y5K#Jc@7Ag{8|n~lE;dwt%L z*t$PnC|pW@#BgaR{UUXSZfi%L{=Bn7)VJlzoo%+-%Hbq%Qt|x%y6G`~IBT`rOV2`C zS@-^b?()vBJ!955Gd_0upM7bHFYWJzZ+;kf`+PD)zn+Rd2c07dkdAP}T?&7%kHcxe zIxKC2BWzc?vSlJfJyX7WhqtTGXCu6%?*=^K^Q^DO#YUsJ{Q3{``_9;agUWjN zDPNpzWr}l(6~jVX!C!K65zqz^3}|(TV6I>lr97Knt+!rRoVVrp#OWy2j|6F1b=WGl{$GOE(cI>^3>Udar?dA@E`5hO@Vlm zzv83wTOq#seC_Fgr1Z$mN&@%))_$+@7UfYi-(B>`uMv0Ez&C;z7_&zRzqf3$AMJY| zo`VNl4!9u3fl5LrW^;}e7a2Xu4eHxp48UIeDyy|UeX0SfU;G8~#uxfeR1c3XYC|cF zc0rThFSUiPT789xXHz)Q-=ajRkh|v+*?%D#SM(I%oDHcq+KZ|0m;(Y16 zZ-8@u;qbYSb8;6(8cv`q1n>2xOX@4-JC&9%$tR#7tBK##e94)9%f#DDL< zo`$5aL$ig+BKFZMpIJ`~r10XE3Bgf~LM}$x9SgqaZ0V1V4#6~Q+ zrtdN8)m&mce+=%41~+JG_ks7PrDx-cGwSuiknAAXirPz1+(e88C+aq~C6Y5!Y~MC-e$42BzQnqThrL_qE0 zcaeKHD$AdcZF)m?-8b)rbKf!PE5%tX_>Ml9>!3+?s>(Dv^0H{V_P@6#)qA0)OG+D= zyQU(XoPAnZV??qxZE>lD&SP`Y+V(psj@=MoLOeTqmd7O(cMWgySzSOzB_iaYBT*?h4q102k6@t(<=c3(s0DM}aD%D0m|>qgd59%-?;vgDx z{$Cn!zVhZsP4j(_w6FoW`QH^$@O=Z))bQ4Tw?ziY&s3Ssf; z)#-;)NCL0YmQvDyZoQJD1@#^f_M|5m`wt|B4vzBC9UWB0Xd-$!@_s22C1aK(mCTkp znhV0{-d|%TZbFAB@j|6X+tg#cr8ql9?&ayP2;fY->t_D9C!GV&D31I(@f3URj{Z{} zj|d1)M;AG1lDz3~?8Om3K^Wy!>9S9mAlKV?t9bD)>XEFy<#JgCiCsN&qTYtyRJgIn z%_I&%;z(hw{zLclNcrZt$9d^U^kn$%%Ot|lUaiUe*E>YI@;fSn_DL)dhXLdI%G#rb zPThlF{u2-={L{wr$=5X#z}Pt?UR8G|c+I6#z${~$jtX_B{0Ip2hp zFpf~t652gJkPN4xw4oC}go$HsL#oAyg>5{S1$NNMb7JUmaFgn}=w6MZ*W9l=xB(w0 z73-5bM2SAXlXsP+f9)^tG?mXWYlQ=oCeE_~8^(F&Nc7;#Q$z2lCk3{$d9nx+ZGis# zTwr-e_T$}vT69$F-}p$ai?lhw%)_kw-E4=-j8Bi!JIlT>Za$Hw^t@I8w(4%z$TAL; zEYB7_n$am_Tle|&o$zUE$QcB13bjAZJ63~?z8z&>W!S)6u-K&3^)&y7PFi*=mWrO} zfkpZV^QFj(T=)@Y_I30?YaGLuEh11HvzK<2p07tc+cLo@@r0vab4QN>Np5D=BN>j`+MhsUnw2zLUlD(du!COs#LWj8O`?<7v>L6GDS8C@QC+@(e&r{M{R>L4Z{ z;V=&16zNs+(;4zF<6CmWXa40#4*i4XYbegy=e3=h;g(qoaM~;0N~N!A%eG#3BMm0w z#0M9(kwB(V3-)hU%*z;+Sg)T}5QnNZ_EKDcLTlnmp3pgK=ZUD}8qhd?eJyObIOO`{ zf@;In9fLrcUb$=%w!u}l6bEGPq|2*Egnanz>ftSg)N*v2kDc>F6!wIG9wt*h){b$3 z>m4I{&t#0w!6H3pAH3voG2At->G0y7poDLuKgL0Ee&wK~jT&sN3S*)8ar&~YB5x^i zhj!S_q~C0YG}*8O5Lexr?lE_1F10YX&E{tdmo%72azN!mbzoY3`^@qjU4$yYM^e=1CCuisn+BHK1Rj+S*YaYOzrzd|CDV(3dc(Nx8p} zeURLgN~(ReIrsf5dEBz1^uS9z!mni`9(N;h$utMO-4zk%1sjJa8?Rh}o|fXqbH0t{ zeD-_u&?Rw#ba89L>2*CKg4L`4TkX%u5b^$6lfH=C5{PDlb2pwMzh7e?AgLJ`d4r|f z=P%!zyB)nW*<%ar_k^i&CH(;B9h^P&bUZiDao-^Bxc+drHbx7lo}*&1 z6gC!Gy zZhL&BWWn#$_K-P2a{4IZD)lh@^l%6FdN+{}TrzeCwCbB=9$r-02q9&yfv^Fbk&^KT zYU;gv>}5v{D>xp>Kf_269-zP_8u_1IL~})-K175AwEG>Sq7M=QFO2X|@=&7V=Ou{fGs^#h||q9C(`|e#$JJsKz5md~go$QTv%n z*Nsx~tCS=Lf9mLQlvd{N?l?OXL&DE>cxp#qz(kXiPd`S$QkauoxpaIJf;>}wVu0_# zO$acajW*3>x^g1(UjWSeO_gOHag>hbmpG+eY zbx(h3vMh|PB@R1dZzAh&aVFh@TLB8 z$W{Zuh3*LDgKT%^UL>x?fNag@Q#g>E;AXIsSnsV(o;37)%S{|>%>9GfeHK{FNlKve zH$fptF30?csgCC96Tdpr3z#lj@~E?z6U%1IME)4`MXrTZ89w!(KghWgJ3wp1OTRX)+;g8fSQ z6?C}7K~!1r9a+zA3|YA2 z`QG*XmjO=j7RZv5Vc}+_F(;F^0Hm%Qef02o8l=6roGvt{lus1$K59sxL}&8x-)nKh zaj29bskhjfZ<&7**6F#xD~g?JGT{iS5Hd^!%Py1j@dIU|=s-WE62BxuiPm}fPG0a5 zmZ|Ct8m_pf2b{ugbNGiDo*Q>KT$Y|3X*hnk@QFT#-}1YVg#oEuu zF}Ee&L<&Y4Bj#C4OwMF0ISU7_m}x0Yt%<83y`3rX=Hv#j09e-eylt$nrsY4ykrXJT zSs%E|tJs%E(Xdo^f z%~Z3j*iU~7NokN?CXE{MCCWJfb!_#~Ac-d3bFzBEX%sPQ%?@h&O#cd;BaqQhSHB=e zQP5zs+fwkLUXVq(P^Vp06MsaXCRb_xVQmbGP8cWl8K#YWVNue=8+J9968F3qPTM$e z7tl>xp&DKfI|trJFwvR6JQqtsl$(3UBrw;dMLc-IuUf^~gt4WQ+_F~F+JLqfg>bw4 zCn-s+c>3B@VGyYB`U0Lc`xI~T0=?ZWVbuT+o#*ZkFg!|j0<04s)uF|`-fzCIVsbXQ zF^iF7OBp>vH4PS8y6kXBdF5yA14k0A*>X>Xy#!2b1(Bel={N=0E>_t_lyEJPguM^` zi;~)3k?jj}KRv0-WgA;A#_^0fz##omUydK9@2=hw9Wj6bk6rn)1dct5E8)qbFvz#y zb}t*BQkGKHfna?~3b!QHrNk{Gc zsDlxJU&d~@LRfmw8qniq$OnbT&&hW=;&{RM#4c%3nX=SsErnWY)gZr zRB;|oO3@mmQRbgs2F^b<(GZm6FCv7LcM$?lGg^G%Bw5%~lHibXbz$vm& zM2Kh$2jFF1NntX5@oj!!)Z2=q7(4dU1S^q(svtQ;CZ(i8vxLx%A z+WePR0r$0~)HqhW$@1POJrW~fByIiFy-&jU4rCkBY= zr6JBxOKc=f__Cn0mbb)S@rR0QZ0j;`aL1F}mMF%7Ksd3FhmDI$qb? z_bBYkju0h%r~S)@nTFqE;Blw?=1p##PdaIyYsURRIFU3V03O;FCVK5}88z5kodQ%8 z7p2%VwpVcA7@)HE*C^7w;u{^3^Q(fsTvs{pXKNmQX=@aI9O`CY0Yw}(75+MbKkAMX z0D7WyzDVJKym^{IIv7nXShFo9&_Lnw`&k%}??w|FUSs7{aL7q=;tDm(wpDRdEp0F?n?5o)DvVon4gk|(z03aIP> zlIK=-<{IE3`@2Ft?UJJ;Xt?;7KE;2fXPOxEKQ7{`RltHY-hXNM!Ub zuba?Ds~W5G!G{*(=utX*{mOTH)P2pm5kOYwgKmyrJ5GONs;d9WJQcakm)46-bzWIob-9|iF&|-$Envt zcp&O?A#W0U)^WYTFKJi=z<==$_UKiDh1-}RNd{AdFrhG!PHRLm!v6~=Ym113hTF63$$h;0B20c&64IhU8++%I{>UUB&J)6d_+~v1rh)ns`InG}`#_|MXA_UJZ z-1$Z-Jo#@enC0#1TNAwPo&Du(`gF7@!l(z}-u}VsoIwcw3mW{vkl|djLrdCXjcA{X?mx=}bA^Gy6~8P@ouIm4-|sf3*C$^$QlfQU4+<&iKRPn3$qjuv z4lVn#793LbdqTybI+fI4bLeXTUY7GJ$VTVr_{&|h%*1R2{fZ4+tx}KHY5$+<2v3>_ zcfojOALk;ls@yw4l8xt~a9S`bJ9jx9YhF-B7!v?;!Joc9ge<`YTXIb?{ zLb|DP&a~Iv4#7U__Fg(|NH%889;5P=ZT1F^xMc||KsXd6rSU&R^f|G`Rq!2_Mmn;c zQRBSDKh3%>8;>JjUrodz5xD14lvMr$Tq$%`&tD2o-Ff^Sk$ry# zQz8nJB44k$e|2KfFzBjbL=_zo!y4%ZjegqMtm{R=uwg z_MKl;-R+`8@i$b;!2eyn($Ji&S>9_zX{qAxu%GV2MEva zdix(*ytW09X=cq!a^+qnan}ik;*!hBf0Yz6atS%2*WD&fsEsEgxD<0o`3aii7B?=Y zc(1FJD4MHGuHN9G?s)R+ex%qhy#(_{u}G!ImI+RBkM?K=48X<%--qbp4E%qcm&DN` z{lqaJyJyVu`gO1eF^#2)pBksEH7!aNQ`V>Yv}z3e?}3bF8Pd>0>cyLr^;$x4+U@#y zp0EebB@{-No7}bKY3QkJhrJ)wOZVU_Q7VT1{USXJwVEoz?g-t|lU43Y-WFF<;Y`Y` z!=Af1(O*YZ(+0@Vy-;h(|HvHy)c2p^i)maff2)g33Dt!=f5tS(F)AEi82bOaHI|8K zkK~ZtDa^!l33N*I#V2x)oqtR!qe*VbT085gC?=XG<*fzt9D0fyFLCyRQ18V*@nWKg zvVGk$@Do%9W?8`3iBANM-Qe@9)d$P6Kzz;qRThqzbnMPt&q<-$tR1Y0^ziyRJI5{H zj<``p1>^7CN6A<4_Ss##azp<2`K(UbLq1>{?tz6h{aHPA4MNrKv(W)?$2a@ptvGS* z=`0D0(F9i^%^kZZTkDCFN{pBXFB0mf)x&aA(lMv^?QdTZy5Y6QaG=r_I0ZAOp>Z^4 zY;T;vlhopogwX`VM-Bs1F-(FeaU!7o7S8}B4Z|TAu0THm){rz-IrC_HRQmJm8ybvjJ#v(p?zFD1< zJ1Pw}%=b?z?aU_qi#(`~5Mnxi)Etm-iiCQV)am<=v%8i)uM40fS;~l4Wi!s0C=Y0; z+TxG?idw^_4Lgm)8lw_Lk&;SZDu>AagOay#G;zC?!OC{?bTBjrLaU^u!6+YBS;>~o zAssL%xkbOpdYX78;HbnU_sZh!ypyg3|3!p8(xg{mmq^`Ls(ttQ>vR$u3E2rvFHpct z!*~gQL!iNl15o&l*MG)mHfXETE)7mT>?$?~AhC<4t^>rsN{c8HTL?7V}?3_AS z$-p0diyuZRl1#RbA|7#ikVzk#Q&9KFPr_0*6V*jV;3=Ut8JOs$q&p~jq|{@~dzJ)2 zIW@fMFomX+2rsf!!9VDGl=$*+_hz5AW(4}DAd%j8*QZg;mbIHsCNOw1$a-$N)Kx?dL#`WUzU6aW_4HGq+FOYI+Nd4h5s8Cc%<7PJ=B= z6`w*=^e(#B`_U+B@qH!Cr%7;K4hs&HfhiDVGQ5~rTp^KX&He=-cuFpJhu><$v)Rt> z`Y%21>l5Sl-4N|z%f607oBc~WIHn>8MV7F+IhO!I3E}E`h3g74z#>IJl;KX{B=|LG z)or#}&tIvD0Q3qkY2nZ%nUp9tKy^LP`u^gQME24v;m9+Xy2{gf3a;<(&ce@tjkf1X zC=>mk5X`jB9(ZE6;fDGXPf$Z20+I@{dDG%e*R|#t+ z7F0ul6V8u5!}a}sD(==K7zDDq0lc=KXKidED{G&@8Fp%)D@5biC-uL>sUV_u_MwxJw7$MYAFtkB zqet4zgdD|_g~PU3xQTYpWq7l;-aa|h13x}TP&9#I5Haqs558}bKM>!QJWC1tz~`}l zqSIXvjbYmVkC?i}uJejN{do;+%cbAWuTSv!+wA6q0zvW$ZriIl;<=0+m)ZB--^nK> zvpoP!nU1Ecz4x__C`gv*s6wT;y;LIRg?zJ_eXw}v#x)7Xi@aZA5}v2H+pfWSyzS8W z{;7K|8v?I}Kc$9sQ6g2_PvPN(%M2r<_OWc}$0_sE0mB;@)T5Pp)aaol>eHdLpCO^B zSu#RzO~9UA{p#o4FOrZKH%ksaVBL&!nA0`D_1&sroFXb?c+J{tZ>*%Fst@g71hIC+ zqBU!-W8Ygz{UMwj*L`JXfmgv-W@jpTC~^`1dniAW%KpR_D=gOe+kT>^bT$)XVsUC~ zaGs_Y{2{~o6g3W}JauO-sUjDQi$EkwC=X2rnYAh|V~XXXQFoNL517+bR};r2DTd$t?5z2<48<2w1XB0I<>~(S3njwm64E7q4;!k_Tm|stQ8Ay3!GY-|I<`oBjO6L>9 zj;);REpxAflx?$ayb1;nZc~@@0^QR<$7hub5io5$a^+RVS?%B_W`A9M=ISqv1=EdN zcfCqE4pZFO&i3kp#)gW`@2VokwuHvS${{<`vnDsW{iX8PR;Et&P~7>LyZ6-_2%z%wUp=fifO($6~Kq2NnM5PsVuDJHh|c^*7`W0mbTrap44jiL?QLyVlS2 z-*jDnfW1=;#$J%m`58?|*UbxnBajO%l1;`5mqSkHrv1v3_Lf)_gyguT9|hH62u^N z#{B_Uazg(WedwL=jjLeGhmpBVu`LSDl#beawBduKcQ~ir2FCWv_ZxHFp zj+3ERxvjH)bF+VwW$mJ+EuGM#95&Gs7%{3@!Q(1M{2H3J>poIXGEBc3bEnHB@uP>& z8qK4Gfd5+l)5eP+u8Q8yy57kc6`>9caW}#HG5Rv(+x?IPQ?-V&Cq961G zs%ulSi9&PtwOa34ZM09!c=p)XBwMpquz0zrbs*cK46TLep5_hQhd9hvY3#!E$riT` z6p--ovW*D&{*ohK#NKn|xF6oWZp7!4&Dxb;8V=wt5d+5D&Y+}_4vlkV*(A8NNz86J z%dA|W2B+NZf6`lbX>q-8!IJr`__t8X;(<1A5ASk&0*mpT zA+H^HSc`W)Sq5|OE%JDNw=@$3yZ=04;`hl+#Z0ViEL9EY7c#uHOqnKeD~&rH@RZqms!1Ij1zqm;d0qGqNZ36?-7^*y<$MX(3I1RFPw;dfLgIAL zW2z%7k#dDI;$83M@HOUE639o%8>OW-Oq3`c+#AS@Z&=C>JoPp0Ti;97KFTy4zr7Vl zo!ru9{O*hRIjvu*F|Lq>f5KylU{ScY9@Q9)={5fFK6WM!Vb9E;Pkksg3mS|=mh!Y`WKq3?p%;m zR+U8~XA)H%%t*qBzTwrtPjB{DJB*aibW|5h0uqfj?t>SEehXk!M2NcaR=o~OSivfl z$dE@Bf=G?3jffoW&3|WF^b{SjL^kFl(SzJueSSJ57bqs?fZ6D<>En+`mKs2Z5w2NF zyPa4pggv`nz;|D1b#8nt;w==TEwIn>^?jY4`)$A5UjxDr08KWNAK)KcQn$CCAG!Ph z!r6r`ULppfOKMu55Cr(SN(ir@i`31jl+VlR1wg&Ml)0N`6cT&O;25o53e^=8gc_#) z`h2?p)k2)0FW=Snm!1FI+S{qPfzTUN+#rR&W+?s4<2V*S({eSpisW{%r>%w{*mBQ! z^#$*m^n1p62`aFeuo?`Van>P~(RUSg8e3~c)Ynb#l%-xWV}jXXiCHf?ajG8)5eP28 z-VN|r%Vz#yQRHhZCPb%k_AlN;i&$n~=u_I_ z7ErlAwx*%!RpiPP1TU(J7eV+p`X6LpM#6lCcl(H2-9( z^Mu_tqZL|*h@4R5^8ec*3%Zn;^j?+~=b4*+xB8YzgZ-h|3Jc8yP6=n06|g&9d&^#0 zQpEG1M%C6Ro`Kt6dcC!!P$GQF!6nG1vojlJ`5I_}yxe^!{Lmdimmx}h`R$$5W%Ik_ zK=X`)$?S|op&`ra@62M&VmgnPKN@^;^I%F;zi5JiPbr;fN+g^DY)8LvX*kPo&=Kq` zHDz4N+twO;p(YJkvk16gIWbA2d=5ig7}>1ef>bba1Ujt4EbRooyj59;DrnAY$m>OM z>Zx|S{kebO^>Ie85^du`ixc`2hq~s%j{HZZVBSRE`t{x5kW|$Kw3dlYP<{Di+0V1_L*ujml&OwKit)bp!baX8oDU>UOm=^kCNEblQ;|4Q% zfiQeNxishZ$px5OQW2w=JDnb}WwmFmpBT|XTWM77u@@}sqVLie4;J=m0NL@Z%}$09 zzEI%R(?_6b&kLG{=1aH6R?SxhGe0jnPqW4Zq`RJ1i0_M6C7+RA9OC%6B$e zaOw=pr{Mz-;|eLV?yjd1>7R`ku>3s><-)X(v=9QnDfCeGXrAz}dOCV@7C#kLEBWQ@ z4R7HL>V(zC5Iv)uNck;4I#y+#&baZ@u43yU|?_cUyzClq@^k!*mn}c zo01$<;L6IIYviwqIbV6}1KL!64O#NR{$raJ^u6ga{hu;?&l$RttDMvrFj-l4^srY( zmNMWb7qs7Yva*CqtM=Ph?Oo_qQ@cC*YxK)OtdA+L8NfY-+n6KPC*w=pfzmZpWKqBf zFC+cp3LJJudFkq^_Vd|yyiFR8ls|YAb#JoJjZAq}LIV+;`~auLX6nfnSkFwQO_0h5 z@93=(rrv`1^uB~b?Fi_PB-OXP_PN&f#d?C|>ls*G<#!y|M`Vb&OfqNUFlJq_KD2R= z5eHO1>eKTgzb=tAF`VUuKHm^tE_j!Qy}Kj1F`Lv2-egqH^~{nUs!5lAI$k03^I}nE zf&SdI|LvUli0IO%q;7Cq(wFG{FSWz`uv*)3UD*v{o2;Itvy+Y+#9F6Acb`9FLVNs3 zHmB=oYnTbw%;iFJdGA}4pTzTVsNKgvpCfTUqBi^F^vPeM{Zl)UnHXTk2ukUr^DSub zgTSWa+IQVNWv{P_8j^r{w%Hd2hlUTFW0I_@nVUAFlg6k!L|4rzZtmvN6oFSi)Cw$G zFETS+1G4}GxsTp2>|fa*|Gs?`4~G)x+40?YEu9w-U0S=85MNp>{ut>_(Sy8tDHTe* zLL9kx_P3IZ2JDryP>K*V9UvTO-GHiYol4b0TzCs*zz#3gyo|R3^Osael!U)D#$8%w zq!zIZ9h_C09i@>giogdQMP!j}ub*cf7XYk|AlY78KUgpH59oU;KnYWB@S?nvJt87@ zeA?74oa+HLXvuUYtc(rDbszQhF8eXvA0@vMO&LAJ9y=!6Q!E9D2U}>t!$-7$X^cXF z{kgZl;%`YYP0Y`H8mB$j88;Iz487DWx%hYgSSUq@Ah0V}T^~`CQ#`cYt6dSuWf&J1~F(glW%dQX~ zSJa*N-xZ$cFQ1s}c2l%E1@p+9{#Yp;P`zthbgO z*P0nCZE1FSZL$pIwaxuQ0*kRU3l8CZIXPYP6LqNkGf-an#bu9e`6Pj4wX~6(R(()Z zaPqSP4s9Yln@=UboX@bQ_4rt)-tpR6B9N}fpsnG1gFc-=d6Y$|AeLRMZz@0IEA}*X zfy%cmgDw1%<1gJX!{3_V&zl#*DmG>6{) zd`uy&W|rel88W8i05jrPsjay4m=!NRQQV^B+(KU#OHQ497^x8RhgqUyGBiV}1YPEB zm>m~<>)n&Cstl)SJ_h1Yrc23KS%%T=Rk}%>cmU>V{lT2uzTxPN91XdQr$z6Kk>uD6Tj{!o{vi8r_B;67C6TRFA zjg-ghtaAaQnWuRH9ln3)qRGNmBXAa>3qFKpOpTi66`Um~J}+dEDVRP6D1 zcb0xKC$0sYx;7^l-K~okr5OluiY__(81gptIJ=DIf|Of`+IxS5C+e8G z#jjyfT#a!ffoyOT$Xr_60xvKF+Sz%02Hzk{ls4$OjlS>5OvY-MZrl_LVEpTrC&M~P zorbpX$oIW5s}PI#?Db1-@Qxt zFWL2PPi6#;AeFYlE_WJstU_u$%#;dCc%J6U$ASBUhrO92&L#~~0_jU3tvCN!T5-{N zv<}u>e;;Z)p9i)iK3uwOrn|-O?NlqT5uWw3wWlL;k|whlo4rELF1?WGR%?7C>HT9j zis&EST3;ue9GPb=wR`b(oQ|d_DPp|o%j%Z3i;i*)9(+!-zIvSa2OlU9;wt?^*F$U- z;L_Xz|5C?~a^pXq-GA~4IZO%vvDiW0*0D0T4AY9T93sIhl<8+?aQ1>$Q#)O)Im9cZ z6bZlfu;JXF`)97*VL8?*q1$n&@Gj2bS7o77E1k&gn|==~M|!6_QP&#FTHxgiec`%$ z8yz&1j^a~Rud_ENKNJ9e@~*iU|9Ae}-16zU-rCs11@2Ls%%;zs*}u3YC0 zW>e;#`qQ4U4!|F)10%C+t*;m1y^ZQzN~I)}ElycmlZW!IUCwpN;ugcH+QcGS~y zUgh4l=GZ3pO5@lt6IM#_3x!a%>BhHX@ALvAb(de*R7`bilcU$abvmv z6p$o}-Ev`0Z~Y=wVYG`YIc4l;`RISjk{=qLkw`Ql-{{akiwu~DK1*T>>2nSnmTU%&`!yG{0&&0*Sq)le0O!!o8R z3Pnktzp|WBXyZ#J)TZs7L^svDPL5>85nODnYlxs`dV5;&1cm}GM%ka4n$$S`$ew-h z*YfXCzG*;>&X0UcrN7hRf`7*e5`DJOf+5vF+8z(1zM7A%^M=g&B z`7x3dXbQB>i?az^_pp@Vn+vG8?(EW|KW5~>%wzIQ`4~a;R_o z67zt{CT@{N{j8tX-R@bt(9^o@nE$L%QdIbwctZR=tVi7&o*M68d|2!2zPC$`_Pe_= zsOWq7DYH=>PMjwRMWW^CYf_OPjy10F$4EcjtQt}iK2*oPzYdmv8urbPnl`NJdIP7X zs?7N3-RSFnq2V{y;H)?kD$lWjn9%mJ=W?Tn;@pIqi+@RC}NCmj?YtJ)~O~bN{pAG!cWiDp@kWQhrl`Hl@BF9`=_cG zzUR|` z#OOn+4Z!B|m)PhpsBz*;-?N*N^>tc{HPz>Fb(tc`tma^o;5sreb7y@Jdt^}p~Q{_A&! zki)(B6z9rlw`%;^js8uy4Tla-m%zgcx4`2Hm%!6nR8O#(jso1DcJEP~+sh+Pw{cX1 zZod?GDkL-iOV^>Ma?ON;?(b{A*h}uozk)9)zxT2Jo-4=hS22yrkI<>#FZpkq0E=6(-l;N2w}7-1AnlZod<#dcgi_F zzP$SeLYveXU+1)4zcEHe7{Jh zhx~leZnVqugb4r6+j*l?8u&hE>TEpZI*%TOe%n$=Pu;MBwg&I2G3oEek%yUPfHBVm zb(h;SdyH_g{lg^F!z$g4f7L0dTIs?vY=b3F+vbOhW8b`-uJgex_j(-;_15E z0UDEB5i}vsfuAqa@UgUCbk!#d4|8acS#Y{`$j}>gW&WGn_I=CzYl8fQLY>JY6u_oy zDy?cVd0g&50~*qBm-|dEIV2%xCXw_$(Q%i(nXisCW5O2G{ilD^ifzj8>-$(hbC97t zRkjsZqT}$Z+Mf1L+RE#eBj=>>dewPy4w2}Pek`bCn`_OmQ{)`*_LG{AUD`2A^)JZt z$!tRZOQLIfMCm=08wbog;3w|L)eHZdS+PP}+V#k)<_OP$^}FZm5*p3trA+`NMi_d_ zyW-Pnv3Du1$D6;OPwMNClJu3+g@+f~oAi~BplzRPV1Bem!sJ?gX~wJ2Pxh*`U6#A% z<(g!j&J5ch*qO}{)`$01-q@S}c>LlT5Kr#c2G17VVRSfp3_<-H6?g3kvhNlu>@phG zZZC9Bj17s^mlk-HdxH{Lptv{@gnzdXWKU}*-c{P5cHgg7{v)K)2*a;=e(g}xr*%+^ zlqS!LcfP9aahr0JzqLsTI?Agq4Lt1$S>_QC=#F~{EBd9x z^84|@>`8?MCzQjU>il(2Tf*(+g|>_!sO2p98+rUmO@$6x0mH>TFX=lI$UMZRS{9U- zG8vTE^xBVc!z=l}2=)^8D9by&&rnkR=qpHgX1J^B8k~pu-V$qQ$kGER>VGQHHFQbq z&Kt>33Qlx*#zI%`B`Zv(iqQ_NZm59=?kx^_^*fMbY74wguNBG<%I`y^6Aomy!nd8+ za3VZX;}PC1sG#1gh}cEctd1#uI&GxaEkUh78fGH*LrsMzF_b+fu!Ke7$)H=1u3)0V zU`Wmke-{G)AK5ZCxP9sQ@76)*Y{b}-&uCEa(*@d)Tw>?A$!{l}IW^gSzNcX~3B?{a zBk#2P#{IswZ@0Wp^FK}H9;dV%&eF!Dmz@~on>9nLFd7@94gYc7PEGF$qO7AzU`f4tyMQ$(arJMFBNWcWD)dN=t2^~X#^TS8)2Jz z6tkNI2Tzu)k2bajZC5A z)boU^B#HO1QGgap8Vya@Ib@VMgW)Kwi>Ez4iy4g={j&j22p6G|sr z4_}`%;!~>qHaznC0hmAM4#-YFhQgmx0>Eccaa(I~b&049g&Axp)NpIfO{Q95h45T} zS!M^fF0w92{woCJS{$~yTXVIi5D<}XeV(?XkegZ3SUV|541wnr^3U*&Mc8?3hRKGwAwzo0d*nUrR?4ZS-?g04y zkEX8xYP0FW#U(IEaSfE>P_#&aP`nhE;!@m-7Y_u7V!@>phXTbu99pzka3~at6n7_R z0wg#8oqIF0Zzg$VlHGHj^X%@C63Kx;*$-UN^(#`o?J}#f8)V|ppP>_T9^byU{|p*G zwOI=Y$%8hB?PYwV00#_cB_>B*f`%pp&#Y~Jd@Re0JB{{E-gO+y;U2gH5sWbtIFN}7 zb>L1||3mF*Ns2*Y862)kYKOe08Q+?J2wSrIvW2SN(+lVd`o-c<7$e#f5SN?7KKs=C zfz=G_YPM2$%Jpsj=9;DM$VBj@Sg*I!7x@l@%}#?!Oo2I%h&+};1fDtm>3@`Kf>&t7 zUeKLfZh&LIuj9K#A@Sy4H_+y+J-d(Hc`6prdokxC_dWNwy`M3Fvfeqqu>{Ot|6$^| zhrX|M-&;R>d8LypbcnpU2pca+rtR;F@S6h5gL9s~;rOcg-^L(jZ_n@Tw`% zH|8#x)Uz>d+}vU3LV^kU`6`Kh_}v=a*onu-n2@_mvSE?8l|hcEw;P093Z~7Qg)ynw z*wFu`I)vbH3~u*W_fsJZGQ~;LLB<`uiJ#EU8ysA?o+3`>et})Cm5~LTIwi=28)sP)jaUB-`iYY9e^k^@JY9;blZahbkmGZ(cWu~TZ#Qp=6xR%?|opx^-@#wjVT z$??sXhL|oLaTPFOcT0EQ190cGMW{Gwt}EtN?!^zF`)QmDc8C0dR-8EbnI+z1_e|%4 z_M3vK3#*IOLf!TWbes$Mz0@gt(YL3`^{9ZUM@ZW(-HDvXFRKH-lbDzKA+FY!>beW` zr!Rm6=U))=YY*5bezY!&ABsNd@$Hj<7?uOXFOVj26G+>C*{;x#noY!U%L4Mr)|RN!*@O)F9wXV0*VNa* z&CSP}3vmSwE8sV|jid|4H8IUFCW=Mk46S!*7eTD#bF6?%+=9oYup0g~iGrymir$8Y zNY*O4TgJn3u^(gffU8~VEvC(t?>4C{Qd>9#r%Qs{JZOGRjBD$h4V~rl6(FcFJNnRH;v#(XpbsiBS-;h5j!!(m3g*`K@lc7lq z%aRGg=)B6Jtd5F4E)-WL2NM1oBA;zfPkA;kCQSq<+Y?-rD=$mnGs%&!QYvKR(-|gHH$b*AanPN6T3|zNn)pDAy%0A?%A@OHKrc z3^m#5z~sjzruQZWWgvtap2eE8mbYzkq2?=CuizHOzrYFn{1Mw6XvK>_n2b8cwCh`3 zT(B<)YkHef2sq_F*0c3|&j9=tksCGEc%UAfyM8Xden4|C6D$a)!tRLH z_HHfwEpz!1iKW2NQ=ZHLQCw#3(KHvZr{%1(tBv-Hrir-*Y#7%H#aP(pwk81@vzruB z2~5V>>z)O%)a3+*@XLGRR%hLamPeLq4!YO=O0~`nz)M;LFtPI3rM7+n#E7q&jb1S1 z1>K*NE~r;cs~bHNUeNlhZT1=s3s&tKVGDE&O?zv*Ok@}`wszTGe*DMY zJ8g87_5c)1V)>44SVxd$xs;zC}RqU zJ2RKLj2-^U$JF&nzhQCzd3u$w^yD7WW93U*jjIrX(01cwi$|HLt^DU858aSc2_rE9 z1K96m+Y_azM`cg3LYvC+^F4kJ$rTUT@waV8;aX{r|71N29rO;LfMO6QV*p&{&tGti zv9Jp(q`!7pt2yG}4w%F?5yDt5{LnAFr1BP>)fF_XD?!)O-#H_3&SdwO5Hr6*GBh-S zF5K@#-Zi6CO(iJw9oM!U0oi|Q@vF%~R>5(*;g}scDelK2D!6Z-A7;0MHCu#!jEVFd zG{e*Xzy336(9j*xP>p}G$D?0(kRRvh+zY+SPD{6cUyRYHH_j|7S#`I__0 zxfQGdF-Yh{ezSgq2A+lnWYVa#%K?adWDF~1f?~<@%-<(Rh(z!-8KxG86FnDZW3VTR z6t<_x{F)KX{#uEGIE5%o8C#tzw%lHs62BjdPdMRM&D?6WLC$nhZ~H=r(Uf z^8L-}_xjgPp0zB__QqRsr!q9te`FB$Om5il)4-mQ1?iOC*J!;<=fwg=qyBy~vJF4x z`If^SW}7nRT1niV!G7jimZ{hN%l$}!jUmh0b-w+*|3)k((s0*)52093$UgY~I};`7 znLQ1cw)Eh7m~>~e+qh)CRpUITT=+Y#+f^@W(x!I#c#*!uM}DUketvcF*uC+jK6xS3 zgpOFJ8ScEF+Y}n?!fwrqfD)If&i}r6_+(7qdJzF(8b+ehy{}w?Dy(jsP@UFQz>FXk zoveSERzFWdd|ncFIWB=2tbgC#UoiUt9-IOcCKzvN?&@-1Irsq>7gBrQ-_pq>tSeE` z$?LdF<{NqI$rrbq$B+f&^SSATx)dgcknT>5p-#DiA1uTRugRJG9J&^(&e1D<%in@j zNgy4w+QXIl{*{nSc;1#mkU*&FSoNoQq7~J-U*@_|!mBxd^ty)pgSlNI0+?Gn2B=I+ zBvmdY9tz0dfGoM#p^s_phO@F{%`!CZlbW7XZU-f6gJF_UEbnixRDb&YRi%6*2DyQa0)n~un73ljn_M zXw@cH7|_T)*73DFm3ujHR&05>FTgaHLmIX`-7Glao!kuXa1s3V__`@g=!J<6C>uOs zZPdjO;Y4}eN3a&oJjDDCP9vl-V-5&p?gw||Oyc$C<#A1)k4(f*Yu3IJa5K8r$jh41 z=&L#cihnPw?9`jHwwuqmWZsrWzv3{MJ(|8Iq!%hS&Ph9^6N@c2&IV0cSC`S*OCQTN z6bJI2akeAl)I|{YGB5HQICCNQpwVp^7&7-Z82aI1H-i|=dq_2BWl0n)^odO)kYAMH zxB=f&@tX}gRT+Z!Ipdt%-HGaY@As&`RYDhsT}ExvXZ}=DG{{G?Ehne|;*8<}t~(ZP zI@-{EtWL5IdKSHse4USEYG{y49MbsNU>#vS?0hVu(ZQH4=KkPGv$egz#kXzHEBY(MfQY0y8DyY$;;M>Ovz6Py$} zr>*vxjLVLN`@lzN%RAYl?TKU!$A%Fbkh)C=*#mD9W42Ii&J3%~JlLGtV{$K6Z{V!5 zBmG2^*_A~nQC@juXuDA09^&+3gY}k<826w*S|JyjW|(lR$yXNWRr$Lqp?&JCoFt7U zVdS=dkkCcp`Ppo?7U_8?x zM@52{bzO)XLNWSI6}sl`BA>IK=HDtCY}T8O3SEAS2qLd|uPvW`o14V+&0TO^*1cI4 z6?_x{ub8_X4GcPx+%>KY6Wr#iHXdt#r!sx~th&9@t-2!fQjRy&{as{Ie&uS`+Dm-7 zI*m$04Q}4|4qdN1F>%K`$Xt%}Rf%o`A2$ZK(eAnKokCHod~v=|x8Gh2?K)%X=U<{( z=Z${DucON=4%iFs!;mS1$)abO9g^K@w%D%MT!rs+)RlD(qoeQNc18=gc|LNap)UVI zfFrF5Cs3v2e?Hy=9AV5yG&Ipp%4D(Lb@c%j)36OG3nlgB2D;CKW!%>(f%5tk)Ap;c zHrw9%%u7CO%scL9LW_}^w=6KnZYu)FT<~@d$ThZTSGe$e9 zof))rbYHBb@v{coV9Rg0k6g|1$4^|%98=v>oM$%e!9&Y`1Tb82;8$9SaH55kr+*fT zLT(N`B(;VSFDnf!zV_mr?;2%!+qHAmosT0DzrXcSSij}1+~ZSNiMqwLRL34~l$ zJ#h=xtjgmGd2Bz8N*al-IM{>dO ztUr1BNJ+IX)|daq(=If&GhRo`*Paxd^?A)8WODP7uvtDh2Eh8<LeW(?kqw^7F4M==GV2pt%+f9eL9>7F;zj8r~Ve#sNB zmGS$^pTJj4*1ZXq+3TKm038zVhK6CGzZLgUZQO3pKQ@TXb$e)DH8ETwoB!LQyDABZ zDb&3#5&E(3tUjdnd}A$Wg3#Bj2|xQ*&pqaaWC+OxJxS$WS%az?vn<4 zv{s|5G0WTcTEkVNyd+a$tV=As?H@-@aP?WxkteUWm!%iR&S&fSxT1M z3)O7v(S!2)5Wnl{h*vUwoAj@=U;XzIVqbkqDd$yP@y9D{^3uze}sG{V^kb9l7h@eowZ&Ni%^I6 zk2Rm==ZvB4qsxoO)VNkYpwtR3g!>QhU2;DOK(=^iRm1C5>anfcli+iDOq(@}mF7#%B32%jw?OWnKi@K+ihTY3?<=r_Ub+Lc~W^&aKOF^%4f< zKuYgrBG%_*>`7b?h{+1It9*Oo&J7+5!)s8wz_e}=lD!vEROd zEx4d>|B$9R5-s0-Cd*Vv(<%Qo4%E0wlcq@i^gJAR)5hmJuJim#?m7_*H2?4{6tCMi zjd88v;FwS9re4L%!_;g-(A~kqC9%^XLA1Tx)+4WELQrgQ6>j6;VX8DCc+BrRjuh83 zC3zZfQS0^kvDsa@Vg9veY!&|g^=khz)dmYom-Zij+8F@Z+E1Ltf>*gtA3VQ3e6%np z=vf{<{`=_x@6@g6{q4W$-;TG_2M-_73I^`AXhN%r;o~7*{)KgyQ(bm5rYg%qDq}?N~YXdBSNEQ_#E!tv}s&&>ItHaBk zUv9M*riMGoFG?hk3DfQC_Dt>;HF#n3s_sAdZ|V15cjOQ}S`jW<9Va5*8WY|fg+sl+ z6w`h&fS&5Y6T*vpX4JZJ&C@D6q$CNghE#ydT=kPpmS0zJi;k=erh2W15P{m&oYLG= z#uMB^r!3`^6(Fp8D%See7Wl&NepciSR?(@T;iII_fx?g{?!C~vrwAI>x94PbYtJq! zX{_6{H|Y-Ih4(U)thL*|mp0V;0UzdnbqQ~*n@WXcHpyjsl&zCrjJVI^x;R*Wi~2b6 zfCDmLTCs2fej{|h1`wcXl3O*in+w;rKNK=tR2B@0PWkN3=uJ`AW<3L^MTN|)eC@y1 zsLa`FpHH;%{qI&_$z28LBLc<0zk0baeB%S8TZFzFyD57%8E~$Tyds+|A|AU@^O`n9 zHovGlvwVM++@NX}LdRjE-qcG}q{8Rf-%x>X%~IWWT>{M=2!i;b)$RHpf%sUV$(C4og3Iq09sxxpJ#=@j`FIwal1-O#SU_v{&M2_ z3WftkQJI&o%czU&HlBbN{RC?y?V>!8UvEO$Hx3DoEHg!2;pd;`74T5iDOa6Y!D=A& z^OE_#yA8RU2$PUn=uXzB)nlx};86!>VOs`f?dhC2Q0=rM z$<1vYF4LM=)&9Jr#4_tLX2utX{R2fY&g#&aRtX>=7WH$c4|Yd`V+be_Wdy~kp{qeU>BJ!RU6L;p9=R~eVIc-N?uI~-R|J7UqjNXT}zmFMsrBt8w*^Qu8 zIEQ2C2aK8I=D+ZDj}jwy5jWPKnipXt_jh;=y_GNn(t0_SbCShEowq@48LRyu3iSA~ z$APFdHQ!EWNey$ox(|q}UR^`!uh4ny_lJDNDi>_9v2%FRU5w+sno`v^;PDfYpFV`N z;EqHoaBbLBXAWYTOK08Br~uUU2?#efINEkK=XOy#CZAxT=!%Ky)MlxBR~r|Da_u8D z36z&v{qkZMIFBR%jVsD`$cnJm{pXRfj+RRwb>ur;D*EI!If|vS5{Ol!D!jOBZU2m4 zTlX0IzMU(D8~6orB1rXsS@@NU`Z45)99^B$oYHTET>A$WeeWHtJnHZV$eIIV?^ck? zRw`IKHkU=bH2B%4 z8>|&$(LqFug%Eb)M_-?~t$eWLGVz4oDFy=a+ZdvXZ{g znKbq;fH9A7=ZjHWE--Apz9y*W&K*Z6?S)jizYJ{pY^JoBq;qdf;7WqM?pVwafH zUpeTIv{X9ZG3chN=Kxr#0tL3uTW3+MDiD%;KKDZCnuI4Zl)AuaL#tIQ;pJ6a*!MR1 zZ|JFKvgx+OM#61lp2zEE1?i(Ka3xRc-*>m%h!TKI$M5v`UDA5ZXDcwKpmQQ<6FqWBtwgDReJ>#jclkTgPoYQC!Fn?@2J0OaFA< z3dDH~|LmvfHi7*yR$6g(k+~n4pW)pl;?%4*IV4J8Wt7BQMb{Y-YFF&>>cWzszPHPP z*>0PBOI4t{IKNOS}%JV&i@qxzE7&;uz=ud49ex2Ji1Fx?@W@jiTEBc%RqC z((6>Ey#CiWe$a7u+r3ak=R7dWq$hyS4Z>6Zu z2xE9X)*j;}i|yI3oq+xzVX7RLT418~LMkwJ48_(ia^M>j`u3+TDoR|CrGfk$35>nC z>ygXkKbu>)PmJnNXha3SNGhiXHpg$^}L z+IfB)c{aV&`?QeLRLk@F(6f=Q?4U}>j-}MOLCEQ})VZeNgL|nn%Lh(3&Kc1Jy6bk_ zmiW@nLLi&L7R!P_!Z*N|gBsMcX*7PqvQO;;es=^FS=4LE!on@d?lq^}Vxqcm4Q zcu0=%gKId)Co}2>LMhEkk_jTO_$lgK8kLlg)TtEPln3borXkrovDfkm_-EKiRqD>O zurG8&iUHQ)DtZF`cfUFHx)?r?TYlfD!@~cR7rBe=uTgu?R7-6FY;kbZg@obCaDMCf zNe$)^d5=BcO1F7~1w<2m`&qx^ClsqCBY8B1+|)QO~E}P>D#v z=0dRGEfeORv{N}VeMneWE%pnq4&#r=#{Py7Ql5R@cN})bBZ~jUWe!)I#<_Ho=%VY5 zox5ZBJ{}`}?yjWaMQt`!aYUrkAov^64VvJl)P%Lgq0H8@MfS4W7xz=jbBz!Vf`UO= z0op6vE}p$gAy?nBT#n^RqGsGrM5$E8-S?~E{#y?%G?)S(s$kDIZnLzK!dfksl;8Mr zpD#ZXHvN$9tkXBh!xir@_$%=9Ua2*9UgVl$Ho_i$z_4w^PlCrL2;m0m5aT~b28P+&9P8%b~XbH4fq z%Rv*Y1A*aq0TGYYJ~&nZjzD6mGpQM4aT$FB7Rw<0fh{f%n4 z1Tqqqi@4Y1!dm@?3sB9^wm#uK_UVzIv5|PW6vdJZK(_oOyKb1tLPioL{iIbk z{ZR1RB+{9JBwbkhKN_*o8jZ0fl$ zez5MHIR-LNE`}Hm_mNmm{FB|2Nc`yE82c=+K3{N~@~kFJAmG{FEx^jSx_ZJZN5vw5 zrKe{jW=gxl1Jw+3B=i-G*ncg*c`O4_ZTc!Y7G}a=wy01yLCURYN$ATTLB|(tJ#rHK zsX4hbv+wHTDv-(MuEbPgDlTHN)w@@4027JCbjSU_%Zx^9p$Cq~Y?!A9(IVrZ|Al=s zUGM{k_8*(Q-uq_$d7@SKCwU;df@S>n4sn}lXA!azjrP1lhk5tDXFF?{(eO#em@vpo z!Qp=zCDI^QUm^HitP!dmNNDYJ;iPK)-%=Pc;7+A4j^Qz9_HGO+9oA+vXIcemAUwKf%ctn5a+oI{o$if&QsuIGZc0A#&rm|)|>Z|0x)LuP+y zKXoMsmn*qzhb$57;S#T{sdnpa$bFpmWcj#QV&^^&!vZPI_M1BI&wxYxCa#YER-Nk3 z_Qb`yPw3!<{rO(utS+w>U{>cq+SPZ2na(%~&TsO1NS5$Q9Hn44*vs>6JDrBO(8*X1 z_x(8^IsGlLq}t133oITw^&2~GD9aI??|$tBDC5q2GT)Gd^pw%MW)(Hk&RGlAJ`q@H z&f5Gw)e!F=mUTbq9U6Opwgx2J$`>E}V=YcT&3G5KbJy}UxpnjBNiwyS(pgSm^C7Kg zRjKDn+DpBb*@*qXJHF)u?@v{6KaBc90y!_9@PQ{4yvqmVvka_zi`do&HXxTC$pjBL z+_n(i^G>}p?T+qQ0@ z;Y{3YLaEzo<3}8#k$BC8@v@#5;kU>G=9(vbO+|$Z86J2X7dXdbIV;g-y+Ew_tLOv> zK24Z^JKz=kwrDA99Tu=oaat6$e7rYuVtUoG)$5n+rw5jbxD#un4Tv_)(Ru$E9KQc0 zmmBBNkLpfCHIL>VYp94YQ1U7P+`F(xyZ}=ca^ASen_paUF14OxzfupIt*yOJHQHm> z$L_9E=W9^CcnUY>YUgXcY=;}#`b;>z-CNINzN*1n$HW(mFWjF zs2dWkCnf(1+DC24w?r`P_|{6Y$%}joRKe;+T)k&=%6e?Yapdj!-lsuvo%qAH=hsx8 z2^xzTl(F0^m<4VNa|GqP?(weC2Yrl@wjAB3pVZDXS$Y3wm0}K<)hbpS8(Y*~l09M0 z+tc3n({-9>ZQB%F-h{>n|BxWMlfehp1!4o{U9WPeg?u;Msm~GnE$gO&fMbpg1cLFb zJygKzn5nLDt869Lny%q9r~`WOa2?_$uX`cmcb$Rbaag70s}d4lG~>#*Cie;~NKt84WFbVii6kL$BT({Q4lmf?7-jZ13S|NuoVld zF)?W8gPKN}%g56?|7L8g|NpA=!@|0k#lq5-E61K2TEaSQ!JI(_F1K_CfT?$H z?~Ck3iFsE7oFx4Wh(^z*KJvYg`AMv$P{G6YoTdDZOG_b`NnKz&KGz?b3FzS*1s4@bw{3>;(Wden*G*h;XU9LS0##6Z;qp*xy4wNr~!P z3~tUt48YMsPv>7|O&oXDU!m(iL)xRBSZHWzX>Pgaja~`Jo`hA{bjWU@dg&==zWgUF zD0_nHHQroD%fIWFP>mia8uM&>LMr$PaI;I=+&Kr+uEYFG!hUQMgYn*RW zV0kg~z@3R-mJ>@oAvF>~S@L7N-Fh+6@hQ&XH%%hBbZ&ydX#H%?K@F@K<| zF|Bl+N;c7|2+C!#7^CE|X4e}Mmr(W`QMCmVkdL-a%Z2W2fNL0KHw3n%GS6yH=WEX~ zu9ltP9Qu6S?ih%$+63%LvK1YvNzm#&q*|)XhwXgagCPWf(t~4e_@{0|aC4fc;x?yK zm9u_il`)(h)HqjQ5gj}bEgs8yB2)J?3+MZLGo!=)(#GMnv9ql>mWSM8Zbz##!B~= zIz{$n>X0l6JkcafZ=v`N1Al`+jc>6B?H^;hWu=ryo^iE$8lwMDcukQJ7MpH3y@vmu zb+9c%yP$RCJE66Ylff1Xt_8@rE|W?W$FyULY}77?&Tp4cHt3)KduYyeQV63Q7aIFg zlG6wuYjQlE2ki`D{&X{VXR@}-V5Y}F0G;VEg)D5PLl`drcVs5g$|5tN%yi-;YAGZO zp|D9zm-4>dWe>^Yplby0VDST`FN)x3p`xLG%doHi%o0xsLEItsQ(r&A|1JMM5j@gw z1H0UgNNY5sADk$yXBF}Rjl4{G*&A+Uz7h%(Q>rNIqM;(+SVyPe*n}Tx4%6UGnExKE zx{y4E!zq}yc~NNUHgJJN?KZGYWSsyJXM!p@!JFpYgf$lW{z~)QPvt;=RYJhz_Y8^D zK>5wa_xjT(Cl$3_6@@fQH71Z$NyRB#wY33e1g7gi*bcH@J5-qQ7Q>A9Gk$Uet?$lT zp|&|fxeS>W}hqV0TogF0%#f@&lmijFXkmP|453j zjINfxoJuir!HDe5EK(JfB@LGb?s5RHW^a?gf7MpR;5O?Ldn;^cig9_o-2&U)f=J|4 zBXUY1WUBG@Yt(I_?WtUryIysdte?MsVQ>l};pC_m0(pYv+%`UUYnZz! z;-CPdH9(9&6YasMOhIr%BM^KZor#7l8Glo;gh`XL-^$O@`LHH)o#Q-GUa|BU)TDCA z(4uJs42p-=4l zOjOcvO)&)D#(J)~Af3+_Qy3v8G-5RETvVsg66WH>0U-{gx|-_){vAyVk%CoX<%snX zo#?@Ugc8!DY2;#PmJXN-O8g>!!Wg$V^-YR}SX!6dh3uYr_&_>rE__-{&FZUW50li( zm{r2nM1Ycl`=Z!t5H~6H`d|=r&{(EtU3Ira1mBl z0Rq}rw3oqgC&UH;1j=94^dVw)w8FEV`|MCnc;d!=&uGUk8~}4%AU>6K36f%Q2#y zE}8VTLXJxPhP~Y}W%Wh+n3@Od@f0?+96(`P%Y8RXDtdDc8gGu_VA?VLh!7A|DP(6h zbx2{hN5G(CS1}y&>_T)YkI`L)h+vqI6Jl3)jooOCy{aMdk1_UX^@r2y@LN{fQ~d0^ zCe+EF7eV6Z!X8Q{gXoBFc|xyQUDl)@4Evv0l{(hX7xf_4tSP(gvJj- zbJ5o`a6w9qc_vEnxX)nOt#~g?RfMz#HD z@xEo8QhX%t(K1>?3LdrxGsiqOmMF?==M`o8MdR-PIpGDs2!wRSe9Fs;>%vHyNH!GwCF_5!SIXz}Yw`3)X|Kop4lXPU%FcIE z@Df<^uQYO%vkyJE@Vn;6r=z>HdDb0yj>9L_lyuBNVmv3BLuP0FkP+uUrEhn*O9FEb zG0fa^51+yLH{=K$-<^cFV`?C3^y;$c~l>^9u9@##mtuDs?Np#j8~ z3;KOUYvUoIW$0t8onZHR%D*Gw5#YSMTGCzsb;3=h)R7zRDPc6GmO<+?yUtf_VJPCZ z_L#di!5cz%wHT+rFA-{{Mbn`hFm8c>7|&LdD@T(^+Y_l(xS>_(xYuT9_F<60q;?}J z6(TxG*E8Mn8Z9^HvPq@6cvU39Nf*D}$=kc(z8$;?>t#BkO*oyq__%31K))#lXa>m8 zOOQY&ygIyWz$?$aU*a*dqRTFdwmj(Sl55N?lM1$R{yYrIaX%h*l>9Lsj{QTi2o47{ z3Xz~W_PQC(?fd~~@jd(GO%b2QT(@|20aVi%;jc8R8fQ*hv_XacD5m`FuSHcTUmkt; z+rXj&Aq{_(KO`7a=c@M*!&DYV^ffaXiM!6_bkHyki0Neun1QNVJxj5mm*(M_`tzKd zQ0N_h%y~{5;l8?Yv`%LEOlQ0cyLUaYg_t5Q&AtR>&u{r(MYLgjU22Ev7kR&|$oNh&v0ot0Hc3}82zglGup)H?-T5}M!*g+UfdN^+ZCg`E^D+d>pU&HP#83` z7E{|zQX)TY0?C$}UysiX>bw-Oi{>!TbG9-#gTDGw}*&{PZwKZxb z4Eao?cLl=fPHtfNwmmk8^*2G>ra|1k{I*j~$f>=sX=ViDxLVJ^m=YPZ0+~8sM<;4c zgfK8g8S+9_{OtC3B@!xb;#M=I;dYHJsMKRoPwYqLakaBy=1#$J zHIM$s@xSby*2BN|-8VylzaE#B#`jekF7Hx$G)5#ggmSmxL9>U?d&|c}AnG({IZqDn zwdZ<>??qsgPq-fa%$*p@dp#$kgM(uT&Up-^0-U1(C%Vj)3@*o8(n?E>Mmv zsNF9qT?6s%OiX0-SK9H2E+m!2HW2;WR}7=+eEj6n5r5*o_AN(!9a~QPI)IF_m_R13 zrecVz(_f^b$K(RHk6T+$T9M5;p-*Tavi4B@M8e2!SQ z=0w^9hFeWFVrDhBjgrwE?a*WxClq$d>^52f*6>(2G3$j5*ttA$=wKLk#xBRS&8~a+ zt@{TAldaH0`+v93&uyO+K*P)kLJa;rH@fFV}EL)xVtC9i=Yc&8_ zC~+g%R&y15i33F<8?7n;Fc}p{XKOV7-wbKIF&mdcQX(U3FtM%F;D>k=MK{|I1zEyb zvQkcE-}p*4MnzcyJ-SjZWr|V)W$b9+*p;GT6fFF04DuN}wR05BFCt13_r%Ef@Y`60 z)r=zYe_4bv9!jgx_as~7K_3oY559`8frrmH#9Ony9DP!fSFlKZh?!FQ8YRVl2PlY; z0(k46QN70Y);wcD(r#6)@_(Y=Dqa=C{C?n|qz`n4HQv(aPFH$RyVKlRW>BKj?ZB;5 zMgErXMgE3gm<5{qI z7@s)FmKI`khRJ7p=GdofMzhn#Id+xp`un4@^Xoxz#N`Y>+^(eB=V@l#r+bDPF*{?A zNSk@l>ET>z!7Z*(&%!9Q2uRLwiyayt&R!Z=Ilc5UMs zOXzlvN;Z9LoO3NG82R?&VqrlPohAKE^4DFpF$AL^B2VYy6JkKBuj140$M{-Z`A*lW zhOfkFtVbM`F~Q>=@$lO394tSAs?LePk} zWf1u9dAtrADDs}dmVNMnf`n~Pp^H$2?x+B8`EpQ(!c$=)GLUNd_Vu7iAKLjAAGi+ptnnR2Vdd9#_N+$li-5q7Tty#l9>>MLyyTdWCk#lG;{* zG+A*(On`jym;|E0=j74!#pKx!$J66aY{;Xi9S}wLO@xn7X!zEDJ}rcd7F-v?eS^t6%hp&*^H&wl`PvtM!cMQJD5gi%#YmJ%toh=1b1nX%@l$=PS<-BI^&Z!jucwEl{b}ag_-$>$?S|{S~mm~&~dHn z5w;@*Sw8s+c^o~pF#QIA9#yHKM{OM2r+6&o#?`kC*m`(+SZP9%^S?{Ab9loiA9l<5b%VFXCQ zczO1)s1D{O-Cn#)j={UMZ_4>lJpC{TFLgZ)g5dsHe&KaYw&u%JE1#sT)yLR=J%WU_W~o zdY!Lt{X`z`rZ4|w9G^(BUx7lJ#v4#@v!y72Nxbp4CPR9u$q|q)23^RREKoBL1IT6&GBwtwrVHikKhO z_2OPi3<^}|ptuH)^>sqI2Hhwc-pO6NP&B;#cay{Z?d`woQ3|SxdL&-Fw?18H?Yt=v zSLEGMdG8CkN@z4ayWhNZ>g$66_E`1Pn-YDQ(D->H2&--Cyeg2Vb%F40-8D*IqZ_Df zeQ4SZomV^;lqQF+6vFV_8Y-te63)$GrAI)|3!+&5GDcHJ5CZz0;QRRNid zZ)8gXQdt*QG@ys4<;Y<3L%n#lYYBbJ?p8xJPtHHFRTb@-W7kd<`thl2ih!f(x7hK| zx;qU?^(=KrMxGX~g?B0|p2sV8=Vg+oRZ3?0u#0zpE>{e^seD1MoPsJh1U%R96mU?q ze^Y*#{6bP0pq##@`!3o`L5iI@7yW zah*8NjMWj-0ox7Hr_9%cuhma+3o48vFgg6*NFG+dAwT^5M(A+%jc2t{aRW8!b&e|@ z!P}q+g>)fdlkc?jd=>by8tM^roN6D+?a7kTZE@{hNDE_1#o0%Gsg>cv>2`VU7en%uQJN?yFcCZcVT*a1q)|$g&?PI1%UIa;t%J!#<&LUyTo^(Y!DA7 zTdJVx^X~UenqTyq^uL(F^TbQ+lf}Q=7l?P+M~PS2XUtdPjXc_dM8h;LtMC8DJqABo z+r9+mcmoT~gdny@U%_W`x!a=G^>=dUu%Pupi1ni{7*kl7y=Ks^${3zo;-(%j5S`8& z8^f6hFxR-HpUSonS>|yoo^QMb%M^3>P&?=Rl@^w` zyzGnnjOy!sRu`f18In23{XWxK{aAyMdy@AsN4&{CSbrtmLA`=ABt2c@CFj4F_37X) zDgGc!@6#R0#1$@b0oLr*jzGtz_CR$X!^_*9=2zO>o>iAl@cdV#yicx%T0vd0h3R_R zqnYM^WGa}ygTx)YZ*mNVjf(PrHzDDfT}S5nr8Va|((kV=$DCAh48BqSQ+KhZ&NnkG zFCV6MC@*|DuP@Ippk82TBGc-(NmU&bqh-KBVqSsC=*oUG7g=9j1_-W@5Ip!lRDEYy zQ%e`_QI8_gM^qG)sv;oLM5GBMB1%A-f^-4t9i+DuJ)j6k?==e2dzTueh8m?4N~CuJ z0TR;h{_g#Ce@q^duyd<2`?Zv$G>H$bqrENQ7PP} z!P5Wc4BRuu7r%Y%yP}dB$M^bwm@a4{;*EAmSKFnP^=dlbJ?RfAY5yG0n88V3lPIPI zk4`|{XP~(S*Um$8dj_D0=UNVwl3z7L2@${+)uvo!rG`~P__fXkQDb=sI8~6oIaN54 zd|0QR4ym7FRZ4Qj!VE2>_$axJR*FQ`itJ#e6+v4{#Md^EvDMk}z^I8p5KcXJm-Rbo zw}|wOypP1Bngrz%O&%zOhE~&E;*~2Bz1~(q7gmdyw+V-atauJu2@(^*m`(Qzqqj>S zrIQ0crv#qgDtmiu^duBx@{ge7ZtJDpW~=@rpMJr9MiHbFb~UK=MMripYR+2a(05bd zOM5j;+9GxjBNVuzy5sQIAqD0qP=T#&1L-%lfz})e&Z+3jKHSDcR0iu!|Aj-y(Y3Xt zte+MuhH$6%*y_~{nX@Zr&$5nAuVKR!idTFynxsy8WZU0Qnxu3N3zY2pE@BieIMdWR z-aOe=2aoUtLk6J>ub!;lMjBO{DH1=O#&yIiTzm5taf-;Yr6ARU7p?9~&$Xg&jc6bD z1jp4eZ(BRY!hn62_Q%%?a4C9p1;^jc3*~5T0piZn6FOHdRyxRf4K7Zx`0HgvwEI}k zT)1Dp?=DvU){`V)M{#*B7&01#A#}P4iselyh=~O%h?QiBOqv|T)@NPLL;n*B8OyPODy~1yPuDkYHRp_`iS&5YJywZ zN*$Fr#`^&3*#q!F0K^(vO9dL~Rv@s`_3WXB&3z4DfUMw#(*D6ZP%yG)!I-iC?S)N4 zUGuDVqpU$7{^0sS0M2M=rk4H*9W2JT={01$Xg zV&0K<$bIPxHP_J{fHJdyIgAG8FuH+_;x%ctlAZ}{{lhcItygr`FlPY<>~#`Al3FHh z{qF^sq*ATj=Td+l87bFdJlA_G@TzW(|5Z}#y1rQ7n7KGKT!{Soo?vs)(_K8MLk$2? zOzs1?t}qDr^~k4y^h#bL6BO>%gX04sudNZ(D{B}?HEd-N@EzObV4$gD(#%2=kiZXs zJE?JPS;3(7*m_sJ0jOSpK`=&7bRuHM4?ud8a>lJzT=f7p2qX&35x{MU0>Fzl05OCb z3;Kjk3aq4-w`25cnYX5V43G(K53K+BA6lVr3qT|e07T*dKqTF`XqBX6w%}9S(!?SF z`~`@CU7#P9KtC*je#`>>n5tvmLJj~5_nuNazU;DXuzC1jn`}y|5J9JaG#N_k9WmXp_9og6F!nlL}TX-C&k`91HzdQjd&id{Dg>{6`Be)2a zG$o<|p!lf(#+NVwG(hns0mU}}6u)_g@f?vuQT;0p09+~n;dikNXl@+DU_h$kki&)WB^uit&7Sg< zXT`|#WrEEL084KnUjbS1oT*17ggOBrx-X{NDdSdNn|@UVvcGPQXgmOO1wQDfzfxS{0i01uVIn zuarYcCIT1cj{Qcu)3*kAAg?;+9c#M<5htj*P-@(ph?IyofI&zB;;-xiR?p9Xk?CFn z6iD26fcaRgqj8bptJ3L@Uw;3dN`n2tv)kB zr-B5<1u1?~{Ba2YDF#bh6@sq+Ik>3=j*G=&4ub!uE*mP3!9w`q0x~Z^Pa{^wh7!oY zGHcoF2h&){)t=S1+dvMhn6oewht6=J_0>PrCnJOTyBC^61b|V>#%)18v(vD^BzyJq zH7gH71uz5Z0>Iz}0B@iY59A;yZ*%wzs)QgDcx8d3HDv~&x!3{q+~F;t0snylELH~a z7u@PvY*Bl={|l0725n+nMB$8q%U36pHZ zBn`k$Q1XC-*fkAJpaGE%2LOpi0_Y@QJ6PLepaJ&&3$XV{pvT1t3)U;(A@TQv04nJS zC{_rdSRsI74FfJ?6_EIKV90n`C^KeN2oJD8D6tI2%vUEP_EpY+oDkRQ(g0r}7BN_6Eb(ECm4D z-2>{LfEYXhG0c4i#2^KT;r3C&)@<^c&BA?^wvfYpba!BG!uChjUB2K|b#O_s+KI#> zrlOPk+NMNS(tDFnarWS=L|QGq1@q<~WiVZ_opVyQY@&Di=fj?;dZ z{b^`f9mzO?d18u${l?o*;_csw`--nXtLf+O5j1Y61m?ecb8`H&ln}Cb3m~@up6d+Y zc~t?=t2&t*vM7EVseOCZ>jN>Mh8Um*rof8b}pFUe!a3$I-P;`i3B%=uKwK*{zoS%_CmHpUPdL7l0*@k8%+p>;O^{ zmIADDDS#B60K*nEL&oce6Py?oMIC$#Zxo5ji~Qk2NUnvC6>(Bq02QbYtV$>#{4n`; z$<!Hq|>{@Z+C~^Go8yJJZC9YB~apUcfTv+HGXlZA3*v6cXA0> z@r;2L&$wK*taIU>`E`vdG#i2dVg3yb^Fz--2vcwTA*`6Zh&=*~ibi7JArQ@>2yo04 zFIQ?SFIOV|-u*!Qy*t*X`E%{n=P2_}nrWWzVXvy^+V5#HbzGWh83shvKdXDHe^$C| z2j;tMF?CA=^Jd;FY)galY)k!6p22yc7{881nY30_M{~ru!5-N4wxFAMU|d52jepe> z9YzlaKKu4EIO)ymo|crkRl4b(l+Im9((65N(lh3Z7tOSkYs9O8&8^+Kt2z4Ofhhg_ zRoRCF^Rf>y+GVM&+GUB>L-zx%hwh+KEcbF#bXO-1l3TZfoGA`o&9vGySflw~Zbjl0 zIjwb@c0B-LEDOReI)^sDe8=&hN;;C`Kl;R6=;al>8~Ii@Nx)dWolR}fnzV2sAJ1og zJ>c=Wz`wx=lInRPyBYabahqKR`Mw7$X@&$t(yWj0O-QjqtBz~x=mQ_wQvHRlJ>nAH z8UA&Qpv$C%Hmu0haImaa$EU%;bOrmuP9HiiE9NGhS7|K?8XmCrEL_hhfBnH%!goC9 zC9MfPW8!Tk1Gy05NR7^(%d3t0j?uhH$7Osmdc$p#+?sD})ZP!%lc$!Jt`wCn;(r{H zF7=nBLGC&=#le~g_MiDE_Qg>VZBe5C1$V=%_6;c47b4pA1(-1%eP2e9b!_Mw8EX4o!y zs*QuSO$r?e70&Mt6jtBShuPd*Z?owH{XK_I^dkyya!6Yz##Vj9y8(~J*(@MFd~0?t znMDwlQ>8yEWOEazGkx>lB=E~_)1;jENTXhZ3WF+3?Vju^);nU_psm6oPATQf=Zaj=L$ zTdI-tD$*CtL~kr;2&U>U6erqQplzz4Xw0A?*%6i>aCLk6bI9H0&p3?}EmK6Iq&3^# z1SyKlIa4-2^c4nmOkTT8c~vd(Li}wNA$fD6SjE1I>v9JL5gPlM7%)dp>cq}_aZn0q zdX!h>S@pdigk%&9k7dV}k0aa(c;E~G0*xW|mJvD9_A3?t1Fe!Iso-d3J19MGotv$- z-Kx9h*a$|y%5vI!i?~XkQ(rhYu-!e-cl?|Xx7?wC{m%TRF!G(L+J-oUp^YR-IoD8Z zE4J2tT)}=^Yy0$z_~z33s>ddBx$OcJX=x>*8IVpUNCZ~hh_=^)MDHqfMWT@xut|*U zIK7Aw5L7K5nB$*15lBM7`^!7*i?MxMhrhNjn8MG#L{vyD zpqGIRufBGh@{R|^SPU`dB`R!U{XMm`mRkCha<-gt)~p9`RJPW>Ys0tEvV#OVu$A!W z_|Ta^2<}gi4iOWi{AiMNL(Z0~FHmO%DS*-e5#!5{W}Qjx zt6g=;jZkeg084SmU^@uOaYJb|n_$bvwt{uKx>b__^8;;HDdpGpp={NKxwPQ3E7l`Q z()1xX>-h=)J|taRz;6I~ns4@QufY%toqLY*_R*~c2rskuB12#`oCemSTRG6-3LxZs z6tggWR{IA*t8?7~IEUWXdWJkN1k1Py|EQ=?g1|?A^m_Eo>#E&$%U{cBLP08T==e#G z2J_mpM6{)_g5oD7CR6v(;pD3>^)bm6$RI=g(%MPZecz##6APh?p;nAx zShViS2`>+YgK`62k-&%4|MrDK1sH;WGtJVqtqbu=2ou(26n5FnMrC09iK8=+E1&AG7`9o?(C68yY|gM#b4Y4juQ`eQ-j z?peZfUoX@6<9NXV>#IHOMhKg0F$@;m^9ISf&rmX1a^ZdLt1nJT$^Hwiu@gs@Tz?6C z;vbQ~QG1pfraJh7)43Zbra^&yYzv}%hv7nHu}YmWu}$qJyIvqD*co-3?o0C{NGRus z3vo2*=Mgk!`hvB0^TUN&cZI?uW+Q^JGv_Wq7d&}y(d{g(3D+$2LsCz_^RiG_)Wrw;o|?XYZW7vtaPwHi7`v71 zLnK?sKMK-2#Lu?%8)&Xt5ZgEecUrn)Yi))s-A=w)n`Cd(PyhASA2grYupJe|wRqi=asWnV)mBf{4M=s_HmAZ*SFc7vRNhekizi^W5z%g|@#XY`1Y7FQ zZ>NxMzH0Mj+mX>nAS>2Y3-BZ-`*9?GRbKKCQ|K|&^g-~tfCIIk)1gIJ<3^ohT z4IWbIrR8M+NYbmdhl_T@VhfRL%Jqy>`Z8mrhr?~1vRx`EV1>0b)iXm$8_E%D-nlBW z9w?0Cq2{8APM0c8M}0%N`{$r;Sh&8z@!^r&F<0!|^tk#D$F0+-iuG_ImaDroEUu=( zDe}N<5mR*|>jJ^SeaYpmy9D2illv`|NmIOU|2`lNA9at#=!*rpV&^OseFD{MA`nh( zzmx1RoUwc!zr(FRlY;_!$Fi>xp$9kXJC^5jD-VEd62X{2c5GB&&`OXvJof|gvn&YD z#l23s6}xs4-`DdTM7YMiSHc;nKa_FXse3+8ss0DrXQY=20IPoGx^2v7?x);Qy4@Wf z?aOcicPwS0;awYpkI5KPn>DXVTo*UCg|Do)^$euBQ_}v{WuUipKVF8PVfLuS!ah?% z{+=BwyAPCp4Dhdswi%@y4^4$hJ9c2Q&fg|I|A|z>aGa`oyP&VMzFjnToFMKB5jGLV zo~;^g6AN+*S^Kamt#3K#5h5*t4DGeJ^NfPIAo;4Z$;`HWT~cEaQ#)~AWw118+l&*) zrD-VqErZM4V_-6c`GSj5VrRI^GZk+7^?~A5g*{$tEyDdEP zWzG?wTc|JAkVM<9LS+{*`qLKY2@YPnIj%+UE5ss_UMG3FH3V5Rmd>uU@W+BSEK+J+ZcP3=`; zj|$&>8zS$SaDf8NGDA5ft}kPayT!glf-g9)HaSe2PUtwCMAEsw~@y=2MSFwCFf_mXj9*mC^x{MO|z!uzq&ScP2R91&hL-+bXb_ z-QdoIs=Jr2dFt@2kwt-||G9fE+52FvBu3R;T_7XbWpw+fbytgUA}!o5%BLg}{Oz4S z@ea$be{i$;+|T($2scj!PVUvPym^);c+N$? zTXFiEezyZU0Q{K|e}Ts`QFA*3N~Gk6gron>{o<3{Y%>JIR{*`!T}MWdmr zl9@FHpz=o+Tj*q*v0lbGB>0En|MS8y3WRsGD#?`{V?<%DaD}Xye_9o9Xmlugw{j^} zwG(P_sq|0+KYDU5sBZO|sxOw<9x_Etdbe_IyQ))ta@*By8x-PrV?TN_v=iU(0>?dh zqXw-8c9a{H<){c4cG12Z`{rWbHE&i*MX7u`zkWQveig*xixrLVXnD7?-I&=~L4r1% z4p33^v_(ecdV~6srgkbm3Q0%UMV+*Zhnnox=ERC(&h`Bhq9MYk&+~XAqXg6bH~miK zqOyof^vuD(&2ut_`Rlq}HP17&vA_Qv`D7RMBjO3=+4cZ%9cMB&9C^Mk$zwnyrWc)6 z?+fIWCf2muRl}{=@s8sQ7ruIHZ-D*a{)Tju}%-mWd}MFFRruW z6+in^=J`;{k0m;xcA1?RlJ*oU_kOt_Wb#-w?Vsth!0-@RU#Tb?;HJ0Pdphyq%l+%@ z{^3G`KwqW>?>-{VP6PeCbzl~<_rlhK^}buLGr?MWM+z2fYt8EDR_jcV7QMvnsTtB= zB^*<<-u91zPUcf=fmX-_L~awbh>1>GC|FmyJA7!ZLygZ}exKczo|~W8)@cn1mQ!8- z_lMgOzy`Toz(+SY;bqb zjozmzeNaWmtIIAow2cI;7t^)B^w~%l2g5$u$;;$M)Vx_e;E$zrQ~vpKRy>Zwdq|Uv zmS^;x5Ca>LKWm&<55!{4dQQ%g6jJ({gxy);c8decc6_qY2b?>E`*Bs!YKBm3k9Zu` zdq}F+s~TOQ(t+L}I#?-A)#xmVgP#L`3{C4$FUB&6zI>)=V zDi|ViJ$s3MX5_gz3bmwErilD-ps{*5%jFLHZ@m+^-$Az74#(d&Ekuf3u5UEsRCcrp z7}Dn(Py>1IOBq-v2aQOR*i!RZ>4HC%&eTAvcTW1~r$>}NGd?&RL)Jv!jXdSk9};BR zAw7n%v%|5}^*Y;- zlkEIM+c%=-Fh6zgzc)F6GvJ(`>GbM4Sh2saY61!tQifz@x%R^&fp2CDG}x=y`#1x) zJOF=kNxR^%t4_>>VO;~*A5CoiV_ev>R#EaY5Nz747nzCC=sqCeDx}VW2uzeuAFRiG zsz|gCK+LHIXRy2hgC>a}Z>h*rR9RT9qc4^KRZfR#jXq*M0>0YIdSo1Arb+wI|%5K(~aE9G;F_Jx!IV%N(T%1yzs(~Zdmr>hMz`^aO;{4`0X;}f4 zS>_qrk7JPU=PL(0yWT)toU(zy9J#6@Oouytl%EWa&%Mbp*H4Mrhh{4`l#Wz=6dD|f z=|sMsbX87H=}dqar~W2OC&$(A4FF(8oOs>G&}1|7aw4$xL-8AaBn0UEPF2)!JEAS; zH@L)dhm*Z8PVy*Ifi>U%=$faG-()3j*3BNVC*t;#8^h?+9sI6B1U&c zYZ;w<9XBXO0I}qQV*>633&cQ^ik#OI*+5wB+{)|190doje4vuaI)~DRi7l>UiOx(1 z4TC44vXQ+eAMS=3tCp1R)9+f2nIdAo7iQ*O%VU@sq#BF%-=&*O=^baf30HVcwQlKh zTVgZT`3ez#cQj{FbswlDNtJ0a4-|}{Sr=Ro7lZO4=g|F+Lm{CvJl_*5xu&OHUn zMEmIdwhHKwpr2Xy^TpPRs4?x6*OH++VkoirqpxC zLAvqY*TWBzv5#?mmvBh^z<=x4zi}*)vy(633_-&jTwN_%uQEaS??+=?_x)5dKycn- zzwZ?2y5?@-!)&nhz~MWU?}u5HBPR74BmI8#cd=tvZTLSQLf73rKKOF+OE0$XvJq;g zt(&>rkdGnP5TngcX1Bg?8|J*(t`~iS8e3;?~w;LPqKDbtT;9pV4eTl_Rk$ zxO@;l7ANM7d)cEyE5TuRu&qQw4p&_6g*;?u*$k`bN8L_}184dJ4CV9W zfEEgCKJqmc1pi7|_rG5$Bm?=!gLm`m;U8{3JrJa8iE^%bm*btvuU`G#27%ahGp3S% zxn0G*s;VwF3TPOs+}W^r=`nJ5sM{CV_o|^|SK zg6B@N9_NnoUCKljuPI(!l`hy;dw_VP?A-C|5)GUt6x|Ls)As&N%DFV_XvAh|{i`u# znv}F!oM(gTVekYb1^m)GykK)F?UO?kK3ZqGXcaI7=JNhb=p}HNE%O@A2b(KGZ&Nj! zwJSPU^`_|^x8zi^^(d3drlCN5(b%hWKb++VDL0EN5EfH-X1N}ny+u*kQs3XS>Ul|+0R|B8vdP~_g$~9=V5|F#MfoZCgJM zLvGf83ur-}rUZxHZ(Vp@eB3y8;9JVDygqxc!`G&&$iHc9y`8(wnz2*Q_)=eG)Q59v zo5M4ksBMhAeVct|n=@X5kMWO@`) zWRluV>txK~98h6HBhUaViW;PpU9c;JhtMS)4bROW?qX4MP@81y{sf&DYy zFs?z1P;hq|=XQUDR_Y-|wG3#ihhd=Z^$a_Uj_TopWod~l`+Qnmb@?}WoWQx6yn00A z-9Oet{7(71F3BEsQ65|JMlxWmL-{?R~lksf2p#2AuSIkgp6@kxX#+!#x3Z)Ich;m=L@pMNG+n$HmjR- z$^$<80@asN?cS8Kx8BuKTkZ$ZXz_2#bX66avtj7zR*xQtoE^}w8(mj8GZ`_3OKNB; z+G>(_m^w33Z2C!2@PotINvrzyf9wP|$@W&pRi@4?;~r{Dl>g_0OXK_=1-sj|tCGjn z4k7>w$zi&|p!C+hl60El9WfU$(Kp**8m;7~ig64JdH|m>9VnXfb{W40vdRT&>VYET zA>xfz*1>cCMu+5mtmHC4u_-du%}{1m-|%JsIpj+|f{f1+Q*ijFgsH>dXq(iU9cG&M z*7*w+Rg0+wTW>FTpwnkZ9vYnFr!JPd-qcxE(DrJ`b$GvjsoMR=$4akj7E$9*2RSrb$4o5GkM7+jgCcV@;V{am=*`QI#^!CL{y&0BJl zqxvUuzWT=&z9udBsX1fDu+E{4cWR|8mz&_4fIM2WPyEnrOCSKbEr0mbzbK=zYJP2T z3+(HZiq}wemCE0}a+0nDJs~?*h2Y*K?J1lFJ9->Yj_(BcEepR4h+mhd%h$HAZIw{t-)rZd9k6 zV_QhMvvRN|>e6P1Fyyxvkc1UCr&0gQK%hah@&j{OvD|AiTMrH;)?&t;hW!|z<`0xB zJc6gzv)pR7Jse7V$}d1Wobt9UFrvDC=wp}sasjy)^{fb@>@?Lci>+A85eIR~6fK!? z%+x>rMOsoATbJd)8Q7D~L#5=$7@;j@#)H$;vP*B?7E*@Z)a6m9N$<0V8`<6jN)GG) zp%+ouCwhRK8xZHJN&4w6b51xo9{-TC8Du-~3MKQ05ssPA?XO45D^1{I{2+ITHbRzo z+R%-H4$tqj z@gGK9C|vU5Dmarhzoq@i{c0>slzCyXXc=QEVI*jBp9VK@Qh50dlWp*t>fShS1@F&-ENl7 z3@Me)*f@MJ`C2>2nfT{mc>KligFmz^hXEti!e@{14~$Oy#`N=4g$sE*whHh2fjQnd z*Zv`SxK@Pd9#6xN9huk#f{)#qV_tbA@@IObfDM5xmanGj_n#3tm)c_UCty3=1(djg8{tm8h+_wy&dn32_;HmkhnlwE@8(S0 zr`7PtGg6;CtoW?omN!hjSckBc%Z_&$B%}OO$KC6xX8T)D_7Ee=XqI`ysdoqQij@!cNtq+__A_`HF_XQCO(x z`f1R5b+j?97gm%_ z!B#ZQ*Urp`Mp_el*ej45SoKiO6i*4{cSoa*kc%S>V?$@KlzK_!qTCH{bfn!E(%DwQ z18wL9P}Qs7UXM3$Q?WclZqCYlevI-to6!#Mxk7xaKdd6xhwmz4&RdU>I;^nN5Wjn= zWr2~BU)9(z6T62Dpce|f`%PK2={psqIvlt7=0q*xJC-*a>6(PotUE$YTAmv35jkZgNoXG0fsp^X|)`j)&>5q4gGe7z6 z+p?A=CLiYbsooo&dDZ3i(ht6*Ejgk!HTz{GgU71tN}t90z2Qw*SO;t`#lV;k!75dUduw$Wb@N5Hx*m(A0_DQ&Uc!y{Nq5^?d(S=TKV>;$=>H= zH@|ng6Z<@Iig@pesg_m}J7I^aw!P6JrlRs|F^zKrv3s8#;uaJG{erxD|B-fQRVRr3 z3N!uRmR$PlQB7ps-4;m8a|2oA_V}77dry zF5k0G(Zq{(hPvfyT?Bchm=5Em{yZh~ijE&Z@49y8U$tbWcb{L3<^(acISoEm>3lw@ z()&si3l+(p>=pe@K#u7C_*(J7{|T-2@(#-x`JmHfLPN;~e6`Bb$e*~YH3}OU^aF!v zVQ_ckJ57ou!}#0ban6V%?xCoqbkGaEPj(c#z^b`(BUpA3vWJ-ynh z%kAP)Q2GOX-t;F^oHUVSw;y^v4A~Nw<|)JFZiW-GfVqgyc|jJ%YgOz=G&hYN473jk z?iSKM+Rar_KzrODv*s-s0Sfb8!p-Q2DOS%wG`2kJT07rf0wS8msv+kt8eIF+@*we=$kCBbAXY~o>;6zD(BJE>lh)O{VmGz!eAc|m zen0Vw&QGpWGXLDUe=q9avucU&@4YZMb)~D9?AorEbbPl?bzQH} zo^T)&jyg0MJ)^C=@Xn)IlOmBPumQs8_(L!6sGTc_7ZYUp!VP$Z{xNy-J4S#5eLQ?^ z(@juIj`$#!4_#0iI#Yt%p-qv$e9^GyIFH3;Q=b#vG18MtqeUt^{JOhN6iQdu!+w(B z*3!(i88>=v=8jEoqQAbb%_e-y|3yVA z>|JS|!ma1KUijB0gpBdGwbJjsRHdKqQog@7;#kH|^j-vc6$;qn(Roc^qhX=YxQT`M z@yGpm9mZdqoTOdIc#l?zhXe!?YAT`x{?ztG7vyjp93J6sFoOP8*@5DbrZ}JPdZ-ElZBlP&E+q{Tp;!8p3dATGpwORSdrKdk{IfJi>X|LG4amjPY#LT?5|Sb>^pF?1fC6> zj1?Ap@UcO=8Js|{$w{H=_uDN%wWzE$VUv)KjJT8{zOgnrOuD}p;rXnSsdk!gr@uw{~0 zqN*#32r!Wn7LE}dC^UkR}-uf?N3rMciOb7>~Y@|~MVRXkiO z9Hg1pp#&~_mWW%=jJGcLH2|OXuhH-U4Px&CJ!L^K+B5dL#;ENOQ_=p8ijPzGv=}BL z;Wilsh}wqEtic_&H4C$a)6rYBr*7|?y7O3W852KglX=vR(HEg^lA}%dxAWe}YE5K7 z#_`qeA}YP$IFhVXmuBIW5^)k^8j{oQB~hy|?a5g7Y;lN-zfuH z+u70H-`gf1Z!tY`{5EN#`G7#G784ae#Q@%=-M+Y8UXQO`3ym{BVl{j^nzeY1S2ooT$&sWYThyqk5~T!H z$+2yZ1o#`sb{j3bA#SbJSnxCCQ-Q*~n;rbup7f%s-77d^z;#d6B>_%&>4v7YJtsDN zFjlKVr@SS_BU>*>Bu?ozTxz`m9q22!+H10t z=Xg&E&?jlN8$bt<@o7`#cgn$O`_+0cf(6GXI3&|%Sg8lqL!*et2OWXpYAkC3O$eln zaJJmo>UMN*AVO2w{uPp|5ti%uhs7UJD_l|WodX0sPuUoC!L%xbY$n?;aCNH=sB&~w zT{&AmX)kT>;TvuKh^1#{VmX#a;zj$1Mz36HDCd{zO*r(}W@~DEPA%du-`%?vePnoG zRv_t$c2h^xjPz5u$9p2mb0r}2ZJ`bW8P;l+?zRc^ui4kh)jC90cw1`IYh%1W$9DM< zcS`yOymu$2L(}h&OSrg0T5Ft~`Y;$16~0-a_Y!WM^kcPB|2K=FZW}=}{EyyKuK6h9 zxfiicSI@TlNB*l_RZjL;vZ?iYQSRR)tO=(3E_spr{{5eo9h%+s0;ilT z^eFnMiXFs+K31dtI$KVdOMXu6Iw|L8cSY&{zb=EvdkiB3Bp{Ni5=rhHx1}Sl2Ajb< z@Li9^*2ynTszi!ekK^})O&yh3ny-&?HGi|l&UB)HE+Ry{dw0{mvI74}_IhV~yT6W; zLybNu(eBhnicAogM^5Z!?T^tVUJZrbSKGz!ciRR!|F;sVel>J{{i?m!2fWX#C5u{V zT?v1g*yJ=3us>ca9zJe+em2`wgZL_F67z2ZmT=cK)U;@Y&bNg-`u7+jbnD{a-SzdC zQ{WdbS%;6u6#z%Tx>dz_)n1yUwUikREE3XJ3sjK*ZJ|%wTrsw8=)SFxI;}$uc-e7> zJrR5Vr69ZD|gt{T%e|*-c_ZeEM>#=5MO{pKdONj9Uy}dMZC> z{lY6znW_IxpyWZNg|r$|{;}G0e7A}@#|Nhw_DsQXZIun1oWw)IGs!Bwy!(Ut&;Mus zf*9?Be~$&@o(5L~3ZXRKv&O!Ky#Mq@s#z@eP~L)1($?6NqoLQ8I_RAJoY`iw+=oVK6Z6iMci?Kixvf30=y}N5 zr6d@vtQp6cp~tLj?pIt8(aeSS!uom?4RUQe7IWq5OyQYZT)OcLMc_H3vi&hS=O7OIxizq0aPzoxs8U* zzNu^cpY!UIARt_gZH~Wvq7`XTr%ky#9=fy>REzb~MN2sT!G_@P(o(91y`?6VW~`o? z^`?&_&>Vy_+vVB#tmkcHo#+&WtwrS|mO`?Bq84MUXuqR+hN9_t>DWlWgnE@Go;nulpn5G zuZyfiP}9!sgZEL1#B+wnTUn15e23UnU`_^ze^@v>kzCyp*Ul) z6H5l_T~LTf{eY(G<3zcG!F_t?5K8kC*{JPwf7P;e3#3<}n!e+Ww%hiYIYXJyO@^ee=Gdm7ATz2{S(=`y2&n!Si?DYoA^EEOJG z_!q=9$bZXiUK{^8I>DYv|oh)Pr) z#Qs@ba!x)<5{&Y=zH4WXKjLenvDZNQQC>S<-qzWZp~ENWJXrS8wrC$AaJ>({!@AT= z14bhA=frGCc7uj=+PNHhk%$iLo)+@Fal{b%Bh(p_2!GbIq4h`Q1xctqZ@nk|-b`AX zK>HnV>?qlqzg-*=w`RwjCAOO6e@tiU|7@_cA;xh>|IoEPVxXeT_AsWeYT4qh`$E2? zI8vdptwI`9ewr;uOPcNV4CWKLCco?*H`(Qe`Q8Jn4y&X_Sz_T!ulT{*UU`uCWNwph zjczJ2F^HEOsTkwM^Yo3h9_cl@r}T%o?KlGQPcW}wKC@Y8$S>sv5T!+y?lJGpDE~D_ zV(-lyJ_-x80KXuy{YXXk-lE0nf0?)aPmRP^eBp9zB4bEy`G=x?eEVQ!G1l^CJBs2p zu-*aaLj9GR`dL*CQdnGf)DMo{VwM;?JPD%5VD*?vlCd{tWEatoZ|jj7t9r{?PV@>o zgxjzQ-aOJ5qvO15bcGj&_^%fo;0F(uq#AGfsGh+k=F1GQZew^6zQlEtiFy9~_1(|@ zfladTv*qHgb|Q76Qh#l;G?-NZk)<*r$Q0Yae&^{Y{NZ=-`=jP|%?A za6Fw2^QcVjQ?sBOC+}E`{9=7%U7Rt&Us=w(vc^&KMfr|-5@o6dI9ryZhNf^~hZ6%P zs~)7Ok?!? z)^|t4^+o>@UnC<-iRfjbNAwb%iHH_LNP=h+(L?lJ1`&+jLqdo|jot}ngfTin^f1ck zb+j?2J-_$X`{%8<*8St&bM`&=+;i{QXYYOX-k+9o_pF6}z@LD(g`yjye{y(IGrA6# z^p5TsFp!%;KO8{V(541F*HnK`%dT;$vG2XBvTlu6HCvA&GFX0)PXR9Qx@Y`&|9&3k zAGo0b3odMlg(oucm%TkCfXosVUSlm41FQ4N-|rjl=V4nEZ}9X)FSx6jJ<#|g!5fji zGu*jWx`qZeu{YTW%?I6Ce5_jFwBssyG4B)32O0dz0qQ5sMp*yl$X=Jb%poNtzqzuu zw+<^EVIa^k^!<_zujf7Vm6)LkVE;6{eG(yj#RA`WSyrWfHK+ZRPn01+eP=T{UHuX@K`*(hrjN7SS8lbbk~)o> z9oGITB8o~%4uC@^E<*uoT>b?EK=7wf#S0p@T4YE0so*T_TI0VN?@3@aYvJbivCMqW z->p?lWw`fTH$xRj3OkiIc-euYXGK?Sb0Q`YEvN$y6yhu#?t}R(&l~c4i90l7$Nr&j z{rGp%nQ9D*Nt7$mor~-C1pYz*#wd)+f6pTh-O)*_FK`K;o3x zeOvfsJx26UrSzyxX5qT04>=jmec}*Mh8PkpUYt`(JfJXs^vxBtw(auSMu8C?@Yy3TpCc`i}Xay`* zaMY7QknLA!1{&m~ds5YrU5))NRp>o9-A*8`d{NmN7jf;Pn+;F~7Fh43Jj)>5n&nLt zat$vxJdv9<$RPQbpv64q1*e_4P7>V)d^DT@epsulWe>MxJe?KrafBA!LXbS?tiDCE zGYRdO`jRciJ-gQOT5x>c@mb)tAY1!d^+d8exG3mM_WFS+yUuPhMqhkUxF9*cnGKAFlqFoI^Hx8IUSC z5HYfhcoImP8Tg~NSpU`}FkDDxr0*e>rDyI|ie4JI5fks^6=5PQ7194pq`;1p{j+1+ zSAPtCC&5a>Br^u+(>NXR=AdQChzJ1oCM z@elFqV8?UT^I!U>sp6+Kxo;;4&auI!hKjB*l|Ff!tk*-h$o3b1AG#8r4~wI}k0hcU z`<4=fan9vV1xyUr&Gol0q$?eydh^4~3Ctp)TLzdTM7z>_Sz!X0?Y?jNx@In&al%y4 zyQc&Zj7R={I#UF@2>D=YZR=h>GEQ!t%O^&l;QFV>oLz!%Y~`Xo1M=J01wswaBK$Lw z3%w7+)pSUbr1)@tNd&S1bM9o4*;mWPCBYl7ZbW+dwlOMG-Sc$r(S)qd#Rq5}5}6k6 z?q1NX+>~YfL=0;D9S!$2^Xu$ZR!WAmL0f+~)N05rFm2YN$AMcHWq^h8jSQ35|7645 zA?NqK8q9~8B_vODiD=Z_PKs7VC9UOiWHv0a{^B*8X}hztPX0X`l&ZFVK**3xOC_&MXwVq%(p1t}P$E5Bi~v z_+ioj^x)>Gl%hVPhKH{r5dFEZX@)YsuT&g;0(1agZ-4>}lHCLN4=9uBaQI(wnRHxckkx_6Re6^WCh%3mtgf1tP{e50G;HntCb+0|LHF#%AV_45 z^4-Hv%f4jMF6^s@9ME@TRxAG#^E&Iodz;&T;o-%ptYUsA!1`xEsg&I_7{<0!x3o6L z*IAnE+<4B#2uUjmd_FR*UmyoA6k*+NTCTH-ctI$A5!$6q)+Lm`2-hZrONPRSBsE^_ z_PWk$Yj1+Lm8;{nYt!Kg8Vi0C2381yoWvbtS5SI{*FjykyaS%b^_3kd^`{#u(ULP6 z%s4wS5TP4>pgr+ifXvg|T(IVve6`o#PzMr{_0%vX9z#|;|wh$3NUp^gL%J++9+AE8l(H&*FXf` zB}{X4?^iNm=~%yCv4%bBgWHGFSWtfpoWhzR(IAEDP3k zyWYJVEb4k5al?otk`Yzi-X@)pP)dWd+ICaBFWi6utVscW9xW#6NH4qop3$|0zR4mn zNG-gQPt5=^BF1$p$Psc^ofdb6$Oq7f_!Q^$czyo6Kh9YZj`nibHn^bE_PHA^1q~EP zF0_>Ut)@6t3q14^JOhbcSABw00($PVRIfRts@x~F=5mUVji7L+^+Xoe%U$z1W^Pv`z+647zSeGNnc;9K0wt zPQHw}yCY&0S3l8^HM&3UeiY~g_7iDTQCmA1S*~={p*w27Jt=~y=So?1A&-K; zR+CuJK#pS{av8dC7PJ&R1u7tPQ1H^&>s64c>ht8kqk&7q}z%vh5n1AF({D%P6 z5h-VA#J$rF;^HqA7UAL?cfaeTZK^_5>xsj$v~G{_kMTKtwtW{;i)`+a9(BZF#yr3Q z*zDO3zlt=O7aI2f4c=AXcwPUPFM1@KwciZo}rMq=|rX)js%x>T!Ph zxC(N(beN$UYbj28Z7Ua4Ke%e});o8`fQig09875UqBM`cD@@ex{>*e@yr}lJjrbX) zjCjqI(Hh1fy5W&{?FEf+=5K;*%s%LNEI<@PJZt(jLbewO{4kS*OLX6a)T9&q8)uf) zOVZVNy!pN&XI+ULt@TDHA&9PA(CqA4(V??Svm#V+N06*i0bgAnCmab#IzGowb?0IV z_c8rkr*k9+aNBj_95OVOV|bpFQ@OO}PNqPdf6vQ}h<{IZB~$*(e3TORo%WxAJNX6z z+oxAxB_A+TJ$f;vN%*fZ4#?B7H|B&FxkpMlnDxD18WcDO(SW}2p2XI$NUixhkyIH| z-{7f76F}S5PWW4V%i|YZzgTM5g$x%`Z+iQ;fG5_S4330a3Ypfh&nC^uGy8|c!3#01 zuqDCJE{nHm=0chmQqXpdQ@VKXWmR{$EMl110o9-?GuqK}P3CUlfU=tSk~d7cfnju$ zX^gl;S`A&7cMkL8n-XVIZ3Wx27XrICG8}4?S{$h|Xfqz=NI`k z3On_#)+*d==l}8yGPUY$WL`9kmjWDNpG{>4ZC?#q=T6GH61zv#@`lp5z3=@fMtj75 zoxc`b(a>vf#hHz28*rXIt#HWN>8Nd8sgCg?(B#=K&mN{6`vuvVGqQz**$Dyw(I z)I&r8^2EAVkUXR>hhB~cb)U`idNK43M&N#3`pbwIT_;%WN9x1NLe;GPI-fWpgw~50 z%%ow@@*PfW5THIiTXj&2btjV*VrG~vUPETm+>J9&;2--=D<3`51qP8+(Ijw|Tu%g{ ziB&;V3O#G|cVao5=HHi5kq0^*H={=t8NrUH>FUxT+{`zkJR^J@-QIhfoqj7Dxw%mxed%7Wm{JPPbem$lI`Yo@`s{Gu|I_zN5A zk=|NSv9AV0kdyV&f8JyFn^I}l;Mqv`!VAYSr)!FUZ8>@>Q&Lzyd|{(Y5L|3^tdcbi zD}Ju7)v3wXK4P-*EIsF-Bc+XfF|NwPrDYpQFy-g%y%_w;Y$-m|81BOayp_I;3f~Pe z$vVhPY@=TkY0dkkm1KuU^A}u`+0;5E_PQ5ZBZ7OJKNn6Xeh0=>t#vqr{9Ux|u9@q{I1( z!#zL#k}r9)-o`FpIU!k&X?(^dzuhbpsa`&DO~#Xq{47cox?T>P`44-Lp9SplaZyI= zh6p$RNdwjLaj&CohyG}#KIG?z$iG7Ysb&S+Mu4=p3+@8YPQK1nk~j2nzb*Iu2xrNrt=0b z`m{S$bOIRh_S#)m^^@`*|GD=K(l>>4=FiF)?J+{*`UX=%bUF)KA1vq22vHm*PW?iT z2D!1v1-x1RLoZD)1i!&ETGnYNJdfcou*+DQdFl&oofQNLLp^gH%G`u)F+YWbGr)lE zRFUQH-tX6Vj)?!w?+Dm_zJyL1gl#VArJ*PhrRNWEgLSZT6$`h|HpiBp_ZQ<1)%To_ ztoGQPbn%JUGHv{vP3uL7cT4JnwV&?5PWr)!&LVf98RDoue8ybRGdMJ(DOGIEO@F~z z{S&~!%nsti*y@a5gXKPTg5^E9mZ(|W3(wU>rA{q>en3Niv|sdv-*2?hAsS|c-enXa zqRme}phO;z)Y{KS@>$k}1DHU==)13@OyBY?vN2&=C~)cO%;n-Y+`-xiev2F=%kS9l z42wBTn2+~x^(3`9TX*`&U(##vXhB8EVl{!Gx^O-w#kcq>Q1xw=+6QPhPK;X2OnSu2 zWyXG%NjhEY$b&}PJ69=JMGO_>|Ncdv1EsW37@0*jW(>_t1a}OK3ZF!_A)9brrHK6H z8Id}pmw7O&u}6!r%tq%z88#Q3iAj2~QnH{`HtlCE;~{0oJThvAAxlu_y6fSHi9TGe zLtgMr|KnO!S}c?At>zRRy!b4()8dT3(aA2l2V<@nxTvVymP~!=jGvnhsD0vMLtkGs zq4ewfMed@Gn?ZrD66E(FiZH zjEfD6_v-!8=>6>@kM;XFiAMy(GwH?tosam}XYzwK6rKqgwtok=U$wqT+H`~(^bOQB zYVJdhD%j^u_;`Uof|o_=b6aI}0zQ+7k64b~?G?ov*9Nk2)6w;Vk$fa@*h) z1LD@U7AcTOyH<4TB=5rZZE5R=b08EeI50l;Y8&+Zn%a8aQWNt28#!p1A8rFhUBf0q zv|2(ts%#wM0GAo(BANEwCqp8s6B>Ubt%Qwbl#$9u5}S$uOa>aTu%+@@rYpbRO4=;#X!~d&oLi zQ17TzY&!zlpo!+jVqDP(+Ksm-!>vsPjPmH`*P#C#`Hf zflxZq5H8aS`zxrtOyiq|Wy(C|gM1#O?8sZ{3NbW-w*8kWu&HPj(!VC?{DeTY$QJI= znW9)QD9VI&@EM`O&~{xvCH@j3Osmczw)Q?DJ^wDo*)ZkG(hw6Oqb#cPbuPiJ_km1#D8pFX7)3bu9vs=8+JKvg zzItx%=o5lqnC<_TU|jzinmJiq%r&t6OitY3R;K#Xxwox z3)p2MKGdKdr~Nz9c!m2(3ijH~zpNfNdbc|tPH|d6R)UA{1s5y?x-}~H zeh)`7!N;%GIc8$52{zsNwMJq4)z8vUf1Beucx^M+9od0iushOQaU-kCc9{f2UIp6F zpld$nWF-Y$6j3XjM|O<6_XagucRo>@65|k2ja!#iP-PVW89|MumsydaL0-!RxNuL3 zHm3FDx51q>`=mI^txbj?z#I|VdwD`)uU;3BL@2G{=Y!6o<~FRk`#W~-&o2oCu*;?7MY_x z)E>leAZI4QmRbo)_;@9NM>*4}DMj4eOjB;y(hlkQT3hzd`23DnOVI(_VFZf~X;~t$ z+UQ`L`=(W~`J2@nJ)+g63(6CwsuBw>A}e7Q^3(J;0jl>nyPK~VXDAMThmt!mdgQ%t zy({>goYq#4E!$*Dz@fTZd-v;)zfFy`NXy+%l}U@+J>UFU*z{DogxCq+PSZR`s#)23yL~IaA?L4{pdr|#Ud4*4jy1BLx4*Ld1n!&gs&S%=xEk+;P z5;XBWf2EC-nv;{8JVUlinay2+pN8JqPUr}A@gkyM4q>g{JrXyqh|ubMHa&1?o*ds} zmr=$i$y|D#OSAg+yKe421!F4U1!U`^4aO!H?FMC#R`1VSeZbFKVYJTIoh?wDvnXt8 zd^_b2_KBL%;{d8efly zU3&*b3dCBPzBJXBy5r6DsxBNglu+@Gx>Wb2W>~eEUC5K^KI-gck+tW!XEn0DfG3I4 zUB(Dv@91EP&_7f0n^X8FokIVj4)W$+-%a_W;Ru~#;v9dNaCXO7_o^XW1fO6o;4mvA zC96kZEDE5+v=4Z-9Bs3km1tcq3J&kF7jf9{$qX0pu)K0Op8@t;|gkZ2JX?PTn(XZjud4GZ3A@E~cmq}(d zo|VZ4kl`$F=xvGU}L^y6oQZ81eeWd8Evf9Jmnp1kwp9GGDF~SC z@2WQTqu;JINC`?dx{7K%lNq}i{t*pT-P00PCk9_T7YGtRy8rk!g}C-0=>e$j}N?P2N_})7xsE2gml$J{#l>YuL=jG zdTHfdO~hXGu7+gf0A^c&H)rcy;ZvL!GR+Ck_Rd)LU%xB89_pVd==al;0m{v7&(=Ri z*yVf0Bs15jzJIxZ0$}cCBjsNFCA_VFx=xQ+d;Q?$TdZ3BywOqw)1pJX}Qw`81>Tw2N$0PZQmMX3Z$RT zCd5D2FAIe(2q4t8B8IPy4P6qK6wgY~&_Y0$D6ad@qfou_W;7Ih`&C9*(0!*=z>=PU zI-vW97Fkb2#qR+zX#2^Ri($1dW{+uwbiGGiL}wdvpZ_jJZM10=72k)Y#)2#*FEEQ_}(edVyer@Z#u3-aZnBR^-E z^Rtu z*DWi&NY%^KAVdA^$p#s8WV)Si5p`(jIKCh=EUq>pq@p$z4K2fm=##!5Rru+mGBZGj zd!Kj#vuKsO|2jVO=@Mv*MK_9JQLeq9Cq9U5g4EMxBuHF+4)oLqF-5Q!A}@e6x~9mS zUEpr=mB`Z?nq@-}doI87nl6>6fd<7gHt!fvOcGm(iJH&wWC+XBpt|O-#H|vleLUcD z`Pqj=LEV3G)2WKzU~hQV&Uc*6;3Pne0f@r?dCP31LF3gt#jcxid9P1CZBXY)CE7Rp zt1E%_lAKme5DkX?iSn!eV>ie&3viqwQ<6DJzQqyv46G^5;5j3F5M8h@i}i-`(2}<_ z-INQ=KU4!E&Vdfj@9n9(S_}hReu8dh?r7X*V1KK$8147pF;fy7gBfFA^z@VY(0>Ds z&p3oy9{gBkr|P#*vW>ORpYu6lCr2px9ENhF)O#gG*~@bmbFJYd7Yl0tJJ8>C+X#Zy zC#6zrn4iQ^fY4n1mr5(u98#2ohS8%V#2N!NfqosDBTM31X-q0Sf96Yn~>n&!T%A-W(qXj1c{GYLsx_@K8PnPJn&a_;nnfa zNC{+hXg-p?G-Ryir)}28&Nth7@Jr7>`8SVMcXMloJ` zK8Wfb&Ux`T`>`zPQGF((;c$NHVWGZp&SfUoHbc>~ z8`OVKa*6yQa3*BA;~n7m(4q@{t~w*&RW12(`Xj!w5nmY^(bEj(bC>&<=^HMGAhJwe zGGF&@hqSP)5wvL(bfGYyHFo|!t@UeKe|Vbth_BK7F^_v}Q)_py7-FesD0!pv)~tu- z-21jI$xtx))g1Z3XnvTu0{%9N$GFNyza|#-bM;_8cKO;?KmXw5QjTL#loH_XdYl=D& zlgkaTz&nLKjm}!U%h8=^>j;JuC9abzQ8dS?q$2>9w^Nt8+4j>@%kq4* z{}#7M@1WaeW|P&NZ5E(yM0m~*&Orp&g6BpJ`= zpHDTdm2C-Z;(lXa_vy;U)I8b8uEzE%{Dos=N2{%fe2z!K6%MfDc40;}Cl#dAc32^+5&)+zfYa!9BRXF%<#8BqlJ8F0 z>b=js?PmgMrA_rzRkFOdMm}6&qR^ofwI@^D+!)%VRLXx##?z!xZNemvkE-eMJY8rF-0J+Bx9ZKgMA$j?(jOSYgA& zaxFms2hsMYzyHeR*?(TJ=Z=H#yHjIb2owBgT{blI4a5Z(`!AE5RuwCEZ)WFUb8cn( zeu;Hao4O~MZ|bGD^eJsG|D|<1g!uN2dx*;$>yV%~VIhL~x|HL$wA5s!AE=8<-#O&S zhNQ;;Zn{6kGF0hf>BGJrGF|d7iAtNtzPdeP5E@0jBO6t+b0?~KXDzBw4|#XssaTX_ zM%)ejWYHtrydc{SpB0TkRVrS#0RiQ;9IBUv;MlEHfT3aBA?8DHL39`(()ofREE6JJ zck@I6w8XLSE&n(n%~V_kXKj5DKv`0C?bpU$UHdT}Y>}SZ$XP9jf*y%-1(PIjxc5V45#aR@I6dzKTMF<6R&za! zQ?{Z*3B25*1dU%Bg6+3Lfywo=ct|TMF8T_wq);k)K1;wIWRs{)^1}AW!d*RN;Xyu1 zcwdkw8SSS|wh|Pfu|~lkpIni&cH)TCj#p6p6`h_2i?l}OzV}b%+HOIuE74a*i|g6I z@)WVW{WKplpH~w+uPRms`k86XD_tsz4&vv zAt@M@p?hT&k0GvKme2Q?~Dl*H{c*G++3D%~45J%aB{yO@iJ{UO9ORGC}J_x%S z!^3`!=^h(H4l8$Eur;7G=aO3XCazn~$x=7s7`!xG3_KQ4my+{f+}O~iTo~=XC@lP9 z@3=4}*4M}iTUr}?Dp{=9Z$5z=$=MM<%l3wyI4UWxg1bSa_@gHEsldsCO;soOs_MH` zjN|a-YuJM^RYoioDtgSiFtRiIqr9ms$r&bgp$j`bmLgG&lj+t9oBDe+kBXY)SV#xh z)z84ow`%kOsWu939C>^{Vr`OZ;?)>4 z|IM-W;~ZZfsSKpW=@w+tBYCKIZpWMzU|BL|<9beYdVKqTpUN;O&&qfT+$$W%pD0m< zV~6*~dsW%#H#liGdSy2|8N~6=QK*YYD2@(>&cy=Q-bLo~nfzm0Skn{`)_ab&y%li{9Rmg{J4+)t4lC&~Zc3NQz9%s# zQgAsPFDGf0D(% zCo;FM4$`B(N+aiP^ka9JqFzb2T&fUnB(czF!tPj+den%nd^Nw&7cFLbh&Vt~(bHUi^wsPb* z-Yqk*NU3MvdOLz<=#TobXp*CbQ7e7eO$Ri!cOKCfL> z7mvl(S=f34Hr}($QH}qj_HG&8J1F{B{bqmSHc}U`GSHsVrqDUH%V?`yXJlJTbF|N= zS4LSJ=elX#?>zls%Pe*)C(he&?0o2X=@;pm5cZSA;4x9)r;?C2^#4>9CEnbAsZ#eJ z(g`)>rRpVU!@BIY(G5E8Y}|>BI&}?mzW!*El|4a3O+5j?QH4@ct?V~$<<*iK^R8@2 zBNjd*iQFyuk4G^maS`yPL}hpD=(sc%MmqPmvu?5k41GKq4zZH;`z?7##lBywZ2u;=GVbML z_&l|i>cQd=FFwJiTceh{)mY5g;ZnQL&*Q#!KK`-L*Pfy#=3DbdcT)2GsEP{r2}KeY z5{@0=`tw5MM*AUAJoKbC+@hUQ*LJJibWWLOoe0m$^|c&K!<@#*@_>>i{MlQ}<}AXC zeH7JA^#?BAXPNf#mi!6%#p^M;nSXco5w~z*-UD>DT)3v^**J)Un zO}xo%Dh2RD-PEHlV-bX(&Aj-^|sBnAzwlv{r7N{`c zcxmFAtSHsQ9<5g$Q2+sdl<2%k_mUf*QhIQY=n`dDG?JXDPZtuSGlOn4!C3#r7$K z*X&ARh5&Eh<^BpUURB8<{6^UQ%Q$o(rSpAxsmBDyb(?I|Dv>z0kcT>$|5K0-EU@{L za!`z=v>%Mtm@Mq1T2IR=bl`vjPcp@Sh^?4FG92#}j9vzk62|yI$+L{8bMtS_@sFst ziYNvZ7y}){UVh7$Q+;$GvUYTXVbYRzMeTP(hJa*G(7~J1)Bm`A3aEqp{$vugy7xX5 zGbCI}uLs{BgJ0B!_2L-u;2ZUcozJ*i7{Y}3?=se2pBnP8f+b2C~ z$zH0U!3PUhTXXM;_Uu6WR!m@{et&t&(gOJ9iPUOg;mAVdZ|vj`g*D%ZSYkVwZxDVA zvWr*+j$XQiMv=7!*)C`2!3}4uS9{7YR=%|dhL=Sb`hD8MA4Q+7?*}{b5q17L;R~B- z@puCbreka5;w6{Xb-d*Ag6Cu0Nj>3VL!(8=_)-VFp3ovjoZWv&s=TlyJ1UXgYR|xF zc9jG`eskLF5y5|zkk&W^HkerwCUFJGk^MW`$$)&R`DX;S_ka!;#Sd-(z9pS&^Rt2L zj1MfP$?VY=)DMl~-1sMPmktE4;`2kN+_mBGH<5-XfIXoWq9b6YYP$R2S4DAr@U(}S<~;+kxw z@)t7JvUJsxD|7G79^A>vYMs=|cJ+dYs9P6BsF!m;#b@`r7G?mp)_1=7JdRC%PG1}+ zO3OFKqy&t{40?0K2FY7 zDK{}PT>*fdAoJ+X6N1JMzZNS|dEuWGe)R^unkpp^_e%jg*7g>nB`V1#+3Zi;^Z?9YE?THC&_j}~Jg z0hTcXB4_?xF>N)O$=&`ov=E!vRt3)Z8TZua8J*jgHoK=3TTyO^;RH3Bc}w_r#XGgz zjvT3!WtU%*_KdWn3(6=+iRwTM4bu4rZ_i~~sI>@>$Ngc(F6wm&gdtM#y4D*3IQ?zG zWxdU=j2Eo=B8}1r&kA2Yciw+;vyiwLJI<07OU@o{rFA)ni1JVVo0TTJ zz-iTsuyZ9k5Pg`~I+!Y=5QF6dBES^?V!W?CVkIeb*;D_mgXLf>m)^)!DtK?u-}rKQ zWPXk1nBO^I9$F56gxfN(z3nB_rb7UDO*%jRmy2;eD$xzg`Zar4QImPpQ2FV=Zz4sB zr@7aNR;iWtS|zdF6H;*rf1+DmyM1G;rdw2;>kveVF?vj3HZo^DGAzzf;@S}y)4fVa z^n%^p>AUzBWTe*bey?DP_l9i(#roWncx+n)T_#wg^c?9xY~TLFjd7?Rn~c$(40zyT&+)bxh2k z*KFbS&&4sHC2v^F>C>-%vzyyTi@tt86MfIByHn*L+?PDaA7k8I;)!6^NdXx1u`7~^ zO&VH8VeS-GuYt0ydSPQz1*Y_<_qtBkjaiH|kPfYnte=Gy*JfhYb>`ZOGQ|2$bOY&EnJE{Fg@Qk}e8QCJSO9rWzuIF-ic|6vr7anN&tl_wr z`4)36O&izx(xLZNYe!5(eMbz)o*>u3xt=bqks9Q-#9Zxv@*=UVnb-NfYHX;u8vT23 zwOQhl1;GOwba<&oh;5lsrj0wBqPkRCS8Nhugnf*Wit<|PZEj<)$$o=h%AzpBsn&E! zj=7>+Sup^l=fCwS-a?28*GgLkhm8F8^F6(QK#rFEqr5A9gV&Y0)WBC#$8P+C1WtA{>M4)}2-1n67XuFx^hghtBFI z%vX~z>V>b7nX~uNcV$nM6TGKpk`iUr-ncg$DbCCX@*T2-DNOov|CX)=Puh!eg593fU$TN zw)~z2N0Gt+tx~+y8F)*;WII}J<-Ww2wrn5#PpVDI-#d!@3 zFp_+GT%T>qr#az!{>8WQV&#*NUx4X6C=aSFRyV?B7<1S3z7MgDFF?IFV@`~m=3|cD6 z=RW~iMe3bX^p+e-2^1;uEotOWmVA1kLUD7J1F#75u9N;jRkXkSR*2iVK}Y+}?`{Cx<^NOVd3Jma7;6iFS zejh0f8xwW5I_K)(P%DG|TBxb;s1vIMX@>FpKfN)Otr*R%AIB{1TwT^RjQJ#})7pyoyN1Rd_w+$?o{JmUe3Wke;6qyN^=#QvtGKd&walefEEbKZ@&Vo{ z0!^eIL24Hc{&EGFXD^J_Jl`z)n;77Ep1%Yx38+iGqD`6)oHH(mFIbrUBF7Tti>JWE zS>AF})yt}1!w{N+MLm56lH2J^NkkSte<#f7S;onVFuQ4qg7-9m?xe*5?lGnU)?h@d0t?E}5{#4ca zTPOFpBtV*ONS$Md@F`@n;5+XPLflvCjr?z<|8`!eDm}8ffwR1MS}*m!%3xAQYcyc2 zGH<|1i^v_sIxpcimH&WqevUm-N(U-HO2%kMipZw4DXs%3a~!z6HINK(Wy)^72&Qp| zu=^_kNdh$kLF~uD{+z=R3TRN?28ipVaP*`QfE#zhjmHw48wt)@q{i2zMn3YqIC(ye z?EZ=DJ`kbs{~_-`O258yL#-x!>{58kTOu%sMItdm@%vy_F)(YE)c-?1^a}o|XYS1xqpLU3l&wzO-qgs4-8u4W z&_Eg3-D7zq6N6Ld!;6l?oJ0yF3BcH$b|^^+-iR0Mz?*GC>(F5t zUK&E}Q*I1B5`IICI)$6#@qiM*egST0O~`q{J{A+X_0gZ^->n+|$hrV8kKvxjI=V&d zJReamQh?re#^ZcxL`(fgsjnQWBPSIp3R2Y5FudGF2L4)k`=&J{Z&aMAFfV5HJ8@{?D0x z%^9dQ)uri^4_DnFVaw&p{NmYx*yK1xXN>nV;K9GY0}9ey$E?U_#3o;>A4mTG9qS~+ z-n$azIzDQkBx@olw_*ZZ!_$co%q@>Q+@+>!<_wzMykM@ie?02z##a`?ZsKo@(eWjf z1#?XPy5VXYefmuAl$EZ-v267Vm7VLgTTY2Q+q@WG^{cear+Qq4ni$sKL^{4@Hm?Ft zdlq>G;~V$X{lo2t9VO>JoNDQBS( z^n_{a2F|Q4H2S=A!IV&`AuL%jy87>BzIk4njYC^xkZeBKj{!xyrD`;L{64P7vZuNK zUX^lwUP6r>Z*Bbc?O7E~3+MmoR^6hJvtA{0@jS;Q()qdV7pPoX+*DeQT$;#8p7jv` z%h=WPkbO3?&?(%&ZQCtGW|{6XFG-3DR)`^X4{p63_OficJ$0o$b!=cXb^N2TdiWUO(vG6Q}gsin6*%@o7?z5x)HBL@zCeC?!rl@JHzBJA=>S4l(6r6SiPzhZ`!r z*8Lz96R$%uVD$XklIHpHfX(C)N_2oXyzG9(QK|aTdDnN5#Zw-Pn99L{tTBiW^4EA` zSw7Nu*ZIGLiV)2#1xYzzK#sOR^aWtg@gHj~N0akPA&F~@7lh*uRb5XX36$N{2QNTT zj-kr?r(hpx`W!p>b!xZ4I^lbmHU z0crxT`vvgijWs}cjQF_R)tlBl4d_MMU-(@X{}ZOFJ>z!DE?V5rSq;{>hd({{ngb32 z)qn%d$}SOMmnN(=xH^4N>qnQDwS>XTw=e|;U1TB^(@AwZ-7dD^CQd^;2|FP33=v?i zJ=wJ7>5v;F@fc>JtGmo7rMpem`kzXB!BvgXi-bx>4!$qiNLkeP+M9;aVOWsJF|R9% zgF~|OCeA_2I=gnB&l0DKHAGd;czt2u7_LA^t6<4{`RzO~P1Rox97 zQ@My3p>q!uriKWUc_RC1AwDigwVq!;MAZ(EX2|WQ&DU^1%thu;FpRjri^ZMyASSUH zB&g4ja_OI-^}0K3_-tC=u3FID$<+BWG*cYQ6$%sn>^VV}@NDC!+^eD!K8TjGp|592 z4m4-;KGj`_R=0S>4Y18x?O$CYu@GX;Jg;q| zliW8kq!l|SE^KY1svgWG@V~r-!sut^Bx*Nky5@-uUgtPLPDrnz^Sh>b@&BUfJHXlc z{{O40D*A|4Q8i+;w6$v2-c7Z&)gG-;o1#i=Ril(pd+)u9+PhY4YR_mTC?$j-A<6%K zzQ5=1dEPf}a&vRed%Vs$ulKpAuBxfzyz)2P^(P5LxsVoG7>g=a_bN8`@!7ZXYv71=$JQ zC({q!X@0U2b_ovbd|Kt6x4kFaK6)bZ1M2^w+CTV1EQ-J2Vr^iWJiVR{h3dLGXKD1# zu3D_6GyKf*s>lp^m8x-_!cO#|7&kK;Js&THGQCjZt^Sa=&sgr@xbkk8_j5&gwuW%i zg%qqml{dKh>C^L1Uk*>*=o)>te_Oa$pOO6A=H2muKq$EG9oUnGkrVruM6Vr@jJ)u8rt z#RC0fHq)f^q&W|xt=%2=^dDWz>F8VO8cVkzwrnwM!+At`=}jHmch~J?#Sx1vj!DW( zvXL`VYSF(O$=cdh_tF!)vg$wnvRBV2*1vwj>{!S{PL~`!gO`Bf#SMdwpj^*&*<`(E5|;X1$A(3h8y9Ukh-{NmixSMc(gCWNHAe}h_EqB%&u@sWmM^3-zr!q|&%HsqTm|pAy3Vn@bzzr3?x`2G z6`%tKRi6b`PSJ`As_irEBG=}=)!XHMlQpmS8|%l|&Llc+!5P_hyu-mbwQo`J*J3mq zM4bCuMV7JP04b<=z3A1zwr*V84gQqFUSwYxNevxg{dA_M=`aQQB+k*r>l-P@k$115 z3`u+Qlt}2gg7?h>kK@9+6sKZ#-KqRW971x4P**CM24`hOdRB%5co)ed6}M8(ZT8_sd@0v@}Wq&kXMGt&JVTcC4_YG~Y@yl<~DE zG3VZOLBFQcBVE8l-%T~=H61-y^5dfvXV!m^w)vpWZ{gfDAXd?ca`d)|+aRbE6mZ7m z5!9&a^=OZM#q8fyXT}WMczf#H@w32O{V$$MW5u4Wtx<8V4N7sgLxT^+v?oNj2|?k~ z+HRtbLSTuSzF>vP7JW&{GQq!Bhfd#YDmc-`Qs3{2@I*C_@Gv!2^HuNHR}il^y5?0b zXA)Z{cn1~jUfQI(*xdO^wo2B_6V@0d2^Ahn(To-x-V3M>hRX}=IZUy=Vc4;f6p<9| z*8Lb|)}=dd!{IG&BV~p>Xjxc@73AwKR3RDaj`VrJ%+xDBRx3staJg3+hTm&Sl|#F} zW!m)-0OKl*NsMR{3&zoQg1pe=i|=xeb$jiHuoZL-a*xMy?+s#${~Q;6&vEO3TXj*T zxKn7S>vEiUsN4FN(OoL?d}7ffyRo1*uJfcl0yeGK(ye`q*H4ppeK!?~e(f8~V62F~ zS{s4BB&JbGAOs8QYA-YdAki01V>T%UK4)xZK@+UTTvkr>qq(~WDgB)sNMwZIkV~mv z3UxSM=O`%CXat-8f>L-0W*#J`BpqVaH3oF z$Yt>*ABiO7f!ApmvzdxxY{)8^@l-L7(@$f2$t4$p~ZL1v{I5*j_FSXhk(bcogG^^rOGN55N}Rq=0mV9wH% zGt@IqsTnkdI}W87%DkIrAFCq_nli^%hKgg}hYVVlO0YX1{^4l`*VpeF*OM4_g@6*Mf27VLZM5`fRWNsrJ68b7moS zSO|>=2JWqIy#|2_orUwnRDJ5QN^h-i(2t|@a@g*Td$w_$SlZy(%HZDv;=WB82(y(0 z(5&mrn|>boOy$>6?TXRG3bH*7@>)FlN+{_WH=q`pGMcdI zrk-V8T-@vI(SdO*5&33mT>ho7cYp^!7A`KjC9!c7)%CmFrBz@KNFxS8Qph*7iZ7@? z&Db&CwIU2D?g*p~((S(ykm)Z5mLY+f?e(O#troK}i;MpJUkAWH&$DuZA0^qVh=25XBLKI#7(L^&E}57Ay^W4K6uT|f zC`2amwX0=)A62UhRAy_aBm^Vv`Ft;2M*SD){4Pv7|Fr!cu}Nqhw2d+DU*npZ<6>KNG%slK-V+~F{3w_vzEBI?i6-b4uPpKR%{ zy!`5Q3Nvvc^NLU&Vv!V1?ngTOa}fSUy)XDfQ7PCV__^QVnBC1}spW2DIcg%0EiGSC0j*giLM zb!4~Fg|YBeh5GVnfQGo}!UczSPeABFnAm)D*xo4Cqj=+tLoG4k8G;@Kn$92&Ty#rhAkfc+eVwf?DO@|snk(s{O4X-$ds z#hI;x55iyEiBETO&VkOQQ&R6>;o%t_P9v5eU80~XIa?0-OyJEXXcV5Xc!p~2^X`tz zG-gucU|8mCPl8VS_3>75i4;T^@S2zNMyK2DOWiX!sfROHaQ47km)AF!436z2`A+Ix zT=iuADqA(RM63$46sGt!ouEijpOM;eiw}xIJ1>~pw`@B3WsPUSDuL~|TjQ+8ktoxc zn!kDLuG12Sm}+4=?+Y`-zEiWMo)Tv@spSFB&%{Eq>@(t(CxZ%HLk;%Gy74q8{b0W~ z;@2!Y{VuLuIsd0P$bJo$CX--O#{9jtB>a>m)O8X)InZR^)oCW@hPe$pl_eqf92cTZ zO&JnuBp4TY@x%uXi7rohiNJ2;>h~Rz>?7OSo}IxAXXs)^s)YD=X=##TbyDaPifPsY z;3jS$_6lXL?EHc*v1BL4kebaYOnZs`!(WS?vSo?cq7`6tky3Cnp|1>7sBk@iu_Q4AN0&P zQcY@4)ll}gs)Hi3)IYJxXF$UXj?wLQ*UMf`9m}2yVyZuF(D^F;g52dQ(xYJjogDBpN?0bV+XpR76r`bBz<`+mjwv3 z!O*Ekok6Kw-xq?5gQETSQ?Cez@)?rW9AAv6D>qvB6Dd_PXKwNyPtN?qNqQX5a^Oi- zhop*m>6*q0^Ta|<=P)u?=0sl0bZ;?WRR-4MmvivtM^5sw;O=BThpW7%SHrw0tXh2t z?6mMW-eA(D>$1P73N*X&s;#N6KT8lIYJbjwyOOxPl(J>(u+3Zl(XBv0%E7G#ahKoc z?krioGkRQ6OY9jU|9UJ`w^{08WnqelnxTYSF^OfTP-f0?y&Bk{a!*`Aomi$t#JA%P zu+NCkoEDU5vugq!{Gc$ELT57N4=CL#UWZuwj+sR;o*&7_Y`^0B%q@mrx07;L- z-J4T!ECtcK{)jA_2koTX!%1a0uc$E?p0RkxJ%g3q5_}l`4CwMA5xc!{Q>F;HrcRyi zo~CV%>aa`8!evZZ?YoOYp?|r1OC*)RNUhCUmhZv2b{DKTSs8XPa!1wH&L$0`yI?y6 z@abI<-#0-xp26oIUG1v`Y=`)Fxox=Ho5F_9#6JdTCsr?F-f~_l@YW+~ckQ<1fQ!21 ztbZMawDp^h)$9wTjxS;uy&xEnPUs#*eyDHoEQ)rnvD}i4ZF)G=+JO!5J`tp1!j>y7l*qS44fb2%std*!oAvAI6td*h*jegeC(UEeaEcyIFX%k z)3pK;eNRl4h=1ds-xGMS;5qUSSZ~wo&YJAE!^DT0dBO42uCwTZ!tQYx;uc(*HfCzhP+52J&ZRVo2x&+_3r*vjc8kS zP<+L6{US;hrIG^Pc&b^w+3UMkycuyJ1SLv!NzNFB)vs4KFE18AtEDWO;cfCR9B-T#4ea$eQ8_1YsmcF-FN@G)A@ckb@E%0%dFn zHHl7-X6gAbfV?vkQr^Q8{iw%wQ z9Y|v+o(`HybjS$N{~ zu%b_)#ngkbFr(mcVRS)#!R^h0sO?W_jGI2sq_c!a)h%7xKbFm|oik_gbVbd5z_Le?CG`b#IR_1D14&>%XLWc{)#VTLga!G^Jx9`KmC8N|51G8CsF*<>*(_} zs}map4Vp!>D{*D@tzTP@nqKm?ILfe=-F!VLIf%4ziFSo|C4X~;TK)uzm-x2-d2~L% zxcaA8C#?~>VY=-9l~6}hH(57am!<3ukBilvw-;x3x!TztQU>W~!GA9oN8cWh9<1$I zy32L+ZFerSsZRrSye6t|rnoqajMUFb{QpNsnV?u@s&$q433 zQ88yMU>f;|EDt)taAC`0(vTE>501-9MHR1oklg~XqDyqg-5gtnd`n`P5=(;y${sI- z)%3~jR;H1Kj0H$6_u&NCmVFq8>GRuL7Sdcw$Ha3|s7qkAvb`w04Rj36 z{%Z|a4bmQCeqzNLCu;RT=gJ=cn>~K|>U78rzpKX#);aUR{eK_Azh6+opGx%Pz8Tey z;+de>vZAo+3Fr;J2=dP|N>jW-x^~RhvyivP3hcYMNVIDqAK0zbQtz;B=~AaFZi`1? zR?<4V3&(6my;N;FS9Pr50kntZW2K+Edo0PZW1xNOpj4O9fR!|I1fF(7e~IWgE zyLIsivUhZ5Ux#~5Nep|*fm7I$3YoB1P}~BG1V49s69n0Tq(LnN)f8wym~E{L%2fw9 z%FdYW)14uFs4ya!(B?En9;1dyRg0qwbh~|8b4Ngv!Yuxf1r-^VJ1iHJoBr>3(C|>K zQ)Nq$+G0d*S0^gKW~z0p){`nA=MC^wP4(5w3)r||!D7+g+0c06pO$o`$#0DU#r31ECCV0kedOg?pyD+q++Z;c0v|Xt)~f@W~z4X zF$WAP@`DBT%~)mk?-5f+RDNM|iTE6V*5CV52+%&BO9W3luPuG0)XdJs?oy-GZlChT z7Xl6IMSB|a_8TwLgl~-sI@P9{#iBr`fjUN)L3@I2!QS#6KAq~g8r^P(z`+B1fBh<( zg%urPJC0`b9Fr?@Id7$*%4N1$g#5jcW?lQth)pc_%L>Giko50EAWRbN-M?mrt8Ht|-0Z|jkBS$>dAJC_+`_aRWLpoq!1ox}$Gh5ydCLI1qtG$=7k zXvgo~PA$%5gpQh+oOAynm|vr#@6yXpv`RR=TG(W@uvDi;bcanondq;#NeZNXV-Y}9 zC#)@9;BJx5khR*;c&Cj$qb}b%rw5mq?kj7nlONu2u^z@XUb(Vs5J&rzZyzzKIAAUs zZQ)STKyl^&|CM@QxpFRd<%*Vk5yi~F(iL;y`YR;g)TK#w`|@*due{!nzrop*;8bR%H< zuuE>6Ubyz`Y;xP1y%jUIR5~^>A$L6XPs>)#Tj!uBzZMUv$kNlA{n&)XC2_uw~R_Yc*wOZti++9*#?Yb`p`S3u+R1 ze4E6kOY`UBofPWYm?-+%zHWP`0`3T3_s6Oo>Ly^K@p*}-z$=A*|7E1u*^k_m+*7MZ za{EIBQXD}$9sDx((%n^0%~tK&g@2NR9rq<`Ja;d(YHMjnx5_^(&&;<%oxYGmp(raN z0_?AYxAHsGIN&9>t>Oy85$M*@aGum{Q+4jB zV=t7900d8C$l=Lj2=OfJa2;z_CIzK*Bds!gw4QpZa5O?%rH@r%?U#`pM_#1ODmhe4 z{P9$RyC^gcQ5t|s3#fod^X85~Ysat&<9GuOPsT08k^rPNBpGhrGlI)J{VDgEHBp&kf(>?a6q=*+ zd_@d<%}{}GCj~B-nH<^iSsMEy1>TX74DTRxqsd;AHMcHImu(;ua!i(H=zM6n(d$@i zOT(;dqlu!9Fuix(I(l1$7jBx@kg9y|<^?}0ua<--%;H$CHSk4sqrRVqh_b3tNNZ`=>YAZe73W22+ zqo#Uk4118i_Nfurfns@z!xJ@Rtl$~@CLYI^#sb>9Va0ygI#RNsJ{^Rza0%qZSfkwy z`0ayg^vLn4<+H)4*0F@rx&V}DGO&ZA!~YHvi7;Lib3L%FfTI%)f9-v*niu=3mV<0~ zFQC>5$v$k$K3Qmpk$1Yiv42AFTcR>4Q`+-Y6gGiB^21Ny;H3CRCI$ZQCg69XUMLkn zy|!o`YO)!LjBaR=cmC|-Kd+w?sW2(_Q+86dOWrx$J~5cetm|h(fBVm4Os;x>dTCWF zy%j9pk)}&>{(`aJ9E>Fs1T2r}aJJ_W(QOG2kleo!yjzI!uCvcP_U9>e3&O|e0ehc$ zE&`CEWG3uc-DMz0JErA5ur-s(Z-h?=3Srcd1P|!-fBqEfhynjJI^Xg${Ejs|S2(Hy zEWLh38q5x(_CkdLG4e3!Xet3-kDb;Av@#0B!OB=dq1^~HF0niS^)!7%krRyT=nDWn zCGF>%F}|_;{2t|xwFUNUxAh~(yAJ~`IvY0l4Zdf@!*JaL{#tr;S9VXsCN66To1h9x zjx<-zC&W8H#E1aTrt&ph4(qJnFkHV;=KiqKy=-X29AmZh1vf)b>#Ce0JR^lmV@<-b z31I#o@;n$L2mfd5wE?4-W(edE_DmTzWC9z??`o*(YM9DtsFJtO?;JAmhx?xdJr-V2 zTu9tg9KB@FmY7#W=_%rK{9ycpEySjY0`|V40=9^p zLJnRsYO@jYn^cV=YX4Km*wmrcLXq}eRK9u-JW;$JD9R8cQ6yy*oNtn{YnTldXot1w z8KyzK-AGNFq&&!a9`{d!yO!E~Fo5PzeJl9~bEj-03Nho2stgIXbDOd{kz7awU!}W? zNWh3{i&&m~eDbaP<|X4XLk}hck>H;`%y%_atoz!(hImDas>W|T7<-cJ`~27rszcT> zMe3kltvK^tPRxytcs%dM4Zc>^b2%@R-7sn;l)p5dzo#=@`>NZw7jZ5g2}aZ$KLeN! zmA8Vgy1!54fxqAhW<3`_Mx4Z~oBl;vgvhg?5Q<{jWuDV3-$5{|4aPB_tJ;(Ip>7t* z0e25gw<1GaIhs1JAZ_A0mR<%iJ?(>9vib@f5A<}}dZJvyJ8m5sY(XfkY-(_Qr+@gM zL1Hlh?1!#fasOi0C6`?MDTKzkpedfiVxjF~5b8_zW7;0bRss(g!57T#D|Nir1EWG| zh6;wG5YTia1)UL(JGC4fe|!adzjpq7mHk+d#4!^ff2 zBDoZ+GHP*Iw|RxHbMyvK9MWu^g-9_soM!B9wc6}%$)7;130q8RXX6i=hpDC|P5xQE zS?YJtlx)?^xhua+#@HZfrUN~Z(Q#w!S3}2AjnQ1wh3IC^c=E!c(XW&7Z{mt}9zM$P zEjWg zw8<})Dc-kLzT%3yOupR4VJKdDh4b*eXjsIWm^}I={u>drh2R3vFYN~qy@|huekSB5 z&5Kx3mD|v1-aQg5mic2c*lFc?ec+ z3o&C79AEkb@B>xgb~Ik7Gr;dx#%yc|?*;~^P6J=7U`8)Xp(*asrUzvH=&dISa5Z-N zxPULxSa)6MXC5-6_qR?`5!rH9B7^c;7qfQ^UJy~6q>fLnuX#4j2Eh(L%zTep8%vM^ zkOQatH9sL)_nVQDBYgE?<*? ztzJ~R5SLf0CT*$|P@RCdr}5O<;SrF!Giq45S}qh-{7Z1FnKM@bj&NSO2)&F|+k?P_ zy-+p)zFy_mj$YbNwRRbsyx6oU>qL|Q+>GaSFO)zEJPV?l3q}PPD)@zbiD)9&$*fm#qQYXoMN_w6v#K9n@r5wY%m{E__R7&5Eq zWp3Eis#K*I(`q@dG{f;5(f-x7-`K6OF8K86Cfo18ul)6@gJC~sVpAKeMC5XT&JlbU z1433wp|oZq`xiZ0x-{J6iSK_)6Uti?KN!}L;)8z)-R^pM0b9SiPxE{8M>o20ig!C^ zvsF?!SnHR}Z$vlWyb%40z4hKFyDx>GwY9TePd)M|JRD*;V;0bIuzCp0hvZ=pxwO)Xoa^m0Qsfck_==pL~3nKHlDdWaH%)*23`cx4PpO!x# zljxU@?y5Sed2b6Xt_oQs8&t3?0=eJwj76iXn>MK+4C{s68?#qy8>-Nndktp3dSk5{ zB9AlzcaSgs?%pg9J!CG@+U?yL{h2^pKpo!SYI^c{>cRMn-|Z5}a3-f38c6N*=gDW9 zG%;S98^0dDtb5x0MK78h<-&F8Yg_vVoiGzV8D*{)AjsW}%1^yNJI=3>=M|e%V%jRN zDb?Tzt6u$f%`>c3SxZ|#jLmeNvs4*?BtS>^o?l+ zYJ70Eze^PRw+61$XLM(j^eCwwN0?`^hIG!0&2S#0S~Wakjz62Ji!LSD@~`@D1O|vA z7|^%*9)OzGDZNWe0WbSu{1hAY!b*e;!k*P%cIvE)7_N(yVZHUC7Ql7^-UP}1YLc||O<$E*TMcySL{m3?Ix z>!Si2GKLL#(hX$412%}2?qkDWABB>DJ|-KBHUOf7!tc87V)^PWHFVZvsydkSySS>l zxTGV~7UHbZW}f8CLp;T{5b&WHf@;n9<)aNDph@TRLY)Fp_Grs$5Il?*%~5cVft=HC zNpYBTJ^ASUF?X^3g9|0;leCc4-ArCAWip*T^<$6j3=6%#*Y-0*Adzg-iW{YAJU;L6 z2>HC59{;W%^o~F=nr9N|&jGSMR6Q{fWhR`$Q#u&P$0jY|#(ZoM zADo7UOiV-<0==ApY{s}%@q=&gQB5A*G|+=P&^^{xeRCB$n2OfQ)0cE;Gf&fj2ei-{ zW++j40=`LnIXe6Xk0`H_vz4s`FHJ0mWsNMy{Ieq}3t1D@-FoJ!J^7ou;#cZ%UshA9 z-BE`Bh)Olom|Hk^?~e+{_#S-#&(#b$0D)i)<~dN(Rhdg5CFhN;NSMapGKdn%^DR|RtjVXGn};ok`M z%|cH^p=aB`p4UUG+!^7Vd136KuPGV9kjA5Jk4GFE!}jt6_e@BH^U9@6pg-MQN8*IM ziwlTD^H@cf5}C0NfRV>*puJ+|2TM1JO4sL$qIt~tftGWA#8H~O;MJ{}!9n5kN?4@H zXW*1hF-I-VYbQWjXwQ**==j-(jv;CNO?dx;to6m`ar))OuHU{l9yM7# zv8h9qsAkT012<{4!_sc*UKing=X-7!^_xD7>$=iO#173gRRLxH480&%hLU)QFI$16 z+9S0a1u|+1YLZEOss`cDBcF#8*yx!Y!YH_DxH*=YC~r~i$A+}<$wRvMLCDY+sw2LB z$giG5cX}z#nwOK|wJMi4JxuP=lW6`F%qj+O{1NDPEVnwp(@zs+qlY}yjq20OJ%rO! z7q9;&()$vRQ{Lb7w)6vl9)r2s_K&L7ttMdZn%4k^lX=dbkDkQR`8Os|9ZKz zuY5nVUh1J~xtFg*|F&M~VJR@rH|}?`UgY5rJw#)_Z?yR1Z!lMihHD?>x$DoDoa?DM zbiyg7k;vp6P&Z}Wb0wOBDSAv{%qh}kG~gb|04FM zSW(39zj|SZ;^jf-5`Tve4Wb_XV)#A$YxB2;Ugu$@-rAws-@3zV5*ra#Pvka<#e#&xrrUWDZWv2i>+E!+&eIf-7j!qwT2gJpzkkk6ctt<>URwj4PkR>sjq`TjTJg20^Y>DZ=(w4< zc~@UYM@%WHMYKP^MSrGhQPfT!94Yg%nafT2lEy=9R)fI)M=FYy9&js_%c~v_W_8wq0^_VefG{Cb&hU-XuK zGSW|jl9LdTlk6An_cB{GuvjubNUuRBxIAb_y8NRK zSjPXzX9jBbB0sgrAqp{d<8O_ON?Uc8z}n|?%|P|G>qiYTdIXw39WpOuKpt2BM9G*E zZdoh#yLo^8!C=kWZx}UBpUK%}F!W-Nb6zQc?ue!TG46K|Ev)Lt?LRhAaLyFffE%@D zz|xNW7xWlqfe2sfKdw>X^t7B?s-0e3>z{lXtR?#eqNMU%#W+h;UxoRCmgO0(LH)K- zM)`^iT)aw2%8()DuifP1(3yV_TrFZ1)_u75q7((cng%sq0CTt<7zAKEUwvY&|_{)oiz!(UQjx#vCrjg(EgHr){Wkx=+w!+JbPKgsq*9J9nMDG zm6zI;`<%VbFV0o^a{6IZLO&f3p}IxkA>7vG$NGo2 zzn0#pkhLt8OGqi}i(6Sv$kVGHoNWnh)YkSNY#Q1AtnBda@5`s6(C)~w#W?THU05VhtCuX4Zj=|w{d1oPgWS-Q2pR8@u&@c4}6PZ%_#PBOXc6n z^R9)L%^3-P=6=V?CxU;h^e)OFO>%>7_`S zbrfAvNvJQ0k-7Tkfu=oA+%1MWea(M~OIgSioCm&6l#>|q0<<~Ph`vs19 zALnNyef9Q>U@H4%F!TMq^3tXSx$C-6*V6Lprny0s6PNN1D%F zi)mD@&8B2$o<-aa$a=ZQCS0C9n4w=(3S%p22rskvXeRvf7!oET!kKPx5Y4Z;xy ztd4;DaIHG2#?o?A{VbQ9ddlfSZ+N4@)XL`56Qv!_AG?VeYEdKfNA$^@)|>@g;=2qP z&!aAS`NVUW&>!X~e)?2SA(gDir>p^bUibdo@Arr*q>tnZ zx;ei9z}WwpZ{iK*_{S*EsA_s76|0k^Y5=HCWbt_eg*AKs@*A6Rr>IFzL#j*%g$UzY zE){rs>qq?;z3(yx=rPwaotc!!z)e$Q;l5&vdSYUWFOK~VAB`8iaUMT^!#ZB}#%%m$ z@5hX{y{8$S@;7m{JwJCWhmTayvj>y{ze%aM`No0GxYYnj0p)+qs}x^Qs1cHyYf zOOdhLyDi?@t9cEKo;@G)G#E^qsWwCDyd!rCVu*OSjW1m+qw1nm~+;@N$Q7Tbn)BwXW&E88B3vX@tLdq5{XxHod&54oh@mq=5B(k7H)z9ivP0qh;*mHUo9GZkmDlV zA`AZ37D)u{h4h*5U+w}lQd_+QJ> zU}H{8YkB%zz{Bee^v~a(#(sZ_z;9y4g5?hvWy($7tLY&(Ry6E-t2NxIgSAYV#U0MB zhb_PC)mpyM_{v#Vah@;-X_T0|SWc-hI{Uh8Ks}_scE`KUEtC*;z=IQBGjfUuDqYqI zHefI5E)tqY8u<-&8hO*{;j%GLl6@8H?wcw|hOG;m zsj~}*jJpeqXj%?P(03{|;#R6)9ajU+y)gopvAp8Pu6L|OHI3eS+DrG!lK)XiEac=X*lFuoHIZ4&T@)Et-wA^)n}ctQ%WhqJJv7=& z7w6VH9mn?xBV8Ycl)c$I8mD-bWY;jN;k_VT3xn4ewy(l#t zha~y&yFcHZ=y+QmgN-Pq8|ic1MAj(Eb(C;z#lBkC0qaM!@P^4P+TMZd&0JBazZ4ye<$s@*efUOMgp~t6ORm144K9jQDdI%#7{% zKQPFZ_GAS*=-J7Umjabwya_N$H~>ZouD~c^FH^HhLBEXm7`;`OkFE+r&5ao;9@dSC zqlAkPLE-OM%Nr(wwciPrG{qv&34jFQq6J9aJ{26- z!uMHgOImEF0FoBHWCHtGHrc-`7G5<5HH%hFOQ3cT!kj{+X_L=C4Hq~zYaH_isT z3-D}%BdQ!kB!MF+=#b&W{rIVK{rYkB@UP+3N#!Wm!wqCZ3JtU?83!zW=5GRU-pJ9% z_Lg+`3uBVPLkvAXhJMy3YYyP(RS$-PCbx%6PV>)3g5ZLRDCcj1QLS1B1K3ifgCtN_ zPA3PxWd8|A95@JjO>#Qpnt}B#b=qoYwKO!#~Hi%V$-OBz!l^YXm zSQ%;ZiOkq&kF3EVJpF7OztsFN@}T#eB8A+OQkdyAJl+cT1J*gBf~3FPYq)K?A-b7~LTq@$X~9#1*@3@$@~?gp_}nrfw3Tb$P}lDs zy0p}SA4>~Wc%8(@1_RPhwZNb?f*bxGC80k2)A@Q+%kk9}^^17Y#;c&$njCGs0 zL}7q%Flr!i3){Pau2MgO;Dvw-gn?1D6)-mTG4Y4Ik0*q=fb@bBX3}`Jfw8kr{D^AJ zts-E|e+}Rg^En%trBiX#(t^*4>P@0Z^NxYQ(lj=_u}EM}LNGA6ZAjaNcIgMibdpkJ z3xKC!5w{*(--`GlJ8*)3)}{N32vyL3wMYFQV>k|Q8I{(A0G?poS9`Ty!%RNFTy^l0 zk;*=FLa22x#mb90)%m!7)j+D-B1b^Df%jTBN7l4Ko01Zh3DwG6N7zn7aMQ;~e z-+$?9d3&PDS?z69vjjA8?b=eV8|*s~>RIVNk85SFF;0#K0{{IQ@9;3`KQU(iwQ z)##A-D0{&q_+?f2ayNTGXZWtFrDOgnr*N~5e?qDmz#{Vt&RU^xOr{XT3Zz_Ec>jtQ z$_vocW1tXHfSKF@GZ_IC#^irw!W$xVeWIhyJEpxN8Jmz;ZNO1K_W}nz*Eh?7vgL1N zZmmcrgqg1a<*4apYZV!V24y5it|rU@(nyVW1nM$arHGKI0)BCK40%0g0-G=jcwC`L zARzwnqW~b5HULz~I3ebe%M0ZVltUIEVI+ZaNCJR~0X|;<$`OnJK9@X(>%m(VN`7rq z!JHopLf121>{o9u|B-BUkglIs-&dAwt*JvVtg;Bnba8HrL2CxE39KzUzG17g>O-uk z5+O=2RZ~i4cK3MaR);|D?e;Pvf@Lg0QvhPJSFj24?1)*1vrHlDgiN~;!YvL&9`HMW z_W2$I!~!!=W*Z=lEC$#WxU*$1HemsE|Xu0cXr0363GJ)s%r;-#qQ|^`3SqSQ> z6pk6su@_vlT_pR<>ofkA&sY2A_oxw$$Ka(u`3pRwV+ph-3ZC&mOYw78Rp=CiSFD4_FV*&t} zz+c}J#i)sMbF4D$*DF}(f~Xy^b6EFcUfi(&EsG8X1BK$*vY zGQZnbt{DKZCLX|=>{LR`YM3jNWDg#^_h8smhqJkvrHZ;E-U)Bt!Z zD47~JiSY5-Ap)7yMhO0z7s>(vJ2N`=+=TAY{QcrvC*9(y^NOC0=B7wQYwHh%crP!< z3zeFbmuRlkEj=P4*7Nv3oYfYC21THGz_w^EupJJNePs?nftNS;z}T7A6B4(SHHqp_ z6v&Q80kuyBYM% zIIZ30FyQ;@g9*6jh($L#sUFSbV^AKx74xmBrIz>CUV`ugJ^%PxUQ3(N+ExtjuWd?c zt}krT(qFI%mAup2R3;h)leG2UY~Q#&ugp-(Wk#Xyo8}^DG=Rw%7~XF@R+>ctsFz<( zV9E-a&oNM|o#4p(K!^x_142Yfs{j|e`t%DBBTO2=#13j8;=6!8k!m_mDv-!>1ZYtc zz^_aIOql^Nx}RCS_4qgtbiwH0%4g6gr$`2zIx3#0AN=FiwIqw7irC3 zzE;hPVzrO5?NMzBiZoD5d{ipqJUr_GTdO8&CEQ?rB|MB9$s8vaA&mv*esp93Q#x+% z(jRN|@bf^QKq&A;;~>R{wfy|G{Id(8a|;y9Gog*8ls}sJo!yOgv=!%bgQm#0s=9eV zd-bQYv9BTm!qNOXmJ)`R5@o{uyR^#wDpm4a4(<~3>rPXUa2zz0#M?mP4P#AXgP{c>3yvU^eehTaP$2{89S3(_i735c`y8X`HqyF3Idr3_m!hOOjvSyXjd zOyyWq$+v^H0Gprzn{azwchS$ zUnQoG6U5r{{_oC{EeIBpN5Tm!CnEQm8*^O8CqXEQ^IMP+2R;n(U@TRM#FnBs)Gg`x zm^es%IFF$DnQ-<5ssNyHEr6A^4Fo_=IjsP!?CJraP~1~$&)tGtnIIU>)6KG^@f2H{ zu(m|lIUobN)dljw;XrDbeK+rPjtVRWRt;hro&1FTWdi%FV+E=drdm$?xtw@)U(OmN3!j`V0}jfT@2NoevOf<=(q8T#D?dCuTJZa{PB|K5p{i~PT7JzoHKpxUKBbHC#Lmgu7MuGUK_Ti#yJ zOIC6$%O$JyRw6XK*{|^DP~|VLyHm}-Ff@@8ui>u`xhyqb`(Y=3-#j?D`@z)eAWeef zk`>1s2qFggj8!~tPMbW=tF2H8>Ud0wm37C^yRUU{t?z^IAJNAD^*!cOg=2*U;CA;0EgMg;#O=uya-u>kEe?%-N=p$g88v^h5hO=qdaqnMgW= z=5Cko^3?9GK<0rnxzB+%iJhTo3 zF0)pPUg$V-E68f}XpC5I#qbMQnNwNu)Fl6`zZpK#4jOeMH(y4sJa(l`ATJuiM;6wg zXro^(sgE}ug|5lv-OOvPpdKB5nXCvIMqV8ifwDO#?;S9K@Jz6PW$$#Xk3tz)yNy|| z7dy;q_}*nt>(uY$WrrLY{8yG}F+g~_p%@?3gVZ_~F%J4FXhkbzPvl(Jww2y9ltE{T zS=WzoD_&0-uthg4_>9Lll*!pj^FIvO3_E3`N4vr{hCb&8PH|vI!C6=vjvtY$mpzXZ z@u9hlIlB48#r2CICo++mIBZY+GJYN-NZ#wk-fWV4v?*#9gzv?oZki(ZMJ4NTtushb z8`@)=4SUGZM;%KeLxmb)zu+-&huw7?xKsB!4l|9*th_WWelE?c07j_4aN&iy@NOMm zen7i0E*oW6f9tV?UzWa#3otDSKn02d*rQ!Si2r{qeRouoP4o8i=%YyBfD}Qxbdg@9 z7f}I0ii*-9(m|T^mSUk->76K56r_W+MCm;WN{0vpA_NE|wDe!z^L_v1oco-eJF~O1 zbIxjYr^>0R=m5aRV&HT;G<&E z?*i5nnR@+8E->WoL?YhL15XojrQXvQGif4;y@yNW!~Q!dvIl#8Yy^C61mwbyOE8%I zAR~u+;-C`5OkA~tbefP-{hwY2n82lT#DUq28Ut=}aai`ae5?xBB}MM+)T z+~G&vXzp_c|4EM*Cu~8#;iEcM_G5o-%Az;%N}%t z0t6AVa#4{B5ma>eEhi4C^d2F)ePN${MFx~5OcheL-H!gFzb>-#!+-;$@>@76>k!~@ z+&F00s~#13O8&HE+V_d>FA;P>KZ!Uv?suURfDXO26=$qGf|^M7TvPXoiuzPeNm0Au z@0Ef0u3}}9fw0K_-rJ)l(`NoK1JRXrmX!HqULtD~r;CRnV!M5L?pwrVxMuJQSye>;9haSX^G{ z$SS|&zWnF*(j35qHb5#m6lsv{1KQa#K3IOvQlPjKaF8^%r$5Wjo)^&QR)$G$p61A) zMbg-Se=D6+JpOsk*01kC#ZkN&oM9@on} z@5`TV2Q0A&SI&vy3tptJv9}qdZi)DGM&?HTCo|gL-LxNJatmZ6-ZW5-`4CC#TmlX7Qmytn^;Ehxj;TuMVe=!Rua~*ZT8hPKPLVDQQIOWPLVmnRll)M9_&Q-8^cDa%icJ*YKX*~N z*`H;?zY&+IOhL=5{t)EFe@-}yvr%ja@!ZQ#*%o!|R?F0EOm>~de9>+4#LB8>eoN9xt})RVWm?kCiE@yOq2 z94?M17JbLn9lnHbk4Xys$iLb#@SpA1GAJEi+7BOh^OR3_*DzfBFF$i6w)}WyevT^x z^u*ER+?WB;z7W9J{48kybjY@}TkaO{`X!n>KtV55VGO60kLJqg6|K7kUdx%$Qp$v?~IlCzG@wg24N&{Jme zwdi#|Sr=S;OVIv<;*t}i8{fUXpzoLjUJk^@t~tM~Uv&kK^Z;n`oiiPCKWzT^jh-F> z0(g4?0VNA~i$5%d$TOb1Nnoy*+@a`)Hu%+VeuYc{fxsUTFd}o%k5fs4;&)%x4@>#6 zp`wHEE1Iu~lGqSjqz%5gBNg7fSetUb#rFZFpfs4 z4Ksk&^L(3eBFa)RK>{ZXN0e$kd^dIw;AeI;gG;W80;*L1R9<>I)bkx(jdA{0M3oqi zy1f-+J=uo4tDw#l7paukt61`IhZz2iWwJdU>iGqu=UbzE84nJ1Usre-8U%PKt4I|# zk`0o6D6lRrFVq|4_}A_YrM)`wa5mq&FUy8sRkYR-#^o}hy|6r_U0RO0tUIjzro7f$ zXlvD9NLr9s8vf?cXW1j@+A>zn_`fgim0)n>vLH@#SvLm4cNnYAZyng&hwXdrD5g8H zuvFq#Z!~iEy2vwChj?+Ov@p4m`SRwxS;9X7w!J3)rpMseKW{sn)?)*vKn4rtwJ3vs z6gsCkX=MQoIKO2MlD^(yK?fop>KZx*TYfQqOhFXm%^YplW&JnN)g6+@R6^BtBCbla z=m43LB=qul*`4fB87p5MGE@VvLTn5i^c!F|D4K`N)SK%@ z-JDwQWjSd%bJDHX4v z`}oAAr|YB3?a$(X38c+1tuQKJp;nfg_SG^kcGql&1bA6=puCR5mggd7Z*ydTT;`ud zwZR*lj8LYUApv0ab?4*0t)C=JoH(LEL=2QelO%FGLPyU|Jo~KyIa{0qVI(TcpVNdz zm2}DN2?8tb$BEdVlLYp^XFRO3=;Z{fc=6?QzeU=r3>9;SiGEf1B+17vjzX zcl4j@%2C)iO&2}18R7R^n0-{}?Ct3HJM2Z}(fCB&sW8WLGwZmPWr<|0=jgn7UcBFw zw&b$^s!T#26$Kbb2}ZY5+YaBJrjCo8!s5kC1Q7tmFiM?TBKrV_}Np*#5X;km%@MLcF$Tn+y3T9B?JC2})*(WhHXPzx32 z9HlyILDZTRS|4pJ5gVdyb6KagOyu4WBz`h&{2^HOY)nO(#U${#CGXnE-eakv);MuR zRSXNti|uB?ImwYrJdIryuay z0o5JU`)II|}sjf|X@)yz;Yo?lLychHi7CQJ-Ra(fDW+f;UQzLPxkm!7VJ8=Sru4fox zLWU*i@8r>0unogvV|6pCvSqg^%cYr&gTuXgMO}riWK_wDnI?X7EFk{O{9sQ6wsKDs zPaXruK?^9QbSD)dt9O;wE*0MA-;b(n%=q-)vVUa}v>seB9S@_6Md%u?<*ESB$8sYn zXV&^xGfDv?+|33LsJ~F<3_+k7)$H6!v%KC)o;L&ZUxthu^j$Y9$a{nf{VKKm!#TI0 zRYLdQqO8$Yr(^RWq%-uKy=jvfkNa|^*+7Hwf8U(#HA7T2Ym$y?ma}iCGu~(rT>Dei zYCS4sYM(cw^uG~q6s_VY4Z2LTU(qJ}i`kG_vk~jsi`%?hm-T4sD7Hs}4m0NRCJ6+DQ!}x;(bJ z`kTs*X_)6=TU~ggD~>(m(ya{kmy$| zxkm0@8!^%J;@tFISd-0YG;T#QWenZQK)#%mTC=)7!DzK!Xf;{gZ`ZVOesv^`U1%ix z+DL)sHuwA;S2>4ZP>Q>aGURo$|Im?qM)c4rv-^6=rn{hO>b}76%(anu&21hS`}I^? zLD*)YGYI}%4j2r|bcY1%U%_0shGai1H7vF2@47!kU}0R4+_ciQ!>6JJDd9_vN&qAbXl0UD@Du zD9=We+xZ_6f`BGQG{YoekzOeBU5hJNcea4)4!MMJ8YFf?Mh&*TUrr}{aXvmDp|DL8 zlc=x1Y#D4PzMOur#~zl+XvmBy{R^S?Lnp1)OY;^)d_Gg$AuO2QLE0TZ$_T|yT?g^K zORdzJixBU7yQQWkevk%-I<(gh`*!tbh0c1cliDWh1p*6RqWc0953N>f>iGg2UZOFp z!TpY3D_cKx;gYFTPPB2+#}ajwgN4ml(fm1=hACothcdimZp$DBc50@Ulpec0u`L07%=D2aJ;0 z3a9tTJoT14jc(YzeLS=Ej*Nt)0!;|THE^o4cnGJ6`tvhgK)*pdXd`Jy`180xT7 zwERs&@N$e-hxm8IILAX&N!x?CCIYTfyd zN>e?wP)C4%e6?~JU__G8G!%=-<&m7)bl{9?-|J`Uh<&9m*|`6OCgqFHii`h@VHB`Bzg!5!iMz0LV#b?2;YJu15{NLQsKn-R{fU}+$jgxVuLmxQZP|(vVuZOyAJsVAtIe?xc`$-08qfou zu`0Q#F=NBvtg1|}z?v-ez_F&s^f001R6Or#U_YWwBOB2%d(z^YP=lAd$H+AZtX@mytO&Bc z(%vwh}gD`7^a6Z}M3d(~-fw zjk*W#k0QNCM#fV!tbA$X`iAyCFfmXAxVU9r|KWMCW6)Mj`gBnEDdrjseBD{3>Go6p zMW5c4**P;lU%!E2oaDH?>{KmZzzH`Z{S=zh&@~=AcXu6Ve{oz?c51|;t=)R9Ioxgj zUbifhe_tGC5%_3#c_+qPgY4rO*O#{4y4RYA+9$+GYxBrF6AJ6SzIpCcggJjRohS&D z=@C4px-8D!{kdFxg+Ac`)N-vRynZ`3lB?LzMu*Jv+qlH*>mJ+sJLes!7mN7+gRS{z zF6(Q-nEE4o@5;@wL$Bf$=DuUvlMVn#~m`CWXivc$Lii@mfb?Mu+mWv*qsf_WG_4ge&_o+MwExlDL zuRz*z*Z08u)gXmFP^X=sTBNtEPi(WZCjp7w(rU^Wr2NwskdQZR0&Lahrm&{sO22m) ztS!Auhjrg70>)CmZ8{xu76(UMqv#Hbj+L_MErm|%*}>@I)(F>9Wz-( z-1NlVMFx)syPpgTlKLEA+3aN9VEv$gFE{;Zq8@txZ9(tOzkN=z`)x+H;yVS~+bHfM z8We73cHnlK0zTPv!`}qR#|M;-TRmz*x{+J1=OX0Q5YIcbugMWUkjrB8MoQISsDJfi z2TIi-BOQhHd}_j-Uvp=9n84-o%V50p6t_m$+N8K z$7$#wzA)s+-4XW5KK~Ewv7p)ZIo5SEa^Q_r8@&SCm= zpd%-@|J$#$%K^(C%FRUSGL@mb^F8mR9cC6zYIetc9)d|AhwX_4<7PyM?uWFd9~dxq zFK|pM$aU>D681tnPh5j4zLL*OIVm1&IriRVMB(pM_04<0IdP+Y7sXz{ZbG z$@%>y2_L%WBX?pxdB(4-;FVW_7bq>B?Jqt2E5FiNme!UzD<4H?nO*Jpw;5~?DbQ&? z<02ZdOl69?iwt3YtK1t_Pa;J7ILdcWbL}k0?P>~faowMq_vMirk6RXr_Q_lKx;o;w z8}af8LmKlbDWq%R?&g^J!v{z9KG6NdGo6BVk%?i!7?)o{i!VMP&-4h5cr8_-MukGf z(X**Gddqk6+kmU{(Dw(d9q`Q$eHxQ(VEPM}8`5@buKSK+?y$j=TOYA)MQgZCuab~L zXRB5BQ(5v<7)aYA<4H!5Z>)BpK2u{Ybs(CcO_V0Y_BYET3Vq3a9&7Rp*{CH-CFKM0 zrZZ3jmfdWwEb>oyfch-WRYop$)tpemGTAuhIMw=>!gAhHv@Oys-!qx|_uQ{s8mT&a z5+>)@Qq+;iyshb3T6794B-a#m)M`wkMi;!4^;K(ciccLAMf_+M3aYcG%0EGO%H7rm zcgc^+$Ce!ZX)b}DYoef6(V1zD9E6-lHU_F-eaHS5rTTj$%ZdA48AS(7AAM<0hgF6^ z<Fo0l5CbgavgNJG07(!6HYVEqdd!Wt))`XQ-b?4FseORG?vT&Ow^4 zPPbsn(;izEZ%Exur0!AM^pizurs4$bx(Q>wDwlI~d*htl6C4DxI3H>9&(GRUG!{VQ zjR@>eV}76K>kesVOyfi&yR+uzpKh8(X9u$gS&5!Si#sEH{6MB(d3^ql`FI)TC|zRF(3kIMQiFt3D@oqrWB*8%*aZCnf+Rfi~G z_soyH zJK-7Jij}+*4gNO43cUjKZyIF*r~%{B0=PGY1_YxkTv=B|0{%)P0;3!>JN5zhpz0_! zn{v0PoM^5t*z0Y9EFA&iTJqE@EdPsE^3aQM;d{z@L4XC1_gKeKjbk+tV$YXsN~=P` zDg6=TRRi+w03oE@RV=_D!8D}VRVe^^2$@s4shHg0EQ++G7$08#S8AM;3U`GMlI_1xuGtmE_GV>Awdvkt*R(;_eQE?U|a0 zAn9tyls`{9sKC8BZF`BvwU2;~g(ly^O_%iayXnE1jg1kBncL9L^N@DnEROJxK$}1u zJ-=-!@<#HuxZ>_TycU=%g4*5#GN)evm!Bw(88njxpmQ2Ijac7UhbjY1Nh5vL1l5;| zUW_SbH!82IB~!isQt^JIVt;UFwsaF&5;%VrPnqk-{Pmj%Jy{F`&2|=~9=G)+9$yNn z(~qClI5q)W9NYdSKPKtGrB9A2chSWlXTWi4_iU}p8!C|_PGv?e?<+B~ zbH7#(^O}&ApF+ofhaZE}pE$#v98IW=EHIRGI3k%wuh84M1%boc zP^$Db+qVIzp(QN*y-fv?Js^!zn6IyB<&#O~_t}YV83nkO@GdK+6-*cZrC{Fd0EpSX ztOA)C40O$rRK_!8v5ziv{J0gAwhHS;g#l?fQV}G0M3ZMD^-Tt3 zSOcbirX1zEC$`KpXwc|?zSj9iKCL152pY)BuobhLg@P*o2sRh8hk&Zi1xw;>!v$?- zglu;p++?nCZk?$}#0!zCKesOzi>y|&c0j+wVNG`5wfuu29QGxbI zL;$>H#2CSpGB3=w=+H!YatZU?7ZRP2&1lOZJX&C{??N7J|4H$DEpPE%%MEX1#^%@P zCQug@5Y&WSG&Nf=CItWMc;~yH(guVJtLe$xBNE)$p8jV3<{+`F-A>EnS<&ZlW!Wi{ z(l&nX(j1<7fqK*!!hwC}tf!tA4O{?;yRc}zsK%}uIKZq=?MG&*NCsd$b&k+x&@B9F zewM-@Cjzz=+rh20hPJJO70BTNQ#i|x-`0o4SEtSpm8|VQPd@Vo3~={u-$g(dE%^K@ z$pgkqF4it?XDm0|`PzB`=vh+n^ND9K*C__hg>GZtyrKik8Y9BJ1u)6x#nk?CD|f`G6 zX%-~m(gRo`o^n_IYD2vzh&XnKl<%`EEYfnJ9Y2Yr;8@u$M;&KHJFlRRfAnqBM)n%= zR3o~}qb_uGiu=b}3+d(UvUQgi;tFg2+;$7@jbOEL3IB02s4^mUsWB^s;5lNqRkdl+ zjpE8+GHBT}%nD6-@}~-$tTnB8t#|mwu+DU3u8Op?l^}NI!yoNyXV@A~kD+SGWHOR- zHjsGY8wPC=-T#QnHbx)c&Oe@Lp&c3RY9eQTp8C!nEIVo}MMvG35PLFD9PpfJF z^zq~+?suhzh9Ost-n_Y~CCy=2@#;#{*n6=HfScLej~^?)PCHbS5kWQHG2PzU<@%Vg7ggx$C#%j`FQyLY6M*W#=JQfq0>l6Yrf3DEQ&OXMeOY(LhBx>JL z?}zmE=q(l;Ph=y%lCv4v40%0z963Lx%Li1Vo;r`!9dw{Mc^F$`+Y&n^B9{6G!sat) zORzoMfoZm$FwGD6sSCY0W~`tuPVV#ooO!hE1-BHZB1cIuIjn+d zzBe6_9ecyRY`Ev}%b014v|To3aY#k_r0>0)f@L<8IxosfkeJWBAs?E*bEC8bUEb+o33bRUut=|Gf9hOK=xyQFQ`y2Niqt_{l;e7RXf_(Q2W$nv|+ zw5p*4djD;^Xf`RUuQW8EMez;ZDLW7I6fdul?=*EB6maHxbKnUi%YQ4yL!*WF4RlrB zlDmr ztihd9AA5ry>h2$yJ)*9a+}x+---vC7afgP?Gb1UV*&-jjHjX8P6U5P@3zh{<`xBR}}&z zFq7(Oxoc%;-VIjN`v>R!_uJswT0=8FP-6J&&;NeI{?m0V%{${v{`4j9reqgO zv~13K!FKJV^2&N$Y%+4?`I{wMrt#LH@zCV^K#ij7m>I}Fk)?R%Y^z+0s@1gr_UW(b z-6n5_XXQDgok0nEV_&ozI5o!fdHaW@M`8cKKbyTd_4Cau++b*m=eU_F&&gooR&k!p zsfWJHAL0B(*JUAoS1~g>l~@;#ijKetZD8nizHz}=}9@Xz5MelQIN~2K}9`TixWag2D=Bz8g55=n85U$ zzVFHB(HI|HgVs!?71TzX2n)?m-jI-|b2P!GFOFe4vYuYm+=sbIOzW^qkLvR>c-ujR zX^hgmRSa)9Fk$gLvMeRl<{T+2Y$uV2 z(}}?|K@7wxm#t^%=-Z{W`#%IRJF|8|bt7_yJH?6H%o?qwg} z?T)hF2KEOlBWEDm@Na-YUl8}3^MU$alg)sYsM6i}dsic6Y}RIj8?l3Rkb>8}dYmXj z()&l{j9QN-8;w0N6lZ?qooJqV-P+CYm5rlXiAH|Z&eOD6N{_i>+P^wH8!j&|P^Ua__X?yyO1{U{UbP%&E!y|Mh zrBcnSx}$peA{N5Brg^HqFzwfYD<|1`!~V;qH{N0MEY%>3CHZp z6Xit8{$Rf5Gq*O{p^tx$wL-)jbmXBTdB~@4vu;6!36_OFTUef+Ri4Qd`NuWKeZp7o zzqMzo#)P*WkDyKFW5me%4)W7_{)bkQj8DU|>Vt=y*H1(kq_RzuV??doAq8azRJ2&c z&+obuM{n$BR$n}cCJp&-2fCdmB~IR(#!2PXg1uZLJAGTol?Uol?5mzGA*aQ^fI=G5 zI<@9_=*zi1bgAlCxjUkZX`_||9(6hpWIU47v{=gN?}j>mYWY7Qr_z_wvUGKz{_wZR z(US|IDb_cPPg$B5{A=CP_5_p^p(Vd)Jg-Rco|e;y5BrlMmBa(S*@&Z(F`{;^k>v0m z-;_HWMD>5>T$DOdgnWeAd2La?%WcCwo)Do!x(8`0b-J1A(6Hf>rv}nRgfb0t{F%yc z!F6+u9y9$3|D8$I&#mWbNw9Ikjn@2S7_q0=hjChC)pWM{(zp<9@I0SboZ~w~n&%Ep zCv=&M6MSzzASXU=WD zm!tU4#GuS>S`|vkWWJ7UP#=SA@rJ&6>uH$}9i0%&S;GB3)N7hFi+*Ll;_NGB2N73b z^adf?m};>LgR4Yp{;xYCZG@)Jo<=2j-wBIlZ?V&&ikHy{q| zpZyg=ZWT%d1-a#i^B1?lPYQ`?)+1FXcjf#l%^iYbe#+q((E~c%RvK6{F>Y(`4Yz+i zhj}l@u4XbzOWc-at1%sa`^R~I(y$)hi+)}tP3J$mq4x{XrkeWIuC|KujkOzD_zOCh zphWR{0{JJr;WJTn0+-1cu|@c|P9LvqL`vXxC)=E9OQSw+&jV{8TVbHhRPhuD%~S}d zrCCaoOa97EkKOz|kElRudskRJ0w>$NR4^XXKZE&1V#2~CdY}oRX$=K?$!jko?(0pi zkwwqEz35=I?#pXdCnueMMW$Uk)*@7kL%tY|3GX~<%L>&uI}Np)6U>>bz2GJDze)1R zXW{YGby*<0R%TI~ewwG2>r70vVQc5x=xl=FIgevS8>H(pd}QTjE9O-jw>t3oNnOv| z@Vj#cqZ7oNQ;mQU4WatbCy;-^)}pG4t(l0;KN>mvET9R;$GeEPKj5y6R8)>o%3kpc z;h&}uatJdcGX2_mMZ82V#|l!mvju{ZD=+VO2dUSjW&&mq{+uofTH8XE&ji}!Rn78Qjv-u0z$EJ__Dn4*ZQ zqo&IGcTWxb#GolQ95cW!&Mq-F<5Bo-&!~N~+FjBzpn_OB^VosTZWNTV%+ZnDUB#IP|@dFga z5-sw<$hWW4|G3!ax@0Vwy~3z0{juU_)TdA_v(sy-X#s9;4e8LvW~)+-QTkf=Ci^H&RMwHl4AuSVC z$H$xnElt`EOSxY}yVGC9Cu4ZZnUy`=eWl$%N36PRHY?;QL~N_9;-{H8^nJIryctRN zq%yoL;uQOvQB6 z(A~Gk>yLSF2uYFog3jB%dcEtLC~Df+W99Xv-3Dl}^jBr7>uqQchw=gAh?6(ddDqf1LYpk|@bc&7s+G?c zsnvr1s_2-@ZIT*dxwOyk)F~Jb5vM7l&Rv|2(9UkD2MJ(jLrWf9pc)DK&yLa=C3jeN z3*~TGy=?iWEkH}n@I~?qV}9*t;zE4vhMMhGnfI381}N+}f@JisbRRTO%A%!lDS`)}z^4*1Zd!n5#L zpd{gp+24AUMoIZ7QghmCsk!|=UF}G9qgjbq5_4h6a!<9omygr}9qr2HB{<=2u+6#5u)kKTMzY?{e zu&cAR(Q|dgB4gXp(}q5+^HKHIi1(v{gZswH;4epPaO)2C zN4yRu<=!MW=Q3uF8I!@5UNI-wPUY<|w!|?5CR(a4#|z-VA$8nn6r~QC*vg`zgQQgk ziQ;!jp_+3vDH4ZYrvA%E-Veqj#S}G-_O&axDxUgP%-#^+>9;%Mr`3wB7OJggNrqaHq&+AmmDecBSrcfbuXEj$P)aD zlM$!!CaU1Ua<<+2pHUxcRkiMd9I86rg7ck%l0h43X+O?EtRN_*R!w+etEy6h9`=0C zrFd%OQ9-T$E=Nt!wFueT1&U_gd_#G~$+=k_USZc`>{K;+S}R8)nl$DSe0F8F^Nw?# zK@J*-^=WxWw#5f!qa-ZOZZmie!eyl-sAzVT=-)-<62yKA8aG`pL7b0Kt?T|ME>4D_ zrD`Lx=Mq0j61qMPe5W4iX3I?;8*&DANlazllFrn*om~Y>^jkIIR0C3En`enShP3TQ zi8)OSC)!{;Y@;Q#wBf8m5k^c-@1juu6l-I0xZ2j@{d#h^&{j88kJ4484NsWng=M9D zz#n5a#A{vN95)I`OKD|Fe$<_R)3(m9LaY_qbIL#%5wPc-(?Eal6)K=CEr+t{26{)Z zqJ)nFDSb}sUwI)lzbFKL%2qndYlJqSJ#SJ`LAV=3i58r)hX$p3N(T`@Yl0h#f&h~{?nqXpQAB(=KP@YFX{rO5FHfpChCUSrs6R)JTV;>d_WC~ zqd23}6|Tisc+gWqarqoA7=Hmi+4A(T8_-)>LmORJ76}o_tURk?9*Rj{tvv)6M~w4X zO7A@+-v3&0u3}EpF<`dh)?}(ZI(u>CTDbRnK29e^u|Korh!B>gXio0p2H0}EZYr2+ zbojSXs*6WKQp~jlbyx7pEaV^dgdXNxj?vSVM`b&giA;rld+|rA#GX67g=4AteD{XT zHhrZsqZ~kPPdVFwkL*D1D`K(Mn?SO_TM7c~r7QU;L3FEm{fv=$?2G(RUa{-FDn)Ks zTi@6idTBid10W$^BZ>w z1)1WlgVG%Mk#13yNA;vz1`PTY!ne~rR)lhY6~e2x^^2ZLG+uG%6)#FW9{LC6L9&6~fzqD6*}j;B zGW`+rb94|k9m?zgyyK)}h_z*xRM)x0*|zrjTyYK>m_Q4(2l359?YGU}=;t3tZ{MSv zYgk5Pvc{W)_8+jxq;OB{s&kp4ayG6lS#SSoTKjYAGnSF0EbyRw zYX*VI5q6i7XNs@A^h2ZX#SG}`QK-4F%kr<%4XN}<4ql~HrD%vSruOC(l0z}|39ZOlf4=!YRTuJn0hW< z$>vA@lroH3UkLD*%xlZX^M%mP zRKEyp+%Cpk_es4frXb?`fAwg1nj zl}8pV0j)k$6nW9W%E$CY8v%tSKcp)C$?A|S|H-^_yFx|vTrx3dSHi&;&AuLX7#f_v zNT6|*N=`G?>59X-_Y7$)Z{+VsyrU@Ua(`0b{7@^QagTam^FH=s(mheejZC(I+^0up1Ie^0o^5A;7{PleMK-q0{4lv zz2~N?1g@&SMdub`sf~BHF@hf`XgMhDv5TCF59sZA?AviNb0tSw zq(k#bmdztn9po2FBo8AE26JSxSkn;_y5|0X96Hw^G+w&pXt1Q>Y1}Yxl1OUrL$bV4 zehPEeGk-nLJiGBF1nj-uq}%=`Sg@LgN;%*HR3t8t=0tz$k$C+w=^PW4YLI)B(A;st zjt``^$v(HigeTmr=wEe_D>{mWZIF~G!4gF|^$Bf*!nSh8R@-dBs6gzb>Cgj6!dII; z(=k|jd!%s-QE=mua`p&VNZ>DpPn^iNv8+4;OX_!OGb=szyxN(bqx-@R^g&g_5(`V3 zZzb-(KKGtJ(IgV?3!1${pzz5JmVW9kcXX8uNq1*m{hRaCHLl{!-huF9X%^h-E{0AC zW5DA6g__9hJLy5= zxC$LVWm@|yPK=VwBY^F{qkQ}bS=rSF! zzt$CU%LZ*lh}ORol-L{P+tTzWveb)%5e7unJD~D?;5KvGHNJm8;gU-JtC=B%J+Fy+ zOKddk6}xjnpZ~^r6#3`gHXU>CaW2uFb65K)ZhUU!-$+|unu_VFT>j@@Kv9}~^~vn) zF640>@#4Kw21zbCO6g%3UEUHTw>cT%YbyWe3A~MycK=Kc=~RG7J+wh zg=iyA#6E5)3$=2`hkawF8ac4f#%c)_(PIb2iwx#3k*;9;%9aEM6T`Amt3PWsr3i@3 zuf@s*`&J#__yXm;PRXfdooQQ>D8enw4FWy$JpV{?nI2MUU9>Oq>iQY?4LYX|eS&ro zmRJYYzN)|N(Mn~xishK8WfZv>^Bp*yHJsdE_cp?JVHar3NoUQ}m@mc`0+q~2sHBNj zD#XDkwdZ0Hoo!Hc0b=M^xwX3LZy-8Yun4&aX)Px!EoWW{4sF$Hg+gb*Is3K=QP-An zK8eJN*w_1saSHOK)#JNe?+xRGxNbnvy3?`Dy8SPdf9QPTj;7=aEqex z-XQNRNE0qsK)tjvzX?+!Cn~PU2e-`M14&t)`m#%Oe6?|7T4a!5yt@(W*(P7|PSfo4 z-&X}vG`G`N(4JaOkD%1AkMP<%snS6`Cppp8U^%xyMIC*6Id@Z)cZR2*UZ;uV#9VF= z8C1d73TF!jALU9$uRh&Lo30DV7C$I|vOrVtUj06~CUhh#(}Lp9;a|5j%c5Q%7wA@v z9^k4=_%eV7B&AkAU@R6}N_)!21gHaJUR+ZA&sXBB9xG^}NJnJJfc~O=kamUJAOaLl+AdLNX+z1O3 zREOMik~?JtiiRD34O9KhsB5#epxL%EniP@CWMxKzKE7rCn^`4Vb;Hjb^#XdFVJ9L< zl^YDLM2ke&9p^?#nGuu+pH-q^i)jbkk%b`MqxCCO(i+BaZWeKvQZ!21EiCT%x3)=s zQa8s;&^;$HmDF@xZHl#PF}pZThH|T6BoWBTH9&pfa`|iQSDjh*zY>D#s5?$+Qzp~j zDIPtBWZxSup6_(eEGpmpMWR`f9>f3iAz8MIa6K=Oaa!|XC?QP@F9CeX-p;W3>KFNh zrudiaYY#)-7;an)k5K69m%TN1=_=u6&>z1ZpFdZK!7S)&#ETM`J0K*gaDSH81s=2_ zkJEP$0rc%!aMe|uH-vZ<=Ltcc5=D5ui%=?qy0oSZ-n?sN+v_PZ3Cajy5=O>1`=Kn~ zMr1r%Jt^pxL?;{hMbfx_v4&V6w(<;t_LJIf0b@C!2bFYE3C=!vzyu<}A>fb7GowK^ zd^;3bHVPKt@}bnqA&fsNd=No2RmjvTmgKi?q~UNF92#UBG!H*kN@*`X;^c z&$2XcaKtN$3wAfNLX7cnWbF@I`9H3{I~tBZe3$qlmP15~C`+^?q9%f9(Sm3Z(WAHM zE$XfoQ4(d9sKG{>MDN|MvU*q{dReT#SgUSf_qz9Y|G4L#Gv`cu-Uk%eYeH|h#;@Mp;ciGW_b2Ii@LdaV`?RM#qXi5K)gCeitm*&d^yVe9r)VnG z1iYcYl^EiN9`}`I-XHBR>0Fu;o%7j$l-SB;c;x(UmP<%!sjgPf_jvZvkv?^ceac=J zDrGd(Vqnk+h)bI#J*rBLT)&T#6LzP1ElSQ`A6>I=jYOkl+E=iP9^Swn!Wcy(>EW%;FcKK<1>8m{6w!Xw6reLlC|1kTs2~W?R@e0!?gyaqJz|ed*|DU z+`pd)L+Xo(`^idj`G4?v`$EZKJPTasua8!ljLYsEm%ow`5}JXv1j|O0-qwv;AjPzx zMc|q7?A3SsE}l$V^sLb~RST}+00i9Yud{19@n_mvV2u*;eR%c9utAID^_mzAes}Uo zTy@5+(KA=Aj`aO{a%FXq!Wsr~;U9AI94suKMgo1f?QO4%;G0#&2whYsgq_wEIjQZ<(3utR#vhCe9bE~Lf?*rhTw7d~^m8AmRVz=0I^7~`vZg(NG6)Ff`#JtAx!}0K z2$PniHm+yXrU%`>_>r{?Si447>6{~-^CUQx<54x$h4L|*V!tK!fh^1|f@H6R;zm7$ ze^OHl?{Tq6P~iR<{$lhHJ67*_WD^tSf)`#G*hx7y#9y1UqEclS?fj**YLmuY63)Hm z$y%4}%XM#;8IsP&an*2EuocPup$)E+xxPhrIC`DHA@jA$<{nXc=Pz~Ced~-1Z>{py zps$axS{GKI_EOGuKDW$#U6-c|7z7v0wFdj!d`9Z0g?-VBa&*g!Tx_hMJndKzhI8b8 zp&ZteX=Kg>J1E;DL>9!P)B2Vh#|d!3iV}-gJ`t?DOsNieXi14}2>{a&8e_@MfrXp< zNopVcTmw^V59aXHM{IQX*#8I{b!-DmbRQlJv4-jwItQkRA50(so28oxB-1s?Ea!FP zUBp>{_G{UlD?Nv2xh@KE7b)=%`)ebexWx2bF4Dh8y08L`b260e%QT+dH`5M8G@3RF zM@yQiIln5)SkE#AJdF6ctGBFRCe&+aHYT8wG|b(X$GiTz?$L?8u$cNqK%D{x>oiWu zD5MQA6-~UC^&qE2S`o0u$dHNNGgu6<5Yrut!;d0FZc~KGAvV&AtZRw+y!X--w(Zig z3K?(*3PUBTAN&H`r4>2WVhz%!o{-~hRLS?UL%Y;P>DxJNHV=|B3Yl0!IcKOAnn-x2BD(eL^}C^N##@YEDET8qXzQ5hV|chd^xEZ&)^xPt zTRWHIZvzgnPj1Izi1^@%cH}$4G}4s^^)`l<4vfa=I* zqKyL#&-z*IPVt{-5i8AnYnLn$m*jdR=%W2If-kI3qu)Wz2# zg`x1u4_T-_xh~vooM9{e`F6P?ijUN_#A7pjvG>3qSMWeBhN2WT#k*lAKZINl4*CU} z0%y;=*H`kmk=`ddKKNdbOLuG<>=V}k29!S=8e8Q|8THkkNGV-fNI8FpRegCF({stF%+NyIKixzMzn3rvBVoUH<;#mVkcNf!VM}{H?40X=qzzh3e6;eaiJ} zzUA!Xnd_9CWD5#}G|+>O;^o0YT9GILMflmZhG?mp$hLL`eYs2${v9H z=*W*^|FhkHX;q0ehTiZ$DqZJwEl<31wdMEUZI=|q9y45Vor&Jv%X`BzGp}I@YN5wo zqEvN=_5)g8sp|!oROimfWyUHFTFr6agq+^++7>P_B)(J3myRoWZzWKn`eqoGa;Dh2 z%vUHTNvmgn6DQIHytM{W_nc8Fk?Udm+T#8zt4}%jYnTlm&6Wj%>C~0;tS;}`j9p^Q zy(=4!1dlW#y2sXN-`|JJ@*jqs26K|z!XWWN_K0OtGrXx~z4~4iQM|Xc5Wir51_xwC za7F1ax{y|Q-+?G@7)JS6loP4R0e=OqXs16U#!2#BV2qr>R{vPHi)-~YPOQnlI*ItH zI+!*li_E*`>Tfu0+BGuU#W_?ni>mcy1ZF|FW(l2>)#*fAKPc4$fet$anQD*G@@^`c* zSmVcOZb$bo-T(B86I!07Pdm@k>wn0NbD@t3^G%;1S=Cg`@(2@duZDk;uCLjEo!xxF7$EzvV4rc$n*E~3AB5~QKzPnq;s2hKRhT9ci5 z;#}+XeO>eqVz-!9u0W(Q!Z}W2Fiiyi9j~ezQJDmxU8s*_gR*_NakWcM^HDM8*6zJ$ z@88%VmwIBy3YmIy@c|#%gxo>Sd*hlPLoeZk zp7N~a>0YAKUu!Wn-lW9c247`+dlA^Qhb?zNj!}qk5>Q$fIUO6Z_oq+7!F{0{6~aez#BA%3?)Q56-m1?W@l#F&S?oy>B5A~)k+cmG02G+N^G zGz3*=!yV*pEnncA`%o7s@6h34KaEP~#rYPU(9G|hjAfQqL3nWp^Svwo~>6k?RAj^2}D<6A23<9ZTQ=85id_bg4aZSdrjZt>sj-EeN_xD9#LTwa{(rRmW5Zh2)eaUfHuxKb+jLgbRByb`7xh%h^$ z&HPNXndb9JTTf!~dMHdW2Tev8gERvX&J7MoHqXD+^<%izyBjOy(8(YE?D#t z;_GEpq9r_mP8W9P-%P>H-Fu2_u#&1wd6wW>er6RhMJKs`-FGg@P1CTItV|(0p!Yq( zqJycI4tvF}Jm70yGS@QIbxHa_GhOmyZp@feKT&jZ3^Imd4!;C|r zf7Y3hDRx$6O4++GoxY!ec2=Q8I)#nj1^u4BPcM6q^_Z6C4)^!Vof|XPCzRVXr9~6y zO&=lYl%;ep7l~g)&gebhS_q4{1|zQP*=(+wugI+OfWJ}cotjg9>o-!5Z%DCBxs$}@ zZG&8+z6eSH&H8B5m$9O6G&?I{D&->jL=ZiyyRV*crt}@ zllI*n=m#V{4Bp+E?rCvk;gJ`Bl}+LmT?{xl^3;BD(bz96(O~DlU){O`o-n&W1kE*w zo~nYwT<^7i{DM&;hmZ#>)pSiZ&ezICbd*(}o_aYs)W|6wep*i|rMqv_0C)daz}@mW zCxRu$oqkMTRmop+Ny`7((X&|igb2-munrg*t$P$lMomJA=U1j?Q*`sX=B3hvF{$~d z9@fpP?IVS2=o@)-X8{Jh5}s`~IZB09PcTN>>!yXJU>^=a&m%LdwrnI6*IvRnGP%wq zjG^YLR|AIAwRRnNk8#rPuAhEd3q;oV$ZdGYWc&?QezB6RpMHyzHq)%VwmI9q9&1rsSZCQRk z1=E)^KXq!4VmD|Uo_3cl-D24@egDCDMmxA@C}p@A@{{{E%PDK zKWmCb$p4Y;J%5crgfXp=$>sGzL+7Hboxp`OXbc+oIS4(W%;2go)B^twMv@(hy^qb#iP5|>vjN$B>&|(tF$S$sJr(VVV%2bw=`a^?e09UsOZ9Xjf&zy8`QmmFT+vMxrGW!74v zAMm1A!wh-bqYYx5*C>a1htb8|&dR*bs{%{uZN)t1w#M_K%l%atZX`ZzWklEy(9-CB z4b2v#))#gg4@gF-#i*zO4gvkFevZnF{?t;qYs-pf94w=HMpVnA3Tv(@kpC77aFoyR z|2?T~Ve^_Th%LE9VZ=Zu>ID$3lB>ES=NeH>4ck>2AmUSZ#O-#ES?v=PHVSVLPu#|h zhtGDRpo*DS`2Lgn+!R(K#o3!FW`~r~*ZglmNri!V&W+|^nm?QwTCR;CI5-I#Xz;2|-( zZ)bG^qk60q_6J5F4SM~#c#U^&XQ*?TvVW=+XtFHWYH)bhd6YXq0A@L0lV5F@k-u`* zlOXZCdc`_k4q}b{nL<^+GYr0dn;z!>Z9>qxNSih~s%}U-gIc>!WYb?rWqr^(ISAqC zY+g@Vkj)>~Cpv(t$eHU&Gnhw-sA@=EH3luL!z=rX{7GJPp)%FO;MrTmuHWm1Ko>nt zn$y1Rr?$9=FA0N8%J*F-^Qmd72m*WRGLH^pK4r5ou5(Gz9`!VKI2~RJ!N0V4CY!_- zIB9$-%e#43s@j-AYo!3-2vFW~JO^n3Th8vh4}J#r@r0dpFCP~5&WUs_pg@POzyU1HR1t0a4AMCLVQn_-YXO5x;+66~*KA4N~f)Q+vQmZ`rgF3ZXbazr*W- zall96;N$tqmzs7bR^DVmZ`Q@Q^9c}hGN9k2b{ek_b}7u7QIq9=JAJ#XzFWG`@EM|n z1WB%5UBU9j&wMvA0Aj{r*AdNF~alCrDI2V1@=^z!A=^)D^nc~qMnPNzg3Tms^d#yhL z!%bPLzZ1D|%sQG+jXJv+#6x$Kipw(>h9}<2D11No7-|*KoO_fQR+PJG8AJ{5QCM^D z1Wpt(`s+z`0%eR@qL4p}l`>iAE;vbcNpR z{b(F%2RRCKB7|Q*$~uzF;FUqz-@{J5rWoJl671v>fp2%_Eu%Yy71xlrpxDkreroz5 zUddAEv0X-oqyv~f8xp@mpM5T@hK-c!9MKQ*M?hs&7upq6{^-lHBlfMLJg;pMl-8nq zVAP496zPj=w7&?ZN>RfF7XBaU?wD3aB#}MJeUmb9| zl`-nu$OgtwwdLJ{uIsUNXME9Ctx+mw+|c5m1_ti;vnC#{Dl>)|-CD~ZzIB}kaGs)P z?COZlme>gxZr(8&CZ3E8mz_|#wlaDB*CP44yb4@gRRPYe`hIbrqQfBa(Dr842(g^k zDEB2`_(H(9f;}B9utInqHN=WE)$NzDAUsg92!FWWj%3`(r`m}CEGwE5?p&7DJytQW zqV}-4-wS<_qdu={H1k4L&%)&Kck%mbUFtjKKlcoqO~z`EpfjFj>ls)eRaj1-ae}d_ z?@!YGSHREW%@eMxg9Oe66^Z?#Vll_D@&0A{t;?>Uo;Fa3rLBrhC6_YXx@dKgA`*-_}ihP^TPfPdH@N~OAA68s2ZRXp!K<~&!b z3`otVh8~UIB7fRSKh53J8DjN2_5K?CU)Qn9t7ohbw+@~aw_>Pp^m5Sn?pjIkH%V!C zQ1_%(AR>#~9^>In+4K-5P$T`OJr#aIE|z)}evk{AYZ`k&ugF<^%Tf~yos)XZ3}N@s z-#Q*n_;fxL(OH~sS3h#^7?|AeU>U@-LU5cJU_}RT>7rPd{ZiC|F(%57AZ6)S`^07f z-gkckuI0MyH|r5?7_PSVGlk`BrbfnSZU7Ye^fN53ac7W47Ix19ui>ZYRnp8kv_TC& zkjPC&I<3|p90#^4M3ZyQpAvI&*LRcr)ZuqFmWRo29bLuIHbF~}jv9?~)pXk$X+Y|-UYyTyGVIUO`j2NgVSw zaXwWkqTMQNI*2qj1pO#|(m+14A{f}brmOoOVP+A6bPDLln$j7VtqP6P|A zJMh;+xiX77uL*(A90ZsJMjTitD^oPuaZ>H@Po3-&%{^H)7NDLZGDHwHva--g@6&Hn zv6P4X{RVkHPP}~GRfvo`5kh{ThZZs54C3(1hwNE1rQIaA9?(`VNd}-eBjYnESmYOW zw7{mKy>U8p2>7W9+f*k@LljXo$Eu@2V+B;Gw~xRJtB2M0?>aW$Lrz-G6!0urf=dsT z&GwoFBd-h(g6Z^?Pw%CSkhuxN=oi~e3xtIl;r;RS-&7#;Su6QF#kUV7Jm>L{pow@2 z8GtnLD%|>h3P5C;rbVdd?;PCo4vh=x{H)UqdKv{%Cz8USFT^QtSiyFCL&JE9nRJhH zh6*uA@#r6*djpd+*=mzg>Xf{o$QviMoh88iuN6kkR}VA7VjD=h7y1R;na^MO+HmW; z5F2ryd;IaAS53XO+=uegP51{YwEX}!$3N-E7gVmkZSAs3mxZ#7#5JorY?R4R0_@B) z;%}AZ5dKJEkt)s*7 zock+-t;^g;3x)(5*k9@}x7?0p`lBUVg6tA^ztR5cU~3v)5C3yiu!A8*Kd?$Z(eF$c zG0D8vs}NL$Zny3ReeNRh+((UI3aDgSJehlOuw$!U9w2TQ|4oHU-9(o=cVtQtO zvno#lHWm0*qF2>M^ti|)qKAGMalhVnRMy5Fnxp-@Jd;gFrq*|rsDQfeT`h->8|(-Q z1PrSUt;v*&FIF`AIoy*U>(cV_adns(%0R*P2Q{3w5ZlD^8tq zCmvfpybRb4y)>(|in2E5dahLd;V5N2lG@l}{&^bSbi-rfoC<7Ovc;+si6|${TOzv! zPba7#xD4{p%`P>9wSF3&3C%*ZvHG!^UiV+u=;iln*&Bxsq8XDnBUpN7$?BN^aqUX^ z)$|bY7&VhOg^eu!O&aJ22v#7@6V_v{159nd0XgHy1k0?9sutJ?sP2Dj)i#Ny7Vk9< zVnmGI!bVe~*RvK)o>*!8Mv@a<=N_oNcq0%Um7}J%jvP4Jin}0KlGz8LJy)!2Kf75zy%AfO^P9U?@GPV7A zM%1rODKE8Mu{prn;}jNLZj(F7qmlvVPGXO43| z2{9e9H`0MVT4}2AV_X$j=!@BM&XnI+`P+tdn9~*N)8t}giU~Wp%0ZKHDnS!8tIAYY z=FoEP>b+}7j)bjbOOG?&ev0gC;O@QuuoB(?Cv5Lq#p3YvvDWnEa1Vp#ilAcdoihFj ztBB=?Dk^hX_reF+8s70w-~bUYz4E;%rs@L|iA>u691M5`ik^4*h1IQJW~tb3e1yyY z!`j(pnw=a;)<#4OWTXkL6fa9=o*z!vM}+C?l4<@CSS&wFGx+;WyMZy0gT!eYiz93Y z(gqbiAgek}TyD2K!gi`zs?|K+(7`&N$x7|qHKtok#HB7@n|{{Be^J@2+)>Rs1nr=4 zI52urn%r?&DYg3LLN4Lrl>;H!YN<2c5}aBg;ty%)qfbGuUn~?YFHHMl;nVzBfP#H} zNJRB;jqP&6nVlaE2->V#h?#BgXmp*690LtR@E7l|b<%EmV-&H$$vssze5=;<*D=@6 zS323=w6!K+rAU& zzDnGAdwbaeu$+v|eF7!Z?o|2f+Hg|ZcXTelKeYH8EwZ#|e01qc9@#O8%B18TBWs2U zI>Xo(eQFD3YhrxZGBU8Dtit#<8tZx*qe+xJJa4++D~S0P{a)_FkX^qzRBoEmx$b-^ z9)qmIlRlG5O+i$7Y7pG1(~cK&Ug^0RCCEHfZO6O$B($!K;F0og+J16(U91S>d47dA zbD=F5EkB_Q%OLN{g1@Udr5;WajoqU`N!1^jue$~Q zsIGy!#d9X_#&+64v4)v9_d4k2o`6!N4;N%R694L+IDmLhq`!6znH$hlbjz)6#AH>T zE<_07n(WeWcMrjT5?6iNSwZ#;U7^8iSDAA#U}Y%97>3ky2iMuD8%*2CF2AgBypZn- z<<@!KBd~nkKf0gf*}O0RC;}DOr6!Yx7e&XqN?|6lFZx&J`?0doBd*ZM=(8#sdhombB9 zI+Z814VKYum0kG(s&pOKsw5I?e)yAP;sx!>B;#r}{E@O4XU>FxS8-l)0u_%7aeQ@Z zuSVv0rmmktJndFWt?(XR-`e7E$QXDpUMZb<&6JA8i8ny0A4Ao|-Hbg(-a=7dJVKYo zW~pWYJQ~ezJ6FA6I|H1G&L#b77o>;_SO3>?^R-YEo5IdR!KfS@?i?+oYO3M_u!v4a z1=i%avP>AwUpBIZ*ejgV6|+s-VD1q;BekL{t8e|c)%^w{&|9~11!TEs6-G``$y3Q? zIT&F%=X$rr9}{F!DYg*goSxU^Eg?U9N~VxSj& zVd$>1!K}>*6R6y7ewli!=*do1a>#@2vbag;JLd9 zOlwKsQgZ1R-{VG!0Izx@*Wmgnwy<~cVtdiIu6VU=^XHOPTzKpF9nKtGQ_?HD1cMn* z(mVCV$jN7r%j9QKq^Q{F^W^FLvylm<zep_fsU)9 z4SjA^q{N!7#Ko;v=+>(0rBb^9?*v?C#pZSZlzi`f^l*<_y#HE$!97{Ik1PQ{pY62& zFl42jBdaDwrjQPf!&`e8WtRmMhRc`}KLM#F2g2f3o?ZtI_Rwo6;AnP%)707PYBn)` zj$o5R7B92(b&>LSrGdDMXZ-Co>X=vZCvwxYmuwjJf2~49i3{*(6oh9`V>=d=;zS9I{bgDr!LQ{dERi z7kBb*dW8lhg$jM&_hN)w87V~R_Z`mBAu^-^b0Vpr9G};@t9_{wISl)+2Jv*u6cKQ; z)PoCm#ho^aRB8=hLX$WxZv9hoq9Dsg>d5#3G#;(65;rZBPM+wm&XImRv=!H1nqGCq z{^r~m@A_biC^YZ7FkLmTx1ZqiCe)=v`wQT~FKun=N(El#6&)?dH;ll4o{ZXF0>MoB z9zNP0+sWb{``SJVfk&oB?XHYTQa?60SSxF;d)lo|KH{$O2-Y_6y8Hais1{uc061lx zY;Aqz7}&MDD;;_>R8lQkyt*|GrI*u8NNlveQ=&q5`9>%#+SG(~?KgvtQ5%0eN#Bdw z(c=k%HFsvxnl{Yd%tXChu&g&DsPoRrjH_T|8fUC~=26@D@CR9I?G`v7h4t4`^>vTm zzcOq+T)PUL!G#tvZv~JaxX@+gW;X#1M_)6{t?m4-qdNE(Z7#{j>fwBo*7oIe=jQCA z4RuEm&bkB6ht-}>qplj|Z2_=8v^85xbIF@;Q*8Sy1ouWA*DxDAu(ILK*V-K5axVQ* z$V|UqFT3#y`LO$c*Y^H+~2CX(=XoUQ<8I*&w{GX zU(8q*{WGp8bp$VJ{5Y%SOmX-61@Fxx-{N(rvaj>(ZfUA281Vh_k~C{FwO=J|cToCl z-|>E9d*mvCYwB`3Xx9;Ab<2Khy}pzfKV`M#pz)|a0KB+IOEzz$$>2=EK zD=h?;H2Q_|$Ft#Oyz)r*$>V@`{El=j|FmVF}GV^B}(r_U$rKgCqx#buk# z?q$uDt@j(_CZ{T=d3N2rI*2NWcGgW5dmB7pn-HU7eL7dI$(!#f2x4BR_+-y_TkUds z-3FI4?8+aKr3C%#E%7XYS5W}(irY8x`VeHc8)&ZLz*M_Gc?Zy<=^io3U7t;d}kI^hts%&@C z@Lc`5G{p#owSyFSDsP!6;KQgV+x5}RH+4Eva35mYWzt%x(VR~GtnR-N(bqaY;UuKb zE^jasVLTQ5S3m1_0n{yb(Md>8L^O3rVE`iQ7M8h15S`@H52ON%HpCK6XB{qk@PS=f zw{#YZaC9*e{aELIV|sZ@HTn-icKvv*uBEFzF#(J+=%o5rYiiVX0G%|Zl1~BD{S8}t zi7C+zV9;0^4U&Q9dKlGf45MS`%3@Z0wrnwnNb1>|;I|^(E=6W#F{Xf??f)E$R*Q|k zvNQH7L~!Q{j)~tmcLfO~v!RM&yjavN^%R`vzwa$?-=F7M2Yyp_U_ql(9<+C6^sTd6 zH6;chBM-zVA;EX_+#7wRGyS1!4+EXr5tmR+HL$+Pp4q+d-5ID`MQwSyMT zLQ@(Tb;JKLdiV0=@X+>5os*)TL=i{^;{IpJp$czdJ?H=8LcFr>Nq~*LJ0ZAEyXALf zeVQl65^uS{LLU!_KY_TS(C;dDPvCWpjE7Og=BZOi#eE{6T(+Yg@W;6f<5fw~n|-{W za9SQRIsf&NajSj$@jgEz>3UUVOii}G9gU;%7|)Fv!=z(-1ysBOwzdXjZrEbZ*yGuw z5+>ExIz7)2u>VdWRAUj(9N{am2&XHyVc6o}{7Hf{X2D`l!p$QumHLrX=OccNdY|2W zChmf>Lg*CYXU0Vr}l9aX9-s+pu{CUBsn6<|0haKid7{`=jV-V*#z;ojYD zUtiSRo71LCPAci{ak8wTDm?zs-QDqEPp@VAcFz^V6!&}FR>4PV|4Oy@fEduB9bklU z=1AR=T7iob&-`59Gy_;XLXX@?+&US94UVEMjKu4{j=gf-|*c8Br0;F0aV9Z;`F8S z*>UB!Pz;4Vn5SWUoObj*n3_Y{d7)MpF!!!$P9?LD4c)1PIBgKX!Utpaqft*Ii~66$FqVBnb?kW`%a^4?GVP$#YQJuZx$x>_nLuHK>YeGL>+_-zAgf6kRQ!n8|p!$*R(h~)1CP3O% z>Bk=d!kyP#g?G+qJ^bVlSG}-_Eu017{D8mwZ<7|@b7nHhH)#EF1chDIXxy=XPp?sq zNWDS0qvidkVc@NZPu!bw9~V%LAA4^D@J%(BPd#2kh$522;<=D-5ZauyO`@IqhUGE~ zo*(&96s61L4uT0q*_3wL!X}VOYNtUB@_?0vCxr1-?isCMG~KaJgyvi6H`O&6&-mSA z)j@Q2hs%vf(9qVb&Tmm}@s|*N`}rg_H<04%6SoCCQ?8@b_@CFZd$a~WZ7*Rd;jbjQ zWrwqW81uc!1x!owj7#!V*!t49@OjNFba(Dsw%aX)4mE)rRDa-&7G|=uGNGnv3m^__ zAn7GxDav?G$BX$xj_-gL+fMY)sIMg$;oV6)5n`@W2~2%+%PjKO!&ksNaC^SU#y8)y zAPzd%P37;QBKD{A^lNR;U{dE^NQH&QQV$mEeV^JF-#WMY-=r2gdP^0y&A<_@?QZwaz@bvGC zp78kn(_^hSpTbnNPLH$4g|8a#uw?aX*bIu;N!hOvFyu}@Xt1;pSvy-iIP>l@US11C zvMR}??H8N`f{i-3grWXyak+iv-hLhMIH?ay>K`e|4r(~x^l1x>I%-Zq7q*WqPt|IA zuDYA{i-d>@X4z5u^||j>llSK3akjnB5%pQN&wb1wdAfaq zJV%OMXQ3DUFdRGNEmfJ@XHT}!jYdR|!8W7@&mK$ni8SS2v7ZD*O+Z@Lr39)79;2-A z8PFACi~SnhRqEK3d_(F4`lYoQo*S06Z>ElWM-i;{ruU;^1x^W& zVWbAi5R?yb35O7eKNhIoHeP}IZhXVdvcdd(F1G4A?z4QT2kgs5=nyX87Zk5y;%f>h zUjv;Vnw{NBrl?{IUQ^oZUOxS2vK{S454v74c|@T>lsF-Ze~e`sDeE^Xau;cmGp={**yr z^c^ib9$fn+>Z7if(4APW<*gL4W982?Ggt_ggq_3?ZI?scLPPTNRf5Ly^S4xYc(z_2 zIZABPJBNjNGr4hf@Ysrg(_L6zB}+1CXQdqMm;e(*wIf#ukayLIX|&Cbkx45-CI4lr zN8LMY3KH?p`xjFPjF6XRc{u-#`MuLOfONh5Zu0o*ub^Ts0*Xb;e!x3FZ`)shuAYl! zAdLyGSH~jOcg74!Gwk(FY`Nzc=i)uk|1%-7HjErD;A^BH#9V(Tt?v;77UHoNF8BLc zB|tAPzCrA-y_d~bR`ld|DgaI)}^MP-A zt*bhj{*i`RzVY+I*{2uHAGkE*KjdY%3gh0s(Y`YjrK`-oo0l}F#Km@`q0P`jff`$K zSbwg$T_19@m?>DVi)niV$C6OhXMB3Gi+3ym;PT>wLczH&kYRs*k|e71w%uMo{1cK~ z&N|O)F?oF6zf%GW$m@(yIfEJzT0UFWtDe2f;v&(UMLVkn&sjK5=4&W9omJHaNG`WmQ{yKW@SEEqhzTrRO~ODzug< zG{yj!j^|wx*ZlL#nh1&H2Fo0&R?=qXNAK~ttR8& z`10UrR|Jx4&I^B!$18&IGU4)?sdU8)Y3@*40dpv#O>!jBA&AXyn^hA#0U1)lw zHg-+~;yT95FYw-{OcWQ@S+&?dqsA+h7tT1c4khv;$4_`5 z)wZu7ql2J8R#f>! z*~QTi+w`19^>w%Vb2sr(yfrPfkt+iJ?i8+SF^~HUNVAVmGp&W`GB%0>zlRJ&-1!1D z3m`kj&*x%IYB_uP&sBpfYA@TLq|iTFjM6B5bM9#9>%#;sb5xNo$@NfhZ_xy$L;vyj zxTDl5UsuVGP6xtN_|BWhmx3!;9;;t9zXkI`7(2D2r;o9iWP(T}H$Uo2`R#SIz(oAl`I`t0=MW&Ax{Ft)avn*YnV4Ss)=`eWHTC-q`zbeeXZXEF>F6YPC%`YSVA` zLN`zv5ZPE181+YnfykrKsN3mReY?gwb~V+r2RacQ!s!%bZ!uYvH;{p;A@99@*-aQAKf zwYsGam5WNi122|p*6P!P+CZ#Y&|v|>%gQ@P-_t0c{kS6%|IMn1<~qB*;@d_~13H1a2^6t-t%QH} z61}{OPjy|Mo4}L9Ng^4{V#d2A_$nq{^)Ne+%5nlW& zWtFP?KC$oRLXdNJ`VIcACmel$Nir?0Gb~!F?)7PP&~ecl)mPtf&El6oxhYrGDiQE5V=#nLHR|z4D+jCw)V|FjyF+hyOACa$;I_e^bpd!PNGam%Kmh zaX}BoMu|(0ZW1cdd+{^EDByQTX%K6;@o8bu`sp3gjx~a`ptY`P`{;?zx@P6L)DZ^} zB3!y-QLG(UXg4jcwf^KoVJS!3+J)ajQB}84N64YT7zf??G4xv40UNQmOY*4VPY6sQ zWyI(#- z|yV}Z1%t7m+0+mlBYC9q4?oUyH3OhE;i7=7P zK6X6aVK7XUcVIUX&ued7!M5I>+kEWEcdx_?e>gXC1Pi&aVI)Op0BaA!w^Gg7ial13 z`!pa;hr~d!a!xKZ1NOq%cC&UmaaO+RC@h$fw5cIx!&ZxR3Em2R0EQ`y5i{hQ59bG{ z%9D(ntDI2uCybnFsUcSKgi_%d{cZcog`vje=SGpxH3!wywUfhDLey8})`Jt;E22@+ z?T*df)}wRqhcRvYVA)WsrQdr4tw9GYibWT*lp7JB;HvqbefHKhp#7go*CGc|H@8GD zeG2PBK)m|zjB1n=!%`ag=7lnbguuwAD6~Y)C}U47B=u)ly?SZvFg-Bc*Q`uY<0a z`NDP)CQ;9kvO#x66^TNztM)>iKV(aD{z=4@G)JmKPm$fV$>>6UBOY>t z;55!S#`XE?@}XH3?*1buZ~MULuY*^`&)|GD{>3ispXNiT5t|t+D~xEn>vF$eK{F_t zviPb9X*fxkXec`VZWmC$5?HEz7+&gnsHo#|o_*2z^;Eq2I(+r{w45Dx)PP8IwWHbA zRK;!Op)v;Pv>9{m2C*VNl5863fj1<6TEd%BZVe2=af@Jr)q2~y%`ni{E>t-ewk{)A zpz;4%D6F+doL|zhD5=ExDMh|ZlFDm=zb8*4TDOlkT_u}5hPK@DxdyW_Q=`s2S?DS$0_2!mrogXg+N*=!26C1VIIySuD^jQOFR=adzXNwT`nDqthzfsr< zgfzW_O!|*$Z$AK#f~!4v@C<;5fcIp*1%s;JJ{!Tog<0%viD~eWAtFEQ6>2NIBy^ir z!ETBLCr&g89NoU#4CvU*a_T^mxWnv=##wkuYmA@)1zS8}hC16wrVhHOUIirjk6!>K z#@EA%yn5qUM|JXIh{VUJ!WB00VBKncF7&UPvO9lIMC>LVYytt+ED17LL}LC_DbFCt zdE=iACXcK0Eb`ufo~v3ksPK$B?`a=jACb9Ab#Xoi=u_XmYnb;YtAl*AK~HWq?<9@Q z^|AgdX{6D%0xkA9#eA%e>i5X~2IKBlDb3#lWvVnSVjh7)5aTDl@l)~6}GFLDB9b*(@!Vhk^hYuD@5IR@@8Ljt8{X)rYekVa_s(i z5HUX}@ds#GNZ{L?iG_JM7($S#)w5AF7$Jtv{;mj}`jpA>sNy^OTlc2>@#Du+Dd%%O z{Yv-_vF+;M3Vl*jRMN&S?RQl(>d&RE6=^hg-~xCqK&o7aeg!LhKd2$_B03%DUae1dVfx8qViH*Bh80${$bv zJq@*}f&bN>>pc(+hQ=G2NwYK-IUTpN^FkR_KK+Y}eC;t7GTvQe^t%kOwdw z#q}g%53*SkP4`RTf3KAaJ<|C~AnT1x@UVu@}S=ON_pjsEG*>VS$KX z0L3oW*ikeZk|=15(bzR=G%DC7t`Rl%g0CeKjR6!D1)2Z-oS9j+(G=e=SH2zm%_(!r zeV$XM?6{lnJZ{gNTbu7}nT&6-ZwI z@A~D~-KdBO@83-d_By`f&Ce&C@;vr*==J4!)$1J07`8Isare$gj%ht7^{JcveO}y( z-kTl-L>?LZ-)CF4ex25N(q^An&!oFHN9*LznR3f(W$YUlt4|0|zBqm8iHdD59e%cc zfu@5;*G(t2EuL=qZ=IdHMx1=Gp-oDH>z;3C?`WR5(LeQQlQY-1*q7V6>(TsoLYHi{ z&pnjbw%Wz(&6Jlv>{q{gx@MKQD>ys}!b=-LB(B+SwyPxlxF#A~j^eqb> zY+Th*YrkXNMUQe5eGWYty}reihQDulvMAMM$LYZiJx=&N{weA&)wC8p+8?bsO5Jwd zlUk1*a<{%&@BE{oYn}x3KNp6K*S`3@^6(9#KUGx9b@1_>v2}6uKAWTc#=CB4UpqS@ z{p^@au01=q@LqQ;c*R|3m-`{~c{851bIHBB{?3x$Tehne zVt>8us=R{(Y)%PZb{aG@X++e-*k+4&L@)03RkquE4USkJR8G%|`#gED-@MzC{F;wU z2yk7fn73peJL7q1ihpw76eqtXO}aO8s=~6DWhwd52J;h^B`yn{_WXdb_&9C-wW;yHI6Un`j>!ft^Q!cDOM77s$!{QA#=UMBxbIJ8mdZyU> z?Y?c3^2obI=C=V=x3~_jImEGnRb}TDU$(2264&lU-3B=hpN!fS`1ME21l8YBL+O)U~&>QY6nD;hCxIFtuwF&vJ>qntOlw*7P6a z>NQ%we|x~m_|**3k|mhfIbA6XH#YxtFBe_nPQ zIVtDr#y?kVdZEmD@1bw^+J`K_Uc!o$j=`}^ImFWX!9 z*)8|x1IF97s?*xueUbajJDz)cx3YF$;vN$@c*^aDtzyexU-DP2zeZI}kLz=>)+PHB z(RJ_czVcn4_{(czFMPh$Zq4BvJ8GqRe%|t;@dDcV|y7pS}37uul*sXH2#~`oTcfI79JMw+SupI1m5P zFSnoar*3(|PkWbtbLYM7%ez)?u4y^fU9%`@-id_RF%uVkl#yhWb#6?>__T_9X5C(0 z>FwAq0j=kbS~kd|#w4el^M`kp^PQh#e#8wZuWrjk9kZR@q)#kmLL1lT7@tk)&Nu)2`%ZJb3Z+Nq*Ax>#g^9 zYj@18_WrN#J6rXzfyZx8=RWPD zzJI^`o{CvMwzC@V{9|im<>!%`PSxq~O(hqP%)mp>x1~JaHl)wZx-q{|{-5)G>VN4L zm#cKxSnq~I%0r(If+u##tB`r=aFB52Y1^O&>ik-nGY-2=-8}U|%NyHIExPRRsc^F9 zm2m6y0XJv-ad?p8puc{i%(HP0xJ(!|B<}-f1@L)Qvh>Ywl-_TcOB! z$8pA(8TXF{W;}|zRr~Dx<%cr@TBbanv~~ZUfEORnUo>Ifl&9s(FAtfQnO82=c79a5 z{oWqU$2p}O7Cf(|K^T^Xq zjdun%NI4p2zbAIegJr4xXZbpgo4a-S-pQR0=da!TThC3KHyzzj@tuylr;MAKM&Nre11h_lx-fI{>uRP3SB6@kX=xXKZ6P1qR~ia|Mysn|K& z_jtNpsxELlu?QBz{8=dcc08W3wYyz7dmHX#Z~g4ToWPTG+a~gHiaX;|zKI$xV^s2L z6&;IV-q;HQW8d?75wL57oh@K&or<)Q--?w-CU5qgDhweTCcNkfx2Br00JseKxl4ZL zZAE*^B?uYhg-e?=d8t7#f?A;#n-0IXm6(I#{gi%6q~K{{tYc6owco)y6sc8=Wd`tE zd`sqxOj9W{eS=Tab3^+_AU)-tD!&i<|cDPoWPs3asu9F>QbsH=tg*_XaF*XjS*Y z@lzd-3~e^&<6wa;mD0{l7t>B-4w+4$Wr_k8v71Jf+0E=k>XH;r%!wr{5M_6S#|R2L zj2nd&a@u*b>RA|`WJfznL2*wRbMj!BDtF4x9w}Y17i-}Ww2Psgily3mA(IDlwHDJ> zvZl0q7H@gNe*L=bM%yLF$fc@P?71?CGO>Im?_k8S7s}??dxHQyS01w7(vZa=zFFl9 z!U7B<1#@8|S*}t}HxeE>Or?4|kR%uDc089@2bHf+D9Rq$xqK6vHcK#NOg4oJ$`ItH zTho-3H!_8a&2nkQ-8n8~b~IW=X7uHMeOX^NfHlP=W^Aqt#beT2bG^y%f{yHxG~F)q zX>QLvQKq5E$xPOOHZq~O-Q(6%u^i=PjBP8Hp{zp32`k(3vQ5OaF3gW*+Nu$N*?3e; zObmB_xp9kmdBrmpAJ5{on07|#mM&e&)8(f1XF|M&X}yqCW13DbFJ3D!E%5Tvvduw) zuDt6{vUoXid8A|hQE1Vi(zW{KUE=AYqocVi2v3=pR?CFGeNlfwItKl`Eguesivt0l zvJv6OsDYp$T?|U0bVEHDOFOfe>)$`tkLNkNs;W*OTE){bFSHTqy-3#(F5+cm0NpXBv%wzCgWbm)sxyI@ICE8>%a@wB-40-uRI$*0(X!{>0e46^Ur&cd8E9 zD@+z-MF|$<2FS^jnC&QK0=(j~t}t5GX-Z!N-h2%(UDnk&MguSg%eRaAcZC{$E9TC_ zHPxwBl+TJ)k&b8b1>TCe^6)Rr$tH#ma&?iXmg-aoHY&^9sl}0^X%aw#nkx|f-n@3v z?`P)J(igS%6Av>5ohx`DqAQ1~J=6j@ENW2d!hWzI%~big*d9NWOsaThN`P%7;;6SE zQrgH)atg8$Zyt`3eR#3l?~KyL&5Aj*7&E0*(JRGOuM}s!Qk?Wkal&fjXzd6gDrS{w z4cCd;Wzy&sa+~&op}bXvlMTIc)H?Q zj1yD~cqc=t4U1uajoit;;HvdcSxH#vDoQ6S0sivRX$tyyEgR9hew8LFRji_<=8%KD z<|)`t)NY?S0JSidz}HpoWouPxcshrM3>&VF3RedPghZ)(`$t9vMyR7gqCx}Jkx^qq z0~uSTqSn_CGqE4}#SewV9-@|2hF5NxQfire>XlnIJ#wePX}GvHWh$vnE-K?TQLR=| zn^tg5Vw*%YYx%e}-=@GZQDT!K?fVA~3l9rWhX#%g47DE+91yM>R6hzgbtbPLhQ zezF41wi>)fy8Kfx8pr5o?3LV44HvD`pC8AL_xo|UvURKru}+h5rL)c_Dp;r794BMz z&`hyah&|qy1V}wj)iRc-qT}_zN)@eN^1PCLR{WwdM{kUX?V)s{eW|y9MM!RsO(E@Z zpIqAZY_UzPVA>v3UwtehOsW$EmkZ@n9G(ZuI~%RC9yN| z;6f6Y!PZJz_B$#Su%wgGRgipjV|=w#`m4YDjcApMu5wh7S#8s&YFsVS1#=e`$TYZ- z8--iBD5mD&NZi^5u`tZ1zm?@07%iQ#j+6GuECzqpoyf#C2gvZ{6y$FT zTv*L4T1k@-;Rjb-yL~alhgN=Efo5_8#HyI9Q*F2kmL=V4pg~;_A#FJ0;*SP{eG^iz zuSQvj8k)cQYMLQjHfnIbFH{Y`JuqV%n$!Afa1mWbYH+nts2ZC>Y(ssducmpKsj(?S zO}RqU&=}KK^G=zmDJQBydE&VF4TETvqd1CfB{lL25yM6v*opstOlywebqHM%i8syS zIw9UJ%VXKe!O6j|(msC9rXfo!0^M(_*c=zKE8P#$V+sBH!PW@Rb)nUpu?_qvJXSPk z#Eq_9YVx3Xo~Qo8O_FLq_5=Kbf^fCsGb$uBAS5hE-6cFcLLCyRZrVbviBd<01O%%6 zahms6j|d4188K>vI$Wb}+Ki3`hXe&T!kIr%9ThPO*FO>dBSunA|0v|ZzaU)xP~zrI z)B%A(5rKh`bcqy&^ugf~A>+csqWnYE8q^l(A30VX5*CSYsDD&Qco=1)bWx(V5&l78 zfl){yW&c#t+Q=R=W2K5_ViGloDbzIQn_=Cfjm}%RVMh%0TLs+2Y4Yi+LOjCQ8g8i^ zgfFrjMHOW$>%lg(8l)gb?p0dn^v`55EN{=t^lCD@VeRL90}tcuGec0M;W>D%3d^zF z6TQXO>NCu1<1Q}F-EmBJBBKTYd6>S=6Itbo z;;^j%x2VS$fAcetcq024Co-13iq0|hX_!_UzQ3Ob>ymYlr>UEzMjUOl02*v~+=AO) z{v=Sv+Gk;8FmHuV7A*$+_K6CaXjBLlP%uj<#P7ugGM`By;-u-6MHhXPNk1d0>Bu~@ z8o)&t@#kK2oZt8HI4ZDR78xHodCTZ{A2WGKxxAUnLk$_sn_plJIlay*yIgn_)jK&QCwkR}N4@6>FNc9WG;S zvS=(*frJwh;bAjV2IFEZ0DpnFAfx2rb3)u|IYbk*gnhrvYfy8 zx~|*3?(-MjCjXn~mtp%X^UE^7bW@9aUibW>2S5Mj`DNI?;^$ZM;_hc&^8V{8U5p#u zn^27Yy$OXWSxN5eC@o#jPA_G-uWx?+`|d61F=WBqD0=MRQMz~=$0FS5S%iYW$iY|; z9xn8tr+Vx$e_&0|y929=-LCZ%`+JF1{L@)md(ti`ilnwJ!3$7VYPp+WSqKT~SoCf~}sIKZu;#9M2m z*n#A5pQF`js{_jN2;+@4rT8R0h7MvEBY9$^Kyq?2OTL=S*8G~utnt~jot+(XbaZ4D zD^_HcD_3Uj?(VE+&6@1(x8G(12M%Ptd-rBOK0d5<>()$|5W`MI4-4-D(Ysho z3+TNjDh%&Z@%N9}lzuuP`AR@jwIOfffjWM0o)X zhzD9A021m2G$0;mfdELn7tnxspalZ(LW49Q9%z98P&jJV@V|KMwE&Oup#||k1LA=e z2!IUX1vDTYXaT)p<^?n$9%uo*e1?P2fjFQA^fDD0&kMu@Ex_w%_#@-sg*F(J{6676|a8AZS25hzD9A z02B@lhzIgZe*(qfWi}1!jE74v(h1bJ)GvTuY!j#s#DC9fFkfF^MlZ)xi-9Lj zoM79wZDSWMTwvF(U1PUy-D3Cd-D6ow9+d0`Up=iV0MdPr~t%> z4)*Xed1cA`bxo;PmY4|w>)Thrx^kWge`(p#^BL^?-Mehzx{atvoK-Y}VRkV{vzTTN zMijaMpyddnTLC;YdZ_ncZJv#0G0h+v$uxp^4^nZ6r&&ZJnMM$L5M2Zi<|7A1^FPco z6htEl^BkiX@z~LfrddU!nno3u1PwH!X=c%=rcuRZLIcfenq4%iX;g9Pw30vr%`O_% zG^%K2p;=8ci$*jbRn$Dxj&X!Pac0q|=1qncT3Ki&)9j+r&CP&=w6f65qLIzb0v)un z&=YBFm%!Cid1}7(=6krM%}d1 z(aJ)znr0iVsY(4~_g;rNu;b>){*Lm>| zpd9oGt#Gum(CkLfP!CXxQ6Gj3G|;L}t0=8(w6gHw1P!#Z)2c?R3SV7lh(QCb?6ktt z%0?>-iUx>>23lchWuuja&Mtg~NBy*_(P}~~3#}%!%FxO}t4s~7Eu~#qGIIsCIx&&2 zEU2CTLt*3tR4!Z!TQ-XYEEcd>z+wT51uPb@SioWdiv=teD2)Z4l_v53i?q-F@d{sq zRro!QRBjP>IYk`O7gfdf=DatwlqpuMi^4GYtS^aPq#ZZa@UB6Q{Ov4zU$pXi7l5V0fs^S5a}ajpdtAUy3a6Vm`y(fzi1=Lv>IhKmM$8F_Eb6lC;DkmVX*-`0S^m| z`c`r%viQPF zlBW1lic4W$UV^EwY*q2nG zNsXc;9!*mgx^$SNEpdc_Krv7(ZBJq_0SUT)%m%NF8kc;48$M=qpZOVTLL!{uQ)QR#Sa6JEX~KI0mK2LMnV+`t+-l zbrmU4KZBnCf1BK{jbM>X7owDT$n(8P5S=- zfxffP&Khi@Jq`B;2}%~wZ$)YS2KGBE<|ao*Xvnu`qSH`3P`XN_QcIUfPOZ~NR+8*T z$GByrM5GO8WWI?9N@h2yj55+kqPW>4RrJ6}+_*5=f^wuTRnZ=ZD{Fn?ctf=XQbgN{ zI*Zn0e6-B<>1G4wudcF&4KWVIF4l|H9Tq)EWV)5LJ}fTc9a(`ms#G+fGzd*p$mTUU zz&p2W`3wxpF`neW)q0tHBx@FTLR`zoD)%Ecenoo)%?N=a2 zUaEC5q98eFAdlNmw@Og~}H?Br0V5$rYQrQkNPYC@7nJh1ieJ zK&sO0RuJ8Q>!U;zXEOc_Yu1Hi3!0lFhTU73KC`lPkp=pM!u9FYNFD<*W(FZ8!>ra- zB6`SvrQZq)DY!mBoWA{xgD~&$tW5bQ>LX^I~0>7MAe9j=A38X!D zu&OqrHJH*#dxUjieQC6@3nz66kB2h;XcBJ)07At2mc1v$QgH^6zei#=_ zVY%``l!{rTMCS4%uD}vv0^_imY=w_M{rSr?8VWQQDrkh6nh+)S9eL=VE@VEj7+Zus zI$auU<|G-%$!0dls2?Dk6?Q40pHA|ZO5e$oatV?wS&gwugyod_Zke4ws89pt`n8CD zGm?y=O!F9bh-nIw7`o2WZ3gqV7=6ej>7ndK(!`*yT-ifamEMMOZahCN@D^)7DJhib zG8v219gscHr)Ld0wn&#>TFWV3LLW>g=N8=pk%sXU(&>veJ!TRkDl1Z7>HDIX9FqNF zOP~*{58w2cAtU>lG^q?C#QrUTK67;$TtSp}q?jwvH11XOH87YV#dOun9_Er?(tf7R zeGM_O*aU&^UPI}xS|nE|DSXwkUSIxya{p4R|Ka*dvi=p@dFJj`==qGvX8y*;V677K zP(q&HP@kDH<%CjQMnSnW6D5WpaO!0?QB5Tl9;rWh%_Zcwa|N}VElj{__>bQ3VZZ72 zYLRAhn^s~r#>7^XiWf+`!YG3Say~$!}Y>B)&gCl0D7wyGWlXA;uv4F(_ z77JJ`P#O#HFUzC<%3|4yu|QGZ|7vyaL`(N?Ju;O{+}XDdfz^*B` z$Q?kx3>&FChz+wT51uPb@SioWdiv|9{7NF0*>9chD?3zBiw*mCAG<|MQxBT>ZJ$=SZ zA5qh1@8qY?)#)>L`fQqhx0Qb5l|HYhX9$%5eP&Oe>sJ9)K{fCOpx+*iK;*x6h#ysD^+0{l05k-RKx5DZGzHB7e$p%^aK6D05A}I00x1< zU0) z26zR6|4QUoxZ}WhFab;ilfYyU1EzqfU>cYXW`LRC3or}J26Mn%Fb~WJ3qUMb2o`}j zuox@>UxKAz8TbmsgRj9i;9Ia9tN;lh5v&BOz;|FZ_#UhQKY+Dh9rzKf2OGdfunBAi zTfkPZ4QvNLfgNBc*adzDyTKmt3)lE-T^H@OVA3m25mrF&3_AT|qbSF6a*EU8A0$7kCf!2JeGDpfC6j=m+|P0bn5b01N_y!4U8v_y`OIAA?VT zFYp8Y;8QRR1b{%G0YM-bgn-Y$a1aVcfG`jaMuN{l1c(GtU=$b)qQMw27K{Vq!2~c7 zOahZZ4449@f@xqnm;q*jFTgA?8_WT7!8|Y@EC8`!Ay@?Bz+$ijdK&^9&7*`!6vX7Yyn%rHn1K11a^R(U>Eoq z>;`+lFJLd&2lj&`kPHrhgWwQ2432=K;21a#Qoyg^1ki$$;5TpzWkAQPz^w|Zfj59VcoS3ybo_-GJf&keWZC`)7U+j7iEvywsBz^J z1~-C@r87f`x5_wU$TF441BBn_92N^;;zT5yfTK9j}J^X)4JYbO(y?xM7ToFS^q8 zc7G@sfj|0CZ7i-g!*Kl<4nM_2!8-I2TjASVsGo|n0VQq!Z3w L$t6qqD)s*#Q==IY diff --git a/src/programs/Simulation/gxtwist/trapfpe.c b/src/programs/Simulation/gxtwist/trapfpe.c deleted file mode 100644 index 00896b629f..0000000000 --- a/src/programs/Simulation/gxtwist/trapfpe.c +++ /dev/null @@ -1,22 +0,0 @@ -#ifdef TRAPFPE -#include -#endif - -void trapfpe_ () -{ - -#ifdef TRAPFPE - - fpu_control_t cw = _FPU_MASK_PM | // bypass PrecisionLoss traps - _FPU_MASK_UM | // bypass Underflow traps - // _FPU_MASK_OM | // bypass Overflow traps - // _FPU_MASK_DM | // bypass Denormalized traps - // _FPU_MASK_IM | // bypass Invalid traps - // _FPU_MASK_ZM | // bypass ZeroDivide traps - _FPU_EXTENDED; // enable extended precision - - _FPU_SETCW(cw); - -#endif - -} diff --git a/src/programs/Simulation/gxtwist/uginit.F b/src/programs/Simulation/gxtwist/uginit.F deleted file mode 100644 index 0b2360fbe0..0000000000 --- a/src/programs/Simulation/gxtwist/uginit.F +++ /dev/null @@ -1,200 +0,0 @@ -* -* $Id$ -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE UGINIT -* -************************************************************************ -* * -* To initialise GEANT3 program and read data cards * -* * -************************************************************************ -* -#include "geant321/gckine.inc" -#include "geant321/gcunit.inc" -#include "geant321/gcphys.inc" -#include "hdtrackparams.inc" -#include "halo.inc" -* - integer iskip - integer infile(20) - integer outfile(20) - common /inputFile/ iskip,infile,outfile - data iskip/0/ - data infile/20*0/ - data outfile/20*0/ - integer openInput, skipInput, openOutput - external openInput, skipInput, openOutput - real beamE0, beamEpeak, beamEmin, radColDist, colDiam - real beamEmit, radThick - common /beamPars/ beamE0,beamEpeak,beamEmin,radColDist,colDiam, - + beamEmit, radThick - data beamE0/0/ - data beamEpeak/0/ - data beamEmin/0/ - data radColDist/76.0/ - data colDiam/0.0034/ - data beamEmit/1e-8/ - data radThick/20e-6/ - - data fhalo/0.0/ - data bfield/-999.0/ - data nosecondaries/0/ - -C Use this parameter to set up a minimum photon energy -C for the coherent bremsstrahlung beam generator - see beamgen.F - real xMinimum,freqMaximum,beamStartZ,Theta02 - common /coherentGen/xMinimum,freqMaximum,beamStartZ,Theta02 - - -* -* ----------------------------------------------------------------- -* -* Initialize GEANT -C..geant.. - call trapfpe() - CALL GINIT -* -* Prints version number -* - WRITE(LOUT,1000) -* -* IKINE = particle type (default=1=gamma) -* PKINE(1)=particle energy -* IKINE and PKINE can be changed with the data card KINE -* - PKINE(1)=10. - PKINE(5)=4. - IKINE=1 - ICOMP=1 - IPAIR=1 - IBREM=1 - IANNI=1 - IPHOT=1 - IHADR=1 -* -* Initialize GEANT/ZBOOK data structures -* -C..geant.. - CALL GZINIT -* -* Define user FFREAD data cards (format free input) -* -* -* Read the data cards -* - OPEN(UNIT=4,FILE='control.in',STATUS='UNKNOWN') - CALL FFSET('LINP',4) - call ffkey('infile',infile,20,'MIXED') - call ffkey('skip',iskip,1,'INTEGER') - call ffkey('outfile',outfile,20,'MIXED') - call ffkey('beam',beamE0,7,'REAL') - call ffkey('bfield', bfield,1,'REAL') - call ffkey('nosecondaries', nosecondaries,1,'INTEGER') - call ffkey('halo',fhalo,1,'REAL') - call gtgamaff() - CALL GFFGO -* -* Verify that the random number seeds are OK -* - call GRNDMQ(iseed1,iseed2,0,'G') - if ((iseed1.eq.0).and.(iseed2.eq.0)) then - write(LOUT,980) 'UGINIT error: ' -980 format(a14,'initial random number generator seeds are 0!') - stop 'cannot continue without good random numbers' - endif -* -* Open the input stream -* - if (infile(1) .gt. 0) then - ifail = openInput(infile) - if (ifail .ne. 0) then - write(lout,9000) infile - 9000 format('GUKINE ERROR - Could not open input stream ',20a4) - stop - endif - if (iskip .gt. 0) then - ifail = skipInput(iskip) - endif - if (nevent .eq. 0) then - nevent = 999999999 - endif - endif -* -* Open the output stream -* - if (outfile(1) .eq. 0) then - call UCTOH('gxtwist.hddm',outfile,4,12) - endif - ifail = openOutput(outfile) - if (ifail .ne. 0) then - write(lout,9010) outfile - 9010 format('GUKINE ERROR - Could not open output stream ',20a4) - stop - endif -* -* Assign the beam parameters -* - if (beamEmin.lt.0) then - print * - print *, 'Error in uginit:', - + ' beamEmin is specified with negative value,', - + ' cannot continue.' - stop - elseif (beamEmin.gt.0.12) then - print * - print *, 'Error in uginit:', - + ' beamEmin is larger than a default value of 0.12 GeV,', - + ' cannot continue.' - stop - elseif (beamEmin.lt.1e-6) then - print *, - + ' beamEmin is smaller than a minimum value of 1 KeV,', - + ' Using default (120 MeV).' - beamEmin = 0.12 - endif - xMinimum = beamEmin/beamE0 - - call cobrems(beamE0,beamEpeak,beamEmit,radThick, - + radColDist,colDiam,0) -* -* Initialize graphics package -* - CALL GDINIT -* -* Initialize the Hall D geometry -* - call HDDSgeant3 - call Goptimize -* -* Open the HBOOK file for output -* - call HROPEN(50,'RZfile','geant.hbook','N',65536,istat) -* -* Initialize GEANT tracking structures -* -C..geant.. - CALL GGCLOS - CALL GPART - CALL GPHYSI - CALL GRFILE(3,'gxtwist.rz','ON') - CALL HCDIR('//RZfile',' ') - -* -* Initialize the GELHAD package and verify parameters -* - call gelh_vrfy() -* -* Load FLUKA and MICAP cross section data if selected -* - if (IHADR.ge.3) call FLINIT - if (IHADR.eq.4) call GMORIN - - 1000 FORMAT(/,' MODE VERSION 1.00 : ',/) - END diff --git a/src/programs/Simulation/gxtwist/uglast.F b/src/programs/Simulation/gxtwist/uglast.F deleted file mode 100644 index 653c923d62..0000000000 --- a/src/programs/Simulation/gxtwist/uglast.F +++ /dev/null @@ -1,33 +0,0 @@ -* -* $Id$ -* -* -* Revision 1.1.1.1 1995/10/24 10:21:52 cernlib -* Geant -* -* -#include "geant321/pilot.h" -*CMZ : 3.21/02 29/03/94 15.41.35 by S.Giani -*-- Author : - SUBROUTINE UGLAST -* -************************************************************************ -* * -* Termination routine to print histograms and statistics * -* * -************************************************************************ -#include "geant321/gcomis.inc" -* -* ----------------------------------------------------------------- -* - call gelh_last() - CALL GLAST -* -* Close HIGZ -* - CALL IGEND -* - call HROUT(0,icycle,' ') - call HREND('RZfile') - call closeOutput() - END diff --git a/src/programs/Simulation/gxtwist/wc.f b/src/programs/Simulation/gxtwist/wc.f deleted file mode 100644 index ceea6fdaaa..0000000000 --- a/src/programs/Simulation/gxtwist/wc.f +++ /dev/null @@ -1,89 +0,0 @@ - subroutine wc - end - - subroutine wcprint(n,x,y,z) - integer n - real x(*),y(*),z(*) -c gcvolu.inc - COMMON/GCVOLU/NLEVEL,NAMES(15),NUMBER(15), - +LVOLUM(15),LINDEX(15),INFROM,NLEVMX,NLDEV(15),LINMX(15), - +GTRAN(3,15),GRMAT(10,15),GONLY(15),GLX(3) -c gtvolu.inc - INTEGER NLEVEL,NAMES,NUMBER,LVOLUM,LINDEX,INFROM,NLEVMX, - + NLDEV,LINMX - REAL GTRAN,GRMAT,GONLY,GLX -c - real xc(3),ubuf(99) - real F(3) - character*20 natmed - do i=1,n - xc(1)=x(i) - xc(2)=y(i) - xc(3)=z(i) - call gmedia(xc,numed) - call gftmed(numed,natmed,nmat,isvol,ifield,fieldm,tmaxfd, - + stemax,deemax,epsil,stmin,ubuf,nwbuf) - call gufld(xc,F) - print 1000, i,xc,natmed,(names(l),number(l),l=1,nlevel) - if (ifield.eq.1) then - print 1010, F - if (sqrt(F(1)**2+F(2)**2+F(3)**2).gt.fieldm) then - print *, 'WARNING: local magnetic field exceeds ', - + 'upper bound of',fieldm,' specified for medium!' - endif - elseif (ifield.eq.2) then - print 1020, F - if (sqrt(F(1)**2+F(2)**2+F(3)**2).gt.fieldm) then - print *, 'WARNING: local magnetic field exceeds ', - + 'upper bound of',fieldm,' specified for medium!' - endif - elseif (ifield.eq.3) then - print 1030, 0,0,fieldm - endif - enddo - 1000 format(' point',i3,':',3g12.5,1x,a20,99('/',a4,i3)) - 1010 format(10x,'strongly inhomogeneous field (',2(g12.5,','), - + g12.5,') kG') - 1020 format(10x,'inhomogeneous field (',2(g12.5,','), - + g12.5,') kG') - 1030 format(10x,'uniform field (',2(g12.5,','), - + g12.5,') kG') - end - - subroutine wcpnorm(n,x,y,z) - integer n - real x(*),y(*),z(*) - real xnorm(3,2),u(3,2),v(3,2) - integer ierr - do i=1,n - xnorm(1,1)=x(i) - xnorm(2,1)=y(i) - xnorm(3,1)=z(i) - call gmedia(xnorm,numed) - call ggperp(xnorm,u,ierr) - xnorm(1,2)=xnorm(1,1)+u(1,1) - xnorm(2,2)=xnorm(2,1)+u(2,1) - xnorm(3,2)=xnorm(3,1)+u(3,1) - call GDFR3D(xnorm,2,u,v) - call IPL(2,u,v) - enddo - end - - subroutine wc3dpline(n,x,y,z) - integer n - real x(*),y(*),z(*) - real u(999),v(999) - real x3d(3,999) - if (n.gt.999) then - print *, 'Warning from wc3dpline - cannot plot more than 999' - print *, 'points in a single polyline, request ignored.' - return - endif - do i=1,n - x3d(1,i)=x(i) - x3d(2,i)=y(i) - x3d(3,i)=z(i) - enddo - call GDFR3D(x3d,n,u,v) - call IPL(n,u,v) - end diff --git a/src/programs/Simulation/gxtwist/wc.kumac b/src/programs/Simulation/gxtwist/wc.kumac deleted file mode 100644 index 43f022c7c5..0000000000 --- a/src/programs/Simulation/gxtwist/wc.kumac +++ /dev/null @@ -1,575 +0,0 @@ -* -* wc.kumac - Geant++ macros to accept drawing origin arguments u,v -* in world coordinates (cm) instead of the viewport coordinates -* expected by the Geant3 drawing package commands. Otherwise -* the arguments are the same as those of the Geant++ commands. -* -* Usage : exec wc#dcut site x .1 10 10 .01 .01 -* -* The following drawing commands are supported: -* draw - plot a view of a named volume in its own reference frame -* dcut - plot a planar intersection with a named volume in its frame -* dxcut - same as dcut, but plane is general instead of only xy, xz or yz -* dvolume - same as draw, but can use master reference frame and select -* particular instances of a given volume in the geometry tree -* The following graphical queries are supported -* pick - clicks of the mouse are converted into 3d points using the -* current drawing parameters and cut plane (see below). -* Multiple clicks of the mouse with the left button select the points, -* while the pick input is terminated with a click of the right button. -* Special arguments to the pick command produce special results: -* pick m - pick two points followed by a right-click, and the -* distance between the two points is computed and printed. -* pick o - pick a single point, and that will be the new origin for -* subsequence wc drawing commands. -* The following calls modify the behavior of the above macros -* setorigin x y z - wc origin (drawing focus) is set to (x,y,z) -* setview u0 v0 su sv theta phi psio -* - sets location of drawing focus in graphics window to (u0,v0) -* - sets scale factors for drawing in graphics window to (su,sv) -* - sets viewing angles (degrees) to Geant angles theta,phi,psio -* where psio differs from the Euler psi of the camera in that -* psio=0 is defined as the psi for which the y axis projects to -* the up direction on the graphics window, unless the projection -* of yhat is zero, in which case xhat is chosen as up -* setangles theta phi psio -* - attempts to calculate the actual Euler psi corresponding to the -* Geant convention for psio (degrees) and save them all as globals -* setcutplane ctheta cphi xint -* - defines the virtual cut plane in the graphics image as the -* plane perpendicular to the ctheta,cphi (degrees) direction, -* whose intercept with the axis ctheta,cphi is xint (cm). -* -* author: Richard Jones -* date: May 10, 2004 -* -MACRO wc - mess 'wc.kumac - Geant++ macros to accept drawing origin arguments u,v' - mess ' in world coordinates (cm) instead of the viewport coordinates' - mess ' expected by the Geant3 drawing package commands. Otherwise' - mess ' the arguments are the same as those of the Geant++ commands.' - mess - mess 'Usage : exec wc#dcut site x .1 10 10 .01 .01' - mess - mess 'The following drawing commands are supported:' - mess ' draw - plot a view of a named volume in its own reference frame' - mess ' dcut - plot a planar intersection with a named volume in its frame' - mess ' dxcut - same as dcut, but plane is general instead of only xy, xz or yz' - mess ' dvolume - same as draw, but can use master reference frame and select' - mess ' particular instances of a given volume in the geometry tree' - mess 'The following graphical queries are supported' - mess ' pick - clicks of the mouse are converted into 3d points using the' - mess ' current drawing parameters and cut plane (see below).' - mess ' Multiple clicks of the mouse with the left button select the points,' - mess ' while the pick input is terminated with a click of the right button.' - mess ' Special arguments to the pick command produce special results:' - mess ' pick m - pick two points followed by a right-click, and the' - mess ' distance between the two points is computed and printed.' - mess ' pick o - pick a single point, and that will be the new origin for' - mess ' subsequence wc drawing commands.' - mess ' The following calls modify the behavior of the above macros' - mess ' setorigin x y z - wc origin (drawing focus) is set to (x,y,z)' - mess ' setview u0 v0 su sv theta phi psio' - mess ' - sets location of drawing focus in graphics window to (u0,v0)' - mess ' - sets scale factors for drawing in graphics window to (su,sv)' - mess ' - sets viewing angles (degrees) to Geant angles theta,phi,psio' - mess ' where psio differs from the Euler psi of the camera in that' - mess ' psio=0 is defined as the psi for which the y axis projects to' - mess ' the up direction on the graphics window, unless the projection' - mess ' of yhat is zero, in which case xhat is chosen as up' - mess ' setangles theta phi psio' - mess ' - attempts to calculate the actual Euler psi corresponding to the' - mess ' Geant convention for psio (degrees) and save them all as globals' - mess ' setcutplane ctheta cphi xint' - mess ' - defines the virtual cut plane in the graphics image as the' - mess ' plane perpendicular to the ctheta,cphi (degrees) direction,' - mess ' whose intercept with the axis ctheta,cphi is xint (cm).' - mess - mess 'author: Richard Jones' - mess 'date: May 10, 2004' - mess -RETURN - -MACRO draw - if ([1].eq.' ') then - message "Error: first argument (volume name) is mandatory" - exitm - endif - global/import wc* - if ([2].ne.' ') then - theta=[2] - elseif ($defined(wctheta).eq.wctheta) then - theta=[wctheta] - else - theta=30 - endif - if ([3].ne.' ') then - phi=[3] - elseif ($defined(wcphi).eq.wcphi) then - phi=[wcphi] - else - phi=30 - endif - if ([4].ne.' ') then - psio=[4] - elseif ($defined(wcpsio).eq.wcpsio) then - psio=[wcpsio] - else - psio=0 - endif - if ([5].ne.' ') then - u0=[5] - elseif ($defined(wcu0).eq.wcu0) then - u0=[wcu0] - else - u0=0 - endif - if ([6].ne.' ') then - v0=[6] - elseif ($defined(wcv0).eq.wcv0) then - v0=[wcv0] - else - v0=0 - endif - if ([7].ne.' ') then - su=[7] - elseif ($defined(wcsu).eq.wcsu) then - su=[wcsu] - else - su=1 - endif - if ([8].ne.' ') then - sv=[8] - elseif ($defined(wcsv).eq.wcsv) then - sv=[wcsv] - else - sv=1 - endif - if ($defined(wcoriginx).ne.wcoriginx) then - exec setorigin 0 0 0 - endif - if (([su].eq.0).or.([sv].eq.0)) then - message "Error: horizontal and vertical scale factors must be non-zero" - exitm - endif - exec setangles [theta] [phi] [psio] - global/import wc* - sigma wcx0=([wcoriginx])*cos([wcphi]*pi/180)+([wcoriginy])*sin([wcphi]*pi/180) - sigma wcy0=-([wcoriginx])*sin([wcphi]*pi/180)+([wcoriginy])*cos([wcphi]*pi/180) - sigma wcz0=[wcoriginz] - sigma wcz1=wcz0*cos([wctheta]*pi/180)+wcx0*sin([wctheta]*pi/180) - sigma wcx1=-wcz0*sin([wctheta]*pi/180)+wcx0*cos([wctheta]*pi/180) - sigma wcy1=wcy0 - sigma wcx2=wcx1*cos([wcpsi]*pi/180)+wcy1*sin([wcpsi]*pi/180) - sigma wcy2=-wcx1*sin([wcpsi]*pi/180)+wcy1*cos([wcpsi]*pi/180) - sigma wcz2=wcz1 - u=$sigma([u0]-(wcx2*[su])) - v=$sigma([v0]-(wcy2*[sv])) - satt * lsty 7 - next - draw [1] [theta] [phi] [psio] [u] [v] [su] [sv] - exec setview [theta] [phi] [psio] [u0] [v0] [su] [sv] - exec setcutplane [theta] [phi] 0 -RETURN - -MACRO dcut - if ([1].eq.' ') then - message "Error: first argument (volume name) is mandatory" - exitm - endif - global/import wc* - if ([2].ne.' ') then - caxis=$lower([2]) - elseif ($defined(wcaxis).eq.wcaxis) then - caxis=[wcaxis] - else - caxis=z - endif - if ([3].ne.' ') then - cxing=[3] - elseif ($defined(wcxing).eq.wcxing) then - cxing=[wcxing] - else - cxing=0 - endif - if ([4].ne.' ') then - u0=[4] - elseif ($defined(wcu0).eq.wcu0) then - u0=[wcu0] - else - u0=10 - endif - if ([5].ne.' ') then - v0=[5] - elseif ($defined(wcv0).eq.wcv0) then - v0=[wcv0] - else - v0=10 - endif - if ([6].ne.' ') then - su=[6] - elseif ($defined(wcsu).eq.wcsu) then - su=[wcsu] - else - su=1 - endif - if ([7].ne.' ') then - sv=[7] - elseif ($defined(wcsv).eq.wcsv) then - sv=[wcsv] - else - sv=1 - endif - if ($defined(wcoriginx).ne.wcoriginx) then - exec setorigin 0 0 0 - endif - if (([su].eq.0).or.([sv].eq.0)) then - message "Error: horizontal and vertical scale factors must be non-zero" - exitm - endif - global/import wc* - if ([caxis].eq.x) then - u=$sigma([u0]-([wcoriginz]*[su])) - v=$sigma([v0]-([wcoriginy]*[sv])) - h=$sigma([cxing]+([wcoriginx])) - phi=0; theta=-90; psi=0 - cutthe=90; cutphi=0 - elseif ([caxis].eq.y) then - u=$sigma([u0]-([wcoriginz]*[su])) - v=$sigma([v0]-([wcoriginx]*[sv])) - h=$sigma([cxing]+([wcoriginy])) - phi=-90; theta=-90; psi=0 - cutthe=90; cutphi=90 - elseif ([caxis].eq.z) then - u=$sigma([u0]-([wcoriginx]*[su])) - v=$sigma([v0]-([wcoriginy]*[sv])) - h=$sigma([cxing]+([wcoriginz])) - phi=0; theta=0; psi=0 - cutthe=0; cutphi=0 - else - message Error: argument 2=[caxis] must be either x, y or z - exitm - endif - satt * lsty 7 - next - dcut [1] [caxis] [h] [u] [v] [su] [sv] - global/create wcaxis [caxis] 'cut axis for wc' - global/create wcxing [cxing] 'cut axis crossing value for wc' - exec setview [theta] [phi] 0 [u0] [v0] [su] [sv] - exec setcutplane [cutthe] [cutphi] [cxing] -RETURN - -MACRO dxcut - if ([1].eq.' ') then - message "Error: first argument (volume name) is mandatory" - exitm - endif - global/import wc* - if ([2].ne.' ') then - cutthe=[2] - elseif ($defined(wcthecut).eq.wcthecut) then - cutthe=[wcthecut] - else - message "Error: no default for argument CUTTHE" - exitm - endif - if ([3].ne.' ') then - cutphi=[3] - elseif ($defined(wcphicut).eq.wcphicut) then - cutphi=[wcphicut] - else - message "Error: no default for argument CUTPHI" - exitm - endif - if ([4].ne.' ') then - cutval=[4] - elseif ($defined(wcvalcut).eq.wcvalcut) then - cutval=[wcvalcut] - else - cutval=0 - endif - if ([5].ne.' ') then - theta=[5] - elseif ($defined(wctheta).eq.wctheta) then - theta=[wctheta] - else - theta=30 - endif - if ([6].ne.' ') then - phi=[6] - elseif ($defined(wcphi).eq.wcphi) then - phi=[wcphi] - else - phi=30 - endif - if ([7].ne.' ') then - u0=[7] - elseif ($defined(wcu0).eq.wcu0) then - u0=[wcu0] - else - u0=10 - endif - if ([8].ne.' ') then - v0=[8] - elseif ($defined(wcv0).eq.wcv0) then - v0=[wcv0] - else - v0=10 - endif - if ([9].ne.' ') then - su=[9] - elseif ($defined(wcsu).eq.wcsu) then - su=[wcsu] - else - su=1 - endif - if ([10].ne.' ') then - sv=[10] - elseif ($defined(wcsv).eq.wcsv) then - sv=[wcsv] - else - sv=1 - endif - if ($defined(wcoriginx).ne.wcoriginx) then - exec setorigin 0 0 0 - endif - if (([su].eq.0).or.([sv].eq.0)) then - message "Error: horizontal and vertical scale factors must be non-zero" - exitm - endif - exec setangles [theta] [phi] 0 - global/import wc* - sigma wcnx=sin([cutthe]*pi/180)*cos([cutphi]*pi/180) - sigma wcny=sin([cutthe]*pi/180)*sin([cutphi]*pi/180) - sigma wcnz=cos([cutthe]*pi/180) - sigma wcx0=([wcoriginx])*cos([wcphi]*pi/180)+([wcoriginy])*sin([wcphi]*pi/180) - sigma wcy0=-([wcoriginx])*sin([wcphi]*pi/180)+([wcoriginy])*cos([wcphi]*pi/180) - sigma wcz0=[wcoriginz] - sigma wcz1=wcz0*cos([wctheta]*pi/180)+wcx0*sin([wctheta]*pi/180) - sigma wcx1=-wcz0*sin([wctheta]*pi/180)+wcx0*cos([wctheta]*pi/180) - sigma wcy1=wcy0 - sigma wcx2=wcx1*cos([wcpsi]*pi/180)+wcy1*sin([wcpsi]*pi/180) - sigma wcy2=-wcx1*sin([wcpsi]*pi/180)+wcy1*cos([wcpsi]*pi/180) - sigma wcz2=wcz1 - u=$sigma([u0]-(wcx2*[su])) - v=$sigma([v0]-(wcy2*[sv])) - cut=$sigma([cutval]+([wcoriginx]*wcnx)+([wcoriginy]*wcny)+([wcoriginz]*wcnz)) - satt * lsty 7 - next - dxcut [1] [cutthe] [cutphi] [cut] [theta] [phi] [u] [v] [su] [sv] - exec setview [theta] [phi] 0 [u0] [v0] [su] [sv] - exec setcutplane [cutthe] [cutphi] [cutval] -RETURN - -MACRO dvolume - if ([1].eq.' ') then - message "Error: first argument (n) is mandatory" - exitm - endif - if ([2].eq.' ') then - message "Error: second argument (volume list) is mandatory" - exitm - endif - if ([3].eq.' ') then - chnrs=[3] - else - chnrs=MARS - endif - global/import wc* - if ([4].ne.' ') then - theta=[4] - elseif ($defined(wctheta).eq.wctheta) then - theta=[wctheta] - else - theta=30 - endif - if ([5].ne.' ') then - phi=[5] - elseif ($defined(wcphi).eq.wcphi) then - phi=[wcphi] - else - phi=30 - endif - if ([6].ne.' ') then - psi=[6] - elseif ($defined(wcpsi).eq.wcpsi) then - psi=[wcpsi] - else - psi=30 - endif - if ([7].ne.' ') then - u0=[7] - elseif ($defined(wcu0).eq.wcu0) then - u0=[wcu0] - else - u0=10 - endif - if ([8].ne.' ') then - v0=[8] - elseif ($defined(wcv0).eq.wcv0) then - v0=[wcv0] - else - v0=10 - endif - if ([9].ne.' ') then - su=[9] - elseif ($defined(wcsu).eq.wcsu) then - su=[wcsu] - else - su=1 - endif - if ([10].ne.' ') then - sv=[10] - elseif ($defined(wcsv).eq.wcsv) then - sv=[wcsv] - else - sv=1 - endif - if ($defined(wcoriginx).ne.wcoriginx) then - exec setorigin 0 0 0 - endif - if (([su].eq.0).or.([sv].eq.0)) then - message "Error: horizontal and vertical scale factors must be non-zero" - exitm - endif - exec setangles [theta] [phi] [psi] - global/import wc* - sigma wcx0=([wcoriginx])*cos([wcphi]*pi/180)+([wcoriginy])*sin([wcphi]*pi/180) - sigma wcy0=-([wcoriginx])*sin([wcphi]*pi/180)+([wcoriginy])*cos([wcphi]*pi/180) - sigma wcz0=[wcoriginz] - sigma wcz1=wcz0*cos([wctheta]*pi/180)+wcx0*sin([wctheta]*pi/180) - sigma wcx1=-wcz0*sin([wctheta]*pi/180)+wcx0*cos([wctheta]*pi/180) - sigma wcy1=wcy0 - sigma wcx2=wcx1*cos([wcpsi]*pi/180)+wcy1*sin([wcpsi]*pi/180) - sigma wcy2=-wcx1*sin([wcpsi]*pi/180)+wcy1*cos([wcpsi]*pi/180) - sigma wcz2=wcz1 - u=$sigma([u0]-(wcx2*[su])) - v=$sigma([v0]-(wcy2*[sv])) - satt * lsty 7 - next - dvolume [1] [2] [chnrs] [theta] [phi] [psi] [u] [v] [su] [sv] - exec setview [theta] [phi] [psi] [u0] [v0] [su] [sv] - exec setcutplane [theta] [phi] 0 -RETURN - -MACRO pick opt - global/import wc* - if (($defined(wcu0).ne.wcu0).or. _ - ($defined(wcv0).ne.wcv0).or. _ - ($defined(wcsu).ne.wcsu).or. _ - ($defined(wcsv).ne.wcsv).or. _ - ($defined(wcthecut).ne.wcthecut).or. _ - ($defined(wcphicut).ne.wcphicut).or. _ - ($defined(wcvalcut).ne.wcvalcut)) then - message "Error: you must use wc#xxx to create a drawing first" - exitm - endif - sigma wcnx=sin([wcthecut]*pi/180)*cos([wcphicut]*pi/180) - sigma wcny=sin([wcthecut]*pi/180)*sin([wcphicut]*pi/180) - sigma wcnz=cos([wcthecut]*pi/180) - sigma wcn1=wcnx*cos([wcphi]*pi/180)+wcny*sin([wcphi]*pi/180) - sigma wcn2=-wcnx*sin([wcphi]*pi/180)+wcny*cos([wcphi]*pi/180) - sigma wcn3=wcnz - sigma wcn6=wcn3*cos([wctheta]*pi/180)+wcn1*sin([wctheta]*pi/180) - sigma wcn4=-wcn3*sin([wctheta]*pi/180)+wcn1*cos([wctheta]*pi/180) - sigma wcn5=wcn2 - sigma wcnu=wcn4*cos([wcpsi]*pi/180)+wcn5*sin([wcpsi]*pi/180) - sigma wcnv=-wcn4*sin([wcpsi]*pi/180)+wcn5*cos([wcpsi]*pi/180) - sigma wcnw=wcn6 - vec/del wcvec* - vlocate wcvecu wcvecv - if ($vexist(wcvecu).eq.0) then - message ' no points entered' - exitm - else - nhit=$vdim(wcvecu,1) - endif - sigma wcx0=(wcvecu-[wcu0])/[wcsu] - sigma wcy0=(wcvecv-[wcv0])/[wcsv] - sigma wcz0=([wcvalcut]-(wcx0*wcnu+wcy0*wcnv))/wcnw - sigma wcx1=wcx0*cos([wcpsi]*pi/180)-wcy0*sin([wcpsi]*pi/180) - sigma wcy1=wcx0*sin([wcpsi]*pi/180)+wcy0*cos([wcpsi]*pi/180) - sigma wcz1=wcz0 - sigma wcz2=wcz1*cos([wctheta]*pi/180)-wcx1*sin([wctheta]*pi/180) - sigma wcx2=wcz1*sin([wctheta]*pi/180)+wcx1*cos([wctheta]*pi/180) - sigma wcy2=wcy1 - sigma wcx3=wcx2*cos([wcphi]*pi/180)-wcy2*sin([wcphi]*pi/180) - sigma wcy3=wcx2*sin([wcphi]*pi/180)+wcy2*cos([wcphi]*pi/180) - sigma wcz3=wcz2 - sigma wcx=[wcoriginx]+wcx3 - sigma wcy=[wcoriginy]+wcy3 - sigma wcz=[wcoriginz]+wcz3 - if ([opt].eq.o) then - exec setorigin $sigma(wcx(1)) $sigma(wcy(1)) $sigma(wcz(1)) - message wc origin reset to ([wcoriginx],[wcoriginy],[wcoriginz]) - elseif ([opt].eq.m) then - sigma d=sqrt((wcx([nhit])-wcx(1))**2_ - +(wcy([nhit])-wcy(1))**2_ - +(wcz([nhit])-wcz(1))**2) - message measured distance $sigma(d) cm - elseif ([opt].eq.l) then - line $sigma(wcvecu(1)) $sigma(wcvecv(1)) $sigma(wcvecu(2)) $sigma(wcvecv(2)) - elseif ($fexist(wc.f).gt.0) then - call wc.f77 - if ([opt].eq.n) then - call wcpnorm([nhit],wcx,wcy,wcz) - else - call wcprint([nhit],wcx,wcy,wcz) - endif - else - do i=1,[nhit] - message ' point' [i]: $sigma(wcx([i])) $sigma(wcy([i])) $sigma(wcz([i])) - enddo - message 'To print volume and medium info you need to copy wc.f to your working directory' - endif -RETURN - -MACRO setorigin 1=0 2=0 3=0 - global/create wcoriginx [1] 'x of wc origin in current DRS (cm)' - global/create wcoriginy [2] 'y of wc origin in current DRS (cm)' - global/create wcoriginz [3] 'z of wc origin in current DRS (cm)' -RETURN - -MACRO setview theta phi psio u0 v0 su sv - global/create wcu0 [u0] 'u offset of wc origin in drawing coordinates' - global/create wcv0 [v0] 'v offset of wc origin in drawing coordinates' - global/create wcsu [su] 'x scale factor of drawing in wc' - global/create wcsv [sv] 'y scale factor of drawing in wc' - exec setangles [theta] [phi] [psio] -RETURN - -MACRO setcutplane theta phi w - global/create wcthecut [theta] 'euler theta of normal to cut plane' - global/create wcphicut [phi] 'euler phi of normal to cut plane' - global/create wcvalcut [w] 'w-intercept of cut plane (for picking)' -RETURN - -MACRO setangles theta phi psio - global/import wc* - sigma tanphi=tan([phi]*pi/180) - sigma costhe=cos([theta]*pi/180) - sigma tanpsi=-costhe*tanphi - sigma cospsi=1/sqrt(1+tanpsi**2) - sigma cosphi=cos([phi]*pi/180) - sigma sinphi=sin([phi]*pi/180) - if ($sigma(abs(costhe)).lt.0.005) then - if ($sigma(abs(cosphi)).lt.0.005) then - sigma psi=pi - theta=90 - phi=90 - elseif ($sigma(cosphi).ge.0) then - sigma psi=0 - else - sigma psi=pi - endif - elseif ($sigma(cosphi*cospsi).ge.0) then - sigma psi=atan(tanpsi) - else - sigma psi=atan(tanpsi)+pi - endif - psi=$sigma((psi*180/pi)-([psio])) - global/create wcpsi [psi] 'euler psi of view in wc frame' - global/create wctheta [theta] 'euler theta of view in wc frame' - global/create wcphi [phi] 'euler phi of view in wc frame' - global/create wcpsio [psio] 'euler psi offset of view in wc frame' -RETURN diff --git a/src/programs/Simulation/mcsmear/BCALSmearer.cc b/src/programs/Simulation/mcsmear/BCALSmearer.cc deleted file mode 100644 index 7966ecdd3f..0000000000 --- a/src/programs/Simulation/mcsmear/BCALSmearer.cc +++ /dev/null @@ -1,896 +0,0 @@ -// $Id: smear.cc 7650 2011-03-29 22:52:30Z shepherd $ -// -// Created June 22, 2005 David Lawrence -// -// Major revision March 6, 2012 David Lawrence - -#include "BCALSmearer.h" - -#include "DRandom2.h" - -#ifndef _DBG_ -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ cout<<__FILE__<<":"<<__LINE__< SiPMHits; - vector incident_particles; - GetSiPMHits(record, SiPMHits, incident_particles); - - // Sampling fluctuations - if(config->SMEAR_HITS) - ApplySamplingFluctuations(SiPMHits, incident_particles); - - // Merge hits associated with different incident particles - MergeHits(SiPMHits, bcal_config->BCAL_TWO_HIT_RESO); - - // Poisson Statistics - if(config->SMEAR_HITS) - ApplyPoissonStatistics(SiPMHits); - - // Place all hit cells into list indexed by fADC ID - map bcalfADC; - SortSiPMHits(SiPMHits, bcalfADC, bcal_config->BCAL_TWO_HIT_RESO); - - // Electronic noise/Dark hits Smearing - if(config->SMEAR_HITS) - SimpleDarkHitsSmear(bcalfADC); - - // Apply energy threshold to dismiss low-energy hits - map fADCHits; - map TDCHits; - FindHits(bcal_config->BCAL_ADC_THRESHOLD_MEV, bcalfADC, fADCHits, TDCHits); - - // Apply time smearing to emulate the fADC resolution - if(config->SMEAR_HITS) - ApplyTimeSmearing(bcal_config->BCAL_FADC_TIME_RESOLUTION, bcal_config->BCAL_TDC_TIME_RESOLUTION, fADCHits, TDCHits); - - // Copy hits into HDDM tree - CopyBCALHitsToHDDM(fADCHits, TDCHits, record); - - bcalfADC.clear(); -} - -int inline BCALSmearer::GetCalibIndex(int module, int layer, int sector) { - return bcal_config->BCAL_NUM_LAYERS*bcal_config->BCAL_NUM_SECTORS*(module-1) - + bcal_config->BCAL_NUM_SECTORS*(layer-1) + (sector-1); -} - - -//----------- -// GetSiPMHits -//----------- -void BCALSmearer::GetSiPMHits(hddm_s::HDDM *record, - map &SiPMHits, - vector &incident_particles) -{ - /// Loop through input HDDM data and extract the energy and time info into - /// CellHits objects. - - // Make sure HDDM stuctures exist. - // In the case of no real BCAL hits, we may still want to emit - // dark hit only events. In this case, we must create the BCAL - // tree here. - hddm_s::BarrelEMcalList bcals = record->getBarrelEMcals(); - if (bcals.size() == 0){ - if(record->getHitViews().empty()){ - record->getPhysicsEvent().addHitViews(); - } - bcals = record->getHitViews().begin()->addBarrelEMcals(); - } - - // Loop over GEANT hits in BCAL - hddm_s::BcalTruthHitList hits = record->getBcalTruthHits(); - hddm_s::BcalTruthHitList::iterator iter; - for (iter = hits.begin(); iter != hits.end(); ++iter) { - bcal_index idxup(iter->getModule(), iter->getLayer(), - iter->getSector(), - iter->getIncident_id(), - bcal_index::kUp); - bcal_index idxdn(iter->getModule(), iter->getLayer(), - iter->getSector(), - iter->getIncident_id(), - bcal_index::kDown); - - double Z = iter->getZLocal(); - double dist_up = 390.0/2.0 + Z; - double dist_dn = 390.0/2.0 - Z; - - int layer = 0; - if (iter->getLayer() == 1){ - layer = 1; - } else if (iter->getLayer() == 2 || iter->getLayer() == 3){ - layer = 2; - } else if (iter->getLayer() == 4 || iter->getLayer() == 5 || iter->getLayer() == 6) { - layer = 3; - } else { - layer = 4; - } - int table_id = GetCalibIndex( iter->getModule(), layer, iter->getSector() ); // key the cell identification off of the upstream cell - double cEff = bcal_config->GetEffectiveVelocity(table_id); - //double attenuation_length = 0; // initialize variable - //double attenuation_L1=-1., attenuation_L2=-1.; // these parameters are ignored for now - //bcal_config->GetAttenuationParameters(table_id, attenuation_length, attenuation_L1, attenuation_L2); - - // Get reference to existing CellHits, or create one if it doesn't exist - CellHits &cellhitsup = SiPMHits[idxup]; - cellhitsup.Etruth = iter->getE(); // Energy deposited in the cell in GeV - //cellhitsup.E = iter->getE()*exp(-dist_up/attenuation_length)*1000.; // in attenuated MeV - cellhitsup.E = iter->getE()*exp(-dist_up/bcal_config->BCAL_ATTENUATION_LENGTH)*1000.; // in attenuated MeV - cellhitsup.t = iter->getT() + dist_up/cEff; // in ns - cellhitsup.end = CellHits::kUp; // Keep track of BCal end - - // Get reference to existing CellHits, or create one if it doesn't exist - CellHits &cellhitsdn = SiPMHits[idxdn]; - cellhitsdn.Etruth = iter->getE(); // Energy deposited in the cell in GeV - cellhitsdn.E = iter->getE()*exp(-dist_dn/bcal_config->BCAL_ATTENUATION_LENGTH)*1000.; // in attenuated MeV - cellhitsdn.t = iter->getT() + dist_dn/cEff; // in ns - cellhitsdn.end = CellHits::kDown; // Keep track of BCal end - } - - // Loop over incident particle list - hddm_s::BcalTruthIncidentParticleList iparts = - bcals().getBcalTruthIncidentParticles(); - hddm_s::BcalTruthIncidentParticleList::iterator piter; - int pcount = 0; - for (piter = iparts.begin(); piter != iparts.end(); ++piter) { - incident_particles.push_back(IncidentParticle_t(*piter)); - if (piter->getId() != ++pcount) { - // If this ever gets called, we'll need to implement a sort routine - _DBG_ << "Incident particle order not preserved!" << endl; - exit(-1); - } - } - - //if (hNincident_particles) - // hNincident_particles->Fill(incident_particles.size()); -} - -//----------- -// ApplySamplingFluctuations -//----------- -void BCALSmearer::ApplySamplingFluctuations(map &SiPMHits, vector &incident_particles) -{ - /// Loop over the CellHits objects and apply sampling fluctuations. - /// - /// Here we apply a statistical error due to the sampling - /// fluctuations. The total energy (Etruth) is integrated by hdgeant. - /// We calculate a sigma based on the deposited energy only. In - /// reality, the sampling fluctuations are also a function of the - /// angle of the shower particles w.r.t. the fibers. We do not include - /// any angular dependence at this time. To do so will require more - /// information be passed from hdgeant. - /// - /// The error is applied by finding the ratio of the smeared - /// cell energy to unsmeared cell energy and scaling the energy - /// by it. - - if(bcal_config->NO_SAMPLING_FLUCTUATIONS)return; - if(bcal_config->NO_SAMPLING_FLOOR_TERM) - bcal_config->BCAL_SAMPLINGCOEFB=0.0; // (redundant, yes, but located in more obvious place here) - - map::iterator iter=SiPMHits.begin(); - for(; iter!=SiPMHits.end(); iter++){ - CellHits &cellhits = iter->second; - - // Find fractional sampling sigma based on deposited energy (whole colorimeter, not just fibers) - double Etruth = cellhits.Etruth; - double sqrtterm = bcal_config->BCAL_SAMPLINGCOEFA / sqrt( Etruth ); - double linterm = bcal_config->BCAL_SAMPLINGCOEFB; - double sigmaSamp = sqrt(sqrtterm*sqrtterm + linterm*linterm); - - // Convert sigma into GeV - sigmaSamp *= Etruth; - - // Randomly sample the fluctuation - double Esmeared = gDRandom.Gaus(Etruth,sigmaSamp); - - // Calculate ratio of smeared to unsmeared - double ratio = Esmeared/Etruth; - - // Scale attenuated energy - cellhits.E *= ratio; - } -} - -//----------- -// MergeHits -//----------- -void BCALSmearer::MergeHits(map &SiPMHits, double Resolution) -{ - /// Combine all SiPM CellHits corresponding to the same - /// cell but different incident particles into a single - /// hit. This is done after the sampling fluctuations - /// have been applied so there is no more dependence on - /// the incident particle parameters. - - // Loop until no merges are made - while(true){ - bool merge=false; - bool merged=false; - map::iterator iter1=SiPMHits.begin(); - for(;iter1!=SiPMHits.end(); iter1++){ - map::iterator iter2 = iter1; - for(++iter2; iter2!=SiPMHits.end(); iter2++){ - - // If hits are not from same module,layer,sector,end - // then just continue the loop - if(iter1->first.module != iter2->first.module)continue; - if(iter1->first.layer != iter2->first.layer )continue; - if(iter1->first.sector != iter2->first.sector)continue; - if(iter1->first.end != iter2->first.end )continue; - - // If hits are far enough apart in time, don't merge them - if(fabs(iter1->second.t - iter2->second.t) < Resolution) merge = true; - if(!merge)continue; - - // ----- Merge hits ----- - if(merge){ - // Get values - double E1 = iter1->second.E; - double t1 = iter1->second.t; - double E2 = iter2->second.E; - double t2 = iter2->second.t; - // It may be possible that one or both of the hits we wish to merge - // don't exist. Check for this and handle accordingly. - if(E1!=0.0 && E2!=0.0){ - iter1->second.E += E2; - if(t1 > t2) iter1->second.t = t2; // Keep the earlier of the two times - } - if(E1==0.0 && E2!=0.0){ - iter1->second.E = E2; - iter1->second.t = t2; - iter2->second.E = 0.0; - iter2->second.t = 0.0; - } - } - - // Erase second one - SiPMHits.erase(iter2); - - // Set flag that we did merge hits and break - // the loops so we can try again. - merged = true; - break; - } - if(merged)break; - } - - // When we make it through without merging any hits, - // we're done so break out of the infinite while loop. - if(!merged)break; - } -} - -//----------- -// ApplyPoissonStatistics -//----------- -void BCALSmearer::ApplyPoissonStatistics(map &SiPMHits) -{ - /// Loop over the CellHits objects and apply Poisson Statistics. - /// - /// Because the response of the SiPM is quantized in units of photo-electrons - /// Poisson counting statistics should be applied. This will affect the - /// smaller energy depositions more than the larger ones. - /// - /// We do this by converting the cell's attenuated energy into - /// photo-electrons and then sampling from a Poisson distribution with that - /// mean. The ratio of the quantized, sampled value to the unquantized - /// integral (in PE) is used to scale the energy. - - if(bcal_config->NO_POISSON_STATISTICS) return; - - map::iterator iter=SiPMHits.begin(); - for(; iter!=SiPMHits.end(); iter++){ - CellHits &cellhits = iter->second; - - if(cellhits.E>0.0){ - // Convert to number of PE - double mean_pe = cellhits.E/bcal_config->BCAL_mevPerPE; - - int Npe = gDRandom.Poisson(mean_pe); - double ratio = (double)Npe/mean_pe; - - cellhits.E *= ratio; - } - } -} - -//----------- -// SortSiPMHits -//----------- -void BCALSmearer::SortSiPMHits(map &SiPMHits, map &bcalfADC, double Resolution) -{ - /// Loop over the CellHits objects and copy pointers to them into SumHits objects. - /// - /// For the BCAL, multiple SiPMs are summed together. This routine gathers individual - /// SiPM hits into single SumHits objects. Each SumHits represents a summed - /// cell that is readout by an fADC channel. Since not every cell has signal in it, each - /// SumHits object may not have as many input cells as SiPMs that will actually be - /// contributing. - - // Loop over SiPMHits and copy a pointer to it to the correct SumHits - // element in the bcalfADC container. The bcalfADC container is an STL map which is - // convenient since it creates a new SumHits object for us if it doesn't exist, - // but otherwise, returns a reference to the existing object. - - map::iterator iter = SiPMHits.begin(); - for(; iter!=SiPMHits.end(); iter++){ - - // Get reference to SumHits object - const bcal_index &idx = iter->first; - int fADCId = dBCALGeom->fADCId( idx.module, idx.layer, idx.sector); - SumHits &sumhits = bcalfADC[fADCId]; - - // Add CellHits object to list in SumHits - CellHits &cellhits = iter->second; - sumhits.cellhits.push_back(&cellhits); - - // If this is the first cell added to the SumHits, assign its - // values to the first elements of the data arrays. Otherwise, - // test if the hit overlaps in time with an existing element. - bool mergedUP = false; - bool mergedDN = false; - - // Upstream - if(cellhits.end == CellHits::kUp && cellhits.E != 0.0){ - if(sumhits.EUP.empty()){ - sumhits.EUP.push_back(cellhits.E); - sumhits.tUP.push_back(cellhits.t); - }else{ - for(int ii = 0; ii < (int)sumhits.EUP.size(); ii++){ - if(fabs(cellhits.t - sumhits.tUP[ii]) < Resolution){ - sumhits.EUP[ii] += cellhits.E; - if(sumhits.tUP[ii] > cellhits.t) sumhits.tUP[ii] = cellhits.t; // Again, keep the earlier of the two times - mergedUP = true; - break; - } - } - if (!mergedUP){ - sumhits.EUP.push_back(cellhits.E); - sumhits.tUP.push_back(cellhits.t); - } - } - } - - // Downstream - if(cellhits.end == CellHits::kDown && cellhits.E != 0.0){ - if(sumhits.EDN.empty()){ - sumhits.EDN.push_back(cellhits.E); - sumhits.tDN.push_back(cellhits.t); - }else{ - for(int ii = 0; ii < (int)sumhits.EDN.size(); ii++){ - if(fabs(cellhits.t - sumhits.tDN[ii]) < Resolution){ - sumhits.EDN[ii] += cellhits.E; - if(sumhits.tDN[ii] > cellhits.t) sumhits.tDN[ii] = cellhits.t; // Again, keep the earlier of the two times - mergedDN = true; - break; - } - } - if (!mergedDN){ - sumhits.EDN.push_back(cellhits.E); - sumhits.tDN.push_back(cellhits.t); - } - } - } - } -} - -//----------- -// SimpleDarkHitsSmear -//----------- -void BCALSmearer::SimpleDarkHitsSmear(map &bcalfADC) -{ - /// Loop over the SumHits objects and add Electronic noise and - /// Dark hits smearing. - /// - /// Take SumHits objects and add to their energy values a random - /// energy as sampled from a Gaussian. The Gaussian for each - /// BCAL layer is based on data taken in May of 2015. - /// In future, data on a channel-by-channel basis will be implemented. - - if(bcal_config->NO_DARK_PULSES) return; - - double Esmeared = 0; - double sigma = 0; - - double sigma1 = bcal_config->BCAL_LAYER1_SIGMA_SCALE*bcal_config->BCAL_MEV_PER_ADC_COUNT; - double sigma2 = bcal_config->BCAL_LAYER2_SIGMA_SCALE*bcal_config->BCAL_MEV_PER_ADC_COUNT; - double sigma3 = bcal_config->BCAL_LAYER3_SIGMA_SCALE*bcal_config->BCAL_MEV_PER_ADC_COUNT; - double sigma4 = bcal_config->BCAL_LAYER4_SIGMA_SCALE*bcal_config->BCAL_MEV_PER_ADC_COUNT; - - // Loop over all fADC readout cells - for(int imodule=1; imodule<=dBCALGeom->NBCALMODS; imodule++){ - - int n_layers = dBCALGeom->NBCALLAYSIN + dBCALGeom->NBCALLAYSOUT; - for(int fADC_lay=1; fADC_lay<=n_layers; fADC_lay++){ - if(fADC_lay == 1) - sigma = sigma1; - else if(fADC_lay == 2) - sigma = sigma2; - else if(fADC_lay == 3) - sigma = sigma3; - else if(fADC_lay == 4) - sigma = sigma4; - - int n_sectors = (fADC_lay <= dBCALGeom->NBCALLAYSIN)? dBCALGeom->NBCALSECSIN : dBCALGeom->NBCALSECSOUT; - for(int fADC_sec=1; fADC_sec<=n_sectors; fADC_sec++){ - - // Use cellId(...) to convert fADC layer and sector into fADCId - // (see dBCALGeom->fADCId) - int fADCId = dBCALGeom->cellId(imodule, fADC_lay, fADC_sec); - - // Get SumHits object if it already exists or create new one - // if it doesn't. - SumHits &sumhits = bcalfADC[fADCId]; - - for(int ii = 0; ii < (int)sumhits.EUP.size(); ii++){ - Esmeared = gDRandom.Gaus(sumhits.EUP[ii],sigma); - sumhits.EUP[ii] = Esmeared; - } - for(int ii = 0; ii < (int)sumhits.EDN.size(); ii++){ - Esmeared = gDRandom.Gaus(sumhits.EDN[ii],sigma); - sumhits.EDN[ii] = Esmeared; - } - } - } - } -} - -//----------- -// ApplyTimeSmearing -//----------- -void BCALSmearer::ApplyTimeSmearing(double sigma_ns, double sigma_ns_TDC, map &fADCHits, map &TDCHits) -{ - /// The fADC250 will extract a time from the samples by applying an algorithm - /// to a few of the samples taken every 4ns. The perfect times from HDGeant - /// must be smeared to reflect the timing resolution of the fADC250. - /// The F1TDC250 does something similar, but with ???ns samples. - - if(bcal_config->NO_T_SMEAR) return; - - // This is hardwired. Perhaps a future warrior would like to make it somehow work with CCDB? - double BCAL_TIMINGADCCOEFA = 0.055; - double BCAL_TIMINGADCCOEFB = 0.000; - - map::iterator it = fADCHits.begin(); - for(; it!=fADCHits.end(); it++){ - fADCHitList &hitlist = it->second; - - // upstream - for(unsigned int i=0; i::iterator itTDC = TDCHits.begin(); - for(; itTDC!=TDCHits.end(); itTDC++){ - TDCHitList &TDChitlist = itTDC->second; - - // upstream - for(unsigned int i=0; i &bcalfADC, map &fADCHits, map &TDCHits) -{ - /// Loop over Sumhits objects and find hits that cross the energy threshold (ADC) - map::iterator iter = bcalfADC.begin(); - for(; iter!=bcalfADC.end(); iter++){ - - int fADCId = iter->first; - SumHits &sumhits = iter->second; - - vector uphits; - vector dnhits; - - vector uphitsTDC; - vector dnhitsTDC; - - // The histogram should have the signal size for the ADC, but the TDC - // leg will actually have a larger size since the pre-amp gain will be - // set differently. Scale the threshold down here to accomodate this. - double preamp_gain_tdc = 5.0; - double thresh_MeV_TDC = thresh_MeV/preamp_gain_tdc; - //the outermost layer of the detector is not equipped with TDCs, so don't generate any TDC hits - int layer = dBCALGeom->layer(fADCId); - - for(int ii = 0; ii < (int)sumhits.EUP.size(); ii++){ - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(bcal_config->GetEfficiencyCorrectionFactor(GetCalibIndex(dBCALGeom->module(fADCId), - dBCALGeom->layer(fADCId), - dBCALGeom->sector(fADCId)), - DBCALGeometry::End::kUpstream))) - continue; - - if(sumhits.EUP[ii] > thresh_MeV && sumhits.tUP[ii] < 2000) uphits.push_back(fADCHit(sumhits.EUP[ii],sumhits.tUP[ii])); // Fill uphits and dnhits with energies (in MeV) - if(layer != 4 && sumhits.EUP[ii] > thresh_MeV_TDC && sumhits.tUP[ii] < 2000) uphitsTDC.push_back(sumhits.tUP[ii]); // and times when they cross an energy threshold. - } // Also fill TDC uphits and dnhits with times if - for(int ii = 0; ii < (int)sumhits.EDN.size(); ii++){ // they are not layer 4 hits and cross threshold. - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(bcal_config->GetEfficiencyCorrectionFactor(GetCalibIndex(dBCALGeom->module(fADCId), - dBCALGeom->layer(fADCId), - dBCALGeom->sector(fADCId)), - DBCALGeometry::End::kDownstream))) - continue; - - if(sumhits.EDN[ii] > thresh_MeV && sumhits.tDN[ii] < 2000) dnhits.push_back(fADCHit(sumhits.EDN[ii],sumhits.tDN[ii])); - if(layer != 4 && sumhits.EDN[ii] > thresh_MeV_TDC && sumhits.tDN[ii] < 2000) dnhitsTDC.push_back(sumhits.tDN[ii]); - } - - // If at least one ADC readout channel has a hit, add the readout cell to fADCHits - if(uphits.size()>0 || dnhits.size()>0){ - fADCHitList &hitlist = fADCHits[fADCId]; - - // The module, fADC layer, and fADC sector are encoded in fADCId - // (n.b. yes, these are the same methods used for extracting - // similar quantities from the cellId.) - hitlist.module = dBCALGeom->module(fADCId); - hitlist.sumlayer = dBCALGeom->layer(fADCId); - hitlist.sumsector = dBCALGeom->sector(fADCId); - - hitlist.uphits = uphits; - hitlist.dnhits = dnhits; - } - - // If at least one TDC readout channel has a hit, add the readout cell to TDCHits - if(uphitsTDC.size()>0 || dnhitsTDC.size()>0){ - TDCHitList &hitlistTDC = TDCHits[fADCId]; - - // The module, fADC layer, and fADC sector are encoded in fADCId - // (n.b. yes, these are the same methods used for extracting - // similar quantities from the cellId.) - hitlistTDC.module = dBCALGeom->module(fADCId); - hitlistTDC.sumlayer = dBCALGeom->layer(fADCId); - hitlistTDC.sumsector = dBCALGeom->sector(fADCId); - - hitlistTDC.uphits = uphitsTDC; - hitlistTDC.dnhits = dnhitsTDC; - } - } -} - -//----------- -// CopyBCALHitsToHDDM -//----------- -void BCALSmearer::CopyBCALHitsToHDDM(map &fADCHits, - map &TDCHits, - hddm_s::HDDM *record) -{ - /// Loop over fADCHitList objects and copy the fADC hits into the HDDM tree. - /// - /// This will copy all of the hits found into the first physicsEvent found - /// in the HDDM file. Note that the hits were formed from data that may - /// have been combined from several physicsEvent structures in the HDDM - /// event. No attempt is made to keep track of this so all hits are thrown - /// into only a single physicsEvent. - - hddm_s::BarrelEMcalList bcals = record->getBarrelEMcals(); - if (bcals.size() == 0){ - if(record->getHitViews().empty()){ - record->getPhysicsEvent().addHitViews(); - } - bcals = record->getHitViews().begin()->addBarrelEMcals(); - } - hddm_s::BcalCellList cells = bcals().getBcalCells(); - hddm_s::BcalCellList::iterator iter; - for (iter = cells.begin(); iter != cells.end(); ++iter) { - - // Delete any existing bcalfADCDigiHit and bcalTDCDigiHit structures - iter->deleteBcalfADCDigiHits(); - iter->deleteBcalTDCDigiHits(); - } - - // If we have no cells over threshold, then bail now. - if (fADCHits.size() == 0 && TDCHits.size() == 0) - return; - - // Create bcalfADCHit structures to hold our fADC hits - map::iterator it; - for (it = fADCHits.begin(); it != fADCHits.end(); ++it) { - // Get pointer to our fADC cell information that needs to be copied to HDDM - fADCHitList &hitlist = it->second; - // Check if this cell is already present in the cells list - cells = bcals().getBcalCells(); - for (iter = cells.begin(); iter != cells.end(); ++iter) { - if (iter->getModule() == it->second.module && - iter->getSector() == it->second.sumsector && - iter->getLayer() == it->second.sumlayer) - { - break; - } - } - if (iter == cells.end()) { - iter = bcals().addBcalCells().begin(); - iter->setModule(hitlist.module); - iter->setLayer(hitlist.sumlayer); - iter->setSector(hitlist.sumsector); - } - - // Copy hits into BcalfADCDigiHit HDDM structure. - // Energies and times must be converted to units of ADC counts. - // Because we use unsigned integers, times must be positive. HDGEANT can output negative times, - // so we can offset the times now to ensure they are positive before the conversion, then - // fix the offset layer in the hit factories. Also, any hit that still has a negative time - // will be ignored. - for (unsigned int i = 0; i < hitlist.uphits.size(); i++) { - int integer_time = round((hitlist.uphits[i].t-bcal_config->BCAL_BASE_TIME_OFFSET)/bcal_config->BCAL_NS_PER_ADC_COUNT); - if (integer_time >= 0){ - hddm_s::BcalfADCDigiHitList fadcs = iter->addBcalfADCDigiHits(); - fadcs().setEnd(bcal_index::kUp); - double integral = round(hitlist.uphits[i].E/bcal_config->BCAL_MEV_PER_ADC_COUNT); - - // fADC saturation based on waveforms from data - if(!bcal_config->NO_FADC_SATURATION) { - if(integral > bcal_config->fADC_MinIntegral_Saturation[0][hitlist.sumlayer-1]) { - double y = integral; - double a = bcal_config->fADC_Saturation_Linear[0][hitlist.sumlayer-1]; - double b = bcal_config->fADC_Saturation_Quadratic[0][hitlist.sumlayer-1]; - double c = bcal_config->fADC_MinIntegral_Saturation[0][hitlist.sumlayer-1]; - // "invert" saturation correction for MC - integral = (1 - a*y + 2.*b*c*y - sqrt(1. - 2.*a*y + 4.*b*c*y + (a*a - 4.*b)*y*y))/(2.*b*y); - } - } - fadcs().setPulse_integral(integral); - fadcs().setPulse_time(integer_time); - } - } - for (unsigned int i = 0; i < hitlist.dnhits.size(); i++) { - int integer_time = round((hitlist.dnhits[i].t-bcal_config->BCAL_BASE_TIME_OFFSET)/bcal_config->BCAL_NS_PER_ADC_COUNT); - if (integer_time >= 0){ - hddm_s::BcalfADCDigiHitList fadcs = iter->addBcalfADCDigiHits(); - fadcs().setEnd(bcal_index::kDown); - double integral = round(hitlist.dnhits[i].E/bcal_config->BCAL_MEV_PER_ADC_COUNT); - - // fADC saturation based on waveforms from data - if(!bcal_config->NO_FADC_SATURATION) { - if(integral > bcal_config->fADC_MinIntegral_Saturation[1][hitlist.sumlayer-1]) { - double y = integral; - double a = bcal_config->fADC_Saturation_Linear[1][hitlist.sumlayer-1]; - double b = bcal_config->fADC_Saturation_Quadratic[1][hitlist.sumlayer-1]; - double c = bcal_config->fADC_MinIntegral_Saturation[1][hitlist.sumlayer-1]; - // "invert" saturation correction for MC - integral = (1 - a*y + 2.*b*c*y - sqrt(1. - 2.*a*y + 4.*b*c*y + (a*a - 4.*b)*y*y))/(2.*b*y); - } - - } - fadcs().setPulse_integral(integral); - fadcs().setPulse_time(integer_time); - } - } - } - - // Create bcalTDCDigiHit structures to hold our F1TDC hits - map::iterator ittdc; - for (ittdc = TDCHits.begin(); ittdc != TDCHits.end(); ittdc++) { - // Get pointer to our TDC hit information that needs to be copied to HDDM - TDCHitList &hitlist = ittdc->second; - // Check if this cell is already present in the cells list - cells = bcals().getBcalCells(); - for (iter = cells.begin(); iter != cells.end(); ++iter) { - if (iter->getModule() == ittdc->second.module && - iter->getSector() == ittdc->second.sumsector && - iter->getLayer() == ittdc->second.sumlayer) - { - break; - } - } - if (iter == cells.end()) { - iter = bcals().addBcalCells().begin(); - iter->setModule(hitlist.module); - iter->setLayer(hitlist.sumlayer); - iter->setSector(hitlist.sumsector); - } - - // Copy hits into BcalTDCDigiHit HDDM structure. - // Times must be converted to units of TDC counts. - for (unsigned int i = 0; i < hitlist.uphits.size(); ++i) { - int integer_time = round((hitlist.uphits[i]-bcal_config->BCAL_TDC_BASE_TIME_OFFSET)/bcal_config->BCAL_NS_PER_TDC_COUNT); - if (integer_time >= 0){ - hddm_s::BcalTDCDigiHitList tdcs = iter->addBcalTDCDigiHits(); - tdcs().setEnd(bcal_index::kUp); - tdcs().setTime(integer_time); - } - } - for (unsigned int i = 0; i < hitlist.dnhits.size(); i++) { - int integer_time = round((hitlist.dnhits[i]-bcal_config->BCAL_TDC_BASE_TIME_OFFSET)/bcal_config->BCAL_NS_PER_TDC_COUNT); - if (integer_time >= 0){ - hddm_s::BcalTDCDigiHitList tdcs = iter->addBcalTDCDigiHits(); - tdcs().setEnd(bcal_index::kDown); - tdcs().setTime(round((hitlist.dnhits[i]-bcal_config->BCAL_TDC_BASE_TIME_OFFSET)/bcal_config->BCAL_NS_PER_TDC_COUNT)); - } - } - } -} - - -//----------- -// bcal_config_t (constructor) -//----------- -bcal_config_t::bcal_config_t(JEventLoop *loop) -{ - BCAL_SAMPLINGCOEFA = 0.0; // 0.042 (from calibDB BCAL/bcal_parms) - BCAL_SAMPLINGCOEFB = 0.0; // 0.013 (from calibDB BCAL/bcal_parms) - BCAL_TWO_HIT_RESO = 0.0; // 50. (from calibDB BCAL/bcal_parms) - BCAL_mevPerPE = 0.0; // Energy corresponding to one pixel firing in MeV - FIX - BCAL_C_EFFECTIVE = 0.0; // constant effective velocity, assumed to be property of fibers - - BCAL_LAYER1_SIGMA_SCALE = 0.0; // Approximated from https://logbooks.jlab.org/entry/3339692 (10 degree, 1.4 V OB pedestal data) - BCAL_LAYER2_SIGMA_SCALE = 0.0; // Approximated from https://logbooks.jlab.org/entry/3339692 (10 degree, 1.4 V OB pedestal data) - BCAL_LAYER3_SIGMA_SCALE = 0.0; // Approximated from https://logbooks.jlab.org/entry/3339692 (10 degree, 1.4 V OB pedestal data) - BCAL_LAYER4_SIGMA_SCALE = 0.0; // Approximated from https://logbooks.jlab.org/entry/3339692 (10 degree, 1.4 V OB pedestal data) - // Values from logbook entry are in units of integrated ADC counts. Average SiPM gain ~ 0.029 MeV per integrated ADC count. - - // FIX - Pull from geometry? - BCAL_NUM_MODULES = 48; - BCAL_NUM_LAYERS = 4; - BCAL_NUM_SECTORS = 4; - - BCAL_BASE_TIME_OFFSET = 0; // -100.0 (from calibDB BCAL/base_time_offset) - BCAL_TDC_BASE_TIME_OFFSET = 0; // -100.0 (from calibDB BCAL/base_time_offset) - - BCAL_ADC_THRESHOLD_MEV = 0.0; // MeV (To be updated/improved) - BCAL_FADC_TIME_RESOLUTION = 0.0; // ns (To be updated/improved) - BCAL_TDC_TIME_RESOLUTION = 0.0; // ns (To be updated/improved) - BCAL_MEV_PER_ADC_COUNT = 0.0; // MeV per integrated ADC count (based on Spring 2015 calibrations) - BCAL_NS_PER_ADC_COUNT = 0.0; // 0.0625 ns per ADC count (from calibDB BCAL/digi_scales) - BCAL_NS_PER_TDC_COUNT = 0.0; // 0.0559 ns per TDC count (from calibDB BCAL/digi_scales) - - // BCAL flags - NO_T_SMEAR = false; - NO_DARK_PULSES = false; - NO_SAMPLING_FLUCTUATIONS = false; - NO_SAMPLING_FLOOR_TERM = false; - NO_POISSON_STATISTICS = false; - NO_FADC_SATURATION = false; - - // Load parameters from CCDB - cout << "get BCAL/bcal_smear_parms_v2 parameters from CCDB..." << endl; - map bcalparms; - if(loop->GetCalib("BCAL/bcal_smear_parms_v2", bcalparms)) { - jerr << "Problem loading BCAL/bcal_smear_parms_v2 from CCDB!" << endl; - } else { - BCAL_SAMPLINGCOEFA = bcalparms["BCAL_SAMPLINGCOEFA"]; - BCAL_SAMPLINGCOEFB = bcalparms["BCAL_SAMPLINGCOEFB"]; - BCAL_TWO_HIT_RESO = bcalparms["BCAL_TWO_HIT_RESO"]; - BCAL_mevPerPE = bcalparms["BCAL_mevPerPE"]; - BCAL_C_EFFECTIVE = bcalparms["BCAL_C_EFFECTIVE"]; - BCAL_ATTENUATION_LENGTH = bcalparms["BCAL_ATTENUATION_LENGTH"]; - BCAL_ADC_THRESHOLD_MEV = bcalparms["BCAL_ADC_THRESHOLD_MEV"]; - BCAL_FADC_TIME_RESOLUTION = bcalparms["BCAL_FADC_TIME_RESOLUTION"]; - BCAL_TDC_TIME_RESOLUTION = bcalparms["BCAL_TDC_TIME_RESOLUTION"]; - BCAL_MEV_PER_ADC_COUNT = bcalparms["BCAL_MEV_PER_ADC_COUNT"]; - BCAL_LAYER1_SIGMA_SCALE = bcalparms["BCAL_LAYER1_SIGMA_SCALE"]; - BCAL_LAYER2_SIGMA_SCALE = bcalparms["BCAL_LAYER2_SIGMA_SCALE"]; - BCAL_LAYER3_SIGMA_SCALE = bcalparms["BCAL_LAYER3_SIGMA_SCALE"]; - BCAL_LAYER4_SIGMA_SCALE = bcalparms["BCAL_LAYER4_SIGMA_SCALE"]; - - } - - //cout << "Get BCAL/attenuation_parameters from CCDB..." < > in_atten_parameters; - //if(loop->GetCalib("BCAL/attenuation_parameters", in_atten_parameters)) { - // jerr << "Problem loading BCAL/bcal_parms from CCDB!" << endl; - //} else { - // attenuation_parameters.clear(); - // - // for (unsigned int i = 0; i < in_atten_parameters.size(); i++) { - // attenuation_parameters.push_back( in_atten_parameters.at(i) ); - // } - //} - - cout << "Get BCAL/digi_scales parameters from CCDB..." << endl; - map bcaldigiscales; - if(loop->GetCalib("BCAL/digi_scales", bcaldigiscales)) { - jerr << "Problem loading BCAL/digi_scales from CCDB!" << endl; - } else { - BCAL_NS_PER_ADC_COUNT = bcaldigiscales["BCAL_ADC_TSCALE"]; - BCAL_NS_PER_TDC_COUNT = bcaldigiscales["BCAL_TDC_SCALE"]; - } - - cout << "Get BCAL/base_time_offset parameters from CCDB..." << endl; - map bcaltimeoffsets; - if(loop->GetCalib("BCAL/base_time_offset", bcaltimeoffsets)) { - jerr << "Problem loading BCAL/base_time_offset from CCDB!" << endl; - } else { - BCAL_BASE_TIME_OFFSET = bcaltimeoffsets["BCAL_BASE_TIME_OFFSET"]; - BCAL_TDC_BASE_TIME_OFFSET = bcaltimeoffsets["BCAL_TDC_BASE_TIME_OFFSET"]; - } - - // load per-channel efficiencies - vector raw_table; - if(loop->GetCalib("BCAL/channel_mc_efficiency", raw_table)) { - jerr << "Problem loading BCAL/channel_mc_efficiency from CCDB!" << endl; - } else { - int channel = 0; - - for (int module=1; module<=BCAL_NUM_MODULES; module++) { - for (int layer=1; layer<=BCAL_NUM_LAYERS; layer++) { - for (int sector=1; sector<=BCAL_NUM_SECTORS; sector++) { - channel_efficiencies.push_back( pair(raw_table[channel],raw_table[channel+1]) ); - - channel += 2; - } - } - } - - } - - std::vector > saturation_ADC_pars; - if(loop->GetCalib("/BCAL/ADC_saturation", saturation_ADC_pars)) - jout << "Error loading /BCAL/ADC_saturation !" << endl; - for (unsigned int i=0; i < saturation_ADC_pars.size(); i++) { - int end = (saturation_ADC_pars[i])["end"]; - int layer = (saturation_ADC_pars[i])["layer"] - 1; - fADC_MinIntegral_Saturation[end][layer] = (saturation_ADC_pars[i])["par0"]; - fADC_Saturation_Linear[end][layer] = (saturation_ADC_pars[i])["par1"]; - fADC_Saturation_Quadratic[end][layer] = (saturation_ADC_pars[i])["par2"]; - } -} - diff --git a/src/programs/Simulation/mcsmear/BCALSmearer.h b/src/programs/Simulation/mcsmear/BCALSmearer.h deleted file mode 100644 index 1fa0fe8c5e..0000000000 --- a/src/programs/Simulation/mcsmear/BCALSmearer.h +++ /dev/null @@ -1,322 +0,0 @@ -#ifndef _BCALSMEARER_H_ -#define _BCALSMEARER_H_ - -#include "mcsmear_config.h" -#include "HDDM/hddm_s.hpp" - -#include -#include -#include -#include -#include -#include -#include -using namespace std; - -#include -#include - -#include "units.h" -#include -#include -#include -#include - -#include "Smearer.h" - -class bcal_config_t -{ - public: - bcal_config_t(JEventLoop *loop); - - //void inline GetAttenuationParameters(int id, double &attenuation_length, double &attenuation_L1, double &attenuation_L2) { - // vector &parms = attenuation_parameters.at(id); - // attenuation_length = parms[0]; - // attenuation_L1 = parms[1]; - // attenuation_L2 = parms[2]; - //} - - double inline GetEffectiveVelocity(int id) { - return BCAL_C_EFFECTIVE; - //return effective_velocities.at(id); - } - - // member variables - double BCAL_SAMPLINGCOEFA; - double BCAL_SAMPLINGCOEFB; - double BCAL_TIMEDIFFCOEFA; - double BCAL_TIMEDIFFCOEFB; - double BCAL_TWO_HIT_RESO; - double BCAL_mevPerPE; - double BCAL_C_EFFECTIVE; - double BCAL_ATTENUATION_LENGTH; - - double BCAL_LAYER1_SIGMA_SCALE; - double BCAL_LAYER2_SIGMA_SCALE; - double BCAL_LAYER3_SIGMA_SCALE; - double BCAL_LAYER4_SIGMA_SCALE; - - int BCAL_NUM_MODULES; - int BCAL_NUM_LAYERS; - int BCAL_NUM_SECTORS; - - double BCAL_BASE_TIME_OFFSET; - double BCAL_TDC_BASE_TIME_OFFSET; - - double BCAL_ADC_THRESHOLD_MEV; - double BCAL_FADC_TIME_RESOLUTION; - double BCAL_TDC_TIME_RESOLUTION; - double BCAL_MEV_PER_ADC_COUNT; - double BCAL_NS_PER_ADC_COUNT; - double BCAL_NS_PER_TDC_COUNT; - - // BCAL flags - bool NO_T_SMEAR; - bool NO_DARK_PULSES; - bool NO_SAMPLING_FLUCTUATIONS; - bool NO_SAMPLING_FLOOR_TERM; - bool NO_POISSON_STATISTICS; - bool NO_FADC_SATURATION; - - //vector > attenuation_parameters; // Avg. of 525 (from calibDB BCAL/attenuation_parameters) - // Assume constant effective velocity instead of channel-dependent one - //vector effective_velocities; // 16.75 (from calibDB BCAL/effective_velocities) - - vector< pair > channel_efficiencies; - - double GetEfficiencyCorrectionFactor(int index, DBCALGeometry::End the_end) { - if(the_end == DBCALGeometry::End::kUpstream) - return channel_efficiencies.at(index).first; - else - return channel_efficiencies.at(index).second; - } - - double fADC_MinIntegral_Saturation[2][4]; - double fADC_Saturation_Linear[2][4]; - double fADC_Saturation_Quadratic[2][4]; -}; - - - -// utility classes - -//.......................... -// bcal_index is a utility class that encapsulates the -// module, layer, sector, and end in a single object that -// can be used as a key to index an STL map. -//.......................... -class bcal_index{ - public: - enum EndType{ - kUp, - kDown - }; - - bcal_index(unsigned int module, unsigned int layer, - unsigned int sector, unsigned int incident_id, - EndType end) - : module(module), - layer(layer), - sector(sector), - incident_id(incident_id), - end(end) - {} - - unsigned int module; - unsigned int layer; - unsigned int sector; - unsigned int incident_id; - EndType end; - - bool operator<(const bcal_index &idx) const { - if (module < idx.module) - return true; - if (module > idx.module) - return false; - if (layer < idx.layer) - return true; - if (layer > idx.layer) - return false; - if (sector < idx.sector) - return true; - if (sector > idx.sector) - return false; - if (incident_id < idx.incident_id) - return true; - if (incident_id > idx.incident_id) - return false; - if ((end==kUp) && (idx.end==kDown)) - return true; - return false; - } -}; - -//.......................... -// CellHits is a utility class that holds information -// regarding the energy and time of depostions in a cell -//.......................... -class CellHits{ - public: - enum EndType{ - kUp, - kDown - }; - - CellHits() : E(0.0), t(0.0) - {} - - double E; - double t; - double Etruth; - EndType end; -}; - -//.......................... -// SumHits is a utility class that is used to hold info -// from the SiPMs contributing to that readout channel. -// This includes a list of CellHits objects, but also -// the total number of SiPMs that should be in the sum -// and the total up/downstream energies and times. -//.......................... -class SumHits{ - public: - SumHits() - {} - - vector cellhits; - vector EUP; - vector tUP; - vector EDN; - vector tDN; -}; - -//.......................... -// fADCHit is a utility class that is used to hold info -// for a single fADC hit. -//.......................... -class fADCHit{ - public: - fADCHit(double E, double t) : E(E), t(t) - {} - - double E; - double t; -}; - -//.......................... -// fADCHitList is a utility class that is used to hold info -// for a set of fADCHit objects. -//.......................... -class fADCHitList{ - public: - fADCHitList() - {} - - int module; - int sumlayer; - int sumsector; - - vector uphits; - vector dnhits; -}; - -//.......................... -// TDCHitList is a utility class that is used to hold info -// for a single F1TDC hit -//.......................... -class TDCHitList{ - public: - TDCHitList() - {} - - int module; - int sumlayer; - int sumsector; - - vector uphits; - vector dnhits; -}; - -//.......................... -// IncidentParticle_t is a utility class for holding the -// parameters of particles recorded as incident on the -// BCAL (shower causing) -//.......................... -class IncidentParticle_t{ - public: - IncidentParticle_t(hddm_s::BcalTruthIncidentParticle &ipart) { - x = ipart.getX(); - y = ipart.getY(); - z = ipart.getZ(); - px = ipart.getPx(); - py = ipart.getPy(); - pz = ipart.getPz(); - ptype = ipart.getPtype(); - } - - float x,y,z; - float px, py, pz; - int ptype, track; -}; - -// MAIN CLASS -class BCALSmearer : public Smearer -{ - public: - BCALSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - bcal_config = new bcal_config_t(loop); - - // pass configuration parameters - bcal_config->NO_T_SMEAR = in_config->BCAL_NO_T_SMEAR; - bcal_config->NO_DARK_PULSES = in_config->BCAL_NO_DARK_PULSES; - bcal_config->NO_SAMPLING_FLUCTUATIONS = in_config->BCAL_NO_SAMPLING_FLUCTUATIONS; - bcal_config->NO_SAMPLING_FLOOR_TERM = in_config->BCAL_NO_SAMPLING_FLOOR_TERM; - bcal_config->NO_POISSON_STATISTICS = in_config->BCAL_NO_POISSON_STATISTICS; - bcal_config->NO_FADC_SATURATION = in_config->BCAL_NO_FADC_SATURATION; - - // load BCAL geometry - vector BCALGeomVec; - loop->Get(BCALGeomVec); - if(BCALGeomVec.size() == 0) - throw JException("Could not load DBCALGeometry object!"); - dBCALGeom = BCALGeomVec[0]; - } - ~BCALSmearer() { - delete bcal_config; - } - - void SmearEvent(hddm_s::HDDM *record); // main smearing function - - protected: - bcal_config_t *bcal_config; - const DBCALGeometry *dBCALGeom; - - int inline GetCalibIndex(int module, int layer, int sector); - - void GetSiPMHits(hddm_s::HDDM *record, - map &SiPMHits, - vector &incident_particles); - void ApplySamplingFluctuations(map &SiPMHits, - vector &incident_particles); - void MergeHits(map &SiPMHits, double Resolution); - void ApplyPoissonStatistics(map &SiPMHits); - void SortSiPMHits(map &SiPMHits, - map &bcalfADC, double Resolution); - void SimpleDarkHitsSmear(map &bcalfADC); - void ApplyTimeSmearing(double sigma_ns, double sigma_ns_TDC, map &fADCHits, - map &TDCHits); - void FindHits(double thresh_MeV, - map &bcalfADC, - map &fADCHits, - map &TDCHits); - void CopyBCALHitsToHDDM(map &fADCHits, - map &TDCHits, - hddm_s::HDDM *record); - -}; - - - -#endif // _SMEAR_BCAL_H_ diff --git a/src/programs/Simulation/mcsmear/CCALSmearer.cc b/src/programs/Simulation/mcsmear/CCALSmearer.cc deleted file mode 100644 index f634e711e4..0000000000 --- a/src/programs/Simulation/mcsmear/CCALSmearer.cc +++ /dev/null @@ -1,72 +0,0 @@ -#include "CCALSmearer.h" - -//----------- -// ccal_config_t (constructor) -//----------- -ccal_config_t::ccal_config_t(JEventLoop *loop) { - // default values - // (This is just a rough estimate 11/30/2010 DL) - CCAL_PHOT_STAT_COEF = 0.035/2.0; - CCAL_BLOCK_THRESHOLD = 20.0*k_MeV; - CCAL_SIGMA = 200.0e-3; -} - - - -//----------- -// SmearEvemt -//----------- -void CCALSmearer::SmearEvent(hddm_s::HDDM *record){ - /// Smear the CCAL hits using the same procedure as the FCAL above. - /// See those comments for details. - - // if (!ccalGeom) - // ccalGeom = new DCCALGeometry(); - - hddm_s::CcalBlockList blocks = record->getCcalBlocks(); - hddm_s::CcalBlockList::iterator iter; - for (iter = blocks.begin(); iter != blocks.end(); ++iter) { - iter->deleteCcalHits(); - hddm_s::CcalTruthHitList thits = iter->getCcalTruthHits(); - hddm_s::CcalTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // Simulation simulates a grid of blocks for simplicity. - // Do not bother smearing inactive blocks. They will be - // discarded in DEventSourceHDDM.cc while being read in - // anyway. - - if (!ccalGeom->isBlockActive(iter->getRow(), iter->getColumn())) - continue; - // Smear the energy and timing of the hit - // double sigma = ccal_config->CCAL_PHOT_STAT_COEF/sqrt(titer->getE()) ; - - // A.S. new calibration of the CCAL - double E = titer->getE(); - double t = titer->getT(); - - if(config->SMEAR_HITS) { - double nphav = E * 2.3e3; // per GeV Corrections - - if(nphav < 30) - E *= gDRandom.SamplePoisson(nphav)/nphav; //photostatistics - else - E *= 1.0 + gDRandom.SampleGaussian(1./sqrt(nphav)); //photostatistics - - E *= 1.167 + gDRandom.SampleGaussian(0.006); // calibration - t += gDRandom.SampleGaussian(ccal_config->CCAL_SIGMA); - } - - // Apply a single block threshold. If the (smeared) energy is below this, - // then set the energy and time to zero. - // A.S. - // if (E > ccal_config->CCAL_BLOCK_THRESHOLD) { - hddm_s::CcalHitList hits = iter->addCcalHits(); - hits().setE(E); - hits().setT(t); - // } - } - - if (config->DROP_TRUTH_HITS) - iter->deleteCcalTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/CCALSmearer.h b/src/programs/Simulation/mcsmear/CCALSmearer.h deleted file mode 100644 index ffca18fc2d..0000000000 --- a/src/programs/Simulation/mcsmear/CCALSmearer.h +++ /dev/null @@ -1,48 +0,0 @@ -// Smearing class for compton calorimeter (CCAL) - -#ifndef _CCALSMEARER_H_ -#define _CCALSMEARER_H_ - -#include "Smearer.h" - -#include - - -class ccal_config_t -{ - public: - ccal_config_t(JEventLoop *loop); - - // Time smearing factor - double CCAL_SIGMA; - - // Photon-statistics factor for smearing hit energy for CompCal - double CCAL_PHOT_STAT_COEF; - - // Single block energy threshold (applied after smearing) - double CCAL_BLOCK_THRESHOLD; - -}; - - -class CCALSmearer : public Smearer -{ - public: - CCALSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - ccal_config = new ccal_config_t(loop); - ccalGeom = new DCCALGeometry(); - } - ~CCALSmearer() { - delete ccal_config; - delete ccalGeom; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - ccal_config_t *ccal_config; - DCCALGeometry *ccalGeom; -}; - - -#endif // _CCALSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/CDCSmearer.cc b/src/programs/Simulation/mcsmear/CDCSmearer.cc deleted file mode 100644 index 4bd278c52c..0000000000 --- a/src/programs/Simulation/mcsmear/CDCSmearer.cc +++ /dev/null @@ -1,191 +0,0 @@ -#include "CDCSmearer.h" - -//----------- -// cdc_config_t (constructor) -//----------- -cdc_config_t::cdc_config_t(JEventLoop *loop) -{ - // default values - CDC_TDRIFT_SIGMA = 0.0; - CDC_TIME_WINDOW = 0.0; - CDC_PEDESTAL_SIGMA = 0.0; - CDC_THRESHOLD_FACTOR = 0.0; - CDC_CHARGE_TO_ADC_COUNTS = 1.; - - // temporary? this is a ballpark guess from Naomi (sdobbs, 8/28/2017) - CDC_INTEGRAL_TO_AMPLITUDE = 1. / 29.; - - // load data from CCDB - jout << "get CDC/cdc_parms parameters from CCDB..." << endl; - map cdcparms; - if(loop->GetCalib("CDC/cdc_parms", cdcparms)) { - jerr << "Problem loading CDC/cdc_parms from CCDB!" << endl; - } else { - CDC_TDRIFT_SIGMA = cdcparms["CDC_TDRIFT_SIGMA"]; - CDC_TIME_WINDOW = cdcparms["CDC_TIME_WINDOW"]; - CDC_PEDESTAL_SIGMA = cdcparms["CDC_PEDESTAL_SIGMA"]; - CDC_THRESHOLD_FACTOR = cdcparms["CDC_THRESHOLD_FACTOR"]; - } - - jout << "get CDC/digi_scales parameters from CCDB..." << endl; - map digi_scales; - if(loop->GetCalib("CDC/digi_scales", cdcparms)) { - jerr << "Problem loading CDC/digi_scales from CCDB!" << endl; - } else { - CDC_CHARGE_TO_ADC_COUNTS = 1./cdcparms["CDC_ADC_ASCALE"]; - } - - // LOAD efficiency correction factors - - // first load some geometry information - vector Nstraws; - int32_t runnumber = loop->GetJEvent().GetRunNumber(); - CalcNstraws(loop, runnumber, Nstraws); - //unsigned int Nrings = Nstraws.size(); - - // then load the CCDB table - vector raw_table; - if(loop->GetCalib("CDC/wire_mc_efficiency", raw_table)) { - jerr << "Problem loading CDC/wire_mc_efficiency from CCDB!" << endl; - } else { - // now fill the table - wire_efficiencies.resize( Nstraws.size() ); - - int ring = 0; - int straw = 0; - - for (unsigned int channel=0; channelGetCalib("CDC/hit_thresholds", raw_table)) { - jerr << "Problem loading CDC/hit_thresholds from CCDB!" << endl; - } else { - // now fill the table - wire_thresholds.resize( Nstraws.size() ); - - int ring = 0; - int straw = 0; - - for (unsigned int channel=0; channel &Nstraws) -{ - DGeometry *dgeom; - vector >cdcwires; - - // Get pointer to DGeometry object - DApplication* dapp=dynamic_cast(eventLoop->GetJApplication()); - dgeom = dapp->GetDGeometry(runnumber); - - // Get the CDC wire table from the XML - dgeom->GetCDCWires(cdcwires); - - // Fill array with the number of straws for each layer - // Also keep track of the total number of straws, i.e., the total number of detector channels - //maxChannels = 0; - Nstraws.clear(); - for (unsigned int i=0; iTRIGGER_LOOKBACK_TIME + cdc_config->CDC_TIME_WINDOW; - // move to wire-dependent sparsification thresholds compared to an overall factor - //double threshold = cdc_config->CDC_THRESHOLD_FACTOR * cdc_config->CDC_PEDESTAL_SIGMA; // for sparsification - - // Loop over all cdcStraw tags - hddm_s::CdcStrawList straws = record->getCdcStraws(); - hddm_s::CdcStrawList::iterator iter; - for (iter = straws.begin(); iter != straws.end(); ++iter) { - - // If the element already contains a cdcStrawHit list then delete it. - hddm_s::CdcStrawHitList hits = iter->getCdcStrawHits(); - if (hits.size() > 0) { - static bool warned = false; - iter->deleteCdcStrawHits(); - if (!warned) { - warned = true; - cerr << endl; - cerr << "WARNING: CDC hits already exist in input file! Overwriting!" - << endl << endl; - } - } - - // Create new cdcStrawHit from cdcStrawTruthHit information - hddm_s::CdcStrawTruthHitList thits = iter->getCdcStrawTruthHits(); - hddm_s::CdcStrawTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++ titer) { - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(cdc_config->GetEfficiencyCorrectionFactor(iter->getRing(), iter->getStraw()))) - continue; - - double t = titer->getT(); - double q = titer->getQ(); - - if(config->SMEAR_HITS) { - // Smear out the CDC drift time using the specified sigma. - // This is for timing resolution from the electronics; - // diffusion is handled in hdgeant. - t += gDRandom.SampleGaussian(cdc_config->CDC_TDRIFT_SIGMA)*1.0e9; - // Pedestal-smeared charge - q += gDRandom.SampleGaussian(cdc_config->CDC_PEDESTAL_SIGMA); - } - double amplitude = q * cdc_config->CDC_CHARGE_TO_ADC_COUNTS * cdc_config->CDC_INTEGRAL_TO_AMPLITUDE; - - // per-wire threshold in ADC units - double threshold = cdc_config->GetWireThreshold(iter->getRing(), iter->getStraw()); - if (t > config->TRIGGER_LOOKBACK_TIME && t < t_max && amplitude > threshold) { - hits = iter->addCdcStrawHits(); - hits().setT(t); - hits().setQ(q); - } - - if (config->DROP_TRUTH_HITS) { - iter->deleteCdcStrawTruthHits(); - } - } - } -} diff --git a/src/programs/Simulation/mcsmear/CDCSmearer.h b/src/programs/Simulation/mcsmear/CDCSmearer.h deleted file mode 100644 index bd8c56e083..0000000000 --- a/src/programs/Simulation/mcsmear/CDCSmearer.h +++ /dev/null @@ -1,52 +0,0 @@ -// Smearing class for central drift chamber (CDC) - -#ifndef _CDCSMEARER_H_ -#define _CDCSMEARER_H_ - -#include "Smearer.h" - - -class cdc_config_t -{ - public: - cdc_config_t(JEventLoop *loop); - - double CDC_TDRIFT_SIGMA; - double CDC_TIME_WINDOW; - double CDC_PEDESTAL_SIGMA; // deprecated - double CDC_THRESHOLD_FACTOR; // number of pedestal sigmas for determining sparsification threshold - deprecated - double CDC_INTEGRAL_TO_AMPLITUDE; - double CDC_CHARGE_TO_ADC_COUNTS; - - vector< vector > wire_efficiencies; - vector< vector > wire_thresholds; - - void CalcNstraws(JEventLoop *loop, int32_t runnumber, vector &Nstraws); - double GetEfficiencyCorrectionFactor(int ring, int straw) { - return wire_efficiencies.at(ring-1).at(straw-1); - } - double GetWireThreshold(int ring, int straw) { - return wire_thresholds.at(ring-1).at(straw-1); - } -}; - - -class CDCSmearer : public Smearer -{ - public: - CDCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - cdc_config = new cdc_config_t(loop); - } - ~CDCSmearer() { - delete cdc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - cdc_config_t *cdc_config; -}; - - - -#endif // _CDCSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/DRandom2.h b/src/programs/Simulation/mcsmear/DRandom2.h deleted file mode 100644 index 9972b69a2f..0000000000 --- a/src/programs/Simulation/mcsmear/DRandom2.h +++ /dev/null @@ -1,150 +0,0 @@ -// $Id$ -// - -// Random number generator used in mcsmear. All random numbers -// should come from the global "gDRandom" object declared here. -// -// Because we want to record the seeds used for every event, -// we use the TRandom2 class. This one has only 3 seed values -// (as opposed to 24 for TRandom1 and 624 for TRandom3) but -// is fast with a large period (10^26). -// -// Because the seeds in TRandom2 are declared protected in -// the class with no methods to access/set them, we derive -// a new class, DRandom2 from TRandom2. This allows us access -// to the numbers for easy recording/retrieving. - -#ifndef _DRANDOM2_H_ -#define _DRANDOM2_H_ - -#include -#include -using std::cerr; -using std::endl; - -class DRandom2:public TRandom2{ - public: - - DRandom2(UInt_t seed=1):TRandom2(seed){} - - void GetSeeds(UInt_t &seed, UInt_t &seed1, UInt_t &seed2){ - seed = this->fSeed; - seed1 = this->fSeed1; - seed2 = this->fSeed2; - } - - void SetSeeds(UInt_t &seed, UInt_t &seed1, UInt_t &seed2){ - - // See the comments in TRandom2::SetSeed(int) - if( (seed<2) | (seed1<8) | (seed2<16) ){ - cerr << endl; - cerr << "*********************************************************" << endl; - cerr << "WARNING: Random seeds passed to DRandom2::SetSeeds have" << endl; - cerr << "forbidden values: " << endl; - cerr << " seed = " << seed << " (must be at least 2)" <fSeed = seed; - this->fSeed1 = seed1; - this->fSeed2 = seed2; - } - - // legacy mcsmear interface - inline double SampleGaussian(double sigma) { - return Gaus(0.0, sigma); - } - - inline double SamplePoisson(double lambda) { - return Poisson(lambda); - } - - inline double SampleRange(double x1, double x2) { - double s, f; - double xlo, xhi; - - if(x1 1.0 ) - return true; - - // If the efficiency is equal to one, then always accept it - if(AlmostEqual(prob, 1.0)) - return true; - - // Otherwise, our efficiency should be some number in (0,1) - // Throw a random number in that range, and reject if the random - // number is larger than our efficiency - if(Uniform() > prob) - return false; - return true; - } - - private: - bool AlmostEqual(double a, double b) { - // Comparing floating point numbers is tough! - // This should work for numbers not near zero. - // Reference: https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ - const double maxRelDiff = 1.e-8; - - double diff = fabs(a-b); - a = fabs(a); - b = fabs(b); - double largest = (b > a) ? b : a; - - if(diff <= largest*maxRelDiff) - return true; - return false; - } - -}; - -#endif // _DRANDOM2_H_ - -extern DRandom2 gDRandom; - - diff --git a/src/programs/Simulation/mcsmear/FCALSmearer.cc b/src/programs/Simulation/mcsmear/FCALSmearer.cc deleted file mode 100644 index 9255cab2cb..0000000000 --- a/src/programs/Simulation/mcsmear/FCALSmearer.cc +++ /dev/null @@ -1,161 +0,0 @@ -#include "FCALSmearer.h" - -//----------- -// fcal_config_t (constructor) -//----------- -fcal_config_t::fcal_config_t(JEventLoop *loop, DFCALGeometry *fcalGeom) -{ - // default values - FCAL_PHOT_STAT_COEF = 0.0; //0.035; - FCAL_BLOCK_THRESHOLD = 0.0; //20.0*k_MeV; - // FCAL_TSIGMA = 0.0; // 200 ps - FCAL_TSIGMA = 0.; // 400 ps - - // Get values from CCDB - cout << "Get FCAL/fcal_parms parameters from CCDB..." << endl; - map fcalparms; - if(loop->GetCalib("FCAL/fcal_parms", fcalparms)) { - jerr << "Problem loading FCAL/fcal_parms from CCDB!" << endl; - } else { - FCAL_PHOT_STAT_COEF = fcalparms["FCAL_PHOT_STAT_COEF"]; - FCAL_BLOCK_THRESHOLD = fcalparms["FCAL_BLOCK_THRESHOLD"]; - } - - cout<<"get FCAL/gains from calibDB"< FCAL_GAINS_TEMP; - if(loop->GetCalib("FCAL/gains", FCAL_GAINS_TEMP)) { - jerr << "Problem loading FCAL/gains from CCDB!" << endl; - } else { - for (unsigned int i = 0; i < FCAL_GAINS_TEMP.size(); i++) { - FCAL_GAINS.push_back(FCAL_GAINS_TEMP.at(i)); - } - } - - cout<<"get FCAL/digi_scales parameters from calibDB"< fcaldigiscales; - if(loop->GetCalib("FCAL/digi_scales", fcaldigiscales)) { - jerr << "Problem loading FCAL/digi_scales from CCDB!" << endl; - } else { - FCAL_MC_ESCALE = fcaldigiscales["FCAL_ADC_ASCALE"]; - } - - cout<<"get FCAL/mc_timing_smear parameters from calibDB"< fcalmctimingsmear; - if(loop->GetCalib("FCAL/mc_timing_smear", fcalmctimingsmear)) { - jerr << "Problem loading FCAL/mc_timing_smear from CCDB!" << endl; - } else { - FCAL_TSIGMA = fcalmctimingsmear["FCAL_TSIGMA"]; - } - - // initialize 2D matrix of efficiencies, indexed by (row,column) - vector< vector > new_block_efficiencies(DFCALGeometry::kBlocksTall, - vector(DFCALGeometry::kBlocksWide)); - block_efficiencies = new_block_efficiencies; - - // load efficiencies from CCDB and fill - vector raw_table; - if(loop->GetCalib("FCAL/block_mc_efficiency", raw_table)) { - jerr << "Problem loading FCAL/block_mc_efficiency from CCDB!" << endl; - } else { - for (int channel=0; channel < static_cast(raw_table.size()); channel++) { - - // make sure that we don't try to load info for channels that don't exist - if (channel == fcalGeom->numActiveBlocks()) - break; - - int row = fcalGeom->row(channel); - int col = fcalGeom->column(channel); - - // results from DFCALGeometry should be self consistent, but add in some - // sanity checking just to be sure - if (fcalGeom->isBlockActive(row,col) == false) { - char str[200]; - sprintf(str, "Loading FCAL constant for inactive channel! " - "row=%d, col=%d", row, col); - throw JException(str); - } - - block_efficiencies[row][col] = raw_table[channel]; - } - } - -} - -//----------- -// SmearEvent -//----------- -void FCALSmearer::SmearEvent(hddm_s::HDDM *record) -{ - /// Smear the FCAL hits using the nominal resolution of the individual blocks. - /// The way this works is a little funny and warrants a little explanation. - /// The information coming from hdgeant is truth information indexed by - /// row and column, but containing energy deposited and time. The mcsmear - /// program will copy the truth information from the fcalTruthHit element - /// to a new fcalHit element, smearing the values with the appropriate detector - /// resolution. - /// - /// To access the "truth" values in DANA, get the DFCALHit objects using the - /// "TRUTH" tag. - - //if (!fcalGeom) - // fcalGeom = new DFCALGeometry(); - - hddm_s::FcalBlockList blocks = record->getFcalBlocks(); - hddm_s::FcalBlockList::iterator iter; - for (iter = blocks.begin(); iter != blocks.end(); ++iter) { - iter->deleteFcalHits(); - hddm_s::FcalTruthHitList thits = iter->getFcalTruthHits(); - hddm_s::FcalTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // Simulation simulates a grid of blocks for simplicity. - // Do not bother smearing inactive blocks. They will be - // discarded in DEventSourceHDDM.cc while being read in - // anyway. - if (!fcalGeom->isBlockActive(iter->getRow(), iter->getColumn())) - continue; - - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(fcal_config->GetEfficiencyCorrectionFactor(iter->getRow(), iter->getColumn()))) { - continue; - } - - // Get gain constant per block - int channelnum = fcalGeom->channel(iter->getRow(), iter->getColumn()); - double FCAL_gain = fcal_config->FCAL_GAINS.at(channelnum); - - double E = titer->getE(); - if(fcal_config->FCAL_ADD_LIGHTGUIDE_HITS) { - hddm_s::FcalTruthLightGuideList lghits = titer->getFcalTruthLightGuides(); - hddm_s::FcalTruthLightGuideList::iterator lgiter; - for (lgiter = lghits.begin(); lgiter != lghits.end(); lgiter++) { - E += lgiter->getE(); - } - } - // Apply constant scale factor to MC energy. 06/22/2016 A. Subedi - E *= fcal_config->FCAL_MC_ESCALE; - - double t = titer->getT(); - - if(config->SMEAR_HITS) { - // Smear the energy and timing of the hit - double sigma = fcal_config->FCAL_PHOT_STAT_COEF/sqrt(titer->getE()); - - t += gDRandom.SampleGaussian(fcal_config->FCAL_TSIGMA); - E *= (1.0 + gDRandom.SampleGaussian(sigma)); - } - - // Apply a single block threshold. - // Scale threshold by gains - if (E >= fcal_config->FCAL_BLOCK_THRESHOLD * FCAL_gain ){ - hddm_s::FcalHitList hits = iter->addFcalHits(); - hits().setE(E); - hits().setT(t); - } - - } - - if (config->DROP_TRUTH_HITS) - iter->deleteFcalTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/FCALSmearer.h b/src/programs/Simulation/mcsmear/FCALSmearer.h deleted file mode 100644 index 7de7c2bc1d..0000000000 --- a/src/programs/Simulation/mcsmear/FCALSmearer.h +++ /dev/null @@ -1,55 +0,0 @@ -// Smearing class for forward calorimeter (FCAL) - -#ifndef _FCALSMEARER_H_ -#define _FCALSMEARER_H_ - -#include "Smearer.h" - -#include - - -class fcal_config_t -{ - public: - fcal_config_t(JEventLoop *loop, DFCALGeometry *fcalGeom); - - double FCAL_PHOT_STAT_COEF; - double FCAL_BLOCK_THRESHOLD; - double FCAL_TSIGMA; - - vector FCAL_GAINS; - double FCAL_MC_ESCALE; - - bool FCAL_ADD_LIGHTGUIDE_HITS; - - vector< vector > block_efficiencies; - - double GetEfficiencyCorrectionFactor(double row, double column) { - return block_efficiencies.at(row).at(column); - } -}; - - - -class FCALSmearer : public Smearer -{ - public: - FCALSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - fcalGeom = new DFCALGeometry(); - fcal_config = new fcal_config_t(loop, fcalGeom); - fcal_config->FCAL_ADD_LIGHTGUIDE_HITS = in_config->FCAL_ADD_LIGHTGUIDE_HITS; - } - ~FCALSmearer() { - delete fcal_config; - delete fcalGeom; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - fcal_config_t *fcal_config; - DFCALGeometry *fcalGeom; -}; - - -#endif // _FCALSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/FDCSmearer.cc b/src/programs/Simulation/mcsmear/FDCSmearer.cc deleted file mode 100644 index e902586934..0000000000 --- a/src/programs/Simulation/mcsmear/FDCSmearer.cc +++ /dev/null @@ -1,143 +0,0 @@ -#include "FDCSmearer.h" - -#include -#include -using namespace jana; - -#include - -//----------- -// fdc_config_t (constructor) -//----------- -fdc_config_t::fdc_config_t(JEventLoop *loop) -{ - // default values - FDC_TDRIFT_SIGMA = 0.0; - FDC_CATHODE_SIGMA = 0.0; - FDC_PED_NOISE = 0.0; - FDC_THRESHOLD_FACTOR = 0.0; - FDC_TIME_WINDOW = 0.0; - FDC_THRESH_KEV = 0.0; - - // load data from CCDB - cout << "Get FDC/fdc_parms parameters from CCDB..." << endl; - map fdcparms; - if(loop->GetCalib("FDC/fdc_parms", fdcparms)) { - jerr << "Problem loading FDC/fdc_parms from CCDB!" << endl; - } else { - FDC_TDRIFT_SIGMA = fdcparms["FDC_TDRIFT_SIGMA"]; - FDC_CATHODE_SIGMA = fdcparms["FDC_CATHODE_SIGMA"]; - FDC_THRESHOLD_FACTOR = fdcparms["FDC_THRESHOLD_FACTOR"]; - //FDC_PED_NOISE = fdcparms["FDC_PED_NOISE"]; // ??? - FDC_TIME_WINDOW = fdcparms["FDC_TIME_WINDOW"]; - //FDC_HIT_DROP_FRACTION = fdcparms["FDC_HIT_DROP_FRACTION"]; // ??? - FDC_THRESH_KEV = fdcparms["FDC_THRESH_KEV"]; - } - - // Calculate ped noise level based on position resolution - // FDC_PED_NOISE = -0.004594 + 0.008711*FDC_CATHODE_SIGMA + - // 0.000010*FDC_CATHODE_SIGMA*FDC_CATHODE_SIGMA; //pC - FDC_PED_NOISE = -0.0938 + 0.0485*FDC_CATHODE_SIGMA; - - - // load efficiency correction factors - for(int package=1; package<=4; package++) { - vector< vector > new_strip_efficiencies; - vector< vector > new_wire_efficiencies; - - char ccdb_str[100]; - sprintf(ccdb_str, "/FDC/package%d/strip_mc_efficiency", package); - if(loop->GetCalib(ccdb_str, new_strip_efficiencies)) { - stringstream err_ss; - err_ss << "Error loading " << ccdb_str << " !"; - throw JException(err_ss.str()); - } - sprintf(ccdb_str,"/FDC/package%d/wire_mc_efficiency", package); - if(loop->GetCalib(ccdb_str, new_wire_efficiencies)) { - stringstream err_ss; - err_ss << "Error loading " << ccdb_str << " !"; - throw JException(err_ss.str()); - } - - for(int chamber=0; chamber<6; chamber++) { - channel_efficiencies.push_back( new_strip_efficiencies[2*chamber+1] ); - channel_efficiencies.push_back( new_wire_efficiencies[chamber] ); - channel_efficiencies.push_back( new_strip_efficiencies[2*chamber] ); - } - } - -} - - -//----------- -// SmearEvent -//----------- -void FDCSmearer::SmearEvent(hddm_s::HDDM *record) -{ - double t_max = config->TRIGGER_LOOKBACK_TIME + fdc_config->FDC_TIME_WINDOW; - double threshold = fdc_config->FDC_THRESHOLD_FACTOR * fdc_config->FDC_PED_NOISE; // for sparsification - - hddm_s::FdcChamberList chambers = record->getFdcChambers(); - hddm_s::FdcChamberList::iterator iter; - for (iter = chambers.begin(); iter != chambers.end(); ++iter) { - - // Add pedestal noise to strip charge data - hddm_s::FdcCathodeStripList strips = iter->getFdcCathodeStrips(); - hddm_s::FdcCathodeStripList::iterator siter; - for (siter = strips.begin(); siter != strips.end(); ++siter) { - // If a fdcCathodeHit already exists delete it - siter->deleteFdcCathodeHits(); - hddm_s::FdcCathodeTruthHitList thits = - siter->getFdcCathodeTruthHits(); - hddm_s::FdcCathodeTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(fdc_config->GetEfficiencyCorrectionFactor(siter))) - continue; - - double q = titer->getQ(); - double t = titer->getT(); - if(config->SMEAR_HITS) { - q += gDRandom.SampleGaussian(fdc_config->FDC_PED_NOISE); - t += gDRandom.SampleGaussian(fdc_config->FDC_TDRIFT_SIGMA)*1.0e9; - } - if (q > threshold && t > config->TRIGGER_LOOKBACK_TIME && t < t_max) { - hddm_s::FdcCathodeHitList hits = siter->addFdcCathodeHits(); - hits().setQ(q); - hits().setT(t); - } - } - - if (config->DROP_TRUTH_HITS) - siter->deleteFdcCathodeTruthHits(); - } - - // Add drift time varation to the anode data - hddm_s::FdcAnodeWireList wires = iter->getFdcAnodeWires(); - hddm_s::FdcAnodeWireList::iterator witer; - for (witer = wires.begin(); witer != wires.end(); ++witer) { - // If a fdcAnodeHit exists already delete it - witer->deleteFdcAnodeHits(); - hddm_s::FdcAnodeTruthHitList thits = witer->getFdcAnodeTruthHits(); - hddm_s::FdcAnodeTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(fdc_config->GetEfficiencyCorrectionFactor(witer))) - continue; - - double t = titer->getT() + gDRandom.SampleGaussian(fdc_config->FDC_TDRIFT_SIGMA)*1.0e9; - if (t > config->TRIGGER_LOOKBACK_TIME && t < t_max) { - hddm_s::FdcAnodeHitList hits = witer->addFdcAnodeHits(); - hits().setT(t); - hits().setDE(titer->getDE()); - } - } - - if (config->DROP_TRUTH_HITS) - witer->deleteFdcAnodeTruthHits(); - } - } -} - diff --git a/src/programs/Simulation/mcsmear/FDCSmearer.h b/src/programs/Simulation/mcsmear/FDCSmearer.h deleted file mode 100644 index 4595e8ff84..0000000000 --- a/src/programs/Simulation/mcsmear/FDCSmearer.h +++ /dev/null @@ -1,72 +0,0 @@ -// Smearing class for forward drift chamber (FDC) - -#ifndef _FDCSMEARER_H_ -#define _FDCSMEARER_H_ - -#include "Smearer.h" - - -class fdc_config_t -{ - public: - fdc_config_t(JEventLoop *loop); - - double FDC_TDRIFT_SIGMA; - double FDC_CATHODE_SIGMA; - double FDC_PED_NOISE; // in pC calculated in above - double FDC_THRESHOLD_FACTOR; // number of pedestal sigmas for determining sparcification threshold - //double FDC_HIT_DROP_FRACTION = 0.0; // 1000.0E-9 - double FDC_TIME_WINDOW; - double FDC_THRESH_KEV; // fdc anode discriminator threshold - - vector< vector > channel_efficiencies; - - double GetEfficiencyCorrectionFactor(hddm_s::FdcCathodeStripList::iterator &siter) { - // cathode strips - int gPlane = 9*(siter->getModule()-1) + 3*(siter->getLayer()-1) - + (siter->getPlane()-1); // starts counting at 0 - int element = siter->getStrip(); - - //cout << "module = " << siter->getModule() << " layer = " << siter->getLayer() - // << " plane = " << siter->getPlane() << " gPlane = " << gPlane - // << " strip = " << siter->getStrip() << endl; - - return channel_efficiencies.at(gPlane).at(element-1); - } - - double GetEfficiencyCorrectionFactor(hddm_s::FdcAnodeWireList::iterator &witer) { - // anode wires - int gPlane = 9*(witer->getModule()-1) + 3*(witer->getLayer()-1) + 1; // starts counting at 0 - int element = witer->getWire(); - - //cout << "module = " << witer->getModule() << " layer = " << witer->getLayer() - // //<< " plane = " << witer->getPlane() - // << " gPlane = " << gPlane - // << " wire = " << witer->getWire() << endl; - - return channel_efficiencies.at(gPlane).at(element-1); - } - -}; - - - -class FDCSmearer : public Smearer -{ - public: - FDCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - fdc_config = new fdc_config_t(loop); - } - ~FDCSmearer() { - delete fdc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - fdc_config_t *fdc_config; -}; - - - -#endif // _FDCSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/FDIRCSmearer.cc b/src/programs/Simulation/mcsmear/FDIRCSmearer.cc deleted file mode 100644 index fd1e9e9362..0000000000 --- a/src/programs/Simulation/mcsmear/FDIRCSmearer.cc +++ /dev/null @@ -1,9 +0,0 @@ -#include "FDIRCSmearer.h" - - -//----------- -// SmearEvent -//----------- -void FDIRCSmearer::SmearEvent(hddm_s::HDDM *record) -{ -} \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/FDIRCSmearer.h b/src/programs/Simulation/mcsmear/FDIRCSmearer.h deleted file mode 100644 index ff0ded490d..0000000000 --- a/src/programs/Simulation/mcsmear/FDIRCSmearer.h +++ /dev/null @@ -1,29 +0,0 @@ -// Smearing class for forward DIRC (FDIRC) -// needs to be filled in - -#ifndef _FDIRCSMEARER_H_ -#define _FDIRCSMEARER_H_ - -#include "Smearer.h" - -//class fdirc_config_t; // forward definition for readability - - -class FDIRCSmearer : public Smearer -{ - public: - FDIRCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - //fdirc_config = new fdirc_config_t(loop); - } - ~FDIRCSmearer() { - //delete fdirc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - //fdirc_config_t *fdirc_config; -}; - - -#endif // _FDIRCSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/FMWPCSmearer.cc b/src/programs/Simulation/mcsmear/FMWPCSmearer.cc deleted file mode 100644 index 7c8ef7aa6c..0000000000 --- a/src/programs/Simulation/mcsmear/FMWPCSmearer.cc +++ /dev/null @@ -1,45 +0,0 @@ -#include "FMWPCSmearer.h" - -//----------- -// fmwpc_config_t (constructor) -//----------- -fmwpc_config_t::fmwpc_config_t(JEventLoop *loop) -{ - // default values - FMWPC_TSIGMA = 10.0; // ns - FMWPC_ASIGMA = 0.5E-6; - FMWPC_THRESHOLD = 0.0; -} - - - -//----------- -// SmearEvent -//----------- -void FMWPCSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::FmwpcChamberList chambers = record->getFmwpcChambers(); - hddm_s::FmwpcChamberList::iterator iter; - for (iter = chambers.begin(); iter != chambers.end(); ++iter) { - iter->deleteFmwpcHits(); - hddm_s::FmwpcTruthHitList thits = iter->getFmwpcTruthHits(); - hddm_s::FmwpcTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time and energy - double t = titer->getT(); - double dE = titer->getDE(); - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(fmwpc_config->FMWPC_TSIGMA); - dE += gDRandom.SampleGaussian(fmwpc_config->FMWPC_ASIGMA); - } - if (dE > fmwpc_config->FMWPC_THRESHOLD) { - hddm_s::FmwpcHitList hits = iter->addFmwpcHits(); - hits().setT(t); - hits().setDE(dE); - } - } - - if (config->DROP_TRUTH_HITS) - iter->deleteFmwpcTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/FMWPCSmearer.h b/src/programs/Simulation/mcsmear/FMWPCSmearer.h deleted file mode 100644 index c423e3d424..0000000000 --- a/src/programs/Simulation/mcsmear/FMWPCSmearer.h +++ /dev/null @@ -1,40 +0,0 @@ -// Smearing class for forward multiple-wire proportional chamber (FMWPC) - -#ifndef _FMWPCSMEARER_H_ -#define _FMWPCSMEARER_H_ - -#include "Smearer.h" - -class fmwpc_config_t -{ - public: - fmwpc_config_t(JEventLoop *loop); - - // FMWPC resolutions and threshold - double FMWPC_TSIGMA; - double FMWPC_ASIGMA; - double FMWPC_THRESHOLD; - -}; - - -class FMWPCSmearer : public Smearer -{ - public: - FMWPCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - fmwpc_config = new fmwpc_config_t(loop); - } - ~FMWPCSmearer() { - delete fmwpc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - fmwpc_config_t *fmwpc_config; -}; - - - - -#endif // _FMWPCSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/JFactoryGenerator_ThreadCancelHandler.h b/src/programs/Simulation/mcsmear/JFactoryGenerator_ThreadCancelHandler.h deleted file mode 100644 index b61fe1fc03..0000000000 --- a/src/programs/Simulation/mcsmear/JFactoryGenerator_ThreadCancelHandler.h +++ /dev/null @@ -1,41 +0,0 @@ -// $Id$ -// -// File: JFactoryGenerator_ThreadCancelHandler.h -// Created: Wed Dec 19 15:52:58 EST 2012 -// Creator: davidl (on Linux ifarm1101 2.6.18-274.3.1.el5 x86_64) -// - - -// The entire purpose of this class is to replace the -// signal handler for HUP signals installed by JANA -// with out own. It does NOT actually generate any -// factories! See the comments at the top of MyProcessor.cc -// for details. - -#ifndef _JFactoryGenerator_ThreadCancelHandler_ -#define _JFactoryGenerator_ThreadCancelHandler_ - -#include -#include - -extern void mcsmear_thread_HUP_sighandler(int sig); - -class JFactoryGenerator_ThreadCancelHandler: public jana::JFactoryGenerator{ - public: - JFactoryGenerator_ThreadCancelHandler(){} - virtual ~JFactoryGenerator_ThreadCancelHandler(){} - virtual const char* className(void){return static_className();} - static const char* static_className(void){return "JFactoryGenerator_ThreadCancelHandler";} - - jerror_t GenerateFactories(jana::JEventLoop *loop){ - - jout<<"Installing special signal handler for mcsmear..."< -#include -#include -#include - -using namespace std; - -#include - -#include "MyProcessor.h" -#include "hddm_s_merger.h" - -#include - -#include -#include -#include - -extern char *OUTFILENAME; -extern std::map files2merge; -extern std::map start2merge; -extern std::map skip2merge; - -static pthread_mutex_t output_file_mutex; -static pthread_t output_file_mutex_last_owner; -static pthread_mutex_t input_file_mutex; -static pthread_t input_file_mutex_last_owner; - -#include -//static JCalibration *jcalib=NULL; -static bool locCheckCCDBContext = true; - -//----------- -// PrintCCDBWarning -//----------- -static void PrintCCDBWarning(string context) -{ - jout << endl; - jout << "===============================================================================" << endl; - jout << " !!!!! WARNING !!!!!" << endl; - jout << "You have either not specified a CCDB variation, or specified a variation" << endl; - jout << "that appears inconsistent with processing simulated data." << endl; - jout << "Be sure that this is what you want to do!" << endl; - jout << endl; - jout << " JANA_CALIB_CONTEXT = " << context << endl; - jout << endl; - jout << "For a more detailed list of CCDB variations used for simulations" << endl; - jout << "see the following wiki page:" << endl; - jout << endl; - jout << " https://halldweb.jlab.org/wiki/index.php/Simulations#Simulation_Conditions" << endl; - jout << "===============================================================================" << endl; - jout << endl; -} - - - -void mcsmear_thread_HUP_sighandler(int sig) -{ - jerr<<" Caught HUP signal for thread 0x"<is_open()){ - cout<<" Error opening output file \""<SetDefaultParameter("HDDM:USE_COMPRESSION", HDDM_USE_COMPRESSION, - "Turn on/off compression of the output HDDM stream." - " \"0\"=no compression, \"1\"=bz2 compression, \"2\"=z compression (default)"); - HDDM_USE_INTEGRITY_CHECKS = true; - gPARMS->SetDefaultParameter("HDDM:USE_INTEGRITY_CHECKS", - HDDM_USE_INTEGRITY_CHECKS, - "Turn on/off automatic integrity checking on the" - " output HDDM stream." - " Set to \"0\" to turn off (it's on by default)"); - - // enable on-the-fly bzip2 compression on output stream - if (HDDM_USE_COMPRESSION == 0) { - jout << " HDDM compression disabled" << std::endl; - } else if (HDDM_USE_COMPRESSION == 1) { - jout << " Enabling bz2 compression of output HDDM file stream" - << std::endl; - fout->setCompression(hddm_s::k_bz2_compression); - } else { - jout << " Enabling z compression of output HDDM file stream (default)" - << std::endl; - fout->setCompression(hddm_s::k_z_compression); - } - - // enable a CRC data integrity check at the end of each event record - if (HDDM_USE_INTEGRITY_CHECKS) { - jout << " Enabling CRC data integrity check in output HDDM file stream" - << std::endl; - fout->setIntegrityChecks(hddm_s::k_crc32_integrity); - } - else { - jout << " HDDM integrity checks disabled" << std::endl; - } - - // We set the mutex type to "ERRORCHECK" so that if the - // signal handler is called, we can unlock the mutex - // safely whether we have it locked or not. - pthread_mutexattr_t attr; - pthread_mutexattr_init(&attr); - pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); - pthread_mutex_init(&output_file_mutex, NULL); - pthread_mutex_init(&input_file_mutex, NULL); - - // pthreads does not provide an "invalid" value for - // a pthread_t that we can initialize with. Furthermore, - // the pthread_t may be a simple as an integer or as - // a complicated structure. Hence, to make this portable - // we clear it with bzero. - bzero(&output_file_mutex_last_owner, sizeof(pthread_t)); - bzero(&input_file_mutex_last_owner, sizeof(pthread_t)); - - return NOERROR; -} - -jerror_t MyProcessor::brun(JEventLoop *loop, int locRunNumber) -{ - // Generally, simulations should be generated and analyzed with a non-default - // set of calibrations, since the calibrations needed for simulations are - // different than those needed for data. - // Conventionally, the CCDB variations needed for simulations start with the - // string "mc". To guard against accidentally not setting the variation correctly - // we check to see if the variation is set and if it contains the string "mc". - // Note that for now, we only print a warning and do not exit immediately. - // It might be advisable to apply some tougher love. - - if(locCheckCCDBContext) { - // only do this once - locCheckCCDBContext = false; - - // load the CCDB context - DApplication* locDApp = dynamic_cast(japp); - //DGeometry *dgeom=locDApp->GetDGeometry(locRunNumber); - JCalibration* jcalib = locDApp->GetJCalibration(locRunNumber); - - string context = jcalib->GetContext(); - - jout << "checking context = " << context << endl; - - // Really we should parse the context string, but since "mc" shouldn't show up - // outside of the context, we just search the whole string. - // Also make sure that the variation is being set - if( (context.find("variation") == string::npos) || (context.find("mc") == string::npos) ) { - PrintCCDBWarning(context); - } - - std::map parms; - jcalib->Get("TOF/tof_parms", parms); - hddm_s_merger::set_ftof_min_delta_t_ns(parms.at("TOF_TWO_HIT_RESOL")); - jcalib->Get("FDC/fdc_parms", parms); - hddm_s_merger::set_fdc_wires_min_delta_t_ns(parms.at("FDC_TWO_HIT_RESOL")); - jcalib->Get("START_COUNTER/start_parms", parms); - hddm_s_merger::set_stc_min_delta_t_ns(parms.at("START_TWO_HIT_RESOL")); - jcalib->Get("BCAL/bcal_parms", parms); - hddm_s_merger::set_bcal_min_delta_t_ns(parms.at("BCAL_TWO_HIT_RESOL")); - jcalib->Get("FCAL/fcal_parms", parms); - hddm_s_merger::set_fcal_min_delta_t_ns(parms.at("FCAL_TWO_HIT_RESOL")); - } - - - // load configuration parameters for all the detectors - if(smearer != NULL) - delete smearer; - smearer = new Smear(config, loop); - -#ifdef HAVE_RCDB - // Pull configuration parameters from RCDB - config->ParseRCDBConfigFile(locRunNumber); - - const double fadc250_period_ns(4.); - const double fadc125_period_ns(8.); - - // hits merging / truncation parameters for the CDC - hddm_s_merger::set_cdc_max_hits(config->readout["CDC"].at("NPEAK")); - double cdc_ie = config->readout["CDC"].at("IE"); - double cdc_pg = config->readout["CDC"].at("PG"); - double cdc_gate = (cdc_ie + cdc_pg) * fadc125_period_ns; - hddm_s_merger::set_cdc_integration_window_ns(cdc_gate); - - // hits merging / truncation parameters for the FDC - hddm_s_merger::set_fdc_wires_max_hits(config->readout["FDC"].at("NHITS")); - double fdc_width = config->readout["FDC"].at("WIDTH"); - hddm_s_merger::set_fdc_wires_min_delta_t_ns(fdc_width + 5.); - hddm_s_merger::set_fdc_strips_max_hits(config->readout["FDC"].at("NPEAK")); - double fdc_ie = config->readout["FDC"].at("IE"); - double fdc_pg = config->readout["FDC"].at("PG"); - double fdc_gate = (fdc_ie + fdc_pg) * fadc125_period_ns; - hddm_s_merger::set_fdc_strips_integration_window_ns(fdc_gate); - - // hits merging / truncation parameters for the STC - hddm_s_merger::set_stc_adc_max_hits(config->readout["ST"].at("NPEAK")); - hddm_s_merger::set_stc_tdc_max_hits(config->readout["ST"].at("NHITS")); - double stc_width = config->readout["ST"].at("WIDTH"); - hddm_s_merger::set_stc_min_delta_t_ns(stc_width + 5.); - double stc_nsa = config->readout["ST"].at("NSA"); - double stc_nsb = config->readout["ST"].at("NSB"); - double stc_gate = (stc_nsa + stc_nsb) * fadc250_period_ns; - hddm_s_merger::set_stc_integration_window_ns(stc_gate); - - // hits merging / truncation parameters for the BCAL - hddm_s_merger::set_bcal_adc_max_hits(config->readout["BCAL"].at("NPEAK")); - hddm_s_merger::set_bcal_tdc_max_hits(config->readout["BCAL"].at("NHITS")); - double bcal_width = config->readout["BCAL"].at("WIDTH"); - hddm_s_merger::set_bcal_min_delta_t_ns(bcal_width + 5.); - double bcal_nsa = config->readout["BCAL"].at("NSA"); - double bcal_nsb = config->readout["BCAL"].at("NSB"); - double bcal_gate = (bcal_nsa + bcal_nsb) * fadc250_period_ns; - hddm_s_merger::set_bcal_integration_window_ns(bcal_gate); - - // hits merging / truncation parameters for the TOF - hddm_s_merger::set_ftof_adc_max_hits(config->readout["TOF"].at("NPEAK")); - hddm_s_merger::set_ftof_tdc_max_hits(config->readout["TOF"].at("NHITS")); - double ftof_width = config->readout["TOF"].at("WIDTH"); - hddm_s_merger::set_ftof_min_delta_t_ns(ftof_width + 5.); - double tof_nsa = config->readout["TOF"].at("NSA"); - double tof_nsb = config->readout["TOF"].at("NSB"); - double tof_gate = (tof_nsa + tof_nsb) * fadc250_period_ns; - hddm_s_merger::set_ftof_integration_window_ns(tof_gate); - - // hits merging / truncation parameters for the FCAL - hddm_s_merger::set_fcal_max_hits(config->readout["FCAL"].at("NPEAK")); - double fcal_nsa = config->readout["FCAL"].at("NSA"); - double fcal_nsb = config->readout["FCAL"].at("NSB"); - double fcal_gate = (fcal_nsa + fcal_nsb) * fadc250_period_ns; - hddm_s_merger::set_fcal_integration_window_ns(fcal_gate); - - // hits merging / truncation parameters for the CCAL - hddm_s_merger::set_ccal_max_hits(config->readout["FCAL"].at("NPEAK")); - hddm_s_merger::set_ccal_integration_window_ns(fcal_gate); - - // hits merging / truncation parameters for the PS - hddm_s_merger::set_ps_max_hits(config->readout["PS"].at("NPEAK")); - double ps_nsa = config->readout["PS"].at("NSA"); - double ps_nsb = config->readout["PS"].at("NSB"); - double ps_gate = (ps_nsa + ps_nsb) * fadc250_period_ns; - hddm_s_merger::set_ps_integration_window_ns(ps_gate); - hddm_s_merger::set_psc_adc_max_hits(config->readout["PSC"].at("NPEAK")); - hddm_s_merger::set_psc_tdc_max_hits(config->readout["PSC"].at("NHITS")); - double psc_width = config->readout["PSC"].at("WIDTH"); - hddm_s_merger::set_psc_min_delta_t_ns(psc_width + 5.); - double psc_nsa = config->readout["PSC"].at("NSA"); - double psc_nsb = config->readout["PSC"].at("NSB"); - double psc_gate = (psc_nsa + psc_nsb) * fadc250_period_ns; - hddm_s_merger::set_psc_integration_window_ns(psc_gate); - - // hits merging / truncation parameters for the TAGM/TAGH - hddm_s_merger::set_tag_adc_max_hits(config->readout["TAGM"].at("NPEAK")); - hddm_s_merger::set_tag_tdc_max_hits(config->readout["TAGM"].at("NHITS")); - double tag_width = config->readout["TAGM"].at("WIDTH"); - hddm_s_merger::set_tag_min_delta_t_ns(tag_width + 5.); - double tag_nsa = config->readout["TAGM"].at("NSA"); - double tag_nsb = config->readout["TAGM"].at("NSB"); - double tag_gate = (tag_nsa + tag_nsb) * fadc250_period_ns; - hddm_s_merger::set_tag_integration_window_ns(tag_gate); - - // hits merging / truncation parameters for the TPOL - hddm_s_merger::set_tpol_max_hits(config->readout["TPOL"].at("NPEAK")); -#endif // HAVE_RCDB - - // fast forward any merger input files over skipped events - std::map::iterator iter; - for (iter = start2merge.begin(); iter != start2merge.end(); ++iter) { - hddm_s::HDDM record2; - for (int i=0; i < skip2merge[iter->first]; ++i) { - if (!(*iter->first >> record2)) { - //pthread_mutex_lock(&input_file_mutex); - //input_file_mutex_last_owner = pthread_self(); - iter->first->setPosition(start2merge.at(iter->first)); - if (!(*iter->first >> record2)) { - //pthread_mutex_unlock(&input_file_mutex); - std::cerr << "Trying to merge from empty input file, " - << "cannot continue!" << std::endl; - exit(-1); - } - //pthread_mutex_unlock(&input_file_mutex); - } - } - skip2merge[iter->first] = 0; - } - - return NOERROR; -} - -//------------------------------------------------------------------ -// evnt - Do processing for each event here -//------------------------------------------------------------------ -jerror_t MyProcessor::evnt(JEventLoop *loop, uint64_t eventnumber) -{ - JEvent& event = loop->GetJEvent(); - JEventSource *source = event.GetJEventSource(); - DEventSourceHDDM *hddm_source = dynamic_cast(source); - if (!hddm_source) { - cerr << " This program MUST be used with an HDDM file as input!" << endl; - exit(-1); - } - hddm_s::HDDM *record = (hddm_s::HDDM*)event.GetRef(); - if (!record) - return NOERROR; - - // Smear values - smearer->SmearEvent(record); - - // Load any external events to be merged during smearing - std::map::iterator iter; - for (iter = files2merge.begin(); iter != files2merge.end(); ++ iter) { - int count = iter->second; - if (count != iter->second) { - count = gDRandom.Poisson(iter->second); - } - for (int i=0; i < count; ++i) { - hddm_s::HDDM record2; - if (!(*iter->first >> record2)) { - //pthread_mutex_lock(&input_file_mutex); - //input_file_mutex_last_owner = pthread_self(); - iter->first->setPosition(start2merge.at(iter->first)); - if (!(*iter->first >> record2)) { - //pthread_mutex_unlock(&input_file_mutex); - std::cerr << "Trying to merge from empty input file, " - << "cannot continue!" << std::endl; - exit(-1); - } - //pthread_mutex_unlock(&input_file_mutex); - } - hddm_s_merger::set_t_shift_ns(0); - hddm_s::RFsubsystemList RFtimes = record2.getRFsubsystems(); - hddm_s::RFsubsystemList::iterator RFiter; - for (RFiter = RFtimes.begin(); RFiter != RFtimes.end(); ++RFiter) - if (RFiter->getJtag() == "TAGH") - hddm_s_merger::set_t_shift_ns(-RFiter->getTsync()); - *record += record2; - } - } - - // Apply DAQ truncation to hit lists - if (config->APPLY_HITS_TRUNCATION) - hddm_s_merger::truncate_hits(*record); - - // Write event to output file - //pthread_mutex_lock(&output_file_mutex); - //output_file_mutex_last_owner = pthread_self(); - *fout << *record; - Nevents_written++; - //pthread_mutex_unlock(&output_file_mutex); - - return NOERROR; -} - -//------------------------------------------------------------------ -// fini -Close output file here -//------------------------------------------------------------------ -jerror_t MyProcessor::fini(void) -{ - if (fout) - delete fout; - if (ofs) { - ofs->close(); - cout << endl << "Closed HDDM file" << endl; - } - cout << " " << Nevents_written << " event written to " << OUTFILENAME - << endl; - - return NOERROR; -} diff --git a/src/programs/Simulation/mcsmear/MyProcessor.h b/src/programs/Simulation/mcsmear/MyProcessor.h deleted file mode 100644 index 7633c349ed..0000000000 --- a/src/programs/Simulation/mcsmear/MyProcessor.h +++ /dev/null @@ -1,53 +0,0 @@ -// Author: David Lawrence Sat Jan 29 09:37:37 EST 2011 -// -// -// MyProcessor.h -// -/// Processor for mcsmear -/// - -#ifndef _MYPROCESSOR_H_ -#define _MYPROCESSOR_H_ - -#include - -#include -#include -using namespace jana; - -#include -#include - -#include "smear.h" -#include "mcsmear_config.h" - -class MyProcessor:public JEventProcessor -{ - public: - MyProcessor(mcsmear_config_t *in_config) { - config = in_config; - smearer = NULL; - } - - jerror_t init(void); ///< Called once at program start. - jerror_t brun(JEventLoop *loop, int32_t runnumber); ///< Called everytime a new run number is detected. - jerror_t evnt(JEventLoop *loop, uint64_t eventnumber); ///< Called every event. - jerror_t erun(void) { ///< Called everytime run number changes, provided brun has been called. - return NOERROR; - } - jerror_t fini(void); ///< Called after last event of last event source has been processed. - - ofstream *ofs; - hddm_s::ostream *fout; - unsigned long Nevents_written; - - private: - int HDDM_USE_COMPRESSION; - bool HDDM_USE_INTEGRITY_CHECKS; - - mcsmear_config_t *config; - Smear *smearer; -}; - - -#endif // _MYPROCESSOR_H_ diff --git a/src/programs/Simulation/mcsmear/PSCSmearer.cc b/src/programs/Simulation/mcsmear/PSCSmearer.cc deleted file mode 100644 index bd5bfd3db6..0000000000 --- a/src/programs/Simulation/mcsmear/PSCSmearer.cc +++ /dev/null @@ -1,46 +0,0 @@ -#include "PSCSmearer.h" - -//----------- -// psc_config_t (constructor) -//----------- -psc_config_t::psc_config_t(JEventLoop *loop) -{ - // default values - PSC_SIGMA = 0.200; //ns - PSC_PHOTONS_PERMEV = 5.e5; - PSC_THRESHOLD = 0.0; -} - - -//----------- -// SmearEvent -//----------- -void PSCSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::PscPaddleList paddles = record->getPscPaddles(); - hddm_s::PscPaddleList::iterator iter; - for (iter = paddles.begin(); iter != paddles.end(); ++iter) { - iter->deletePscHits(); - hddm_s::PscTruthHitList thits = iter->getPscTruthHits(); - hddm_s::PscTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time - double t = titer->getT(); - double NewE = titer->getDE(); - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(psc_config->PSC_SIGMA); - double npe = titer->getDE() * 1000. * psc_config->PSC_PHOTONS_PERMEV; - npe = npe + gDRandom.SampleGaussian(sqrt(npe)); - NewE = npe/psc_config->PSC_PHOTONS_PERMEV/1000.; - } - if (NewE > psc_config->PSC_THRESHOLD) { - hddm_s::PscHitList hits = iter->addPscHits(); - hits().setT(t); - hits().setDE(NewE); - } - } - - if (config->DROP_TRUTH_HITS) - iter->deletePscTruthHits(); - } -} \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/PSCSmearer.h b/src/programs/Simulation/mcsmear/PSCSmearer.h deleted file mode 100644 index b90e7dc486..0000000000 --- a/src/programs/Simulation/mcsmear/PSCSmearer.h +++ /dev/null @@ -1,39 +0,0 @@ -// Smearing class for coarse pair spectrometer counters (PSC) - -#ifndef _PSCSMEARER_H_ -#define _PSCSMEARER_H_ - -#include "Smearer.h" - - -class psc_config_t -{ - public: - psc_config_t(JEventLoop *loop); - - double PSC_SIGMA; - double PSC_PHOTONS_PERMEV; - double PSC_THRESHOLD; - -}; - - -class PSCSmearer : public Smearer -{ - public: - PSCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - psc_config = new psc_config_t(loop); - } - ~PSCSmearer() { - delete psc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - psc_config_t *psc_config; -}; - - - -#endif // _PSSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/PSSmearer.cc b/src/programs/Simulation/mcsmear/PSSmearer.cc deleted file mode 100644 index c2e8f133f8..0000000000 --- a/src/programs/Simulation/mcsmear/PSSmearer.cc +++ /dev/null @@ -1,44 +0,0 @@ -#include "PSSmearer.h" - -//----------- -// ps_config_t (constructor) -//----------- -ps_config_t::ps_config_t(JEventLoop *loop) -{ - // default values - PS_SIGMA = 0.200; // ns - PS_NPIX_PER_GEV = 1.e5; - PS_THRESHOLD = 0.0; -} - - -//----------- -// SmearEvent -//----------- -void PSSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::PsTileList tiles = record->getPsTiles(); - hddm_s::PsTileList::iterator iter; - for (iter = tiles.begin(); iter != tiles.end(); ++iter) { - iter->deletePsHits(); - hddm_s::PsTruthHitList thits = iter->getPsTruthHits(); - hddm_s::PsTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time - double t = titer->getT(); - double dE = titer->getDE(); - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(ps_config->PS_SIGMA); - // convert energy deposition in number of fired pixels - double npe = gDRandom.SamplePoisson( titer->getDE() * ps_config->PS_NPIX_PER_GEV); - dE = npe/ps_config->PS_NPIX_PER_GEV; - } - hddm_s::PsHitList hits = iter->addPsHits(); - hits().setT(t); - hits().setDE(dE); - } - - if (config->DROP_TRUTH_HITS) - iter->deletePsTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/PSSmearer.h b/src/programs/Simulation/mcsmear/PSSmearer.h deleted file mode 100644 index 00f17c67a3..0000000000 --- a/src/programs/Simulation/mcsmear/PSSmearer.h +++ /dev/null @@ -1,38 +0,0 @@ -// Smearing class for fine pair spectrometer counters (PS) - -#ifndef _PSSMEARER_H_ -#define _PSSMEARER_H_ - -#include "Smearer.h" - - -class ps_config_t -{ - public: - ps_config_t(JEventLoop *loop); - - double PS_SIGMA; - double PS_NPIX_PER_GEV; - double PS_THRESHOLD; - -}; - - -class PSSmearer : public Smearer -{ - public: - PSSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - ps_config = new ps_config_t(loop); - } - ~PSSmearer() { - delete ps_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - ps_config_t *ps_config; -}; - - -#endif // _PSSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/SCSmearer.cc b/src/programs/Simulation/mcsmear/SCSmearer.cc deleted file mode 100644 index 1c9e7dcdcb..0000000000 --- a/src/programs/Simulation/mcsmear/SCSmearer.cc +++ /dev/null @@ -1,153 +0,0 @@ -#include "SCSmearer.h" -#include "START_COUNTER/DSCHit_factory.h" - -//----------- -// sc_config_t (constructor) -//----------- -sc_config_t::sc_config_t(JEventLoop *loop) -{ - // default values - START_SIGMA = 0.0; // 300ps - START_PHOTONS_PERMEV = 0.0; // used to be 8000 should be more like 200 - START_PADDLE_THRESHOLD = 0.0; - - // Load data from CCDB - cout << "Get START_COUNTER/start_parms parameters from CCDB..." << endl; - map startparms; - if(loop->GetCalib("START_COUNTER/start_parms", startparms)) { - jerr << "Problem loading START_COUNTER/start_parms from CCDB!" << endl; - } else { - START_SIGMA = startparms["START_SIGMA"] ; - START_PHOTONS_PERMEV = startparms["START_PHOTONS_PERMEV"]; - } - - cout<<"get START_COUNTER/paddle_mc_efficiency from calibDB"<GetCalib("START_COUNTER/paddle_mc_efficiency", paddle_efficiencies)) { - jerr << "Problem loading START_COUNTER/paddle_mc_efficiency from CCDB!" << endl; - } - - // Start counter individual paddle resolutions - vector< vector > sc_paddle_resolution_params; - if(loop->GetCalib("START_COUNTER/time_resol_paddle_v2", sc_paddle_resolution_params)) - jout << "Error in loading START_COUNTER/time_resol_paddle_v2 !" << endl; - else { - if(sc_paddle_resolution_params.size() != (unsigned int)DSCHit_factory::MAX_SECTORS) - jerr << "Start counter paddle resolutions table has wrong number of entries:" << endl - << " loaded = " << sc_paddle_resolution_params.size() - << " expected = " << DSCHit_factory::MAX_SECTORS << endl; - - for(int i=0; i sc_mc_correction_factors; - if(loop->GetCalib("START_COUNTER/mc_time_resol_corr", sc_mc_correction_factors)) { - jout << "Error in loading START_COUNTER/mc_time_resol_corr !" << endl; - } else { - SC_MC_CORRECTION_P0 = sc_mc_correction_factors["P0"]; - SC_MC_CORRECTION_P1 = sc_mc_correction_factors["P1"]; - } - - // Get the geometry - DApplication* dapp = dynamic_cast(loop->GetJApplication()); - if(!dapp){ - jerr << "Cannot get DApplication from JEventLoop!" << endl; - return; - } - DGeometry* locGeometry = dapp->GetDGeometry(loop->GetJEvent().GetRunNumber()); - - // Get start counter geometry - vector >sc_norm; - vector >sc_pos; - if (locGeometry->GetStartCounterGeom(sc_pos, sc_norm)) { - for(int sc_index=0; sc_index<30; sc_index++) - SC_START_Z.push_back( sc_pos[sc_index][0].z() ); - } - -} - - -//----------- -// SmearEvent -//----------- -void SCSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::StcTruthPointList truthPoints = record->getStcTruthPoints(); - - hddm_s::StcPaddleList pads = record->getStcPaddles(); - hddm_s::StcPaddleList::iterator iter; - for (iter = pads.begin(); iter != pads.end(); ++iter) { - iter->deleteStcHits(); - hddm_s::StcTruthHitList thits = iter->getStcTruthHits(); - hddm_s::StcTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // correct simulation efficiencies - if(config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(sc_config->GetEfficiencyCorrectionFactor(iter->getSector()))) - continue; - - // smear the time - hddm_s::StcTruthPointList::iterator piter = FindMatchingTruthPoint(titer, truthPoints); - // calculate a z-depending timing resolution - // z is measured from the readout end of the paddles - double z_pos = 30.; // default value in the middle, in case we can't find a good point. this shouldn't happen, but you never know... - if( piter != truthPoints.end() ) - z_pos = piter->getZ() - sc_config->SC_START_Z[iter->getSector()-1]; - - double t = titer->getT(); - double NewE = titer->getDE(); - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(sc_config->GetPaddleTimeResolution(iter->getSector()-1, z_pos)); - // smear the energy - double npe = titer->getDE() * 1000. * sc_config->START_PHOTONS_PERMEV; - npe = npe + gDRandom.SampleGaussian(sqrt(npe)); - NewE = npe/sc_config->START_PHOTONS_PERMEV/1000.; - } - if (NewE > sc_config->START_PADDLE_THRESHOLD) { - hddm_s::StcHitList hits = iter->addStcHits(); - hits().setT(t); - hits().setDE(NewE); - } - } - - if (config->DROP_TRUTH_HITS) - iter->deleteStcTruthHits(); - } -} - -// ---------------------- -// FindMatchingTruthPoint -// ---------------------- -hddm_s::StcTruthPointList::iterator SCSmearer::FindMatchingTruthPoint(hddm_s::StcTruthHitList::iterator hiter, hddm_s::StcTruthPointList &truthPoints) -{ - // Match the StcTruthHit with the most likely corresponding StcTruthPoin - // This is needed since StcTruthHits correspond to detector hits, and so only have time and - // energy values. If we want to do something with a z-dependence, e.g. time resolutions, - // we need the StcTruthPoint, which has a location in detector coordinates. - // The only thing they have in common in the energy deposited in the scintillator paddles - // since the StcTruthHit has a propagation time correction applied, so we use that - // to disambiguate multiple hits in the same paddle - hddm_s::StcTruthPointList::iterator piter; - hddm_s::StcTruthPointList::iterator best_piter = truthPoints.end(); - double best_match_deltaE = 100.; - for( piter = truthPoints.begin(); piter != truthPoints.end(); piter++) { - if( hiter->getSector() == piter->getSector() ) { - double deltaE = fabs(hiter->getDE() - piter->getDEdx()); - if(deltaE < best_match_deltaE) { - best_piter = piter; - best_match_deltaE = deltaE; - } - } - } - - return best_piter; -} diff --git a/src/programs/Simulation/mcsmear/SCSmearer.h b/src/programs/Simulation/mcsmear/SCSmearer.h deleted file mode 100644 index aa41891b39..0000000000 --- a/src/programs/Simulation/mcsmear/SCSmearer.h +++ /dev/null @@ -1,84 +0,0 @@ -// Smearing class for start counter (SC) - -#ifndef _SCSMEARER_H_ -#define _SCSMEARER_H_ - -#include "Smearer.h" - - -class sc_config_t -{ - public: - sc_config_t(JEventLoop *loop); - - double GetPaddleTimeResolution(int sector, double sc_local_z) { - double time_resolution = 0.; - - if(sc_local_z < SC_BOUNDARY1[sector]) { - time_resolution = SC_SECTION1_P0[sector] + SC_SECTION1_P1[sector]*sc_local_z; - } else if(sc_local_z < SC_BOUNDARY2[sector]) { - time_resolution = SC_SECTION2_P0[sector] + SC_SECTION2_P1[sector]*sc_local_z; - } else { - time_resolution = SC_SECTION3_P0[sector] + SC_SECTION3_P1[sector]*sc_local_z; - } - - // max sure that we aren't getting some ridiculously large resolution - if(time_resolution > SC_MAX_RESOLUTION[sector]) - time_resolution = SC_MAX_RESOLUTION[sector]; - - // If these resolutions come from data, apply correction factors to remove any other contributions - time_resolution = (time_resolution - SC_MC_CORRECTION_P0) / SC_MC_CORRECTION_P1; - - // convert ps to ns - time_resolution /= 1000.; - //cout << " time resolution = " << time_resolution << endl; - return time_resolution; - } - - double GetEfficiencyCorrectionFactor(int sector) { - return paddle_efficiencies.at(sector-1); - } - - double START_SIGMA; - double START_PHOTONS_PERMEV; - double START_PADDLE_THRESHOLD; - - vector paddle_efficiencies; - - // Start counter geometry parameters - vector SC_START_Z; - - // Start counter resolution parameters - vector SC_MAX_RESOLUTION; - vector SC_BOUNDARY1, SC_BOUNDARY2; - vector SC_SECTION1_P0, SC_SECTION1_P1; - vector SC_SECTION2_P0, SC_SECTION2_P1; - vector SC_SECTION3_P0, SC_SECTION3_P1; - - double SC_MC_CORRECTION_P0, SC_MC_CORRECTION_P1; - -}; - - -class SCSmearer : public Smearer -{ - public: - SCSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - sc_config = new sc_config_t(loop); - } - ~SCSmearer() { - delete sc_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - protected: - hddm_s::StcTruthPointList::iterator FindMatchingTruthPoint(hddm_s::StcTruthHitList::iterator hiter, hddm_s::StcTruthPointList &truthPoints); - - private: - sc_config_t *sc_config; -}; - - - -#endif // _SCSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/SConscript b/src/programs/Simulation/mcsmear/SConscript deleted file mode 100644 index 05f46aaf80..0000000000 --- a/src/programs/Simulation/mcsmear/SConscript +++ /dev/null @@ -1,14 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddROOT(env) -sbms.AddRCDB(env) -sbms.AddDANA(env) -sbms.executable(env) - - diff --git a/src/programs/Simulation/mcsmear/Smearer.h b/src/programs/Simulation/mcsmear/Smearer.h deleted file mode 100644 index 36a7704d7e..0000000000 --- a/src/programs/Simulation/mcsmear/Smearer.h +++ /dev/null @@ -1,28 +0,0 @@ -// abstract base class for smearing hits in a subdetector - -#ifndef _SMEARER_H_ -#define _SMEARER_H_ - -#include "mcsmear_config.h" -#include "HDDM/hddm_s.hpp" -#include "DRandom2.h" - -#include -using namespace jana; - -class Smearer -{ - public: - Smearer(JEventLoop *loop, mcsmear_config_t *in_config) { - config = in_config; - }; - virtual ~Smearer() {} - - virtual void SmearEvent(hddm_s::HDDM *record) = 0; - - protected: - mcsmear_config_t *config; // save a link to this information, but we do not own it - -}; - -#endif // _SMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/TAGHSmearer.cc b/src/programs/Simulation/mcsmear/TAGHSmearer.cc deleted file mode 100644 index e36d05c40e..0000000000 --- a/src/programs/Simulation/mcsmear/TAGHSmearer.cc +++ /dev/null @@ -1,48 +0,0 @@ -#include "TAGHSmearer.h" - - -//----------- -// tagh_config_t (constructor) -//----------- -tagh_config_t::tagh_config_t(JEventLoop *loop) -{ - // default values - TAGH_TSIGMA = 0.350; // ns - TAGH_FADC_TSIGMA = 0.450; // ns - TAGH_NPE_PER_GEV = 5.e5; - -} - - -//----------- -// SmearEvent -//----------- -void TAGHSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::HodoChannelList taghs = record->getHodoChannels(); - hddm_s::HodoChannelList::iterator iter; - for (iter = taghs.begin(); iter != taghs.end(); ++iter) { - iter->deleteTaggerHits(); - hddm_s::TaggerTruthHitList thits = iter->getTaggerTruthHits(); - hddm_s::TaggerTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time - double t = titer->getT(); - double tADC = titer->getT(); - double npe = titer->getDE() * tagh_config->TAGH_NPE_PER_GEV; - - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(tagh_config->TAGH_TSIGMA); - tADC += gDRandom.SampleGaussian(tagh_config->TAGH_FADC_TSIGMA); - npe = gDRandom.SamplePoisson(titer->getDE() * tagh_config->TAGH_NPE_PER_GEV); - } - hddm_s::TaggerHitList hits = iter->addTaggerHits(); - hits().setT(t); - hits().setTADC(tADC); - hits().setNpe(npe); - } - - if (config->DROP_TRUTH_HITS) - iter->deleteTaggerTruthHits(); - } -} \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/TAGHSmearer.h b/src/programs/Simulation/mcsmear/TAGHSmearer.h deleted file mode 100644 index b865d16b00..0000000000 --- a/src/programs/Simulation/mcsmear/TAGHSmearer.h +++ /dev/null @@ -1,40 +0,0 @@ -// Smearing class for tagger hodoscope (TAGH) - -#ifndef _TAGHSMEARER_H_ -#define _TAGHSMEARER_H_ - -#include "Smearer.h" - - -class tagh_config_t -{ - public: - tagh_config_t(JEventLoop *loop); - - double TAGH_TSIGMA; - double TAGH_FADC_TSIGMA; - double TAGH_NPE_PER_GEV; - -}; - - -class TAGHSmearer : public Smearer -{ - public: - TAGHSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - tagh_config = new tagh_config_t(loop); - } - ~TAGHSmearer() { - delete tagh_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - tagh_config_t *tagh_config; -}; - - - - -#endif // _TAGHSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/TAGMSmearer.cc b/src/programs/Simulation/mcsmear/TAGMSmearer.cc deleted file mode 100644 index 00ad47b15a..0000000000 --- a/src/programs/Simulation/mcsmear/TAGMSmearer.cc +++ /dev/null @@ -1,43 +0,0 @@ -#include "TAGMSmearer.h" - -//----------- -// tagm_config_t (constructor) -//----------- -tagm_config_t::tagm_config_t(JEventLoop *loop) { - // default values - TAGM_TSIGMA = 0.200; // ns - TAGM_FADC_TSIGMA = 0.350; // ns - TAGM_NPIX_PER_GEV = 1.e5; -} - -//----------- -// SmearEvent -//----------- -void TAGMSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::MicroChannelList tagms = record->getMicroChannels(); - hddm_s::MicroChannelList::iterator iter; - for (iter = tagms.begin(); iter != tagms.end(); ++iter) { - iter->deleteTaggerHits(); - hddm_s::TaggerTruthHitList thits = iter->getTaggerTruthHits(); - hddm_s::TaggerTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time - double t = titer->getT(); - double tADC = titer->getT(); - double npe = titer->getDE() * tagm_config->TAGM_NPIX_PER_GEV; - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(tagm_config->TAGM_TSIGMA); - tADC += gDRandom.SampleGaussian(tagm_config->TAGM_FADC_TSIGMA); - npe = gDRandom.SamplePoisson(titer->getDE() * tagm_config->TAGM_NPIX_PER_GEV); - } - hddm_s::TaggerHitList hits = iter->addTaggerHits(); - hits().setT(t); - hits().setTADC(tADC); - hits().setNpe(npe); - } - - if (config->DROP_TRUTH_HITS) - iter->deleteTaggerTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/TAGMSmearer.h b/src/programs/Simulation/mcsmear/TAGMSmearer.h deleted file mode 100644 index c4908a8b6c..0000000000 --- a/src/programs/Simulation/mcsmear/TAGMSmearer.h +++ /dev/null @@ -1,39 +0,0 @@ -// Smearing class for tagger microscope (TAGM) - -#ifndef _TAGMSMEARER_H_ -#define _TAGMSMEARER_H_ - -#include "Smearer.h" - - -class tagm_config_t -{ - public: - tagm_config_t(JEventLoop *loop); - - double TAGM_TSIGMA; - double TAGM_FADC_TSIGMA; - double TAGM_NPIX_PER_GEV; - -}; - - -class TAGMSmearer : public Smearer -{ - public: - TAGMSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - tagm_config = new tagm_config_t(loop); - } - ~TAGMSmearer() { - delete tagm_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - tagm_config_t *tagm_config; -}; - - - -#endif // _TAGMSMEARER_H_ \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/TOFSmearer.cc b/src/programs/Simulation/mcsmear/TOFSmearer.cc deleted file mode 100644 index 51e5f777e7..0000000000 --- a/src/programs/Simulation/mcsmear/TOFSmearer.cc +++ /dev/null @@ -1,101 +0,0 @@ -#include "TOFSmearer.h" - -//----------- -// tof_config_t (constructor) -//----------- -tof_config_t::tof_config_t(JEventLoop *loop) -{ - // default values - TOF_SIGMA = 100.*k_psec; - TOF_PHOTONS_PERMEV = 400.; - TOF_BAR_THRESHOLD = 0.0; - - // geometry - const int TOF_NUM_PLANES = 2; - const int TOF_NUM_BARS = 44; - - // Load data from CCDB - cout<<"Get TOF/tof_parms parameters from CCDB..."< tofparms; - if(loop->GetCalib("TOF/tof_parms", tofparms)) { - jerr << "Problem loading TOF/tof_parms from CCDB!" << endl; - return; - } - - TOF_SIGMA = tofparms["TOF_SIGMA"]; - TOF_PHOTONS_PERMEV = tofparms["TOF_PHOTONS_PERMEV"]; - - cout<<"get TOF/paddle_resolutions from calibDB"< TOF_PADDLE_TIME_RESOLUTIONS_TEMP; - if(loop->GetCalib("TOF/paddle_resolutions", TOF_PADDLE_TIME_RESOLUTIONS_TEMP)) { - jerr << "Problem loading TOF/paddle_resolutions from CCDB!" << endl; - } else { - for (unsigned int i = 0; i < TOF_PADDLE_TIME_RESOLUTIONS_TEMP.size(); i++) { - TOF_PADDLE_TIME_RESOLUTIONS.push_back(TOF_PADDLE_TIME_RESOLUTIONS_TEMP.at(i)); - } - } - - // load per-channel efficiencies - vector raw_table; - if(loop->GetCalib("TOF/channel_mc_efficiency", raw_table)) { - jerr << "Problem loading TOF/channel_mc_efficiency from CCDB!" << endl; - } else { - int channel = 0; - - for(int plane=0; plane >(TOF_NUM_BARS) ); - for(int bar=0; bar(raw_table[plane_index+bar], - raw_table[plane_index+TOF_NUM_BARS+bar]); - channel+=2; - } - } - } - -} - - -//----------- -// SmearEvent -//----------- -void TOFSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::FtofCounterList tofs = record->getFtofCounters(); - hddm_s::FtofCounterList::iterator iter; - for (iter = tofs.begin(); iter != tofs.end(); ++iter) { - // take care of hits - iter->deleteFtofHits(); - hddm_s::FtofTruthHitList thits = iter->getFtofTruthHits(); - hddm_s::FtofTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // correct simulation efficiencies - if (config->APPLY_EFFICIENCY_CORRECTIONS - && !gDRandom.DecideToAcceptHit(tof_config->GetEfficiencyCorrectionFactor(titer))) - continue; - - // Smear the time - //double t = titer->getT() + gDRandom.SampleGaussian(tof_config->TOF_SIGMA); - double t = titer->getT(); - // Smear the energy - float NewE = titer->getDE(); - if(config->SMEAR_HITS) { - t += gDRandom.SampleGaussian(tof_config->GetHitTimeResolution(iter->getPlane(),iter->getBar())); - double npe = titer->getDE() * 1000. * tof_config->TOF_PHOTONS_PERMEV; - npe += gDRandom.SampleGaussian(sqrt(npe)); - NewE = npe/tof_config->TOF_PHOTONS_PERMEV/1000.; - } - if (NewE > tof_config->TOF_BAR_THRESHOLD) { - hddm_s::FtofHitList hits = iter->addFtofHits(); - hits().setEnd(titer->getEnd()); - hits().setT(t); - hits().setDE(NewE); - } - } - - if (config->DROP_TRUTH_HITS) { - iter->deleteFtofTruthHits(); - } - } -} \ No newline at end of file diff --git a/src/programs/Simulation/mcsmear/TOFSmearer.h b/src/programs/Simulation/mcsmear/TOFSmearer.h deleted file mode 100644 index 68625802c3..0000000000 --- a/src/programs/Simulation/mcsmear/TOFSmearer.h +++ /dev/null @@ -1,59 +0,0 @@ -// Smearing class for forward time-of-flight wall (TOF) - -#ifndef _TOFSMEARER_H_ -#define _TOFSMEARER_H_ - -#include "Smearer.h" - -#include - -class tof_config_t -{ - public: - tof_config_t(JEventLoop *loop); - - inline double GetPaddleTimeResolution(int plane, int bar) { - int paddle = plane*44 + bar - 1; // hardcode for now - return TOF_PADDLE_TIME_RESOLUTIONS.at(paddle); - } - inline double GetHitTimeResolution(int plane, int bar) { - // assume that the paddle resolution is given by: paddle resol = (hit resol)^2 - return GetPaddleTimeResolution(plane, bar)/TMath::Sqrt2(); - } - - double TOF_SIGMA; - double TOF_PHOTONS_PERMEV; - double TOF_BAR_THRESHOLD; - - vector TOF_PADDLE_TIME_RESOLUTIONS; - - vector< vector< pair > > channel_efficiencies; - - double GetEfficiencyCorrectionFactor(hddm_s::FtofTruthHitList::iterator &siter) { - if(siter->getEnd() == 0) - return channel_efficiencies.at(siter->getPlane()).at(siter->getBar()-1).first; - else - return channel_efficiencies.at(siter->getPlane()).at(siter->getBar()-1).second; - } -}; - - -class TOFSmearer : public Smearer -{ - public: - TOFSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - tof_config = new tof_config_t(loop); - } - ~TOFSmearer() { - delete tof_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - tof_config_t *tof_config; - -}; - - -#endif // _TOFSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/TPOLSmearer.cc b/src/programs/Simulation/mcsmear/TPOLSmearer.cc deleted file mode 100644 index 4739627e71..0000000000 --- a/src/programs/Simulation/mcsmear/TPOLSmearer.cc +++ /dev/null @@ -1,46 +0,0 @@ -#include "TPOLSmearer.h" - -//----------- -// tpol_config_t (constructor) -//----------- -tpol_config_t::tpol_config_t(JEventLoop *loop) -{ - // default values - TPOL_SIGMA_NS = 4.4; // ns - TPOL_SIGMA1_MEV = 0.03; // MeV - TPOL_SIGMA2_MEV = 0.03; // MeV - TPOL_THRESHOLD_MEV = 0.05; // MeV -} - - -//----------- -// SmearEvent -//----------- -void TPOLSmearer::SmearEvent(hddm_s::HDDM *record) -{ - hddm_s::TpolSectorList sectors = record->getTpolSectors(); - hddm_s::TpolSectorList::iterator iter; - for (iter = sectors.begin(); iter != sectors.end(); ++iter) { - iter->deleteTpolHits(); - hddm_s::TpolTruthHitList thits = iter->getTpolTruthHits(); - hddm_s::TpolTruthHitList::iterator titer; - for (titer = thits.begin(); titer != thits.end(); ++titer) { - // smear the time - double t_ns = titer->getT(); - // smear the energy, convert to MeV - double dE_MeV = titer->getDE() * 1e3; - if(config->SMEAR_HITS) { - t_ns += gDRandom.SampleGaussian(tpol_config->TPOL_SIGMA_NS); - dE_MeV += (gDRandom.SampleGaussian(tpol_config->TPOL_SIGMA1_MEV) + gDRandom.SampleGaussian(tpol_config->TPOL_SIGMA2_MEV)); - } - // apply the threshold - if (dE_MeV > tpol_config->TPOL_THRESHOLD_MEV) { - hddm_s::TpolHitList hits = iter->addTpolHits(); - hits().setT(t_ns); - hits().setDE(dE_MeV); - } - } - if (config->DROP_TRUTH_HITS) - iter->deleteTpolTruthHits(); - } -} diff --git a/src/programs/Simulation/mcsmear/TPOLSmearer.h b/src/programs/Simulation/mcsmear/TPOLSmearer.h deleted file mode 100644 index 94149a1dba..0000000000 --- a/src/programs/Simulation/mcsmear/TPOLSmearer.h +++ /dev/null @@ -1,39 +0,0 @@ -// Smearing class for fine pair spectrometer counters (TPOL) - -#ifndef _TPOLSMEARER_H_ -#define _TPOLSMEARER_H_ - -#include "Smearer.h" - - -class tpol_config_t -{ - public: - tpol_config_t(JEventLoop *loop); - - double TPOL_SIGMA_NS; - double TPOL_SIGMA1_MEV; - double TPOL_SIGMA2_MEV; - double TPOL_THRESHOLD_MEV; - -}; - - -class TPOLSmearer : public Smearer -{ - public: - TPOLSmearer(JEventLoop *loop, mcsmear_config_t *in_config) : Smearer(loop, in_config) { - tpol_config = new tpol_config_t(loop); - } - ~TPOLSmearer() { - delete tpol_config; - } - - void SmearEvent(hddm_s::HDDM *record); - - private: - tpol_config_t *tpol_config; -}; - - -#endif // _TPOLSMEARER_H_ diff --git a/src/programs/Simulation/mcsmear/hddm_s_merger.cc b/src/programs/Simulation/mcsmear/hddm_s_merger.cc deleted file mode 100644 index d740a57766..0000000000 --- a/src/programs/Simulation/mcsmear/hddm_s_merger.cc +++ /dev/null @@ -1,2234 +0,0 @@ -// -// hddm_s_merger.cc - Utility class for merging hits from two hddm_s element lists -// -// author: richard.t.jones at uconn.edu -// version: march 20, 2017 -// -// notes: -// 1) Only hits information (ie. tags generated by mcsmear from simulation -// truth information) are merged by the functions in this suite; all other -// tags are ignored. -// -// 2) The merger functions overload the += operator for HDDM_ElementList and -// HDDM_ElementLink objects. The destination and source elements in this -// operation are assumed to belong to different HDDM records. -// -// 3) The merging operators maintain the intended ordering of hits elements -// in the merged HDDM record. This is not strictly required by the hddm_s -// data model, but it is a good convention and makes sure that the origin -// of any particular tag cannot feed forward and affect how it is used in -// subsequent analysis. - -#include -#include -#include - -const double fadc125_period_ns(8.); -const double fadc250_period_ns(4.); - -static thread_local double t_shift_ns(0); - -static thread_local int cdc_max_hits(1); -static thread_local double cdc_integration_window_ns(800.); - -static thread_local int fdc_wires_max_hits(8); -static thread_local double fdc_wires_min_delta_t_ns(35.); -static thread_local int fdc_strips_max_hits(1); -static thread_local double fdc_strips_integration_window_ns(200.); - -static thread_local int stc_adc_max_hits(3); -static thread_local int stc_tdc_max_hits(8); -static thread_local double stc_min_delta_t_ns(25.); -static thread_local double stc_integration_window_ns(100.); - -static thread_local int bcal_adc_max_hits(1); -static thread_local int bcal_tdc_max_hits(8); -static thread_local double bcal_min_delta_t_ns(25.); -static thread_local double bcal_integration_window_ns(114.); -static thread_local double bcal_fadc_counts_per_ns(16.); -static thread_local double bcal_tdc_counts_per_ns(16.13); - -static thread_local int ftof_adc_max_hits(3); -static thread_local int ftof_tdc_max_hits(64); -static thread_local double ftof_min_delta_t_ns(25.); -static thread_local double ftof_integration_window_ns(104.); - -static thread_local int fcal_max_hits(3); -static thread_local double fcal_min_delta_t_ns(70.); -static thread_local double fcal_integration_window_ns(64.); - -static thread_local int ccal_max_hits(3); -static thread_local double ccal_min_delta_t_ns(70.); -static thread_local double ccal_integration_window_ns(64.); - -static thread_local int ps_max_hits(3); -static thread_local double ps_integration_window_ns(72.); -static thread_local int psc_adc_max_hits(3); -static thread_local int psc_tdc_max_hits(3); -static thread_local double psc_min_delta_t_ns(25.); -static thread_local double psc_integration_window_ns(36.); - -static thread_local int tag_adc_max_hits(3); -static thread_local int tag_tdc_max_hits(8); -static thread_local double tag_min_delta_t_ns(25.); -static thread_local double tag_integration_window_ns(36.); - -static thread_local int tpol_max_hits(1); -static thread_local double tpol_integration_window_ns(2500.); - -static thread_local int fmwpc_max_hits(1); -static thread_local double fmwpc_min_delta_t_ns(400.); - -extern const mcsmear_config_t *mcsmear_config; - -namespace hddm_s_merger { - - double get_t_shift_ns() { - return t_shift_ns; - } - - void set_t_shift_ns(double dt_ns) { - t_shift_ns = dt_ns; - } - - int get_cdc_max_hits() { - return cdc_max_hits; - } - - void set_cdc_max_hits(int maxhits) { - cdc_max_hits = maxhits; - } - - double get_cdc_integration_window_ns() { - return cdc_integration_window_ns; - } - - void set_cdc_integration_window_ns(double dt_ns) { - cdc_integration_window_ns = dt_ns; - } - - int get_fdc_wires_max_hits() { - return fdc_wires_max_hits; - } - - void set_fdc_wires_max_hits(int maxhits) { - fdc_wires_max_hits = maxhits; - } - - double get_fdc_wires_min_delta_t_ns() { - return fdc_wires_min_delta_t_ns; - } - - void set_fdc_wires_min_delta_t_ns(double dt_ns) { - fdc_wires_min_delta_t_ns = dt_ns; - } - - int get_fdc_strips_max_hits() { - return fdc_strips_max_hits; - } - - void set_fdc_strips_max_hits(int maxhits) { - fdc_strips_max_hits = maxhits; - } - - double get_fdc_strips_integration_window_ns() { - return fdc_strips_integration_window_ns; - } - - void set_fdc_strips_integration_window_ns(double dt_ns) { - fdc_strips_integration_window_ns = dt_ns; - } - - int get_stc_adc_max_hits() { - return stc_adc_max_hits; - } - - void set_stc_adc_max_hits(int maxhits) { - stc_adc_max_hits = maxhits; - } - - int get_stc_tdc_max_hits() { - return stc_tdc_max_hits; - } - - void set_stc_tdc_max_hits(int maxhits) { - stc_tdc_max_hits = maxhits; - } - - double get_stc_min_delta_t_ns() { - return stc_min_delta_t_ns; - } - - void set_stc_min_delta_t_ns(double dt_ns) { - stc_min_delta_t_ns = dt_ns; - } - - double get_stc_integration_window_ns() { - return stc_integration_window_ns; - } - - void set_stc_integration_window_ns(double dt_ns) { - stc_integration_window_ns = dt_ns; - } - - int get_bcal_adc_max_hits() { - return bcal_adc_max_hits; - } - - void set_bcal_adc_max_hits(int maxhits) { - bcal_adc_max_hits = maxhits; - } - - int get_bcal_tdc_max_hits() { - return bcal_tdc_max_hits; - } - - void set_bcal_tdc_max_hits(int maxhits) { - bcal_tdc_max_hits = maxhits; - } - - double get_bcal_min_delta_t_ns() { - return bcal_min_delta_t_ns; - } - - void set_bcal_min_delta_t_ns(double dt_ns) { - bcal_min_delta_t_ns = dt_ns; - } - - double get_bcal_integration_window_ns() { - return bcal_integration_window_ns; - } - - void set_bcal_integration_window_ns(double dt_ns) { - bcal_integration_window_ns = dt_ns; - } - - double get_bcal_fadc_counts_per_ns() { - return bcal_fadc_counts_per_ns; - } - - void set_bcal_fadc_counts_per_ns(double slope) { - bcal_fadc_counts_per_ns = slope; - } - - double get_bcal_tdc_counts_per_ns() { - return bcal_tdc_counts_per_ns; - } - - void set_bcal_tdc_counts_per_ns(double slope) { - bcal_tdc_counts_per_ns = slope; - } - - int get_ftof_adc_max_hits() { - return ftof_adc_max_hits; - } - - void set_ftof_adc_max_hits(int maxhits) { - ftof_adc_max_hits = maxhits; - } - - int get_ftof_tdc_max_hits() { - return ftof_tdc_max_hits; - } - - void set_ftof_tdc_max_hits(int maxhits) { - ftof_tdc_max_hits = maxhits; - } - - double get_ftof_min_delta_t_ns() { - return ftof_min_delta_t_ns; - } - - void set_ftof_min_delta_t_ns(double dt_ns) { - ftof_min_delta_t_ns = dt_ns; - } - - double get_ftof_integration_window_ns() { - return ftof_integration_window_ns; - } - - void set_ftof_integration_window_ns(double dt_ns) { - ftof_integration_window_ns = dt_ns; - } - - int get_fcal_max_hits() { - return fcal_max_hits; - } - - void set_fcal_max_hits(int maxhits) { - fcal_max_hits = maxhits; - } - - double get_fcal_min_delta_t_ns() { - return fcal_min_delta_t_ns; - } - - void set_fcal_min_delta_t_ns(double dt_ns) { - fcal_min_delta_t_ns = dt_ns; - } - - double get_fcal_integration_window_ns() { - return fcal_integration_window_ns; - } - - void set_fcal_integration_window_ns(double dt_ns) { - fcal_integration_window_ns = dt_ns; - } - - int get_ccal_max_hits() { - return ccal_max_hits; - } - - void set_ccal_max_hits(int maxhits) { - ccal_max_hits = maxhits; - } - - double get_ccal_min_delta_t_ns() { - return ccal_min_delta_t_ns; - } - - void set_ccal_min_delta_t_ns(double dt_ns) { - ccal_min_delta_t_ns = dt_ns; - } - - double get_ccal_integration_window_ns() { - return ccal_integration_window_ns; - } - - void set_ccal_integration_window_ns(double dt_ns) { - ccal_integration_window_ns = dt_ns; - } - - int get_ps_max_hits() { - return ps_max_hits; - } - - void set_ps_max_hits(int maxhits) { - ps_max_hits = maxhits; - } - - double get_ps_integration_window_ns() { - return ps_integration_window_ns; - } - - void set_ps_integration_window_ns(double dt_ns) { - ps_integration_window_ns = dt_ns; - } - - int get_psc_adc_max_hits() { - return psc_adc_max_hits; - } - - void set_psc_adc_max_hits(int maxhits) { - psc_adc_max_hits = maxhits; - } - - int get_psc_tdc_max_hits() { - return psc_tdc_max_hits; - } - - void set_psc_tdc_max_hits(int maxhits) { - psc_tdc_max_hits = maxhits; - } - - double get_psc_min_delta_t_ns() { - return psc_min_delta_t_ns; - } - - void set_psc_min_delta_t_ns(double dt_ns) { - psc_min_delta_t_ns = dt_ns; - } - - double get_psc_integration_window_ns() { - return psc_integration_window_ns; - } - - void set_psc_integration_window_ns(double dt_ns) { - psc_integration_window_ns = dt_ns; - } - - int get_tag_adc_max_hits() { - return tag_adc_max_hits; - } - - void set_tag_adc_max_hits(int maxhits) { - tag_adc_max_hits = maxhits; - } - - int get_tag_tdc_max_hits() { - return tag_tdc_max_hits; - } - - void set_tag_tdc_max_hits(int maxhits) { - tag_tdc_max_hits = maxhits; - } - - double get_tag_min_delta_t_ns() { - return tag_min_delta_t_ns; - } - - void set_tag_min_delta_t_ns(double dt_ns) { - tag_min_delta_t_ns = dt_ns; - } - - double get_tag_integration_window_ns() { - return tag_integration_window_ns; - } - - void set_tag_integration_window_ns(double dt_ns) { - tag_integration_window_ns = dt_ns; - } - - int get_tpol_max_hits() { - return tpol_max_hits; - } - - void set_tpol_max_hits(int maxhits) { - tpol_max_hits = maxhits; - } - - double get_tpol_integration_window_ns() { - return tpol_integration_window_ns; - } - - void set_tpol_integration_window_ns(double dt_ns) { - tpol_integration_window_ns = dt_ns; - } - - int get_fmwpc_max_hits() { - return fmwpc_max_hits; - } - - void set_fmwpc_max_hits(int maxhits) { - fmwpc_max_hits = maxhits; - } - - double get_fmwpc_min_delta_t_ns() { - return fmwpc_min_delta_t_ns; - } -} - -hddm_s::HDDM &operator+=(hddm_s::HDDM &dst, hddm_s::HDDM &src) -{ - dst.getPhysicsEvents() += src.getPhysicsEvents(); - return dst; -} - -hddm_s::PhysicsEventList &operator+=(hddm_s::PhysicsEventList &dst, - hddm_s::PhysicsEventList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::PhysicsEventList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getHitViews() += iter->getHitViews(); - } - return dst; -} - -hddm_s::HitViewList &operator+=(hddm_s::HitViewList &dst, - hddm_s::HitViewList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::HitViewList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getCentralDCs() += iter->getCentralDCs(); - dst(0).getForwardDCs() += iter->getForwardDCs(); - dst(0).getStartCntrs() += iter->getStartCntrs(); - dst(0).getBarrelEMcals() += iter->getBarrelEMcals(); - dst(0).getForwardEMcals() += iter->getForwardEMcals(); - dst(0).getForwardTOFs() += iter->getForwardTOFs(); - dst(0).getComptonEMcals() += iter->getComptonEMcals(); - dst(0).getTaggers() += iter->getTaggers(); - dst(0).getPairSpectrometerFines() += iter->getPairSpectrometerFines(); - dst(0).getPairSpectrometerCoarses() += iter->getPairSpectrometerCoarses(); - dst(0).getTripletPolarimeters() += iter->getTripletPolarimeters(); - dst(0).getForwardMWPCs() += iter->getForwardMWPCs(); - } - return dst; -} - -hddm_s::CentralDCList &operator+=(hddm_s::CentralDCList &dst, - hddm_s::CentralDCList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::CentralDCList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getCdcStraws() += iter->getCdcStraws(); - } - return dst; -} - -hddm_s::CdcStrawList &operator+=(hddm_s::CdcStrawList &dst, - hddm_s::CdcStrawList &src) -{ - // order first by ring, then straw - int iord = 0; - hddm_s::CdcStrawList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int ring = iter->getRing(); - int straw = iter->getStraw(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getRing() > ring || - (dst(iord).getRing() == ring && dst(iord).getStraw() > straw)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getRing() < ring || - (dst(iord).getRing() == ring && dst(iord).getStraw() < straw)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getRing() != ring || - dst(iord).getStraw() != straw) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setRing(ring); - dst(iord).setStraw(straw); - } - dst(iord).getCdcStrawHits() += iter->getCdcStrawHits(); - } - return dst; -} - -hddm_s::CdcStrawHitList &operator+=(hddm_s::CdcStrawHitList &dst, - hddm_s::CdcStrawHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::CdcStrawHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = cdc_integration_window_ns; - double dt = ti + 2*fadc125_period_ns; - double newQ = iter->getQ(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldQ = dst(iord - 1).getQ(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setQ(oldQ + newQ * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldQ = dst(iord).getQ(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setQ(newQ + oldQ * pulse_fraction); - else - dst(iord).setQ(newQ); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setQ(newQ); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::ForwardDCList &operator+=(hddm_s::ForwardDCList &dst, - hddm_s::ForwardDCList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::ForwardDCList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getFdcChambers() += iter->getFdcChambers(); - } - return dst; -} - -hddm_s::FdcChamberList &operator+=(hddm_s::FdcChamberList &dst, - hddm_s::FdcChamberList &src) -{ - // order first by module, then layer - int iord = 0; - hddm_s::FdcChamberList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int layer = iter->getLayer(); - int module = iter->getModule(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getModule() > module || - (dst(iord).getModule() == module && dst(iord).getLayer() > layer)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getModule() < module || - (dst(iord).getModule() == module && dst(iord).getLayer() < layer)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getModule() != module || - dst(iord).getLayer() != layer) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setModule(module); - dst(iord).setLayer(layer); - } - dst(iord).getFdcAnodeWires() += iter->getFdcAnodeWires(); - dst(iord).getFdcCathodeStrips() += iter->getFdcCathodeStrips(); - } - return dst; -} - -hddm_s::FdcAnodeWireList &operator+=(hddm_s::FdcAnodeWireList &dst, - hddm_s::FdcAnodeWireList &src) -{ - // order by anode wire - int iord = 0; - hddm_s::FdcAnodeWireList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int wire = iter->getWire(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getWire() > wire) - --iord; - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getWire() < wire) - ++iord; - else - break; - } - if (iord == dst.size() || dst(iord).getWire() != wire) { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setWire(wire); - } - dst(iord).getFdcAnodeHits() += iter->getFdcAnodeHits(); - } - return dst; -} - -hddm_s::FdcAnodeHitList &operator+=(hddm_s::FdcAnodeHitList &dst, - hddm_s::FdcAnodeHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::FdcAnodeHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double dt = fdc_wires_min_delta_t_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / dt; - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / dt; - dst(iord).setDE(newDE + oldDE * pulse_fraction); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::FdcCathodeStripList &operator+=(hddm_s::FdcCathodeStripList &dst, - hddm_s::FdcCathodeStripList &src) -{ - // order by plane, then cathode strip - int iord = 0; - hddm_s::FdcCathodeStripList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int plane = iter->getPlane(); - int strip = iter->getStrip(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getPlane() > plane || - (dst(iord).getPlane() == plane && dst(iord).getStrip() > strip)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getPlane() < plane || - (dst(iord).getPlane() == plane && dst(iord).getStrip() < strip)) - ++iord; - else - break; - } - if (iord == dst.size() || dst(iord).getPlane() != plane || - dst(iord).getStrip() != strip) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setPlane(plane); - dst(iord).setStrip(strip); - } - dst(iord).getFdcCathodeHits() += iter->getFdcCathodeHits(); - } - return dst; -} - -hddm_s::FdcCathodeHitList &operator+=(hddm_s::FdcCathodeHitList &dst, - hddm_s::FdcCathodeHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::FdcCathodeHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = fdc_strips_integration_window_ns; - double dt = ti + 2*fadc125_period_ns; - double newQ = iter->getQ(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldQ = dst(iord - 1).getQ(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setQ(oldQ + newQ * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldQ = dst(iord).getQ(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setQ(newQ + oldQ * pulse_fraction); - else - dst(iord).setQ(newQ); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setQ(newQ); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::StartCntrList &operator+=(hddm_s::StartCntrList &dst, - hddm_s::StartCntrList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::StartCntrList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getStcPaddles() += iter->getStcPaddles(); - } - return dst; -} - -hddm_s::StcPaddleList &operator+=(hddm_s::StcPaddleList &dst, - hddm_s::StcPaddleList &src) -{ - // order by sector index - int iord = 0; - hddm_s::StcPaddleList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int sector = iter->getSector(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getSector() > sector) - --iord; - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getSector() < sector) - ++iord; - else - break; - } - if (iord == dst.size() || dst(iord).getSector() != sector) { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setSector(sector); - } - dst(iord).getStcHits() += iter->getStcHits(); - } - return dst; -} - -hddm_s::StcHitList &operator+=(hddm_s::StcHitList &dst, - hddm_s::StcHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::StcHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = stc_integration_window_ns; - double dt = stc_min_delta_t_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setDE(newDE + oldDE * pulse_fraction); - else - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setT(t); - if (iord > 0 && t - dst(iord - 1).getT() < ti) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - dst(iord).setDE(0); - } - else if (iord < dst.size() - 1 && dst(iord + 1).getT() - t < ti) { - double oldDE = dst(iord + 1).getDE(); - double pulse_fraction = 1 - (dst(iord + 1).getT() - t) / ti; - dst(iord).setDE(newDE + oldDE * pulse_fraction); - dst(iord + 1).setDE(0); - } - else { - dst(iord).setDE(newDE); - } - } - } - return dst; -} - -hddm_s::BarrelEMcalList &operator+=(hddm_s::BarrelEMcalList &dst, - hddm_s::BarrelEMcalList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::BarrelEMcalList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getBcalCells() += iter->getBcalCells(); - } - return dst; -} - -hddm_s::BcalCellList &operator+=(hddm_s::BcalCellList &dst, - hddm_s::BcalCellList &src) -{ - // order by module, then layer, then sector - int iord = 0; - hddm_s::BcalCellList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int module = iter->getModule(); - int sector = iter->getSector(); - int layer = iter->getLayer(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getModule() > module || - (dst(iord).getModule() == module && dst(iord).getLayer() > layer) - || (dst(iord).getModule() == module && - dst(iord).getLayer() == layer && - dst(iord).getSector() > sector)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getModule() < module || - (dst(iord).getModule() == module && dst(iord).getLayer() < layer) - || (dst(iord).getModule() == module && - dst(iord).getLayer() == layer && - dst(iord).getSector() < sector)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || dst(iord).getModule() != module || - dst(iord).getLayer() != layer || - dst(iord).getSector() != sector) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setModule(module); - dst(iord).setLayer(layer); - dst(iord).setSector(sector); - } - dst(iord).getBcalfADCDigiHits() += iter->getBcalfADCDigiHits(); - dst(iord).getBcalTDCDigiHits() += iter->getBcalTDCDigiHits(); - dst(iord).getBcalfADCHits() += iter->getBcalfADCHits(); - dst(iord).getBcalTDCHits() += iter->getBcalTDCHits(); - } - return dst; -} - -hddm_s::BcalfADCHitList &operator+=(hddm_s::BcalfADCHitList &dst, - hddm_s::BcalfADCHitList &src) -{ - // order by end, t, merge with existing hit if close enough - int iord = 0; - hddm_s::BcalfADCHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = bcal_integration_window_ns; - double dt = ti + 2*fadc250_period_ns; - double newE = iter->getE(); - int end = iter->getEnd(); - while (iord > 0) { - if (iord == dst.size() || - dst(iord).getEnd() > end || dst(iord).getT() > t) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getEnd() < end || dst(iord).getT() < t) { - ++iord; - } - else - break; - } - if (iord > 0 && - dst(iord - 1).getEnd() == end && t - dst(iord - 1).getT() < dt) - { - double oldE = dst(iord - 1).getE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setE(oldE + newE * pulse_fraction); - } - else if (iord < dst.size() && - dst(iord).getEnd() == end && dst(iord).getT() - t < dt) - { - double oldE = dst(iord).getE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setE(newE + oldE * pulse_fraction); - else - dst(iord).setE(newE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setEnd(end); - dst(iord).setE(newE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::BcalTDCHitList &operator+=(hddm_s::BcalTDCHitList &dst, - hddm_s::BcalTDCHitList &src) -{ - // order by end, t, merge with existing hit if close enough - int iord = 0; - hddm_s::BcalTDCHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double dt = bcal_min_delta_t_ns; - int end = iter->getEnd(); - while (iord > 0) { - if (iord == dst.size() || - dst(iord).getEnd() > end || dst(iord).getT() > t) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getEnd() < end || dst(iord).getT() < t) { - ++iord; - } - else - break; - } - if (iord > 0 && - dst(iord - 1).getEnd() == end && t - dst(iord - 1).getT() < dt) - { - continue; - } - else if (iord < dst.size() && - dst(iord).getEnd() == end && dst(iord).getT() - t < dt) - { - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setEnd(end); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::BcalfADCDigiHitList &operator+=(hddm_s::BcalfADCDigiHitList &dst, - hddm_s::BcalfADCDigiHitList &src) -{ - // order by end, t, merge with existing hit if close enough - int iord = 0; - hddm_s::BcalfADCDigiHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getPulse_time() + t_shift_ns * bcal_fadc_counts_per_ns; - double ti = bcal_integration_window_ns * bcal_fadc_counts_per_ns; - double dt = ti + 2; - double newE = iter->getPulse_integral(); - int end = iter->getEnd(); - while (iord > 0) { - if (iord == dst.size() || - dst(iord).getEnd() > end || dst(iord).getPulse_time() > t) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getEnd() < end || dst(iord).getPulse_time() < t) { - ++iord; - } - else - break; - } - if (iord > 0 && dst(iord - 1).getEnd() == end && - t - dst(iord - 1).getPulse_time() < dt) - { - double oldE = dst(iord - 1).getPulse_integral(); - double pulse_fraction = 1 - (t - dst(iord - 1).getPulse_time()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setPulse_integral(oldE + newE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getEnd() == end && - dst(iord).getPulse_time() - t < dt) - { - double oldE = dst(iord).getPulse_integral(); - double pulse_fraction = 1 - (dst(iord).getPulse_time() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setPulse_integral(newE + oldE * pulse_fraction); - else - dst(iord).setPulse_integral(newE); - dst(iord).setPulse_time(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setEnd(end); - dst(iord).setPulse_integral(newE); - dst(iord).setPulse_time(t); - } - } - return dst; -} - -hddm_s::BcalTDCDigiHitList &operator+=(hddm_s::BcalTDCDigiHitList &dst, - hddm_s::BcalTDCDigiHitList &src) -{ - // order by end, t, merge with existing hit if dt < dtmin - int iord = 0; - hddm_s::BcalTDCDigiHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getTime() + t_shift_ns * bcal_tdc_counts_per_ns; - double dt = bcal_min_delta_t_ns * bcal_tdc_counts_per_ns; - int end = iter->getEnd(); - while (iord > 0) { - if (iord == dst.size() || - dst(iord).getEnd() > end || dst(iord).getTime() > t) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getEnd() < end || dst(iord).getTime() < t) { - ++iord; - } - else - break; - } - if (iord > 0 && - dst(iord - 1).getEnd() == end && t - dst(iord - 1).getTime() < dt) - { - continue; - } - else if (iord < dst.size() && - dst(iord).getEnd() == end && dst(iord).getTime() - t < dt) - { - dst(iord).setTime(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setEnd(end); - dst(iord).setTime(t); - } - } - return dst; -} - -hddm_s::ForwardTOFList &operator+=(hddm_s::ForwardTOFList &dst, - hddm_s::ForwardTOFList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::ForwardTOFList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getFtofCounters() += iter->getFtofCounters(); - } - return dst; -} - -hddm_s::FtofCounterList &operator+=(hddm_s::FtofCounterList &dst, - hddm_s::FtofCounterList &src) -{ - // order first by plane, then bar - int iord = 0; - hddm_s::FtofCounterList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int bar = iter->getBar(); - int plane = iter->getPlane(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getPlane() > plane || - (dst(iord).getPlane() == plane && dst(iord).getBar() > bar)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getPlane() < plane || - (dst(iord).getPlane() == plane && dst(iord).getBar() < bar)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getPlane() != plane || - dst(iord).getBar() != bar) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setPlane(plane); - dst(iord).setBar(bar); - } - dst(iord).getFtofHits() += iter->getFtofHits(); - } - return dst; -} - -hddm_s::FtofHitList &operator+=(hddm_s::FtofHitList &dst, - hddm_s::FtofHitList &src) -{ - // order by end, t, merge with existing hit if close enough - int iord = 0; - hddm_s::FtofHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = ftof_integration_window_ns; - double dt = ftof_min_delta_t_ns; - double newDE = iter->getDE(); - int end = iter->getEnd(); - while (iord > 0) { - if (iord == dst.size() || - dst(iord).getEnd() > end || dst(iord).getT() > t) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getEnd() < end || dst(iord).getT() < t) { - ++iord; - } - else - break; - } - if (iord > 0 && - dst(iord - 1).getEnd() == end && t - dst(iord - 1).getT() < dt) - { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && - dst(iord).getEnd() == end && dst(iord).getT() - t < dt) - { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setDE(newDE + oldDE * pulse_fraction); - else - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setEnd(end); - if (iord > 0 && dst(iord - 1).getEnd() == end && - t - dst(iord - 1).getT() < ti) - { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - dst(iord).setDE(0); - } - else if (iord < dst.size() - 1 && dst(iord + 1).getEnd() == end && - dst(iord + 1).getT() - t < ti) - { - double oldDE = dst(iord + 1).getDE(); - double pulse_fraction = 1 - (dst(iord + 1).getT() - t) / ti; - dst(iord).setDE(newDE + oldDE * pulse_fraction); - dst(iord + 1).setDE(0); - } - else { - dst(iord).setDE(newDE); - } - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::ForwardEMcalList &operator+=(hddm_s::ForwardEMcalList &dst, - hddm_s::ForwardEMcalList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::ForwardEMcalList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getFcalBlocks() += iter->getFcalBlocks(); - } - return dst; -} - -hddm_s::FcalBlockList &operator+=(hddm_s::FcalBlockList &dst, - hddm_s::FcalBlockList &src) -{ - // order first by column, then row - int iord = 0; - hddm_s::FcalBlockList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int row = iter->getRow(); - int column = iter->getColumn(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getColumn() > column || - (dst(iord).getColumn() == column && dst(iord).getRow() > row)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getColumn() < column || - (dst(iord).getColumn() == column && dst(iord).getRow() < row)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getColumn() != column || - dst(iord).getRow() != row) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setColumn(column); - dst(iord).setRow(row); - } - dst(iord).getFcalHits() += iter->getFcalHits(); - } - return dst; -} - -hddm_s::FcalHitList &operator+=(hddm_s::FcalHitList &dst, - hddm_s::FcalHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::FcalHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = fcal_integration_window_ns; - double dt = ti + 2*fadc250_period_ns; - double newE = iter->getE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldE = dst(iord - 1).getE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setE(oldE + newE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldE = dst(iord).getE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setE(newE + oldE * pulse_fraction); - else - dst(iord).setE(newE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setE(newE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::ComptonEMcalList &operator+=(hddm_s::ComptonEMcalList &dst, - hddm_s::ComptonEMcalList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::ComptonEMcalList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getCcalBlocks() += iter->getCcalBlocks(); - } - return dst; -} - -hddm_s::CcalBlockList &operator+=(hddm_s::CcalBlockList &dst, - hddm_s::CcalBlockList &src) -{ - // order first by column, then row - int iord = 0; - hddm_s::CcalBlockList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int row = iter->getRow(); - int column = iter->getColumn(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getColumn() > column || - (dst(iord).getColumn() == column && dst(iord).getRow() > row)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getColumn() < column || - (dst(iord).getColumn() == column && dst(iord).getRow() < row)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getColumn() != column || - dst(iord).getRow() != row) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setColumn(column); - dst(iord).setRow(row); - } - dst(iord).getCcalHits() += iter->getCcalHits(); - } - return dst; -} - -hddm_s::CcalHitList &operator+=(hddm_s::CcalHitList &dst, - hddm_s::CcalHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::CcalHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = ccal_integration_window_ns; - double dt = ti + 2*fadc250_period_ns; - double newE = iter->getE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldE = dst(iord - 1).getE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setE(oldE + newE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldE = dst(iord).getE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setE(newE + oldE * pulse_fraction); - else - dst(iord).setE(newE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setE(newE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::TaggerList &operator+=(hddm_s::TaggerList &dst, - hddm_s::TaggerList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::TaggerList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getMicroChannels() += iter->getMicroChannels(); - dst(0).getHodoChannels() += iter->getHodoChannels(); - } - return dst; -} - -hddm_s::MicroChannelList &operator+=(hddm_s::MicroChannelList &dst, - hddm_s::MicroChannelList &src) -{ - // order by column, row index - int iord = 0; - hddm_s::MicroChannelList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int column = iter->getColumn(); - int row = iter->getRow(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getColumn() > column || - (dst(iord).getColumn() == column && dst(iord).getRow() > row)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getColumn() < column || - (dst(iord).getColumn() == column && dst(iord).getRow() < row)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || dst(iord).getColumn() != column || - dst(iord).getRow() != row) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setColumn(column); - dst(iord).setRow(row); - dst(iord).setE(iter->getE()); - } - dst(iord).getTaggerHits() += iter->getTaggerHits(); - } - return dst; -} - -hddm_s::HodoChannelList &operator+=(hddm_s::HodoChannelList &dst, - hddm_s::HodoChannelList &src) -{ - // order by counter index - int iord = 0; - hddm_s::HodoChannelList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int cid = iter->getCounterId(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getCounterId() > cid) - --iord; - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getCounterId() < cid) - ++iord; - else - break; - } - if (iord == dst.size() || dst(iord).getCounterId() != cid) { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setCounterId(cid); - dst(iord).setE(iter->getE()); - } - dst(iord).getTaggerHits() += iter->getTaggerHits(); - } - return dst; -} - -hddm_s::TaggerHitList &operator+=(hddm_s::TaggerHitList &dst, - hddm_s::TaggerHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::TaggerHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = tag_integration_window_ns; - double dt = tag_min_delta_t_ns; - double newNpe = iter->getNpe(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldNpe = dst(iord - 1).getNpe(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setNpe(oldNpe + newNpe * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldNpe = dst(iord).getNpe(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setNpe(newNpe + oldNpe * pulse_fraction); - else - dst(iord).setNpe(newNpe); - dst(iord).setTADC(iter->getTADC()); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - if (iord > 0 && t - dst(iord - 1).getT() < ti) { - double oldNpe = dst(iord - 1).getNpe(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - dst(iord - 1).setNpe(oldNpe + newNpe * pulse_fraction); - dst(iord).setNpe(0); - } - else if (iord < dst.size() - 1 && dst(iord + 1).getT() - t < ti) { - double oldNpe = dst(iord + 1).getNpe(); - double pulse_fraction = 1 - (dst(iord + 1).getT() - t) / ti; - dst(iord).setNpe(newNpe + oldNpe * pulse_fraction); - dst(iord + 1).setNpe(0); - } - else { - dst(iord).setNpe(newNpe); - } - dst(iord).setTADC(iter->getTADC()); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::PairSpectrometerFineList &operator+=( - hddm_s::PairSpectrometerFineList &dst, - hddm_s::PairSpectrometerFineList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::PairSpectrometerFineList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getPsTiles() += iter->getPsTiles(); - } - return dst; -} - -hddm_s::PsTileList &operator+=(hddm_s::PsTileList &dst, - hddm_s::PsTileList &src) -{ - // order first by arm, then column - int iord = 0; - hddm_s::PsTileList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int column = iter->getColumn(); - int arm = iter->getArm(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getArm() > arm || - (dst(iord).getArm() == arm && dst(iord).getColumn() > column)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getArm() < arm || - (dst(iord).getArm() == arm && dst(iord).getColumn() < column)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getArm() != arm || - dst(iord).getColumn() != column) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setArm(arm); - dst(iord).setColumn(column); - } - dst(iord).getPsHits() += iter->getPsHits(); - } - return dst; -} - -hddm_s::PsHitList &operator+=(hddm_s::PsHitList &dst, - hddm_s::PsHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::PsHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = ps_integration_window_ns; - double dt = ti + 2*fadc250_period_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setDE(newDE + oldDE * pulse_fraction); - else - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::PairSpectrometerCoarseList &operator+=( - hddm_s::PairSpectrometerCoarseList &dst, - hddm_s::PairSpectrometerCoarseList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::PairSpectrometerCoarseList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getPscPaddles() += iter->getPscPaddles(); - } - return dst; -} - -hddm_s::PscPaddleList &operator+=(hddm_s::PscPaddleList &dst, - hddm_s::PscPaddleList &src) -{ - // order first by arm, then module - int iord = 0; - hddm_s::PscPaddleList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int module = iter->getModule(); - int arm = iter->getArm(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getArm() > arm || - (dst(iord).getArm() == arm && dst(iord).getModule() > module)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getArm() < arm || - (dst(iord).getArm() == arm && dst(iord).getModule() < module)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getArm() != arm || - dst(iord).getModule() != module) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setArm(arm); - dst(iord).setModule(module); - } - dst(iord).getPscHits() += iter->getPscHits(); - } - return dst; -} - -hddm_s::PscHitList &operator+=(hddm_s::PscHitList &dst, - hddm_s::PscHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::PscHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = psc_integration_window_ns; - double dt = psc_min_delta_t_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setDE(newDE + oldDE * pulse_fraction); - else - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - if (iord > 0 && t - dst(iord - 1).getT() < ti) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - dst(iord).setDE(0); - } - else if (iord < dst.size() - 1 && dst(iord + 1).getT() - t < ti) { - double oldDE = dst(iord + 1).getDE(); - double pulse_fraction = 1 - (dst(iord + 1).getT() - t) / ti; - dst(iord).setDE(newDE + oldDE * pulse_fraction); - dst(iord + 1).setDE(0); - } - else { - dst(iord).setDE(newDE); - } - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::TripletPolarimeterList &operator+=( - hddm_s::TripletPolarimeterList &dst, - hddm_s::TripletPolarimeterList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::TripletPolarimeterList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getTpolSectors() += iter->getTpolSectors(); - } - return dst; -} - -hddm_s::TpolSectorList &operator+=(hddm_s::TpolSectorList &dst, - hddm_s::TpolSectorList &src) -{ - // order by sector index - int iord = 0; - hddm_s::TpolSectorList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int sector = iter->getSector(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getSector() > sector) - --iord; - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getSector() < sector) - ++iord; - else - break; - } - if (iord == dst.size() || dst(iord).getSector() != sector) { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setSector(sector); - } - dst(iord).getTpolHits() += iter->getTpolHits(); - } - return dst; -} - -hddm_s::TpolHitList &operator+=(hddm_s::TpolHitList &dst, - hddm_s::TpolHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::TpolHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double ti = tpol_integration_window_ns; - double dt = ti + 2*fadc250_period_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / ti; - if (pulse_fraction > 0) - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / ti; - if (pulse_fraction > 0) - dst(iord).setDE(newDE + oldDE * pulse_fraction); - else - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - } - return dst; -} - -hddm_s::ForwardMWPCList &operator+=(hddm_s::ForwardMWPCList &dst, - hddm_s::ForwardMWPCList &src) -{ - if (src.size() > 0 && dst.size() == 0) - dst.add(1); - hddm_s::ForwardMWPCList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - dst(0).getFmwpcChambers() += iter->getFmwpcChambers(); - } - return dst; -} - -hddm_s::FmwpcChamberList &operator+=(hddm_s::FmwpcChamberList &dst, - hddm_s::FmwpcChamberList &src) -{ - // order first by layer, then wire - int iord = 0; - hddm_s::FmwpcChamberList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - int layer = iter->getLayer(); - int wire = iter->getWire(); - while (iord > 0) { - if (iord == dst.size() || dst(iord).getLayer() > layer || - (dst(iord).getLayer() == layer && dst(iord).getWire() > wire)) - { - --iord; - } - else - break; - } - while (iord < dst.size()) { - if (dst(iord).getLayer() < layer || - (dst(iord).getLayer() == layer && dst(iord).getWire() < wire)) - { - ++iord; - } - else - break; - } - if (iord == dst.size() || - dst(iord).getLayer() != layer || - dst(iord).getWire() != wire) - { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setLayer(layer); - dst(iord).setWire(wire); - } - dst(iord).getFmwpcHits() += iter->getFmwpcHits(); - } - return dst; -} - -hddm_s::FmwpcHitList &operator+=(hddm_s::FmwpcHitList &dst, - hddm_s::FmwpcHitList &src) -{ - // order by t, merge with existing hit if close enough - int iord = 0; - hddm_s::FmwpcHitList::iterator iter; - for (iter = src.begin(); iter != src.end(); ++iter) { - double t = iter->getT() + t_shift_ns; - double dt = fmwpc_min_delta_t_ns; - double newDE = iter->getDE(); - while (iord > 0 && dst(iord).getT() > t) - --iord; - while (iord < dst.size() && dst(iord).getT() < t) - ++iord; - if (iord > 0 && t - dst(iord - 1).getT() < dt) { - double oldDE = dst(iord - 1).getDE(); - double pulse_fraction = 1 - (t - dst(iord - 1).getT()) / dt; - dst(iord - 1).setDE(oldDE + newDE * pulse_fraction); - } - else if (iord < dst.size() && dst(iord).getT() - t < dt) { - double oldDE = dst(iord).getDE(); - double pulse_fraction = 1 - (dst(iord).getT() - t) / dt; - dst(iord).setDE(newDE + oldDE * pulse_fraction); - dst(iord).setT(t); - } - else { - dst.add(1, (iord < dst.size())? iord : -1); - dst(iord).setDE(newDE); - dst(iord).setT(t); - } - } - return dst; -} - -void hddm_s_merger::truncate_hits(hddm_s::HDDM &record) { - hddm_s::CdcStrawList straws = record.getCdcStraws(); - hddm_s::CdcStrawList::iterator istraw; - for (istraw = straws.begin(); istraw != straws.end(); ++istraw) { - truncate_cdc_hits(istraw->getCdcStrawHits()); - } - - hddm_s::FdcAnodeWireList wires = record.getFdcAnodeWires(); - hddm_s::FdcAnodeWireList::iterator iwire; - for (iwire = wires.begin(); iwire != wires.end(); ++iwire) { - truncate_fdc_wire_hits(iwire->getFdcAnodeHits()); - } - hddm_s::FdcCathodeStripList strips = record.getFdcCathodeStrips(); - hddm_s::FdcCathodeStripList::iterator istrip; - for (istrip = strips.begin(); istrip != strips.end(); ++istrip) { - truncate_fdc_strip_hits(istrip->getFdcCathodeHits()); - } - - hddm_s::StcPaddleList paddles = record.getStcPaddles(); - hddm_s::StcPaddleList::iterator ipad; - for (ipad = paddles.begin(); ipad != paddles.end(); ++ipad) { - truncate_stc_hits(ipad->getStcHits()); - } - - hddm_s::BcalCellList cells = record.getBcalCells(); - hddm_s::BcalCellList::iterator icell; - for (icell = cells.begin(); icell != cells.end(); ++icell) { - truncate_bcal_adc_hits(icell->getBcalfADCHits()); - truncate_bcal_tdc_hits(icell->getBcalTDCHits()); - truncate_bcal_adc_digihits(icell->getBcalfADCDigiHits()); - truncate_bcal_tdc_digihits(icell->getBcalTDCDigiHits()); - } - - hddm_s::FtofCounterList counters = record.getFtofCounters(); - hddm_s::FtofCounterList::iterator icntr; - for (icntr = counters.begin(); icntr != counters.end(); ++icntr) { - truncate_ftof_hits(icntr->getFtofHits()); - } - - hddm_s::FcalBlockList blocks = record.getFcalBlocks(); - hddm_s::FcalBlockList::iterator iblock; - for (iblock = blocks.begin(); iblock != blocks.end(); ++iblock) { - truncate_fcal_hits(iblock->getFcalHits()); - } - - hddm_s::CcalBlockList modules = record.getCcalBlocks(); - hddm_s::CcalBlockList::iterator imod; - for (imod = modules.begin(); imod != modules.end(); ++imod) { - truncate_ccal_hits(imod->getCcalHits()); - } - - hddm_s::MicroChannelList columns = record.getMicroChannels(); - hddm_s::MicroChannelList::iterator icol; - for (icol = columns.begin(); icol != columns.end(); ++icol) { - truncate_tag_hits(icol->getTaggerHits()); - } - hddm_s::HodoChannelList channels = record.getHodoChannels(); - hddm_s::HodoChannelList::iterator ichan; - for (ichan = channels.begin(); ichan != channels.end(); ++ichan) { - truncate_tag_hits(ichan->getTaggerHits()); - } - - hddm_s::PsTileList tiles = record.getPsTiles(); - hddm_s::PsTileList::iterator itile; - for (itile = tiles.begin(); itile != tiles.end(); ++itile) { - truncate_ps_hits(itile->getPsHits()); - } - hddm_s::PscPaddleList bricks = record.getPscPaddles(); - hddm_s::PscPaddleList::iterator ibrick; - for (ibrick = bricks.begin(); ibrick != bricks.end(); ++ibrick) { - truncate_psc_hits(ibrick->getPscHits()); - } - - hddm_s::TpolSectorList sectors = record.getTpolSectors(); - hddm_s::TpolSectorList::iterator isector; - for (isector = sectors.begin(); isector != sectors.end(); ++isector) { - truncate_tpol_hits(isector->getTpolHits()); - } - - hddm_s::FmwpcChamberList chambers = record.getFmwpcChambers(); - hddm_s::FmwpcChamberList::iterator ichamber; - for (ichamber = chambers.begin(); ichamber != chambers.end(); ++ichamber) { - truncate_fmwpc_hits(ichamber->getFmwpcHits()); - } -} - -void hddm_s_merger::truncate_cdc_hits(hddm_s::CdcStrawHitList &hits) { - if (hits.size() > cdc_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d cdc hits, truncating to %d\n", hits.size(), cdc_max_hits); -#endif - hits.del(-1, cdc_max_hits); - } -} - -void hddm_s_merger::truncate_fdc_wire_hits(hddm_s::FdcAnodeHitList &hits) { - if (hits.size() > fdc_wires_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d fdc wire hits, truncating to %d\n", hits.size(), fdc_wires_max_hits); -#endif - hits.del(-1, fdc_wires_max_hits); - } -} - -void hddm_s_merger::truncate_fdc_strip_hits(hddm_s::FdcCathodeHitList &hits) { - if (hits.size() > fdc_strips_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d fdc strip hits, truncating to %d\n", hits.size(), fdc_strips_max_hits); -#endif - hits.del(-1, fdc_strips_max_hits); - } -} - -void hddm_s_merger::truncate_stc_hits(hddm_s::StcHitList &hits) { - if (hits.size() > stc_tdc_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d stc tdc hits, truncating to %d\n", hits.size(), stc_tdc_max_hits); -#endif - hits.del(-1, stc_tdc_max_hits); - } - if (hits.size() > stc_adc_max_hits) { - int nadc=0; - hddm_s::StcHitList::iterator iter; - for (iter = hits.begin(); iter != hits.end(); ++iter) { - if (iter->getDE() > 0) - if (++nadc > stc_adc_max_hits) - iter->setDE(0); - } -#if VERBOSE_TRUNCATION - if (nadc > stc_adc_max_hits) - printf("found %d stc adc hits, truncating to %d\n", nadc, stc_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_bcal_adc_hits(hddm_s::BcalfADCHitList &hits) { - int nadc[2] = {0,0}; - if (hits.size() > bcal_adc_max_hits) { - hddm_s::BcalfADCHitList::iterator iter; - int n=0; - for (iter = hits.begin(); iter != hits.end(); ++iter, ++n) { - if (++nadc[iter->getEnd()] > bcal_adc_max_hits) { - --iter; - hits.del(1, n--); - } - } -#if VERBOSE_TRUNCATION - if (nadc[0] > bcal_adc_max_hits) - printf("found %d bcal adc end=0 hits, truncating to %d\n", nadc[0], bcal_adc_max_hits); - if (nadc[1] > bcal_adc_max_hits) - printf("found %d bcal adc end=1 hits, truncating to %d\n", nadc[1], bcal_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_bcal_tdc_hits(hddm_s::BcalTDCHitList &hits) { - int ntdc[2] = {0,0}; - if (hits.size() > bcal_tdc_max_hits) { - hddm_s::BcalTDCHitList::iterator iter; - int n=0; - for (iter = hits.begin(); iter != hits.end(); ++iter, ++n) { - if (++ntdc[iter->getEnd()] > bcal_tdc_max_hits) { - --iter; - hits.del(1, n--); - } - } -#if VERBOSE_TRUNCATION - if (ntdc[0] > bcal_tdc_max_hits) - printf("found %d bcal tdc end=0 hits, truncating to %d\n", ntdc[0], bcal_adc_max_hits); - if (ntdc[1] > bcal_tdc_max_hits) - printf("found %d bcal tdc end=1 hits, truncating to %d\n", ntdc[1], bcal_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_bcal_adc_digihits(hddm_s::BcalfADCDigiHitList &hits) { - int nadc[2] = {0,0}; - if (hits.size() > bcal_adc_max_hits) { - hddm_s::BcalfADCDigiHitList::iterator iter; - int n=0; - for (iter = hits.begin(); iter != hits.end(); ++iter, ++n) { - if (++nadc[iter->getEnd()] > bcal_adc_max_hits) { - --iter; - hits.del(1, n--); - } - } -#if VERBOSE_TRUNCATION - if (nadc[0] > bcal_adc_max_hits) - printf("found %d bcal adc end=0 digihits, truncating to %d\n", nadc[0], bcal_adc_max_hits); - if (nadc[1] > bcal_adc_max_hits) - printf("found %d bcal adc end=1 digihits, truncating to %d\n", nadc[1], bcal_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_bcal_tdc_digihits(hddm_s::BcalTDCDigiHitList &hits) { - int ntdc[2] = {0,0}; - if (hits.size() > bcal_tdc_max_hits) { - hddm_s::BcalTDCDigiHitList::iterator iter; - int n=0; - for (iter = hits.begin(); iter != hits.end(); ++iter, ++n) { - if (++ntdc[iter->getEnd()] > bcal_tdc_max_hits) { - --iter; - hits.del(1, n--); - } - } -#if VERBOSE_TRUNCATION - if (ntdc[0] > bcal_tdc_max_hits) - printf("found %d bcal tdc end=0 digihits, truncating to %d\n", ntdc[0], bcal_tdc_max_hits); - if (ntdc[1] > bcal_tdc_max_hits) - printf("found %d bcal tdc end=1 digihits, truncating to %d\n", ntdc[1], bcal_tdc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_ftof_hits(hddm_s::FtofHitList &hits) { - int nadc[2] = {0,0}; - int ntdc[2] = {0,0}; - hddm_s::FtofHitList::iterator iter; - int n=0; - for (iter = hits.begin(); iter != hits.end(); ++iter, ++n) { - if (++ntdc[iter->getEnd()] > ftof_tdc_max_hits) { - --iter; - hits.del(1, n--); - } - else if (iter->getDE() > 0 && ++nadc[iter->getEnd()] > ftof_adc_max_hits) { - iter->setDE(0); - } - } -#if VERBOSE_TRUNCATION - if (ntdc[0] > ftof_tdc_max_hits) - printf("found %d ftof tdc end=0 hits, truncating to %d\n", ntdc[0], ftof_tdc_max_hits); - if (ntdc[1] > ftof_tdc_max_hits) - printf("found %d ftof tdc end=1 hits, truncating to %d\n", ntdc[1], ftof_tdc_max_hits); - if (nadc[0] > ftof_adc_max_hits) - printf("found %d ftof adc end=0 hits, truncating to %d\n", nadc[0], ftof_adc_max_hits); - if (nadc[1] > ftof_adc_max_hits) - printf("found %d ftof adc end=1 hits, truncating to %d\n", nadc[1], ftof_adc_max_hits); -#endif -} - -void hddm_s_merger::truncate_fcal_hits(hddm_s::FcalHitList &hits) { - if (hits.size() > fcal_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d fcal hits, truncating to %d\n", hits.size(), fcal_max_hits); -#endif - hits.del(-1, fcal_max_hits); - } -} - -void hddm_s_merger::truncate_ccal_hits(hddm_s::CcalHitList &hits) { - if (hits.size() > ccal_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d ccal hits, truncating to %d\n", hits.size(), ccal_max_hits); -#endif - hits.del(-1, ccal_max_hits); - } -} - -void hddm_s_merger::truncate_tag_hits(hddm_s::TaggerHitList &hits) { - if (hits.size() > tag_tdc_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d tag tdc hits, truncating to %d\n", hits.size(), tag_tdc_max_hits); -#endif - hits.del(-1, tag_tdc_max_hits); - } - if (hits.size() > tag_adc_max_hits) { - int nadc=0; - hddm_s::TaggerHitList::iterator iter; - for (iter = hits.begin(); iter != hits.end(); ++iter) { - if (iter->getNpe() > 0) - if (++nadc > tag_adc_max_hits) - iter->setNpe(0); - } -#if VERBOSE_TRUNCATION - printf("found %d tag adc hits, truncating to %d\n", hits.size(), tag_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_ps_hits(hddm_s::PsHitList &hits) { - if (hits.size() > ps_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d ps hits, truncating to %d\n", hits.size(), ps_max_hits); -#endif - hits.del(-1, ps_max_hits); - } -} - -void hddm_s_merger::truncate_psc_hits(hddm_s::PscHitList &hits) { - if (hits.size() > psc_tdc_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d psc hits, truncating to %d\n", hits.size(), psc_tdc_max_hits); -#endif - hits.del(-1, psc_tdc_max_hits); - } - if (hits.size() > psc_adc_max_hits) { - int nadc=0; - hddm_s::PscHitList::iterator iter; - for (iter = hits.begin(); iter != hits.end(); ++iter) { - if (iter->getDE() > 0) - if (++nadc > psc_adc_max_hits) - iter->setDE(0); - } -#if VERBOSE_TRUNCATION - printf("found %d psc hits, truncating to %d\n", nadc, psc_adc_max_hits); -#endif - } -} - -void hddm_s_merger::truncate_tpol_hits(hddm_s::TpolHitList &hits) { - if (hits.size() > tpol_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d tpol hits, truncating to %d\n", hits.size(), tpol_max_hits); -#endif - hits.del(-1, tpol_max_hits); - } -} - -void hddm_s_merger::truncate_fmwpc_hits(hddm_s::FmwpcHitList &hits) { - if (hits.size() > fmwpc_max_hits) { -#if VERBOSE_TRUNCATION - printf("found %d fmwpc hits, truncating to %d\n", hits.size(), fmwpc_max_hits); -#endif - hits.del(-1, fmwpc_max_hits); - } -} diff --git a/src/programs/Simulation/mcsmear/hddm_s_merger.h b/src/programs/Simulation/mcsmear/hddm_s_merger.h deleted file mode 100644 index 9d5d65697a..0000000000 --- a/src/programs/Simulation/mcsmear/hddm_s_merger.h +++ /dev/null @@ -1,233 +0,0 @@ -// -// hddm_s_merger.h - Utility class for merging hits from two hddm_s element lists -// -// author: richard.t.jones at uconn.edu -// version: march 20, 2017 - -#ifndef _HDDM_S_MERGER_H_ -#define _HDDM_S_MERGER_H_ - -#include - -namespace hddm_s_merger { - double get_t_shift_ns(); - void set_t_shift_ns(double dt_ns); - - // hits merging / truncation parameters for the CDC - int get_cdc_max_hits(); - void set_cdc_max_hits(int maxhits); - double get_cdc_integration_window_ns(); - void set_cdc_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the FDC - int get_fdc_wires_max_hits(); - void set_fdc_wires_max_hits(int maxhits); - double get_fdc_wires_min_delta_t_ns(); - void set_fdc_wires_min_delta_t_ns(double dt_ns); - int get_fdc_strips_max_hits(); - void set_fdc_strips_max_hits(int maxhits); - double get_fdc_strips_integraton_window_ns(); - void set_fdc_strips_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the STC - int get_stc_adc_max_hits(); - void set_stc_adc_max_hits(int maxhits); - int get_stc_tdc_max_hits(); - void set_stc_tdc_max_hits(int maxhits); - double get_stc_min_delta_t_ns(); - void set_stc_min_delta_t_ns(double dt_ns); - double get_stc_integration_window_ns(); - void set_stc_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the BCAL - int get_bcal_adc_max_hits(); - void set_bcal_adc_max_hits(int maxhits); - int get_bcal_tdc_max_hits(); - void set_bcal_tdc_max_hits(int maxhits); - double get_bcal_min_delta_t_ns(); - void set_bcal_min_delta_t_ns(double dt_ns); - double get_bcal_integration_window_ns(); - void set_bcal_integration_window_ns(double dt_ns); - double get_bcal_fadc_counts_per_ns(); - void set_bcal_fadc_counts_per_ns(double slope); - double get_bcal_tdc_counts_per_ns(); - void set_bcal_tdc_counts_per_ns(double slope); - - // hits merging / truncation parameters for the TOF - int get_ftof_adc_max_hits(); - void set_ftof_adc_max_hits(int maxhits); - int get_ftof_tdc_max_hits(); - void set_ftof_tdc_max_hits(int maxhits); - double get_ftof_min_delta_t_ns(); - void set_ftof_min_delta_t_ns(double dt_ns); - double get_ftof_integration_window_ns(); - void set_ftof_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the FCAL - int get_fcal_max_hits(); - void set_fcal_max_hits(int maxhits); - double get_fcal_min_delta_t_ns(); - void set_fcal_min_delta_t_ns(double dt_ns); - double get_fcal_integration_window_ns(); - void set_fcal_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the CCAL - int get_ccal_max_hits(); - void set_ccal_max_hits(int maxhits); - double get_ccal_min_delta_t_ns(); - void set_ccal_min_delta_t_ns(double dt_ns); - double get_ccal_integration_window_ns(); - void set_ccal_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the PS - int get_ps_max_hits(); - void set_ps_max_hits(int maxhits); - double get_ps_integration_window_ns(); - void set_ps_integration_window_ns(double dt_ns); - int get_psc_adc_max_hits(); - void set_psc_adc_max_hits(int maxhits); - int get_psc_tdc_max_hits(); - void set_psc_tdc_max_hits(int maxhits); - double get_psc_min_delta_t_ns(); - void set_psc_min_delta_t_ns(double dt_ns); - double get_psc_integration_window_ns(); - void set_psc_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the TAGM/TAGH - int get_tag_adc_max_hits(); - void set_tag_adc_max_hits(int maxhits); - int get_tag_tdc_max_hits(); - void set_tag_tdc_max_hits(int maxhits); - double get_tag_min_delta_t_ns(); - void set_tag_min_delta_t_ns(double dt_ns); - double get_tag_integration_window_ns(); - void set_tag_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the TPOL - int get_tpol_max_hits(); - void set_tpol_max_hits(int maxhits); - double get_tpol_integration_window_ns(); - void set_tpol_integration_window_ns(double dt_ns); - - // hits merging / truncation parameters for the FWMPC - int get_fmwpc_max_hits(); - void set_fmwpc_max_hits(int maxhits); - double get_fmwpc_min_delta_t_ns(); - void set_fmwpc_min_delta_t_ns(double dt_ns); - - void truncate_hits(hddm_s::HDDM &record); - void truncate_cdc_hits(hddm_s::CdcStrawHitList &hits); - void truncate_fdc_wire_hits(hddm_s::FdcAnodeHitList &hits); - void truncate_fdc_strip_hits(hddm_s::FdcCathodeHitList &hits); - void truncate_stc_hits(hddm_s::StcHitList &hits); - void truncate_bcal_adc_hits(hddm_s::BcalfADCHitList &hits); - void truncate_bcal_tdc_hits(hddm_s::BcalTDCHitList &hits); - void truncate_bcal_adc_digihits(hddm_s::BcalfADCDigiHitList &hits); - void truncate_bcal_tdc_digihits(hddm_s::BcalTDCDigiHitList &hits); - void truncate_ftof_hits(hddm_s::FtofHitList &hits); - void truncate_fcal_hits(hddm_s::FcalHitList &hits); - void truncate_ccal_hits(hddm_s::CcalHitList &hits); - void truncate_tag_hits(hddm_s::TaggerHitList &hits); - void truncate_ps_hits(hddm_s::PsHitList &hits); - void truncate_psc_hits(hddm_s::PscHitList &hits); - void truncate_tpol_hits(hddm_s::TpolHitList &hits); - void truncate_fmwpc_hits(hddm_s::FmwpcHitList &hits); -} - -hddm_s::HDDM &operator+=(hddm_s::HDDM &dst, hddm_s::HDDM &src); -hddm_s::PhysicsEventList &operator+=(hddm_s::PhysicsEventList &dst, - hddm_s::PhysicsEventList &src); -hddm_s::HitViewList &operator+=(hddm_s::HitViewList &dst, - hddm_s::HitViewList &src); -hddm_s::CentralDCList &operator+=(hddm_s::CentralDCList &dst, - hddm_s::CentralDCList &src); -hddm_s::CdcStrawList &operator+=(hddm_s::CdcStrawList &dst, - hddm_s::CdcStrawList &src); -hddm_s::CdcStrawHitList &operator+=(hddm_s::CdcStrawHitList &dst, - hddm_s::CdcStrawHitList &src); -hddm_s::ForwardDCList &operator+=(hddm_s::ForwardDCList &dst, - hddm_s::ForwardDCList &src); -hddm_s::FdcChamberList &operator+=(hddm_s::FdcChamberList &dst, - hddm_s::FdcChamberList &src); -hddm_s::FdcAnodeWireList &operator+=(hddm_s::FdcAnodeWireList &dst, - hddm_s::FdcAnodeWireList &src); -hddm_s::FdcAnodeHitList &operator+=(hddm_s::FdcAnodeHitList &dst, - hddm_s::FdcAnodeHitList &src); -hddm_s::FdcCathodeStripList &operator+=(hddm_s::FdcCathodeStripList &dst, - hddm_s::FdcCathodeStripList &src); -hddm_s::FdcCathodeHitList &operator+=(hddm_s::FdcCathodeHitList &dst, - hddm_s::FdcCathodeHitList &src); -hddm_s::StartCntrList &operator+=(hddm_s::StartCntrList &dst, - hddm_s::StartCntrList &src); -hddm_s::StcPaddleList &operator+=(hddm_s::StcPaddleList &dst, - hddm_s::StcPaddleList &src); -hddm_s::StcHitList &operator+=(hddm_s::StcHitList &dst, - hddm_s::StcHitList &src); -hddm_s::BarrelEMcalList &operator+=(hddm_s::BarrelEMcalList &dst, - hddm_s::BarrelEMcalList &src); -hddm_s::BcalCellList &operator+=(hddm_s::BcalCellList &dst, - hddm_s::BcalCellList &src); -hddm_s::BcalfADCHitList &operator+=(hddm_s::BcalfADCHitList &dst, - hddm_s::BcalfADCHitList &src); -hddm_s::BcalTDCHitList &operator+=(hddm_s::BcalTDCHitList &dst, - hddm_s::BcalTDCHitList &src); -hddm_s::BcalfADCDigiHitList &operator+=(hddm_s::BcalfADCDigiHitList &dst, - hddm_s::BcalfADCDigiHitList &src); -hddm_s::BcalTDCDigiHitList &operator+=(hddm_s::BcalTDCDigiHitList &dst, - hddm_s::BcalTDCDigiHitList &src); -hddm_s::ForwardTOFList &operator+=(hddm_s::ForwardTOFList &dst, - hddm_s::ForwardTOFList &src); -hddm_s::FtofCounterList &operator+=(hddm_s::FtofCounterList &dst, - hddm_s::FtofCounterList &src); -hddm_s::FtofHitList &operator+=(hddm_s::FtofHitList &dst, - hddm_s::FtofHitList &src); -hddm_s::ForwardEMcalList &operator+=(hddm_s::ForwardEMcalList &dst, - hddm_s::ForwardEMcalList &src); -hddm_s::FcalBlockList &operator+=(hddm_s::FcalBlockList &dst, - hddm_s::FcalBlockList &src); -hddm_s::FcalHitList &operator+=(hddm_s::FcalHitList &dst, - hddm_s::FcalHitList &src); -hddm_s::ComptonEMcalList &operator+=(hddm_s::ComptonEMcalList &dst, - hddm_s::ComptonEMcalList &src); -hddm_s::CcalBlockList &operator+=(hddm_s::CcalBlockList &dst, - hddm_s::CcalBlockList &src); -hddm_s::CcalHitList &operator+=(hddm_s::CcalHitList &dst, - hddm_s::CcalHitList &src); -hddm_s::TaggerList &operator+=(hddm_s::TaggerList &dst, - hddm_s::TaggerList &src); -hddm_s::MicroChannelList &operator+=(hddm_s::MicroChannelList &dst, - hddm_s::MicroChannelList &src); -hddm_s::HodoChannelList &operator+=(hddm_s::HodoChannelList &dst, - hddm_s::HodoChannelList &src); -hddm_s::TaggerHitList &operator+=(hddm_s::TaggerHitList &dst, - hddm_s::TaggerHitList &src); -hddm_s::PairSpectrometerFineList &operator+=( - hddm_s::PairSpectrometerFineList &dst, - hddm_s::PairSpectrometerFineList &src); -hddm_s::PsTileList &operator+=(hddm_s::PsTileList &dst, - hddm_s::PsTileList &src); -hddm_s::PsHitList &operator+=(hddm_s::PsHitList &dst, - hddm_s::PsHitList &src); -hddm_s::PairSpectrometerCoarseList &operator+=( - hddm_s::PairSpectrometerCoarseList &dst, - hddm_s::PairSpectrometerCoarseList &src); -hddm_s::PscPaddleList &operator+=(hddm_s::PscPaddleList &dst, - hddm_s::PscPaddleList &src); -hddm_s::PscHitList &operator+=(hddm_s::PscHitList &dst, - hddm_s::PscHitList &src); -hddm_s::TripletPolarimeterList &operator+=( - hddm_s::TripletPolarimeterList &dst, - hddm_s::TripletPolarimeterList &src); -hddm_s::TpolSectorList &operator+=(hddm_s::TpolSectorList &dst, - hddm_s::TpolSectorList &src); -hddm_s::TpolHitList &operator+=(hddm_s::TpolHitList &dst, - hddm_s::TpolHitList &src); -hddm_s::ForwardMWPCList &operator+=(hddm_s::ForwardMWPCList &dst, - hddm_s::ForwardMWPCList &src); -hddm_s::FmwpcChamberList &operator+=(hddm_s::FmwpcChamberList &dst, - hddm_s::FmwpcChamberList &src); -hddm_s::FmwpcHitList &operator+=(hddm_s::FmwpcHitList &dst, - hddm_s::FmwpcHitList &src); - -#endif - diff --git a/src/programs/Simulation/mcsmear/mcsmear.cc b/src/programs/Simulation/mcsmear/mcsmear.cc deleted file mode 100644 index fa040d3ad6..0000000000 --- a/src/programs/Simulation/mcsmear/mcsmear.cc +++ /dev/null @@ -1,245 +0,0 @@ -// $Id: mcsmear.cc 19023 2015-07-14 20:23:27Z beattite $ -// -// Created June 22, 2005 David Lawrence - -#include -#include -#include -#include -#include - -using namespace std; - -#include -#include -#include -#include - -#include -#include - -#include -#include "MyProcessor.h" -#include "JFactoryGenerator_ThreadCancelHandler.h" -#include "mcsmear_config.h" - -#include "units.h" -#include "HDDM/hddm_s.hpp" - -void Smear(hddm_s::HDDM *record); -void ParseCommandLineArguments(int narg, char* argv[], mcsmear_config_t *in_config); -void Usage(void); - -extern void SetSeeds(const char *vals); - -char *INFILENAME = NULL; -char *OUTFILENAME = NULL; -int QUIT = 0; - -std::map files2merge; -std::map start2merge; -std::map skip2merge; - -using namespace jana; - -// for histogramming -//pthread_mutex_t root_mutex = PTHREAD_MUTEX_INITIALIZER; - -// GLOBAL RANDOM NUMBER GENERATOR -// Note, the argument is zero to cause the seeds to -// be initialized using the UUID (see code for ROOT's -// TRandom2 constructor) No argument, or an argument -// greater than zero will result in the same seeds -// being set every time mcsmear is run. -DRandom2 gDRandom(0); // declared extern in DRandom2.h - -const mcsmear_config_t *mcsmear_config; - -//----------- -// main -//----------- -int main(int narg,char* argv[]) -{ - mcsmear_config_t *config = new mcsmear_config_t(); - ParseCommandLineArguments(narg, argv, config); - mcsmear_config = config; - - // Create DApplication object - DApplication dapp(narg, argv); - dapp.AddFactoryGenerator(new JFactoryGenerator_ThreadCancelHandler()); - - TFile *hfile = new TFile("smear.root","RECREATE","smearing histograms"); // note: not used for anything right now - - MyProcessor myproc(config); - jerror_t error_code = dapp.Run(&myproc); - - hfile->Write(); - hfile->Close(); - - if(error_code != NOERROR) - return static_cast(error_code); - else - return 0; -} - -//----------- -// ParseCommandLineArguments -//----------- -void ParseCommandLineArguments(int narg, char* argv[], mcsmear_config_t *config) -{ - - for (int i=1; iADD_NOISE=true; break; - case 's': config->SMEAR_HITS=false; break; - case 'i': config->IGNORE_SEEDS=true; break; - case 'r': config->SetSeeds(&ptr[2]); break; - case 'd': config->DROP_TRUTH_HITS=true; break; - case 'D': config->DUMP_RCDB_CONFIG=true; break; - case 'e': config->APPLY_EFFICIENCY_CORRECTIONS=false; break; - case 'm': config->APPLY_HITS_TRUNCATION=false; break; - case 'E': config->FCAL_ADD_LIGHTGUIDE_HITS=true; break; - - // BCAL parameters - case 'G': config->BCAL_NO_T_SMEAR = true; break; - case 'H': config->BCAL_NO_DARK_PULSES = true; break; - case 'K': config->BCAL_NO_SAMPLING_FLUCTUATIONS = true; break; - case 'L': config->BCAL_NO_SAMPLING_FLOOR_TERM = true; break; - case 'M': config->BCAL_NO_POISSON_STATISTICS = true; break; - case 'S': config->BCAL_NO_FADC_SATURATION = true; break; - } - } - else { - std::string filename(ptr); - size_t slash = filename.find_last_of("/"); - size_t colon = filename.find_last_of(":"); - if (colon != filename.npos && (slash == filename.npos || colon > slash)) { - double wgt = std::stod(filename.substr(colon + 1)); - size_t plus = filename.substr(colon + 1).find_first_of("+"); - size_t decimal = filename.substr(colon + 1, plus).find_first_of("."); - if (decimal != filename.npos) // distinguish float from int - wgt += 1e-10; - int skip = 0; - if (plus != filename.npos) - skip = std::stoi(filename.substr(colon + plus + 1)); - std::ifstream fin(filename.substr(0, colon)); - hddm_s::istream stin(fin); - hddm_s::HDDM record; - stin >> record; - std::ifstream *ifs = new std::ifstream(filename.substr(0, colon)); - hddm_s::istream *istr = new hddm_s::istream(*ifs); - start2merge[istr] = stin.getPosition(); - files2merge[istr] = wgt; - skip2merge[istr] = skip; - std::fill(ptr, ptr + strlen(ptr), '-'); - continue; - } - INFILENAME = argv[i]; - } - } - - if (!INFILENAME){ - cout << endl << "You must enter a filename!" << endl << endl; - Usage(); - } - - - // Generate output filename based on input filename - if (OUTFILENAME == NULL) { - char *ptr, *path_stripped, *pdup; - path_stripped = ptr = pdup = strdup(INFILENAME); - while((ptr = strstr(ptr, "/")))path_stripped = ++ptr; - ptr = strstr(path_stripped, ".hddm"); - if(ptr)*ptr=0; - char str[256]; - sprintf(str, "%s_smeared.hddm", path_stripped); - OUTFILENAME = strdup(str); - free(pdup); - } - -} - - -//----------- -// Usage -//----------- -void Usage(void) -{ - cout << endl << "Usage:" << endl; - cout << " mcsmear [options] file.hddm [noise1.hddm: [...] ]" << endl; - cout << endl; - cout << "Read the given, Geant-produced HDDM file as input and smear" << endl; - cout << "the truth values for \"hit\" data before writing out to a" << endl; - cout << "separate file. The truth values for the thrown particles are" << endl; - cout << "not changed. Noise hits can also be added appending additional" << endl; - cout << "input hddm files after the primary input file, denoted above" << endl; - cout << "as noise1.hddm:. Each event in the primary input file will" << endl; - cout << "be merged at hits level with events from the first listed" << endl; - cout << "noise file, events from the second noise file, and so on" << endl; - cout << "for as many noise files as are listed. If the pileup factor " << endl; - cout << "is a float (contains a decimal point) then the number of events" << endl; - cout << "from the noise file that get merged into each event in the" << endl; - cout << "primary input file is generated at random from a Poisson" << endl; - cout << "distribution with a mean of . When all of the input events" << endl; - cout << "in any of the noise files are exhausted, the file is opened" << endl; - cout << "again and reading of noise events restarts from the beginning" << endl; - cout << "of the file. If you want to skip S events at the beginning of" << endl; - cout << "the noise file at startup, append \"+S\" to the argument." << endl; - cout << "Note that all smearing is done using Gaussians." << endl; - cout << endl; - cout << " options:" << endl; - cout << " -ofname Write output to a file named \"fname\" (default auto-generate name)" << endl; - cout << " -s Don't smear real hits (default is to smear)" << endl; - cout << " -i Ignore random number seeds found in input HDDM file" << endl; - cout << " -r\"s1 s2 s3\" Set initial random number seeds" << endl; - cout << " -e Don't apply channel dependent efficiency corrections" << endl; -// cout << " -u# Sigma CDC anode drift time in ns (def:" << CDC_TDRIFT_SIGMA*1.0E9 << "ns)" << endl; -// cout << " (NOTE: this is only used if -y is also specified!)" << endl; -// cout << " -y Do NOT apply drift distance dependence error to" << endl; -// cout << " CDC (default is to apply)" << endl; -// cout << " -Y Apply constant sigma smearing for FDC drift time. " << endl; -// cout << " Default is to use a drift-distance dependent parameterization." << endl; -// cout << " -t# CDC time window for background hits in ns (def:" << CDC_TIME_WINDOW*1.0E9 << "ns)" << endl; -// cout << " -U# Sigma FDC anode drift time in ns (def:" << FDC_TDRIFT_SIGMA*1.0E9 << "ns)" << endl; -// cout << " -C# Sigma FDC cathode strips in microns (def:" << FDC_TDRIFT_SIGMA << "ns)" << endl; -// cout << " -T# FDC time window for background hits in ns (def:" << FDC_TIME_WINDOW*1.0E9 << "ns)" << endl; -// cout << " -e hdgeant was run with LOSS=0 so scale the FDC cathode" << endl; -// cout << " pedestal noise (def:false)" << endl; - cout << " -d Drop truth hits (default: keep truth hits)" << endl; -// cout << " -p# FCAL photo-statistics smearing factor in GeV^3/2 (def:" << FCAL_PHOT_STAT_COEF << ")" << endl; -// cout << " -b# FCAL single block threshold in MeV (def:" << FCAL_BLOCK_THRESHOLD/k_MeV << ")" << endl; -// cout << " -B Don't process BCAL hits at all (def. process)" << endl; - // cout << " -Vthresh BCAL ADC threshold (def. " << BCAL_ADC_THRESHOLD_MEV << " MeV)" << endl; - // cout << " -Xsigma BCAL fADC time resolution (def. " << BCAL_FADC_TIME_RESOLUTION << " ns)" << endl; - cout << " -D Dump configuration debug information" << endl; - cout << " -G Don't smear BCAL times (def. smear)" << endl; - cout << " -H Don't add BCAL dark hits (def. add)" << endl; - cout << " -K Don't apply BCAL sampling fluctuations (def. apply)" << endl; - cout << " -L Don't apply BCAL sampling floor term (def. apply)" << endl; - cout << " -M Don't apply BCAL Poisson statistics (def. apply)" << endl; - cout << " -S Don't apply BCAL fADC saturation (def. apply)" << endl; - // cout << " -f# TOF sigma in psec (def: " << TOF_SIGMA/k_psec << ")" << endl; - cout << " -h Print this usage statement." << endl; - cout << endl; -// cout << " Example:" << endl; -// cout << endl; -// cout << " mcsmear -u3.5 -t500 hdgeant.hddm" << endl; -// cout << endl; -// cout << " This will produce a file named hdgeant_nsmeared.hddm that" << endl; -// cout << " includes the hit information from the input file hdgeant.hddm" << endl; -// cout << " but with the FDC and CDC hits smeared out. The CDC hits will" << endl; -// cout << " have their drift times smeared via a gaussian with a 3.5ns width" << endl; -// cout << " while the FDC will be smeared using the default values." << endl; -// cout << " In addition, background hits will be added, the exact number of" << endl; -// cout << " of which are determined by the time windows specified for the" << endl; -// cout << " CDC and FDC. In this examplem the CDC time window was explicitly" << endl; -// cout << " set to 500 ns." << endl; -// cout << endl; - - exit(0); -} diff --git a/src/programs/Simulation/mcsmear/mcsmear_config.cc b/src/programs/Simulation/mcsmear/mcsmear_config.cc deleted file mode 100644 index 12adf354b5..0000000000 --- a/src/programs/Simulation/mcsmear/mcsmear_config.cc +++ /dev/null @@ -1,260 +0,0 @@ - -#include "mcsmear_config.h" - -#include -#include - -#ifdef HAVE_RCDB -#include -#include "RCDB/ConfigParser.h" -string RCDB_CONNECTION; -rcdb::Connection *rcdb_connection; -#endif // HAVE_RCDB - - -//----------- -// mcsmear_config_t (Constructor) -//----------- -mcsmear_config_t::mcsmear_config_t() -{ - // default values - DROP_TRUTH_HITS = false; - ADD_NOISE = false; - SMEAR_HITS = true; - //SMEAR_BCAL = true; - IGNORE_SEEDS = false; - DUMP_RCDB_CONFIG = false; - APPLY_EFFICIENCY_CORRECTIONS = true; - APPLY_HITS_TRUNCATION = true; - FCAL_ADD_LIGHTGUIDE_HITS = false; - - TRIGGER_LOOKBACK_TIME = -100; // ns - -#ifdef HAVE_RCDB - // RCDB configuration - // first determine which database to connect to - if( getenv("RCDB_CONNECTION")!= NULL ) - RCDB_CONNECTION = getenv("RCDB_CONNECTION"); - else - RCDB_CONNECTION = "mysql://rcdb@hallddb.jlab.org/rcdb"; // default to outward-facing MySQL DB - - // load RCDB later, so that the DApplication interface is initialized - rcdb_connection = NULL; -#endif //HAVE_RCDB -} - -//----------- -// mcsmear_config_t (Destructor) -//----------- -mcsmear_config_t::~mcsmear_config_t() { -#ifdef HAVE_RCDB - delete rcdb_connection; -#endif //HAVE_RCDB -} - -//----------- -// SetSeeds -//----------- -void mcsmear_config_t::SetSeeds(const char *vals) -{ - /// This is called from the command line parser to - /// set the initial seeds based on user input from - /// the command line. - // - stringstream ss(vals); - Int_t seed1, seed2, seed3; - ss >> seed1 >> seed2 >> seed3; - UInt_t *useed1 = reinterpret_cast(&seed1); - UInt_t *useed2 = reinterpret_cast(&seed2); - UInt_t *useed3 = reinterpret_cast(&seed3); - gDRandom.SetSeeds(*useed1, *useed2, *useed3); - - cout << "Seeds set from command line. Any random number" << endl; - cout << "seeds found in the input file will be ignored!" << endl; - IGNORE_SEEDS = true; -} - - -#ifdef HAVE_RCDB - -//----------- -// LoadRCDBConnection -//----------- -void mcsmear_config_t::LoadRCDBConnection() -{ - // We want to connect to RCDB as late as possible for two reasons: - // 1) No need to connect to the database unless we are actually using this information, - // which should speed things up - // 2) To use the JANA command line parameter interface, we need to make sure that the - // DApplication is initialized, and it might not be when the mcsmear_config_t - // constructor is called - - // if we're already connected, then stop now - if(rcdb_connection != NULL) - return; - - gPARMS->SetDefaultParameter("RCDB_CONNECTION", RCDB_CONNECTION, "URL used to access RCDB."); - - // load connection to RCDB - rcdb_connection = new rcdb::Connection(RCDB_CONNECTION); -} - -//----------- -// ParseRCDBConfigFile -//----------- -bool mcsmear_config_t::ParseRCDBConfigFile(int runNumber) -{ - // This is just for testing (right now) - // To get a lot of the configuration parameters we need, we need to parse the CODA configuration files - // which are saved in RCDB in the JSON format - - // Lazily connect to RCDB - LoadRCDBConnection(); - - // The "rtvs" condition contains the file name of the CODA configuration file - // What else does this contain?? - auto rtvsCondition = rcdb_connection->GetCondition(runNumber, "rtvs"); // Get condition by run and name - if(!rtvsCondition) { - jerr << "RCDB: 'rtvs' condition is not set for run " << runNumber << endl; - return false; - } - - auto json = rtvsCondition->ToJsonDocument(); // The CODA rtvs is serialized as JSon dictionary. - string fileName(json["%(config)"].GetString()); // The file name is stored in '%(config)' - - - // Get file out of RCDB (indexed by run number and name) - auto file = rcdb_connection->GetFile(runNumber, fileName); - if(!file) { // If there is no such file, null is returned - jerr << "File with name \"" << fileName - << "\" doesn't exist for run "<< runNumber << endl; - return false; - } - - // Parse CODA config file - vector SectionNames = {"TRIGGER", "GLOBAL", "FCAL", "BCAL", "TOF", "ST", "TAGH", - "TAGM", "PS", "PSC", "TPOL", "CDC", "FDC"}; - string fileContent = file->GetContent(); // Get file content - auto result = rcdb::ConfigParser::Parse(fileContent, SectionNames); // Parse it! - - // EXAMPLE -// double CDC_FADC125_DAC = stod(result.Sections["CDC"].NameValues["FADC125_DAC"]); -// double CDC_FADC125_THR = stod(result.Sections["CDC"].NameValues["FADC125_THR"]); - - if(DUMP_RCDB_CONFIG) { - //// DEBUG //// - //cout << "CODA config file contents:" << endl; - ofstream coda_ofile("rcdb_coda.config"); - coda_ofile << "Full file: " << endl; - coda_ofile << fileContent << endl; - - - coda_ofile << endl << "Parsed:" << endl; - for(auto sectionName: SectionNames) { - coda_ofile << "Section: " << sectionName << endl; - auto sectionData = result.Sections[sectionName]; - - for(auto value : sectionData.NameValues) - coda_ofile << value.first << " = " << value.second << endl; - for(auto data_vec : sectionData.NameVectors) { - coda_ofile << data_vec.first << " = "; - for(auto value: data_vec.second) - coda_ofile << value << " "; - coda_ofile << endl; - } - - coda_ofile << endl; - } - coda_ofile.close(); - } - - // then we get stuff out of it - - double dvalue; - std::stringstream deco; - vector::iterator iter; - vector fadc250_sys = {"FCAL", "BCAL", "TOF", "ST", "TAGH", - "TAGM", "PS", "PSC", "TPOL"}; - for (iter = fadc250_sys.begin(); iter != fadc250_sys.end(); ++iter) { - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC250_NPEAK"]); - deco >> dvalue; - readout[*iter]["NPEAK"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC250_NSA"]); - deco >> dvalue; - readout[*iter]["NSA"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC250_NSB"]); - deco >> dvalue; - readout[*iter]["NSB"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC250_W_WIDTH"]); - deco >> dvalue; - readout[*iter]["WINDOW"] = dvalue; - } - - vector fadc125_sys = {"FDC", "CDC"}; - for (iter = fadc125_sys.begin(); iter != fadc125_sys.end(); ++iter) { - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC125_NPEAK"]); - deco >> dvalue; - readout[*iter]["NPEAK"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC125_IE"]); - deco >> dvalue; - readout[*iter]["IE"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC125_PG"]); - deco >> dvalue; - readout[*iter]["PG"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["FADC125_W_WIDTH"]); - deco >> dvalue; - readout[*iter]["WINDOW"] = dvalue; - } - - vector f1tdc_sys = {"BCAL", "ST", "TAGH", "TAGM", "PSC", "FDC"}; - for (iter = f1tdc_sys.begin(); iter != f1tdc_sys.end(); ++iter) { - readout[*iter]["NHITS"] = 8.; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["F1TDC_WINDOW"]); - deco >> dvalue; - readout[*iter]["WINDOW"] = dvalue; - deco.clear(); - if (result.Sections.at(*iter).NameVectors["DSC2_WIDTH"].size() > 0) { - deco.str(result.Sections.at(*iter).NameVectors["DSC2_WIDTH"][0]); - deco >> dvalue; - } - else { - dvalue = 50; // default value; - } - readout[*iter]["WIDTH"] = dvalue; - } - - vector tdc1290_sys = {"TOF"}; - for (iter = tdc1290_sys.begin(); iter != tdc1290_sys.end(); ++iter) { - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["TDC1290_N_HITS"]); - deco >> dvalue; - readout[*iter]["NHITS"] = dvalue; - deco.clear(); - deco.str(result.Sections.at(*iter).NameValues["TDC1290_W_WIDTH"]); - deco >> dvalue; - readout[*iter]["WINDOW"] = dvalue; - deco.clear(); - if (result.Sections.at(*iter).NameVectors["DSC2_WIDTH"].size() > 0) { - deco.str(result.Sections.at(*iter).NameVectors["DSC2_WIDTH"][0]); - deco >> dvalue; - } - else { - dvalue = 50; // default value - } - readout[*iter]["WIDTH"] = dvalue; - } - - return true; -} - -#endif // HAVE_RCDB - diff --git a/src/programs/Simulation/mcsmear/mcsmear_config.h b/src/programs/Simulation/mcsmear/mcsmear_config.h deleted file mode 100644 index 8a5c49b625..0000000000 --- a/src/programs/Simulation/mcsmear/mcsmear_config.h +++ /dev/null @@ -1,66 +0,0 @@ -// Classes to store configuration information for mcsmear - -#ifndef _MCSMEAR_CONFIG_H_ -#define _MCSMEAR_CONFIG_H_ - -#include "units.h" - -#include -#include -#include "DRandom2.h" - -using namespace jana; - - -// external function definitions from SampleGaussian.cc -double SampleGaussian(double sigma); -double SamplePoisson(double lambda); -double SampleRange(double x1, double x2); - - -// Overall configuration parameters -class mcsmear_config_t -{ - public: - mcsmear_config_t(); - ~mcsmear_config_t(); - - //----------- - // SetSeeds - //----------- - void SetSeeds(const char *vals); - - // member variables - bool ADD_NOISE; - bool DROP_TRUTH_HITS; - bool SMEAR_HITS; - bool DUMP_RCDB_CONFIG; - - //bool SMEAR_BCAL; - //bool FDC_ELOSS_OFF; - bool IGNORE_SEEDS; - double TRIGGER_LOOKBACK_TIME; - bool APPLY_EFFICIENCY_CORRECTIONS; - bool APPLY_HITS_TRUNCATION; - - bool FCAL_ADD_LIGHTGUIDE_HITS; - - // flags to pass command line info to subdetector classes - double BCAL_NO_T_SMEAR; - double BCAL_NO_DARK_PULSES; - double BCAL_NO_SAMPLING_FLUCTUATIONS; - double BCAL_NO_SAMPLING_FLOOR_TERM; - double BCAL_NO_POISSON_STATISTICS; - double BCAL_NO_FADC_SATURATION; - - -#ifdef HAVE_RCDB - void LoadRCDBConnection(); - bool ParseRCDBConfigFile(int runNumber); -#endif // HAVE_RCDB - - std::map > readout; -}; - - -#endif // _MCSMEAR_CONFIG_H_ diff --git a/src/programs/Simulation/mcsmear/smear.cc b/src/programs/Simulation/mcsmear/smear.cc deleted file mode 100644 index b526f80737..0000000000 --- a/src/programs/Simulation/mcsmear/smear.cc +++ /dev/null @@ -1,188 +0,0 @@ -// $Id$ -// -// Created June 22, 2005 David Lawrence - -#include "smear.h" - -#include -#include -#include -using namespace std; - -#include -#include "units.h" -#include -#include - -#include "DRandom2.h" - -#ifndef _DBG_ -#define _DBG_ cout<<__FILE__<<":"<<__LINE__<<" " -#define _DBG__ cout<<__FILE__<<":"<<__LINE__<(new BCALSmearer(loop,config)); - smearers[SYS_FCAL] = static_cast(new FCALSmearer(loop,config)); - smearers[SYS_CDC] = static_cast(new CDCSmearer(loop,config)); - smearers[SYS_FDC] = static_cast(new FDCSmearer(loop,config)); - smearers[SYS_TOF] = static_cast(new TOFSmearer(loop,config)); - smearers[SYS_START] = static_cast(new SCSmearer(loop,config)); - smearers[SYS_TAGH] = static_cast(new TAGHSmearer(loop,config)); - smearers[SYS_TAGM] = static_cast(new TAGMSmearer(loop,config)); - smearers[SYS_PS] = static_cast(new PSSmearer(loop,config)); - smearers[SYS_PSC] = static_cast(new PSCSmearer(loop,config)); - smearers[SYS_TPOL] = static_cast(new TPOLSmearer(loop,config)); - smearers[SYS_DIRC] = static_cast(new FDIRCSmearer(loop,config)); - smearers[SYS_CCAL] = static_cast(new CCALSmearer(loop,config)); - smearers[SYS_FMWPC] = static_cast(new FMWPCSmearer(loop,config)); - } else { - // Parse string of system names - std::istringstream ss(detectors_to_load); - std::string token; - while(std::getline(ss, token, ',')) { - DetectorSystem_t the_detector = static_cast(atoi(token.c_str())); - switch(the_detector) { - case SYS_BCAL: smearers[the_detector] = static_cast(new BCALSmearer(loop,config)); break; - case SYS_FCAL: smearers[the_detector] = static_cast(new FCALSmearer(loop,config)); break; - case SYS_CDC: smearers[the_detector] = static_cast(new CDCSmearer(loop,config)); break; - case SYS_FDC: smearers[the_detector] = static_cast(new FDCSmearer(loop,config)); break; - case SYS_TOF: smearers[the_detector] = static_cast(new TOFSmearer(loop,config)); break; - case SYS_START: smearers[the_detector] = static_cast(new SCSmearer(loop,config)); break; - case SYS_TAGH: smearers[the_detector] = static_cast(new TAGHSmearer(loop,config)); break; - case SYS_TAGM: smearers[the_detector] = static_cast(new TAGMSmearer(loop,config)); break; - case SYS_PS: smearers[the_detector] = static_cast(new PSSmearer(loop,config)); break; - case SYS_PSC: smearers[the_detector] = static_cast(new PSCSmearer(loop,config)); break; - case SYS_TPOL: smearers[the_detector] = static_cast(new TPOLSmearer(loop,config)); break; - case SYS_DIRC: smearers[the_detector] = static_cast(new FDIRCSmearer(loop,config)); break; - case SYS_CCAL: smearers[the_detector] = static_cast(new CCALSmearer(loop,config)); break; - case SYS_FMWPC: smearers[the_detector] = static_cast(new FMWPCSmearer(loop,config)); break; - default: break; // don't smear any other detectors - } - } - } -} - -//----------- -// Smear (destructor) -//----------- -Smear::~Smear() -{ - for(map::iterator smearer_it = smearers.begin(); - smearer_it != smearers.end(); smearer_it++) - delete smearer_it->second; -} - -//----------- -// SmearEvent -//----------- -void Smear::SmearEvent(hddm_s::HDDM *record) -{ - GetAndSetSeeds(record); - - // Smear each detector system - for(map::iterator smearer_it = smearers.begin(); - smearer_it != smearers.end(); smearer_it++) { - //cerr << "smearing " << SystemName(smearer_it->first) << endl; - smearer_it->second->SmearEvent(record); - } - -} - -//----------- -// SetSeeds -//----------- -void Smear::SetSeeds(const char *vals) -{ - /// This is called from the command line parser to - /// set the initial seeds based on user input from - /// the command line. - // - // - stringstream ss(vals); - Int_t seed1, seed2, seed3; - ss >> seed1 >> seed2 >> seed3; - UInt_t *useed1 = reinterpret_cast(&seed1); - UInt_t *useed2 = reinterpret_cast(&seed2); - UInt_t *useed3 = reinterpret_cast(&seed3); - gDRandom.SetSeeds(*useed1, *useed2, *useed3); - - cout << "Seeds set from command line. Any random number" << endl; - cout << "seeds found in the input file will be ignored!" << endl; - config->IGNORE_SEEDS = true; -} - -//----------- -// GetAndSetSeeds -//----------- -void Smear::GetAndSetSeeds(hddm_s::HDDM *record) -{ - // Check if non-zero seed values exist in the input HDDM file. - // If so, use them to set the seeds for the random number - // generator. Otherwise, make sure the seeds that are used - // are stored in the output event. - - if (record == 0) - return; - else if (record->getReactions().size() == 0) - return; - - hddm_s::ReactionList::iterator reiter = record->getReactions().begin(); - if (reiter->getRandoms().size() == 0) { - // No seeds stored in event. Add them - hddm_s::RandomList blank_rand = reiter->addRandoms(); - blank_rand().setSeed1(0); - blank_rand().setSeed2(0); - blank_rand().setSeed3(0); - blank_rand().setSeed4(0); - } - - UInt_t seed1, seed2, seed3; - hddm_s::Random my_rand = reiter->getRandom(); - - if (!config->IGNORE_SEEDS) { - // Copy seeds from event record to local variables - seed1 = my_rand.getSeed1(); - seed2 = my_rand.getSeed2(); - seed3 = my_rand.getSeed3(); - - // If the seeds in the event are all zeros it means they - // were not set. In this case, initialize seeds to constants - // to guarantee the seeds are used if this input file were - // smeared again with the same command a second time. These - // are set here to the fractional part of the cube roots of - // the first three primes, truncated to 9 digits. - if ((seed1 == 0) || (seed2 == 0) || (seed3 == 0)){ - uint64_t eventNo = record->getPhysicsEvent().getEventNo(); - seed1 = 259921049 + eventNo; - seed2 = 442249570 + eventNo; - seed3 = 709975946 + eventNo; - } - - // Set the seeds in the random generator. - gDRandom.SetSeeds(seed1, seed2, seed3); - } - - // Copy seeds from generator to local variables - gDRandom.GetSeeds(seed1, seed2, seed3); - - // Copy seeds from local variables to event record - my_rand.setSeed1(seed1); - my_rand.setSeed2(seed2); - my_rand.setSeed3(seed3); -} - - diff --git a/src/programs/Simulation/mcsmear/smear.h b/src/programs/Simulation/mcsmear/smear.h deleted file mode 100644 index d2b01130d7..0000000000 --- a/src/programs/Simulation/mcsmear/smear.h +++ /dev/null @@ -1,55 +0,0 @@ -// main class for smearing data - -#ifndef _SMEAR_H_ -#define _SMEAR_H_ - -#include -using namespace std; - -#include "HDDM/hddm_s.hpp" -#include "GlueX.h" - -#include -using namespace jana; - -#include "mcsmear_config.h" - -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - - - -class Smear -{ - public: - Smear(mcsmear_config_t *in_config, JEventLoop *loop, string detectors_to_load="all"); - ~Smear(); - - // main entrance - takes an event and smears it - void SmearEvent(hddm_s::HDDM *record); - - private: - // utility functions - void SetSeeds(const char *vals); - void GetAndSetSeeds(hddm_s::HDDM *record); - - // Detector digitization/smearing is implemented in a different class for each subdetector - map smearers; - - mcsmear_config_t *config; -}; - -#endif // _SMEAR_H_ diff --git a/src/programs/Simulation/nullgen/SConscript b/src/programs/Simulation/nullgen/SConscript deleted file mode 100644 index d6770b940e..0000000000 --- a/src/programs/Simulation/nullgen/SConscript +++ /dev/null @@ -1,13 +0,0 @@ - - -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -sbms.AddROOT(env) -sbms.AddRCDB(env) -sbms.AddDANA(env) -sbms.executable(env) - diff --git a/src/programs/Simulation/nullgen/nullgen.cc b/src/programs/Simulation/nullgen/nullgen.cc deleted file mode 100644 index 59adf634d0..0000000000 --- a/src/programs/Simulation/nullgen/nullgen.cc +++ /dev/null @@ -1,86 +0,0 @@ -// -// nullgen - produces a file of null (empty) simulated events. This can -// be used in combination with mcsmear if all you want to do -// is to merge the hits from events drawn from multiple input -// hddm streams into a a single stream of fatter events. -// -// author: richard.t.jones at uconn.edu -// version: march 17, 2017 -// -// usage: nullgen -n -o -// -// example: -// Suppose you have a set of three files x1.hddm, x2.hddm, and x3.hddm -// all containing events that have already been smeared, and you want -// to simply merge these such that the output events are merges of 2 -// events from x1.hddm, 3 events from x2.hddm, and 1 from x3.hddm, -// then the following sequence of commands will generate 1000 events -// in xsum.hddm, the merged output file. -// -// $ nullgen -n 1000 -o xnull.hddm -// $ mcsmear x1.hddm:2 x2.hddm:3 x3.hddm:1 -o xsum.hddm - -#include -#include -#include - -void usage() -{ - std::cout << "usage: nullgen -n " - << "[-r ] " - << "-o " - << std::endl; - exit(1); -} - -int main(int argc, char *argv[]) -{ - int event_count = 0; - int run_number = 0; - std::string output_file; - - for (int iarg=1; iarg < argc; ++iarg) { - std::string arg(argv[iarg]); - if (arg.substr(0,2) == "-n") { - if (arg.size() > 2) { - event_count = std::stoi(arg.substr(2)); - } - else { - event_count = std::stoi(argv[++iarg]); - } - } - else if (arg.substr(0,2) == "-r") { - if (arg.size() > 2) { - run_number = std::stoi(arg.substr(2)); - } - else { - run_number = std::stoi(argv[++iarg]); - } - } - else if (arg.substr(0,2) == "-o") { - if (arg.size() > 2) { - output_file = arg.substr(2); - } - else { - output_file = argv[++iarg]; - } - } - else { - usage(); - } - } - - if (event_count == 0 || output_file.size() == 0) { - usage(); - } - std::ofstream outf(output_file); - hddm_s::ostream fout(outf); - hddm_s::HDDM record; - hddm_s::PhysicsEventList elist = record.addPhysicsEvents(); - elist(0).setRunNo(run_number); - for (int event=0; event < event_count; ++event) { - elist(0).setEventNo(event); - fout << record; - } - return 0; -} diff --git a/src/programs/Simulation/stdhep_translators/README b/src/programs/Simulation/stdhep_translators/README deleted file mode 100644 index 54b9439ded..0000000000 --- a/src/programs/Simulation/stdhep_translators/README +++ /dev/null @@ -1,26 +0,0 @@ - - -These translators existed in the sim-recon base for many years until -they were retired in March 2017 as part of a clean up effort to remove -unused or obsolete code. - -They have been reinstated in Feb. 2018 since a use case emerged that -could make use of them. Note that the itape conversion programs were -not resurrected. - -Note also that these make use of cernlib and so are implmented as an -optional build. - - -Below is the original README file contents --------------------------------------------------------------- - -See CVS package HDMS_mcfast/README for more -details. This package is used by mcfast. - -To make the translators: - % make all -This will make 4 executables: ascii2stdhep itape2stdhep -stdhep2ascii stdhep2itape - -Install these files in your path. diff --git a/src/programs/Simulation/stdhep_translators/SConscript b/src/programs/Simulation/stdhep_translators/SConscript deleted file mode 100644 index 966e8a1fb2..0000000000 --- a/src/programs/Simulation/stdhep_translators/SConscript +++ /dev/null @@ -1,15 +0,0 @@ - -import os -import sbms - -# get env object and clone it -Import('*') -env = env.Clone() - -if os.getenv('CERN') == None: - print '==== CANNOT BUILD stdhep_translators WITHOUT CERN ====' -else: - sbms.AddHDDM(env) - sbms.AddCERNLIB(env) - sbms.executables(env) - diff --git a/src/programs/Simulation/stdhep_translators/ascii2stdhep.c b/src/programs/Simulation/stdhep_translators/ascii2stdhep.c deleted file mode 100644 index d07c7b7890..0000000000 --- a/src/programs/Simulation/stdhep_translators/ascii2stdhep.c +++ /dev/null @@ -1,553 +0,0 @@ -/************************************************ - * ascii2stdhep.c - * This program converts the ascii output of genr8 - * to StdHep format. See http://www-pat.fnal.gov/stdhep.html - * Paul Eugenio - * Carnegie Mellon University - * 24 Sept 98 - **********************************************/ - -#include -#include -#include -#include - - -#include -#include -#include -#include - -#define TRUE 1 -#define FALSE 0 - -/* - * #include See it below. - */ - -/******************* From stdhep.h **************************** -* Basic COMMON block from STDHEP: the HEPEVT COMMON block -* See product StDhep -* -* note that to avoid alignment problems, structures and common blocks -* should be in the order: double precision, real, integer. -*************************************************************** -#define NMXHEP 4000 -extern struct hepevt { - int nevhep; /* The event number * - int nhep; /* The number of entries in this event * - int isthep[NMXHEP]; /* The Particle id * - int idhep[NMXHEP]; /* The particle id * - int jmohep[NMXHEP][2]; /* The position of the mother particle * - int jdahep[NMXHEP][2]; /* Position of the first daughter... * - double phep[NMXHEP][5]; /* 4-Momentum, mass * - double vhep[NMXHEP][4]; /* Vertex information * -} hepevt_; -************************************************************/ - - -/****************** - * Local Structure - ******************/ -typedef struct { double x,y,z; } dvector3_t; -typedef struct { double t; dvector3_t space; } dvector4_t; - -typedef struct { - int statusCode; /* 1 is a final state particle */ - int pid; /* this use the PDG MC numbering scheme */ - double mass; - dvector4_t p; -}mc_part_t; - -/*************** - * GLOBALS - ***************/ -int Debug=0; - - -/******************************** - * Prototypes for StdHep functions. - *********************************/ - -int StdHepXdrWiteInit(char *fileName,char *title, int ntries, int istream); -int StdHepXdrWrite(int ilbl,int istream); -int StdHepXdrEnd(int istream); - - -/******************************** - * Local Prototypes - *********************************/ -int PrintUsage(char *processName); -int getFromAscii(FILE *fp,int nparts,mc_part_t *P); -int getFromGampFile(FILE *fp,int *nparts,mc_part_t *P); -int fill_hepevt(int nparts, mc_part_t *parts); -int pdgID(Particle_t p); - - -/**************** - * main() - **************/ - /* - * MAX_PARTS sets the max numbers of particles in an event - */ -#define MAX_PARTS 20 -int main(int argc,char **argv) -{ - char *argptr; - int i,ntries=0,nskip=0,ret,gotANevent,written=0; - int ilbl=1,istream=0,nparts=0;/*I guessed at istream */ - int read_gamp_file=FALSE; - char *outputfile ="default.evt"; - char *title ="The HallD MCfast"; - char inputfile[40]; - FILE *inputfp=stdin; - mc_part_t parts[MAX_PARTS]; - - - - if (argc == 1){ - PrintUsage(argv[0]); - exit (0); - } - else { /* good start */ - for (i=1; i 1)) { - argptr++; - switch (*argptr) { - case 'd': - Debug =2; - break; - case 'n': - nparts=atoi(++argptr); - break; - case 'g': - read_gamp_file=TRUE; - break; - case 'S': - nskip=atoi(++argptr); - fprintf(stderr,"Skipping the first %d events\n",nskip); - break; - case 'N': - ntries=atoi(++argptr); - break; - case 'o': - outputfile = ++argptr; - break; - case 'i': - sprintf(inputfile,"%s",++argptr); - if(!(inputfp = fopen(inputfile,"r"))){ - fprintf(stderr,"Fail to open input file!\n"); - exit(-1); - } - break; - case 'h': - PrintUsage(argv[0]); - exit(0); - break; - default: - fprintf(stderr,"Unrecognized argument -%s\n\n",argptr); - PrintUsage(argv[0]); - exit(-1); - break; - } - } - } - - /* main code */ - - /* - * Open and init a stdhep file. - */ - - if(ret=StdHepXdrWriteInit(outputfile,title,ntries, istream)){ - /* some error must have occured */ - fprintf(stderr,"err:StdHepXdrWiteInit ret=%d\n"); - exit(-1); - } - - /* - * Fill the HEPEVENT structure. - */ - - /* Read asci event. */ - if(read_gamp_file) - gotANevent=getFromGampFile(inputfp,&nparts,parts); - else - gotANevent=getFromAscii(inputfp,nparts,parts); - while(gotANevent>0){ /* I have an event! */ - if(!(nskip-- > 0)){ - if( gotANevent==-2){ - fprintf(stderr,"Broken input file.\n"); - exit(-1); - } - /* fill the hepevt structure */ - fill_hepevt(nparts, parts); - - /* write to stdhep file */ - ret=StdHepXdrWrite(ilbl,istream); - if(!(++written %100)) - fprintf(stderr,"McFast events Written: %d\r",written); - } else{ - if(!(nskip %100)) - fprintf(stderr," \rSkipping events: %d\r",nskip); - } - if(read_gamp_file) - gotANevent=getFromGampFile(inputfp,&nparts,parts); - else - gotANevent=getFromAscii(inputfp,nparts,parts); - - if(written == ntries) - gotANevent=0; /* Stop reading events */ - } - - if(written1) - fprintf(stderr,"header: %s\n",line); - nread++; - token=strtok(line," ");/* nparts + beam */ - *nparts = atoi(token); - - /* skip the beam */ - fgets(line,sizeof(line),fp); - (*nparts)--; - if(Debug>1) - fprintf(stderr," beam: %s\n",line); - /* get the particle information */ - for(i=0;i<*nparts;i++){ - if(fgets(line,sizeof(line),fp)!=NULL){ - if(Debug>1) - fprintf(stderr,"part[%d]: %s\n",i,line); - - token=strtok(line," "); - genr8id = atoi(token); - P[i].pid= pdgID(genr8id); - P[i].statusCode=1; - - token=strtok(NULL," "); /* the charge */ - token=strtok(NULL," "); - P[i].p.space.x = atof(token); - token=strtok(NULL," "); - P[i].p.space.y = atof(token); - token=strtok(NULL," "); - P[i].p.space.z = atof(token); - token=strtok(NULL," "); - P[i].p.t = atof(token); - mass = sqrt( P[i].p.t * P[i].p.t - (P[i].p.space.x * P[i].p.space.x + - P[i].p.space.y * P[i].p.space.y + - P[i].p.space.z * P[i].p.space.z)); - - P[i].mass = mass; - if(Debug>1) - fprintf(stderr,"\tThe four momentum is %lf %lf %lf %lf \n", - P[i].p.space.x,P[i].p.space.y,P[i].p.space.z,P[i].p.t); - if(Debug>1) - fprintf(stderr,"\tThe mass is %lf\n",P[i].mass); - - } else return -2; - - - }/* end of nparts */ - if(Debug>1) - fprintf(stderr,"It's a good event.\n"); - return 1;/* it looks like a good event */ - } else return -1;/* there are no more events */ -} - - -/********************* - * - * getEvent - * - *******************/ - -int getFromAscii(FILE *fp,int nparts, mc_part_t *P) -{ - char line[2056]; - char *token; - static int nread=0; - int i; - Particle_t genr8id; - double mass; - - /* get the event header info */ - - if(fgets(line,sizeof(line),fp)!=NULL){ - nread++; - token=strtok(line," "); - /* runNo = atoi(token); */ - - token=strtok(NULL," "); - /* conf = atof(token); */ - - - /* get the particle information */ -for(i=0;i2) - fprintf(stderr,"Particle %d with charge = %d \n",i,P[i].iso3); */ - token=strtok(NULL," "); - P[i].p.space.x = atof(token); - token=strtok(NULL," "); - P[i].p.space.y = atof(token); - token=strtok(NULL," "); - P[i].p.space.z = atof(token); - token=strtok(NULL," "); - P[i].p.t = atof(token); - - if(Debug>2) - fprintf(stderr,"\tThe four momentum is %lf %lf %lf %lf \n", - P[i].p.space.x,P[i].p.space.y,P[i].p.space.z,P[i].p.t); - if(Debug>2) - fprintf(stderr,"\tThe mass is %lf\n",P[i].mass); - - } else return -2;/* bad input file */ - } /* end of for(i=0 ... four particles */ - return 1;/* it looks like a good event */ - } else return -1;/* there are no more events */ -} - -/******************** - * fill_hepevt - *******************/ -int fill_hepevt(int nparts, mc_part_t *part){ - int i; - static int nevent=0; - - nevent++; - /* hepevt header info */ - hepevt_.nevhep=nevent; - hepevt_.nhep=nparts; - if(Debug>1) - fprintf(stderr,"EventNo: %d\n",nevent); - /* now loop over the particle in the event */ - - - for(i=0;i1){ - fprintf(stderr,"StatusCode: %d Pid: %d Mass: %lf\n", - part[i].statusCode, part[i].pid, part[i].mass); - fprintf(stderr,"(p.x, p.y, p.x, p.t): (%lf, %lf, %lf, %lf)\n", - part[i].p.space.x, - part[i].p.space.y, - part[i].p.space.z, - part[i].p.t); - } - } - return 1; -} - -/******************** - * pdgID(int genr8id) - * The convention is that - * followed in StdHep 4.02 - *******************/ -int pdgID(Particle_t p){ - int id=0; - switch (p) { - case Unknown: - - break; - case Gamma: - id=22; - break; - case Positron: - id=-11; - break; - case Electron: - id=11; - break; - case Neutrino: - id=12; - break; - case MuonPlus: - id=-13; - break; - case MuonMinus: - id=13; - break; - case Pi0: - id=111; - break; - case PiPlus: - id=211; - break; - case PiMinus: - id=-211; - break; - case KLong: - id=130; - break; - case KPlus: - id=321; - break; - case KMinus: - id=-321; - break; - case Neutron: - id=2112; - break; - case Proton: - id=2212; - break; - case AntiProton: - id=-2212; - break; - case KShort: - id=310; - break; - case Eta: - id=221; - break; - case Lambda: - id=3122; - break; - case SigmaPlus: - id=3222; - break; - case Sigma0: - id=3212; - break; - case SigmaMinus: - id=3112; - break; - case Xi0: - id=3322; - case XiMinus: - id=3312; - break; - case OmegaMinus: - id=3334; - break; - case AntiNeutron: - id=-2112; - break; - case AntiLambda: - id=-3122; - break; - case AntiSigmaMinus: - id=-3112; - break; - case AntiSigma0: - id=-3212; - break; - case AntiSigmaPlus: - id=-3222; - break; - case AntiXi0: - id=-3322; - break; - case AntiXiPlus: - id=-3312; - break; - case AntiOmegaPlus: - id=-3334; - break; - case Rho0: - id=113; - break; - case RhoPlus: - id=213; - break; - case RhoMinus: - id=-213; - break; - case omega: - id=223; - break; - case EtaPrime: - id=331; - break; - case phiMeson: - id=333; - break; - default: - id=0; - break; - } - return(id); -} - - -/******************** - * PrintUsage - *******************/ -int PrintUsage(char *processName) -{ - - fprintf(stderr,"%s usage: [switches] \n",processName); - fprintf(stderr,"\t-i The input ascii file(default is stdin).\n"); - fprintf(stderr,"\t-o The output file.\n"); - fprintf(stderr,"\t-N<#> The number output events. (N <= NasciiEvents)\n"); - fprintf(stderr,"\t-S<#> Skip the first # number of input events. \n"); - fprintf(stderr,"\t-n<#> The number particles per event.\n"); - fprintf(stderr,"\t-g Read gamp event format\n"); - fprintf(stderr,"\t-h Print this help message\n\n"); -} - - diff --git a/src/programs/Simulation/stdhep_translators/stdhep2ascii.c b/src/programs/Simulation/stdhep_translators/stdhep2ascii.c deleted file mode 100644 index 442148d3d6..0000000000 --- a/src/programs/Simulation/stdhep_translators/stdhep2ascii.c +++ /dev/null @@ -1,479 +0,0 @@ -/************************************************ - * stdhep2ascii.c - * This program converts the StdHep format to the ascii - * format of genr8 See http://www-pat.fnal.gov/stdhep.html - * - * Paul Eugenio - * Carnegie Mellon University - * 24 Sept 98 - **********************************************/ - -#include -#include -#include -#include - - -#include -#include -#include -#include - -/* - * #include See it below. - */ - -/******************* From stdhep.h **************************** -* Basic COMMON block from STDHEP: the HEPEVT COMMON block -* See product StDhep -* -* note that to avoid alignment problems, structures and common blocks -* should be in the order: double precision, real, integer. -*************************************************************** -#define NMXHEP 4000 -extern struct hepevt { - int nevhep; /* The event number * - int nhep; /* The number of entries in this event * - int isthep[NMXHEP]; /* The Particle id * - int idhep[NMXHEP]; /* The particle id * - int jmohep[NMXHEP][2]; /* The position of the mother particle * - int jdahep[NMXHEP][2]; /* Position of the first daughter... * - double phep[NMXHEP][5]; /* 4-Momentum, mass * - double vhep[NMXHEP][4]; /* Vertex information * -} hepevt_; -************************************************************/ - -#define MAX_PARTS 2000 -/****************** - * Local Structure - ******************/ -typedef struct { double x,y,z; } dvector3_t; -typedef struct { double t; dvector3_t space; } dvector4_t; - -typedef struct { - int statusCode; /* 1 is a final state particle */ - int pid; /* this use the PDG MC numbering scheme */ - double mass; - dvector4_t p; -}mc_part_t; - -typedef struct{ - int runNo; - int eventNo; - int nparts; - mc_part_t part[MAX_PARTS]; -}mc_evt_t; - -/*************** - * GLOBALS - ***************/ -int Debug=0; - - -/******************************** - * Prototypes for StdHep functions. - *********************************/ - -int StdHepXdrReadInit(char *fileName,int ntries, int istream); -int StdHepXdrRead(int *ilbl,int istream); -int StdHepXdrEnd(int istream); - - -/******************************** - * Local Prototypes - *********************************/ -int PrintUsage(char *processName); -int fill_mc_parts(mc_evt_t *mc_evt); -int write_mc_parts(FILE *fp, mc_evt_t *mc_evt); -int write_gamp_parts(FILE *fp, mc_evt_t *mc_evt,int beamE); -int getCharge(int PDGpid); -int gampID(int id); - -/**************** - * main() - **************/ - /* - * MAX_PARTS sets the max numbers of particles in an event - */ - -int main(int argc,char **argv) -{ - char *argptr; - int i,ntries=0,ret,gotANevent,written=0; - int ilbl=1,istream=0,nparts=0;/*I guessed at istream */ - int kludge_beam =-1; - char *evtfile ="default.evt"; - char outputfile[40]; - FILE *outputfp=stdout; - mc_evt_t mc_evt; - - - - if (argc == 1){ - PrintUsage(argv[0]); - exit (0); - } - else { /* good start */ - for (i=1; i 1)) { - argptr++; - switch (*argptr) { - case 'd': - Debug =2; - break; - case 'n': - nparts=atoi(++argptr); - break; - case 'g': - kludge_beam=atoi(++argptr); - fprintf(stderr,"Writing gamp format kludge beam of %d\n",kludge_beam); - break; - case 'N': - ntries=atoi(++argptr); - break; - case 'o': - sprintf(outputfile,"%s",++argptr); - if(!(outputfp = fopen(outputfile,"w"))){ - fprintf(stderr,"Fail to open output file!\n"); - exit(-1); - } - break; - case 'i': - evtfile= ++argptr; - break; - case 'h': - PrintUsage(argv[0]); - exit(0); - break; - default: - fprintf(stderr,"Unrecognized argument -%s\n\n",argptr); - PrintUsage(argv[0]); - exit(-1); - break; - } - } - } - - /* main code */ - - /* - * Open and init a stdhep file. - */ - - if(ret=StdHepXdrReadInit(evtfile,ntries, istream)){ - /* some error must have occured */ - fprintf(stderr,"err:StdHepXdrReadInit ret=%d\n",ret); - exit(-1); - } - - /* - * Fill the mc_part_t structure from the HEPEVENT structure. - */ - - for(i=0;i0) - write_gamp_parts(outputfp,&mc_evt,kludge_beam); - else - write_mc_parts(outputfp,&mc_evt); - if(!(++written %100)) - fprintf(stderr,"McFast events Read: %d\r",written); - } - - fprintf(stderr,"\nTotal McFast events Read: %d\n",written); - - /* - * Close the StdHep file and exit. - */ - - StdHepXdrEnd(istream); - exit(0); - - } /* end of else /* good start */ -} /* end of main */ - -/********************* - * - * fill_mc_parts - * - *******************/ - - -int fill_mc_parts(mc_evt_t *mc_evt){ - int i; - int runNo=-9000; - - /* - * fill header info - */ - mc_evt->runNo=runNo; - mc_evt->eventNo=hepevt_.nevhep; - mc_evt->nparts=hepevt_.nhep; - - /* - * now loop over the particle in the event - */ - for(i=0;inparts;i++){ - mc_evt->part[i].statusCode=hepevt_.isthep[i]; - mc_evt->part[i].pid=hepevt_.idhep[i]; - mc_evt->part[i].p.space.x=hepevt_.phep[i][0]; - mc_evt->part[i].p.space.y=hepevt_.phep[i][1]; - mc_evt->part[i].p.space.z=hepevt_.phep[i][2]; - mc_evt->part[i].p.t=hepevt_.phep[i][3]; - mc_evt->part[i].mass=hepevt_.phep[i][4]; - } - return 1; -} - - -/******************** - * write_gamp_parts - *******************/ -int write_gamp_parts(FILE *fp, mc_evt_t *mc_evt, int photon_beam){ - int i; - /* - * Write the number of particles (including the beam) - */ - fprintf(fp,"%d \n", mc_evt->nparts+1); - /* - * Write particle info (id charge p.x p.y p.z p.t) - */ - /* kludged beam */ - fprintf(fp,"1 0 0 0 %d %d \n", photon_beam,photon_beam); - /* now write out nparts */ - for(i=0;inparts;i++){ - fprintf(fp,"%d %d %lf %lf %lf %lf \n", - gampID(mc_evt->part[i].pid),getCharge( mc_evt->part[i].pid), - mc_evt->part[i].p.space.x, - mc_evt->part[i].p.space.y, - mc_evt->part[i].p.space.z, - mc_evt->part[i].p.t); - } -} - -/******************** - * write_mc_parts - *******************/ -int write_mc_parts(FILE *fp, mc_evt_t *mc_evt){ - int i; - - - /* - * write header info - */ - fprintf(fp,"%d %d\n", mc_evt->runNo, mc_evt->eventNo); - - /* - * now loop over the particle in the event - */ - for(i=0;inparts;i++){ - fprintf(fp,"%d %d %lf \n",(i+1), - gampID(mc_evt->part[i].pid), mc_evt->part[i].mass); - fprintf(fp," %d %lf %lf %lf %lf\n", - getCharge( mc_evt->part[i].pid), - /* mc_evt->part[i].pid/abs(mc_evt->part[i].pid),*/ - mc_evt->part[i].p.space.x, - mc_evt->part[i].p.space.y, - mc_evt->part[i].p.space.z, - mc_evt->part[i].p.t); - } - return 1; -} - - -/******************** - * getCharge - *******************/ -int getCharge(int PDGpid){ - int charge; - /* - * See 1998 PDG Rev. MC particle numbering scheme - */ - typedef enum { - gamma=22, - pizero=111, - eta=221, - etaprime=331, - Kshort=310, - Klong=130, - neutron=2112, - Lambda=3122 - } PGDneutralPID_t; - - charge = PDGpid/abs(PDGpid); - /* - * now check for neutrals - */ - switch((PGDneutralPID_t) PDGpid){ /* See PDG Rev. MC particle numbering scheme */ - case gamma: - case pizero: - case eta: - case etaprime: - case Kshort: - case Klong: - case neutron: - case -neutron: - case Lambda: - case -Lambda: - charge =0; - default: - break; - } - - return charge; - -} -/******************** - * gampID(int pdgID) - * The convention is that - * followed in StdHep 4.02 - *******************/ -int gampID(int id){ - Particle_t p=Unknown; - switch (id) { - case 0: - p=Unknown; - break; - case 22: - p=Gamma; - break; - case -11: - p=Positron; - break; - case 11: - p=Electron; - break; - case 12: - p=Neutrino; - break; - case -13: - p=MuonPlus; - break; - case 13: - p=MuonMinus; - break; - case 111: - p=Pi0; - break; - case 211: - p=PiPlus; - break; - case -211: - p=PiMinus; - break; - case 130: - p=KLong; - break; - case 321: - p=KPlus; - break; - case -321: - p=KMinus; - break; - case 2112: - p=Neutron; - break; - case 2212: - p=Proton; - break; - case -2212: - p=AntiProton; - break; - case 310: - p=KShort; - break; - case 221: - p=Eta; - break; - case 3122: - p=Lambda; - break; - case 3222: - p=SigmaPlus; - break; - case 3212: - p=Sigma0; - break; - case 3112: - p=SigmaMinus; - break; - case 3322: - p=Xi0; - case 3312: - p=XiMinus; - break; - case 3334: - p=OmegaMinus; - break; - case -2112: - p=AntiNeutron; - break; - case -3122: - p=AntiLambda; - break; - case -3112: - p=AntiSigmaMinus; - break; - case -3212: - p=AntiSigma0; - break; - case -3222: - p=AntiSigmaPlus; - break; - case -3322: - p=AntiXi0; - break; - case -3312: - p=AntiXiPlus; - break; - case -3334: - p=AntiOmegaPlus; - break; - case 113: - p=Rho0; - break; - case 213: - p=RhoPlus; - break; - case -213: - p=RhoMinus; - break; - case 223: - p=omega; - break; - case 331: - p=EtaPrime; - break; - case 333: - p=phiMeson; - break; - default: - p=Unknown; - break; - } - return((int)p); -} - - - -/******************** - * PrintUsage - *******************/ -int PrintUsage(char *processName) -{ - - fprintf(stderr,"%s usage: [switches] \n",processName); - fprintf(stderr,"\t-i The input mcfast evt file.\n"); - fprintf(stderr,"\t-o The output ascii file(default is stdout).\n"); - fprintf(stderr,"\t-N<#> The number mcfast events.\n"); - fprintf(stderr,"\t-n<#> The number particles per event.\n"); - fprintf(stderr,"\t-g Write gamp output w/ kludged photon beam.\n"); - fprintf(stderr,"\t-h Print this help message\n\n"); -} - - diff --git a/src/programs/Simulation/stdhep_translators/stdhep2hddm.c b/src/programs/Simulation/stdhep_translators/stdhep2hddm.c deleted file mode 100644 index 9335998b0f..0000000000 --- a/src/programs/Simulation/stdhep_translators/stdhep2hddm.c +++ /dev/null @@ -1,364 +0,0 @@ -/************************************************ - * stdhep2hddm.c - * This program converts the StdHep format to a - * generic hddm format. - * - * See http://www-pat.fnal.gov/stdhep.html - * http://zeus.phys.uconn.edu/halld/datamodel/doc - * - * Richard Jones - * University of Connecticut - * June 1, 2001 - **********************************************/ - -#include -#include -#include -#include - -#include "hddm_s.h" - -#include -#include -#include - -int runNo=-9000; - -/* - * #include See it below. - */ - -/******************* From stdhep.h **************************** -* Basic COMMON block from STDHEP: the HEPEVT COMMON block -* See product StDhep -* -* note that to avoid alignment problems, structures and common blocks -* should be in the order: double precision, real, integer. -*************************************************************** -#define NMXHEP 4000 -extern struct hepevt { - int nevhep; /* The event number * - int nhep; /* The number of entries in this event * - int isthep[NMXHEP]; /* The Particle id * - int idhep[NMXHEP]; /* The particle id * - int jmohep[NMXHEP][2]; /* The position of the mother particle * - int jdahep[NMXHEP][2]; /* Position of the first daughter... * - double phep[NMXHEP][5]; /* 4-Momentum, mass * - double vhep[NMXHEP][4]; /* Vertex information * -} hepevt_; -************************************************************/ - - -/******************************** - * Prototypes for StdHep functions. - *********************************/ - -int StdHepXdrReadInit(char *fileName,int ntries, int istream); -int StdHepXdrRead(int *ilbl,int istream); -int StdHepXdrEnd(int istream); - - -int gampID(int id) -{ - Particle_t p=Unknown; - switch (id) { - case 0: - p=Unknown; - break; - case 22: - p=Gamma; - break; - case -11: - p=Positron; - break; - case 11: - p=Electron; - break; - case 12: - p=Neutrino; - break; - case -13: - p=MuonPlus; - break; - case 13: - p=MuonMinus; - break; - case 111: - p=Pi0; - break; - case 211: - p=PiPlus; - break; - case -211: - p=PiMinus; - break; - case 130: - p=KLong; - break; - case 321: - p=KPlus; - break; - case -321: - p=KMinus; - break; - case 2112: - p=Neutron; - break; - case 2212: - p=Proton; - break; - case -2212: - p=AntiProton; - break; - case 310: - p=KShort; - break; - case 221: - p=Eta; - break; - case 3122: - p=Lambda; - break; - case 3222: - p=SigmaPlus; - break; - case 3212: - p=Sigma0; - break; - case 3112: - p=SigmaMinus; - break; - case 3322: - p=Xi0; - case 3312: - p=XiMinus; - break; - case 3334: - p=OmegaMinus; - break; - case -2112: - p=AntiNeutron; - break; - case -3122: - p=AntiLambda; - break; - case -3112: - p=AntiSigmaMinus; - break; - case -3212: - p=AntiSigma0; - break; - case -3222: - p=AntiSigmaPlus; - break; - case -3322: - p=AntiXi0; - break; - case -3312: - p=AntiXiPlus; - break; - case -3334: - p=AntiOmegaPlus; - break; - case 113: - p=Rho0; - break; - case 213: - p=RhoPlus; - break; - case -213: - p=RhoMinus; - break; - case 223: - p=omega; - break; - case 331: - p=EtaPrime; - break; - case 333: - p=phiMeson; - break; - default: - p=Unknown; - break; - } - return((int)p); -} - - -int fill_mc_part(int i, s_Vertices_t* vs, int v) -{ - Particle_t ptype; - s_Origin_t* or = vs->in[v].origin; - s_Products_t* ps = vs->in[v].products; - if (or == &hddm_s_nullTarget) - { - or = make_s_Origin(); - vs->in[v].origin = or; - or->vx = hepevt_.vhep[i][0]; - or->vy = hepevt_.vhep[i][1]; - or->vz = hepevt_.vhep[i][2]; - } - if (ps == &hddm_s_nullTarget) - { - ps = make_s_Products(30); - vs->in[v].products = ps; - ps->mult = 0; - } - ptype = gampID(hepevt_.idhep[i]); - ps->in[ps->mult].type = ptype; - ps->in[ps->mult].momentum = make_s_Momentum(); - ps->in[ps->mult].momentum->px = hepevt_.phep[i][0]; - ps->in[ps->mult].momentum->py = hepevt_.phep[i][1]; - ps->in[ps->mult].momentum->pz = hepevt_.phep[i][2]; - ps->in[ps->mult].momentum->E = hepevt_.phep[i][3]; - ps->in[ps->mult].properties = make_s_Properties(); - ps->in[ps->mult].properties->mass = hepevt_.phep[i][4]; - ps->in[ps->mult].properties->charge = ParticleCharge(ptype); - ps->mult++; - - if (hepevt_.jdahep[i][0] != 0) - { - int j; - for (j = 0; j < hepevt_.nhep; j++) - { - int iv = vs->mult; - if (hepevt_.jmohep[j][0] == i) - { - fill_mc_part(j,vs,iv); - } - } - vs->mult++; - } -} - - -int fill_mc_parts(s_HDDM_t* mc_evt) -{ - int i; - s_PhysicsEvents_t* pes = make_s_PhysicsEvents(1); - s_Reactions_t* rs = make_s_Reactions(1); - s_Vertices_t* vs = make_s_Vertices(10); - mc_evt->physicsEvents = pes; - pes->in[0].reactions = rs; - rs->in[0].vertices = vs; - pes->mult = 1; - rs->mult = 1; - vs->mult = 1; - for (i = 0; i < hepevt_.nhep; i++) - { - if (hepevt_.jmohep[i][0] == 0) - { - fill_mc_part(i,vs,0); - } - } - pes->in[0].runNo = runNo; - pes->in[0].eventNo = hepevt_.nevhep; - return 1; -} - - -int PrintUsage(char *processName) -{ - fprintf(stderr,"%s usage: [switches] \n",processName); - fprintf(stderr,"\t-i input stdhep evt file (no default)\n"); - fprintf(stderr,"\t-o output hddm file (default is stdhep.hddm)\n"); - fprintf(stderr,"\t-N<#> number stdhep events to process (default is 0)\n"); - fprintf(stderr,"\t-r<#> run number saved in events (default is -9000)\n"); - fprintf(stderr,"\t-h Print this help message\n\n"); -} - - -int main(int argc,char **argv) -{ - char *argptr; - int i, ntries=0, ret, written=0; - char *evtfile = "default.evt"; - int istream=0, ilbl; - s_HDDM_t *mc_evt; - s_iostream_t *outputfp; - char hddmfile[400]; - strcpy(hddmfile,"stdhep.hddm"); - - if (argc == 1) - { - PrintUsage(argv[0]); - exit (0); - } - else - { - for (i = 1; i < argc; i++) { - argptr = argv[i]; - if ((*argptr == '-') && (strlen(argptr) > 1)) { - argptr++; - switch (*argptr) { - case 'N': - ntries=atoi(++argptr); - break; - case 'o': - sprintf(hddmfile,"%s.hddm",++argptr); - break; - case 'i': - evtfile= ++argptr; - break; - case 'r': - runNo= atoi(++argptr); - break; - case 'h': - PrintUsage(argv[0]); - exit(0); - break; - default: - fprintf(stderr,"Unrecognized argument -%s\n\n",argptr); - PrintUsage(argv[0]); - exit(-1); - break; - } - } - } - -/* - * Open and init a stdhep file. - */ - - if (ret=StdHepXdrReadInit(evtfile,ntries,istream)) - { - /* some error must have occured */ - fprintf(stderr,"err:StdHepXdrReadInit ret=%d\n",ret); - exit(-1); - } - - if (!(outputfp = init_s_HDDM(hddmfile))) - { - fprintf(stderr,"Fail to open output file!\n"); - exit(-1); - } - - for (i=0;i hddm2root $HALLD_HOME/src/libraries/HDDM/rest.xml"< hddm2root $HALLD_RECON_HOME/src/libraries/HDDM/rest.xml"< hddm2root_r file.hddm"< 0 ){ + # If HALLD_RECON_HOME is defined, use DANA so user doesn't need to explicitly pass "-d" + if( length($ENV{"HALLD_RECON_HOME"}) > 0 ){ $JANA_IMPLEMENTATION = "DANA"; - print "HALLD_HOME environment variable is set. Assuming DANA package.\n"; + print "HALLD_RECON_HOME environment variable is set. Assuming DANA package.\n"; print "(to use JANA instead, pass the \"-j\" option)\n"; } } @@ -233,7 +233,7 @@ sub CopySConstruct() #$PACKAGES = $JANA_IMPLEMENTATION; #if(!$NO_ROOT){ $PACKAGES .= ":ROOT"; } - $from = $ENV{"HALLD_HOME"} . "/src/SBMS/SConstruct.plugin"; + $from = $ENV{"HALLD_RECON_HOME"} . "/src/SBMS/SConstruct.plugin"; $to = "./${pluginname}/SConstruct"; copy($from, $to) or die ("copy failed $! -- $?"); } @@ -253,7 +253,7 @@ sub Usage() print " -b Use \"BANA\" as base Makefile package in Makefile\n"; print " -j Use \"JANA\" as base Makefile package in Makefile\n"; print " -d Use \"DANA\" as base Makefile package in Makefile\n"; - print " (this will be set by default if HALLD_HOME is set)\n"; + print " (this will be set by default if HALLD_RECON_HOME is set)\n"; print " --no-root Do not include \"ROOT\" in the PACKAGES line in Makefile\n"; print "\n"; print "This script superceeds some similar functionality in the mkprocessor\n";